mirror of
https://github.com/kanaka/mal.git
synced 2024-09-11 13:55:55 +03:00
fix eval bugs in bind
This commit is contained in:
parent
bfaeb3bfe9
commit
b7cc870f89
@ -17,8 +17,8 @@ and specialEval (SYMBOL "def!") = SOME evalDef
|
||||
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
||||
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||
|
||||
and evalLet e [LIST bs, ast] = eval (bind bs (inside e)) ast
|
||||
| evalLet e [VECTOR bs, ast] = eval (bind bs (inside e)) ast
|
||||
and evalLet e [LIST bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet e [VECTOR bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||
|
||||
and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs
|
||||
@ -39,11 +39,13 @@ and evalApply e (FN f) args = f (map (eval e) args)
|
||||
and evalSymbol e s = valOrElse (lookup e s)
|
||||
(fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
||||
|
||||
and bind (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map (eval e) (v::vs))) e; e)
|
||||
| bind [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind (SYMBOL s::v::rest) e = (def s (eval e v) e; bind rest e)
|
||||
| bind [] e = e
|
||||
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
and bindLet args e = bind' (eval e) args e
|
||||
and bind args e = bind' identity args e
|
||||
and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs))) e; e)
|
||||
| bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e)
|
||||
| bind' _ [] e = e
|
||||
| bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
|
||||
fun print f =
|
||||
prReadableStr f
|
||||
|
@ -17,8 +17,8 @@ and specialEval (SYMBOL "def!") = SOME evalDef
|
||||
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
||||
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||
|
||||
and evalLet e [LIST bs, ast] = eval (bind bs (inside e)) ast
|
||||
| evalLet e [VECTOR bs, ast] = eval (bind bs (inside e)) ast
|
||||
and evalLet e [LIST bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet e [VECTOR bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||
|
||||
and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs
|
||||
@ -39,11 +39,13 @@ and evalApply e (FN f) args = f (map (eval e) args)
|
||||
and evalSymbol e s = valOrElse (lookup e s)
|
||||
(fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
||||
|
||||
and bind (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map (eval e) (v::vs))) e; e)
|
||||
| bind [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind (SYMBOL s::v::rest) e = (def s (eval e v) e; bind rest e)
|
||||
| bind [] e = e
|
||||
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
and bindLet args e = bind' (eval e) args e
|
||||
and bind args e = bind' identity args e
|
||||
and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs))) e; e)
|
||||
| bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e)
|
||||
| bind' _ [] e = e
|
||||
| bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
|
||||
fun print f =
|
||||
prReadableStr f
|
||||
|
@ -20,8 +20,8 @@ and specialEval (SYMBOL "def!") = SOME evalDef
|
||||
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
||||
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||
|
||||
and evalLet e [LIST bs, ast] = eval (bind bs (inside e)) ast
|
||||
| evalLet e [VECTOR bs, ast] = eval (bind bs (inside e)) ast
|
||||
and evalLet e [LIST bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet e [VECTOR bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||
|
||||
and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs
|
||||
@ -57,11 +57,13 @@ and evalApply e (FN f) args = f (map (eval e) args)
|
||||
and evalSymbol e s = valOrElse (lookup e s)
|
||||
(fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
||||
|
||||
and bind (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map (eval e) (v::vs))) e; e)
|
||||
| bind [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind (SYMBOL s::v::rest) e = (def s (eval e v) e; bind rest e)
|
||||
| bind [] e = e
|
||||
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
and bindLet args e = bind' (eval e) args e
|
||||
and bind args e = bind' identity args e
|
||||
and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs))) e; e)
|
||||
| bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e)
|
||||
| bind' _ [] e = e
|
||||
| bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
|
||||
fun print f =
|
||||
prReadableStr f
|
||||
|
@ -24,8 +24,8 @@ and specialEval (SYMBOL "def!") = SOME evalDef
|
||||
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
||||
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||
|
||||
and evalLet e [LIST bs, ast] = let val e = inside e in eval (bind (eval e) bs e) ast end
|
||||
| evalLet e [VECTOR bs, ast] = let val e = inside e in eval (bind (eval e) bs e) ast end
|
||||
and evalLet e [LIST bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet e [VECTOR bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||
|
||||
and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs
|
||||
@ -38,7 +38,7 @@ and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b
|
||||
and evalFn e [(LIST binds),body] = makeFn e binds body
|
||||
| evalFn e [(VECTOR binds),body] = makeFn e binds body
|
||||
| evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body"
|
||||
and makeFn e binds body = FN (fn (exprs) => eval (bind (eval e) (interleave binds exprs) (inside e)) body)
|
||||
and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body)
|
||||
|
||||
and evalQuote e [x] = x
|
||||
| evalQuote _ _ = raise NotApplicable "quote needs one argument"
|
||||
@ -58,7 +58,7 @@ and quasiFolder (LIST [SYMBOL "splice-unquote", x], acc) = [SYMBOL "concat", x,
|
||||
and evalDefmacro e [SYMBOL s, LIST [SYMBOL "fn*", LIST binds, body]] = let val m = makeMacro e binds body in (def s m e; m) end
|
||||
| evalDefmacro e [SYMBOL s, LIST [SYMBOL "fn*", VECTOR binds, body]] = let val m = makeMacro e binds body in (def s m e; m) end
|
||||
| evalDefmacro _ _ = raise NotApplicable "defmacro! needs a name, a list of bindings, and a body"
|
||||
and makeMacro e binds body = MACRO (fn (exprs) => eval (bind identity (interleave binds exprs) (inside e)) body)
|
||||
and makeMacro e binds body = MACRO (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body)
|
||||
|
||||
and expandMacro e [(ast as LIST (SYMBOL s::args))] = (case lookup e s of SOME (MACRO m) => m args | _ => ast)
|
||||
| expandMacro _ [ast] = ast
|
||||
@ -70,11 +70,13 @@ and evalApply e (FN f) args = f (map (eval e) args)
|
||||
and evalSymbol e s = valOrElse (lookup e s)
|
||||
(fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
||||
|
||||
and bind evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs))) e; e)
|
||||
| bind _ [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind evl rest e)
|
||||
| bind _ [] e = e
|
||||
| bind _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
and bindLet args e = bind' (eval e) args e
|
||||
and bind args e = bind' identity args e
|
||||
and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs))) e; e)
|
||||
| bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e)
|
||||
| bind' _ [] e = e
|
||||
| bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
|
||||
fun print f =
|
||||
prReadableStr f
|
||||
@ -87,7 +89,7 @@ fun rep e s =
|
||||
| NotDefined msg => "NOT DEFINED: " ^ msg
|
||||
| e => "ERROR: " ^ (exnMessage e)
|
||||
|
||||
val initEnv = ENV (NS (ref [])) |> bind identity coreNs
|
||||
val initEnv = ENV (NS (ref [])) |> bind coreNs
|
||||
|
||||
fun repl e =
|
||||
let open TextIO
|
||||
@ -123,7 +125,7 @@ val prelude = " \
|
||||
\ (cons 'cond (rest (rest xs)))))))"
|
||||
|
||||
fun main () = (
|
||||
bind identity [
|
||||
bind [
|
||||
SYMBOL "eval",
|
||||
FN (fn ([x]) => eval initEnv x
|
||||
| _ => raise NotApplicable "'eval' requires one argument")
|
||||
|
@ -25,8 +25,8 @@ and specialEval (SYMBOL "def!") = SOME evalDef
|
||||
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
||||
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||
|
||||
and evalLet e [LIST bs, ast] = let val e = inside e in eval (bind (eval e) bs e) ast end
|
||||
| evalLet e [VECTOR bs, ast] = let val e = inside e in eval (bind (eval e) bs e) ast end
|
||||
and evalLet e [LIST bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet e [VECTOR bs, ast] = eval (bindLet bs (inside e)) ast
|
||||
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||
|
||||
and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs
|
||||
@ -39,7 +39,7 @@ and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b
|
||||
and evalFn e [(LIST binds),body] = makeFn e binds body
|
||||
| evalFn e [(VECTOR binds),body] = makeFn e binds body
|
||||
| evalFn _ _ = raise NotApplicable "fn* needs a list of bindings and a body"
|
||||
and makeFn e binds body = FN (fn (exprs) => eval (bind (eval e) (interleave binds exprs) (inside e)) body)
|
||||
and makeFn e binds body = FN (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body)
|
||||
|
||||
and evalQuote e [x] = x
|
||||
| evalQuote _ _ = raise NotApplicable "quote needs one argument"
|
||||
@ -59,7 +59,7 @@ and quasiFolder (LIST [SYMBOL "splice-unquote", x], acc) = [SYMBOL "concat", x,
|
||||
and evalDefmacro e [SYMBOL s, LIST [SYMBOL "fn*", LIST binds, body]] = let val m = makeMacro e binds body in (def s m e; m) end
|
||||
| evalDefmacro e [SYMBOL s, LIST [SYMBOL "fn*", VECTOR binds, body]] = let val m = makeMacro e binds body in (def s m e; m) end
|
||||
| evalDefmacro _ _ = raise NotApplicable "defmacro! needs a name, a list of bindings, and a body"
|
||||
and makeMacro e binds body = MACRO (fn (exprs) => eval (bind identity (interleave binds exprs) (inside e)) body)
|
||||
and makeMacro e binds body = MACRO (fn (exprs) => eval (bind (interleave binds exprs) (inside e)) body)
|
||||
|
||||
and expandMacro e [(ast as LIST (SYMBOL s::args))] = (case lookup e s of SOME (MACRO m) => m args | _ => ast)
|
||||
| expandMacro _ [ast] = ast
|
||||
@ -68,7 +68,7 @@ and expandMacro e [(ast as LIST (SYMBOL s::args))] = (case lookup e s of SOME (M
|
||||
and evalTry e [a, LIST [SYMBOL "catch*", b, c]] = (eval e a handle ex => evalCatch (inside e) b ex c)
|
||||
| evalTry e [a] = eval e a
|
||||
| evalTry _ _ = raise NotApplicable "try* needs a form to evaluate"
|
||||
and evalCatch e b ex body = eval (bind (eval e) [b, STRING (exnString ex)] e) body
|
||||
and evalCatch e b ex body = eval (bind [b, STRING (exnString ex)] e) body
|
||||
|
||||
and exnString (NotDefined msg) = msg
|
||||
| exnString (NotApplicable msg) = msg
|
||||
@ -82,11 +82,13 @@ and evalApply e (FN f) args = f (map (eval e) args)
|
||||
and evalSymbol e s = valOrElse (lookup e s)
|
||||
(fn _ => raise NotDefined ("'" ^ s ^ "' not found"))
|
||||
|
||||
and bind evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs))) e; e)
|
||||
| bind _ [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind evl rest e)
|
||||
| bind _ [] e = e
|
||||
| bind _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
and bindLet args e = bind' (eval e) args e
|
||||
and bind args e = bind' identity args e
|
||||
and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs))) e; e)
|
||||
| bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST []) e; e)
|
||||
| bind' evl (SYMBOL s::v::rest) e = (def s (evl v) e; bind' evl rest e)
|
||||
| bind' _ [] e = e
|
||||
| bind' _ _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
|
||||
fun print f =
|
||||
prReadableStr f
|
||||
@ -99,7 +101,7 @@ fun rep e s =
|
||||
| NotDefined msg => "NOT DEFINED: " ^ msg
|
||||
| e => "ERROR: " ^ (exnMessage e)
|
||||
|
||||
val initEnv = ENV (NS (ref [])) |> bind identity coreNs
|
||||
val initEnv = ENV (NS (ref [])) |> bind coreNs
|
||||
|
||||
fun repl e =
|
||||
let open TextIO
|
||||
@ -135,7 +137,7 @@ val prelude = " \
|
||||
\ (cons 'cond (rest (rest xs)))))))"
|
||||
|
||||
fun main () = (
|
||||
bind identity [
|
||||
bind [
|
||||
SYMBOL "eval",
|
||||
FN (fn ([x]) => eval initEnv x
|
||||
| _ => raise NotApplicable "'eval' requires one argument")
|
||||
|
Loading…
Reference in New Issue
Block a user