<> <> <> <> <> 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, symbolsList: LIST[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: 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.