CDExprImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reversed.
Created by: Mayo, July 11, 1984 1:04:25 pm PDT
Last Edited by: Bertrand Serlet, August 26, 1985 5:04:48 pm PDT
DIRECTORY
CDExpr,
AMTypes USING [TV],
AMBridge USING [SomeRefFromTV, TVForReadOnlyReferent],
FS USING [StreamOpen, Error],
Interpreter USING [Evaluate],
IO USING [STREAM, GetLineRope, EndOfStream],
Rope USING [SkipTo, SkipOver, Length, Substr, Fetch, Cat],
SymTab;
CDExprImpl: CEDAR PROGRAM    
IMPORTS IO, FS, AMBridge, Interpreter, SymTab, Rope EXPORTS CDExpr = BEGIN
OPEN CDExpr;
Utilities
Error: PUBLIC ERROR [ec: ErrorCode, msg: ROPE] = CODE;
whiteSpace: ROPE ← " \n\t";
RefFromTV: PROC [tv: REF] RETURNS [REF] =
{IF ~ISTYPE [tv, AMTypes.TV] THEN
ERROR Error[NotTVTable, "Parameter table contained something other than a TV!"];
TRUSTED {RETURN [AMBridge.SomeRefFromTV[tv]]}};
TVFromRef: PROC [ref: REF] RETURNS [AMTypes.TV] =
TRUSTED {RETURN [AMBridge.TVForReadOnlyReferent[ref]]};
Reading and storing parameters
Eval: PROC [symTab: SymTab.Ref, expr: ROPE] RETURNS [AMTypes.TV] = BEGIN
tv: AMTypes.TV;
none: BOOL;
err: ROPE;
[tv, err, none] ← Interpreter.Evaluate[rope: expr, symTab: symTab];
IF err # NIL THEN
ERROR Error[CouldNotEval, Rope.Cat["Could not evaluate '", expr, "', error was '", err, "'."]]
ELSE IF none THEN
ERROR Error[NoValue, Rope.Cat["Expression '", expr, "' did not return a value."]];
RETURN [tv];
END;
Assign: PUBLIC PROC [symTab: SymTab.Ref, line: ROPE] RETURNS [BOOL] =
BEGIN
var, expr: ROPE;
start, end, operatorPos: INT;
operator: CHAR;
tv: AMTypes.TV;
TrimWhite: PROC [in: ROPE] RETURNS [ROPE] =
BEGIN
i, j: INT;
i ← Rope.SkipOver[in, 0, whiteSpace];
FOR j ← Rope.Length[in] - 1, j ← j - 1 WHILE j >= 0 DO
ch: CHAR ← Rope.Fetch[in, j];
IF ch # ' AND ch # '\n AND ch # '\t THEN EXIT;
ENDLOOP;
RETURN [IF j < i THEN "" ELSE Rope.Substr[in, i, j - i + 1]];
END;
operatorPos ← Rope.SkipTo[line, 0, "←~="];
IF operatorPos = Rope.Length[line] THEN 
ERROR Error[Syntax, Rope.Cat["No '←', '=', or '~' operator in '", line, "', evaluation not done."]];
operator ← Rope.Fetch[line, operatorPos];
IF operatorPos = Rope.Length[line] - 1 THEN
ERROR Error[Syntax, Rope.Cat["Empty expression in '", line, "', assignment not done."]];
expr ← Rope.Substr[line, operatorPos + 1, Rope.Length[line] - operatorPos];
-- evaluate RHS unless ~ (store as ROPE)
tv ← IF operator = '← THEN Eval[symTab, expr] ELSE TVFromRef[NEW [ROPE ← TrimWhite[expr]]];
-- parse the destination
var ← Rope.Substr[line, 0, operatorPos];
start ← Rope.SkipOver[var, 0, whiteSpace];
end ← Rope.SkipTo[var, 0, whiteSpace];
IF (end + 1 < Rope.Length[var]) AND (Rope.SkipOver[var, end + 1, whiteSpace] # Rope.Length[var]) THEN
ERROR Error[Syntax, Rope.Cat["Variable '", var, "' is malformed, assignment not done."]];
-- add into table
var ← Rope.Substr[var, start, end - start];
RETURN [SymTab.Store[symTab, var, tv]];
END;
ReadStream: PUBLIC PROC [stream: IO.STREAM] RETURNS [symTab: SymTab.Ref] = BEGIN
symTab ← SymTab.Create[37];
DO
EOF: BOOL ← FALSE;
i: INT;
line: ROPE;
line ← stream.GetLineRope[ ! IO.EndOfStream => {EOF ← TRUE; CONTINUE}];
IF EOF THEN EXIT;
i ← Rope.SkipOver[line, 0, whiteSpace];
IF i = Rope.Length[line] THEN LOOP;
IF Rope.Fetch[line, i] = '- AND i+1 < Rope.Length[line] AND Rope.Fetch[line, i+1] = '- THEN LOOP;
[] ← Assign[symTab, line];
ENDLOOP;
END;
ReadFile: PUBLIC PROC [fileName: ROPE] RETURNS [symTab: SymTab.Ref] = BEGIN
file: IO.STREAM ← NIL;
msg: ROPE ← NIL;
file ← FS.StreamOpen[fileName !FS.Error => IF error.group = user THEN {
msg ← error.explanation; CONTINUE }];
IF msg # NIL THEN ERROR Error[FileError, msg];
RETURN [ReadStream[file]];
END;
Storing parameters
-- base types & ref any for lists and other things
StoreBool: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE, val: BOOL] RETURNS [BOOL] =
{RETURN [StoreRef[symTab, name, NEW [BOOL ← val]]]};
StoreInt: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE, val: INT] RETURNS [BOOL] =
{RETURN [StoreRef[symTab, name, NEW [INT ← val]]]};
StoreAtom: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE, val: ATOM] RETURNS [BOOL] =
{RETURN [StoreRef[symTab, name, val]]};
StoreRope: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE, val: ROPE] RETURNS [BOOL] =
{RETURN [StoreRef[symTab, name, val]]};
StoreRef: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE, val: REF] RETURNS [BOOL] =
{RETURN [SymTab.Store[symTab, name, TVFromRef[NEW [REF ← val]]]]};
Fetching parameters
FetchBool: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE] RETURNS [found: BOOL, val: BOOL] =
BEGIN
ref: REF;
[found, ref] ← FetchRef[symTab, name];
IF ~found THEN RETURN [FALSE, FALSE];
WITH ref SELECT FROM
refVal: REF BOOL => RETURN [TRUE, refVal^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a BOOL."]];
END;
FetchInt: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE] RETURNS [found: BOOL, val: INT] =
BEGIN
ref: REF;
[found, ref] ← FetchRef[symTab, name];
IF ~found THEN RETURN [FALSE, 0];
WITH ref SELECT FROM
refVal: REF INT => RETURN [TRUE, refVal^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be an INT."]];
END;
FetchAtom: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE] RETURNS [found: BOOL, val: ATOM] =
BEGIN
ref: REF;
[found, ref] ← FetchRef[symTab, name];
IF ~found THEN RETURN [FALSE, NIL];
WITH ref SELECT FROM
refVal: REF ATOM => RETURN [TRUE, refVal^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be an ATOM."]];
END;
FetchRope: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE] RETURNS [found: BOOL, val: ROPE] =
BEGIN
ref: REF;
[found, ref] ← FetchRef[symTab, name];
IF ~found THEN RETURN [FALSE, NIL];
WITH ref SELECT FROM
refVal: REF ROPE => RETURN [TRUE, refVal^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a ROPE."]];
END;
FetchRef: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE] RETURNS [found: BOOL, val: REF] =
BEGIN
[found, val] ← SymTab.Fetch[symTab, name];
IF found THEN val ← RefFromTV[val];
END;
Operations on SymTab of TV
Combine 2 tables of TVs to yield a third. Values in the second table override values in the first table if there is a conflict.
CombineTabs: PUBLIC PROC [winner: SymTab.Ref, loser: SymTab.Ref ← NIL] RETURNS [SymTab.Ref] = BEGIN
resultTab: SymTab.Ref;
AddIn: SymTab.EachPairAction -- PROC [key: Key, val: Val] RETURNS [quit: BOOL] -- = BEGIN
[] ← SymTab.Store[resultTab, key, val];
RETURN [FALSE];
END;
size: INT ← SymTab.GetSize[winner];
IF loser # NIL THEN size ← size + SymTab.GetSize[loser];
resultTab ← SymTab.Create[size];
IF loser # NIL THEN [] ← SymTab.Pairs[loser, AddIn];
[] ← SymTab.Pairs[winner, AddIn];
RETURN [resultTab];
END;
Pairs: PUBLIC PROC [symTab: SymTab.Ref, action: SymTab.EachPairAction] RETURNS [BOOL] =
enumerates pairs currently in symbol table in unspecified order
pairs inserted/deleted during enumeration may or may not be seen
applies action to each pair until action returns TRUE or no more pairs
returns TRUE if some action returns TRUE
BEGIN
SymTabAction: SymTab.EachPairAction = {quit ← action[key, RefFromTV[val]]};
RETURN [SymTab.Pairs[symTab, SymTabAction]];
END;
END.