diff --git a/impls/sml/env.sml b/impls/sml/env.sml index 60e0c480..f90849ba 100644 --- a/impls/sml/env.sml +++ b/impls/sml/env.sml @@ -1,7 +1,6 @@ type mal_defs = (string * mal_type) list datatype mal_env = ENV of mal_defs - | INNER of (mal_defs * mal_env) fun get (d:mal_defs) s = d |> List.find (eq s o #1) |> Option.map #2 @@ -9,10 +8,6 @@ fun get (d:mal_defs) s = fun set s v (d:mal_defs) = (s, v) :: (d |> List.filter (not o eq s o #1)) -fun def s v (INNER (d, out)) = INNER (set s v d, out) - | def s v (ENV d) = ENV (set s v d) +fun def s v (ENV d) = ENV (set s v d) -fun let_in s v out = INNER (set s v [], out) - -fun lookup (INNER (d, out)) s = optOrElse (get d s) (fn _ => lookup out s) - | lookup (ENV d) s = get d s +fun lookup (ENV d) s = get d s diff --git a/impls/sml/step3_env.sml b/impls/sml/step3_env.sml index bba1f2cc..5c45a2e8 100644 --- a/impls/sml/step3_env.sml +++ b/impls/sml/step3_env.sml @@ -5,10 +5,13 @@ fun READ s = readStr s fun EVAL e (LIST (SYMBOL "def!"::args)) = eval_def e args + | EVAL e (LIST (SYMBOL "let*"::args)) = eval_let e args | EVAL e (ast as (LIST (_::_))) = (e, eval_apply e ast) | EVAL e ast = (e, eval_ast e ast) -and eval_ast e (LIST l) = LIST (List.map (#2 o (EVAL e)) l) +and EVAL' e ast = (#2 o EVAL e) ast + +and eval_ast e (LIST l) = LIST (List.map (EVAL' e) l) | eval_ast e (SYMBOL s) = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) | eval_ast e ast = ast @@ -17,8 +20,15 @@ and eval_apply e ast = LIST ((FN f)::args) => f args | _ => raise NotApplicable "eval_apply needs a non-empty list" -and eval_def e [SYMBOL s, ast] = let val (_, v) = EVAL e ast in (def s v e, v) end - | eval_def _ _ = raise NotApplicable "define needs a symbol and a value" +and eval_def e [SYMBOL s, ast] = let val v = EVAL' e ast in (def s v e, v) end + | eval_def _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate" + +and eval_let e [LIST bindings, ast] = (e, EVAL' (bind bindings e) ast) + | eval_let _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate" + +and bind (SYMBOL s::v::rest) e = def s (EVAL' e v) e |> bind rest + | bind [] e = e + | bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs" fun PRINT f = prStr f @@ -39,20 +49,20 @@ fun malMinus (INT b, INT a) = INT (a - b) fun malDiv (INT b, INT a) = INT (a div b) | malDiv _ = raise NotApplicable "can only divide integers" -val initEnv = - [] |> set "+" - (FN (foldl malPlus (INT 0))) - |> set "*" - (FN (foldl malTimes (INT 1))) - |> set "-" - (FN (fn [x] => malMinus (x, INT 0) - | x::xs => foldr malMinus x xs - | _ => raise NotApplicable "'-' requires arguments")) - |> set "/" - (FN (fn [x] => malDiv (x, INT 1) - | x::xs => foldr malDiv x xs - | _ => raise NotApplicable "'/' requires arguments")) - |> ENV +val initEnv = ENV [] |> bind [ + SYMBOL "+", + FN (foldl malPlus (INT 0)), + SYMBOL "*", + FN (foldl malTimes (INT 1)), + SYMBOL "-", + FN (fn [x] => malMinus (x, INT 0) + | x::xs => foldr malMinus x xs + | _ => raise NotApplicable "'-' requires arguments"), + SYMBOL "/", + FN (fn [x] => malDiv (x, INT 1) + | x::xs => foldr malDiv x xs + | _ => raise NotApplicable "'/' requires arguments") +] fun repl () = repl' initEnv