CPSValueRepresenter.scala 14.7 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
    case H.Halt(v) => L.Halt(rewrite(v))
Sapphie's avatar
Sapphie committed
32
    case _ => throw new Exception("Unimplemented: " + tree.getClass.toString)
33
  }
Sapphie's avatar
Sapphie committed
34

Luca Bataillard's avatar
Luca Bataillard committed
35
36
37
38
39
  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)
Sapphie's avatar
Sapphie committed
40
41
      val res = L.AppF(L.AtomN(wName), retC, newArgs)
      res
Luca Bataillard's avatar
Luca Bataillard committed
42
    } else {
Sapphie's avatar
Sapphie committed
43
      val f = Symbol.fresh("closure")
Luca Bataillard's avatar
Luca Bataillard committed
44
45
      val newBody = L.AppF(L.AtomN(f), retC, rewrite(fun) +: args.map(rewrite))
      val newArgs = Seq(rewrite(fun), L.AtomL(0))
Sapphie's avatar
Sapphie committed
46
      val res = L.LetP(f, CPS.BlockGet, newArgs, newBody)
Sapphie's avatar
Sapphie committed
47
      println("aaaaaaaaaaaa")
Sapphie's avatar
Sapphie committed
48
49
50
      println(fName)
      println(res)
      res
Luca Bataillard's avatar
Luca Bataillard committed
51
52
53
    }
  }

Luca Bataillard's avatar
Luca Bataillard committed
54
  private def transformLetF(initialFuns: Seq[H.Fun], body: H.Tree)(implicit oldKnownFuns: KnownFunsMap): L.LetF = {
Luca Bataillard's avatar
Luca Bataillard committed
55
56
57
58
59
60
61
62
63
64
65
66
    
    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
67
68
          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
69
70
71
        case H.AppC(cnt, args) => 
          fvAtomSeq(args, fvMap)
        case H.AppF(fun, retC, args) => 
Luca Bataillard's avatar
Luca Bataillard committed
72
          fvAtomSeq(args, fvMap) ++ fvMap.getOrElse(fun.asName.get, Set(fun.asName.get))
Luca Bataillard's avatar
Luca Bataillard committed
73
74
75
76
77
78
79
80
        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
81
          .map((n: Option[Symbol]) => n.get)
Luca Bataillard's avatar
Luca Bataillard committed
82
83

      def iterate(fvMap: FVMap): FVMap =
Luca Bataillard's avatar
Luca Bataillard committed
84
85
86
87
88
        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
89
90
91
92
93
94
      
      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
95
96
97
98
99
100
101
102
103
104

    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
105
106
    val fvs = funsFV(initialFuns, oldKnownFuns)

Luca Bataillard's avatar
Luca Bataillard committed
107
108
109
    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
110
111
      
      val fv = fvs(fName)
Luca Bataillard's avatar
Luca Bataillard committed
112
113
      (fName -> (wName, sName, fv))
    }
Sapphie's avatar
Sapphie committed
114
115
116
117
    println("eeeee")
    println(initialFuns.map(_.name))
    println(definedFuns)
    println()
Luca Bataillard's avatar
Luca Bataillard committed
118
119
120
121
122
    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
123
      val wBody = substitute(transform(fBody)(knownFuns))((fvs zip us).toMap)
Luca Bataillard's avatar
Luca Bataillard committed
124
125
126
127
128
129
130
131
132
133
134
135

      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
136
      L.Fun(sName, sCntName, envName +: sArgs, sBody)
Luca Bataillard's avatar
Luca Bataillard committed
137
    }
138

Luca Bataillard's avatar
Luca Bataillard committed
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
    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
154
          val blockSetArgs = Seq(blockAtom, L.AtomL(0), L.AtomN(wrapper))
Luca Bataillard's avatar
Luca Bataillard committed
155
156
          L.LetP(t1, CPS.BlockSet, blockSetArgs, varInits)
      }
157
158
    }

Luca Bataillard's avatar
Luca Bataillard committed
159
160
161
    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)
162
163
164
      }


