(* Simple arithmetic expressions * sestoft@dina.kvl.dk 2001-02-07 *) load "Absyn"; open Absyn; (* Some closed expressions: *) val e1 = Let("z", CstI 17, Prim("+", [Var "z", Var "z"])); val e2 = Let("z", CstI 17, Prim("+", [Let("z", CstI 22, Prim("*", [CstI 100, Var "z"])), Var "z"])); val e3 = Let("z", Prim("-", [CstI 5, CstI 4]), Prim("*", [CstI 100, Var "z"])); (* ---------------------------------------------------------------------- *) (* Formatting expressions as strings *) val e4 = Prim("-", [Prim("-", [Var "a", Var "b"]), Var "c"]); val e5 = Prim("-", [Var "a", Prim("-", [Var "b", Var "c"])]); val e6 = Prim("*", [Prim("-", [Var "a", Var "b"]), Var "c"]); val e7 = Prim("-", [Prim("*", [Var "a", Var "b"]), Var "c"]); val e8 = Prim("*", [Var "a", Prim("-", [Var "b", Var "c"])]); val e9 = Prim("-", [Var "a", Prim("*", [Var "b", Var "c"])]); val es = [e1, e2, e3, e4, e5, e6, e7, e8, e9]; fun fmt1 (e : expr) : string = case e of CstI i => Int.toString i | Var x => x | Let(x, erhs, ebody) => String.concat["let ", x, " = ", fmt1 erhs, " in ", fmt1 ebody, " end"] | Prim(ope, [e1, e2]) => String.concat["(", fmt1 e1, ope, fmt1 e2, ")"] (* Format expressions as strings, avoiding excess parentheses *) fun fmt2 (ctxpre : int) (e : expr) = case e of CstI i => Int.toString i | Var x => x | Let(x, erhs, ebody) => String.concat["let ", x, " = ", fmt2 ~1 erhs, " in ", fmt2 ~1 ebody, " end"] | Prim(ope, [e1, e2]) => (case ope of "+" => wrappar ctxpre 6 [fmt2 5 e1, ope, fmt2 6 e2] | "-" => wrappar ctxpre 6 [fmt2 5 e1, ope, fmt2 6 e2] | "*" => wrappar ctxpre 7 [fmt2 6 e1, ope, fmt2 7 e2] | _ => raise Fail "unknown primitive") and wrappar ctxpre pre ss = if pre <= ctxpre then String.concat ("(" :: ss @ [")"]) else String.concat ss fun fmt e = fmt2 ~1 e; (* ---------------------------------------------------------------------- *) (* Evaluation *) fun lookup env x = let fun h [] = raise Fail "unknown variable" | h ((y, v)::yr) = if x=y then v else h yr in h env end fun eval e (env : (string * int) list) : int = case e of CstI i => i | Var x => lookup env x | Let(x, erhs, ebody) => let val xval = eval erhs env val env1 = (x, xval) :: env in eval ebody env1 end | Prim("+", [e1, e2]) => eval e1 env + eval e2 env | Prim("*", [e1, e2]) => eval e1 env * eval e2 env | Prim("-", [e1, e2]) => eval e1 env - eval e2 env | Prim _ => raise Fail "unknown primitive" fun eval0 e = eval e [] (* ---------------------------------------------------------------------- *) (* Closedness *) (* Checking whether an expression is closed. The environment env is a list of the bound variables. *) fun member x [] = false | member x (y::yr) = x=y orelse member x yr; fun closedin e (env : string list) : bool = case e of CstI i => true | Var x => member x env | Let(x, erhs, ebody) => let val env1 = x :: env in closedin erhs env andalso closedin ebody env1 end | Prim(ope, [e1, e2]) => closedin e1 env andalso closedin e2 env; (* An expression is closed if it is closed in the empty environment *) fun closed1 e = closedin e []; (* ---------------------------------------------------------------------- *) (* Free variables *) (* Operations on sets, represented as lists. Simple but inefficient; use binary trees, hashtables or splaytrees for efficiency. *) (* union(xs, ys) is the set of all elements in xs or ys, without duplicates *) fun union ([], ys) = ys | union (x::xr, ys) = if member x ys then union(xr, ys) else x :: union(xr, ys); (* minus xs ys is the set of all elements in xs but not in ys *) fun minus ([], ys) = [] | minus (x::xr, ys) = if member x ys then minus(xr, ys) else x :: minus (xr, ys); (* Find all variables that occur free in expression e *) fun freevars e : string list = case e of CstI i => [] | Var x => [x] | Let(x, erhs, ebody) => union (freevars erhs, minus (freevars ebody, [x])) | Prim(ope, [e1, e2]) => union (freevars e1, freevars e2) | Prim _ => raise Fail "freevars: prim"; (* Alternative definition of closed *) fun closed2 e = (freevars e = []) (* ---------------------------------------------------------------------- *) (* Compilation to target expressions with numerical indexes instead of symbolic variable names. *) datatype texpr = (* target expressions *) TCstI of int | TVar of int (* index into runtime environment *) | TLet of texpr * texpr | TPrim of string * texpr list (* Map variable name to variable index at compile-time *) fun getindex (cenv : ''a list) (x : ''a) = let fun h [] = raise Fail "unknown variable" | h (y::yr) = if x=y then 0 else 1 + h yr in h cenv end (* Compiling from expr to texpr. The compile-time environment cenv is a list of variable names; the position of a variable in the list indicates its binding depth and hence the position in the runtime environment. The integer giving the position is the same as a deBruijn index in the lambda calculus: the number of binders between this occurrence of a variable, and its binding. *) fun tcomp e (cenv : string list) : texpr = case e of CstI i => TCstI i | Var x => TVar (getindex cenv x) | Let(x, erhs, ebody) => let val cenv1 = x :: cenv in TLet(tcomp erhs cenv, tcomp ebody cenv1) end | Prim(ope, [e1, e2]) => TPrim(ope, [tcomp e1 cenv, tcomp e2 cenv]) | Prim _ => raise Fail "tcomp: prim"; (* Evaluation of target expressions with variable indexes. The run-time environment renv is a list of variable values (ints). *) fun teval e (renv : int list) : int = case e of TCstI i => i | TVar x => List.nth(renv, x) | TLet(erhs, ebody) => let val xval = teval erhs renv val renv1 = xval :: renv in teval ebody renv1 end | TPrim("+", [e1, e2]) => teval e1 renv + teval e2 renv | TPrim("*", [e1, e2]) => teval e1 renv * teval e2 renv | TPrim("-", [e1, e2]) => teval e1 renv - teval e2 renv | TPrim _ => raise Fail "unknown primitive" (* Correctness: eval e [] equals teval (tcomp e []) [] *) (* ---------------------------------------------------------------------- *) (* Stack machines *) (* Stack machine instructions. An expressions in postfix or reverse Polish form is a list of stack machine instructions. *) datatype rinstr = RCstI of int | RAdd | RSub | RMul | RDup | RSwap (* A simple stack machine for evaluation of variable-free expressions in postfix form *) fun reval ([] : rinstr list) (v :: _) = v | reval ([] : rinstr list) [] = raise Fail "reval: no result" | reval (inst :: rest) stk = case (inst, stk) of (RCstI i, _) => reval rest (i::stk) | (RAdd, i2 :: i1 :: stkr) => reval rest ((i1+i2)::stkr) | (RSub, i2 :: i1 :: stkr) => reval rest ((i1-i2)::stkr) | (RMul, i2 :: i1 :: stkr) => reval rest ((i1*i2)::stkr) | (RDup, i1 :: stkr) => reval rest (i1 :: i1 :: stkr) | (RSwap, i2 :: i1 :: stkr) => reval rest (i1 :: i2 :: stkr) val rpn1 = reval [RCstI 10, RCstI 17, RDup, RMul, RAdd] []; (* Compilation of a variable-free expression to a rinstr list *) fun rcomp e : rinstr list = case e of CstI i => [RCstI i] | Prim("+", [e1, e2]) => rcomp e1 @ rcomp e2 @ [RAdd] | Prim("*", [e1, e2]) => rcomp e1 @ rcomp e2 @ [RMul] | Prim("-", [e1, e2]) => rcomp e1 @ rcomp e2 @ [RSub] | Prim _ => raise Fail "unknown primitive" (* Correctness: eval e [] [] equals reval (rcomp e) [] *) (* Storing intermediate results and variable bindings in the same stack. We can store intermediate results as well as variable bindings on the same stack. This is possible because the scopes of variables are statically nested: the scope of a variable (and hence the need for its binding) does not extend beyond the expression in which it is bound. *) datatype sinstr = SCstI of int (* push integer *) | SVar of int (* push variable from env *) | SPop (* pop value/unbind var *) | SSwap (* exchange top and next *) | SPrim2 of string (* take ops, put result *) fun seval ([] : sinstr list) (v::_) = v | seval ([] : sinstr list) _ = raise Fail "seval: no result??" | seval (inst :: rest) stk = (case (inst, stk) of (SCstI i, _) => seval rest (i :: stk) | (SVar i, _) => seval rest (List.nth(stk, i) :: stk) | (SPop, _ :: stkr) => seval rest stkr | (SSwap, i2::i1::stkr) => seval rest (i1::i2::stkr) | (SPrim2 ope, i2::i1::stkr) => (case ope of "+" => seval rest (i1+i2 :: stkr) | "-" => seval rest (i1-i2 :: stkr) | "*" => seval rest (i1*i2 :: stkr) | _ => raise Fail "seval: SPrim2")) (* To compile for the single-stack machine, we must keep count (at compile-time) of the intermediate results, interspersed between the variable bindings on the stack. For this we need a compile-time variable environment with dummies Intrm for intermediate values. *) datatype rtvalue = Bound of string (* A bound variable *) | Intrm; (* An intermediate result *) (* Compilation to a list of instructions for a unified-stack machine *) fun scomp e (cenv : rtvalue list) : sinstr list = case e of CstI i => [SCstI i] | Var x => [SVar (getindex cenv (Bound x))] | Let(x, erhs, ebody) => scomp erhs cenv @ scomp ebody (Bound x :: cenv) @ [SSwap, SPop] | Prim(ope, [e1, e2]) => scomp e1 cenv @ scomp e2 (Intrm :: cenv) @ [SPrim2 ope]; val ss = map (fn e => scomp e []) [e1, e2]; (* Correctness: eval e [] [] equals seval (scomp e []) [] for an expression with no free variables. *) (* Net effect principle: the net result of evaluation, by seval, of the code generated, by scomp, from an expression e, is to push the value of e onto the evaluation stack. Hence if v = eval e [] [] then for any stack stk, seval (scomp e []) s equals v :: s *) (* Output the integers in list inss to the text file called fname: *) fun instofile (inss : int list) (fname : string) = let val os = TextIO.openOut fname fun outn n = TextIO.output(os, " " ^ Int.toString n); in List.app outn inss; TextIO.closeOut os end;