mirror of
https://github.com/kanaka/mal.git
synced 2024-10-26 22:28:26 +03:00
make envs mutable
This commit is contained in:
parent
3224c1b856
commit
e160b83391
@ -24,7 +24,7 @@ val coreList = [
|
|||||||
(* N.B. adds extra newline at end *)
|
(* N.B. adds extra newline at end *)
|
||||||
fun slurp lines strm = case TextIO.inputLine strm of
|
fun slurp lines strm = case TextIO.inputLine strm of
|
||||||
SOME l => slurp (l::lines) strm
|
SOME l => slurp (l::lines) strm
|
||||||
| NONE => rev lines
|
| NONE => (TextIO.closeIn strm; rev lines)
|
||||||
|
|
||||||
fun malPrint s = (
|
fun malPrint s = (
|
||||||
TextIO.print (s ^ "\n");
|
TextIO.print (s ^ "\n");
|
||||||
@ -107,9 +107,8 @@ val coreAtom = [
|
|||||||
| _ => raise NotApplicable "'reset!' requires an atom argument"),
|
| _ => raise NotApplicable "'reset!' requires an atom argument"),
|
||||||
|
|
||||||
SYMBOL "swap!",
|
SYMBOL "swap!",
|
||||||
FN6 (fn e => (fn (ATOM a::(FN f)::args) => let val x = f ((!a)::args) in (a := x; (e, x)) end
|
CLOSURE (fn e => (fn (ATOM a::(FN f)::args) => let val x = f ((!a)::args) in (a := x; x) end
|
||||||
| (ATOM a::(FN4 f)::args) => let val x = f e ((!a)::args) in (a := x; (e, x)) end
|
| (ATOM a::(CLOSURE f)::args) => let val x = f e ((!a)::args) in (a := x; x) end
|
||||||
| (ATOM a::(FN6 f)::args) => let val (e',x) = f e ((!a)::args) in (a := x; (e', x)) end
|
|
||||||
| _ => raise NotApplicable "'reset!' requires an atom argument"))
|
| _ => raise NotApplicable "'reset!' requires an atom argument"))
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -1,5 +1,14 @@
|
|||||||
fun def s v (ENV d) = (s, v) :: (d |> List.filter (not o eq s o #1)) |> ENV
|
fun set s v (NS d) = d := (s, v) :: (!d |> List.filter (not o eq s o #1))
|
||||||
|
|
||||||
fun lookup (ENV d) s = d |> List.find (eq s o #1) |> Option.map #2
|
fun get (NS d) s = !d |> List.find (eq s o #1) |> Option.map #2
|
||||||
|
|
||||||
fun wrap (ENV outer) (ENV inner) = ENV (inner @ outer)
|
fun def s v (ENV ns) = set s v ns
|
||||||
|
| def s v (INNER (ns, _)) = set s v ns
|
||||||
|
|
||||||
|
fun lookup (ENV ns) s = get ns s
|
||||||
|
| lookup (INNER (ns, outer)) s = optOrElse (get ns s) (fn () => lookup outer s)
|
||||||
|
|
||||||
|
fun wrap outer (ENV ns) = INNER (ns, outer)
|
||||||
|
| wrap outer (INNER (ns, inner)) = INNER (ns, wrap outer inner)
|
||||||
|
|
||||||
|
fun inside outer = INNER (NS (ref []), outer)
|
||||||
|
@ -7,8 +7,7 @@ fun prStr NIL = "nil"
|
|||||||
| prStr (STRING s) = s
|
| prStr (STRING s) = s
|
||||||
| 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 _) = "#<function>"
|
| prStr (FN _) = "#<function>"
|
||||||
| prStr (FN4 _) = "#<function>"
|
| prStr (CLOSURE _) = "#<function>"
|
||||||
| prStr (FN6 _) = "#<function>"
|
|
||||||
|
|
||||||
fun prReadableStr (STRING s) = "\"" ^ (malEscape s) ^ "\""
|
fun prReadableStr (STRING s) = "\"" ^ (malEscape s) ^ "\""
|
||||||
| prReadableStr (ATOM x) = "(atom " ^ (prReadableStr (!x)) ^ ")"
|
| prReadableStr (ATOM x) = "(atom " ^ (prReadableStr (!x)) ^ ")"
|
||||||
|
@ -40,7 +40,7 @@ fun malMinus (INT b, INT a) = INT (a - b)
|
|||||||
fun malDiv (INT b, INT a) = INT (a div b)
|
fun malDiv (INT b, INT a) = INT (a div b)
|
||||||
| malDiv _ = raise NotApplicable "can only divide integers"
|
| malDiv _ = raise NotApplicable "can only divide integers"
|
||||||
|
|
||||||
val initEnv = ENV [
|
val initEnv = ENV (NS (ref [
|
||||||
("+", FN (foldl malPlus (INT 0))),
|
("+", FN (foldl malPlus (INT 0))),
|
||||||
("*", FN (foldl malTimes (INT 1))),
|
("*", FN (foldl malTimes (INT 1))),
|
||||||
("-", FN (
|
("-", FN (
|
||||||
@ -53,7 +53,7 @@ val initEnv = ENV [
|
|||||||
| x::xs => foldr malDiv x xs
|
| x::xs => foldr malDiv x xs
|
||||||
| _ => raise NotApplicable "'/' requires at least one argument"
|
| _ => raise NotApplicable "'/' requires at least one argument"
|
||||||
))
|
))
|
||||||
]
|
]))
|
||||||
|
|
||||||
fun repl () =
|
fun repl () =
|
||||||
let open TextIO
|
let open TextIO
|
||||||
|
@ -6,25 +6,23 @@ fun read s =
|
|||||||
|
|
||||||
fun eval e (LIST (SYMBOL "def!"::args)) = evalDef e args
|
fun eval e (LIST (SYMBOL "def!"::args)) = evalDef e args
|
||||||
| eval e (LIST (SYMBOL "let*"::args)) = evalLet e args
|
| eval e (LIST (SYMBOL "let*"::args)) = evalLet e args
|
||||||
| eval e (LIST (a::args)) = (e, evalApply e (eval' e a) args)
|
| eval e (LIST (a::args)) = evalApply e (eval e a) args
|
||||||
| eval e (SYMBOL s) = (e, evalSymbol e s)
|
| eval e (SYMBOL s) = evalSymbol e s
|
||||||
| eval e ast = (e, ast)
|
| eval e ast = ast
|
||||||
|
|
||||||
and eval' e ast = (#2 o eval e) ast
|
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
||||||
|
|
||||||
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"
|
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||||
|
|
||||||
and evalLet e [LIST bs, ast] = (e, eval' (bind bs e) ast)
|
and evalLet e [LIST bs, ast] = eval (bind bs (inside e)) ast
|
||||||
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||||
|
|
||||||
and evalApply e (FN f) args = f (map (eval' e) args)
|
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))
|
| evalApply _ a args = raise NotApplicable (prStr a ^ " 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"))
|
||||||
|
|
||||||
and bind (SYMBOL s::v::rest) e = def s (eval' e v) e |> bind rest
|
and bind (SYMBOL s::v::rest) e = (def s (eval e v) e; bind rest e)
|
||||||
| bind [] e = e
|
| bind [] e = e
|
||||||
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||||
|
|
||||||
@ -32,11 +30,11 @@ fun print f =
|
|||||||
prStr f
|
prStr f
|
||||||
|
|
||||||
fun rep e s =
|
fun rep e s =
|
||||||
s |> read |> eval e |> (fn (e, v) => (e, print v))
|
s |> read |> eval e |> print
|
||||||
handle Nothing => (e, "")
|
handle Nothing => ""
|
||||||
| SyntaxError msg => (e, "SYNTAX ERROR: " ^ msg)
|
| SyntaxError msg => "SYNTAX ERROR: " ^ msg
|
||||||
| NotApplicable msg => (e, "CANNOT APPLY: " ^ msg)
|
| NotApplicable msg => "CANNOT APPLY: " ^ msg
|
||||||
| NotDefined msg => (e, "NOT DEFINED: " ^ msg)
|
| NotDefined msg => "NOT DEFINED: " ^ msg
|
||||||
|
|
||||||
fun malPlus (INT a, INT b) = INT (a + b)
|
fun malPlus (INT a, INT b) = INT (a + b)
|
||||||
| malPlus _ = raise NotApplicable "can only add integers"
|
| malPlus _ = raise NotApplicable "can only add integers"
|
||||||
@ -47,7 +45,7 @@ fun malMinus (INT b, INT a) = INT (a - b)
|
|||||||
fun malDiv (INT b, INT a) = INT (a div b)
|
fun malDiv (INT b, INT a) = INT (a div b)
|
||||||
| malDiv _ = raise NotApplicable "can only divide integers"
|
| malDiv _ = raise NotApplicable "can only divide integers"
|
||||||
|
|
||||||
val initEnv = ENV [] |> bind [
|
val initEnv = ENV (NS (ref [])) |> bind [
|
||||||
SYMBOL "+",
|
SYMBOL "+",
|
||||||
FN (foldl malPlus (INT 0)),
|
FN (foldl malPlus (INT 0)),
|
||||||
SYMBOL "*",
|
SYMBOL "*",
|
||||||
@ -68,10 +66,10 @@ fun repl e =
|
|||||||
print("user> ");
|
print("user> ");
|
||||||
case inputLine(stdIn) of
|
case inputLine(stdIn) of
|
||||||
SOME(line) =>
|
SOME(line) =>
|
||||||
let val (e', s) = rep e line
|
let val s = rep e line
|
||||||
val _ = print(s ^ "\n")
|
val _ = print(s ^ "\n")
|
||||||
in
|
in
|
||||||
repl e'
|
repl e
|
||||||
end
|
end
|
||||||
| NONE => ()
|
| NONE => ()
|
||||||
) end
|
) end
|
||||||
|
@ -2,40 +2,38 @@ fun read s =
|
|||||||
readStr s
|
readStr s
|
||||||
|
|
||||||
fun eval e (LIST (SYMBOL "def!"::args)) = evalDef e args
|
fun eval e (LIST (SYMBOL "def!"::args)) = evalDef e args
|
||||||
|
| eval e (LIST (SYMBOL "let*"::args)) = evalLet e args
|
||||||
| eval e (LIST (SYMBOL "do"::args)) = evalDo e args
|
| eval e (LIST (SYMBOL "do"::args)) = evalDo e args
|
||||||
| eval e (LIST (SYMBOL "if"::args)) = evalIf e args
|
| eval e (LIST (SYMBOL "if"::args)) = evalIf e args
|
||||||
| eval e (LIST (SYMBOL "let*"::args)) = (e, evalLet e args)
|
| eval e (LIST (SYMBOL "fn*"::args)) = evalFn e args
|
||||||
| eval e (LIST (SYMBOL "fn*"::args)) = (e, evalFn e args)
|
| eval e (LIST (a::args)) = evalApply e (eval e a) args
|
||||||
| eval e (LIST (a::args)) = (e, evalApply e (eval' e a) args)
|
| eval e (SYMBOL s) = evalSymbol e s
|
||||||
| eval e (SYMBOL s) = (e, evalSymbol e s)
|
| eval e ast = ast
|
||||||
| eval e ast = (e, ast)
|
|
||||||
|
|
||||||
and eval' e ast = (#2 o eval e) ast
|
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
||||||
|
|
||||||
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"
|
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||||
|
|
||||||
and evalLet e [LIST bs, ast] = eval' (bind bs e) ast
|
and evalLet e [LIST bs, ast] = eval (bind bs (inside e)) ast
|
||||||
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||||
|
|
||||||
and evalDo e (x::xs) = foldl (fn (x, (e,_)) => eval e x) (eval e x) xs
|
and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs
|
||||||
| evalDo _ _ = raise NotApplicable "do needs at least one argument"
|
| evalDo _ _ = raise NotApplicable "do needs at least one argument"
|
||||||
|
|
||||||
and evalIf e [c,a,b] = eval e c |> (fn (e,c) => eval e (if truthy c then a else b))
|
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 e [c,a] = evalIf e [c,a,NIL]
|
||||||
| evalIf _ _ = raise NotApplicable "if needs two or three arguments"
|
| evalIf _ _ = raise NotApplicable "if needs two or three arguments"
|
||||||
|
|
||||||
and evalFn c [(LIST binds),body] = FN4 (fn (e) => fn (exprs) => eval' (bind (interleave binds exprs) (wrap e c)) body)
|
and evalFn c [(LIST binds),body] = CLOSURE (fn (e) => fn (exprs) => eval (bind (interleave binds exprs) (inside (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 (FN4 (f)) args = f e (map (eval' e) args)
|
and evalApply e (CLOSURE (f)) args = f e (map (eval e) args)
|
||||||
| evalApply e (FN f) args = f (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))
|
| 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"))
|
||||||
|
|
||||||
and bind (SYMBOL s::v::rest) e = def s (eval' e v) e |> bind rest
|
and bind (SYMBOL s::v::rest) e = (def s (eval e v) e; bind rest e)
|
||||||
| bind [] e = e
|
| bind [] e = e
|
||||||
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||||
|
|
||||||
@ -43,13 +41,13 @@ fun print f =
|
|||||||
prStr f
|
prStr f
|
||||||
|
|
||||||
fun rep e s =
|
fun rep e s =
|
||||||
s |> read |> eval e |> (fn (e, v) => (e, print v))
|
s |> read |> eval e |> print
|
||||||
handle Nothing => (e, "")
|
handle Nothing => ""
|
||||||
| SyntaxError msg => (e, "SYNTAX ERROR: " ^ msg)
|
| SyntaxError msg => "SYNTAX ERROR: " ^ msg
|
||||||
| NotApplicable msg => (e, "CANNOT APPLY: " ^ msg)
|
| NotApplicable msg => "CANNOT APPLY: " ^ msg
|
||||||
| NotDefined msg => (e, "NOT DEFINED: " ^ msg)
|
| NotDefined msg => "NOT DEFINED: " ^ msg
|
||||||
|
|
||||||
val initEnv = ENV [] |> bind coreNs
|
val initEnv = ENV (NS (ref [])) |> bind coreNs
|
||||||
|
|
||||||
fun repl e =
|
fun repl e =
|
||||||
let open TextIO
|
let open TextIO
|
||||||
@ -57,10 +55,10 @@ fun repl e =
|
|||||||
print("user> ");
|
print("user> ");
|
||||||
case inputLine(stdIn) of
|
case inputLine(stdIn) of
|
||||||
SOME(line) =>
|
SOME(line) =>
|
||||||
let val (e', s) = rep e line
|
let val s = rep e line
|
||||||
val _ = print(s ^ "\n")
|
val _ = print(s ^ "\n")
|
||||||
in
|
in
|
||||||
repl e'
|
repl e
|
||||||
end
|
end
|
||||||
| NONE => ()
|
| NONE => ()
|
||||||
) end
|
) end
|
||||||
|
@ -2,42 +2,38 @@ fun read s =
|
|||||||
readStr s
|
readStr s
|
||||||
|
|
||||||
fun eval e (LIST (SYMBOL "def!"::args)) = evalDef e args
|
fun eval e (LIST (SYMBOL "def!"::args)) = evalDef e args
|
||||||
|
| eval e (LIST (SYMBOL "let*"::args)) = evalLet e args
|
||||||
| eval e (LIST (SYMBOL "do"::args)) = evalDo e args
|
| eval e (LIST (SYMBOL "do"::args)) = evalDo e args
|
||||||
| eval e (LIST (SYMBOL "if"::args)) = evalIf e args
|
| eval e (LIST (SYMBOL "if"::args)) = evalIf e args
|
||||||
| eval e (LIST (SYMBOL "let*"::args)) = (e, evalLet e args)
|
| eval e (LIST (SYMBOL "fn*"::args)) = evalFn e args
|
||||||
| eval e (LIST (SYMBOL "fn*"::args)) = (e, evalFn e args)
|
| eval e (LIST (a::args)) = evalApply e (eval e a) args
|
||||||
| eval e (LIST (a::args)) = evalApply e (eval' e a) args
|
| eval e (SYMBOL s) = evalSymbol e s
|
||||||
| eval e (SYMBOL s) = (e, evalSymbol e s)
|
| eval e ast = ast
|
||||||
| eval e ast = (e, ast)
|
|
||||||
|
|
||||||
and eval' e ast = (#2 o eval e) ast
|
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
||||||
|
|
||||||
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"
|
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||||
|
|
||||||
and evalLet e [LIST bs, ast] = eval' (bind bs e) ast
|
and evalLet e [LIST bs, ast] = eval (bind bs (inside e)) ast
|
||||||
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
| evalLet _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||||
|
|
||||||
and evalDo e (x::xs) = foldl (fn (x, (e,_)) => eval e x) (eval e x) xs
|
and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs
|
||||||
| evalDo _ _ = raise NotApplicable "do needs at least one argument"
|
| evalDo _ _ = raise NotApplicable "do needs at least one argument"
|
||||||
|
|
||||||
and evalIf e [c,a,b] = eval e c |> (fn (e,c) => eval e (if truthy c then a else b))
|
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 e [c,a] = evalIf e [c,a,NIL]
|
||||||
| evalIf _ _ = raise NotApplicable "if needs two or three arguments"
|
| evalIf _ _ = raise NotApplicable "if needs two or three arguments"
|
||||||
|
|
||||||
(* TODO: Wrapping, binding, and mutating an env must be separate things *)
|
and evalFn c [(LIST binds),body] = CLOSURE (fn (e) => fn (exprs) => eval (bind (interleave binds exprs) (inside (wrap e c))) body)
|
||||||
and evalFn c [(LIST binds),body] = FN6 (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 (FN4 (f)) args = (e, f e (map (eval' e) args))
|
and evalApply e (CLOSURE (f)) args = f e (map (eval e) args)
|
||||||
| evalApply e (FN6 (f)) args = f e (map (eval' e) args)
|
| evalApply e (FN f) args = f (map (eval e) args)
|
||||||
| evalApply e (FN f) args = (e, f (map (eval' e) args))
|
|
||||||
| evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (LIST 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"))
|
||||||
|
|
||||||
and bind (SYMBOL s::v::rest) e = def s (eval' e v) e |> bind rest
|
and bind (SYMBOL s::v::rest) e = (def s (eval e v) e; bind rest e)
|
||||||
| bind [] e = e
|
| bind [] e = e
|
||||||
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||||
|
|
||||||
@ -45,18 +41,13 @@ fun print f =
|
|||||||
prReadableStr f
|
prReadableStr f
|
||||||
|
|
||||||
fun rep e s =
|
fun rep e s =
|
||||||
s |> read |> eval e |> (fn (e, v) => (e, print v))
|
s |> read |> eval e |> print
|
||||||
handle Nothing => (e, "")
|
handle Nothing => ""
|
||||||
| SyntaxError msg => (e, "SYNTAX ERROR: " ^ msg)
|
| SyntaxError msg => "SYNTAX ERROR: " ^ msg
|
||||||
| NotApplicable msg => (e, "CANNOT APPLY: " ^ msg)
|
| NotApplicable msg => "CANNOT APPLY: " ^ msg
|
||||||
| NotDefined msg => (e, "NOT DEFINED: " ^ msg)
|
| NotDefined msg => "NOT DEFINED: " ^ msg
|
||||||
|
|
||||||
val initEnv = ENV [] |> bind coreNs
|
val initEnv = ENV (NS (ref [])) |> bind coreNs
|
||||||
|> bind [
|
|
||||||
SYMBOL "eval",
|
|
||||||
FN6 (fn (e) => fn ([x]) => eval e x
|
|
||||||
| _ => raise NotApplicable "'eval' requires one argument")
|
|
||||||
]
|
|
||||||
|
|
||||||
fun repl e =
|
fun repl e =
|
||||||
let open TextIO
|
let open TextIO
|
||||||
@ -64,10 +55,10 @@ fun repl e =
|
|||||||
print("user> ");
|
print("user> ");
|
||||||
case inputLine(stdIn) of
|
case inputLine(stdIn) of
|
||||||
SOME(line) =>
|
SOME(line) =>
|
||||||
let val (e', s) = rep e line
|
let val s = rep e line
|
||||||
val _ = print(s ^ "\n")
|
val _ = print(s ^ "\n")
|
||||||
in
|
in
|
||||||
repl e'
|
repl e
|
||||||
end
|
end
|
||||||
| NONE => ()
|
| NONE => ()
|
||||||
) end
|
) end
|
||||||
@ -78,4 +69,12 @@ val prelude = " \
|
|||||||
\ (fn* (f) \
|
\ (fn* (f) \
|
||||||
\ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"
|
\ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"
|
||||||
|
|
||||||
fun main () = (rep initEnv prelude) |> #1 |> repl
|
fun main () = (
|
||||||
|
bind [
|
||||||
|
SYMBOL "eval",
|
||||||
|
FN (fn ([x]) => eval initEnv x
|
||||||
|
| _ => raise NotApplicable "'eval' requires one argument")
|
||||||
|
] initEnv;
|
||||||
|
rep initEnv prelude;
|
||||||
|
repl initEnv
|
||||||
|
)
|
||||||
|
@ -6,10 +6,12 @@ datatype mal_type = NIL
|
|||||||
| LIST of mal_type list
|
| LIST of mal_type list
|
||||||
| ATOM of mal_type ref
|
| ATOM of mal_type ref
|
||||||
| FN of mal_type list -> mal_type
|
| FN of mal_type list -> mal_type
|
||||||
| FN4 of mal_env -> mal_type list -> mal_type
|
| CLOSURE of mal_env -> mal_type list -> mal_type
|
||||||
| FN6 of mal_env -> mal_type list -> (mal_env * mal_type)
|
|
||||||
|
|
||||||
and mal_env = ENV of (string * mal_type) list
|
and mal_ns = NS of (string * mal_type) list ref
|
||||||
|
|
||||||
|
and mal_env = ENV of mal_ns
|
||||||
|
| INNER of mal_ns * mal_env
|
||||||
|
|
||||||
fun truthy (BOOL false) = false
|
fun truthy (BOOL false) = false
|
||||||
| truthy NIL = false
|
| truthy NIL = false
|
||||||
|
Loading…
Reference in New Issue
Block a user