λ Calculus Interpreter (Lazy).

LA home
Computing
FP
 λ-calculus
  Intro.
  Examples
  Syntax
  Interp.(L)
  Interp.(S)
  Interp.(L)
   #Parser
   #Exec.
   #Ex.
   #Appndx

Also see:
  Prolog

The (lazy) λ calculus interpreter consists of a simple parser, execution routines (eval, force) and a few supporting routines.

Parser.

The functional language has a simple grammar and parsing it is quite easy; a parser is included in an appendix. The lexical symbols and syntactic types are used throughout the interpreter.


                                                           {lexical items}
symbol = (word, numeral, empty{ () }, nilsy, charliteral, truesy, falsesy,
          open, close, sqopen, sqclose, curlopen, curlclose,
          letsy, recsy, insy, comma, colon,
          ifsy, thensy, elsesy, lambdasy, dot,
          quote,
          conssy,
          orsy, andsy,
          eq, ne, lt, le, gt, ge,
          plus, minus, times, over,
          nullsy, hdsy, tlsy, notsy,
          eofsy
         );

{ Lexical Types. }

The syntactic types define a parse tree. The interpreter walks this tree executing a program.


tree = ^ node;

SyntaxClass = ( ident, intcon, boolcon, charcon, emptycon, nilcon,
                lambdaexp, application, unexp, binexp, ifexp, block,
                declist, decln
              );

node = record case tag :SyntaxClass of
          ident       :( id :alfa );
          intcon      :( n:integer );
          boolcon     :( b:boolean );
          charcon     :( ch:char );
          emptycon, nilcon:();
          
          lambdaexp   :( fparam, body :tree );
          application :( fun, aparam :tree );
          unexp       :( unopr :symbol; unarg :tree );
          binexp      :( binopr:symbol; left, right :tree );
          ifexp       :( e1, e2, e3 :tree );
          block       :( decs, exp :tree );
          declist     :( recursive:boolean; hd, tl :tree );
          decln       :( name: alfa; val:tree )
end;

{ Syntactic Types. }

Execution.

This section describes an interpreter for the functional language. It employs an implementation of normal-order evaluation known as call by need evaluation. The interpreter evaluates an expression (program) represented by a parse tree and produces and prints a value. Expressions and values are quite separate kinds of things. There are integer, boolean and other simple values. Evaluating a function abstraction produces a function value. A function value contains some code (an expression) and an environment to execute the code in. An environment is a list of bindings of names to values. When a name is used its value is found in the environment. Being a lazy interpreter, there is a deferred value for expressions that have been put-off until later. A deferred value has not yet been evaluated. It consists of an expression to be evaluated and an environment to evaluate it in if need be.


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;

{ Environment and Value Types. }

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};

{ Shell of Interpreter for Functional Language. }
{ - L. Allison 9/2007 }
{Do not remove: Lazy.p, Strict.p, lazy.*.P, strict.*.P, lex.*.P, & syntax.*.P }
{ are released under Gnu `copyleft' General Public Licence (GPL)              }

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};

{ Output Values. }

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;

{ Evaluate an Expression. }
{ - L. Allison 9/2007 }
{Do not remove: Lazy.p, Strict.p, lazy.*.P, strict.*.P, lex.*.P, & syntax.*.P }
{ are released under Gnu `copyleft' General Public Licence (GPL)              }

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};

{ Build and Search Environment. }

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};

{ Apply a Function to a Parameter. }

