mirror of
https://github.com/kanaka/mal.git
synced 2024-08-17 01:30:26 +03:00
closures capture the env
This commit is contained in:
parent
ca9e16a350
commit
058c6dd98f
@ -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)
|
||||
|
@ -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>"
|
||||
|
@ -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"))
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user