function eval { (x:tree; rho:Env) :Value forwarded }; { eval :Exp -> Env -> Value Note: evaluates an Expression and returns a Value} {POST: result tag is not deferval, weak head normal form} var func, switch :Value; begin case x^.tag of ident: eval:=applyenv(rho, x^.id); intcon: eval:=mkint(x^.n); boolcon: eval:=mkbool(x^.b); charcon: eval:=mkchar(x^.ch); nilcon: eval:=mkvalue(nilval); emptycon: eval:=mkvalue(emptyval); lambdaexp: eval:=mkfunc(x, rho); application: begin func := eval(x^.fun, rho); if func^.tag=funcval then eval:=apply(func, defer(x^.aparam, rho)) else error('apply ~fn ') end; unexp: eval:=U(x^.unopr, eval(x^.unarg, rho)); binexp: if x^.binopr=conssy then { cons should not eval its params } eval:=O(x^.binopr, defer(x^.left,rho), defer(x^.right,rho)) else eval:=O(x^.binopr, eval(x^.left,rho), {others strict} eval(x^.right,rho)); ifexp: begin switch:=eval(x^.e1, rho); if switch^.tag=boolval then if switch^.b then eval:=eval(x^.e2, rho) else eval:=eval(x^.e3, rho) else error('if ~bool ') end; block: eval:=eval( x^.exp, D(x^.decs, rho)) end {case} ; evals := evals + 1 { statistics } end {eval}; procedure force { ( v :Value ) forwarded } ; var fv :Value; begin if v^.tag=deferval then begin fv := eval( v^.e, v^.r ); v^ := fv^ {overwrite} end end; {\fB Evaluate an Expression. \fP} {Do not remove: Lazy.p, Strict.p, lazy.*.P, strict.*.P, lex.*.P, & syntax.*.P } { are released under Gnu `copyleft' General Public Licence (GPL) } { - L. Allison, CSSE, Monash Uni., .au, 7/2003. }