[Cyan]<DATools6.1>PW>CDExprImpl.mesa!1

CDExprImpl.mesa

Created by: Mayo, July 11, 1984 1:04:25 pm PDT

Last Edited by: Bertrand Serlet, May 28, 1986 11:59:06 am 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];

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, wDir: ROPE ← NIL] RETURNS [symTab: SymTab.Ref] = BEGIN

file: IO.STREAM ← NIL;

msg: ROPE ← NIL;

file ← FS.StreamOpen[fileName: fileName, wDir: wDir ! 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.