step 3 scaffolding

impls/sml/Makefile

@@ -1,4 +1,4 @@
-STEP_BINS = step0_repl step1_read_print step2_eval
+STEP_BINS = step0_repl step1_read_print step2_eval step3_env
 
 all: $(STEP_BINS)
 
@@ -11,6 +11,9 @@ step1_read_print: step1_read_print.mlb step1_read_print.sml reader.sml printer.s
 step2_eval: step2_eval.mlb step2_eval.sml env.sml reader.sml printer.sml types.sml util.sml main.sml
 	mlton -output $@ $<
 
+step3_env: step3_env.mlb step3_env.sml env.sml reader.sml printer.sml types.sml util.sml main.sml
+	mlton -output $@ $<
+
 clean:
 	rm -f $(STEP_BINS)
 

impls/sml/step3_env.mlb

@@ -0,0 +1,11 @@
+local
+    $(SML_LIB)/basis/basis.mlb
+    util.sml
+    types.sml
+    printer.sml
+    reader.sml
+    env.sml
+    step3_env.sml
+in
+    main.sml
+end

impls/sml/step3_env.sml

@@ -0,0 +1,68 @@
+exception NotDefined of string
+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
+
+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_apply e ast =
+    case eval_ast e ast of
+        LIST ((FN f)::args) => f args
+        | _ => raise NotApplicable "eval_apply needs a non-empty list"
+
+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
+
+fun malPlus  (INT a, INT b) = INT (a + b)
+  | malPlus _ = raise NotApplicable "can only add integers"
+fun malTimes (INT a, INT b) = INT (a * b)
+  | malTimes _ = raise NotApplicable "can only multiply integers"
+fun malMinus (INT b, INT a) = INT (a - b)
+  | malMinus _ = raise NotApplicable "can only subtract integers"
+fun malDiv   (INT b, INT a) = INT (a div b)
+  | malDiv _ = raise NotApplicable "can only divide integers"
+
+val initEnv = ENV [
+    ("+", FN (foldl malPlus (INT 0))),
+    ("*", FN (foldl malTimes (INT 1))),
+    ("-", FN (
+        fn [x]   => malMinus (x, INT 0)
+         | x::xs => foldr malMinus x xs
+         | _ => raise NotApplicable "'-' requires at least one argument"
+    )),
+    ("/", FN (
+        fn [x]   => malDiv (x, INT 1)
+         | x::xs => foldr malDiv x xs
+         | _ => raise NotApplicable "'/' requires at least one argument"
+    ))
+]
+
+fun repl () =
+    let open TextIO
+    in (
+        print("user> ");
+        case inputLine(stdIn) of
+            SOME(line) => (
+                print((rep initEnv line) ^ "\n");
+                repl ()
+            )
+            | NONE => ()
+    ) end