closures capture the env

impls/sml/env.sml

@@ -1,13 +1,5 @@
-type mal_defs = (string * mal_type) list
+fun def s v (ENV d) = (s, v) :: (d |> List.filter (not o eq s o #1)) |> ENV
 
-datatype mal_env = ENV of mal_defs
+fun lookup (ENV d) s = d |> List.find (eq s o #1) |> Option.map #2
 
-fun get (d:mal_defs) s =
-    d |> List.find (eq s o #1) |> Option.map #2
-
-fun set s v (d:mal_defs) =
-    (s, v) :: (d |> List.filter (not o eq s o #1))
-
-fun def s v (ENV d) = ENV (set s v d)
-
-fun lookup (ENV d) s = get d s
+fun wrap (ENV outer) (ENV inner) = ENV (inner @ outer)

impls/sml/printer.sml

@@ -4,4 +4,5 @@ fun prStr NIL          = "nil"
   | prStr (BOOL false) = "false"
   | prStr (INT i)      = if i >= 0 then Int.toString i else "-" ^ (Int.toString (Int.abs i))
   | prStr (LIST l)     = "(" ^ (String.concatWith " " (map prStr l)) ^ ")" (* N.B. not tail recursive *)
-  | prStr (FN f)       = "#<function>"
+  | prStr (FN _)       = "#<function>"
+  | prStr (CLOSURE _)  = "#<closure>"

impls/sml/step4_if_fn_do.sml

@@ -26,11 +26,12 @@ and evalIf e [c,a,b] = if truthy (eval' e c) then (eval' e a) else (eval' e b)
   | evalIf e [c,a]   = if truthy (eval' e c) then (eval' e a) else NIL
   | evalIf _ _       = raise NotApplicable "if needs two or three arguments"
 
-and evalFn e [(LIST binds),body] = FN (fn (exprs) => eval' (bind (interleave binds exprs) e) body)
+and evalFn c [(LIST binds),body] = CLOSURE (fn (e) => fn (exprs) => eval' (bind (interleave binds exprs) (wrap e c)) body)
   | evalFn _ _                   = raise NotApplicable "fn* needs a list of bindings and a body"
 
-and evalApply e (FN f) args = f (map (eval' e) args)
-  | evalApply _ a      args = raise NotApplicable (prStr a ^ " is not applicable on " ^ prStr (LIST args))
+and evalApply e (CLOSURE (f)) args = f e (map (eval' e) args)
+  | evalApply e (FN f)        args = f (map (eval' e) args)
+  | evalApply _ x             args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (LIST args))
 
 and evalSymbol e s = valOrElse (lookup e s)
                                (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))

impls/sml/types.sml

@@ -4,6 +4,9 @@ datatype mal_type = NIL
                   | INT of int
                   | LIST of mal_type list
                   | FN of mal_type list -> mal_type
+                  | CLOSURE of mal_env -> mal_type list -> mal_type
+
+and mal_env = ENV of (string * mal_type) list
 
 fun truthy (BOOL false) = false
   | truthy NIL          = false