Strict Interpreter
It is a useful exercise to compare the lazy interpreter with the strict interpreter. The two share many components, particularly the lexical and syntax analysers. Other parts differ in small but subtle ways.
Evaluation is print driven in the lazy interpreter but not so in the strict interpreter.
procedure ShowValue( v:Value ); begin with v^ do case tag of intval: write( n:1 ); boolval: write( b ); charval: write( ch ); emptyval:write( '()' ); nilval: write('nil'); listval: begin write('('); ShowValue(hd); writeln('::'); {flush buffer} ShowValue(tl); write(')') end; funcval: write('function'); end end {ShowValue}; { Output Values. }
-- there is no option to deal with "deferred" values.
Apply here assumes that a parameter of a function has already been fully evaluated (and so does not need to force it):
function apply( fn, ap :Value ):Value; { apply a function fn to param ap } { apply : (Value->Value) -> Value -> Value } begin if fn^.e^.fparam^.tag = emptycon then { (L().e)ap } if ap^.tag = emptyval then apply := eval(fn^.e^.body, fn^.r) else error('L().e exp ') else apply := eval(fn^.e^.body, bind(fn^.e^.fparam^.id, ap, fn^.r)) end {apply}; { Apply a Function to a Parameter. }
In the strict interpreter, eval fully evaluates a parameter before passing it to an operator or a function:
function eval { (x:tree; rho:Env) :Value forwarded }; { eval :Exp -> Env -> Value Note: evaluates an Expression and returns a Value} 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, eval(x^.aparam, rho)) else error('apply ~fn ') end; unexp: eval:=U(x^.unopr, eval(x^.unarg, rho)); binexp: eval:=O(x^.binopr, eval(x^.left,rho), {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}; { Evaluate an Expression Strictly. } {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, 2007 }
And exec prints an evaluated expression, rather than a deferred one.
procedure execute(prog:tree); #include "lazy.type.P" var evals, envcells, conscells :integer; { statistics } LastId :alfa; { debugging} procedure error( m:alfa ); begin writeln; writeln('Error: ', m, ' LastId=', LastId); goto 99 {error abort} end; #include "lazy.mkval.P" { Make various Values } function eval( x:tree; rho:Env ):Value; forward; #include "strict.env.P" { manipulate Environment } #include "strict.D.P" { Execute Declarations } #include "strict.apply.P" { Apply a Function } #include "strict.U.P" { Execute Unary Operators } #include "lazy.O.P" { Execute Binary Operators } #include "strict.eval.P" { eval an Expression } #include "strict.show.P" { Output Values } begin{execute} evals := 0; envcells := 0; conscells := 0; {zero counters} LastId := '-start- '; ShowValue(eval(prog, {Env=}nil)); { Execution } writeln; write( evals, ' evals'); write( envcells, ' env cells used, '); writeln( conscells, ' cells used') end{execute}; { Shell of Interpreter for Strict Functional Language. } {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, 2007 }
In processing a declaration in the strict interpreter, an identifier is bound to the value resulting from evaluating the right hand side of the declartion:
function D( decs:tree; rho:Env ):Env; { D :Decs -> Env -> Env } var localrho :Env; function D2( decs :tree; local, global :Env ):Env; begin if decs=nil then D2:=global else D2:=bind(decs^.hd^.name, eval(decs^.hd^.val,local), {strict} D2(decs^.tl, local, global)) end; begin if decs=nil then D:=rho else begin if decs^.recursive then begin localrho:=bind('-dummy----', nil, rho); localrho^.next:=D2( decs, localrho, rho ); D:=localrho end else D:=D2( decs, rho, rho ) end end {D}; { Execute Declarations Strictly. }
All expressions have been evaluated before passing them to operators, so there is no need for any operator to force them.
function U( opr:symbol; v:Value ):Value; { U :Value -> Value } begin case opr of minus: if v^.tag=intval then U:=mkint(-v^.n) else error('- non int '); notsy: if v^.tag=boolval then U:=mkbool(not v^.b) else error('not ~bool '); hdsy: if v^.tag=listval then U:=v^.hd else error('hd ~list '); tlsy: if v^.tag=listval then U:=v^.tl else error('tl ~list '); nullsy:if v^.tag=listval then U:=mkbool(false) else if v^.tag=nilval then U:=mkbool(true) else error('null ~list') end end {U}; { Execute Unary Operators }
function bind( x:alfa; val:Value; r:Env ):Env; { :Ide -> Value -> Env -> Env } var p:Env; begin new(p); envcells:=envcells+1; with p^ do begin id:=x; v:=val; next:=r end; bind:=p end {bind}; function applyenv( r:Env; x:alfa ):Value; { :Env -> Ide -> Value } begin LastId := x; {debugging} if r=nil then error('undec id ') else if r^.id=x then applyenv := r^.v else applyenv := applyenv( r^.next, x ) end {applyenv}; { Build and Search Environment. }
Appendix
Parts of the strict interpreter (syntax is shared with the lazy one):- [strict.D.P]
- [strict.U.P]
- [strict.apply.P]
- [strict.env.P]
- [strict.eval.P]
- [strict.exec.P]
- [strict.show.P]
- [strict.U.P]