File: ExprReadImpl.mesa   
Copyright © 1984 by Xerox Corporation. All rights reserved.
Created by: Mayo, July 11, 1984 1:04:25 pm PDT
Last Edited by: Mayo, August 31, 1984 1:19:04 am PDT
DIRECTORY
ExprRead,
Interpreter USING [Evaluate],
FS USING [StreamOpen, Error],
IO USING [STREAM, GetLineRope, EndOfStream],
SymTab,
AMTypes USING [TV],
AMBridge USING [SomeRefFromTV, TVForReadOnlyReferent, TVForROPE, TVForATOM],
Rope USING [ROPE, SkipTo, SkipOver, Length, Substr, Fetch, Cat];
ExprReadImpl: CEDAR PROGRAM    
IMPORTS IO, FS, AMBridge, Interpreter, SymTab, Rope EXPORTS ExprRead = BEGIN
OPEN ExprRead;
Error: PUBLIC ERROR[ec: ErrorCode, msg: Rope.ROPE] = CODE;
whiteSpace: Rope.ROPE ← " \n\t";
Eval: PUBLIC PROC [expr: Rope.ROPE, symTab: SymTab.Ref] RETURNS [AMTypes.TV] = BEGIN
tv: AMTypes.TV;
none: BOOL;
err: Rope.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 [line: Rope.ROPE, symTab: SymTab.Ref] = BEGIN
var, expr: Rope.ROPE;
operatorPos: INT;
operator: CHAR;
tv: AMTypes.TV;
TrimWhite: PROC [in: Rope.ROPE] RETURNS[Rope.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;
IF j < i THEN
RETURN[""]
ELSE
RETURN[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
IF operator = '← THEN
tv ← Eval[expr, symTab]
ELSE {      
-- don't evaluate RHS, store as ROPE
expr ← TrimWhite[expr];
TRUSTED {tv ← AMBridge.TVForROPE[expr];};
};
IF operatorPos > 0 THEN BEGIN
start, end: INT;
-- 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 BEGIN
ERROR Error[$Syntax, Rope.Cat["Variable '", var, "' is malformed, assignment not done."]];
END
ELSE BEGIN
-- add into table
var ← Rope.Substr[var, start, end - start];
[] ← SymTab.Store[symTab, var, tv];
END;
END;
END;
ReadStream: PUBLIC PROC [stream: IO.STREAM] RETURNS [symTab: SymTab.Ref] = BEGIN
symTab ← SymTab.Create[97];
DO
EOF: BOOLFALSE;
i: INT;
line: Rope.ROPE;
line ← stream.GetLineRope[ ! IO.EndOfStream => {EOFTRUE; 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[line, symTab];
ENDLOOP;
END;
ReadFile: PUBLIC PROC [fileName: Rope.ROPE] RETURNS [symTab: SymTab.Ref] = BEGIN
file: IO.STREAM ← NIL;
msg: Rope.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;
-- 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 [first, second: SymTab.Ref] 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;
size1, size2: INT ← 0;
IF first # NIL THEN size1 ← SymTab.GetSize[first];
IF second # NIL THEN size2 ← SymTab.GetSize[second];
resultTab ← SymTab.Create[size1 + size2];
IF first # NIL THEN [] ← SymTab.Pairs[first, AddIn];
IF second # NIL THEN [] ← SymTab.Pairs[second, AddIn];
RETURN[resultTab];
END;
FetchProc: PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [REF ANY] = BEGIN
ref, refTV: REF ANYNIL;
found: BOOLFALSE;
[found, refTV] ← SymTab.Fetch[params, name];
IF ~found THEN {
IF missingOK THEN
RETURN[NIL]
ELSE
ERROR Error[Missing, Rope.Cat["Parameter '", name, "' is missing."]];
};
IF ~ISTYPE[refTV, AMTypes.TV] THEN ERROR Error[NotTVTable, "Parameter table contained something other than a TV!"];
TRUSTED {ref ← AMBridge.SomeRefFromTV[refTV];};
RETURN[ref];
END;
FetchBool: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: BOOL] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, FALSE];
WITH ref SELECT FROM
b: REF BOOL => RETURN[TRUE, b^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a boolean."]];
END;
FetchInt: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: INT] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, 0];
WITH ref SELECT FROM
i: REF INT => RETURN[TRUE, i^];
c: REF CARDINAL => RETURN[TRUE, c^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be an integer."]];
END;
FetchCardinal: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: CARDINAL] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, 0];
WITH ref SELECT FROM
i: REF INT => {
IF i^ >= 0 THEN
RETURN[TRUE, i^]
ELSE
ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a cardinal."]];
};
c: REF CARDINAL => RETURN[TRUE, c^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a cardinal."]];
END;
FetchAtom: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: ATOM] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, NIL];
WITH ref SELECT FROM
a: REF ATOM => RETURN[TRUE, a^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be an atom."]];
END;
FetchRope: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: Rope.ROPE] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, NIL];
WITH ref SELECT FROM
r: REF Rope.ROPE => RETURN[TRUE, r^];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a rope."]];
END;
FetchListOfBool: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: LIST OF BOOL] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, NIL];
WITH ref SELECT FROM
refR: REF LIST OF BOOL => RETURN[TRUE, refR^];
refA: REF LIST OF REF ANY => {
rr, rf: LIST OF BOOLNIL;
FOR la: LIST OF REF ANY ← refA^, la.rest WHILE la # NIL DO
WITH la.first SELECT FROM
a: REF BOOL => rr ← CONS[a^, rr];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of booleans."]];
ENDLOOP;
FOR la: LIST OF BOOL ← rr, la.rest WHILE la # NIL DO
rf ← CONS[la.first, rf];
ENDLOOP;
RETURN[TRUE, rf];
};
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of booleans."]];
END;
FetchListOfInt: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: LIST OF INT] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, NIL];
WITH ref SELECT FROM
refI: REF LIST OF INT => RETURN[TRUE, refI^];
refA: REF LIST OF REF ANY => {
rr, rf: LIST OF INTNIL;
FOR la: LIST OF REF ANY ← refA^, la.rest WHILE la # NIL DO
WITH la.first SELECT FROM
i: REF INT => rr ← CONS[i^, rr];
c: REF CARDINAL => rr ← CONS[c^, rr];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of integers."]];
ENDLOOP;
FOR la: LIST OF INT ← rr, la.rest WHILE la # NIL DO
rf ← CONS[la.first, rf];
ENDLOOP;
RETURN[TRUE, rf];
};
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of integers."]];
END;
FetchListOfCardinal: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: LIST OF CARDINAL] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, NIL];
WITH ref SELECT FROM
refC: REF LIST OF CARDINAL => RETURN[TRUE, refC^];
refI: REF LIST OF INT => {
rr, rf: LIST OF CARDINALNIL;
FOR la: LIST OF INT ← refI^, la.rest WHILE la # NIL DO
IF la.first >= 0 THEN
rr ← CONS[la.first, rr]
ELSE
ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of cardinals."]];
ENDLOOP;
FOR la: LIST OF CARDINAL ← rr, la.rest WHILE la # NIL DO
rf ← CONS[la.first, rf];
ENDLOOP;
RETURN[TRUE, rf];
};
refA: REF LIST OF REF ANY => {
rr, rf: LIST OF CARDINALNIL;
FOR la: LIST OF REF ANY ← refA^, la.rest WHILE la # NIL DO
WITH la.first SELECT FROM
i: REF INT => rr ← CONS[i^, rr];
c: REF CARDINAL => rr ← CONS[c^, rr];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of cardinals."]];
ENDLOOP;
FOR la: LIST OF CARDINAL ← rr, la.rest WHILE la # NIL DO
rf ← CONS[la.first, rf];
ENDLOOP;
RETURN[TRUE, rf];
};
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of integers."]];
END;
FetchListOfAtom: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: LIST OF ATOM] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, NIL];
WITH ref SELECT FROM
refR: REF LIST OF ATOM => RETURN[TRUE, refR^];
refA: REF LIST OF REF ANY => {
rr, rf: LIST OF ATOMNIL;
FOR la: LIST OF REF ANY ← refA^, la.rest WHILE la # NIL DO
WITH la.first SELECT FROM
a: ATOM => rr ← CONS[a, rr];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of atoms."]];
ENDLOOP;
FOR la: LIST OF ATOM ← rr, la.rest WHILE la # NIL DO
rf ← CONS[la.first, rf];
ENDLOOP;
RETURN[TRUE, rf];
};
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of atoms."]];
END;
FetchListOfRope: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: LIST OF Rope.ROPE] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, NIL];
WITH ref SELECT FROM
refR: REF LIST OF Rope.ROPE => RETURN[TRUE, refR^];
refA: REF LIST OF REF ANY => {
rr, rf: LIST OF Rope.ROPENIL;
FOR la: LIST OF REF ANY ← refA^, la.rest WHILE la # NIL DO
WITH la.first SELECT FROM
r: Rope.ROPE => rr ← CONS[r, rr];
rp: REF Rope.ROPE => rr ← CONS[rp^, rr];
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of ropes."]];
ENDLOOP;
FOR la: LIST OF Rope.ROPE ← rr, la.rest WHILE la # NIL DO
rf ← CONS[la.first, rf];
ENDLOOP;
RETURN[TRUE, rf];
};
ENDCASE => ERROR Error[BadType, Rope.Cat["Parameter '", name, "' must be a list of ropes."]];
END;
FetchRefAny: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, missingOK: BOOLFALSE] RETURNS [found: BOOL, val: REF ANY] = BEGIN
ref: REF ANY ← FetchProc[params, name, missingOK];
IF ref = NIL THEN RETURN[FALSE, NIL];
RETURN[TRUE, ref];
END;
-- base types & ref any for lists and other things
StoreBool: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, val: BOOL] = BEGIN
StoreRefAny[params, name, NEW[BOOL ← val]];
END;
StoreInt: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, val: INT] = BEGIN
StoreRefAny[params, name, NEW[INT ← val]];
END;
StoreCardinal: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, val: CARDINAL] = BEGIN
StoreRefAny[params, name, NEW[CARDINAL ← val]];
END;
StoreAtom: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, val: ATOM] = BEGIN
tv: AMTypes.TV;
TRUSTED{tv ← AMBridge.TVForATOM[val]};
[] ← SymTab.Store[params, name, tv];
END;
StoreRope: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, val: Rope.ROPE] = BEGIN
tv: AMTypes.TV;
TRUSTED{tv ← AMBridge.TVForROPE[val]};
[] ← SymTab.Store[params, name, tv];
END;
StoreRefAny: PUBLIC PROC [params: SymTab.Ref, name: Rope.ROPE, val: REF ANY] = BEGIN
tv: AMTypes.TV;
TRUSTED{tv ← AMBridge.TVForReadOnlyReferent[val]};
[] ← SymTab.Store[params, name, tv];
END;
END.