type Env = ^ Binding;
Value = ^ValNode;
Binding = record id :alfa; v:Value; next:Env end;
ValueClass = (intval, boolval, charval, emptyval,
listval, nilval, funcval, deferval);
ValNode = record case tag :ValueClass of
intval: (n :integer );
boolval:(b :boolean );
charval:(ch:char );
nilval, emptyval:();
listval:(hd, tl :Value);
funcval, deferval:( e:tree; r:Env )
end;
{\fB Environment and Value Types. \fP}
Execution is driven by output. The interpreter turns the input expression into a deferred value and has it printed.
procedure execute(prog:tree);
#include "lazy.type.P"
var evals, envcells, conscells :integer; { statistics }
LastId :alfa; { debugging}
Answer :Value;
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;
procedure force( v:Value ); forward;
#include "lazy.env.P" { manipulate Environment }
#include "lazy.D.P" { Execute Declarations }
#include "lazy.apply.P" { Apply a Function }
#include "lazy.U.P" { Execute Unary Operators }
#include "lazy.O.P" { Execute Binary Operators }
#include "lazy.eval.P" { eval and force an Expression }
#include "lazy.show.P" { Output Values }
begin{execute}
evals := 0; envcells := 0; conscells := 0; {zero counters}
LastId := '-start- ';
Answer := defer(prog, {Env=}nil);
ShowValue(Answer); { Execution is print driven }
writeln; write( evals, ' evals');
write( envcells, ' env cells used, ');
writeln( conscells, ' cells used')
end{execute};
{\fB Shell of Interpreter for Functional Language. \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. }
The print routine prints the various kinds of value. Note that printing a list is recursive. A deferred value must be forced or turned into a non-deferred value before it can be printed.
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');
deferval:begin force(v); ShowValue(v) end { evaluation is o/p driven }
end
end {ShowValue};
{\fB Output Values. \fP}
Expressions are evaluated by force and by eval. Being part of a lazy interpreter, eval does as little work as possible. In particular, the components of a list, the head and the tail, are not evaluated but are deferred. The head and tail are only evaluated further if they are printed or if some strict operator, eg. +, is applied to them. When eval returns a structure, only the top most node is guaranteed not to be deferred; substructures may be deferred. This condition is known as weak head normal form. Note that force overwrites a deferred value with the evaluated value. This is efficient because values can be shared, particularly in recursive structures and when parameters are passed. Overwriting ensures that a value is only evaluated once. Functions O and U execute binary and unary operators respectively (see appendix).
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. }
Bind adds a new binding to the environment. It is called during the processing of declarations and of function application. Applyenv returns a variable's value. It is only called by eval so it forces the variable's value.
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
begin force( r^.v ); {only called from eval}
applyenv := r^.v
end
else applyenv := applyenv( r^.next, x )
end {applyenv};
{\fB Build and Search Environment. \fP}
A function is applied by binding the actual parameter value to the formal parameter name to form a new environment. The body of the function is evaluated in this new environment. Some type-checking is done to ensure that it really is a function that is being applied. If the formal parameter is empty `( )' a check is made that the actual parameter is also empty.
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 }
begin force(ap);
if ap^.tag = emptyval then apply := eval(fn^.e^.body, fn^.r)
else error('L().e exp ')
end
else apply := eval(fn^.e^.body, bind(fn^.e^.fparam^.id, ap, fn^.r))
end {apply};
{\fB Apply a Function to a Parameter. \fP}
A declaration is processed much like a function application
(recall that `let x=e in f' is
equivalent to `(lambda x.f)e')
and the declared name is bound to the defining value.
Note that this value is deferred.
If a group of declarations is recursive,
the environment used contains them also,
otherwise the enclosing environment is used.
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, defer(decs^.hd^.val,local),
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};
{\fB Execute Declarations. \fP}