# HG changeset patch # User Christian Urban # Date 1506420878 -3600 # Node ID 8e633f1d0d3897f05172d0366987ab36078b06bd # Parent d5476854428c8a36b390443efd7b1d5412073e6d added file diff -r d5476854428c -r 8e633f1d0d38 compiler.scala --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler.scala Tue Sep 26 11:14:38 2017 +0100 @@ -0,0 +1,801 @@ + +type Num = Int +type Idn = String + +var counter = -1 +// for generating new variables + +def Fresh(x: Idn) = { + counter += 1 + x ++ "_" ++ counter.toString() +} + +def commas(s: List[String]) : String = s match { + case Nil => "" + case s::Nil => s + case s::ss => s + "," + commas(ss) +} +def cutlines(s: List[String]) : String = s match { + case Nil => "" + case s::ss => s + "\n" + cutlines(ss) +} + + +abstract class Prim +case class PLUS() extends Prim { override def toString = " + " } +case class MINUS() extends Prim { override def toString = " - " } +case class MULT() extends Prim { override def toString = " * " } + +abstract class FTerm +case class FVar(x : Idn) extends FTerm { override def toString = x } +case class FNum(i : Num) extends FTerm { override def toString = i.toString } +case class FFix(x : Idn, x1: Idn, e : FTerm) extends FTerm { + override def toString = "fix " + x + "(" + x1 + ")" + "." + e +} +case class FApp(e1 : FTerm, e2 : FTerm) extends FTerm { + override def toString = "(" + e1 + ") (" + e2 + ")" +} +case class FTuple(es : List[FTerm]) extends FTerm { + override def toString = "<" + commas(es.map(_.toString)) + ">" +} +case class FProj(i : Num, e : FTerm) extends FTerm { + override def toString = "proj " + i.toString + " " + e +} +case class FPrimOp(e1 : FTerm, p : Prim, e2 : FTerm) extends FTerm { + override def toString = e1 + p.toString + e2 +} +case class FIf0(e1 : FTerm, e2 : FTerm, e3 : FTerm) extends FTerm { + override def toString = "if0(" + e1 + "," + e2 + "," + e3 + ")" +} + + +abstract class KTerm +abstract class KVal + +case class KApp(v : KVal, vs : List[KVal]) extends KTerm { + override def toString = v + "(" + commas(vs.map(_.toString)) + ")" +} +case class KIf0(v : KVal, e1 : KTerm, e2 : KTerm) extends KTerm { + override def toString = "if0(" + v + "," + e1 + "," + e2 + ")" +} +case class KHalt(v : KVal) extends KTerm { override def toString = "halt " + v } +case class KLet(x : Idn, v : KVal, e : KTerm) extends KTerm { + override def toString = "let " + x + " = " + v + " in " + e +} +case class KLetProj(x : Idn, i : Num, v : KVal, e : KTerm) extends KTerm { + override def toString = "let " + x + " =" + i + " " + v + " in " + e +} +case class KLetPrimOp(x : Idn, v1 : KVal, p : Prim, v2 : KVal, e : KTerm) extends KTerm { + override def toString = "let " + x + " = " + v1 + p + v2 + " in " + e +} + + +case class KVVar(x : Idn) extends KVal { override def toString = x } +case class KVNum(i : Num) extends KVal { override def toString = i.toString } +case class KVTuple(vs : List[KVal]) extends KVal { + override def toString = "<" + commas(vs.map(_.toString)) + ">" +} +case class KVFix(x : Idn, args : List[Idn], e : KTerm) extends KVal { + override def toString = "fix " + x + "(" + commas(args) + ")." + e +} + +// CPS tail translation +def CPST(e: FTerm) : (KVal => KTerm) = e match { + case FVar(x) => (c: KVal) => KApp(c, List(KVVar(x))) + case FNum(i) => (c: KVal) => KApp(c, List(KVNum(i))) + case FIf0(e1, e2, e3) => (c: KVal) => { + val e1_prime = CPS(e1) + val e2_prime = CPST(e2) + val e3_prime = CPST(e3) + e1_prime((y: KVal) => KIf0(y, e2_prime(c), e3_prime(c))) + } + case FPrimOp(e1, op, e2) => (c: KVal) => { + val z = Fresh("z") + val e1_prime = CPS(e1) + val e2_prime = CPS(e2) + e1_prime((y1: KVal) => + e2_prime((y2: KVal) => + KLetPrimOp(z, y1, op, y2, KApp(c, List(KVVar(z)))))) + } + case FFix(x, x1, e) => (c: KVal) => { + val c_prime = Fresh("c'") + val e_prime = CPST(e) + KApp(c, List(KVFix(x, List(x1, c_prime), e_prime(KVVar(c_prime))))) + } + case FApp(e1, e2) => (c: KVal) => { + val e1_prime = CPS(e1) + val e2_prime = CPS(e2) + e1_prime((y1: KVal) => + e2_prime((y2: KVal) => + KApp(y1, List(y2, c)))) + } + case FTuple(es) => (c: KVal) => { + def aux(es: List[FTerm], vs: List[KVal]) : KTerm = es match { + case Nil => KApp(c, vs.reverse) + case (e::es) => CPS(e)((y: KVal) => aux(es, y::vs)) + } + aux(es, Nil) + } + case FProj(i, e) => (c: KVal) => { + val z = Fresh("z") + CPS(e)((y: KVal) => KLetProj(z, i, y, KApp(c, List(KVVar(z))))) + } +} + +// CPS translation +def CPS(e: FTerm) : (KVal => KTerm) => KTerm = e match { + case FVar(i) => (k: KVal => KTerm) => k(KVVar(i)) + case FNum(i) => (k: KVal => KTerm) => k(KVNum(i)) + case FFix(x, x1, e) => (k: KVal => KTerm) => { + val c = Fresh("c") + val e_prime = CPST(e) + k(KVFix(x, List(x1, c), e_prime(KVVar(c)))) + } + case FApp(e1, e2) => (k: KVal => KTerm) => { + val fr = Fresh("") + val z = Fresh("z") + val e1_prime = CPS(e1) + val e2_prime = CPS(e2) + e1_prime((y1: KVal) => + e2_prime((y2: KVal) => + KApp(y1, List(y2, KVFix(fr, List(z), k(KVVar(z))))))) + } + case FIf0(e1, e2, e3) => (k: KVal => KTerm) => { + val fr = Fresh("") + val c = Fresh("c") + val z = Fresh("z") + val e1_prime = CPS(e1) + val e2_prime = CPST(e2) + val e3_prime = CPST(e3) + e1_prime((y: KVal) => + KLet(c, KVFix(fr, List(z), k(KVVar(z))), + KIf0(y, e2_prime(KVVar(c)), e3_prime(KVVar(c))))) + } + case FPrimOp(e1, op, e2) => (k: KVal => KTerm) => { + val z = Fresh("z") + val e1_prime = CPS(e1) + val e2_prime = CPS(e2) + e1_prime((y1: KVal) => e2_prime((y2: KVal) => KLetPrimOp(z, y1, op, y2, k(KVVar(z))))) + } + case FTuple(es) => (k: KVal => KTerm) => { + def aux(es: List[FTerm], vs: List[KVal]) : KTerm = es match { + case Nil => k(KVTuple(vs.reverse)) + case (e::es) => CPS(e)((y: KVal) => aux(es, y::vs)) + } + aux(es, Nil) + } + case FProj(i, e) => (k: KVal => KTerm) => { + val z = Fresh("z") + CPS(e)((y: KVal) => KLetProj(z, i, y, k(KVVar(z)))) + } +} + + + +//free variable function +def FVKval(v: KVal) : Set[Idn] = v match { + case KVVar(x) => Set(x) + case KVNum(i) => Set() + case KVTuple(vs) => vs.flatMap{FVKval}.toSet + case KVFix(x, args, e) => FVKexp(e) -- args - x +} + +def FVKexp(e: KTerm) : Set[Idn] = e match { + case KApp(v, vs) => FVKval(v) ++ vs.flatMap{FVKval}.toSet + case KIf0(v, e1, e2) => FVKval(v) ++ FVKexp(e1) ++ FVKexp(e2) + case KHalt(v) => FVKval(v) + case KLet(x, v, e) => FVKval(v) ++ (FVKexp(e) - x) + case KLetProj(x, i, v, e) => FVKval(v) ++ (FVKexp(e) - x) + case KLetPrimOp(x, v1, p, v2, e) => (FVKexp(e) - x) ++ FVKval(v1) ++ FVKval(v2) +} + + +abstract class CTerm +abstract class CVal + +case class CApp(v : CVal, vs : List[CVal]) extends CTerm { + override def toString = v + "(" + commas(vs.map(_.toString)) + ")" +} +case class CIf0(v : CVal, e1 : CTerm, e2 : CTerm) extends CTerm { + override def toString = "if0(" + v + "," + e1 + "," + e2 + ")" +} +case class CHalt(v : CVal) extends CTerm { override def toString = "halt " + v } +case class CLet(x : Idn, v : CVal, e : CTerm) extends CTerm { + override def toString = "let " + x + " = " + v + " in\n" + e +} +case class CLetProj(x : Idn, i : Num, v : CVal, e : CTerm) extends CTerm { + override def toString = "let " + x + " =" + i + " " + v + " in\n" + e +} +case class CLetPrimOp(x : Idn, v1 : CVal, p : Prim, v2 : CVal, e : CTerm) extends CTerm { + override def toString = "let " + x + " =" + v1 + p + v2 + " in\n" + e +} + +case class CVVar(x : Idn) extends CVal { override def toString = x } +case class CVNum(i : Num) extends CVal { override def toString = i.toString } +case class CVTuple(vs : List[CVal]) extends CVal { + override def toString = "<" + commas(vs.map(_.toString)) + ">" +} +case class CVFixCode(x : Idn, args : List[Idn], e : CTerm) extends CVal { + override def toString = "fixcode " + x + "(" + commas(args) + ")." + e +} + + + +// closure conversion +def CExp(e: KTerm) : CTerm = e match { + case KApp(v, vs) => { + val z = Fresh("z") + val z_code = Fresh("zcode") + val z_env = Fresh("zenv") + CLet(z, CVal(v), + CLetProj(z_code, 0, CVVar(z), + CLetProj(z_env, 1, CVVar(z), + CApp(CVVar(z_code), CVVar(z_env) :: vs.map{CVal})))) + } + case KIf0(v, e1, e2) => CIf0(CVal(v), CExp(e1), CExp(e2)) + case KHalt(v) => CHalt(CVal(v)) + case KLet(x, v, e) => CLet(x, CVal(v), CExp(e)) + case KLetProj(x, i, v, e) => CLetProj(x, i, CVal(v), CExp(e)) + case KLetPrimOp(x, v1, p, v2, e) => CLetPrimOp(x, CVal(v1), p, CVal(v2), CExp(e)) +} + +def CVal(v: KVal) : CVal = v match { + case KVVar(x) => CVVar(x) + case KVNum(i) => CVNum(i) + case KVTuple(vs) => CVTuple(vs.map{CVal}) + case KVFix(x, args, e) => { + val x_env = Fresh(x + ".env") + val ys = FVKval(KVFix(x, args, e)).toList + val ys_index = + ys.zipWithIndex.foldRight(CExp(e)) {case ((x, n), e) => CLetProj(x, n, CVVar(x_env), e) } + val v_code = CVFixCode(x, x_env :: args, ys_index) + val v_env = CVTuple(ys.map{CVVar(_)}) + CVTuple(List(v_code, v_env)) + } +} + +abstract class HTerm +abstract class HVal { + def eval(env: Map[Idn, HVal]) : HVal +} + +case class HApp(v : HVal, vs : List[HVal]) extends HTerm { + override def toString = v + "(" + commas (vs.map(_.toString)) + ")" +} +case class HIf0(v : HVal, e1 : HTerm, e2 : HTerm) extends HTerm { + override def toString = "if0(" + v + "," + e1 + "," + e2 + ")" +} +case class HHalt(v : HVal) extends HTerm { + override def toString = "halt " + v +} +case class HLet(x : Idn, v : HVal, e : HTerm) extends HTerm { + override def toString = "let " + x + " = " + v + " in\n" + e +} +case class HLetProj(x : Idn, i : Num, v : HVal, e : HTerm) extends HTerm { + override def toString = "let " + x + " =" + i + " " + v + " in\n" + e +} +case class HLetPrimOp(x : Idn, v1 : HVal, p : Prim, v2 : HVal, e : HTerm) extends HTerm { + override def toString = "let " + x + " = " + v1 + p + v2 + " in\n" + e +} + +case class HVVar(x : Idn) extends HVal { + override def toString = x + def eval(env: Map[Idn, HVal]) : HVal = env(x) +} +case class HVNum(i : Num) extends HVal { + override def toString = i.toString + def eval(env: Map[Idn, HVal]) : HVal = HVNum(i) +} +case class HVTuple(vs : List[HVal]) extends HVal { + override def toString = "<" + commas (vs.map(_.toString)) + ">" + def eval(env: Map[Idn, HVal]) : HVal = HVTuple(vs.map(_.eval(env))) +} +case class HVLabel(l: Idn) extends HVal { + override def toString = l + def eval(env: Map[Idn, HVal]) : HVal = HVLabel(l) +} + + +case class HBlock(args: List[Idn], term: HTerm) { + override def toString = "code(" + commas(args) + ").\n" + term + "\n" +} + +case class HProg(blocks: Map[Idn, HBlock], term: HTerm) { + override def toString = "\nheap:\n" + + cutlines(blocks.toList.map(_ match { case (x, y) => x + " -> " + y.toString })) + + "in start:\n" + term.toString + + def run_block(pretty: Boolean, l: Idn, as: List[HVal], env: Map[Idn, HVal]) : Unit = { + val blk = blocks(l) + val env_prime = (blk.args zip as).toMap + if (pretty) println("Referenced: " + l + " -> " + blk) + run(pretty, blk.term, env ++ env_prime) + } + + def run(pretty: Boolean, e: HTerm, env: Map[Idn, HVal]) : Unit = { + if (pretty) println("Env:" + env.toList.length + " stored values)\n" + + cutlines(env.toList.sortBy {_._1}.map(_.toString))) + if (pretty) println("Term:\n" + e.toString) + if (pretty) Console.readLine + e match { + case HHalt(v) => println ("Finished with result " + v.eval(env)) + case HApp(v, vs) => (v.eval(env), vs.map(_.eval(env))) match { + case (HVLabel(l), vs) => run_block(pretty, l, vs, env) + case _ => throw new IllegalArgumentException("not a label") + } + case HLet(x, v, e) => run(pretty, e, env + (x -> v.eval(env))) + case HLetProj(x, i, v, e) => v.eval(env) match { + case HVTuple(vs) => run(pretty, e, env + (x -> vs(i))) + case _ => throw new IllegalArgumentException("not a tuple") + } + case HLetPrimOp(x, v1, p, v2, e) => (v1.eval(env), p, v2.eval(env)) match { + case (HVNum(m), PLUS(), HVNum(n)) => run(pretty, e, env + (x -> HVNum(m + n))) + case (HVNum(m), MINUS(), HVNum(n)) => run(pretty, e, env + (x -> HVNum(m - n))) + case (HVNum(m), MULT(), HVNum(n)) => run(pretty, e, env + (x -> HVNum(m * n))) + case _ => throw new IllegalArgumentException("not a number") + } + case HIf0(v, e1, e2) => v.eval(env) match { + case HVNum(0) => run(pretty, e1, env) + case _ => run(pretty, e2, env) + } + } + } + + def run_prog(pretty: Boolean) = run(pretty, term, Map()) +} + + + +// hoisting +def H(e: CTerm, ls: Map[Idn, HVal]) : (HTerm, Map[Idn, HBlock]) = e match { + case CApp(v, vs) => { + val (v_prime, hs) = HV(v, ls) + val (vs_prime, hss) = vs.map{HV(_, ls)}.unzip + (HApp(v_prime, vs_prime), hs ++ hss.flatten) + } + case CIf0(v, e1, e2) => { + val (v_prime, hs1) = HV(v, ls) + val (e1_prime, hs2) = H(e1, ls) + val (e2_prime, hs3) = H(e2, ls) + (HIf0(v_prime, e1_prime, e2_prime), hs1 ++ hs2 ++ hs3) + } + case CHalt(v) => { + val (v_prime, hs) = HV(v, ls) + (HHalt(v_prime), hs) + } + case CLet(x, v, e) => { + val (v_prime, hs1) = HV(v, ls) + val (e_prime, hs2) = H(e, ls) + (HLet(x, v_prime, e_prime), hs1 ++ hs2) + } + case CLetProj(x, i, v, e) => { + val (v_prime, hs1) = HV(v, ls) + val (e_prime, hs2) = H(e, ls) + (HLetProj(x, i, v_prime, e_prime), hs1 ++ hs2) + } + case CLetPrimOp(x, v1, p, v2, e) => { + val (v1_prime, hs1) = HV(v1, ls) + val (v2_prime, hs2) = HV(v2, ls) + val (e_prime, hs3) = H(e, ls) + (HLetPrimOp(x, v1_prime, p, v2_prime, e_prime), hs1 ++ hs2 ++ hs3) + } +} + +def HV(v: CVal, ls: Map[Idn, HVal]) : (HVal, Map[Idn, HBlock]) = v match { + case CVVar(x) => ls.get(x) match { + case Some(v) => (v, Map()) + case None => (HVVar(x), Map()) + } + case CVNum(i) => (HVNum(i), Map()) + case CVTuple(vs) => { + val (vs_prime, hss) = vs.map{HV(_, ls)}.unzip + (HVTuple(vs_prime), hss.flatten.toMap) + } + case CVFixCode(x, args, e) => { + val l = Fresh(x + ".block") + val (e_prime, hs) = H(e, ls + (x -> HVTuple(List(HVLabel(l), HVVar(args.head))))) + (HVLabel(l), hs + (l -> HBlock(args, e_prime))) + } +} + +def HP(e: CTerm) = { + val (e_prime, hs) = H(e, Map()) + HProg(hs, e_prime) +} + + +abstract class TALVal { + def eval(regs: Map[Idn, TALVal]) : TALVal +} +abstract class TALInstr { + def update_regs(regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = regs +} + +case class TALReg(r: Idn) extends TALVal { + override def toString = r + def eval(regs: Map[Idn, TALVal]) = regs(r).eval(regs) +} +case class TALLabel(l: Idn) extends TALVal { + override def toString = l + def eval(regs: Map[Idn, TALVal]) = TALLabel(l) +} +case class TALNum(i: Int) extends TALVal { + override def toString = i.toString + def eval(regs: Map[Idn, TALVal]) = TALNum(i) +} +case class TALTuple(vs: List[TALVal]) extends TALVal { + override def toString = "<" + commas (vs.map(_.toString)) + ">" + def eval(regs: Map[Idn, TALVal]) = TALTuple(vs.map(_.eval(regs))) +} + + +case class TALAdd(r1: Idn, r2: Idn, v: TALVal) extends TALInstr { + override def toString = "Add " + r1 + " " + r2 + " " + v + override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = (regs(r2), v) match { + case (TALNum(n), TALNum(m)) => regs + (r1 -> TALNum(n + m)) + case (TALNum(n), TALReg(r3)) => regs(r3) match { + case TALNum(m) => regs + (r1 -> TALNum (n + m)) + case _ => throw new IllegalArgumentException("not a number") + } + case _ => throw new IllegalArgumentException("not a number") + } +} +case class TALSub(r1: Idn, r2: Idn, v: TALVal) extends TALInstr { + override def toString = "Sub " + r1 + " " + r2 + " " + v + override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = (regs(r2), v) match { + case (TALNum(n), TALNum(m)) => regs + (r1 -> TALNum(n - m)) + case (TALNum(n), TALReg(r3)) => regs(r3) match { + case TALNum(m) => regs + (r1 -> TALNum (n - m)) + case _ => throw new IllegalArgumentException("not a number") + } + case _ => throw new IllegalArgumentException("not a number") + } +} +case class TALMul(r1: Idn, r2: Idn, v: TALVal) extends TALInstr { + override def toString = "Mul " + r1 + " " + r2 + " " + v + override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = (regs(r2), v) match { + case (TALNum(n), TALNum(m)) => regs + (r1 -> TALNum (n * m)) + case (TALNum(n), TALReg(r3)) => regs(r3) match { + case TALNum(m) => regs + (r1 -> TALNum (n * m)) + case _ => throw new IllegalArgumentException("not a number") + } + case _ => throw new IllegalArgumentException("not a number") + } +} +case class TALBnz(r: Idn, v: TALVal) extends TALInstr { + override def toString = "Bnz " + r + " " + v +} +case class TALMov(r: Idn, v: TALVal) extends TALInstr { + override def toString = "Mov " + r + " " + v + override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = v match { + case TALReg(r1) => regs + (r -> regs(r1)) + case _ => regs + (r -> v) + } +} +case class TALProj(r1: Idn, r2: Idn, i: Num) extends TALInstr { + override def toString = "Ldi " + r1 + " <- " + r2 + "[" + i + "]" + override def update_regs (regs: Map[Idn, TALVal]) : Map[Idn, TALVal] = { + regs(r2) match { + case TALTuple(vs) => regs + (r1 -> vs(i)) + case _ => throw new IllegalArgumentException("not a tuple: ") + } + } +} + +case class TALJmp(v: TALVal) extends TALInstr { + override def toString = "Jmp " + v +} +case class TALHalt() extends TALInstr { + override def toString = "halt" +} + + +case class TALBlock(regs: List[Idn], cs: List[TALInstr]) { + override def toString = "code(" + commas(regs) + ").\n" + cutlines(cs.map{_.toString}) + "\n" +} + +case class TALProg(blocks: Map[Idn, TALBlock], start: List[TALInstr]) { + override def toString = "heap:\n" + + cutlines(blocks.toList.map(_ match { case (x, y) => x + " -> " + y.toString })) + + "start block:\n" + cutlines(start.map(_.toString)) + + def run_block(pretty: Boolean, l: Idn, regs: Map[Idn, TALVal]) : Unit = { + val blk = blocks(l) + if (pretty) println("Referenced: " + l + " -> " + blk) + val regs_prime = for ((r, n) <- blk.regs.zipWithIndex) yield (r, TALReg("RArg_" + n.toString).eval(regs)) + run(pretty, blk.cs, regs ++ regs_prime.toMap) + } + + def run(pretty: Boolean, cs: List[TALInstr], regs: Map[Idn, TALVal]) : Unit = { + if (pretty) println("Regs:(" + regs.toList.length + " stored values)\n" + + cutlines(regs.toList.sortBy {_._1}.map(_.toString))) + if (pretty) println("Instrs:\n" + cutlines(cs.map(_.toString))) + if (pretty) Console.readLine + cs match { + case (TALHalt() :: _) => println ("Finished with result " + regs("RArg_0")) + case (TALJmp(TALLabel(l)) :: _) => run_block(pretty, l, regs) + case (TALJmp(TALReg(r)) :: _) => regs(r) match { + case TALLabel(l) => run_block(pretty, l, regs) + case _ => throw new IllegalArgumentException("jump to non-label") + } + case (TALBnz(r, TALLabel(l)) :: cs) => regs(r) match { + case TALNum(0) => run(pretty, cs, regs) + case _ => run_block(pretty, l, regs) + } + case (c :: cs) => run(pretty, cs, c.update_regs(regs)) + case Nil => throw new IllegalArgumentException("no instruction left") + } + } + + def run_prog(pretty: Boolean) : Unit = run(pretty, start, Map()) +} + +def mk_vreg(s: String) = "Reg_" + s +def mk_areg(i: Int) = "RArg_" + i.toString + + +def Tval(v: HVal) : TALVal = v match { + case HVVar(x) => TALReg("Reg_" + x) + case HVNum(i) => TALNum(i) + case HVTuple(vs) => TALTuple(vs.map(Tval)) + case HVLabel(l) => TALLabel(l) +} + +def Texp(e: HTerm) : (Map[Idn, TALBlock], List[TALInstr]) = e match { + case HApp(v, vs) => { + val fr_reg0 = Fresh("r0") + val fr_regs = vs.map((v) => Fresh("r")) + val movs0 = List(TALMov(fr_reg0, Tval(v))) + val movs1 = for ((r, v) <- (fr_regs zip vs)) yield TALMov(r, Tval(v)) + val movs2 = for ((r, i) <- fr_regs.zipWithIndex) yield TALMov(mk_areg(i), TALReg(r)) + val movs3 = List(TALJmp(TALReg(fr_reg0))) + (Map(), movs0 ::: movs1 ::: movs2 ::: movs3) + } + case HIf0(v, e1, e2) => { + val l = Fresh("else_branch") + val r = Fresh("r") + val (h1, comp1) = Texp(e1) + val (h2, comp2) = Texp(e2) + val code = List(TALMov(r, Tval(v)), TALBnz(r, TALLabel(l))) + val h3 = TALBlock(Nil, comp2) + (h1 ++ h2 + (l -> h3), code ::: comp1) + } + case HHalt(v) => { + (Map(), List(TALMov(mk_areg(0), Tval(v)), TALHalt())) + } + case HLet(x, v, e) => { + val (h, comp) = Texp(e) + val code = TALMov(mk_vreg(x), Tval(v)) + (h, code :: comp) + } + case HLetPrimOp(x, v1, PLUS(), v2, e) => { + val r = mk_vreg(x) + val (h, comp) = Texp(e) + val code = List(TALMov(r, Tval(v1)), TALAdd(r, r, Tval(v2))) + (h, code ::: comp) + } + case HLetPrimOp(x, v1, MINUS(), v2, e) => { + val r = mk_vreg(x) + val (h, comp) = Texp(e) + val code = List(TALMov(r, Tval(v1)), TALSub(r, r, Tval(v2))) + (h, code ::: comp) + } + case HLetPrimOp(x, v1, MULT(), v2, e) => { + val r = mk_vreg(x) + val (h, comp) = Texp(e) + val code = List(TALMov(r, Tval(v1)), TALMul(r, r, Tval(v2))) + (h, code ::: comp) + } + case HLetProj(x, i, v, e) => { + val r = mk_vreg(x) + val (h, comp) = Texp(e) + val code = List(TALMov(r, Tval(v)), TALProj(r, r, i)) + (h, code ::: comp) + } +} + +def Tblock(l: Idn, hb: HBlock) : List[(Idn, TALBlock)] = hb match { + case HBlock(args, e) => { + val (h, comp) = Texp(e) + (l, TALBlock(args.map("Reg_" + _), comp)) :: h.toList + } +} + +def Tprog(prog: HProg) = prog match { + case HProg(heaps, e) => { + val (hs, comp) = Texp(e) + val heap_prime = for ((l, hb) <- heaps) yield Tblock(l, hb) + TALProg(hs ++ heap_prime.flatten.toMap, comp) + } +} + +/* Simple examples + +// tuple <1,2,3> +val prog0 = FTuple(List(FNum(1), FNum(2), FNum(3))) +val Kresult0 = CPS(prog0)((y:KVal) => KHalt(y)) +val Cresult0 = CExp(Kresult0) +val Hresult0 = HP(Cresult0) +val Tresult0 = Tprog(Hresult0) + +println("tuple example: \n") +println("F: " + prog0.toString) +println("K: " + Kresult0.toString) +println("C: " + Cresult0.toString) +println("H: " + Hresult0.toString) +println("T: " + Tresult0.toString + "\n") +Tresult0.run_prog(true) +Console.readLine + +// tuple Proj 1 <1,2,3> +val prog1 = FProj(1, FTuple(List(FNum(1), FNum(2), FNum(3)))) +val Kresult1 = CPS(prog1)((y:KVal) => KHalt(y)) +val Cresult1 = CExp(Kresult1) +val Hresult1 = HP(Cresult1) +val Tresult1 = Tprog(Hresult1) + +println("tuple - proj: \n") +println("F: " + prog1.toString) +println("K: " + Kresult1.toString) +println("C: " + Cresult1.toString) +println("H: " + Hresult1.toString) +println("T: " + Tresult1.toString + "\n") +Tresult1.run_prog(true) +Console.readLine + +// 3 + 4 +val prog2 = FPrimOp(FNum(3),PLUS(),FNum(4)) +val Kresult2 = CPS(prog2)((y:KVal) => KHalt(y)) +val Cresult2 = CExp(Kresult2) +val Hresult2 = HP(Cresult2) +val Tresult2 = Tprog(Hresult2) + +println("3 + 4: \n") +println("F: " + prog2.toString) +println("K: " + Kresult2.toString) +println("C: " + Cresult2.toString) +println("H: " + Hresult2.toString) +println("T: " + Tresult2.toString + "\n") +Tresult2.run_prog(true) +Console.readLine + +// (fix f(x). 18 * x + 32) 24 +val d1 = FPrimOp(FPrimOp(FNum(18), MULT(), FVar("x")), PLUS(), FNum(32)) +val prog3 = FApp(FFix("f", "x", d1), FNum(24)) +val Kresult3 = CPS(prog3)((y:KVal) => KHalt(y)) +val Cresult3 = CExp(Kresult3) +val Hresult3 = HP(Cresult3) +val Tresult3 = Tprog(Hresult3) + +println("(fix f(x). 18 * x + 32) 24 \n") +println("F: " + prog3.toString + "\n") +println("K: " + Kresult3.toString + "\n") +println("C: " + Cresult3.toString + "\n") +println("H: " + Hresult3.toString + "\n") +Hresult3.run_prog(true) +Console.readLine +println("T: " + Tresult3.toString + "\n") +Tresult3.run_prog(true) +Console.readLine +*/ + + +/* +// twice-apply example +// fix twice(f)._(x). f (f x) +val fun = FFix("id", "x", FPrimOp(FVar("x"), MULT(), FVar("x"))) +val ffx = FApp(FVar("f"), FApp(FVar("f"), FVar("x"))) +val f1 = FFix("twice", "f", FFix("twicef", "x", ffx)) +val prog4 = FApp(FApp(f1, fun), FNum(2)) +val Kresult4 = CPS(prog4)((y:KVal) => KHalt(y)) +val Cresult4 = CExp(Kresult4) +val Hresult4 = HP(Cresult4) +val Tresult4 = Tprog(Hresult4) + +println("twice fun 2\n") +println("F: " + prog4.toString + "\n") +println("K: " + Kresult4.toString + "\n") +println("C: " + Cresult4.toString + "\n") +println("H: " + Hresult4.toString + "\n") +//Hresult4.run_prog(false) +//Console.readLine +println("T: " + Tresult4.toString + "\n") +Tresult4.run_prog(false) +Console.readLine +*/ + +/* +//identity function +//fix id(x). x +val id = FFix("id", "x", FVar("x")) +val id_three = FApp(id, FNum(3)) + +val Kresult5 = CPS(id_three)((y:KVal) => KHalt(y)) +val Cresult5 = CExp(Kresult5) +val Hresult5 = HP(Cresult5) +val Tresult5 = Tprog(Hresult5) + +println("id 3:") +println("F: " + id_three.toString) +println("K: " + Kresult5.toString + "\n") +println("C: " + Cresult5.toString + "\n") +println("H: " + Hresult5.toString + "\n") +println("T: " + Tresult5.toString + "\n") +Tresult5.run_prog(false) +Console.readLine +*/ + +/* +//example: factorial +val f = FVar("f") +val n = FVar("n") +val one = FNum(1) +val six = FNum(15) +val e0 = FPrimOp(n, MINUS(), one) +val e1 = FApp(f, e0) +val e2 = FPrimOp(n, MULT(), e1) +val fact: FTerm = FFix("f", "n", FIf0(n, one, e2)) +val fact_six = FApp(fact, six) + + +val Kresult6 = CPS(fact_six)((y:KVal) => KHalt(y)) +val Cresult6 = CExp(Kresult6) +val Hresult6 = HP(Cresult6) +val Tresult6 = Tprog(Hresult6) + +println("fact 6: \n") +println("F: " + fact_six) +Console.readLine +println("K: " + Kresult6.toString + "\n") +Console.readLine +println("C: " + Cresult6.toString + "\n") +Console.readLine +println("H: " + Hresult6.toString + "\n") +println("-----------------------------") +println("Execution") +Hresult6.run_prog(false) +Console.readLine +println("T: " + Tresult6.toString + "\n") +println("-----------------------------") +println("Execution") +Tresult6.run_prog(false) +Console.readLine +*/ + + +//example: fibonacci +// fib(n).if0(n, 1,if0(n - 1, 1, fib(n - 1) + fib(n - 2))) +val fib = FVar("fib") +val n = FVar("n") +val one = FNum(1) +val two = FNum(2) +val minus_one = FPrimOp(n, MINUS(), one) +val minus_two = FPrimOp(n, MINUS(), two) +val fibonacci = + FFix("fib", "n", + FIf0(n, one, + FIf0(minus_one, one, FPrimOp(FApp(fib, minus_one), PLUS(), FApp(fib, minus_two))))) +val fib_apply = FApp(fibonacci, FNum(4)) + +val Kresult7 = CPS(fib_apply)((y:KVal) => KHalt(y)) +val Cresult7 = CExp(Kresult7) +val Hresult7 = HP(Cresult7) +val Tresult7 = Tprog(Hresult7) + +println("fib: \n") +println("F: " + fib_apply) +Console.readLine +println("K: " + Kresult7.toString + "\n") +Console.readLine +println("C: " + Cresult7.toString + "\n") +Console.readLine +println("H: " + Hresult7.toString + "\n") +println("-----------------------------") +println("H Prog") +Hresult7.run_prog(false) +Console.readLine +println("T: " + Tresult7.toString + "\n") +println("-----------------------------") +println("TAL") +Tresult7.run_prog(false) +Console.readLine