mirror of
https://github.com/kanaka/mal.git
synced 2024-08-17 01:30:26 +03:00
SML: Step 3
This commit is contained in:
parent
3a53a42461
commit
8d3f32804e
@ -1,7 +1,6 @@
|
||||
type mal_defs = (string * mal_type) list
|
||||
|
||||
datatype mal_env = ENV of mal_defs
|
||||
| INNER of (mal_defs * mal_env)
|
||||
|
||||
fun get (d:mal_defs) s =
|
||||
d |> List.find (eq s o #1) |> Option.map #2
|
||||
@ -9,10 +8,6 @@ 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 def s v (INNER (d, out)) = INNER (set s v d, out)
|
||||
| def s v (ENV d) = ENV (set s v d)
|
||||
fun 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
|
||||
fun lookup (ENV d) s = get d s
|
||||
|
@ -5,10 +5,13 @@ fun READ s =
|
||||
readStr s
|
||||
|
||||
fun EVAL e (LIST (SYMBOL "def!"::args)) = eval_def e args
|
||||
| EVAL e (LIST (SYMBOL "let*"::args)) = eval_let e args
|
||||
| EVAL e (ast as (LIST (_::_))) = (e, eval_apply e ast)
|
||||
| EVAL e ast = (e, eval_ast e ast)
|
||||
|
||||
and eval_ast e (LIST l) = LIST (List.map (#2 o (EVAL e)) l)
|
||||
and EVAL' e ast = (#2 o EVAL e) ast
|
||||
|
||||
and eval_ast e (LIST l) = LIST (List.map (EVAL' e) l)
|
||||
| eval_ast e (SYMBOL s) = valOrElse (lookup e s) (fn _ => raise NotDefined ("symbol '" ^ s ^ "' not found"))
|
||||
| eval_ast e ast = ast
|
||||
|
||||
@ -17,8 +20,15 @@ and eval_apply e ast =
|
||||
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"
|
||||
and eval_def e [SYMBOL s, ast] = let val v = EVAL' e ast in (def s v e, v) end
|
||||
| eval_def _ _ = raise NotApplicable "def! needs a symbol and a form to evaluate"
|
||||
|
||||
and eval_let e [LIST bindings, ast] = (e, EVAL' (bind bindings e) ast)
|
||||
| eval_let _ _ = raise NotApplicable "let* needs a list of bindings and a form to evaluate"
|
||||
|
||||
and bind (SYMBOL s::v::rest) e = def s (EVAL' e v) e |> bind rest
|
||||
| bind [] e = e
|
||||
| bind _ _ = raise NotApplicable "bindings must be a list of symbol/form pairs"
|
||||
|
||||
fun PRINT f =
|
||||
prStr f
|
||||
@ -39,20 +49,20 @@ fun malMinus (INT b, INT a) = INT (a - b)
|
||||
fun malDiv (INT b, INT a) = INT (a div b)
|
||||
| malDiv _ = raise NotApplicable "can only divide integers"
|
||||
|
||||
val initEnv =
|
||||
[] |> set "+"
|
||||
(FN (foldl malPlus (INT 0)))
|
||||
|> set "*"
|
||||
(FN (foldl malTimes (INT 1)))
|
||||
|> set "-"
|
||||
(FN (fn [x] => malMinus (x, INT 0)
|
||||
| x::xs => foldr malMinus x xs
|
||||
| _ => raise NotApplicable "'-' requires arguments"))
|
||||
|> set "/"
|
||||
(FN (fn [x] => malDiv (x, INT 1)
|
||||
| x::xs => foldr malDiv x xs
|
||||
| _ => raise NotApplicable "'/' requires arguments"))
|
||||
|> ENV
|
||||
val initEnv = ENV [] |> bind [
|
||||
SYMBOL "+",
|
||||
FN (foldl malPlus (INT 0)),
|
||||
SYMBOL "*",
|
||||
FN (foldl malTimes (INT 1)),
|
||||
SYMBOL "-",
|
||||
FN (fn [x] => malMinus (x, INT 0)
|
||||
| x::xs => foldr malMinus x xs
|
||||
| _ => raise NotApplicable "'-' requires arguments"),
|
||||
SYMBOL "/",
|
||||
FN (fn [x] => malDiv (x, INT 1)
|
||||
| x::xs => foldr malDiv x xs
|
||||
| _ => raise NotApplicable "'/' requires arguments")
|
||||
]
|
||||
|
||||
fun repl () = repl' initEnv
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user