diff --git a/impls/sml/env.sml b/impls/sml/env.sml index 91814e15..60e0c480 100644 --- a/impls/sml/env.sml +++ b/impls/sml/env.sml @@ -9,5 +9,10 @@ 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 lookup (INNER (d, out)) s = (case get d s of NONE => lookup out s | x => x) +fun def s v (INNER (d, out)) = INNER (set s v d, out) + | 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 diff --git a/impls/sml/step3_env.sml b/impls/sml/step3_env.sml index e9b562f2..bba1f2cc 100644 --- a/impls/sml/step3_env.sml +++ b/impls/sml/step3_env.sml @@ -4,32 +4,31 @@ exception NotApplicable of string fun READ s = readStr s -fun EVAL e ast = - case ast of - LIST [] => ast - | LIST l => eval_apply e ast - | _ => eval_ast e ast +fun EVAL e (LIST (SYMBOL "def!"::args)) = eval_def e args + | EVAL e (ast as (LIST (_::_))) = (e, eval_apply e ast) + | EVAL e ast = (e, eval_ast e ast) -and eval_ast e ast = - case ast of - SYMBOL s => (case lookup e s of SOME v => v | NONE => raise NotDefined ("unable to resolve symbol '" ^ s ^ "'")) - | LIST l => LIST (List.map (EVAL e) l) - | _ => ast +and eval_ast e (LIST l) = LIST (List.map (#2 o (EVAL e)) l) + | eval_ast e (SYMBOL s) = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found")) + | eval_ast e ast = ast and eval_apply e ast = case eval_ast e ast of 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" + fun PRINT f = prStr f fun rep e s = - s |> READ |> EVAL e |> PRINT - handle Nothing => "" - | SyntaxError msg => "SYNTAX ERROR: " ^ msg - | NotApplicable msg => "CANNOT APPLY: " ^ msg - | NotDefined msg => "NOT DEFINED: " ^ msg + s |> READ |> EVAL e |> (fn (e, v) => (e, PRINT v)) + handle Nothing => (e, "") + | SyntaxError msg => (e, "SYNTAX ERROR: " ^ msg) + | NotApplicable msg => (e, "CANNOT APPLY: " ^ msg) + | NotDefined msg => (e, "NOT DEFINED: " ^ msg) fun malPlus (INT a, INT b) = INT (a + b) | malPlus _ = raise NotApplicable "can only add integers" @@ -55,14 +54,18 @@ val initEnv = | _ => raise NotApplicable "'/' requires arguments")) |> ENV -fun repl () = +fun repl () = repl' initEnv + +and repl' e = let open TextIO in ( print("user> "); case inputLine(stdIn) of - SOME(line) => ( - print((rep initEnv line) ^ "\n"); - repl () - ) + SOME(line) => + let val (e', s) = rep e line + val _ = print(s ^ "\n") + in + repl' e' + end | NONE => () ) end diff --git a/impls/sml/util.sml b/impls/sml/util.sml index 2913b5fc..cc44333c 100644 --- a/impls/sml/util.sml +++ b/impls/sml/util.sml @@ -5,3 +5,9 @@ and takeWhile' f acc [] = rev acc infix 3 |> fun x |> f = f x fun eq a b = a = b + +fun optOrElse NONE b = b () + | optOrElse a _ = a + +fun valOrElse (SOME x) _ = x + | valOrElse a b = b ()