^Semantics^ ^examples^

# Elementary Semantics Expressed in Pascal

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
lineno:=lineno+1; write(lineno:4,':');
nextch:=' '
end
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.

```

© L. Allison, School of Computer Science and Software Engineering, Monash University, Australia 3800.
Created with "vi (Linux & IRIX)",   charset=iso-8859-1