kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-09-11 13:55:55 +03:00
Code Issues Projects Releases Wiki Activity

cleanup closures after env changes

Browse Source
This commit is contained in:
Fabian 2021-04-02 20:42:36 +02:00 committed by Joel Martin
parent 9fc9f1c112
commit 4b3d031f4c
5 changed files with 8 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
impls/sml/core.sml
View File

@ -107,9 +107,8 @@ val coreAtom = [
| _ => raise NotApplicable "'reset!' requires an atom argument"),
SYMBOL "swap!",
CLOSURE (fn e => (fn (ATOM a::(FN f)::args) => let val x = f ((!a)::args) in (a := x; x) end
| (ATOM a::(CLOSURE f)::args) => let val x = f e ((!a)::args) in (a := x; x) end
| _ => raise NotApplicable "'reset!' requires an atom argument"))
FN (fn (ATOM a::(FN f)::args) => let val x = f ((!a)::args) in (a := x; x) end
| _ => raise NotApplicable "'reset!' requires an atom argument")
]
val coreNs = List.concat [

1
impls/sml/printer.sml
View File

@ -7,7 +7,6 @@ fun prStr NIL = "nil"
| prStr (STRING s) = s
| prStr (LIST l) = "(" ^ (String.concatWith " " (map prStr l)) ^ ")" (* N.B. not tail recursive *)
| prStr (FN _) = "#<function>"
| prStr (CLOSURE _) = "#<function>"
fun prReadableStr (STRING s) = "\"" ^ (malEscape s) ^ "\""
| prReadableStr (ATOM x) = "(atom " ^ (prReadableStr (!x)) ^ ")"

7
impls/sml/step4_if_fn_do.sml
View File

@ -23,12 +23,11 @@ and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b
| evalIf e [c,a] = evalIf e [c,a,NIL]
| evalIf _ _ = raise NotApplicable "if needs two or three arguments"
and evalFn c [(LIST binds),body] = CLOSURE (fn (e) => fn (exprs) => eval (bind (interleave binds exprs) (inside (wrap e c))) body)
and evalFn e [(LIST binds),body] = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body)
| evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body"
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 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"))

7
impls/sml/step6_file.sml
View File

@ -23,12 +23,11 @@ and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b
| evalIf e [c,a] = evalIf e [c,a,NIL]
| evalIf _ _ = raise NotApplicable "if needs two or three arguments"
and evalFn c [(LIST binds),body] = CLOSURE (fn (e) => fn (exprs) => eval (bind (interleave binds exprs) (inside (wrap e c))) body)
and evalFn e [(LIST binds),body] = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body)
| evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body"
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 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"))

1
impls/sml/types.sml
View File

@ -6,7 +6,6 @@ datatype mal_type = NIL
| LIST of mal_type list
| ATOM of mal_type ref
| FN of mal_type list -> mal_type
| CLOSURE of mal_env -> mal_type list -> mal_type
and mal_ns = NS of (string * mal_type) list ref