A declaration is processed much like a function application (recall that `let x=e in f' is equivalent to `(λ 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};

{ Execute Declarations. }

A strict (eager, non-lazy) version of the interpreter also exists and the two share many components. For differences, see the strict interpreter.

Exercises

  1. Extend the functional language parser to permit [a, b, c, ..., x] as a shorthand for a::b::c::...::x::nil and to allow "string" as shorthand for a list of characters ['s','t','r','i','n','g'].

  2. Add a where clause to the language.
    let [rec] <decs> in <Exp> = <Exp> where [rec] <decs>
-- LA 9/2007

Appendix.


{System dependent:} procedure setlinebuffering; external;

program functional(input, output);

label 99; {error failure; stop}

type alfa = packed array [1..10] of char;

#include "lex.type.P"      {Lexical Types}
#include "syntax.type.P"   {Syntactic Types}

var prog:tree;

#include "syntax.print.P"  {Print a Parse Tree}
#include "syntax.P"        {The Parser}
#include "lazy.exec.P"     {The Interpreter}

begin setlinebuffering; {System dependent}
      prog:=parser;
      writeln; writeln(' --- end of parsing --- ');
      printtree(prog); writeln; writeln(' --- running --- ');
      execute(prog);
      99:writeln; writeln(' --- finished --- ')
end.

{ Lazy Functional Language Interpreter, Main Program. }
{ L. Allison 9/2007 }
{Do not remove: Lazy.p, Strict.p, lazy.*.P, strict.*.P, lex.*.P, & syntax.*.P }
{ are released under Gnu `copyleft' General Public Licence (GPL)              }

Main Program for Functional Language System.

Routines necessary to complete the parser and interpreter follow.



procedure getch;
   const tab = 9;
begin if eof then begin ch:='.'; theword:='     ' end
      else {not eof} if eoln then
      begin readln; writeln; ch:=' ';
            lineno:=lineno+1; write(lineno:3, ': ')
      end
      else begin {not eof and not eoln} read(ch); write(ch);
                 if ord(ch)=tab then ch:=' '
           end
end{getch};

procedure insymbol;
   const blank='          ';
   var len:integer;
begin repeat while ch=' ' do getch;
             if ch='{' then  { comment }
             begin repeat getch
                   until (ch='}') or eof;
                   getch
             end
      until not( ch in [' ', '{'] );
      if eof then sy:=eofsy
      
      else if ch in ['a'..'z', 'A'..'Z'] then                             {xyz}
      begin theword:=blank;
            len:=0;
            while ch in ['a'..'z', 'A'..'Z', '0'..'9'] do
            begin len:=len+1;
                  if len<=10 then theword[len] := ch;
                  getch
            end; {not ch in ['a'..'z', '0'..'9']}
            if      theword='hd        ' then sy:=hdsy  {not efficient}
            else if theword='tl        ' then sy:=tlsy
            else if theword='lambda    ' then sy:=lambdasy
            else if theword='if        ' then sy:=ifsy
            else if theword='then      ' then sy:=thensy
            else if theword='else      ' then sy:=elsesy
            else if theword='let       ' then sy:=letsy
            else if theword='in        ' then sy:=insy
            else if theword='rec       ' then sy:=recsy
            else if theword='or        ' then sy:=orsy
            else if theword='and       ' then sy:=andsy
            else if theword='not       ' then sy:=notsy
            else if theword='nil       ' then sy:=nilsy
            else if theword='null      ' then sy:=nullsy
            else if theword='true      ' then sy:=truesy
            else if theword='false     ' then sy:=falsesy
            else sy:=word
      end{alphanums}
      
      else if ch in ['0'..'9'] then                            {123}
      begin theint:=0;
            while ch in ['0'..'9'] do
            begin theint:=theint*10+ord(ch)-ord('0'); getch
            end;
            sy:=numeral
      end
      
      else if ch='''' then
      begin getch;
            theword:=blank; theword[1]:=ch; getch;
            if ch='''' then                             { 'z'   charliteral}
               begin getch; sy:=charliteral end
            else error('char lit  ')
      end
      
      else if ch in ['=', '<', '>', '+', '-', '*', '/',
                     '.', ',', ':', '(', ')', '[', ']', '"' ] then
         case ch of
            '<': begin getch;
                       if ch='=' then begin getch; sy:=le end
                       else if ch='>' then begin getch; sy:=ne end
                       else sy:=lt
                 end;
            '>': begin getch;
                       if ch='=' then begin getch; sy:=ge end
                       else sy:=gt
                 end;
            '(': begin getch;
                       if ch=')' then begin getch; sy:=empty end
                       else sy:=open
                 end;
            ':': begin getch;
                       if ch=':' then begin getch; sy:=conssy end
                       else sy:=colon
                 end;
            '=', '+', '-', '*', '/', '.', ',',
            ')', '[', ']', '"':
                 begin case ch of
                       '+': sy:=plus;
                       '-': sy:=minus;
                       '=': sy:=eq;
                       '*': sy:=times;
                       '/': sy:=over;
                       '.': sy:=dot;
                       ',': sy:=comma;
                       '(': sy:=open;  ')': sy:=close;
                       '[': sy:=sqopen; ']': sy:=sqclose;
                       '"': sy:=quote
                       end{case};
                       getch
                 end
         end{case}

      else error('bad symbol')
end{insymbol};

{ Lexical Analysis. }
{ - L. Allison 9/2007 }
{Do not remove: Lazy.p, Strict.p, lazy.*.P, strict.*.P, lex.*.P, & syntax.*.P }
{ are released under Gnu `copyleft' General Public Licence (GPL)              }




function parser:tree;
   const applicpriority=7;

   var lineno :integer;                      { state vars for parser}
       ch:char; sy:symbol; theword:alfa; theint:integer;

       oprpriority:array[symbol]of integer;
       startsexp, unoprs, binoprs, rightassoc :set of symbol;
       sym :symbol;

   function newnode(k:SyntaxClass):tree;
      var p:tree;
   begin new(p); p^.tag:=k; newnode:=p end;

   procedure error(m:alfa);
   begin writeln;
         writeln('error:', m, ' lineno=', lineno:1,
                 ' ch=<', ch, '>(', ord(ch):1, ') sy=', ord(sy):1,
                 ' last word=<', theword, '>');
         writeln; write('skip :');
         while not eof do
            if eoln then begin readln; writeln; write('skip :') end
            else begin read(ch); write(ch) end;
         goto 99 {error abort}
   end{error};

#include "lex.insym.P"  {Lexical Analysis Routines}

   procedure check(s:symbol; m:alfa);
   begin if sy=s then insymbol else error(m) end;

   function syis(s:symbol):boolean;
   begin if sy=s then begin syis:=true; insymbol end else syis:=false end;

   function expression:tree;  { --- parse an expression --- }

      function param:tree;
         var p:tree;
      begin if sy=word then          { lambda x .... }
            begin p:=newnode(ident);
                  p^.id:=theword
            end
            else if sy=empty then    { lambda () ... }
               p:=newnode(emptycon)
            else error('f param   ');
            insymbol;
            param:=p
      end;

      function pdecs:tree; {  [rec] , , ... in exp }
         var d:tree;
             isrec:boolean;

         function cons( isrec:boolean; h,t:tree):tree;
            var p:tree;
         begin p:=newnode(declist); p^.recursive:=isrec;
               p^.hd:=h; p^.tl:=t; cons:=p
         end;

         function pdeclist(isrec:boolean) :tree; { ,, ... }
            var d:tree;

            function pdec:tree;  {   =  }
               var d:tree;
            begin if sy=word then
                  begin d:=newnode(decln);
                        d^.name:=theword; insymbol; check(eq,'= expected');
                        d^.val :=expression
                  end
                  else error('dec, no id');
                  pdec:=d
            end{pdec};

         begin {pdeclist             dec, dec, ..., dec }
            d:=pdec;
            if syis(comma) then pdeclist:=cons(isrec,d,pdeclist(isrec))
                           else pdeclist:=cons(isrec,d,nil)
         end{pdeclist};

      begin {pdecs}
         isrec:=syis(recsy);    { [rec] pdeclist  in exp }
         d:=newnode(block);
         d^.decs:=pdeclist(isrec);
         check(insy, 'in expectd');
         d^.exp := expression;
         pdecs := d
      end{pdecs};

      function exp(priority:integer):tree;
         var e, a :tree;
      begin {exp}
         if priority < applicpriority then
         begin e := exp( priority+1 );
               if (sy in binoprs*rightassoc)and(oprpriority[sy]=priority) then
               begin a:=e; e:=newnode(binexp);
                     e^.binopr:=sy; insymbol;
                     e^.left:=a; e^.right:=exp(priority)
               end
               else
               while (sy in binoprs-rightassoc)and(oprpriority[sy]=priority) do
               begin a:=e; e:=newnode(binexp);
                     e^.binopr:=sy; insymbol;
                     e^.left:=a; e^.right:= exp(priority+1)
               end
         end

         else if priority=applicpriority then {application   f g h x}
         begin e:=exp(priority+1);
               while sy in startsexp - binoprs do {need () in  f(-3)}
               begin a:=e; e:=newnode(application);
                     e^.fun:=a; e^.aparam:=exp(priority+1)
               end
         end

         else {operands}if sy in unoprs then
         begin e:=newnode(unexp);
               e^.unopr:=sy; insymbol;
               e^.unarg:=exp(priority)
         end

         else if sy in startsexp then  case sy of

         word:   begin e:=newnode(ident); e^.id:=theword; insymbol end;
         numeral:begin e:=newnode(intcon); e^.n:=theint; insymbol end;
         charliteral:begin e:=newnode(charcon); e^.ch:=theword[1]; insymbol end;
         empty:  begin insymbol; e:=newnode(emptycon) end;
         nilsy:  begin insymbol; e:=newnode(nilcon) end;
         truesy: begin e:=newnode(boolcon); e^.b:=true; insymbol end;
         falsesy:begin e:=newnode(boolcon); e^.b:=false; insymbol end;

         open:   begin insymbol; e:=expression; check(close,') expected') end;

         letsy:  begin insymbol; e:=pdecs end;

         ifsy:begin insymbol; e:=newnode(ifexp);
                    e^.e1:=expression; check(thensy,'no then   ');
                    e^.e2:=expression; check(elsesy,'no else   ');
                    e^.e3:=expression
              end;

         lambdasy:begin insymbol; e:=newnode(lambdaexp);
                        e^.fparam:=param; check(dot,'. expected');
                        e^.body:=expression
                  end;
         end{case}

         else error('bad opernd');

         exp:=e
      end {exp};

   begin{expression}
      expression:=exp({priority=}1)
   end{expression};

begin {parser}
   unoprs     := [minus, hdsy, tlsy, nullsy, notsy];
   binoprs    := [conssy..over];
   rightassoc := [conssy];
   startsexp  := unoprs + [word..falsesy, open, letsy, ifsy, lambdasy];

   for sym:=word to eofsy do oprpriority[sym]:=0;
   oprpriority[conssy]:=1;
   oprpriority[orsy]:=2;        oprpriority[andsy]:=3;
   for sym:=eq to ge do oprpriority[sym]:=4;
   oprpriority[plus]:=5;         oprpriority[minus]:=5;
   oprpriority[times]:=6;        oprpriority[over]:=6;

   lineno := 1;
   writeln(' Simple Functional Language   L.A. Monash Comp Sci 10/2/87');
   write(lineno:3, ': ');
   ch:=' '; theword := '-start----'; theint:=maxint; insymbol;

   parser := expression; {a program is a single expression}

   check(eofsy, 'prog+junk ');
   writeln
end{parser};

{ Parser for Functional Language. }
{ - L. Allison 9/2007 }
{Do not remove: Lazy.p, Strict.p, lazy.*.P, strict.*.P, lex.*.P, & syntax.*.P }
{ are released under Gnu `copyleft' General Public Licence (GPL)              }




function mkvalue(t:ValueClass):Value;
   var p:Value;
begin new(p); p^.tag:=t; mkvalue:=p
end;

function mkint(nn:integer):Value;
   var p:Value;
begin new(p); p^.tag:=intval; p^.n:=nn; mkint:=p
end;

function mkbool(bb:boolean):Value;
   var p:Value;
begin new(p); p^.tag:=boolval; p^.b:=bb; mkbool:=p
end;

function mkchar( cc:char ):Value;
   var p:Value;
begin new(p); p^.tag:=charval; p^.ch:=cc; mkchar:=p
end;

function mkfunc( code:tree; rho:Env ):Value;
   var p:Value;
begin new(p); with p^ do begin tag:=funcval; e:=code; r:=rho end; mkfunc:=p
end;

function defer(x:tree; rho:Env):Value;  {form closure}
   var p:Value;
begin new(p); with p^ do begin tag:=deferval; e:=x; r:=rho end; defer:=p
end {defer};

function cons( h, t :Value ):Value;
   var p :Value;
begin new(p); with p^ do begin tag:=listval; hd:=h; tl:=t end; cons:=p
     ;conscells := conscells + 1  {statistics}
end;

{ Make Various Values. }




function U( opr:symbol; v:Value ):Value;    { U :Value -> Value }
{PRE: v^.tag <> deferval}
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
                begin force(v^.hd); U:=v^.hd end
             else error('hd ~list  ');
      tlsy:  if v^.tag=listval then
                begin force(v^.tl); U:=v^.tl end
             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 O( opr:symbol; v1, v2 :Value ):Value;    { O :Value^2 -> Value }
   var abs1, abs2, intAns :integer; boolAns :boolean;
begin case opr of
      eq, ne, lt, le, gt, ge:
         begin if [v1^.tag] * [v2^.tag] * [intval, boolval, charval] <> [] then
               case v1^.tag of
               intval:  begin abs1:=v1^.n;       abs2:=v2^.n end;
               boolval: begin abs1:=ord(v1^.b);  abs2:=ord(v2^.b)  end;
               charval: begin abs1:=ord(v1^.ch); abs2:=ord(v2^.ch) end
               end
               else error('rel ops   ');
               case opr of
               eq: boolAns:=abs1= abs2;   ne: boolAns:=abs1<>abs2;
               le: boolAns:=abs1<=abs2;   lt: boolAns:=abs1< abs2;
               ge: boolAns:=abs1>=abs2;   gt: boolAns:=abs1> abs2
               end;
               O:=mkbool(boolAns)
         end;        
      plus, minus, times, over:
         begin if [v1^.tag, v2^.tag] = [intval] then
               case opr of
               plus:  intAns:=v1^.n +   v2^.n;
               minus: intAns:=v1^.n -   v2^.n;
               times: intAns:=v1^.n *   v2^.n;
               over:  intAns:=v1^.n div v2^.n
               end
               else error('arith opr ');
               O:=mkint(intAns)
         end;
      andsy, orsy:
         begin if [v1^.tag, v2^.tag] = [boolval] then
               case opr of
               andsy: boolAns:=v1^.b and v2^.b;
               orsy:  boolAns:=v1^.b or  v2^.b
               end
               else error('bool opr  ');
               O:=mkbool(boolAns)
         end;
      conssy: { deferred params } O:=cons(v1, v2)
      end
end {O};

{ Execute Binary Operators. }
{ - L. Allison 9/2007 }
{Do not remove: Lazy.p, Strict.p, lazy.*.P, strict.*.P, lex.*.P, & syntax.*.P }
{ are released under Gnu `copyleft' General Public Licence (GPL)              }

A strict (eager, non-lazy) version of the interpreter also exists and the two share many components. For differences, see the strict interpreter.

www:


© L. Allison   http://www.allisons.org/ll/   (or as otherwise indicated),
Created with "vi (Linux or Solaris)",  charset=iso-8859-1,  fetched Monday, 20-Nov-2017 17:44:55 EST.

free: Linux, Ubuntu operating-sys, OpenOffice office-suite, The GIMP ~photoshop,
Firefox web-browser, FlashBlock flash on/off.