Implement halt untagging and improve modulo representation

compiler/src/l3/CPSValueRepresenter.scala

@@ -28,7 +28,20 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
       L.AppC(cnt, lArgs)
     case H.If(cond, args, thenC, elseC) =>
       transformIf(cond, args, thenC, elseC)
-    case H.Halt(v) => L.Halt(rewrite(v))
+    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(_) => 
+        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)
+    }
+
+
     case _ => throw new Exception("Unimplemented: " + tree.getClass.toString)
   }
 
@@ -46,6 +59,52 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
     }
   }
 
+  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
+    val unitCheckCont = mkeCheckCont("unit_check",
+      transformIf(L3.UnitP, Seq(v), untagUnitCont.name, haltCont))
+
+    // If it's a boolean, untag it, otherwise check if it's a unit
+    val boolCheckCont = mkeCheckCont("bool_check",
+      transformIf(L3.BoolP, Seq(v), untagBoolCont.name, unitCheckCont.name))
+
+    // if it's a character, untag it, otherwise check if it's a boolean
+    val charCheckCont = mkeCheckCont("char_check",
+      transformIf(L3.CharP, Seq(v), untagCharCont.name, boolCheckCont.name))
+
+    //etc
+    val letCBody = transformIf(L3.IntP, Seq(v), untagIntCont.name, charCheckCont.name)
+
+    val conts = Seq(untagIntCont,
+                  untagCharCont,
+                  untagBoolCont,
+                  untagUnitCont,
+                  unitCheckCont,
+                  charCheckCont,
+                  boolCheckCont)
+    L.LetC(conts, letCBody)
+  }
+
   private def transformLetF(initialFuns: Seq[H.Fun], body: H.Tree)(implicit oldKnownFuns: KnownFunsMap): L.LetF = {
     
     def funsFV(definedFuns: Seq[H.Fun], prevKnownFuns: KnownFunsMap): Map[Symbol, Seq[Symbol]] = {      
@@ -268,7 +327,13 @@ object CPSValueRepresenter extends (H.Tree => L.Tree) {
 
       // I don't think there is a way to do this in a smart way
       case L3.IntDiv => rawBinaryTree(CPS.Div)
-      case L3.IntMod => rawBinaryTree(CPS.Mod)
+      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))
+          }
+        }
+      }
 
       case L3.IntShiftLeft =>
         tempLetP(CPS.Sub, Seq(Left(x), lAtomOne)) { x1 =>