Luca Bataillard's avatar
Luca Bataillard committed
165
166
167
    val lastBody = transform(body)(knownFuns)
    val closureInits = initFuns(definedFuns, lastBody)
    val closureAllocsInits = allocFuns(definedFuns, closureInits)
Sapphie's avatar
Sapphie committed
168
    
Luca Bataillard's avatar
Luca Bataillard committed
169
    L.LetF(workers ++ wrappers, closureAllocsInits)
170
171
  }

Sapphie's avatar
Sapphie committed
172
173
174
  // Substitutes _free_ variables in `tree`
  // meaning that `subst` should only contain variables
  // that are free in `tree`
175
  def substitute(tree: L.Tree)(implicit subst: Subst[Symbol]): L.Tree = {
Sapphie's avatar
Sapphie committed
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
    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)
    }
  }
209

Sapphie's avatar
Sapphie committed
210
  private def transformIf(cond: L3TestPrimitive, args: Seq[H.Atom], thenC: H.Name, elseC: H.Name): L.Tree = {
Sapphie's avatar
Sapphie committed
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
    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)
229
230
231
      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
232
233
234
235
236
237

    }
  }

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

Luca Bataillard's avatar
Luca Bataillard committed
238
  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
239

240
    val lAtomOne: Either[H.Atom, L.Atom] = Right(L.AtomL(1))
Sapphie's avatar
Sapphie committed
241
242
243
244
245
    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
246
247
248
249
250
251
252
      // 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
253
              L.LetP(n, CPS.Add, Seq(shiftedRes, L.AtomL(1)), transform(body))
Sapphie's avatar
Sapphie committed
254
255
256
257
258
            }
          }
        }
      }
    }
Sapphie's avatar
Sapphie committed
259

260
261
262
    prim match {
      case L3.IntAdd => 
        tempLetP(CPS.Sub, Seq(Left(x), lAtomOne)) { x1 => 
Luca Bataillard's avatar
Luca Bataillard committed
263
          L.LetP(n, CPS.Add, Seq(x1, rewrite(y)), transform(body))
264
265
266
        }
      case L3.IntSub =>
        tempLetP(CPS.Add, Seq(Left(x), lAtomOne)) { x1 =>
Luca Bataillard's avatar
Luca Bataillard committed
267
          L.LetP(n, CPS.Sub, Seq(x1, rewrite(y)), transform(body))
268
269
270
271
272
        }
      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
273
              L.LetP(n, CPS.Add, Seq(z, L.AtomL(1)), transform(body))
274
275
276
            }
          }
        }
Sapphie's avatar
Sapphie committed
277
278

      // I don't think there is a way to do this in a smart way
Sapphie's avatar
Sapphie committed
279
280
      case L3.IntDiv => rawBinaryTree(CPS.Div)
      case L3.IntMod => rawBinaryTree(CPS.Mod)
Sapphie's avatar
Sapphie committed
281
282
283
284
285

      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
286
              L.LetP(n, CPS.Add, Seq(z, L.AtomL(1)), transform(body))
Sapphie's avatar
Sapphie committed
287
288
289
290
291
292
293
            }
          }
        }

      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
294
            L.LetP(n, CPS.Or, Seq(z, L.AtomL(1)), transform(body))
Sapphie's avatar
Sapphie committed
295
296
297
          }
        }

Sapphie's avatar
Sapphie committed
298
      case L3.IntBitwiseAnd =>
Luca Bataillard's avatar
Luca Bataillard committed
299
        L.LetP(n, CPS.And, Seq(rewrite(x), rewrite(y)), transform(body))
Sapphie's avatar
Sapphie committed
300
301

      case L3.IntBitwiseOr =>
Luca Bataillard's avatar
Luca Bataillard committed
302
        L.LetP(n, CPS.Or, Seq(rewrite(x), rewrite(y)), transform(body))
Sapphie's avatar
Sapphie committed
303
304
305

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

Sapphie's avatar
Sapphie committed
309

310
      case L3.BlockAlloc(tag) => 
