mirror of
https://github.com/kanaka/mal.git
synced 2024-09-11 13:55:55 +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 =
|
fun wrap (ENV outer) (ENV inner) = ENV (inner @ outer)
|
||||||
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
|
|
||||||
|
@ -4,4 +4,5 @@ fun prStr NIL = "nil"
|
|||||||
| prStr (BOOL false) = "false"
|
| prStr (BOOL false) = "false"
|
||||||
| prStr (INT i) = if i >= 0 then Int.toString i else "-" ^ (Int.toString (Int.abs i))
|
| 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 (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 e [c,a] = if truthy (eval' e c) then (eval' e a) else NIL
|
||||||
| evalIf _ _ = raise NotApplicable "if needs two or three arguments"
|
| 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"
|
| evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body"
|
||||||
|
|
||||||
and evalApply e (FN f) args = f (map (eval' e) args)
|
and evalApply e (CLOSURE (f)) args = f e (map (eval' e) args)
|
||||||
| evalApply _ a args = raise NotApplicable (prStr a ^ " is not applicable on " ^ prStr (LIST 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)
|
and evalSymbol e s = valOrElse (lookup e s)
|
||||||
(fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
(fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
||||||
|
@ -4,6 +4,9 @@ datatype mal_type = NIL
|
|||||||
| INT of int
|
| INT of int
|
||||||
| LIST of mal_type list
|
| LIST of mal_type list
|
||||||
| FN of mal_type list -> mal_type
|
| 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
|
fun truthy (BOOL false) = false
|
||||||
| truthy NIL = false
|
| truthy NIL = false
|
||||||
|
Loading…
Reference in New Issue
Block a user