mirror of
https://github.com/kanaka/mal.git
synced 2024-08-16 17:20:23 +03:00
step 3 scaffolding
This commit is contained in:
parent
fa7a784fe0
commit
64af767e72
@ -1,4 +1,4 @@
|
||||
STEP_BINS = step0_repl step1_read_print step2_eval
|
||||
STEP_BINS = step0_repl step1_read_print step2_eval step3_env
|
||||
|
||||
all: $(STEP_BINS)
|
||||
|
||||
@ -11,6 +11,9 @@ step1_read_print: step1_read_print.mlb step1_read_print.sml reader.sml printer.s
|
||||
step2_eval: step2_eval.mlb step2_eval.sml env.sml reader.sml printer.sml types.sml util.sml main.sml
|
||||
mlton -output $@ $<
|
||||
|
||||
step3_env: step3_env.mlb step3_env.sml env.sml reader.sml printer.sml types.sml util.sml main.sml
|
||||
mlton -output $@ $<
|
||||
|
||||
clean:
|
||||
rm -f $(STEP_BINS)
|
||||
|
||||
|
11
impls/sml/step3_env.mlb
Normal file
11
impls/sml/step3_env.mlb
Normal file
@ -0,0 +1,11 @@
|
||||
local
|
||||
$(SML_LIB)/basis/basis.mlb
|
||||
util.sml
|
||||
types.sml
|
||||
printer.sml
|
||||
reader.sml
|
||||
env.sml
|
||||
step3_env.sml
|
||||
in
|
||||
main.sml
|
||||
end
|
68
impls/sml/step3_env.sml
Normal file
68
impls/sml/step3_env.sml
Normal file
@ -0,0 +1,68 @@
|
||||
exception NotDefined of string
|
||||
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
|
||||
|
||||
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_apply e ast =
|
||||
case eval_ast e ast of
|
||||
LIST ((FN f)::args) => f args
|
||||
| _ => raise NotApplicable "eval_apply needs a non-empty list"
|
||||
|
||||
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
|
||||
|
||||
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"
|
||||
|
||||
val initEnv = ENV [
|
||||
("+", FN (foldl malPlus (INT 0))),
|
||||
("*", FN (foldl malTimes (INT 1))),
|
||||
("-", FN (
|
||||
fn [x] => malMinus (x, INT 0)
|
||||
| x::xs => foldr malMinus x xs
|
||||
| _ => raise NotApplicable "'-' requires at least one argument"
|
||||
)),
|
||||
("/", FN (
|
||||
fn [x] => malDiv (x, INT 1)
|
||||
| x::xs => foldr malDiv x xs
|
||||
| _ => raise NotApplicable "'/' requires at least one argument"
|
||||
))
|
||||
]
|
||||
|
||||
fun repl () =
|
||||
let open TextIO
|
||||
in (
|
||||
print("user> ");
|
||||
case inputLine(stdIn) of
|
||||
SOME(line) => (
|
||||
print((rep initEnv line) ^ "\n");
|
||||
repl ()
|
||||
)
|
||||
| NONE => ()
|
||||
) end
|
Loading…
Reference in New Issue
Block a user