311
        tempLetP(CPS.ShiftRight, Seq(Left(x), lAtomOne)) { t1 =>
Luca Bataillard's avatar
Luca Bataillard committed
312
          L.LetP(n, CPS.BlockAlloc(tag), Seq(t1), transform(body))
313
        }
Sapphie's avatar
Sapphie committed
314
      case L3.BlockTag =>
315
        tempLetP(CPS.BlockTag, args map (Left(_))) { t1 =>
316
          tempLetP(CPS.ShiftLeft, Seq(Right(t1), lAtomOne)) { t2 =>
Luca Bataillard's avatar
Luca Bataillard committed
317
            L.LetP(n, CPS.Add, Seq(t2, L.AtomL(1)), transform(body))
318
319
320
          }
        }
      case L3.BlockLength => 
321
        tempLetP(CPS.BlockLength, args map (Left(_))) { t1 =>
322
          tempLetP(CPS.ShiftLeft, Seq(Right(t1), lAtomOne)) { t2 =>
Luca Bataillard's avatar
Luca Bataillard committed
323
            L.LetP(n, CPS.Add, Seq(t2, L.AtomL(1)), transform(body))
324
325
          }
        }
326
327
328
      case L3.BlockSet => 
        val block = rewrite(x)
        val value = rewrite(z)
329
        tempLetP(CPS.ShiftRight, Seq(Left(y), Right(L.AtomL(1)))){idx => 
Luca Bataillard's avatar
Luca Bataillard committed
330
          L.LetP(n, CPS.BlockSet, Seq(block, idx, value), transform(body))
331
        }
332
333
      case L3.BlockGet => 
        val block = rewrite(x)
334
        tempLetP(CPS.ShiftRight, Seq(Left(y), Right(L.AtomL(1)))){
Luca Bataillard's avatar
Luca Bataillard committed
335
          idx => L.LetP(n, CPS.BlockGet, Seq(block, idx), transform(body))
336
        }
337
338
339
      case L3.ByteRead =>
        tempLetP(CPS.ByteRead, Seq()){ t1 => 
          tempLetP(CPS.ShiftLeft, Seq(Right(t1), lAtomOne)) { t2 =>
Luca Bataillard's avatar
Luca Bataillard committed
340
            L.LetP(n, CPS.Add, Seq(t2, L.AtomL(1)), transform(body))
341
342
343
344
          }
        }
      case L3.ByteWrite => 
        tempLetP(CPS.ShiftRight, Seq(Left(x), lAtomOne)) { t1 => 
Luca Bataillard's avatar
Luca Bataillard committed
345
          L.LetP(n, CPS.ByteWrite, Seq(t1), transform(body))
346
        }
Sapphie's avatar
Sapphie committed
347
      case L3.CharToInt =>
Luca Bataillard's avatar
Luca Bataillard committed
348
        L.LetP(n, CPS.ShiftRight, Seq(rewrite(x), L.AtomL(2)), transform(body))
Sapphie's avatar
Sapphie committed
349
      case L3.Id =>
Sapphie's avatar
Sapphie committed
350
351
352
353
354
355
        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
356
      
357
358
      case L3.IntToChar => 
        tempLetP(CPS.ShiftLeft, Seq(Left(x), Right(L.AtomL(2)))){ t1 =>
Luca Bataillard's avatar
Luca Bataillard committed
359
          L.LetP(n, CPS.Add, Seq(t1, L.AtomL(2)), transform(body))
360
        }
Sapphie's avatar
Sapphie committed
361
362

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

Sapphie's avatar
Sapphie committed
366

Sapphie's avatar
Sapphie committed
367
368
369
370
  // 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
371
  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
372
      val lArgs = args.map {
373
374
        case Left(hAtom) => rewrite(hAtom)
        case Right(lAtom)  => lAtom
Sapphie's avatar
Sapphie committed
375
376
      }
      val tmpName = Symbol.fresh("x")
Sapphie's avatar
Sapphie committed
377
      val innerLetP: A = mkBody(L.AtomN(tmpName))
Sapphie's avatar
Sapphie committed
378
379
380
381
382
383
384
385
386
387
388
389
390
      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
391
}