CPSValueRepresenter.scala 17.1 KB
Newer Older
Sapphie's avatar
Sapphie committed
1
2
package l3

Sapphie's avatar
Sapphie committed
3
4
5
6
7
8
9
import l3.{SymbolicCPSTreeModule => H}
import l3.{SymbolicCPSTreeModuleLow => L}
import l3.{L3Primitive => L3}
import l3.{CPSValuePrimitive => CPS}
import l3.{CPSTestPrimitive => CPST}

object CPSValueRepresenter extends (H.Tree => L.Tree) {
Luca Bataillard's avatar
Luca Bataillard committed
10
11
12
13
14
15
16
17
18
  private type Worker = Symbol
  private type Wrapper = Symbol
  private type FreeVars = Seq[Symbol]
  private type KnownFunsMap = Map[Symbol, (Worker, Wrapper, FreeVars)] 
  
  def apply(tree: H.Tree): L.Tree = transform(tree)(Map())

  private def transform(tree: H.Tree)(implicit knownFuns: KnownFunsMap): L.Tree = tree match {
    case H.LetP(n, prim, args, body) => transformLetP(n, prim, args, body)
Sapphie's avatar
Sapphie committed
19
    case H.LetF(funs, body) =>
20
      transformLetF(funs, body)
Sapphie's avatar
Sapphie committed
21
    case H.LetC(cnts, body) =>
Luca Bataillard's avatar
Luca Bataillard committed
22
23
      val lCnts = cnts.map(c => L.Cnt(c.name, c.args, transform(c.body)))
      L.LetC(lCnts, transform(body))
Sapphie's avatar
Sapphie committed
24
    case H.AppF(fun, retC, args) =>
Luca Bataillard's avatar
Luca Bataillard committed
25
      transformAppF(fun, retC, args)
Sapphie's avatar
Sapphie committed
26
27
28
29
30
    case H.AppC(cnt, args) =>
      val lArgs = args.map(rewrite)
      L.AppC(cnt, lArgs)
    case H.If(cond, args, thenC, elseC) =>
      transformIf(cond, args, thenC, elseC)
31
32
33
34
35
36
    case H.Halt(v) => v match {
      case H.AtomL(UnitLit) => L.Halt(L.AtomL(0))
      case H.AtomL(IntLit(i)) => L.Halt(L.AtomL(i.toInt))
      case H.AtomL(CharLit(c)) => L.Halt(L.AtomL(c.toInt))
      case H.AtomL(BooleanLit(b)) => L.Halt(L.AtomL(if (b) 1 else 0))
      case v1 @ H.AtomN(_) => 
Sapphie's avatar
Sapphie committed
37
        return L.Halt(rewrite(v))
38
39
40
41
42
43
44
45
        val haltContName = Symbol.fresh("c-halt")
        val haltContArgs = Seq(Symbol.fresh("halt_arg"))
        val haltContBody = L.Halt(L.AtomN(haltContArgs(0)))
        val letCBody = makeUntaggingTree(v1, haltContName)
        L.LetC(Seq(L.Cnt(haltContName, haltContArgs, haltContBody)), letCBody)
    }


Sapphie's avatar
Sapphie committed
46
    case _ => throw new Exception("Unimplemented: " + tree.getClass.toString)
47
  }
Sapphie's avatar
Sapphie committed
48

Luca Bataillard's avatar
Luca Bataillard committed
49
50
51
52
53
  private def transformAppF(fun: H.Atom, retC: Symbol, args: Seq[H.Atom])(implicit knownFuns: KnownFunsMap): L.Tree = {
    val fName = fun.asName.get
    if (knownFuns.contains(fName)) {
      val (wName, sName, fvs) = knownFuns(fName)
      val newArgs = (args map rewrite) ++ (fvs map L.AtomN)
54
      L.AppF(L.AtomN(wName), retC, newArgs)
Luca Bataillard's avatar
Luca Bataillard committed
55
    } else {
Sapphie's avatar
Sapphie committed
56
      val f = Symbol.fresh("closure")
Luca Bataillard's avatar
Luca Bataillard committed
57
58
      val newBody = L.AppF(L.AtomN(f), retC, rewrite(fun) +: args.map(rewrite))
      val newArgs = Seq(rewrite(fun), L.AtomL(0))
59
      L.LetP(f, CPS.BlockGet, newArgs, newBody)
Luca Bataillard's avatar
Luca Bataillard committed
60
61
62
    }
  }

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
  def makeUntaggingTree(v: H.AtomN, haltCont: Symbol): L.Tree = {
    def mkeUntagCont(name: String, nBitsShift: Int): L.Cnt = {
      val contName = Symbol.fresh("c-" + name)
      val argName = Symbol.fresh(name + "_arg")
      val shiftedName = Symbol.fresh(name + "_arg_untagged")
      L.Cnt(contName, Seq(argName),
        L.LetP(shiftedName, CPS.ShiftRight,
            Seq(L.AtomN(argName), L.AtomL(nBitsShift)),
            L.AppC(haltCont, Seq(L.AtomN(shiftedName)))))
    }

    def mkeCheckCont(name: String, body: L.Tree): L.Cnt = {
      val contName = Symbol.fresh(name)
      L.Cnt(contName, Seq(), body)
    }

    val untagIntCont = mkeUntagCont("int_untag", 1)
    val untagCharCont = mkeUntagCont("char_untag", 3)
    val untagBoolCont = mkeUntagCont("bool_untag", 4)
    val untagUnitCont = mkeUntagCont("unit_untag", 2)

    // If it's a unit, untag it, otherwise, immediately skip to halt
Sapphie's avatar
Sapphie committed
85
86
    val unitCheckCont = mkeCheckCont("unit_check",
      transformIf(L3.UnitP, Seq(v), untagUnitCont.name, haltCont))
87
88

    // If it's a boolean, untag it, otherwise check if it's a unit
Sapphie's avatar
Sapphie committed
89
90
    val boolCheckCont = mkeCheckCont("bool_check",
      transformIf(L3.BoolP, Seq(v), untagBoolCont.name, unitCheckCont.name))
91
92

    // if it's a character, untag it, otherwise check if it's a boolean
Sapphie's avatar
Sapphie committed
93
94
    val charCheckCont = mkeCheckCont("char_check",
     transformIf(L3.CharP, Seq(v), untagCharCont.name, boolCheckCont.name))
95
96

    //etc
97
    val letCBody = transformIf(L3.IntP, Seq(v), untagIntCont.name, haltCont)
98
99

    val conts = Seq(untagIntCont,
Sapphie's avatar
Sapphie committed
100
101
102
103
104
105
                  untagCharCont,
                  untagBoolCont,
                  untagUnitCont,
                  unitCheckCont,
                  charCheckCont,
                  boolCheckCont
106
                  )
107
108
109
    L.LetC(conts, letCBody)
  }

Luca Bataillard's avatar
Luca Bataillard committed
110
  private def transformLetF(initialFuns: Seq[H.Fun], body: H.Tree)(implicit oldKnownFuns: KnownFunsMap): L.LetF = {
Luca Bataillard's avatar
Luca Bataillard committed
111
112
113
114
115
116
117
118
119
120
121
122
    
    def funsFV(definedFuns: Seq[H.Fun], prevKnownFuns: KnownFunsMap): Map[Symbol, Seq[Symbol]] = {      
      type FVMap = Map[Symbol, Set[Symbol]]

      def fv(e: H.Tree, fvMap: FVMap): Set[Symbol] = e match {
        case H.LetP(n, prim, args, body) =>
          val argsFV = fvAtomSeq(args, fvMap)
          (fv(body, fvMap) - n) ++ argsFV
        case H.LetC(cnts, body) =>
          val cntsFVs = cnts.flatMap(c => fv(c.body, fvMap) -- c.args)
          fv(body, fvMap) ++ cntsFVs
        case H.LetF(funs, body) => 
Luca Bataillard's avatar
Luca Bataillard committed
123
124
          val funsFVs = funs.flatMap(f => (fv(f.body, fvMap) -- f.args))
          (fv(body, fvMap) ++ funsFVs) -- funs.map(_.name)
Luca Bataillard's avatar
Luca Bataillard committed
125
126
127
        case H.AppC(cnt, args) => 
          fvAtomSeq(args, fvMap)
        case H.AppF(fun, retC, args) => 
Luca Bataillard's avatar
Luca Bataillard committed
128
          fvAtomSeq(args, fvMap) ++ fvMap.getOrElse(fun.asName.get, Set(fun.asName.get))
Luca Bataillard's avatar
Luca Bataillard committed
129
130
131
132
133
134
135
136
        case H.If(_, args, _, _) => 
          fvAtomSeq(args, fvMap)
        case H.Halt(arg) => 
          arg.asName.toSet
      }

      def fvAtomSeq(as: Seq[H.Atom], fvMap: FVMap): Set[Symbol] =
        as.map(_.asName).filter(_.isDefined).toSet
Luca Bataillard's avatar
Luca Bataillard committed
137
          .map((n: Option[Symbol]) => n.get)
Luca Bataillard's avatar
Luca Bataillard committed
138
139

      def iterate(fvMap: FVMap): FVMap =
Luca Bataillard's avatar
Luca Bataillard committed
140
141
142
143
144
        definedFuns.foldLeft (fvMap) { case (acc, H.Fun(fName, _, fArgs, fBody)) =>
            val newFv = (fv(fBody, acc)) -- fArgs
            val newBinding = (fName, newFv)
            acc + newBinding
        }
Luca Bataillard's avatar
Luca Bataillard committed
145
146
147
148
149
150
      
      val definedFvMap = definedFuns.map(f => (f.name, Set[Symbol]())).toMap
      val initialFvMap: FVMap = definedFvMap ++ prevKnownFuns.map{ case (fName, (_, _, fvs)) => (fName, fvs.toSet)}
      
      fixedPoint(initialFvMap)(iterate) map { case (fName, fvs) => (fName, fvs.toSeq) }
    }
Luca Bataillard's avatar
Luca Bataillard committed
151
152
153
154
155
156
157
158
159
160

    def bindArguments(wName: Symbol, retC: Symbol, envName: Symbol, 
                      freeVars: Seq[Symbol], counter: Int, wArgs: Seq[L.Atom]): L.Tree = freeVars match {
      case Nil => L.AppF(L.AtomN(wName), retC, wArgs)
      case fv :: fvs =>
        val v = Symbol.fresh("binding_" + fv.name)
        L.LetP(v, CPS.BlockGet, Seq(L.AtomN(envName), L.AtomL(counter)),
          bindArguments(wName, retC, envName, fvs, counter + 1, wArgs :+ L.AtomN(v)))
    }

Luca Bataillard's avatar
Luca Bataillard committed
161
162
    val fvs = funsFV(initialFuns, oldKnownFuns)

Luca Bataillard's avatar
Luca Bataillard committed
163
164
165
    val definedFuns = initialFuns map { case H.Fun(fName, _, fArgs, fBody) => 
      val wName = Symbol.fresh(fName.name + "_worker")
      val sName = Symbol.fresh(fName.name + "_wrapper")
Luca Bataillard's avatar
Luca Bataillard committed
166
167
      
      val fv = fvs(fName)
Luca Bataillard's avatar
Luca Bataillard committed
168
169
170
171
172
173
174
      (fName -> (wName, sName, fv))
    }
    val knownFuns = oldKnownFuns ++ definedFuns

    val workers = initialFuns map { case H.Fun(fName, fRetC, fArgs, fBody) =>
      val (wName, _, fvs) = knownFuns(fName)
      val us = fvs.map(f => Symbol.fresh("fv_" + f.name))
Luca Bataillard's avatar
Luca Bataillard committed
175
      val wBody = substitute(transform(fBody)(knownFuns))((fvs zip us).toMap)
Luca Bataillard's avatar
Luca Bataillard committed
176
177
178
179
180
181
182
183
184
185
186
187

      L.Fun(wName, fRetC, fArgs ++ us, wBody)
    }
    
    val wrappers = initialFuns map { case H.Fun(fName, _, fArgs, fBody) =>
      val (wName, sName, fvs) = knownFuns(fName)
      val sCntName = Symbol.fresh("c_wrapper")
      val envName = Symbol.fresh("env")

      val sArgs = fArgs map (f => Symbol.fresh("n_" + f.name))
      val sBody = bindArguments(wName, sCntName, envName, fvs, 1, sArgs map (L.AtomN(_)))

Luca Bataillard's avatar
Luca Bataillard committed
188
      L.Fun(sName, sCntName, envName +: sArgs, sBody)
Luca Bataillard's avatar
Luca Bataillard committed
189
    }
190

Luca Bataillard's avatar
Luca Bataillard committed
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
    def initFuns(funsAndVars: Seq[(Symbol, (Worker, Wrapper, FreeVars))], lastBody: L.Tree): L.Tree = {
      def initFunHelper(fvs: Seq[Symbol], counter: Int, blockAtom: L.Atom, rest: Seq[(Symbol, (Worker, Wrapper, FreeVars))]): L.Tree = fvs match {
        case Nil => initFuns(rest, lastBody)
        case fv :: fvs => 
          val nextBody = initFunHelper(fvs, counter + 1, blockAtom, rest)
          val args: Seq[L.Atom] = Seq(blockAtom, L.AtomL(counter), L.AtomN(fv))
          L.LetP(Symbol.fresh("blockset_unused"), CPS.BlockSet, args, nextBody)
      } 

      funsAndVars match {
        case Nil => lastBody
        case (fName, (worker, wrapper, fvs)) :: rest => 
          val blockAtom = L.AtomN(fName)
          val varInits = initFunHelper(fvs, 1, blockAtom, rest)
          val t1 = Symbol.fresh("blockset_unused")
Luca Bataillard's avatar
Luca Bataillard committed
206
          val blockSetArgs = Seq(blockAtom, L.AtomL(0), L.AtomN(wrapper))
Luca Bataillard's avatar
Luca Bataillard committed
207
208
          L.LetP(t1, CPS.BlockSet, blockSetArgs, varInits)
      }
209
210
    }

Luca Bataillard's avatar
Luca Bataillard committed
211
212
213
    def allocFuns(funsAndVars: Seq[(Symbol, (Worker, Wrapper, FreeVars))], closureInits: L.Tree): L.Tree = 
      funsAndVars.foldRight(closureInits) { case ((fName, (worker, wrapper, fvs)), prevBody) => 
        L.LetP(fName, CPS.BlockAlloc(202), Seq(L.AtomL(fvs.length + 1)), prevBody)
214
215
216
      }


Luca Bataillard's avatar
Luca Bataillard committed
217
218
219
    val lastBody = transform(body)(knownFuns)
    val closureInits = initFuns(definedFuns, lastBody)
    val closureAllocsInits = allocFuns(definedFuns, closureInits)
Sapphie's avatar
Sapphie committed
220
    
Luca Bataillard's avatar
Luca Bataillard committed
221
    L.LetF(workers ++ wrappers, closureAllocsInits)
222
223
  }

Sapphie's avatar
Sapphie committed
224
225
226
  // Substitutes _free_ variables in `tree`
  // meaning that `subst` should only contain variables
  // that are free in `tree`
227
  def substitute(tree: L.Tree)(implicit subst: Subst[Symbol]): L.Tree = {
Sapphie's avatar
Sapphie committed
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
    def subtituteArgs(args: Seq[L.Atom]): Seq[L.Atom] = args.map(substituteAtom)

    def substituteAtom(atom: L.Atom) = atom match {
      case L.AtomL(_) => atom
      case L.AtomN(n) => L.AtomN(subst.getOrElse(n,n))
    }

    tree match {
      case L.LetP(name, prim, args, body) =>
        val newArgs = subtituteArgs(args)
        val newBody = substitute(body)
        L.LetP(name, prim, newArgs, newBody)
      case L.AppC(cnt, args) =>
        L.AppC(cnt, subtituteArgs(args))
      case L.AppF(fun, retC, args) =>
        L.AppF(substituteAtom(fun), retC, subtituteArgs(args))
      case L.Halt(arg) => L.Halt(substituteAtom(arg))
      case L.If(cond, args, thenC, elseC) =>
        L.If(cond, subtituteArgs(args), thenC, elseC)
      case L.LetC(cnts, body) =>
        val newCnts = cnts.map { cnt =>
          L.Cnt(cnt.name, cnt.args, substitute(cnt.body))
        }
        val newBody = substitute(body)
        L.LetC(newCnts, newBody)
      case L.LetF(funs, body) =>
        val newFuns = funs.map {fun =>
          L.Fun(fun.name, fun.retC, fun.args, substitute(fun.body))
        }
        val newBody = substitute(body)
        L.LetF(newFuns, newBody)
    }
  }
261

Sapphie's avatar
Sapphie committed
262
  private def transformIf(cond: L3TestPrimitive, args: Seq[H.Atom], thenC: H.Name, elseC: H.Name): L.Tree = {
Sapphie's avatar
Sapphie committed
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
    def maskAndCheck(numBits: Int, target: Bits32): L.LetP = {
      val Seq(x) = args
      tempLetP(CPS.And, Seq(Left(x), getMaskR(numBits))) { x1 =>
        L.If(CPST.Eq, Seq(x1, L.AtomL(target)), thenC, elseC)
      }
    }

    cond match {
      case L3.BlockP =>
        maskAndCheck(2, 0x0)
      case L3.IntP =>
        maskAndCheck(1, 0x1)
      case L3.BoolP =>
        maskAndCheck(4, 0xa)
      case L3.UnitP =>
        maskAndCheck(4, 0x2)
      case L3.CharP =>
        maskAndCheck(3, 0x6)
281
282
283
      case L3.Eq =>  L.If(CPST.Eq, args.map(rewrite), thenC, elseC)
      case L3.IntLe => L.If(CPST.Le, args map rewrite, thenC, elseC)
      case L3.IntLt => L.If(CPST.Lt, args map rewrite, thenC, elseC)
Sapphie's avatar
Sapphie committed
284
285
286
287
288
289

    }
  }

