diff options
| -rw-r--r-- | codegen.sml | 2 | ||||
| -rw-r--r-- | cps.sml | 38 | ||||
| -rw-r--r-- | elab.sml | 22 | ||||
| -rw-r--r-- | gensym.sml | 2 | ||||
| -rw-r--r-- | run_tests.fish | 2 |
5 files changed, 33 insertions, 33 deletions
diff --git a/codegen.sml b/codegen.sml index 67b2d30..0bd86be 100644 --- a/codegen.sml +++ b/codegen.sml @@ -162,7 +162,7 @@ struct | Syntax.CPrimop (Syntax.PEq, [x, y], [res], [k]) => Syntax.OEq (translate res, translateVal x, translateVal y) :: go k | Syntax.CPrimop (Syntax.PIf, [b], [], [k1, k2]) => let - val trueLabel = Gensym.new () + val trueLabel = GenSym.new () in Syntax.OIf (translateVal b, trueLabel) :: go k2 @@ -5,8 +5,8 @@ struct Syntax.LVar v => cont (Syntax.VVar v) | Syntax.LFn (v, expr) => let - val fnName = Gensym.new () - val k = Gensym.new () + val fnName = GenSym.new () + val k = GenSym.new () in Syntax.CFix ([(fnName, [v, k], toCPS expr (fn ret => Syntax.CApp (Syntax.VVar k, [ret])))], @@ -16,7 +16,7 @@ struct Syntax.CFix ( map (fn (name, arg, expr) => - let val w = Gensym.new () + let val w = GenSym.new () in ( name , [arg, w] @@ -28,7 +28,7 @@ struct ) | Syntax.LApp (Syntax.LPrim primop, Syntax.LRecord args) => let - val temp = Gensym.new () + 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 [] @@ -36,8 +36,8 @@ struct | 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 () + val addr = GenSym.new () + val arg = GenSym.new () in Syntax.CFix ([(addr, [arg], cont (Syntax.VVar arg))], toCPS f (fn f' => @@ -46,7 +46,7 @@ struct end | Syntax.LInt i => cont (Syntax.VInt i) | Syntax.LString s => - let val temp = Gensym.new () + let val temp = GenSym.new () in Syntax.CRecord ( [(map (fn c => (Syntax.VInt (Char.ord c), [])) (String.explode s), temp)] @@ -55,13 +55,13 @@ struct end | Syntax.LRecord [] => cont (Syntax.VInt 0) | Syntax.LSelect (i, expr) => - let val temp = Gensym.new () + let val temp = GenSym.new () in toCPS expr (fn x => Syntax.CSelect (i, x, temp, cont (Syntax.VVar temp))) end | Syntax.LRecord exprs => let fun go [] vars = - let val temp = Gensym.new () + let val temp = GenSym.new () in Syntax.CRecord ([(map (fn v => (v, [])) (rev vars), temp)], cont (Syntax.VVar temp)) end | go (expr :: exprs) vars = @@ -71,15 +71,15 @@ struct | Syntax.LSwitch (expr, arms, otherwise) => let val sortedArms = Sort.sort (fn ((x, _), (y, _)) => Int.compare (x, y)) arms - val contAddr = Gensym.new () - val otherwiseAddr = Gensym.new () - val arg = Gensym.new () + val contAddr = GenSym.new () + val otherwiseAddr = GenSym.new () + val arg = GenSym.new () fun go _ [] cont = Syntax.CApp (Syntax.VVar otherwiseAddr, []) | go v [(x, arm)] cont = (case otherwise of NONE => toCPS arm cont | SOME _ => - let val b = Gensym.new () + let val b = GenSym.new () in Syntax.CPrimop ( Syntax.PEq @@ -96,7 +96,7 @@ struct end) | go v arms cont = let - val b = Gensym.new () + val b = GenSym.new () val h = length arms div 2 val half1 = List.take (arms, h) val half2 = List.drop (arms, h) @@ -143,7 +143,7 @@ struct | funs (Syntax.CFix (fs, body)) acc = funs body (foldl (fn ((fName, fVars, fBody), acc) => (fName, fVars, exprs fBody) :: funs fBody acc) acc fs) | funs (Syntax.CPrimop (_, _, _, ks)) acc = foldl (fn (x, acc) => funs x acc) acc ks - val entryPoint = Gensym.new () + val entryPoint = GenSym.new () in Syntax.CFix ((entryPoint, [], exprs expr) :: funs expr [], Syntax.CApp (Syntax.VLabel entryPoint, [])) end @@ -227,7 +227,7 @@ struct Syntax.CSelect (i, translateValue arg, res, convertExpr varMap k) | Syntax.CApp (func, args) => let - val temp = Gensym.new () + val temp = GenSym.new () val f = translateValue func in Syntax.CSelect (0, f, temp, Syntax.CApp (Syntax.VVar temp, f :: map translateValue args)) @@ -239,15 +239,15 @@ struct (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 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) + (GenSym.new (), closure :: args, newBody) end) funcs val newBody = @@ -52,7 +52,7 @@ struct val (_, vars, types) = foldl (fn ((name, _), (i, vars, types)) => - (i + 1, StringMap.insert name (Gensym.new ()) vars, StringMap.insert name (i, nCons) types)) + (i + 1, StringMap.insert name (GenSym.new ()) vars, StringMap.insert name (i, nCons) types)) (0, #vars env, #types env) cons in Env { vars = vars, types = types, structTypes = #structTypes env } @@ -271,7 +271,7 @@ struct val env = foldl (fn ((name, _), env) => - bindVar name (Gensym.new ()) env) + bindVar name (GenSym.new ()) env) env bindings in @@ -290,7 +290,7 @@ struct val actions = actionVector env expr arms val actionFns = map - (fn a => (Gensym.new (), Gensym.new (), a)) + (fn a => (GenSym.new (), GenSym.new (), a)) actions val smallActions = map @@ -341,7 +341,7 @@ struct List.mapPartial (fn (_, (_, NONE)) => NONE | (i, (name, _)) => - let val v = Gensym.new () + let val v = GenSym.new () in SOME (lookupVar name env, v, Syntax.LRecord [Syntax.LInt i, Syntax.LVar v]) end) (enumerate cons) @@ -361,7 +361,7 @@ struct elab env (Syntax.ECase (v, [(pat, Syntax.ELet (decls, body))])) | Syntax.ELet (Syntax.DValRec (Syntax.PVar name, f as Syntax.ELambda _) :: decls, body) => let - val n = Gensym.new () + val n = GenSym.new () val env = bindVar name n env val (arg, fnBody) = case elab env f of @@ -378,10 +378,10 @@ struct in if not (List.all (fn (ps, _) => length ps = nPats) cases) then raise Fail "clauses do not all have same number of patterns" else let - val n = Gensym.new () - val temps = List.tabulate (nPats, fn _ => Gensym.new ()) + val n = GenSym.new () + val temps = List.tabulate (nPats, fn _ => GenSym.new ()) val env = bindVar name n env - val t = Gensym.new () + val t = GenSym.new () val innerCase = elabCase env (Syntax.LVar t) (map (fn (ps, b) => (Syntax.PTuple ps, b)) cases) in Syntax.LFix @@ -401,17 +401,17 @@ struct let val names = structBoundVars structDecls val tuple = elab env (Syntax.ELet (structDecls, Syntax.ETuple (map (fn n => Syntax.EIdent [n]) names))) - val v = Gensym.new () + val v = GenSym.new () val env = bindStructType name structDecls env val env = bindVar name v env in Syntax.LApp (Syntax.LFn (v, elab env (Syntax.ELet (decls, body))), tuple) end | Syntax.ELambda body => - let val v = Gensym.new () + let val v = GenSym.new () in Syntax.LFn (v, elabCase env (Syntax.LVar v) [body]) end | Syntax.ECase (expr, arms) => - let val v = Gensym.new () + let val v = GenSym.new () in Syntax.LApp (Syntax.LFn (v, elabCase env (Syntax.LVar v) arms), elab env expr) end @@ -1,4 +1,4 @@ -structure Gensym = +structure GenSym = struct val counter : int ref = ref 0 fun new () : int = (counter := (!counter + 1) ; !counter) diff --git a/run_tests.fish b/run_tests.fish index 1005fac..22c86d5 100644 --- a/run_tests.fish +++ b/run_tests.fish @@ -3,7 +3,7 @@ set d (realpath (status dirname)) cd $d/bytecode -cargo build +cargo build; or return cd $d |