structure Elab = struct structure StringMap = Map(type k = string val cmp = String.compare); fun primop (s : string) : Syntax.primop = case s of "exit" => Syntax.PExit | _ => raise Fail ("invalid op: " ^ s) fun elab (env : int StringMap.map) (p : Syntax.expr) : Syntax.lexp = case p of Syntax.EIdent [i] => (case StringMap.lookup i env of NONE => raise Fail ("unbound identifier " ^ i) | SOME x => Syntax.LVar x) | Syntax.EIdent _ => raise Fail "long identifiers are not supported" | Syntax.EBuiltin builtin => Syntax.LPrim (primop builtin) | Syntax.EInt i => Syntax.LInt i | Syntax.EStr s => Syntax.LString s | Syntax.ETuple exprs => Syntax.LRecord (map (elab env) exprs) | Syntax.EList exprs => foldr (fn (x, acc) => Syntax.LRecord [elab env x, acc]) (Syntax.LInt 0) exprs | Syntax.EApp (f, x) => Syntax.LApp (elab env f, elab env x) | Syntax.ETyped (e, _) => elab env e | Syntax.EAndAlso (_, _) => raise Fail "unimplemented" | Syntax.EOrElse (_, _) => raise Fail "unimplemented" | Syntax.ELet ([], body) => elab env body | Syntax.ELet (Syntax.DVal (pat, v) :: decls, body) => elab env (Syntax.ECase (v, [(pat, Syntax.ELet (decls, body))])) | Syntax.ELambda (pat, body) => let val v = Gensym.new () val env' = case pat of Syntax.PWild => env | Syntax.PVar name => StringMap.insert name v env in Syntax.LFn (v, elab env' body) end | Syntax.ECase (expr, []) => raise Fail "nonexhaustive match" | Syntax.ECase (expr, (pat, body) :: rest) => if rest <> [] then raise Fail "redundant match" else let val v = Gensym.new () in case pat of Syntax.PWild => Syntax.LApp (Syntax.LFn (v, elab env body), elab env expr) | Syntax.PVar name => Syntax.LApp (Syntax.LFn (v, elab (StringMap.insert name v env) body), elab env expr) end fun elaborate (p : Syntax.expr) : Syntax.lexp = elab StringMap.empty p end