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;
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;
ReadStream:
PUBLIC PROC [stream:
IO.
STREAM]
RETURNS [symTab: SymTab.Ref] =
BEGIN
symTab ← SymTab.Create[97];
DO
EOF: BOOL ← FALSE;
i: INT;
line: Rope.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[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:
BOOL ←
FALSE]
RETURNS [
REF
ANY] =
BEGIN
ref, refTV: REF ANY ← NIL;
found: BOOL ← FALSE;
[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:
BOOL ←
FALSE]
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:
BOOL ←
FALSE]
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:
BOOL ←
FALSE]
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:
BOOL ←
FALSE]
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:
BOOL ←
FALSE]
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:
BOOL ←
FALSE]
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 BOOL ← NIL;
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:
BOOL ←
FALSE]
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 INT ← NIL;
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:
BOOL ←
FALSE]
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 CARDINAL ← NIL;
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 CARDINAL ← NIL;
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:
BOOL ←
FALSE]
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 ATOM ← NIL;
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:
BOOL ←
FALSE]
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.ROPE ← NIL;
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:
BOOL ←
FALSE]
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.