mirror of
https://github.com/kanaka/mal.git
synced 2024-09-11 13:55:55 +03:00
SML: Step 2
This commit is contained in:
parent
1c637768c0
commit
fa7a784fe0
@ -1,4 +1,4 @@
|
|||||||
STEP_BINS = step0_repl step1_read_print
|
STEP_BINS = step0_repl step1_read_print step2_eval
|
||||||
|
|
||||||
all: $(STEP_BINS)
|
all: $(STEP_BINS)
|
||||||
|
|
||||||
@ -8,6 +8,9 @@ step0_repl: step0_repl.mlb step0_repl.sml main.sml
|
|||||||
step1_read_print: step1_read_print.mlb step1_read_print.sml reader.sml printer.sml types.sml util.sml main.sml
|
step1_read_print: step1_read_print.mlb step1_read_print.sml reader.sml printer.sml types.sml util.sml main.sml
|
||||||
mlton -output $@ $<
|
mlton -output $@ $<
|
||||||
|
|
||||||
|
step2_eval: step2_eval.mlb step2_eval.sml env.sml reader.sml printer.sml types.sml util.sml main.sml
|
||||||
|
mlton -output $@ $<
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f $(STEP_BINS)
|
rm -f $(STEP_BINS)
|
||||||
|
|
||||||
|
5
impls/sml/env.sml
Normal file
5
impls/sml/env.sml
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
datatype mal_env = ENV of (string * mal_type) list
|
||||||
|
|
||||||
|
fun lookup (ENV fs) s =
|
||||||
|
fs |> List.find (eq s o #1)
|
||||||
|
|> Option.map #2
|
@ -4,3 +4,4 @@ fun prStr NIL = "nil"
|
|||||||
| prStr (BOOL false) = "false"
|
| prStr (BOOL false) = "false"
|
||||||
| prStr (INT i) = if i >= 0 then Int.toString i else "-" ^ (Int.toString (Int.abs i))
|
| prStr (INT i) = if i >= 0 then Int.toString i else "-" ^ (Int.toString (Int.abs i))
|
||||||
| 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 f) = "<function>"
|
||||||
|
11
impls/sml/step2_eval.mlb
Normal file
11
impls/sml/step2_eval.mlb
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
local
|
||||||
|
$(SML_LIB)/basis/basis.mlb
|
||||||
|
util.sml
|
||||||
|
types.sml
|
||||||
|
printer.sml
|
||||||
|
reader.sml
|
||||||
|
env.sml
|
||||||
|
step2_eval.sml
|
||||||
|
in
|
||||||
|
main.sml
|
||||||
|
end
|
68
impls/sml/step2_eval.sml
Normal file
68
impls/sml/step2_eval.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
|
@ -3,3 +3,4 @@ datatype mal_type = NIL
|
|||||||
| BOOL of bool
|
| BOOL of bool
|
||||||
| INT of int
|
| INT of int
|
||||||
| LIST of mal_type list
|
| LIST of mal_type list
|
||||||
|
| FN of mal_type list -> mal_type
|
||||||
|
@ -3,3 +3,5 @@ and takeWhile' f acc [] = rev acc
|
|||||||
| takeWhile' f acc (x::xs) = if f x then takeWhile' f (x::acc) xs else rev acc
|
| takeWhile' f acc (x::xs) = if f x then takeWhile' f (x::acc) xs else rev acc
|
||||||
|
|
||||||
infix 3 |> fun x |> f = f x
|
infix 3 |> fun x |> f = f x
|
||||||
|
|
||||||
|
fun eq a b = a = b
|
||||||
|
Loading…
Reference in New Issue
Block a user