Commit dc62066f authored by Matt Vaughan's avatar Matt Vaughan
Browse files

push before working at office

parent 5db68595
......@@ -120,11 +120,77 @@ fun repWith checkF trueF falseF elem =
then trueF elem
else falseF elem
exception WrongArgToPrim
val primfs = [("+",(fn args => case args
of [LITERAL (NUM n1), LITERAL (NUM n2)] =>
LITERAL (NUM (n1+n2))
| _ => raise WrongArgToPrim)),
("-",(fn args => case args
of [LITERAL (NUM n1), LITERAL (NUM n2)] =>
LITERAL (NUM (n1-n2))
| _ => raise WrongArgToPrim)),
("*",(fn args => case args
of [LITERAL (NUM n1), LITERAL (NUM n2)] =>
LITERAL (NUM (n1*n2))
| _ => raise WrongArgToPrim)),
("/",(fn args => case args
of [LITERAL (NUM n1), LITERAL (NUM n2)] =>
LITERAL (NUM (n1 div n2))
| _ => raise WrongArgToPrim)),
("<",(fn args => case args
of [LITERAL (NUM n1), LITERAL (NUM n2)] =>
LITERAL (BOOL (n1<n2))
| _ => raise WrongArgToPrim)),
(">",(fn args => case args
of [LITERAL (NUM n1), LITERAL (NUM n2)] =>
LITERAL (BOOL (n1>n2))
| _ => raise WrongArgToPrim)),
("=",(fn args => case args
of [LITERAL (NUM n1), LITERAL (NUM n2)] =>
LITERAL (BOOL (n1 = n2))
| _ => raise WrongArgToPrim)),
("null?",
(fn _ => (print "Incomplete\n" ; raise WrongArgToPrim))),
("boolean?",
(fn _ => (print "Incomplete\n" ; raise WrongArgToPrim))),
("number?",
(fn _ => (print "Incomplete\n" ; raise WrongArgToPrim))),
("symbol?",
(fn _ => (print "Incomplete\n" ; raise WrongArgToPrim))),
("pair?",
(fn _ => (print "Incomplete\n" ; raise WrongArgToPrim))),
("procedure?",
(fn _ => (print "Incomplete\n" ; raise WrongArgToPrim))),
("cons",(fn args => case args
of [LITERAL x, LITERAL y] =>
LITERAL (PAIR (x,y))
| _ => raise WrongArgToPrim)),
("car",(fn args => case args
of [LITERAL (PAIR (fst,snd))] => LITERAL fst
| _ => raise WrongArgToPrim)),
("cdr",(fn args => case args
of [LITERAL (PAIR (fst,snd))] => LITERAL snd
| _ => raise WrongArgToPrim)),
("print",(fn args =>
let fun p (LITERAL (NUM x)) = Int.toString x
| p (LITERAL (BOOL b)) = Bool.toString b
| p (LITERAL (PAIR (a,b))) =
concat ["(",p (LITERAL a)," . ",
p (LITERAL b),")"]
| p other = "other"
in (print (p (hd args)) ; LITERAL NIL)
end)),
("error",
(fn _ => (print "Incomplete\n" ; raise WrongArgToPrim)))];
exception IFXNeedsBoolConditional
exception Unimplemented
exception CantApplyNonLambda
fun interpexp envs (LITERAL vv) = (envs, LITERAL vv)
| interpexp envs (VAR n) = (envs, lookup envs n)
| interpexp envs (VAR n) =
if has primfs n
then (envs, LITERAL (PRIMITIVE n))
else (envs, lookup envs n)
| interpexp envs (SET (n,e)) =
let val (envs', e') = interpexp (doset envs (n, (LITERAL NIL))) e
in (doset envs' (n,e), LITERAL NIL)
......@@ -136,10 +202,22 @@ fun interpexp envs (LITERAL vv) = (envs, LITERAL vv)
| LITERAL (BOOL false) => interpexp envs' else'
| _ => raise IFXNeedsBoolConditional
end
| interpexp envs (LAMBDA l) = (envs, LAMBDA l)
| interpexp envs (APPLY (LITERAL (PRIMITIVE n), args)) =
let val f = lookup primfs n
val (envs', args')
= foldl (fn (arg, (envs, args')) =>
let val (envs', arg') = interpexp envs arg
in (envs', args' @ [arg'])
end) (envs, []) args
in (envs', f args')
end
| interpexp envs (APPLY (f, args)) =
let val (envs', (formals, body)) = (case interpexp envs f
of (envs', LAMBDA(f,b)) => (envs',(f,b))
| _ => raise CantApplyNonLambda)
| _ =>
(app print ["Non-Lambda"] ;
raise CantApplyNonLambda))
val binds = ListPair.zip (formals, args)
(* deal with side effects *)
fun evalArgs ((name, arg), (envs', binds)) =
......
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment