Elementary Semantics Expressed in Pascal

LA home
Computing
Semantics
 Examples

See L. Allison, A Practical Introduction to Denotational Semantics, CUP, Cambridge Computer Science Texts V23, 1986.

These semantics are for a "pure" imperative language where side-effects are impossible in expressions.

Note   function EE   and   function CC   in particular.

program ch5(input, output);
label 99;
type  {lexical objects}
      alfa = packed array [1..10] of char;
      symbol = (plussy, minussy, timessy, oversy,
                eqsy, nesy, ltsy, lesy, gtsy, gesy,
                ident, numeral,
                ifsy, thensy, elsesy, whilesy, dosy,
                beginsy, endsy, skipsy,
                semisy, becomessy, open, close, stopsy);

      {syntactic domains}
      exptype = (bexp, uexp, varr, int);
      opr     = (plus, minus, times, over,
                 eq, ne, lt, le, gt, ge, neg);
      cmdtype = (assign, semi, ifstat, whiles, skip);
      exp = ^ enode;
      enode = record case tag:exptype of
                 bexp    :(o:opr; left, right:exp);
                 uexp    :(u:opr; son:exp);
                 varr    :(id:alfa);
                 int     :(i:integer);
              end;
      cmd = ^ cnode;
      cnode = record case tag:cmdtype of
                 assign  :(id:alfa; e:exp);
                 semi    :(left,right:cmd);
                 ifstat  :(b:exp; gtrue,gfalse:cmd);
                 whiles  :(bw:exp; g:cmd);
                 skip    :()
              end;

      {semantic domains}
      Values = integer;

      State = ^ avar;
      avar  = record ident:alfa;
                     v:Values;
                     next:State
              end;

var lineno:integer;
    ch : char   {current character};
    sy : symbol {current symbol class};
    word : alfa {current keyword, identifier or operator};
    n : integer {value of current numeral};

{------------------------------------------------------------lexical-----}
procedure error(a:alfa);
begin writeln;
      writeln(' error:', a,' ch=[' ,ch, '] word=[' ,word,'] n=',n:1);
      goto 99
end;

function nextch:char;
   var ch:char;
begin if eof then error('prem'' eof ')
      else if eoln then
      begin readln; writeln;
            lineno:=lineno+1; write(lineno:4,':');
            nextch:=' '
      end
      else begin read(ch); write(ch); nextch:=ch
           end
end;

procedure insymbol;
   var l:integer; ch2:char;
begin while ch=' ' do ch:=nextch;
      if ch in ['a'..'z','A'..'Z'] then
      begin l:=0; word:='          ';
            while ch in ['a'..'z','A'..'Z','0'..'9'] do
            begin l:=l+1;
                  if l <= 10 then word[l]:=ch;
                  ch:=nextch
            end;
                 if word = 'begin     ' then sy:=beginsy
            else if word = 'end       ' then sy:=endsy
            else if word = 'if        ' then sy:=ifsy
            else if word = 'then      ' then sy:=thensy
            else if word = 'else      ' then sy:=elsesy
            else if word = 'while     ' then sy:=whilesy
            else if word = 'do        ' then sy:=dosy
            else if word = 'skip      ' then sy:=skipsy
            else sy:= ident
      end
      else if ch in ['0'..'9'] then
      begin n:=0;
            while ch in ['0'..'9'] do
            begin n:=n*10+ord(ch)-ord('0');
                  ch:=nextch
            end;
            sy:=numeral
      end
      else if ch in ['+', '-', '*', '/', '=', '(', ')', ';', '.'] then
      begin case ch of
               '+': sy:=plussy;
               '-': sy:=minussy;
               '*': sy:=timessy;
               '/': sy:=oversy;
               '=': sy:=eqsy;
               '(': sy:=open;
               ')': sy:=close;
               ';': sy:=semisy;
               '.': sy:=stopsy
            end;
            ch:=nextch
      end
      else if ch in ['<' , '>', ':'] then
      begin ch2:=ch; ch:=nextch;
            case ch2 of
               '<' : if ch='=' then sy:=lesy
                    else if ch='>' then sy:=nesy else sy:=ltsy;
               '>': if ch='=' then sy:=gesy else sy:=gtsy;
               ':': if ch='=' then sy:=becomessy
                    else error('no = in :=')
            end;
            if sy in [lesy,nesy,gesy,becomessy]  then ch:=nextch
      end else error('insymbol  ')
end {insymbol};

procedure check(s:symbol; chs:alfa);
   var m:alfa;
begin if sy=s then insymbol
      else begin m:='chck(    )';
                 m[6]:=chs[1]; m[7]:=chs[2]; m[8]:=chs[3];
                 m[9]:=chs[4]; error(m)
end        end;

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

function consexp(t:exptype; f:opr; e1,e2:exp):exp;
   var e:exp;
begin new(e); consexp:=e;
      with e^ do
      begin tag := t; o:=f;{hope pc doesn't check}
            left:=e1; right:=e2
end  end;

function conscmd(t:cmdtype; ctrle:exp; g1,g2:cmd):cmd;
   var c:cmd;
begin new(c); conscmd:=c;
      with c^ do
      begin tag:=t;
            case t of
               assign: error('cons cmd  ');
               semi:   begin left:=g1; right:=g2 end;
               ifstat: begin b:=ctrle; gtrue:=g1; gfalse:=g2 end;
               whiles: begin bw:=ctrle;g:=g1 end;
               skip:
end  end    end;
{-----------------------------------------------------parser--------------}
function parser:cmd;

   function pexp:exp;
      var e:exp; o:opr;

      function pexp1:exp;
         var e:exp; o:opr;

         function pexp2:exp;
            var e:exp; o:opr;

            function pexp3:exp;
               var e:exp;
            begin if sy=open then
                  begin insymbol;
                        e:=pexp;
                        check(close, ')         ')
                  end
                  else if sy=minussy then
                  begin insymbol;
                        e:=consexp(uexp, neg, pexp3, nil)
                  end
                  else if sy=ident then
                  begin new(e);
                        with e^ do
                        begin tag:=varr; id:=word
                        end;
                        insymbol
                  end
                  else if sy=numeral then
                  begin new(e);
                        with e^ do
                        begin tag:=int; i:=n
                        end;
                        insymbol
                  end
                  else error('pexp3     ');
                  pexp3:=e
            end {pexp3};

         begin {pexp2}
            e:=pexp3;
            while sy in [timessy,oversy] do
            begin if sy=timessy then o:=times
                  else o:=over;
                  insymbol;
                  e:=consexp(bexp, o, e, pexp3)
            end;
            pexp2:=e
         end {pexp2};

      begin {pexp1}
         e:=pexp2;
         while sy in [plussy,minussy] do
         begin if sy=plussy then o:=plus
               else o:=minus;
               insymbol;
               e:=consexp(bexp, o, e, pexp2)
         end;
         pexp1:=e
      end {pexp1};

   begin {pexp}
      e:=pexp1;
      if sy in [eqsy .. gesy] then
      begin case sy of
               eqsy: o:=eq; nesy: o:=ne;
               ltsy: o:=lt; lesy: o:=le;
               gtsy: o:=gt; gesy: o:=ge
            end;
            insymbol;
            e:=consexp(bexp, o, e, pexp1)
      end;
      pexp:=e
   end {pexp};

   function pcmd:cmd;
      var c:cmd;
          x:alfa;

          function ifcmd:cmd;
             var e:exp; g1:cmd;
          begin e:=pexp;
                check(thensy, 'then      '); g1:=pcmd;
                check(elsesy, 'else      ');
                ifcmd:=conscmd(ifstat,e,g1,pcmd)
          end {ifcmd};

          function whilecmd:cmd;
             var e:exp;
          begin e:=pexp; check(dosy, 'do        ');
                whilecmd:=conscmd(whiles, e, pcmd,nil)
          end;

   begin if sy=ident then
         begin x:=word;
               insymbol; check(becomessy, ':=        ');
               new(c);
               with c^ do  {x:=rhs}
               begin tag:=assign; id:=x; e:=pexp
               end
         end
         else if nextsymis(ifsy) then
               c:=ifcmd
         else if nextsymis(whilesy) then
               c:=whilecmd
         else if nextsymis(beginsy) then
         begin c:=pcmd;
               while nextsymis(semisy) do
                     c:=conscmd(semi, nil, c, pcmd);
               check(endsy, 'end       ')
         end
         else if nextsymis(skipsy) then
            c:=conscmd(skip, nil,nil,nil)
         else error('parse cmd ');
         pcmd := c
   end {pcmd};

begin {parser}
   parser:=pcmd;
   if sy <> stopsy then error('no .      ')
end {parser};
{-------------------------------------------------------------semantics--}
procedure display(s:State);
begin if s=nil then writeln(' finish')
      else begin writeln(s^.ident,'=',s^.v:3); display(s^.next)
end        end;

function undefined:Values;
{not a function in the semantics; a fn here to get side-effect of stop}
begin undefined:=0 {else pc complains}; error('run:undef ') end;

function update(s:State; id:alfa; val:Values):State;
             { : State x Ide x Values -> State }
   var p:State;
begin new(p); p^.next:=s; update:=p;
      p^.ident:=id; p^.v:=val
end;

function applyState(s:State; id:alfa):Values;
begin if s=nil then applyState:=undefined
      else if s^.ident = id then applyState:=s^.v
      else applyState:=applyState(s^.next, id)
end;

function EE(e:exp; s:State):Values; {: exp x State -> Values }
   function OO(o:opr; v1, v2 :Values):Values;
   begin case o of
            plus: OO:=v1+v2;
            minus:OO:=v1-v2;
            times:OO:=v1*v2;
            over: OO:=v1 div v2;
            eq:   OO:=ord(v1=v2);
            ne:   OO:=ord(v1 <> v2);
            lt:   OO:=ord(v1 <  v2);
            le:   OO:=ord(v1 <= v2);
            gt:   OO:=ord(v1 >  v2);
            ge:   OO:=ord(v1 >= v2)
         end {case}
   end {OO};

begin {EE}
   case e^.tag of
      varr:   EE:=applyState(s, e^.id);
      int:    EE:=e^.i;
      uexp:   EE:= - EE(e^.son, s) {- only unary op};
      bexp:   EE:= OO( e^.o, EE(e^.left, s), EE(e^.right,s))
   end {case}
end {EE};

function CC(g:cmd; s:State):State; {: cmd x State -> State}
begin {Main interpreter routine}
   case g^.tag of
      assign:   CC:=update(s, g^.id, EE(g^.e, s));
      semi:     CC:=CC(g^.right, CC(g^.left, s));
      ifstat:   if EE(g^.b,s)=1 then CC:=CC(g^.gtrue,s)
                               else CC:=CC(g^.gfalse,s);
      whiles:   if EE(g^.bw,s)=1 then CC:=CC(g, CC(g^.g,s))
                                else CC:=s;
      skip:     CC:=s
   end {case}
end {CC};
{-----------------------------------------------------------------main---}
begin
   writeln(' A Simple Language, L.Allison U.W.A.');
   lineno:=1; write(lineno:4, ':');
   word:='-starting-'; n:=0; ch:=nextch; insymbol;

   display( CC(parser, {startState=}nil ) );
   99: {fin}
end.


www #ad:

↑ © L. Allison, www.allisons.org/ll/   (or as otherwise indicated).
Created with "vi (Linux)",  charset=iso-8859-1,   fetched Tuesday, 27-Sep-2022 14:48:46 UTC.

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