From b3f2fd686bc781996687deaadbe721b3300e4aba Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Fri, 10 Feb 2023 15:06:47 -0800 Subject: Write a first draft of the compiler. Sorry I haven't been better about these commit messages. You're not my mom. --- buffer.sml | 51 +++++++++++++++++++ codegen.sml | 148 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ cps.sml | 161 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ elab.sml | 22 +++++++++ gensym.sml | 5 ++ linker.sml | 90 +++++++++++++++++++++++++++++++++ main.sml | 9 ++++ program.cm | 6 +++ syntax.sml | 121 ++++++++++++++++++++++++++++++++++++++++++++- 9 files changed, 612 insertions(+), 1 deletion(-) create mode 100644 buffer.sml create mode 100644 codegen.sml create mode 100644 cps.sml create mode 100644 elab.sml create mode 100644 gensym.sml create mode 100644 linker.sml create mode 100644 main.sml 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 -- cgit v1.3.1