2021-03-30 13:15:41 +03:00
|
|
|
fun read s =
|
|
|
|
readStr s
|
|
|
|
|
2022-01-10 02:15:40 +03:00
|
|
|
fun eval e ast = (
|
|
|
|
case lookup e "DEBUG-EVAL" of
|
|
|
|
SOME(x) => if truthy x
|
|
|
|
then TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n")
|
|
|
|
else ()
|
|
|
|
| NONE => ();
|
|
|
|
eval' e ast)
|
|
|
|
|
|
|
|
and eval' e (LIST (a::args,_)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args)
|
|
|
|
| eval' e (SYMBOL s) = evalSymbol e s
|
|
|
|
| eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META)
|
|
|
|
| eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META)
|
|
|
|
| eval' e ast = ast
|
2021-04-05 18:46:23 +03:00
|
|
|
|
|
|
|
and specialEval (SYMBOL "def!") = SOME evalDef
|
|
|
|
| specialEval (SYMBOL "let*") = SOME evalLet
|
|
|
|
| specialEval (SYMBOL "do") = SOME evalDo
|
|
|
|
| specialEval (SYMBOL "if") = SOME evalIf
|
|
|
|
| specialEval (SYMBOL "fn*") = SOME evalFn
|
|
|
|
| specialEval _ = NONE
|
2021-03-30 13:15:41 +03:00
|
|
|
|
2021-04-01 19:12:41 +03:00
|
|
|
and evalDef e [SYMBOL s, ast] = let val v = eval e ast in (def s v e; v) end
|
2021-04-06 20:50:25 +03:00
|
|
|
| evalDef _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
2021-03-30 13:15:41 +03:00
|
|
|
|
2021-04-06 20:50:25 +03:00
|
|
|
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"
|
2021-03-30 13:15:41 +03:00
|
|
|
|
2021-04-01 19:12:41 +03:00
|
|
|
and evalDo e (x::xs) = foldl (fn (x, _) => eval e x) (eval e x) xs
|
2021-04-06 20:50:25 +03:00
|
|
|
| evalDo _ _ = raise NotApplicable "do needs at least one argument"
|
2021-03-30 13:15:41 +03:00
|
|
|
|
2021-04-01 19:12:41 +03:00
|
|
|
and evalIf e [c,a,b] = if truthy (eval e c) then eval e a else eval e b
|
2021-03-30 13:15:41 +03:00
|
|
|
| evalIf e [c,a] = evalIf e [c,a,NIL]
|
2021-04-06 20:50:25 +03:00
|
|
|
| evalIf _ _ = raise NotApplicable "if needs two or three arguments"
|
2021-03-30 13:15:41 +03:00
|
|
|
|
2021-04-06 20:50:25 +03:00
|
|
|
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 (interleave binds exprs) (inside e)) body, NO_META)
|
2021-03-30 13:15:41 +03:00
|
|
|
|
2021-04-06 20:50:25 +03:00
|
|
|
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, NO_META)))
|
2021-03-30 13:15:41 +03:00
|
|
|
|
|
|
|
and evalSymbol e s = valOrElse (lookup e s)
|
|
|
|
(fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
|
|
|
|
2021-04-05 20:28:54 +03:00
|
|
|
and bindLet args e = bind' (eval e) args e
|
|
|
|
and bind args e = bind' identity args e
|
2021-04-06 20:50:25 +03:00
|
|
|
and bind' evl (SYMBOL "&"::v::(SYMBOL s)::vs) e = (def s (LIST (map evl (v::vs), NO_META)) e; e)
|
|
|
|
| bind' _ [SYMBOL "&", SYMBOL s] e = (def s (LIST ([], NO_META)) e; e)
|
2021-04-05 20:28:54 +03:00
|
|
|
| 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"
|
2021-03-30 13:15:41 +03:00
|
|
|
|
|
|
|
fun print f =
|
2021-03-30 18:33:57 +03:00
|
|
|
prReadableStr f
|
2021-03-30 13:15:41 +03:00
|
|
|
|
|
|
|
fun rep e s =
|
2021-04-01 19:12:41 +03:00
|
|
|
s |> read |> eval e |> print
|
|
|
|
handle Nothing => ""
|
|
|
|
| SyntaxError msg => "SYNTAX ERROR: " ^ msg
|
|
|
|
| NotApplicable msg => "CANNOT APPLY: " ^ msg
|
|
|
|
| NotDefined msg => "NOT DEFINED: " ^ msg
|
2021-03-30 13:15:41 +03:00
|
|
|
|
2021-04-06 20:50:25 +03:00
|
|
|
val replEnv = ENV (NS (ref [])) |> bind coreNs
|
2021-03-30 13:15:41 +03:00
|
|
|
|
|
|
|
fun repl e =
|
|
|
|
let open TextIO
|
|
|
|
in (
|
|
|
|
print("user> ");
|
|
|
|
case inputLine(stdIn) of
|
|
|
|
SOME(line) =>
|
2021-04-01 19:12:41 +03:00
|
|
|
let val s = rep e line
|
2021-03-30 13:15:41 +03:00
|
|
|
val _ = print(s ^ "\n")
|
|
|
|
in
|
2021-04-01 19:12:41 +03:00
|
|
|
repl e
|
2021-03-30 13:15:41 +03:00
|
|
|
end
|
|
|
|
| NONE => ()
|
|
|
|
) end
|
|
|
|
|
2021-03-30 21:27:24 +03:00
|
|
|
val prelude = " \
|
2021-04-03 00:42:35 +03:00
|
|
|
\(def! not (fn* (a) (if a false true))) \
|
2021-03-30 21:27:24 +03:00
|
|
|
\(def! \
|
|
|
|
\ load-file \
|
|
|
|
\ (fn* (f) \
|
|
|
|
\ (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"
|
|
|
|
|
2021-04-01 19:12:41 +03:00
|
|
|
fun main () = (
|
2021-04-01 20:31:26 +03:00
|
|
|
bind [
|
|
|
|
SYMBOL "eval",
|
2021-04-06 20:50:25 +03:00
|
|
|
FN (fn ([x]) => eval replEnv x
|
|
|
|
| _ => raise NotApplicable "'eval' requires one argument", NO_META)
|
|
|
|
] replEnv;
|
|
|
|
rep replEnv ("(do " ^ prelude ^ " nil)");
|
2021-04-01 20:31:26 +03:00
|
|
|
case CommandLine.arguments () of
|
|
|
|
prog::args => (
|
2021-04-06 20:50:25 +03:00
|
|
|
def "*ARGV*" (LIST (map STRING args, NO_META)) replEnv;
|
|
|
|
rep replEnv ("(load-file \"" ^ prog ^ "\")");
|
2021-04-01 20:31:26 +03:00
|
|
|
()
|
|
|
|
)
|
2021-04-03 00:42:50 +03:00
|
|
|
| args => (
|
2021-04-06 20:50:25 +03:00
|
|
|
def "*ARGV*" (LIST (map STRING args, NO_META)) replEnv;
|
|
|
|
repl replEnv
|
2021-04-03 00:42:50 +03:00
|
|
|
)
|
2021-04-01 19:12:41 +03:00
|
|
|
)
|