|
( # Semantic Interpreter, Dept. Computer Science U.W.A. 1983 #
# L. Allison, Programming Denotational Semantics II #
# The Computer Journal, V28, No5, pp480-486, 1985 #
mode alfa = [1:10] char;
proc eq = (alfa x,y)bool:
(loc bool b:=true; loc int i := lwb x;
while b and i <= upb x do
b:=x[i]=y[i]; i+:=1
od;
b
);
mode node = struct( ref node s1, s2, s3, ref alfa op, int i);
mode tree = ref node;
# error and input routines omitted #
#--------------------------------------------------------------------#
# syntax #
proc program = tree:
begin
# parse a program, body omitted #
end # program #;
#--------------------------------------------------------------------#
# semantics #
mode value = int, location = int;
mode anscell = struct(value v, ref anscell next);
mode answer = ref anscell;
mode store = proc(location)value,
env = proc(alfa)location;
mode cont = proc(store)answer,
kont = proc(value,store)answer;
mode pnv = proc(alfa,cont,store)answer;
mode dcont = proc(env,pnv,store)answer;
value unbound = -max int, undefined value = -(max int -1);
proc display = (answer s)void:
if s isnt nil then
print((newline, v of s)); display(next of s)
fi;
proc new = (store s)location:
( loc location l := 1;
while s(l) /= unbound do
l +:= 1
od;
l
);
# cc: cmd->(env x pnv)->cont->store->answer #
proc cc = (tree cmd, env e, pnv p, cont c, store s)answer:
begin
# dd:dec->(env x pnv)->dcont->store->answer #
proc dd = (tree dec, env e, pnv p, dcont dc, store s) answer:
begin
env new env = (alfa id) location:
if eq(op of dec, id) then new(s)
else e(id)
fi;
pnv new pnv = (alfa id, cont ret addr, store s)answer:
if eq(id, op of s1 of dec) then
cc( s2 of dec, e, new pnv #recursion!#, ret addr, s)
else p(id, ret addr, s)
fi;
dcont other decs = (env e, pnv p, store s)answer:
dd(s2 of dec, e, p, dc, s);
if dec is nil then dc(e, p, s)
elif eq(op of dec, "var ") then
dd(s1 of dec, e, p, dc, s)
elif eq(op of dec, "proc ") then
dc(e, new pnv, s)
elif eq(op of dec, ", ") then # dec1, dec2, #
dd( s1 of dec, e, p, other decs, s)
else # var id #
store new s = (location l)value:
if l=new(s) then undefined value
else s(l)
fi;
dc( new env, p, new s )
fi
end # dd #;
# ee : exp->(env x pnv)->kont->store->answer #
proc ee = (tree exp, env e, pnv p, kont k, store s)answer:
begin
kont rhs = (value v1, store s)answer:
( kont operator = (value v2, store s)answer:
k((alfa opr = op of exp;
if eq(opr,"= ") then
if v1=v2 then 1 else 0 fi
elif eq(opr,"<> ") then
if v1/=v2 then 1 else 0 fi
elif eq(opr,"< ") then
if v1<v2 then 1 else 0 fi
elif eq(opr,"<= ") then
if v1<=v2 then 1 else 0 fi
elif eq(opr,"> ") then
if v1>v2 then 1 else 0 fi
elif eq(opr,">= ") then
if v1>=v2 then 1 else 0 fi
elif eq(opr,"+ ") then v1+v2
elif eq(opr,"- ") then v1-v2
elif eq(opr,"* ") then v1*v2
else error(" undef operator in ee"); skip
fi),
s
);
ee(s2 of exp, e, p, operator, s)
) # rhs # ;
if eq(op of exp, "-integer ") then
k(i of exp, s)
elif (op of exp)[1]>="a" and (op of exp)[1]<="z" then
value v = s( e( op of exp ) );
if v=undefined value then error(" undefined variable");skip
else k( v, s)
fi
else
ee(s1 of exp, e, p, rhs, s)
fi
end # of ee #;
# the body of cc(cmd,env,pnv,cont,store)answer #
dcont stat part = (env e, pnv p, store s)answer:
cc(s2 of cmd, e, p, c, s);
kont cond = (value v, store s)answer:
cc(if v=1 then s2 of cmd else s3 of cmd fi, e, p, c, s);
cont again = (store s)answer:cc(cmd,e,p,c,s);
kont loop = (value v, store s)answer:
if v=1 then cc(s2 of cmd, e, p, again, s) else c(s) fi;
cont s2c = (store s)answer: cc(s2 of cmd, e, p, c, s);
kont update = (value v, store s)answer:
c( (location l)value:
if l = e(op of s1 of cmd) then v else s(l) fi
);
kont do i o = (value v, store s)answer:
heap anscell := (v, c(s));
if cmd is nil then c(s)
elif eq(op of cmd, "begin ") then
cc(s1 of cmd, e, p, c, s)
elif eq(op of cmd, "; ") then
if eq(op of s1 of cmd, "var ")
or eq(op of s1 of cmd, "proc ") then #dec; stats#
dd(s1 of cmd, e, p, stat part, s)
else # stat; statlist #
cc(s1 of cmd, e, p, s2c, s)
fi
elif eq(op of cmd, "if ") then
ee(s1 of cmd, e, p, cond, s)
elif eq(op of cmd, "while ") then
ee(s1 of cmd, e, p, loop, s)
elif eq(op of cmd, ":= ") then
ee(s2 of cmd, e, p, update, s)
elif eq(op of cmd, "output ") then
ee(s1 of cmd, e, p, do i o, s)
else # identifier : call on a proc #
p(op of cmd, c, s)
fi
end # of cc #;
#--------------------------------------------------------------------#
display( cc( program ,
(alfa id)location:(error(" undeclared id"); skip),
(alfa id, cont ra, store s)answer:
(error(" undeclared proc"); skip),
(store s)answer:nil,
(location l)value:unbound ))
)
Also see
[more (click)].
|
|