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
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] ~ {
Converts the token stream into an expression tree
Utility procs under this section
Error:
PROC [message:
ROPE] ~ {
Theoretically, at least, the offending token should be on the stack
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 {
First, see how many args the proc takes
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;
Here, we know the proc is of the form PROC [arg1, ..., argn] RETURNS [val], where val and argi are all 2 words.
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]
};
END of the Utility procs
Parsing procs
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"];
};
Main routine for ParseExpression
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];
};
This section contains the procedures which implement operations not found elsewhere
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];
};
START code for ExpressParser
Init[];
}.