function checkVal(m:alfa; vs:Values; v:Value) :Value; begin checkVal := v; {type checking} if not(v^.tag in vs) then error(m) end; 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; function mkprocess1(t:ValueClass; pA, pB:Value):Value; var p :Value; begin new(p); mkprocess1:=p; with p^ do begin tag:=t; {choice or para, | or ||, NB. pA, pB in WHNF} p1:=checkVal('bad proc A', processvalues, pA); p2:=checkVal('bad proc B', processvalues, pB) end end; function mkprocess2(t:ValueClass; chan:Value; m, c:tree; rho:Env):Value; var p :Value; begin new(p); mkprocess2:=p; with p^ do begin tag:=t {inprocessval or outprocessval}; chnl:=chan; msg:=m; cont:=c; pr:=rho end end; function mkchannel:Value; var p :Value; begin new(p); mkchannel:= p; with p^ do begin tag:=channelval; ChannelCntr:=ChannelCntr+1; n:=ChannelCntr end end; {\fB Make Various Values. \fP} { Do not remove: This program is released under Gnu `copyleft' General } { Public Licence (GPL) -- L.Allison, CSSE, Monash Uni., .au, 7/2004 }