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, 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 [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]; tv _ IF operator = '_ THEN Eval[symTab, expr] ELSE TVFromRef[NEW [ROPE _ TrimWhite[expr]]]; 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."]]; 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; 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. 2CDExprImpl.mesa Copyright ╙ 1984, 1987 by Xerox Corporation. All rights reversed. Created by: Mayo, July 11, 1984 1:04:25 pm PDT Last Edited by: Bertrand Serlet, April 14, 1987 3:55:05 am PDT Utilities Reading and storing parameters -- evaluate RHS unless ~ (store as ROPE) -- parse the destination -- add into table Storing parameters -- base types & ref any for lists and other things Fetching parameters 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. 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 Э╩ /ШЪЬЩJЪЬBЩBJЪЬ+╧kЩ.JЪЬ>Щ>JШЧЪЭ Ш JШJЪЬЭЬЭЬШJЪЬ ЭЬ(Ш6JЪЭЬЭЬШJЪЬЭЬШJЪЭЬЭЬЭЬШ,JЪЬЭЬ0Ш:JЪЬШЧJШЪ╨bn ЬЭЬЭЬШЪ ЭЬЭЬЭЬ&ЭЬ ЭШJJЪЭЬ Ш ЧJШheadЪЬ Щ JЩJЪ ЮЬЭЬЭЬЭЬЭЬШ6JШJЪ╧b ЬЭЬШJШЪ ╧n ЬЭЬЭЬЭЬЭЬШ)Ъ ЬЭЬЭЬЭЬЭЬШ"JЪЭЬKШPЧJЪЭЬЭЬ Ш/ЧJШЪ а ЬЭЬЭЬЭЬ ЭЬШ1JЪЭЬЭЬ(Ш7ЧЧJЩЩJЩЪаЬЭЬЭЬЭЬ ЭЬЭШHJЪЬЭЬШJЪЬЭЬШJЪЬЭЬШ JЪЬ@ЭЬШOЪЭЬЭЬЭЬШJЪЭЬYШ^ЧЪЭЬЭЬЭЬШJЪЭЬMШRЧJЪЭЬШJЪЭЬШЧJШЪаЬЭЬЭЬЭЬЭЬЭЬШFJЪЭШJЪЬЭЬШJЪЬЭЬШJЪЬ ЭЬШJЪЬЭЬШJШЪ а ЬЭЬЭЬЭЬЭЬШ,JЪЭШJЪЬЭЬШ JШ%ЪЭЬ$ЭЬЭШ6JЪЬЭЬШJЪ ЭЬ ЭЬ ЭЬ ЭЬЭЬШ/JЪЭЬШЧJЪЭЬЭЬЭЬЭЬ Ш=JЪЭЬШJШЧJЪЬ*Ш*ЪЭЬ!ЭЬШ(JЪЭЬ_ШdЧJШ)ЪЭЬ%ЭЬШ,JЪЭЬSШXЧJЪЬLШLJЪ╧c(Щ(JЪЬЭЬЭЬЭЬЭЬЭЬШ[JЪбЩJЪЬ(Ш(JШ*JШ&ЪЭЬЭЬ>ЭЬШfJЪЭЬTШYЧJЪбЩJЪЬ+Ш+JЪЭЬ!Ш'ЪЭЬШJШЧЧЪ а ЬЭЬЭЬ ЭЬЭЬЭЬЭШPJЪЬШЪЭШJЪЭЬЭЬЭЬШJЪЬЭЬШJЪЬЭЬШJЪЬ╧r╨krвЬЭЬЭЬЭЬШGJЪЭЬЭЬЭЬЭЬШJШ'JЪЭЬЭЬЭЬШ#JЪ ЭЬЭЬЭЬЭЬЭЬШaJШJЪЭЬШЧJЪЭЬШЧЪаЬЭЬЭЬЭЬЭЬЭЬЭЬЭШ]JЪЬЭЬЭЬЭЬШJЪЬЭЬЭЬШJЪЬЭЬ-ЭЬ ЭЬЭЬЭЬШДJЪЭЬЭЬЭЬЭЬШ.JЪЭЬШJЪЭЬШЧЧJЩЩJЩJЪб2Щ2Ъа ЬЭЬЭЬЭЬЭЬЭЬЭЬШTJЪЬЭЬЭЬЭЬШ4ЧЪаЬЭЬЭЬЭЬЭЬЭЬЭЬШRJЪЬЭЬЭЬЭЬШ3ЧЪа ЬЭЬЭЬЭЬЭЬЭЬЭЬШTJЪЬЭЬ Ш'ЧЪа ЬЭЬЭЬЭЬЭЬЭЬЭЬШTJЪЬЭЬ Ш'ЧJШЪаЬЭЬЭЬЭЬЭЬЭЬЭЬШRJЪЬЭЬ'ЭЬЭЬШBЧЧJШЩJШЪа ЬЭЬЭЬЭЬЭЬ ЭЬЭЬШ[JЪЭШJЪЬЭЬШ JЪЬ&Ш&JЪ ЭЬЭЬЭЬЭЬЭЬШ%ЪЭЬЭЬЭШJЪ ЬЭЬЭЬЭЬЭЬШ+JЪЭЬЭЬDШTЧJЪЭЬШJШЧЪаЬЭЬЭЬЭЬЭЬ ЭЬЭЬШYJЪЭШJЪЬЭЬШ JЪЬ&Ш&JЪЭЬЭЬЭЬЭЬШ!ЪЭЬЭЬЭШJЪ ЬЭЬЭЬЭЬЭЬШ*JЪЭЬЭЬDШTЧJЪЭЬШJШЧЪа ЬЭЬЭЬЭЬЭЬ ЭЬЭЬШ[JЪЭШJЪЬЭЬШ JЪЬ&Ш&JЪ ЭЬЭЬЭЬЭЬЭЬШ#ЪЭЬЭЬЭШJЪ ЬЭЬЭЬЭЬЭЬШ+JЪЭЬЭЬEШUЧJЪЭЬШЧJШЪа ЬЭЬЭЬЭЬЭЬ ЭЬЭЬШ[JЪЭШJЪЬЭЬШ JЪЬ&Ш&JЪ ЭЬЭЬЭЬЭЬЭЬШ#ЪЭЬЭЬЭШJЪ ЬЭЬЭЬЭЬЭЬШ+JЪЭЬЭЬDШTЧJЪЭЬШJШЧЪаЬЭЬЭЬЭЬЭЬ ЭЬЭЬШXJЪЭШJЪЬ*Ш*JЪЭЬЭЬШ#JЪЭЬШЧЧJШЪЬЭЩJЩJЪЬАЩАЪаЬЭЬЭЬ*ЭЬЭЬЭШcJШJШЪЮЬб4ЬЭШYJШ'JЪЭЬЭЬШJЪЭЬШJШЧJЪЬЭЬШ#JЪЭЬ ЭЬЭЬ%Ш8JЪЬ Ш JЪЭЬ ЭЬЭЬ!Ш4JЪЬ!Ш!JЪЭЬ ШJЪЭЬШЧЧШЪ аЬЭЬЭЬ5ЭЬЭЬШWJЪЬ?Щ?JЪЬ@Щ@JЪЬ1ЭЬЩFJЪЬЭЬЭЩ(JЪЭШJХStartOfExpansion? -- [key: SymTab.Key, val: SymTab.Val] RETURNS [quit: BOOL] -- ЪЮЬ?ШKJЪЭЬ&Ш,JЪЭЬШЧЧJШJЪЭЬШЧЧЕЧф&E