RobotEvaluatorImpl:
CEDAR
PROGRAM
IMPORTS RobotEvaluator, Rope
EXPORTS RobotEvaluator
~ {
OPEN RobotEvaluator;
NewUnassignedValue:
PUBLIC
PROC
RETURNS [z: Value] ~ {
Returns a new Value which is marked as being `unassigned'.
RETURN[NEW[ValueRec ← [type:unassigned] ]];
};
NewValueFromInteger:
PUBLIC
PROC [a:
INTEGER]
RETURNS [z: Value] ~ {
Returns a new Value which has the given INTEGER value.
RETURN[NEW[ValueRec ← [type:integer, value: a] ]];
};
ApplyUnaryFcn:
PUBLIC
PROC [fcn: UnOp, a: Value]
RETURNS [z: Value] ~ {
Apply the specified function to the given value.
val: Value ← NIL;
val ← NEW[ValueRec ← [type: unExp, fcn: fcn, a: a]];
RETURN[Eval[val]];
ApplyBinaryFcn:
PUBLIC
PROC [fcn: BinOp, a,b: Value]
RETURNS [z: Value] ~ {
Apply the specified function to the given values.
val: Value ← NIL;
val ← NEW[ValueRec ← [type: binExp, fcn: fcn, a: a, b: b]];
RETURN[Eval[val]];
ApplyTrinaryFcn:
PUBLIC
PROC [fcn: TrinOp, a,b,c: Value]
RETURNS [z: Value] ~ {
Apply the specified function to the given values.
val: Value ←
NIL;
val ← NEW[ValueRec ← [type: trinExp, fcn: fcn, a:a, b:b, c:c]];
RETURN[Eval[val]];
Eval:
PUBLIC
PROC [value: Value, s: SymbolTable ←
NIL]
RETURNS [z: Value] ~ {
Evaluate the value. Specifically, if the value was originally defined as a function of other values that were then unassigned, but are now at the time of the call to Eval, then Eval will return a Value that is an INTEGER rather than a complex type.
SELECT value.type
FROM
unExp => {
a: Value ← Eval[value.a, s]; --Resolve the child first
unOp: UnOp ← NARROW[value.fcn];
If the child can be resolved, then really apply the function
IF IsInteger[a] THEN RETURN[NewValueFromInteger[unOp^[a.value]]];
RETURN[NEW[ValueRec ← [type: unExp, fcn: value.fcn, a: a]]];
};
binExp => {
a: Value ← Eval[value.a, s]; --Resolve the children first
b: Value ← Eval[value.b, s];
binOp: BinOp ← NARROW[value.fcn];
If the children can be resolved, then really apply the function
IF IsInteger[a] AND IsInteger[b] THEN RETURN[NewValueFromInteger[binOp^[a.value,b.value]]];
RETURN[NEW[ValueRec ← [type: binExp, fcn: value.fcn, a: a, b: b]]];
};
trinExp => {
a: Value ← Eval[value.a, s]; --Resolve the children first
b: Value ← Eval[value.b, s];
c: Value ← Eval[value.c, s];
trinOp: TrinOp ← NARROW[value.fcn];
If the children can be resolved, then really apply the function
IF IsInteger[a] AND IsInteger[b] AND IsInteger[c] THEN RETURN[NewValueFromInteger[trinOp^[a.value, b.value, c.value]]];
RETURN[NEW[ValueRec ← [type: binExp, fcn: value.fcn, a: a, b: b, c: c]]];
};
symbolRef => {
IF s#NIL AND s[value.value]#NIL AND s[value.value].value.type=integer THEN RETURN[s[value.value].value];
}; --ELSE just RETURN the symbolRef as we found it
ENDCASE;
If we get here, either (1) it was already an INTEGER, or (2) it is still unassigned. In both cases, however, we can just return what we received.
RETURN[value];
};
IsInteger:
PRIVATE
PROC [value: Value]
RETURNS [
BOOLEAN] ~ {
RETURN[value.type=integer];
};
NewSymbolTable:
PUBLIC
PROC
RETURNS [s: SymbolTable] ~ {
RETURN [NEW[SymbolTableRec ← ALL[NIL]]];
};
RopeToSymbolIndex:
PUBLIC
PROC [r: Rope.
ROPE, s: SymbolTable]
RETURNS [index: Index] ~ {
Hash the rope into an index. Then, starting with that record, look for either a blank record or one where the name is equal to the ROPE passed to us.
i: Index ← HashRopeForSymbol[r];
count: INT ← 0;
DO
SELECT
TRUE
FROM
s[i]=NIL => {s[i]←NEW[SymbolRec ← [name: r, value: NewUnassignedValue[]]]; RETURN[i]};
Rope.Equal[s[i].name, r] => RETURN[i];
ENDCASE; --Fall through
i ← NextIndex[i]; --Only get here if had a collision in hashing
IF (count ← count+1) > MaxSymbolIndex THEN ERROR; --Symbol Table full
ENDLOOP;
};
HashRopeForSymbol:
PRIVATE
PROC [r: Rope.
ROPE]
RETURNS [index: Index] ~ {
Hash the rope into a pseudo-random index into a symbol table
len: INTEGER ← Rope.Length[r];
raw: INT ← (7*len + 31*CharToInt[Rope.Fetch[r,0]] + 103*CharToInt[Rope.Fetch[r,len-1]]) MOD MaxSymbolIndex;
index ← raw;
};
CharToInt:
PRIVATE
PROC [c:
CHAR]
RETURNS [i:
INT] ~
INLINE {
RETURN [ORD[c]];
};
ResolveSymbolTable:
PUBLIC
PROC [s: SymbolTable]
RETURNS [unresolved:
BOOLEAN] ~ {
AttemptResolve:
PROC
RETURNS [resolvedThisPass, stillUnresolved:
BOOLEAN] ~ {
resolvedThisPass ← FALSE;
stillUnresolved ← FALSE;
FOR i: Index
IN Index
DO
IF s[i]#
NIL
AND s[i].value.type#integer
THEN {
s[i].value ← Eval[s[i].value, s];
IF s[i].value.type=integer THEN resolvedThisPass ← TRUE ELSE stillUnresolved ← TRUE;
};
ENDLOOP;
};
resolvedThisPass, stillUnresolved: BOOLEAN ← TRUE; --TRUE causes at least 1 iteration
WHILE resolvedThisPass
AND stillUnresolved
DO
[resolvedThisPass, stillUnresolved] ← AttemptResolve[];
ENDLOOP;
unresolved ← stillUnresolved;
Define the actual procs that do the work, when we have resolved the args to INTEGERs.
opIfThenElseRec: TrinOpRec ~ {z ← IF a=0 THEN b ELSE c};
opORRec: BinOpRec ~ {z ← IF a=0 OR b=0 THEN 0 ELSE 1};
opANDRec: BinOpRec ~ {z ← IF a=0 AND b=0 THEN 0 ELSE 1};
opNOTRec: UnOpRec ~ {z ← IF a=0 THEN 1 ELSE 0};
opMODRec: BinOpRec ~ {z ← a MOD b; IF z<0 THEN z←z+b};
opLTRec: BinOpRec ~ {z ← IF a<b THEN 0 ELSE 1};
opEQRec: BinOpRec ~ {z ← IF a=b THEN 0 ELSE 1};
opGTRec: BinOpRec ~ {z ← IF a>b THEN 0 ELSE 1};
opNERec: BinOpRec ~ {z ← IF a#b THEN 0 ELSE 1};
opGERec: BinOpRec ~ {z ← IF a>=b THEN 0 ELSE 1};
opLERec: BinOpRec ~ {z ← IF a<=b THEN 0 ELSE 1};
opPlusRec: BinOpRec ~ {z ← a+b};
opMinusRec: BinOpRec ~ {z ← a-b};
opTimesRec: BinOpRec ~ {z ← a*b};
opDivideRec: BinOpRec ~ {z ← a/b};
opUMinusRec: UnOpRec ~ {z ← -a};
opIfThenElse: PUBLIC TrinOp ← NEW[TrinOpRec ← opIfThenElseRec];
opOR: PUBLIC BinOp ← NEW[BinOpRec ← opORRec];
opAND: PUBLIC BinOp ← NEW[BinOpRec ← opANDRec];
opNOT: PUBLIC UnOp ← NEW[UnOpRec ← opNOTRec];
opMOD: PUBLIC BinOp ← NEW[BinOpRec ← opMODRec];
opLT: PUBLIC BinOp ← NEW[BinOpRec ← opLTRec];
opEQ: PUBLIC BinOp ← NEW[BinOpRec ← opEQRec];
opGT: PUBLIC BinOp ← NEW[BinOpRec ← opGTRec];
opNE: PUBLIC BinOp ← NEW[BinOpRec ← opNERec];
opGE: PUBLIC BinOp ← NEW[BinOpRec ← opGERec];
opLE: PUBLIC BinOp ← NEW[BinOpRec ← opLERec];
opPlus: PUBLIC BinOp ← NEW[BinOpRec ← opPlusRec];
opMinus: PUBLIC BinOp ← NEW[BinOpRec ← opMinusRec];
opTimes: PUBLIC BinOp ← NEW[BinOpRec ← opTimesRec];
opDivide: PUBLIC BinOp ← NEW[BinOpRec ← opDivideRec];
opUMinus: PUBLIC UnOp ← NEW[UnOpRec ← opUMinusRec];