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]; 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] RETURNS [symTab: SymTab.Ref] = BEGIN file: IO.STREAM _ NIL; msg: 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; 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, NEW [ATOM _ val]]]}; StoreRope: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE, val: ROPE] RETURNS [BOOL] = {RETURN [StoreRef[symTab, name, NEW [ROPE _ val]]]}; StoreRef: PUBLIC PROC [symTab: SymTab.Ref, name: ROPE, val: REF] RETURNS [BOOL] = {RETURN [SymTab.Store[symTab, name, TVFromRef[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. ÔCDExprImpl.mesa Copyright c 1984 by Xerox Corporation. All rights reversed. Created by: Mayo, July 11, 1984 1:04:25 pm PDT Last Edited by: Bertrand Serlet, January 4, 1985 7:00:07 pm PST Utilities Reading and storing parameters Bertrand made that Proc private because a simple way to have it is to do an appropriate fetch after a store in a symbol table. This avoids the need of many eval procs. -- 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šœ Ïmœ1™žœ˜fJšžœT˜Y—J™Jšœ+˜+Jšžœ!˜'šžœ˜J˜——š   œžœžœ žœžœžœž˜PJšœ˜šž˜Jšžœžœžœ˜Jšœžœ˜Jšœžœ˜ Jš œÏrÐkr¢ œžœžœžœ˜GJšžœžœžœžœ˜J˜'Jšžœžœžœ˜#Jš žœžœžœžœžœ˜aJ˜Jšžœ˜—Jšžœ˜—š  œžœžœ žœžœž˜KJšœžœžœžœ˜Jšœžœžœ˜Jš œžœžœ žœžœžœ˜mJšžœžœžœžœ˜.Jšžœ˜Jšžœ˜——J™™J™Jšœ2™2š  œžœžœžœžœžœžœ˜TJšœžœžœžœ ˜4—š œžœžœžœžœžœžœ˜RJšœžœžœžœ ˜3—š  œžœžœžœžœžœžœ˜TJšœžœžœžœ ˜4—š  œžœžœžœžœžœžœ˜TJšœžœžœžœ ˜4—J˜š œžœžœžœžœžœžœ˜RJšœžœ/˜6——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šžœžœ<žœ˜U—Jšžœ˜—J˜š  œžœžœžœžœ žœžœ˜[Jšž˜Jšœž˜ Jšœ&˜&Jšžœžœžœžœ˜#šžœžœž˜Jš œžœžœžœžœ ˜+Jšžœžœ;žœ˜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šœF™FJšœ(™(Jšž˜J•StartOfExpansion? -- [key: SymTab.Key, val: SymTab.Val] RETURNS [quit: BOOL] -- šŸ œ?˜KJšžœ&˜,Jšžœ˜——J˜Jšžœ˜——…—¼&—