DIRECTORYAMBridge,AMTypes,Convert,Express,ExpressParser,ExpressToken,ExpressTree,Real,RealFns,Rope;ExpressParserImpl: CEDAR PROGRAMIMPORTS AMBridge, AMTypes, Convert, ExpressToken, ExpressTree, Real, RealFns, RopeEXPORTS Express, ExpressParser~ {OPEN ExpressParser, E: Express, ETk: ExpressToken, ET: ExpressTree, RF: RealFns;ROPE: TYPE ~ Rope.ROPE;Token: TYPE ~ ETk.Token;ErrorDesc: TYPE ~ E.ErrorDesc;ParseError: PUBLIC ERROR [ErrorDesc] ~ CODE;IllegalClientProcedure: PUBLIC ERROR ~ CODE;ParseExpression: PUBLIC PROC [ts: TokenStream, symbols: Symbols, cProcs: ClientProcList _ NIL] RETURNS [expression: XTree] ~ {Error: PROC [message: ROPE] ~ {ERROR ParseError[[message, ETk.TokenPosition[ts]]];};RopeToReal: PROC [rope: ROPE] RETURNS [value: REAL] ~ {OPEN C: Convert;IF Rope.Find[rope, "."]=-1THEN value _ C.CardFromDecimalLiteral[rope ! ANY => Error["Expected value"]]ELSE value _ C.RealFromRope[rope ! ANY => Error["Expected value"]];};ClientProcInfo: PROC [procName: ROPE] RETURNS [nItems: NAT, proc: PROC ANY RETURNS [REAL]] ~ TRUSTED {FOR cProc: ClientProcList _ cProcs, cProc.rest UNTIL cProc=NIL DOIF Rope.Equal[cProc.first.userRope, procName, FALSE] THEN {OPEN AMTypes;procType: Type _ TVType[ AMBridge.TVForProc[cProc.first.proc]];domain: Type _ Domain[procType];range: Type _ Range[procType];proc _ cProc.first.proc;IF Size[Range[procType]]#2 THEN ERROR IllegalClientProcedure[];nItems _ NComponents[domain];		--Ah, but are they all the right size?FOR i: Index IN [1..nItems] DOIF Size[IndexToType[domain, 1]]#2 THEN ERROR IllegalClientProcedure[];ENDLOOP;RETURN;};ENDLOOP;ERROR;};Type: PROC RETURNS [ATOM] ~ {RETURN[GetToken[].kind];};PeekType: PROC RETURNS [ATOM] ~ {token: Token _ GetToken[];Push[token];RETURN[token.kind];};Skip: PROC ~ {					--Peeked at token, and now wants to throw it away...[] _ GetToken[];};GetToken: PROC RETURNS [Token] ~ {RETURN[ETk.GetNextToken[ts, symbols, cProcs]]};Push: PROC [t: Token] ~ {ETk.PushToken[ts, t]};Relop: PROC [kind: ATOM] RETURNS [BOOLEAN] ~ {RETURN[SELECT kind FROM$LT, $GT, $LE, $GE, $EQ, $NE => TRUE,ENDCASE => FALSE];};InvertRelop: PROC [kind: ATOM] RETURNS [ATOM] ~ {RETURN[SELECT kind FROM$LT => $GE,$GT => $LE,$LE => $GT,$GE => $LT,$EQ => $NE,$NE => $EQ,ENDCASE => kind]};ParseExp: PROC RETURNS [XTree] ~ {IF PeekType[]=$If THEN {e1, e2, e3: XTree;Skip[];													--IFe1 _ ParseDisjunct[];									--exp1IF Type[]#$Then THEN Error["Expected THEN"];	--THENe2 _ ParseExp[];											--exp2IF Type[]#$Else THEN Error["Expected ELSE"];		--ELSEe3 _ ParseExp[];											--exp3RETURN[ET.ApplyTrinOp[$If, e1, e2, e3]];}ELSE {RETURN[ParseSum[]];};};ParseSum: PROC RETURNS [exp: XTree] ~ {token: Token;exp _ ParseProduct[];DOtoken _ GetToken[];SELECT token.kind FROM$Add, $Subtract => exp _ ET.ApplyBinOp[token.kind, exp, ParseProduct[]];ENDCASE => {Push[token]; EXIT};ENDLOOP;};ParseProduct: PROC RETURNS [exp: XTree] ~ {token: Token;exp _ ParseFactor[];DOtoken _ GetToken[];SELECT token.kind FROM$Multiply, $Divide => exp _ ET.ApplyBinOp[token.kind, exp, ParseFactor[]]; $mod => exp _ ET.ApplyFcn[KindToProc[token.kind], LIST[exp, ParseFactor[]]];ENDCASE => {Push[token]; EXIT};ENDLOOP;};ParseDisjunct: PROC RETURNS [exp: XTree] ~ {token: Token;exp _ ParseConjunct[];DOtoken _ GetToken[];SELECT token.kind FROM$or => exp _ ET.ApplyBinOp[token.kind, exp, ParseConjunct[]];ENDCASE => {Push[token]; EXIT};ENDLOOP;};ParseConjunct: PROC RETURNS [exp: XTree] ~ {token: Token;exp _ ParseNegation[];DOtoken _ GetToken[];SELECT token.kind FROM$and, $xor => exp _ ET.ApplyBinOp[token.kind, exp, ParseNegation[]];ENDCASE => {Push[token]; EXIT};ENDLOOP;};ParseNegation: PROC RETURNS [XTree] ~ {IF PeekType[]=$not THEN {kind: ATOM _ GetToken[].kind;						--Get the $notRETURN[ET.ApplyUnOp[kind, ParseRelation[]]]}ELSE RETURN[ParseRelation[]];};ParseRelation: PROC RETURNS [XTree] ~ {relop: ATOM;e1, e2: XTree;IF PeekType[]=$LPar THEN {kind: ATOM _ GetToken[].kind;xTree: XTree _ ParseDisjunct[];IF Type[]#$RPar THEN Error["Expected Right Parenthesis"];RETURN[xTree];}ELSE {e1 _ ParseExp[];								--exp1relop _ ParseRelop[];						--relope2 _ ParseExp[];								--exp2RETURN[ET.ApplyBinOp[relop, e1, e2]];};};ParseRelop: PROC RETURNS [kind: ATOM] ~ {token: Token _ GetToken[];SELECT TRUE FROMtoken.kind=$not => {RETURN[InvertRelop[ParseRelop[]]]};Relop[token.kind] => {RETURN[token.kind]};ENDCASE => Error["Expected Relational Operator"];};ParseFactor: PROC RETURNS [XTree] ~ {token: Token _ GetToken[];SELECT token.kind FROM$Add => RETURN[ParseExponentiation[]];$Subtract => RETURN[ET.ApplyUnOp[$Negate, ParseExponentiation[]]];ENDCASE => {Push[token]; RETURN[ParseExponentiation[]]};};ParseExponentiation: PROC RETURNS [exp: XTree] ~ {token: Token;exp _ ParsePrimary[];DOtoken _ GetToken[];SELECT token.kind FROM$power => exp _ ET.ApplyFcn[KindToProc[token.kind], LIST[exp, ParsePrimary[]]];ENDCASE => {Push[token]; EXIT};ENDLOOP;};ParsePrimary: PROC RETURNS [exp: XTree] ~ {token: Token _ GetToken[];args: LIST OF XTree;SELECT token.kind FROM$Id1, $Id2, $Id3, $Id4, $Id5 => RETURN[ET.XTreeFromId[token.kind]];$Constant => RETURN[ET.XTreeFromConstant[RopeToReal[token.rope]]];$LPar => {exp _ ParseExp[];IF Type[]#$RPar THEN Error["Expected Right Parenthesis"];};$sin, $cos, $tan, $sqrt, $atan, $exp, $ln, $abs => {args _ ParseRecord[1];	--Parse a 1-valued domainRETURN[ET.ApplyFcn[KindToProc[token.kind], args]]};$min, $max => {args _ ParseRecord[2];	--Parse a 2-valued domain (built into the proc builder)RETURN[ET.ApplyBinOp[token.kind, args.first, args.rest.first]];};$atanxy, $log => {	--Parse a 2-valued domain (for which this module supplies a procedure)args _ ParseRecord[2];IF token.kind=$atanxy THEN args _ LIST[args.rest.first, args.first];		--Mumble, mumble, mumble ... This allows the user to type in his arguments in the form atan[x, y] , but the actual implementation pushes the y argument on the stack first, in order that the procedure called (which is RealFns.ArcTan) has y as the first argument.RETURN[ET.ApplyFcn[KindToProc[token.kind], args]];};$CProc => {nItems: INT;proc: PROC ANY RETURNS [REAL];[nItems, proc] _ ClientProcInfo[token.rope];args _ ParseRecord[nItems];RETURN[ET.ApplyFcn[proc, args]]};ENDCASE => Error["Illegal symbol"];};ParseRecord: PROC [nItems: INT] RETURNS [args: LIST OF XTree _ NIL] ~ {argsTail: LIST OF XTree _ NIL;					--Tail of args listIF nItems=0 THEN RETURN[NIL];IF Type[]#$LBracket THEN Error["Expected Left Bracket"];argsTail _ args _ CONS[ParseExp[], NIL];		--First argumentTHROUGH (1..nItems] DOIF Type[]#$Comma THEN Error["Expected Comma"];argsTail _ argsTail.rest _ CONS[ParseExp[], NIL];ENDLOOP;IF Type[]#$RBracket THEN Error["Expected Right Bracket"];};expression _ ParseExp[];IF Type[]#$EndOfStream THEN Error["Garbage on end of expression"];};FcnList: TYPE ~ LIST OF RECORD [kind: ATOM, proc: PROC ANY RETURNS ANY];fcnList: FcnList _ NIL;RegisterFcn: PROC [rope: ROPE, kind: ATOM, proc: PROC ANY RETURNS ANY] ~ {ETk.RegisterToken[rope, kind];fcnList _ CONS[[kind, proc], fcnList];};KindToProc: PROC [kind: ATOM] RETURNS [proc: PROC ANY RETURNS ANY] ~ {FOR fcns: FcnList _ fcnList, fcns.rest UNTIL fcns=NIL DOIF fcns.first.kind=kind THEN RETURN[fcns.first.proc];ENDLOOP;ERROR;};Init: PROC ~ {RegisterFcn["sin", $sin, RF.Sin];RegisterFcn["cos", $cos, RF.Cos];RegisterFcn["tan", $tan, RF.Tan];RegisterFcn["sqrt", $sqrt, RF.SqRt];RegisterFcn["log", $log, RF.Log];RegisterFcn["^", $power, RF.Power];RegisterFcn["atan", $atan, EvArcTan];RegisterFcn["exp", $exp, RF.Exp];RegisterFcn["ln", $ln, RF.Ln];RegisterFcn["atanxy", $atanxy, RF.ArcTan];RegisterFcn["abs", $abs, EvAbs];RegisterFcn["mod", $mod, EvMod];};EvMod: PROC [a, b: REAL] RETURNS [REAL] ~ {		--RETURN a mod bRETURN[a-b*Real.Fix[a/b]];};EvArcTan: PROC [a: REAL] RETURNS [REAL] ~ {RETURN[RF.ArcTan[a, 1.0]];};EvAbs: PROC [a: REAL] RETURNS [REAL] ~ {RETURN[IF a<0 THEN -a ELSE a];};Init[];}.   ؛  ExpressParserImpl.mesaImplementation of vanilla recursive descent parser for the Express packageCreated Tuesday, July 17, 1984 10:16 pm PDTLast edited by Eric Nickell, July 31, 1984 10:56:38 pm PDTConverts the token stream into an expression treeUtility procs under this sectionTheoretically, at least, the offending token should be on the stackFirst, see how many args the proc takesHere, we know the proc is of the form PROC [arg1, ..., argn] RETURNS [val], where val and argi are all 2 words.END of the Utility procsParsing procsMain routine for ParseExpressionThis section contains the procedures which implement operations not found elsewhereSTART code for ExpressParser ‌ت\  ک ڑœ™JڑœJ™JJڑœ(دk™+J™:J™ —ڑ‌	ک	Jک	JکJکJکJکJڑœکJکJکJکJڑœکJک —ڑœ‌œ‌ک Jڑ‌œKکRJڑ‌œکJڑœکJڑ‌œ‌œ‌œ‌œ
کPJک Jڑ‌œ‌œ‌œکJڑœ‌œکJڑœ‌œ‌œک—Jک Jڑœ‌œ‌œ‌œک,Jڑœ‌œ‌œ‌œک,Jک ڑ
دnœ‌œ‌œ>‌œ‌œک~J™1J™ ™ ڑ‍œ‌œ‌œکJ™CJڑ‌œ.ک3JڑœکJک —ڑ
‍
œ‌œ‌œ‌œ	‌œک7Jڑ‌œ‌œ
کڑ‌œکJڑ‌œ	‌œ‌œکLJڑ‌œ	‌œ‌œکC—Jک—ڑ‍œ‌œ‌œ‌œ
‌œ‌œ‌œ‌œ‌œ‌œکfڑ‌œ,‌œ‌œ‌کAڑ‌œ,‌œ‌œک;J™'Jڑ‌œ	کJک Jڑœ?ک?Jک JکJکJڑ‌œ‌œ‌œک?Jڑœدc&کEڑ‌œ
‌œ‌کJڑ‌œ ‌œ‌œکFJڑ‌ک—J™oJڑ‌œکJڑœک—Jڑ‌ک—Jڑ‌œکJک—ڑ‍œ‌œ‌œ‌œکJڑ‌œکJک—ڑ‍œ‌œ‌œ‌œک!JکJکJڑ‌œکJک—ڑ‍œ‌œ	ں4کGJکJک—ڑ‍œ‌œ‌œ‌œ)کQJک —Jڑ‍œ‌œ%ک/ڑ
‍œ‌œ‌œ‌œ‌œک.ڑ‌œ‌œ‌کJڑœ ‌œک%Jڑ‌œ‌œک—Jک—ڑ
‍œ‌œ‌œ‌œ‌œک1ڑ‌œ‌œ‌کJکJکJکJکJکJکJڑ‌œ	ک—Jک—J™—™ڑ‍œ‌œ‌œک"ڑ‌œ‌œکJکJڑœںکJڑœںک$Jڑ‌œ‌œںک3Jڑœںک!Jڑ‌œ‌œںک4Jڑœںک!Jڑ‌œ‌œک(Jک—ڑ‌œکJڑ‌œکJک—Jڑœک—ڑ‍œ‌œ‌œک'JکJکڑ‌کJکڑ‌œ‌کJڑœ‌œ-کHJڑ‌œ‌œک—Jڑ‌œک—Jک—ڑ‍œ‌œ‌œک+JکJکڑ‌کJکڑ‌œ‌کJڑœ‌œ-کKJڑœ‌œ"‌œکLJڑ‌œ‌œک—Jڑ‌œک—Jک—ڑ‍œ‌œ‌œک,JکJڑœکڑ‌کJکڑ‌œ‌کJڑœ‌œ.ک=Jڑ‌œ‌œک—Jڑ‌œک—Jک—ڑ‍œ‌œ‌œک,JکJڑœکڑ‌کJکڑ‌œ‌کJڑœ‌œ.کDJڑ‌œ‌œک—Jڑ‌œک—Jک—ڑ‍œ‌œ‌œک'ڑ‌œ‌œکJڑœ‌œںک1Jڑ‌œ‌œ"ک+Jڑœک—Jڑ‌œ‌œکJک—ڑ‍œ‌œ‌œک'Jڑœ‌œکJکڑ‌œ‌œکJڑœ‌œکJکJڑ‌œ‌œ%ک9Jڑ‌œکJڑœک—ڑ‌œکJڑœںکJڑœںک"JڑœںکJڑ‌œ‌œک%Jڑœک—Jک—ڑ‍
œ‌œ‌œ‌œک)Jکڑ‌œ‌œ‌کJڑœ‌œک7Jڑœ‌œک*Jڑ‌œ*ک1—Jک—ڑ‍œ‌œ‌œک%Jکڑ‌œ‌کJڑœ‌œک&Jڑœ‌œ‌œ,کBJڑ‌œ‌œک8—Jک—ڑ‍œ‌œ‌œک2JکJڑœکڑ‌کJکڑ‌œ‌کJڑœ‌œ"‌œکOJڑ‌œ‌œک—Jڑ‌œک—Jک—ڑ‍œ‌œ‌œک+JکJڑœ‌œ‌œکڑ‌œ‌کJڑœ ‌œ‌œکCJڑœ‌œ‌œ,کBک
JکJڑ‌œ‌œ%ک9Jک—ک4Jڑœںک0Jڑ‌œ‌œ(ک1Jک—ڑœکJڑœں7کNJڑ‌œ‌œ6ک?Jڑœک—ڑœںFکYJڑœکJڑ	‌œ‌œ‌œ ںVذcoں£کثJڑ‌œ‌œ)ک2Jک—کJڑœ‌œکJڑ	œ‌œ‌œ‌œ‌œکJڑœ,ک,JڑœکJڑ‌œ‌œکJک—Jڑ‌œک#—Jک—ڑ‍œ‌œ
‌œ‌œ‌œ‌œ	‌œکGJڑœ
‌œ‌œ	‌œںک6Jک Jڑ‌œ
‌œ‌œ‌œکJڑ‌œ‌œ ک8Jڑœ‌œ‌œںک:ڑ‌œ‌کJڑ‌œ‌œک.Jڑœ‌œ‌œک1Jڑ‌ک—Jڑ‌œ‌œ!ک9Jک——™ JکJڑ‌œ‌œ'کB—JکJک —Jڑœ	‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکHJڑœ‌œکڑ‍œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکJJکJڑœ
‌œک&JکJک —ڑ‍
œ‌œ‌œ‌œ‌œ‌œ‌œ‌œکFڑ‌œ$‌œ‌œ‌ک8Jڑ‌œ‌œ‌œک5Jڑ‌ک—Jڑ‌œکJکJک —ڑ‍œ‌œکJڑœ‌œک!Jڑœ‌œک!Jڑœ‌œک!Jڑœ‌œک$Jڑœ‌œک!Jڑœ‌œک#Jڑœ%ک%Jڑœ‌œک!Jڑœ‌œکJڑœ‌œ	ک*Jڑœ ک Jڑœ ک Jک—Jک default™Sڑ‍œ‌œ‌œ‌œ‌œںک=Jڑ‌œکJکJک —ڑ
‍œ‌œ‌œ‌œ‌œک+Jڑ‌œ‌œکJکJک —ڑ
‍œ‌œ‌œ‌œ‌œک(Jڑ‌œ‌œ‌œ‌œکJکJک ——J™JکJک— …—    ج  -â  