<> <> DIRECTORY AMBridge USING [TVForReadOnlyReferent], AMTypes USING [NComponents, TVType, TypeClass, UnderType], BBEmptyReturn USING [TheEmptyReturn], BBEval USING [Eval, EvalHead, GetSymTab], BBInterp USING [Tree], BBSafety USING [Mother], CedarScanner USING [ AtomFromToken, CharFromToken, ContentsFromToken, GetClosure, GetProc, GetToken, IntFromToken, RealFromToken, RopeFromToken, Token], PPLeaves USING [HTNode, LTNode], PPOps USING [ParseStream], PPTree USING [Link, Node, NodeName, Null], PrintTV USING [NullPutClosure, PutClosure], Rope USING [Equal, Flatten, Replace, ROPE, SkipTo, Text], RTBasic USING [nullType, TV, Type], SymTab USING [Ref, Store]; BBInterpImpl: CEDAR PROGRAM IMPORTS AMBridge, AMTypes, BBEmptyReturn, BBEval, BBSafety, CedarScanner, PPOps, Rope, SymTab EXPORTS BBInterp SHARES Rope = BEGIN OPEN BBEval, BBInterp, PrintTV, Rope, RTBasic; CARD: TYPE = LONG CARDINAL; <> stmtTemplate: ROPE _ "Expr: PROGRAM = {\n}."; stmtPos: INT _ stmtTemplate.SkipTo[0, "\n"]; nilNode: REF PPTree.Node _ NEW[PPTree.Node[0]]; empty: TV _ BBEmptyReturn.TheEmptyReturn[]; useSimpleParse: BOOL _ TRUE; ParseExpr: PUBLIC PROC [expr: ROPE, errout: PutClosure _ NullPutClosure] RETURNS [Tree] = { tree: PPTree.Link _ PPTree.Null; text: Rope.Text _ expr.Flatten[]; IF useSimpleParse THEN RETURN[SimpleParse[text ! NotSimple => CONTINUE]]; <> IF NOT IsSimpleAssign[text] THEN expr _ Rope.Replace["&_(\n)", 3, 0, text]; expr _ stmtTemplate.Replace[stmtPos, 0, expr]; tree _ PPOps.ParseStream[source: expr, errPut: errout]; <> RETURN [GetFirstAssign[tree]]; }; EvalExpr: PUBLIC PROC [tree: Tree, head: EvalHead] RETURNS [rtns: TV, numRtns: NAT] = { type: Type _ nullType; rtns _ BBEval.Eval[tree, head, nullType]; IF rtns = empty THEN {numRtns _ 0; RETURN}; numRtns _ 1; type _ AMTypes.UnderType[AMTypes.TVType[rtns]]; IF AMTypes.TypeClass[type] = structure THEN numRtns _ AMTypes.NComponents[type]; }; NotSimple: ERROR = CODE; SimpleTokenClass: TYPE = {none, id, literal, atom, assign, dot, comma, nil, leftParen, rightParen, leftSquare, rightSquare}; SimpleParse: PROC [rope: ROPE] RETURNS [root: PPTree.Link] = { <> <> <> OPEN PPLeaves, PPTree, Rope; text: Text _ rope.Flatten[]; index: NAT _ 0; len: NAT _ IF text = NIL THEN 0 ELSE text.length; allcaps: BOOL _ FALSE; tok: Text _ NIL; class: SimpleTokenClass _ none; value: REF _ NIL; GetChar1: CedarScanner.GetProc = { <> c: CHAR _ 0C; IF index < len THEN IF (c _ text[index]) = '& THEN c _ 'a; RETURN [c]; }; GetChar2: CedarScanner.GetProc = { <> <> c: CHAR _ 0C; IF index < len THEN c _ text[index]; IF allcaps AND c NOT IN ['A..'Z] THEN allcaps _ FALSE; RETURN [c]}; GetToken: PROC [idCheck: BOOL _ TRUE] = { ENABLE {ABORTED => GO TO abort; ANY => GO TO complex}; mtok: CedarScanner.Token; DO allcaps _ TRUE; class _ none; mtok _ CedarScanner.GetToken[GetClosure1, index]; index _ mtok.next; tok _ CedarScanner.ContentsFromToken[GetClosure2, mtok].Flatten[]; SELECT mtok.kind FROM tokenID => { SELECT TRUE FROM NOT allcaps => class _ id; tok.Equal["NIL"] => class _ nil; tok.Equal["TRUE"], tok.Equal["FALSE"] => class _ id; NOT idCheck => class _ id; ENDCASE => ERROR NotSimple; }; tokenINT => { class _ literal; value _ NEW[INT _ CedarScanner.IntFromToken[GetClosure2, mtok]]}; tokenREAL => { class _ literal; value _ NEW[REAL _ CedarScanner.RealFromToken[GetClosure2, mtok]]}; tokenROPE => { class _ literal; value _ CedarScanner.RopeFromToken[GetClosure2, mtok]; }; tokenCHAR => { class _ literal; value _ NEW[CHAR _ CedarScanner.CharFromToken[GetClosure2, mtok]]; }; tokenATOM => { class _ atom; value _ CedarScanner.AtomFromToken[GetClosure2, mtok]; }; tokenSINGLE => { c: CHAR _ GetChar2[NIL, mtok.start]; SELECT c FROM '_ => class _ assign; '. => class _ dot; ', => class _ comma; '( => class _ leftParen; ') => class _ rightParen; '[ => class _ leftSquare; '] => class _ rightSquare; ENDCASE => ERROR NotSimple; }; tokenCOMMENT => LOOP; tokenEOF => {}; ENDCASE => GO TO complex; RETURN; ENDLOOP; EXITS abort => ERROR ABORTED; complex => ERROR NotSimple; }; InternalParse: PROC RETURNS [PPTree.Link] = { left: Link _ Null; leftClass: SimpleTokenClass _ none; GetToken[]; leftClass _ class; SELECT class FROM id => -- an identifier left _ NEW[HTNode _ [index: 0, name: tok]]; nil => left _ nilNode; literal => -- a number left _ NEW[LTNode _ [index: 0, value: value, literal: tok]]; atom => { <> temp: REF Node _ NEW[Node[1]]; temp.name _ atom; temp[1] _ NEW[HTNode _ [index: 0, name: tok]]; left _ temp}; leftParen => { left _ InternalParse[]; IF class # rightParen THEN GO TO oops; class _ none} ENDCASE => GO TO oops; DO GetToken[]; SELECT class FROM none, rightParen, rightSquare, comma => EXIT; leftSquare => { list, tail, each: LIST OF Link _ NIL; count: CARDINAL _ 0; temp, node: REF Node _ NIL; right: Link _ Null; DO save: NAT _ index; GetToken[]; SELECT class FROM rightSquare => EXIT; comma => each _ LIST[Null]; ENDCASE => { index _ save; each _ LIST[InternalParse[]]; SELECT class FROM comma, rightSquare => {}; ENDCASE => GO TO oops; }; count _ count + 1; IF tail = NIL THEN list _ each ELSE tail.rest _ each; tail _ each; IF class = rightSquare THEN EXIT; ENDLOOP; SELECT count FROM 0 => {}; 1 => right _ list.first; ENDCASE => { temp _ NEW[Node[count]]; right _ temp; temp.name _ list; FOR i: CARDINAL IN [1..count] DO temp[i] _ list.first; list _ list.rest; ENDLOOP}; node _ NEW[Node[2]]; node.name _ apply; node[1] _ left; node[2] _ right; left _ node}; dot => { temp: REF Node _ NIL; right: Link _ Null; GetToken[FALSE]; IF class # id THEN ERROR NotSimple; right _ NEW[HTNode _ [index: 0, name: tok]]; temp _ NEW[Node[2]]; temp.name _ dot; temp[1] _ left; temp[2] _ right; left _ temp; leftClass _ id}; assign => { temp: REF Node _ NIL; right: Link _ InternalParse[]; IF right = Null THEN GO TO oops; temp _ NEW[Node[2]]; temp.name _ assign; temp[1] _ left; temp[2] _ right; left _ temp} ENDCASE => GO TO oops; IF class = rightParen THEN EXIT; ENDLOOP; RETURN [left]; EXITS oops => ERROR NotSimple }; GetClosure1: CedarScanner.GetClosure; GetClosure2: CedarScanner.GetClosure; TRUSTED { <> <> GetClosure1 _ [GetChar1]; GetClosure2 _ [GetChar2]; }; root _ InternalParse[]; IF class # none OR root = NIL THEN ERROR NotSimple }; GetFirstAssign: PROC [tree: PPTree.Link] RETURNS [PPTree.Link] = { <> <<(where "first" is first in the preorder traversal)>> WITH tree SELECT FROM node: REF PPTree.Node => { kind: PPTree.NodeName _ node.name; nsons: CARDINAL = node.sonLimit - 1; IF kind = assign THEN RETURN [node]; FOR i: CARDINAL IN [1..nsons] DO nt: PPTree.Link _ GetFirstAssign[node[i]]; IF nt # NIL THEN RETURN [nt] ENDLOOP} ENDCASE; RETURN [NIL] }; IsSimpleAssign: PROC [text: Rope.Text] RETURNS [BOOL] = { GetClosure1: CedarScanner.GetClosure; GetChar1: CedarScanner.GetProc = { <> c: CHAR _ 0C; IF index < len THEN IF (c _ text[index]) = '& THEN c _ 'a; RETURN [c]; }; index: NAT _ 0; len: NAT _ text.length; token: CedarScanner.Token; TRUSTED { <> GetClosure1 _ [GetChar1]; }; <> DO token _ CedarScanner.GetToken[GetClosure1, index]; index _ token.next; SELECT token.kind FROM tokenID => EXIT; tokenCOMMENT => LOOP; ENDCASE => RETURN [FALSE]; ENDLOOP; <> DO token _ CedarScanner.GetToken[GetClosure1, index]; index _ token.next; SELECT token.kind FROM tokenSINGLE => RETURN [text[token.start] = '_]; tokenCOMMENT => LOOP; ENDCASE => RETURN [FALSE]; ENDLOOP; }; TVForUnderType: PROC [under: Type] RETURNS [TV] = TRUSTED { RETURN [AMBridge.TVForReadOnlyReferent [NEW[Type _ AMTypes.UnderType[under]]]] }; HelpOurBuddy: PROC = TRUSTED { symtab: SymTab.Ref _ BBEval.GetSymTab[]; lag: TV _ NIL; <> [] _ symtab.Store["ATOM", TVForUnderType[CODE[ATOM]]]; [] _ symtab.Store["BOOL", lag _ TVForUnderType[CODE[BOOL]]]; [] _ symtab.Store["BOOLEAN", lag]; [] _ symtab.Store["CARD", TVForUnderType[CODE[CARD]]]; [] _ symtab.Store["CARDINAL", TVForUnderType[CODE[CARDINAL]]]; [] _ symtab.Store["CHAR", lag _ TVForUnderType[CODE[CHAR]]]; [] _ symtab.Store["CHARACTER", lag]; [] _ symtab.Store["INT", TVForUnderType[CODE[INT]]]; [] _ symtab.Store["INTEGER", TVForUnderType[CODE[INTEGER]]]; [] _ symtab.Store["PROC", TVForUnderType[CODE[PROC]]]; [] _ symtab.Store["PROCANY", TVForUnderType[CODE[PROC ANY RETURNS ANY]]]; [] _ symtab.Store["PROCESS", TVForUnderType[CODE[PROCESS]]]; [] _ symtab.Store["REF", TVForUnderType[CODE[REF]]]; [] _ symtab.Store["ROPE", TVForUnderType[CODE[ROPE]]]; [] _ symtab.Store["WORD", TVForUnderType[CODE[WORD]]]; }; nilNode.name _ nil; [] _ BBSafety.Mother[HelpOurBuddy]; END.