2021-03-26 14:05:05 +03:00
|
|
|
exception NotDefined of string
|
|
|
|
exception NotApplicable of string
|
|
|
|
|
2021-04-07 15:49:00 +03:00
|
|
|
fun read s =
|
2021-03-26 14:05:05 +03:00
|
|
|
readStr s
|
|
|
|
|
2022-01-10 02:15:40 +03:00
|
|
|
(* TextIO.print ("EVAL: " ^ prReadableStr ast ^ "\n") *)
|
2021-04-07 15:49:00 +03:00
|
|
|
fun eval e ast = case ast of
|
|
|
|
LIST (_::_,_) => evalApply e ast
|
|
|
|
| _ => evalAst e ast
|
2021-03-26 14:05:05 +03:00
|
|
|
|
2021-04-07 15:49:00 +03:00
|
|
|
and evalAst e ast = case ast of
|
2021-04-06 20:50:25 +03:00
|
|
|
SYMBOL s => (case lookup e s of SOME v => v | NONE => raise NotDefined ("unable to resolve symbol '" ^ s ^ "'"))
|
2021-04-07 15:49:00 +03:00
|
|
|
| LIST (l,_) => LIST (List.map (eval e) l, NO_META)
|
|
|
|
| VECTOR (v,_) => VECTOR (List.map (eval e) v, NO_META)
|
2021-08-21 20:08:17 +03:00
|
|
|
| MAP (m,_) => MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META)
|
2021-04-06 20:50:25 +03:00
|
|
|
| _ => ast
|
2021-03-26 14:05:05 +03:00
|
|
|
|
2021-04-07 15:49:00 +03:00
|
|
|
and evalApply e ast = case evalAst e ast of
|
2021-04-06 20:50:25 +03:00
|
|
|
LIST ((FN (f,_))::args, _) => f args
|
|
|
|
| _ => raise NotApplicable "eval_apply needs a non-empty list"
|
2021-03-26 14:05:05 +03:00
|
|
|
|
2021-04-07 15:49:00 +03:00
|
|
|
fun print f =
|
2021-04-03 00:37:25 +03:00
|
|
|
prReadableStr f
|
2021-03-26 14:05:05 +03:00
|
|
|
|
|
|
|
fun rep e s =
|
2021-04-07 15:49:00 +03:00
|
|
|
s |> read |> eval e |> print
|
2021-04-06 20:50:25 +03:00
|
|
|
handle Nothing => ""
|
|
|
|
| e => "ERROR: " ^ (exnMessage e)
|
2021-03-26 14:05:05 +03:00
|
|
|
|
|
|
|
fun malPlus (INT a, INT b) = INT (a + b)
|
|
|
|
| malPlus _ = raise NotApplicable "can only add integers"
|
|
|
|
fun malTimes (INT a, INT b) = INT (a * b)
|
|
|
|
| malTimes _ = raise NotApplicable "can only multiply integers"
|
|
|
|
fun malMinus (INT b, INT a) = INT (a - b)
|
|
|
|
| malMinus _ = raise NotApplicable "can only subtract integers"
|
|
|
|
fun malDiv (INT b, INT a) = INT (a div b)
|
|
|
|
| malDiv _ = raise NotApplicable "can only divide integers"
|
|
|
|
|
2021-04-06 20:50:25 +03:00
|
|
|
val replEnv = ENV (NS (ref [
|
|
|
|
("+", FN (foldl malPlus (INT 0), NO_META)),
|
|
|
|
("*", FN (foldl malTimes (INT 1), NO_META)),
|
2021-03-26 14:05:05 +03:00
|
|
|
("-", FN (
|
|
|
|
fn [x] => malMinus (x, INT 0)
|
|
|
|
| x::xs => foldr malMinus x xs
|
|
|
|
| _ => raise NotApplicable "'-' requires at least one argument"
|
2021-04-06 20:50:25 +03:00
|
|
|
, NO_META
|
2021-03-26 14:05:05 +03:00
|
|
|
)),
|
|
|
|
("/", FN (
|
|
|
|
fn [x] => malDiv (x, INT 1)
|
|
|
|
| x::xs => foldr malDiv x xs
|
|
|
|
| _ => raise NotApplicable "'/' requires at least one argument"
|
2021-04-06 20:50:25 +03:00
|
|
|
, NO_META
|
2021-03-26 14:05:05 +03:00
|
|
|
))
|
2021-04-01 19:12:41 +03:00
|
|
|
]))
|
2021-03-26 14:05:05 +03:00
|
|
|
|
|
|
|
fun repl () =
|
|
|
|
let open TextIO
|
|
|
|
in (
|
|
|
|
print("user> ");
|
|
|
|
case inputLine(stdIn) of
|
|
|
|
SOME(line) => (
|
2021-04-06 20:50:25 +03:00
|
|
|
print((rep replEnv line) ^ "\n");
|
2021-03-26 14:05:05 +03:00
|
|
|
repl ()
|
|
|
|
)
|
|
|
|
| NONE => ()
|
|
|
|
) end
|
2021-03-29 15:06:10 +03:00
|
|
|
|
|
|
|
fun main () = repl ()
|