Write a first draft of the compiler.

Sorry I haven't been better about these commit messages.
You're not my mom.

9 files changed, 612 insertions, 1 deletions

diff --git a/buffer.sml b/buffer.sml
new file mode 100644
index 0000000..03292bb
--- /dev/null
+++ b/buffer.sml
@@ -0,0 +1,51 @@
+structure Buffer =
+struct
+  fun append (a : Word8ArraySlice.slice) (b : Word8VectorSlice.slice) : Word8ArraySlice.slice =
+    let
+      val bLen = Word8VectorSlice.length b
+      val (base, i, aLen) = Word8ArraySlice.base a
+      val baseLen = Word8Array.length base
+    in
+      if i + aLen + bLen <= baseLen
+      then
+        (Word8ArraySlice.copyVec { src = b, dst = base, di = i + aLen } ;
+         Word8ArraySlice.slice (base, i, SOME (aLen + bLen)))
+      else
+        let val newBuf = Word8Array.array (baseLen * 2 + bLen, Word8.fromInt 0)
+        in
+          Word8ArraySlice.copy { src = a, dst = newBuf, di = 0 } ;
+          Word8ArraySlice.copyVec { src = b, dst = newBuf, di = aLen } ;
+          Word8ArraySlice.slice (newBuf, 0, SOME (aLen + bLen))
+        end
+    end
+
+  fun buf () : BinIO.outstream * Word8ArraySlice.slice ref =
+    let val buffer = ref (Word8ArraySlice.full (Word8Array.array (0, Word8.fromInt 0)))
+    in
+      (BinIO.mkOutstream
+        (BinIO.StreamIO.mkOutstream
+          (BinPrimIO.augmentWriter
+            (BinPrimIO.WR
+              { name = "buffer"
+              , chunkSize = 1
+              , writeVec =
+                  SOME
+                    (fn a =>
+                      (buffer := append (!buffer) a ;
+                       Word8VectorSlice.length a))
+              , writeArr = NONE
+              , writeVecNB = NONE
+              , writeArrNB = NONE
+              , block = SOME (fn () => ())
+              , canOutput = SOME (fn () => true)
+              , getPos = NONE
+              , setPos = NONE
+              , endPos = NONE
+              , verifyPos = NONE
+              , close = fn () => ()
+              , ioDesc = NONE
+              }),
+           IO.NO_BUF)),
+       buffer)
+    end
+end
diff --git a/codegen.sml b/codegen.sml
new file mode 100644
index 0000000..1f6a2a8
--- /dev/null
+++ b/codegen.sml
@@ -0,0 +1,148 @@
+structure CodeGen =
+struct
+  fun enumerate l = ListPair.zip (List.tabulate (length l, (fn x => x)), l)
+
+  (* There are 8 registers *)
+  val tempReg = 7
+
+  structure VarMap = Map (type k = Syntax.var
+                          val cmp = Int.compare)
+
+  fun cycle (outputs : Syntax.var VarMap.map) (output : Syntax.var) : Syntax.opcode list =
+    case VarMap.lookup output outputs of
+      NONE => Syntax.OShuf (output, Syntax.VVar tempReg) :: cycles outputs
+    | SOME input =>
+        Syntax.OShuf (output, Syntax.VVar input) :: cycle (VarMap.delete output outputs) input
+
+  and cycles (outputs : Syntax.var VarMap.map) : Syntax.opcode list =
+    case VarMap.lookupMin outputs of
+      NONE => []
+    | SOME (output, input) =>
+        Syntax.OShuf (tempReg, Syntax.VVar input) :: cycle (VarMap.delete output outputs) input
+
+  fun shuffle' (inputs : unit VarMap.map) (outputs : Syntax.var VarMap.map) : Syntax.opcode list =
+    case VarMap.lookupMin (VarMap.difference outputs inputs) of
+      NONE => cycles outputs
+    | SOME (output, input) =>
+        Syntax.OShuf (output, Syntax.VVar input) :: shuffle' (VarMap.delete input inputs) (VarMap.delete output outputs)
+
+  fun shuffle (args : Syntax.value list) : Syntax.opcode list =
+    let
+      val outputMap =
+        VarMap.fromList
+          (List.mapPartial
+            (fn (i, Syntax.VVar v) =>
+                  if i = v
+                  then NONE
+                  else SOME (i, v)
+              | _ => NONE)
+            (enumerate args))
+      val inputMap =
+        VarMap.fromList
+          (map
+            (fn (_, input) => (input, ()))
+            (VarMap.toList outputMap))
+      val constants =
+        List.mapPartial
+          (fn (_, Syntax.VVar _) => NONE
+            | (i, constArg) => SOME (Syntax.OShuf (i, constArg)))
+          (enumerate args)
+    in
+      shuffle' inputMap outputMap @ constants
+    end
+
+  fun buildVarMap (expr : Syntax.cexp) : Syntax.var VarMap.map =
+    let
+      val next = ref 0
+      fun insert v m =
+        let val this = !next
+        in
+          next := this + 1;
+          VarMap.insert v this m
+        end
+      fun go expr =
+        case expr of
+          Syntax.CRecord (_, res, k) => insert res (go k)
+        | Syntax.CSelect (_, _, res, k) => insert res (go k)
+        | Syntax.CApp _ => VarMap.empty
+        | Syntax.CFix (funcs, body) =>
+            let
+              val funcsVars =
+                foldl
+                  (fn ((_, args, body), acc) =>
+                    let
+                      val argsVars =
+                        foldl
+                          (fn ((i, arg), acc) => VarMap.insert arg i acc)
+                          VarMap.empty
+                          (ListPair.zip
+                            (List.tabulate (length args, fn x => x + 1),
+                             args))
+                      val bodyVars = buildVarMap body
+                    in VarMap.union (VarMap.union acc argsVars) bodyVars
+                    end)
+                  VarMap.empty
+                  funcs
+              val bodyVars = go body
+            in VarMap.union funcsVars bodyVars
+            end
+        | Syntax.CPrimop (_, _, res, k) =>
+            let
+              val resVars =
+                foldl
+                  (fn (v, acc) => insert v acc)
+                  VarMap.empty
+                  res
+              val kVars =
+                foldl
+                  (fn (expr, acc) => VarMap.union acc (go expr))
+                  VarMap.empty
+                  k
+            in
+              VarMap.union resVars kVars
+            end
+    in go expr
+    end
+
+  fun toASM (expr : Syntax.cexp) : Syntax.opcode list =
+    let
+      val varMap = buildVarMap expr
+      fun translate v = valOf (VarMap.lookup v varMap)
+      fun translateVal (Syntax.VVar v) = Syntax.VVar (translate v)
+        | translateVal x = x
+      fun go expr =
+        case expr of
+          Syntax.CRecord (args, res, k) =>
+            Syntax.OAlloc (translate res, Syntax.VInt (length args))
+            :: List.concat
+                (map
+                  (fn (i, (arg, path)) =>
+                    let val (temp, ops) =
+                      foldl
+                        (fn (off, (arg, ops)) =>
+                          (Syntax.VVar tempReg, Syntax.OPeek (tempReg, off, translateVal arg) :: ops))
+                        (arg, [])
+                        path
+                    in rev (Syntax.OPoke (i, translate res, temp) :: ops)
+                    end)
+                  (enumerate args))
+            @ toASM k
+        | Syntax.CSelect (i, arg, res, k) => Syntax.OPeek (translate res, i, translateVal arg) :: toASM k
+        | Syntax.CApp (func, args) => shuffle (func :: args) @ [Syntax.OCall]
+        | Syntax.CFix (funcs, body) =>
+            let
+              val bodyASM = toASM body
+              val funcsASM =
+                foldl
+                  (fn ((name, _, body), acc) =>
+                    Syntax.OLabel name :: go body @ acc)
+                  []
+                  funcs
+            in
+              bodyASM @ funcsASM
+            end
+        | Syntax.CPrimop (Syntax.PExit, [arg], _, _)=> [Syntax.OExit arg]
+        | _ => raise Fail ("malformed CPS:\n" ^ Syntax.cexpToString expr)
+    in go expr
+    end
+end
diff --git a/cps.sml b/cps.sml
new file mode 100644
index 0000000..948b8c8
--- /dev/null
+++ b/cps.sml
@@ -0,0 +1,161 @@
+structure CPS =
+struct
+  fun toCPS (e : Syntax.lexp) (cont : Syntax.value -> Syntax.cexp) : Syntax.cexp =
+    case e of
+      Syntax.LApp (Syntax.LPrim primop, Syntax.LRecord args) =>
+        let
+          val temp = Gensym.new ()
+          fun go [] acc = Syntax.CPrimop (primop, rev acc, [temp], [cont (Syntax.VVar temp)])
+            | go (arg :: args) acc = toCPS arg (fn arg' => go args (arg' :: acc))
+        in go args []
+        end
+    | Syntax.LApp (Syntax.LPrim primop, arg) => toCPS (Syntax.LApp (Syntax.LPrim primop, Syntax.LRecord [arg])) cont
+    | Syntax.LApp (f, x) =>
+        let
+          val addr = Gensym.new ()
+          val arg = Gensym.new ()
+        in Syntax.CFix
+          ([(addr, [arg], cont (Syntax.VVar arg))],
+           toCPS f (fn f' =>
+             toCPS x (fn x' =>
+               Syntax.CApp (f', [x', Syntax.VVar addr]))))
+        end
+    | Syntax.LInt i => cont (Syntax.VInt i)
+    | Syntax.LString s => cont (Syntax.VString s)
+    | Syntax.LRecord [] => cont (Syntax.VInt 0)
+    | Syntax.LRecord exprs =>
+        let
+          fun go [] vars =
+                let val temp = Gensym.new ()
+                in Syntax.CRecord (map (fn v => (v, [])) (rev vars), temp, cont (Syntax.VVar temp))
+                end
+            | go (expr :: exprs) vars =
+                toCPS expr (fn v => go exprs (v :: vars))
+        in go exprs []
+        end
+    | _ => raise Fail ("malformed expression " ^ Syntax.lexpToString e)
+
+  fun hoist (expr : Syntax.cexp) : Syntax.cexp =
+    let
+      fun funs (Syntax.CRecord (_, _, k)) acc = funs k acc
+        | funs (Syntax.CSelect (_, _, _, k)) acc = funs k acc
+        | funs (Syntax.CApp _) acc = acc
+        | funs (Syntax.CFix (fs, body)) acc = funs body (fs @ acc)
+        | funs (Syntax.CPrimop (_, _, _, ks)) acc = foldl (fn (x, acc) => funs x acc) acc ks
+
+      fun exprs (Syntax.CRecord (args, res, k)) = Syntax.CRecord (args, res, exprs k)
+        | exprs (Syntax.CSelect (i, arg, res, k)) = Syntax.CSelect (i, arg, res, exprs k)
+        | exprs (expr as Syntax.CApp (func, args)) = expr
+        | exprs (Syntax.CFix (_, body)) = body
+        | exprs (Syntax.CPrimop (p, args, res, ks)) = Syntax.CPrimop (p, args, res, (map exprs ks))
+      val entryPoint = Gensym.new ()
+    in
+      Syntax.CFix ((entryPoint, [], exprs expr) :: funs expr [], Syntax.CApp (Syntax.VLabel entryPoint, []))
+    end
+
+  structure VarMap = Map (type k = Syntax.var
+                          val cmp = Int.compare)
+
+  fun varSet (l : Syntax.var list) : unit VarMap.map = VarMap.fromList (map (fn x => (x, ())) l)
+
+  fun freeVars (expr : Syntax.cexp) : unit VarMap.map =
+    case expr of
+      Syntax.CRecord (args, res, k) =>
+        let
+          val argFreeVars = varSet (List.mapPartial (fn (Syntax.VVar v, _) => SOME v | _ => NONE) args)
+          val kFreeVars = VarMap.delete res (freeVars k)
+        in
+          VarMap.union argFreeVars kFreeVars
+        end
+    | Syntax.CSelect (_, arg, res, k) =>
+        let
+          val argFreeVars =
+            case arg of
+              Syntax.VVar v => varSet [v]
+            | _ => VarMap.empty
+          val kFreeVars = VarMap.delete res (freeVars k)
+        in
+          VarMap.union argFreeVars kFreeVars
+        end
+    | Syntax.CApp (func, args) =>
+        let
+          val funcFreeVars =
+            case func of
+              Syntax.VVar v => varSet [v]
+            | _ => VarMap.empty
+          val argFreeVars = varSet (List.mapPartial (fn Syntax.VVar v => SOME v | _ => NONE) args)
+        in
+          VarMap.union funcFreeVars argFreeVars
+        end
+    | Syntax.CFix (funs, body) =>
+        let
+          val names = varSet (map (fn (name, _, _) => name) funs)
+          val funsFreeVars = map (fn (name, args, fixBody) => VarMap.difference (freeVars fixBody) (varSet args)) funs
+          val bodyFreeVars = freeVars body
+        in
+          foldl (fn (x, acc) => VarMap.union acc (VarMap.difference x names)) VarMap.empty (bodyFreeVars :: funsFreeVars)
+        end
+    | Syntax.CPrimop (_, args, res, ks) =>
+        let
+          val argFreeVars = varSet (List.mapPartial (fn Syntax.VVar v => SOME v | _ => NONE) args)
+          val boundVars = varSet res
+          val kFreeVars = foldl (fn (x, acc) => VarMap.union acc x) VarMap.empty (map (fn k => VarMap.difference (freeVars k) boundVars) ks)
+        in
+          VarMap.union argFreeVars kFreeVars
+        end
+
+  fun freeVarsClosure (name, args, body) = map (fn (x, _) => x) (VarMap.toList (VarMap.difference (freeVars body) (varSet (name :: args))))
+
+  fun enumerate l = ListPair.zip (List.tabulate (length l, (fn x => x)), l)
+
+  fun convertExpr varMap expr =
+    let
+      fun translate var = getOpt (VarMap.lookup var varMap, var)
+      fun translateValue (Syntax.VVar v) = Syntax.VVar (translate v)
+        | translateValue v = v
+    in
+      case expr of
+        Syntax.CRecord (args, res, k) =>
+          Syntax.CRecord (map (fn (v, p) => (translateValue v, p)) args, res, convertExpr varMap k)
+      | Syntax.CSelect (i, arg, res, k) =>
+          Syntax.CSelect (i, translateValue arg, res, convertExpr varMap k)
+      | Syntax.CApp (func, args) =>
+          let val temp = Gensym.new ()
+          in Syntax.CSelect (0, translateValue func, temp,
+               Syntax.CApp (Syntax.VVar temp, map translateValue args))
+          end
+      | Syntax.CFix (funcs, body) =>
+          let
+            val convertedFuncs =
+              map
+                (fn this as (name, args, body) =>
+                  let
+                    val funcFreeVars = freeVarsClosure this
+                    val varMap' = VarMap.union varMap (VarMap.fromList (map (fn v => (v, Gensym.new ())) funcFreeVars))
+                    val closure = Gensym.new ()
+                    val newBody =
+                      foldl
+                        (fn ((i, x), acc) => Syntax.CSelect (i + 1, Syntax.VVar closure, valOf (VarMap.lookup x varMap'), acc))
+                        (convertExpr varMap' body)
+                        (enumerate funcFreeVars)
+                  in
+                    (Gensym.new (), closure :: args, newBody)
+                  end)
+                funcs
+            val newBody =
+              foldl
+                (fn ((old as (oldName, args, body), (newName, _, _)), acc) =>
+                  let val funcFreeVars = freeVarsClosure old
+                  in Syntax.CRecord ((Syntax.VLabel newName, []) :: map (fn v => (Syntax.VVar v, [])) funcFreeVars, oldName, acc)
+                  end)
+                body
+                (ListPair.zip (funcs, convertedFuncs))
+          in
+            Syntax.CFix (convertedFuncs, newBody)
+          end
+      | Syntax.CPrimop (p, args, res, ks) =>
+          Syntax.CPrimop (p, map translateValue args, res, map (convertExpr varMap) ks)
+    end
+
+  fun convertClosures (expr : Syntax.cexp) : Syntax.cexp = hoist (convertExpr VarMap.empty expr)
+end
diff --git a/elab.sml b/elab.sml
new file mode 100644
index 0000000..0838f38
--- /dev/null
+++ b/elab.sml
@@ -0,0 +1,22 @@
+structure Elab =
+struct
+  fun primop (s : string) : Syntax.primop =
+    case s of
+      "exit" => Syntax.PExit
+    | _ => raise Fail ("invalid op: " ^ s)
+
+  fun elaborate (p : Syntax.expr) : Syntax.lexp =
+    case p of
+      Syntax.EBuiltin builtin => Syntax.LPrim (primop builtin)
+    | Syntax.EIdent [i] => raise Fail "only primitive operations for now, no variables"
+    | Syntax.EInt i => Syntax.LInt i
+    | Syntax.EStr s => Syntax.LString s
+    | Syntax.ETuple exprs => Syntax.LRecord (map elaborate exprs)
+    | Syntax.EApp (f, x) => Syntax.LApp (elaborate f, elaborate x)
+    | Syntax.ETyped (e, _) => elaborate e
+    | Syntax.ELet (decls, body) =>
+        Syntax.LRecord
+          (map elaborate
+            (map (fn (Syntax.DVal e) => e) decls @ [body]))
+    | _ => raise Fail "elaborate: operation not supported"
+end
diff --git a/gensym.sml b/gensym.sml
new file mode 100644
index 0000000..7a5f123
--- /dev/null
+++ b/gensym.sml
@@ -0,0 +1,5 @@
+structure Gensym =
+struct
+  val counter : int ref = ref 0
+  fun new () : int = (counter := (!counter + 1) ; !counter)
+end
diff --git a/linker.sml b/linker.sml
new file mode 100644
index 0000000..b52e84b
--- /dev/null
+++ b/linker.sml
@@ -0,0 +1,90 @@
+structure Linker =
+struct
+  fun makeOpcode w code arg1Const arg2Const =
+    if code >= 0x40
+    then raise Fail "code is more than 6 bits"
+    else
+      let
+        val arg1Bit = if arg1Const then 2 else 0
+        val arg2Bit = if arg2Const then 1 else 0
+      in
+        BinIO.output1 (w, Word8.fromInt (code * 4 + arg1Bit + arg2Bit))
+      end
+
+  fun isConst (Syntax.VVar _) = false
+    | isConst _ = true
+
+  fun lowByte w n =
+    BinIO.output1 (w, Word8.fromInt (Word.toInt (Word.andb (n, Word.fromInt 0xff))))
+
+  fun writeInt w i =
+    let
+      val n = Word.fromInt i
+      fun go b =
+        if b < 8
+        then
+          (lowByte w (Word.>> (n, Word.fromInt (8 * b))) ;
+           go (b + 1))
+        else ()
+    in
+      go 0
+    end
+
+  structure IntMap = Map(type k = int val cmp = Int.compare);
+
+  fun encode (m : int IntMap.map) (w : BinIO.outstream) (oper : Syntax.opcode) : unit =
+    let
+      fun writeValue w (Syntax.VVar v) = writeInt w v
+        | writeValue w (Syntax.VLabel l) = writeInt w (getOpt (IntMap.lookup l m, 0))
+        | writeValue w (Syntax.VInt i) = writeInt w i
+        | writeValue w (Syntax.VString _) = raise Fail "I don't support strings yet"
+    in
+      case oper of
+        Syntax.OAlloc (r, v) =>
+          (makeOpcode w 1 (isConst v) false ;
+           writeInt w r ;
+           writeValue w v)
+      | Syntax.OCall =>
+          makeOpcode w 2 false false
+      | Syntax.OPoke (off, p, v) =>
+          (makeOpcode w 3 (isConst v) false ;
+           writeInt w off ;
+           writeInt w p ;
+           writeValue w v)
+      | Syntax.OPeek (r, off, v) =>
+          (makeOpcode w 4 (isConst v) false ;
+           writeInt w r ;
+           writeInt w off ;
+           writeValue w v)
+      | Syntax.OShuf (r, v) =>
+          (makeOpcode w 5 (isConst v) false ;
+           writeInt w r ;
+           writeValue w v)
+      | Syntax.OExit v =>
+          (makeOpcode w 6 (isConst v) false ;
+           writeValue w v)
+      | Syntax.OLabel _ => ()
+    end
+
+  fun link (program : Syntax.opcode list) : Word8Vector.vector =
+    let
+      val (w1, b1) = Buffer.buf ()
+      val labels =
+        foldl
+          (fn (x, acc) =>
+            (encode IntMap.empty w1 x ;
+             case x of
+               Syntax.OLabel l => IntMap.insert l (Word8ArraySlice.length (!b1)) acc
+             | _ => acc))
+          IntMap.empty
+          program
+      val (w, b) = Buffer.buf ()
+      fun go [] = ()
+        | go (oper :: program) =
+            (encode labels w oper ;
+             go program)
+    in
+      go program ;
+      Word8ArraySlice.vector (!b)
+    end
+end
diff --git a/main.sml b/main.sml
new file mode 100644
index 0000000..c020691
--- /dev/null
+++ b/main.sml
@@ -0,0 +1,9 @@
+fun parseFiles (filenames : string list) : (string, Syntax.dec list) Either.either =
+  let fun go [] acc = Either.Right (concat (rev acc))
+        | go (f :: fs) acc =
+            case Parser.parse f
+              Either.Right prog => go fs (prog :: acc)
+              err => err
+  in go [] filenames
+
+val _ = parseFiles (CommandLine.arguments ())
diff --git a/program.cm b/program.cm
index f0fc04f..b957215 100644
--- a/program.cm
+++ b/program.cm
@@ -1,8 +1,14 @@
 Group is
 
+codegen.sml
+cps.sml
 either.sml
+elab.sml
+gensym.sml
+linker.sml
 map.sml
 parser.sml
 syntax.sml
+buffer.sml
 
 $/basis.cm
diff --git a/syntax.sml b/syntax.sml
index fbb61bd..2e2cc11 100644
--- a/syntax.sml
+++ b/syntax.sml
@@ -1,9 +1,128 @@
 structure Syntax =
 struct
-  datatype expr = EIdent of string
+  (* SML syntax *)
+  datatype etype = Tyvar of string
+                 | Tycon of etype list * string
+                 | TyTuple of etype list
+                 | Tyfun of etype * etype
+
+  datatype expr = EIdent of string list
+                | EBuiltin of string
                 | EInt of int
                 | EStr of string
                 | ETuple of expr list
                 | EList of expr list
                 | EApp of expr * expr
+                | ETyped of expr * etype
+                | EAndAlso of expr * expr
+                | EOrElse of expr * expr
+                | ELet of dec list * expr
+
+  and dec = DVal of expr
+
+  (* Lambda language *)
+  datatype primop = PExit
+  datatype lexp = LApp of lexp * lexp
+                | LInt of int
+                | LString of string
+                | LRecord of lexp list
+                | LPrim of primop
+
+  (* CPS *)
+  type var = int
+  datatype value = VVar of var
+                 | VLabel of var
+                 | VInt of int
+                 | VString of string
+  datatype cexp = CRecord of (value * int list) list * var * cexp
+                | CSelect of int * value * var * cexp
+                | CApp of value * value list
+                | CFix of (var * var list * cexp) list * cexp
+                | CPrimop of primop * value list * var list * cexp list
+
+  datatype opcode = OAlloc of var * value
+                  | OCall
+                  | OPoke of int * var * value
+                  | OPeek of var * int * value
+                  | OShuf of var * value
+                  | OExit of value
+                  | OLabel of var
+
+  fun listToString (show : 'a -> string) (l : 'a list) =
+    "[" ^ String.concatWith ", " (map show l) ^ "]"
+
+  fun multilineListToString (show : string -> 'a -> string) (indent : string) (l : 'a list) =
+    case l of
+      [] => "[]"
+    | [x] => "[ " ^ show (indent ^ "  ") x ^ " ]"
+    | (x :: xs) =>
+        let val indent' = indent ^ "  "
+        in "[ " ^ show indent' x ^ concat (map (fn x => "\n" ^ indent ^ ", " ^ show indent' x) xs) ^ "\n" ^ indent ^ "]"
+        end
+
+  fun quote (s : string) : string = "\"" ^ String.toString s ^ "\""
+
+  fun etypeToString (x : etype) : string =
+    case x of
+      Tyvar s => "Tyvar " ^ quote s
+    | Tycon (args, con) => "Tycon (" ^ listToString etypeToString args ^ ", " ^ quote con ^ ")"
+    | TyTuple args => "TyTuple " ^ listToString etypeToString args
+    | Tyfun (a, b) => "Tyfun (" ^ etypeToString a ^ ", " ^ etypeToString b ^ ")"
+
+  fun exprToStringI (indent : string) (x : expr) : string =
+    let val self = exprToStringI indent
+    in case x of
+         EIdent i => "EIdent " ^ listToString quote i
+       | EBuiltin b => "EBuiltin " ^ quote b
+       | EInt i => "EInt " ^ Int.toString i
+       | EStr s => "EStr " ^ quote s
+       | ETuple xs => "ETuple " ^ listToString self xs
+       | EList l => "EList " ^ listToString self l
+       | EApp (f, x) => "EApp (" ^ self f ^ ", " ^ self x ^ ")"
+       | ETyped (e, t) => "ETyped (" ^ self e ^ ", " ^ etypeToString t ^ ")"
+       | EAndAlso (a, b) => "EAndAlso (" ^ self a ^ ", " ^ self b ^ ")"
+       | EOrElse (a, b) => "EOrElse (" ^ self a ^ ", " ^ self b ^ ")"
+       | ELet (decs, e) => "ELet (" ^ multilineListToString decToStringI indent decs ^ ", " ^ self e ^ ")"
+    end
+
+  and decToStringI (indent : string) (x : dec) : string =
+    case x of
+      DVal e => "DVal (" ^ exprToStringI indent e ^ ")"
+
+  val exprToString : expr -> string = exprToStringI ""
+
+  val decToString : dec -> string = decToStringI ""
+
+  fun primopToString (x : primop) : string =
+    case x of
+      PExit => "PExit"
+
+  fun lexpToString (x : lexp) : string =
+    case x of
+      LApp (a, b) => "LApp (" ^ lexpToString a ^ ", " ^ lexpToString b ^ ")"
+    | LInt i => "LInt " ^ Int.toString i
+    | LString s => "LString " ^ quote s
+    | LRecord l => "LRecord " ^ listToString lexpToString l
+    | LPrim p => "LPrim " ^ primopToString p
+
+  fun valueToString (x : value) : string =
+    case x of
+      VVar v => "VVar " ^ Int.toString v
+    | VLabel l => "VLabel " ^ Int.toString l
+    | VInt i => "VInt " ^ Int.toString i
+    | VString s => "VString " ^ quote s
+
+  fun cexpToStringI (indent : string) (x : cexp) : string =
+    let
+      val self = cexpToStringI indent
+      val newIndent = indent ^ "\t"
+    in case x of
+         CRecord (a, b, c) => "CRecord (" ^ listToString (fn (x, y) => "(" ^ valueToString x ^ ", " ^ listToString Int.toString y ^ ")") a ^ ", " ^ Int.toString b ^ ",\n" ^ indent ^ self c ^ ")"
+       | CSelect (a, b, c, d) => "CSelect (" ^ Int.toString a ^ ", " ^ valueToString b ^ ", " ^ Int.toString c ^ ",\n" ^ indent ^ self d ^ ")"
+       | CApp (a, b) => "CApp (" ^ valueToString a ^ ", " ^ listToString valueToString b ^ ")"
+       | CFix (a, b) => "CFix (" ^ multilineListToString (fn indent' => fn (x, y, z) => "(" ^ Int.toString x ^ ", " ^ listToString Int.toString y ^ ",\n" ^ indent' ^ "\t" ^ cexpToStringI (indent' ^ "\t") z) newIndent a ^ ",\n" ^ newIndent ^ cexpToStringI newIndent b ^ ")"
+       | CPrimop (a, b, c, d) => "CPrimop (" ^ primopToString a ^ ", " ^ listToString valueToString b ^ ", " ^ listToString Int.toString c ^ ",\n" ^ indent ^ multilineListToString cexpToStringI indent d ^ ")"
+    end
+
+  val cexpToString : cexp -> string = cexpToStringI ""
 end