mirror of
https://github.com/kanaka/mal.git
synced 2024-08-16 17:20:23 +03:00
def! works
This commit is contained in:
parent
b8728f28ea
commit
3a53a42461
@ -9,5 +9,10 @@ fun get (d:mal_defs) s =
|
||||
fun set s v (d:mal_defs) =
|
||||
(s, v) :: (d |> List.filter (not o eq s o #1))
|
||||
|
||||
fun lookup (INNER (d, out)) s = (case get d s of NONE => lookup out s | x => x)
|
||||
fun def s v (INNER (d, out)) = INNER (set s v d, out)
|
||||
| def s v (ENV d) = ENV (set s v d)
|
||||
|
||||
fun let_in s v out = INNER (set s v [], out)
|
||||
|
||||
fun lookup (INNER (d, out)) s = optOrElse (get d s) (fn _ => lookup out s)
|
||||
| lookup (ENV d) s = get d s
|
||||
|
@ -4,32 +4,31 @@ exception NotApplicable of string
|
||||
fun READ s =
|
||||
readStr s
|
||||
|
||||
fun EVAL e ast =
|
||||
case ast of
|
||||
LIST [] => ast
|
||||
| LIST l => eval_apply e ast
|
||||
| _ => eval_ast e ast
|
||||
fun EVAL e (LIST (SYMBOL "def!"::args)) = eval_def e args
|
||||
| EVAL e (ast as (LIST (_::_))) = (e, eval_apply e ast)
|
||||
| EVAL e ast = (e, eval_ast e ast)
|
||||
|
||||
and eval_ast e ast =
|
||||
case ast of
|
||||
SYMBOL s => (case lookup e s of SOME v => v | NONE => raise NotDefined ("unable to resolve symbol '" ^ s ^ "'"))
|
||||
| LIST l => LIST (List.map (EVAL e) l)
|
||||
| _ => ast
|
||||
and eval_ast e (LIST l) = LIST (List.map (#2 o (EVAL e)) l)
|
||||
| eval_ast e (SYMBOL s) = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
||||
| eval_ast e ast = ast
|
||||
|
||||
and eval_apply e ast =
|
||||
case eval_ast e ast of
|
||||
LIST ((FN f)::args) => f args
|
||||
| _ => raise NotApplicable "eval_apply needs a non-empty list"
|
||||
|
||||
and eval_def e [SYMBOL s, ast] = let val (_, v) = EVAL e ast in (def s v e, v) end
|
||||
| eval_def _ _ = raise NotApplicable "define needs a symbol and a value"
|
||||
|
||||
fun PRINT f =
|
||||
prStr f
|
||||
|
||||
fun rep e s =
|
||||
s |> READ |> EVAL e |> PRINT
|
||||
handle Nothing => ""
|
||||
| SyntaxError msg => "SYNTAX ERROR: " ^ msg
|
||||
| NotApplicable msg => "CANNOT APPLY: " ^ msg
|
||||
| NotDefined msg => "NOT DEFINED: " ^ msg
|
||||
s |> READ |> EVAL e |> (fn (e, v) => (e, PRINT v))
|
||||
handle Nothing => (e, "")
|
||||
| SyntaxError msg => (e, "SYNTAX ERROR: " ^ msg)
|
||||
| NotApplicable msg => (e, "CANNOT APPLY: " ^ msg)
|
||||
| NotDefined msg => (e, "NOT DEFINED: " ^ msg)
|
||||
|
||||
fun malPlus (INT a, INT b) = INT (a + b)
|
||||
| malPlus _ = raise NotApplicable "can only add integers"
|
||||
@ -55,14 +54,18 @@ val initEnv =
|
||||
| _ => raise NotApplicable "'/' requires arguments"))
|
||||
|> ENV
|
||||
|
||||
fun repl () =
|
||||
fun repl () = repl' initEnv
|
||||
|
||||
and repl' e =
|
||||
let open TextIO
|
||||
in (
|
||||
print("user> ");
|
||||
case inputLine(stdIn) of
|
||||
SOME(line) => (
|
||||
print((rep initEnv line) ^ "\n");
|
||||
repl ()
|
||||
)
|
||||
SOME(line) =>
|
||||
let val (e', s) = rep e line
|
||||
val _ = print(s ^ "\n")
|
||||
in
|
||||
repl' e'
|
||||
end
|
||||
| NONE => ()
|
||||
) end
|
||||
|
@ -5,3 +5,9 @@ and takeWhile' f acc [] = rev acc
|
||||
infix 3 |> fun x |> f = f x
|
||||
|
||||
fun eq a b = a = b
|
||||
|
||||
fun optOrElse NONE b = b ()
|
||||
| optOrElse a _ = a
|
||||
|
||||
fun valOrElse (SOME x) _ = x
|
||||
| valOrElse a b = b ()
|
||||
|
Loading…
Reference in New Issue
Block a user