RussellRuntimeImpl.mesa
This is a simple runtime environment for Russell execution.
Last Edited by: Demers, March 9, 1984 12:37:21 pm PST
DIRECTORY
RussellRuntime USING [ RTValue, RTTuple, ConsRTNode, BindingRTNode, RTCodeBody, RTClosure, ClosureRTNode, RTLocation] ;
RussellRuntimeImpl: CEDAR PROGRAM
EXPORTS RussellRuntime
= BEGIN
OPEN
RussellRuntime
;
Errors
RTError: PUBLIC ERROR[ec: ATOM] = CODE;
Environments and tuples.
MkTuple: PUBLIC PROCEDURE [name: ATOM, value: RTValue] RETURNS [RTTuple]
= BEGIN
RETURN[ NEW[BindingRTNode ← [name~name, value~value]]]
END;
ConcatTuple: PUBLIC PROCEDURE [tuple1,tuple2: RTValue] RETURNS [RTTuple]
= BEGIN
RETURN[ NEW[ConsRTNode ← [leftPart~tuple1,rightPart~tuple2]]]
END;
SelectFromTuple: PUBLIC PROCEDURE [tuple: RTValue, name: ATOM] RETURNS [RTValue]
= BEGIN
answer: RTValue ← NIL;
DoSelection: PROCEDURE [t: RTTuple] RETURNS[ BOOL ]
Lookup name in tuple. Guaranteed to find the leftmost match, so replacement can be simulated by concatentation. This procedure is unnecessarily complicated but is more efficient than the straightforward recursive procedure -- it does not perform any recursive calls on right-linear lists.
Invariant: Subtrees below p, nextp contain exactly all the unconsidered nodes in left-to-right order.
= BEGIN
p: RTTuple ← t;
nextp: RTTuple ← NIL;
DO
IF p = NIL THEN BEGIN
IF nextp = NIL THEN RETURN[ FALSE ];
p ← nextp; nextp ← NIL
END ;
ASSERT: p # NIL
WITH p SELECT FROM
pb: REF BindingRTNode => BEGIN
IF pb.name = name
THEN BEGIN
answer ← pb.value;
RETURN[ TRUE ]
END
ELSE BEGIN
p ← NIL
END
END ;
pc: REF ConsRTNode => SELECT TRUE FROM
nextp = NIL => BEGIN
p ← pc.leftPart;
nextp ← pc.rightPart
END ;
pc.rightPart = NIL =>
p ← pc.leftPart ;
pc.leftPart = NIL =>
p ← pc.rightPart ;
ENDCASE => BEGIN
IF DoSelection[pc.leftPart] THEN RETURN[ TRUE ] ;
p ← pc.rightPart
END ;
ENDCASE =>
RETURN[ FALSE ] ;
ENDLOOP
END ; -- DoSelection
IF DoSelection[ NARROW[tuple] ]
THEN RETURN[ answer ]
ELSE ERROR RTError[ec~$badTuple] ;
END ; -- SelectFromTuple
QueryTuple: PUBLIC PROCEDURE [tuple: RTValue, name: ATOM] RETURNS [BOOL]
= BEGIN
DoQuery: PROCEDURE [t: RTTuple] RETURNS[ BOOL ]
Look for name in tuple. This procedure is similar to DoSelection, above.
Invariant: Subtrees below p, nextp contain exactly all the unconsidered nodes in left-to-right order.
= BEGIN
p: RTTuple ← t;
nextp: RTTuple ← NIL;
DO
IF p = NIL THEN BEGIN
IF nextp = NIL THEN RETURN[ FALSE ];
p ← nextp; nextp ← NIL
END ;
ASSERT: p # NIL
WITH p SELECT FROM
pb: REF BindingRTNode => BEGIN
IF pb.name = name
THEN RETURN[ TRUE ]
ELSE p ← NIL
END ;
pc: REF ConsRTNode => SELECT TRUE FROM
nextp = NIL => BEGIN
p ← pc.leftPart;
nextp ← pc.rightPart
END ;
pc.rightPart = NIL =>
p ← pc.leftPart ;
pc.leftPart = NIL =>
p ← pc.rightPart ;
ENDCASE => BEGIN
IF DoQuery[pc.leftPart] THEN RETURN[ TRUE ] ;
p ← pc.rightPart
END ;
ENDCASE =>
RETURN[ FALSE ] ;
ENDLOOP
END ; -- DoQuery
RETURN[ DoQuery[ NARROW[tuple] ] ]
END ; -- QueryTuple
Procedure Closures
MkClosure: PUBLIC PROCEDURE [ep: RTValue, ip: REF ANY, cb: RTCodeBody] RETURNS [RTClosure]
= BEGIN
RETURN[ NEW[ ClosureRTNode ← [ep~NARROW[ep], ip~ip, cb~cb] ]]
END ; -- MkClosure
ApplyClosure: PUBLIC PROCEDURE [closure: RTValue, arg: RTValue ] RETURNS [RTValue]
= BEGIN
WITH closure SELECT FROM
c: RTClosure =>
RETURN[ c.cb[ env~c.ep, arg~arg, ip~c.ip ] ] ;
ENDCASE =>
ERROR RTError[ec~$badClosure] ;
END ; -- ApplyClosure
Procedures for manipulating environments.
PrependValue: PUBLIC PROCEDURE [tuple: RTTuple, name: ATOM, value: RTValue] RETURNS[RTTuple]
= BEGIN
RETURN[ ConcatTuple[ MkTuple[name~name,value~value], tuple ]]
END ; -- PrependValue
PrependProc: PUBLIC PROCEDURE [tuple: RTTuple, name: ATOM, body: RTCodeBody] RETURNS[RTTuple]
= BEGIN
RETURN[
ConcatTuple[
MkTuple[name~name, value~MkClosure[ep~NIL, ip~NIL, cb~body]],
tuple ]
]
END ; -- PrependProc
Variables and store.
ValueOf: PUBLIC PROCEDURE [location: RTValue] RETURNS [RTValue]
= BEGIN
WITH location SELECT FROM
loc: RTLocation =>
RETURN[ loc^ ] ;
ENDCASE =>
ERROR RTError[ec~$badLocation] ;
END ; -- ValueOf
Assign: PUBLIC PROCEDURE [location: RTValue, value: RTValue] RETURNS [RTValue]
= BEGIN
WITH location SELECT FROM
loc: RTLocation =>
RETURN[ (loc^ ← value) ] ;
ENDCASE =>
ERROR RTError[ec~$badLocation] ;
END ; -- Assign
New: PUBLIC PROCEDURE [] RETURNS [RTLocation]
= BEGIN
RETURN[ NEW[ RTValue ← NIL ] ]
END ; -- New
END .