  private def getMaskR(numBits: Int): Either[H.Atom, L.Atom] = Right(L.AtomL((1 << numBits) -1))

Luca Bataillard's avatar
Luca Bataillard committed
290
  private def transformLetP(n: H.Name, prim: L3, args: Seq[H.Atom], body: H.Tree)(implicit knownFuns: KnownFunsMap): L.LetP = {
Sapphie's avatar
Sapphie committed
291

292
    val lAtomOne: Either[H.Atom, L.Atom] = Right(L.AtomL(1))
Sapphie's avatar
Sapphie committed
293
294
295
296
297
    lazy val x = args(0)
    lazy val y = args(1)
    lazy val z = args(2)

    def rawBinaryTree(op: CPS): L.LetP = {
Sapphie's avatar
Sapphie committed
298
299
300
301
302
303
304
      // Untag both values
      tempLetP(CPS.ShiftRight, Seq(Left(x), lAtomOne)) { x1 =>
        tempLetP(CPS.ShiftRight, Seq(Left(y), lAtomOne)) { y1 =>
          // Apply the actual operation
          tempLetP(op, Seq(Right(x1), Right(y1))) { truDiv =>
            // Retag the result
            tempLetP(CPS.ShiftLeft, Seq(Right(truDiv), lAtomOne)) { shiftedRes =>
Luca Bataillard's avatar
Luca Bataillard committed
305
              L.LetP(n, CPS.Add, Seq(shiftedRes, L.AtomL(1)), transform(body))
Sapphie's avatar
Sapphie committed
306
307
308
309
310
            }
          }
        }
      }
    }
Sapphie's avatar
Sapphie committed
311

312
313
314
    prim match {
      case L3.IntAdd => 
        tempLetP(CPS.Sub, Seq(Left(x), lAtomOne)) { x1 => 
Luca Bataillard's avatar
Luca Bataillard committed
315
          L.LetP(n, CPS.Add, Seq(x1, rewrite(y)), transform(body))
316
317
318
        }
      case L3.IntSub =>
        tempLetP(CPS.Add, Seq(Left(x), lAtomOne)) { x1 =>
Luca Bataillard's avatar
Luca Bataillard committed
319
          L.LetP(n, CPS.Sub, Seq(x1, rewrite(y)), transform(body))
320
321
322
323
324
        }
      case L3.IntMul =>
        tempLetP(CPS.Sub, Seq(Left(x), lAtomOne)) { x1 =>
          tempLetP(CPS.ShiftRight, Seq(Left(y), lAtomOne)) { y1 =>
            tempLetP(CPS.Mul, Seq(Right(x1), Right(y1))) { z =>
Luca Bataillard's avatar
Luca Bataillard committed
325
              L.LetP(n, CPS.Add, Seq(z, L.AtomL(1)), transform(body))
326
327
328
            }
          }
        }
Sapphie's avatar
Sapphie committed
329
330

      // I don't think there is a way to do this in a smart way
Sapphie's avatar
Sapphie committed
331
      case L3.IntDiv => rawBinaryTree(CPS.Div)
332
333
334
335
336
337
338
      case L3.IntMod => tempLetP(CPS.XOr, Seq(Left(x), lAtomOne)) {
        x1 => tempLetP(CPS.XOr, Seq(Left(y), lAtomOne)) { y1 =>
          tempLetP (CPS.Mod, Seq(Right(x1), Right(y1))) { untaggedModRes =>
            L.LetP(n, CPS.XOr, Seq(untaggedModRes, L.AtomL(1)), transform(body))
          }
        }
      }
Sapphie's avatar
Sapphie committed
339
340
341
342
343

      case L3.IntShiftLeft =>
        tempLetP(CPS.Sub, Seq(Left(x), lAtomOne)) { x1 => 
          tempLetP(CPS.ShiftRight, Seq(Left(y), lAtomOne)) { y1 => 
            tempLetP(CPS.ShiftLeft, Seq(Right(x1), Right(y1))) { z => 
Luca Bataillard's avatar
Luca Bataillard committed
344
              L.LetP(n, CPS.Add, Seq(z, L.AtomL(1)), transform(body))
Sapphie's avatar
Sapphie committed
345
346
347
348
349
350
351
            }
          }
        }

      case L3.IntShiftRight =>
        tempLetP(CPS.ShiftRight, Seq(Left(y), lAtomOne)) { y1 =>
          tempLetP(CPS.ShiftRight, Seq(Left(x), Right(y1))) { z => 
Luca Bataillard's avatar
Luca Bataillard committed
352
            L.LetP(n, CPS.Or, Seq(z, L.AtomL(1)), transform(body))
Sapphie's avatar
Sapphie committed
353
354
355
          }
        }

Sapphie's avatar
Sapphie committed
356
      case L3.IntBitwiseAnd =>
Luca Bataillard's avatar
Luca Bataillard committed
357
        L.LetP(n, CPS.And, Seq(rewrite(x), rewrite(y)), transform(body))
Sapphie's avatar
Sapphie committed
358
359

      case L3.IntBitwiseOr =>
Luca Bataillard's avatar
Luca Bataillard committed
360
        L.LetP(n, CPS.Or, Seq(rewrite(x), rewrite(y)), transform(body))
Sapphie's avatar
Sapphie committed
361
362
363

      case L3.IntBitwiseXOr =>
        tempLetP(CPS.XOr, Seq(Left(x), lAtomOne)) { x1 =>
Luca Bataillard's avatar
Luca Bataillard committed
364
          L.LetP(n, CPS.XOr, Seq(x1, rewrite(y)), transform(body))
Sapphie's avatar
Sapphie committed
365
366
        }

Sapphie's avatar
Sapphie committed
367

368
      case L3.BlockAlloc(tag) => 
369
        tempLetP(CPS.ShiftRight, Seq(Left(x), lAtomOne)) { t1 =>
Luca Bataillard's avatar
Luca Bataillard committed
370
          L.LetP(n, CPS.BlockAlloc(tag), Seq(t1), transform(body))
371
        }
Sapphie's avatar
Sapphie committed
372
      case L3.BlockTag =>
373
        tempLetP(CPS.BlockTag, args map (Left(_))) { t1 =>
374
          tempLetP(CPS.ShiftLeft, Seq(Right(t1), lAtomOne)) { t2 =>
Luca Bataillard's avatar
Luca Bataillard committed
375
            L.LetP(n, CPS.Add, Seq(t2, L.AtomL(1)), transform(body))
376
377
378
          }
        }
      case L3.BlockLength => 
379
        tempLetP(CPS.BlockLength, args map (Left(_))) { t1 =>
380
          tempLetP(CPS.ShiftLeft, Seq(Right(t1), lAtomOne)) { t2 =>
Luca Bataillard's avatar
Luca Bataillard committed
381
            L.LetP(n, CPS.Add, Seq(t2, L.AtomL(1)), transform(body))
382
383
          }
        }
384
385
386
      case L3.BlockSet => 
        val block = rewrite(x)
        val value = rewrite(z)
387
        tempLetP(CPS.ShiftRight, Seq(Left(y), Right(L.AtomL(1)))){idx => 
Luca Bataillard's avatar
Luca Bataillard committed
388
          L.LetP(n, CPS.BlockSet, Seq(block, idx, value), transform(body))
389
        }
390
391
      case L3.BlockGet => 
        val block = rewrite(x)
392
        tempLetP(CPS.ShiftRight, Seq(Left(y), Right(L.AtomL(1)))){
Luca Bataillard's avatar
Luca Bataillard committed
393
          idx => L.LetP(n, CPS.BlockGet, Seq(block, idx), transform(body))
394
        }
395
396
397
      case L3.ByteRead =>
        tempLetP(CPS.ByteRead, Seq()){ t1 => 
          tempLetP(CPS.ShiftLeft, Seq(Right(t1), lAtomOne)) { t2 =>
Luca Bataillard's avatar
Luca Bataillard committed
398
            L.LetP(n, CPS.Add, Seq(t2, L.AtomL(1)), transform(body))
399
400
401
402
          }
        }
      case L3.ByteWrite => 
        tempLetP(CPS.ShiftRight, Seq(Left(x), lAtomOne)) { t1 => 
Luca Bataillard's avatar
Luca Bataillard committed
403
          L.LetP(n, CPS.ByteWrite, Seq(t1), transform(body))
404
        }
Sapphie's avatar
Sapphie committed
405
      case L3.CharToInt =>
Luca Bataillard's avatar
Luca Bataillard committed
406
        L.LetP(n, CPS.ShiftRight, Seq(rewrite(x), L.AtomL(2)), transform(body))
Sapphie's avatar
Sapphie committed
407
      case L3.Id =>
Sapphie's avatar
Sapphie committed
408
409
410
411
412
413
        val newKnownFuns = x match {
          case H.AtomN(xName) if knownFuns contains xName => 
            knownFuns.updated(n, knownFuns(xName))
          case _ => knownFuns
        }
        L.LetP(n, CPS.Id, Seq(rewrite(x)), transform(body)(newKnownFuns))
Sapphie's avatar
Sapphie committed
414
      
415
416
      case L3.IntToChar => 
        tempLetP(CPS.ShiftLeft, Seq(Left(x), Right(L.AtomL(2)))){ t1 =>
Luca Bataillard's avatar
Luca Bataillard committed
417
          L.LetP(n, CPS.Add, Seq(t1, L.AtomL(2)), transform(body))
418
        }
Sapphie's avatar
Sapphie committed
419
420

      case _ => throw new Exception("Unreachable code (unary letP) " + prim.getClass)
Sapphie's avatar
Sapphie committed
421
422
    }
  }
423

Sapphie's avatar
Sapphie committed
424

Sapphie's avatar
Sapphie committed
425
426
427
428
  // Creates an outer LetP, and binds the result to a name,
  // then passes the name to mkBody
  // Works similarly to transform in the CL3->CPS translation
  // Does *not* tag the integers given as arguments
Sapphie's avatar
Sapphie committed
429
  private def tempLetP[A <: L.Tree](p: CPS, args: Seq[Either[H.Atom, L.Atom]]) (mkBody: L.Atom => A): L.LetP = {
Sapphie's avatar
Sapphie committed
430
      val lArgs = args.map {
431
432
        case Left(hAtom) => rewrite(hAtom)
        case Right(lAtom)  => lAtom
Sapphie's avatar
Sapphie committed
433
434
      }
      val tmpName = Symbol.fresh("x")
Sapphie's avatar
Sapphie committed
435
      val innerLetP: A = mkBody(L.AtomN(tmpName))
Sapphie's avatar
Sapphie committed
436
437
438
439
440
441
442
443
444
445
446
447
448
      L.LetP(tmpName, p, lArgs, innerLetP)
  }

  private def rewrite(a: H.Atom): L.Atom = a match {
    case H.AtomN(n) => L.AtomN(n)
    case H.AtomL(IntLit(i)) => L.AtomL((i.toInt << 1) | 0x1)
    case H.AtomL(CharLit(c)) => L.AtomL((c.toInt << 3) | 0x6) // 110
    case H.AtomL(BooleanLit(b)) => if (b) 
        L.AtomL(0x1a) // 11010
      else
        L.AtomL(0x0a) // 01010
    case H.AtomL(UnitLit) => L.AtomL(2)
  }
Sapphie's avatar
Sapphie committed
449
}