<> <> <> <<>> DIRECTORY RobotEvaluator, Rope USING [ROPE, Equal, Fetch, Length]; RobotEvaluatorImpl: CEDAR PROGRAM IMPORTS RobotEvaluator, Rope EXPORTS RobotEvaluator ~ { OPEN RobotEvaluator; NewUnassignedValue: PUBLIC PROC RETURNS [z: Value] ~ { <> RETURN[NEW[ValueRec _ [type:unassigned] ]]; }; NewValueFromInteger: PUBLIC PROC [a: INTEGER] RETURNS [z: Value] ~ { <> RETURN[NEW[ValueRec _ [type:integer, value: a] ]]; }; ApplyUnaryFcn: PUBLIC PROC [fcn: UnOp, a: Value] RETURNS [z: 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] ~ { <> 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] ~ { <> 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] ~ { <> SELECT value.type FROM unExp => { a: Value _ Eval[value.a, s]; --Resolve the child first unOp: UnOp _ NARROW[value.fcn]; <> 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 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 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; <> 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] ~ { <> 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] ~ { <> 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; }; <> 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 ab 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]; }.