<> <> <> <> 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; <> <<>> 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]]}; <<>> <> <<>> 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, 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; <<>> <> <<>> <<-- 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]]]]}; <> 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; <> <<>> <> 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] = <> <> <> <> BEGIN SymTabAction: SymTab.EachPairAction = {quit _ action[key, RefFromTV[val]]}; RETURN [SymTab.Pairs[symTab, SymTabAction]]; END; END.