[ivy]<Satterthwaite>Poplar>PLParseImpl.Mesa!5

PLParseImpl.Mesa
Copyright (c) 1981 by Xerox Corporation. All rights reserved.
lasted edited by Satterthwaite, April 18, 1986 5:06:41 pm PST
used to be parse.mesa
DIRECTORY
Ascii: TYPE USING [Control],
Disp: TYPE USING [Print],
IO: TYPE USING [char, int, Put, PutF, rope],
PL: TYPE USING [Eval, GetSpecialNodes, Insert, Lookup, LSTNode, LSTNodeRecord,
Node, NodeRecord, NodeType, OS, Preorder, rEQUAL, RErr, rFCN, rID, rPFUNC1,
rSTR, rUNARY, SErr, SN, Symbol, Z],
PString: TYPE USING [CopyStream, EmptyS, Item, MakeNUM, NewStream, Stream],
Rope: TYPE USING [Concat, FromRefText, ROPE];
PLParseImpl: CEDAR PROGRAM
IMPORTS Ascii, Disp, S: PString, P:PL, Rope, IO EXPORTS PL = {
OPEN PL;
N: ZONE = P.Z;
TokType: TYPE = {ZERO,LP,RP,LB,RB,COMMA,EOF,SEP,LC,RC,
COLON,HOLE,DIV,STR,ID,GTR,ASS,PROG,FCN,SEQOF,OPT,
DELETE,SEQOFC,MAPPLY, PLUS,MINUS,
GOBBLE,TILDE,PALT,COMB, SEQ, CATL, WILD, FAIL,ITER,SCREEN,EQUAL};
NodeType: TYPE = PL.NodeType;
LSTNode: TYPE = PL.LSTNode;
LSTNodeRecord: TYPE = PL.LSTNodeRecord;
Node: TYPE = PL.Node;
NodeRecord: TYPE = PL.NodeRecord;
ROPE: TYPE = Rope.ROPE;
Symbol: TYPE = PL.Symbol;
String: TYPE = ROPE;
progstr: PString.Stream;
currn: Node ← NIL;
tokenType: TokType ← ZERO;
tokenString: String ← NIL;
tokenID: Symbol ← NIL;
nchar: CHAR;
stcnt, linecnt, charcnt: INT;
Fail,MTSt: Node;
Nail: PL.LSTNode;
savinput: PString.Stream;
checking: BOOL ← FALSE; -- set by CheckRoutine, used by BinaryExp and FunctionBody
dist: prog EOF
prog: stmt { SEP prog } | stmt SEP
stmt: var ASS stmt | exp
ChoiceExp: ThenExp {PALT ThenExp}
ThenExp: BinaryExp {GTR BinaryExp}
BinaryExp: BinaryExp {(DIV | MAPPLY| GOBBLE| ITER | PLUS | MINUS | CATL | SEQ | EQUAL ) PrefixExp} | BinaryExp PrefixExp
PrefixExp: UNARY PrefixExp | PFUNC1 PrefixExp | MINUS PrefixExp | TILDE PrefixExp | SimpleExp {SEQOF | SEQOFC | OPT | DELETE}
SimpleExp: STR | ID | PFUNC | SCREEN | WILD | FAIL | HOLE | LB RB | LB prog RB | LC stmt RC | ID COLON {= PrefixExp ;}prog | LB prog RB COLON {= PrefixExp ;} prog
| LP stmt RP
Convention: peektok is the first token for each of the routines, e.g.
peektok = STR for the Base
CheckRoutine: PROC[prog: Node]
RETURNS [ans: Node] =
{
Ch: PROC[n:Node] RETURNS[BOOL] =
{
WITH n SELECT FROM f: rFCN =>
WITH f.parms SELECT FROM p: rEQUAL =>
{
[] ← P.Eval[n, NIL];
};
ENDCASE;
ENDCASE;
RETURN[TRUE];
};
Ch1: PROC[n:Node] RETURNS[BOOL] =
{
IF n.Type=EQUAL THEN
{
P.OS.Put[IO.rope["Missed Equality Check"], IO.char['\n]];
Disp.Print[n];
};
RETURN[TRUE];
};
WITH prog SELECT FROM
s: rSTR =>
{checking ← TRUE;
{p: Node ← Dist[s.str ! UNWIND => checking ← FALSE];
checking ← FALSE;
[] ← P.Eval[p, NIL];
P.Preorder[p, Ch];
P.Preorder[p, Ch1];
ans ← Nail}};
ENDCASE => P.RErr["input to check not string"];
};
FillRoutine: PROC[prog: Node]
RETURNS [ans: Node] =
{WITH prog SELECT FROM
s: rSTR =>
{ans ← Dist[s.str];
[] ← P.Eval[ans, NIL]};
ENDCASE => P.RErr["input to check not string"];
};
Dist: PUBLIC PROC [p: ROPE] RETURNS[Node] = {
this is the kickoff routine - call only once
p is the node to which has the string to be compiled
n: Node ← NIL;
progstr ← S.NewStream[p];
savinput ← S.CopyStream[progstr];
charcnt ← stcnt ← linecnt ← 1;
nchar ← ' ;
GetTok; -- set up peek vals
n ← Prog[];
IF tokenType ~= EOF THEN ErrorMsg["Parser expected EOF"];
P.Preorder[n,CheckPattern];
RETURN[n];
};
CheckPattern: PROC[n: Node] RETURNS[BOOL] = {
IF n.Type = PATTERN THEN RETURN[FALSE];
IF n.Type = SEQOF
OR n.Type = SEQOFC
OR n.Type = OPT
OR n.Type = DELETE
OR n.Type = HOLE THEN ErrorMsg["Pattern operator not surrounded by { }"];
RETURN[TRUE];
};
Prog: PROC RETURNS [res: Node] = {
res ← NIL;
res ← Stmt[];
IF tokenType = SEP THEN {
GetTok;
IF tokenType ~= EOF THEN res ← N.NEW[NodeRecord←[,PROG[res,Prog[]]]];
};
};
Stmt: PROC RETURNS[i: Node] = {
i ← ChoiceExp[];
IF tokenType = ASS THEN {
WITH i SELECT FROM
x: rID =>{t: Symbol = x.name;
GetTok;
i ← N.NEW[NodeRecord←[,ASS[t,Stmt[]]]];
}
ENDCASE => ErrorMsg["Missing ; or assignment to non-variable"];
};
RETURN[i];
};
this parses left-assoc instead of right assoc.
ChoiceExp: PROC RETURNS[Node] = {
i,j: Node ← NIL;
IF tokenType = PALT THEN i ← currn
ELSE i ← ThenExp[];
WHILE tokenType = PALT DO
GetTok;
j ← ThenExp[];
i ← N.NEW[NodeRecord←[,PALT[i,j]]]
ENDLOOP;
RETURN[i];
};
ThenExp: PROC RETURNS[Node] = {
i,j: Node ← NIL;
IF tokenType = GTR THEN i ← currn
ELSE i ← BinaryExp[];
WHILE tokenType = GTR DO
GetTok;
j ← BinaryExp[];
i ← N.NEW[NodeRecord←[,GTR[i,j]]]
ENDLOOP;
RETURN[i];
};
BinaryExp: PROC RETURNS[i: Node] = {
loop: BOOL ← TRUE;
p: TokType ← tokenType;
i ← IF p = DIV OR p = MAPPLY OR p = GOBBLE OR p = ITER OR p = PLUS OR p = CATL OR p = SEQ OR p = PLUS OR p = CATL OR p = SEQ THEN currn ELSE PrefixExp[];
WHILE loop DO
loop ← TRUE;
SELECT tokenType FROM
DIV => {
GetTok;
i ← N.NEW[NodeRecord←[,PAPPLY[i,PrefixExp[]]]];
};
MAPPLY => {
GetTok;
i ← N.NEW[NodeRecord←[,MAPPLY[i,PrefixExp[]]]];
};
GOBBLE => {
GetTok;
i ← N.NEW[NodeRecord←[,GOBBLE[i,PrefixExp[]]]];
};
ITER => {
GetTok;
i ← N.NEW[NodeRecord←[,ITER[i,PrefixExp[]]]];
};
PLUS => {
GetTok;
i ← N.NEW[NodeRecord←[,PLUS[i,PrefixExp[]]]];
};
MINUS => {
GetTok;
i ← N.NEW[NodeRecord←[,MINUS[i,PrefixExp[]]]];
};
CATL => {
GetTok;
i ← N.NEW[NodeRecord←[,CATL[i,PrefixExp[]]]];
};
SEQ => {
GetTok;
i ← N.NEW[NodeRecord←[,SEQ[i,PrefixExp[]]]];
};
EQUAL => {
GetTok;
IF checking THEN
i ← N.NEW[NodeRecord←[,EQUAL[i,PrefixExp[]]]]
ELSE [] ← PrefixExp[];
};
ENDCASE => {
check to see if this is a cat
the list below must be kept up to date.
It is those things in First[PreFixExp]
p ← tokenType;
IF p=ID OR p=STR OR p = COMB OR p = LB OR p = LC OR p = LP OR p = TILDE OR p = MINUS OR p = SCREEN OR p = HOLE OR p=WILD OR p = FAIL THEN
i ← N.NEW[NodeRecord←[,CAT[i,PrefixExp[]]]]
ELSE loop ← FALSE;
};
ENDLOOP;
RETURN[i];
};
PrefixExp: PROC RETURNS[i:Node] = {
SELECT tokenType FROM
ID =>
WITH tokenID SELECT FROM
s: rUNARY => {t: Symbol ← tokenID;
GetTok;
RETURN[N.NEW[NodeRecord ←[,COMB[t,PrefixExp[]]]]];
};
s: rPFUNC1 => {t: Symbol ← tokenID;
GetTok;
RETURN[N.NEW[NodeRecord ←[,COMB[t,PrefixExp[]]]]];
};
ENDCASE;
TILDE => {
GetTok;
RETURN[N.NEW[NodeRecord ←[,TILDE[PrefixExp[]]]]];
};
MINUS => {
GetTok;
i ← N.NEW[NodeRecord ←[,MINUS[P.SN[S.MakeNUM[0]],PrefixExp[]]]];
RETURN;
};
ENDCASE;
i ← SimpleExp[];
WHILE tokenType = SEQOF OR tokenType = SEQOFC OR tokenType = OPT OR tokenType = DELETE DO
IF tokenType = SEQOF THEN {
GetTok;
i ← N.NEW[NodeRecord ←[,SEQOF[i]]];
}
ELSE IF tokenType = SEQOFC THEN {
GetTok;
i ← N.NEW[NodeRecord ←[,SEQOFC[i]]];
}
ELSE IF tokenType = OPT THEN {
GetTok;
i ← N.NEW[NodeRecord ←[,OPT[i]]];
}
ELSE IF tokenType = DELETE THEN {
GetTok;
i ← N.NEW[NodeRecord ←[,DELETE[i]]];
};
ENDLOOP;
};
SimpleExp: PROC RETURNS[t: Node] = {
SELECT tokenType FROM
STR => {x:String=tokenString; GetTok; RETURN[P.SN[x]]; };
ID => {
t ← N.NEW[NodeRecord ← [,ID[tokenID]]];
GetTok;
IF tokenType=COLON THEN t ← FunctionBody[t];
RETURN;
};
SCREEN => { GetTok; RETURN[currn] };
HOLE => { GetTok; RETURN[N.NEW[NodeRecord ← [,HOLE[]]]]; };
WILD => { GetTok; RETURN[N.NEW[NodeRecord ← [,WILD[]]]]; };
FAIL => { GetTok; RETURN[Fail]; };
LB => {
GetTok;
IF tokenType = RB THEN { GetTok;RETURN[Nail]};
{pans: LSTNode ← N.NEW[LSTNodeRecord ← [,LST[Prog[],Nail]]];
t ← pans;
WHILE tokenType = COMMA DO
GetTok;
pans.listtail ← N.NEW[LSTNodeRecord ← [,LST[Prog[],Nail]]];
pans ← pans.listtail;
ENDLOOP;
IF tokenType ~= RB THEN ErrorMsg["Missing ']'"];
GetTok;
IF tokenType=COLON THEN t ← FunctionBody[t];
RETURN};
};
LP => { -- used solely for parenthesization
GetTok;
t ← Prog[];
IF tokenType ~= RP THEN ErrorMsg["Parser expected ')'"];
GetTok;
RETURN[t];
};
LC => {
GetTok;
t ← Prog[];
IF tokenType ~= RC THEN ErrorMsg["Parser expected '}'"];
GetTok;
RETURN[N.NEW[NodeRecord←[,PATTERN[t]]]];
};
ENDCASE;
ErrorMsg["Parser did not recognize Simple Expression"];
};
FunctionBody: PROC[bv: Node] RETURNS [b: Node] =
{
GetTok;
IF tokenType=EQUAL THEN
{
testVal: Node ← NIL;
b ←NIL;
GetTok;
testVal ← PrefixExp[];
IF tokenType#SEP THEN ErrorMsg["Missing ; after :="];
GetTok;
IF checking THEN
bv ← N.NEW[NodeRecord ← [,EQUAL[bv,testVal]]];
};
b ← N.NEW[NodeRecord ← [,FCN[bv, Prog[]]]];
};
wk: REF TEXT ← NEW[TEXT[100]];
GetTok: PROC= {
i: CARDINAL;
sym: Symbol;
got: BOOL ← FALSE;
c: CHAR;
loop: BOOL ← TRUE;
uc: BOOL;
WHILE loop DO
loop ← FALSE;
WHILE nchar = ' OR nchar = '\t OR nchar = '\n DO
[] ← GetNChar[]
ENDLOOP;
SELECT nchar FROM
0C => tokenType ← EOF;
'" => { st: Node ← NIL;
t: String ← "";
i ← 0;
DO
IF i = wk.maxLength THEN
{
wk.length ← i;
t ← t.Concat[Rope.FromRefText[wk]];
i ← 0;
};
wk[i] ← GetNChar[];
IF wk[i] = 0C THEN
ErrorMsg["String ran off end, probably omitted quote"];
IF wk[i] = '" THEN
{
wk.length ← i;
t ← t.Concat[Rope.FromRefText[wk]];
EXIT;
};
IF wk[i] = '^ THEN
wk[i] ← Usual[GetNChar[]];
i ← i + 1;
ENDLOOP;
tokenType ← STR; tokenString←t};
IN ['0..'9] => {
wk[0] ← nchar;
i ← 1;
WHILE i < wk.maxLength DO
wk[i] ← GetNChar[];
IF wk[i] = 0C THEN EXIT;
IF wk[i] NOT IN ['0..'9] THEN EXIT;
i ← i + 1;
ENDLOOP;
IF i >= wk.maxLength THEN ErrorMsg["Number too long for parser"];
wk.length ← i;
tokenType ← STR; tokenString ← Rope.FromRefText[wk];
got ← TRUE;
};
'' => { -- single quote, just like " except terminated diff.
i ← 0;
WHILE i < wk.maxLength AND (GetNChar[] IN ['A..'Z] OR nchar IN ['a..'z] OR nchar IN ['0..'9] OR nchar = '. OR nchar = '^) DO
wk[i] ← IF nchar = '^ THEN Usual[GetNChar[]] ELSE nchar;
i ← i + 1;
ENDLOOP;
IF i >= wk.maxLength THEN ErrorMsg["String too long for parser"];
wk.length ← i;
tokenType ← STR; tokenString ← Rope.FromRefText[wk];
got ← TRUE;
};
'( => tokenType ←LP;
') => tokenType ←RP;
'[ => tokenType ←LB;
'] => tokenType ←RB;
'{ => tokenType ←LC;
'} => tokenType ←RC;
': => tokenType ←COLON;
'~ => tokenType ←TILDE;
'% => tokenType ←ITER;
'@ => tokenType ←SCREEN;
'/ => {
[] ← GetNChar[];
IF nchar ~= '/ THEN {
tokenType ←DIV;
got ← TRUE;
}
ELSE {
[] ← GetNChar[];
IF nchar ~= '/ THEN {
tokenType ←MAPPLY;
got ← TRUE;
}
ELSE tokenType ←GOBBLE;
};
};
', => {
[] ← GetNChar[];
IF nchar = ', THEN tokenType ←CATL
ELSE IF nchar = '! THEN {
tokenType ←SEQOFC;
}
ELSE IF nchar ~= ', THEN {
tokenType ←COMMA;
got ← TRUE;
};
};
'| => tokenType ←PALT;
'. => {
[] ← GetNChar[];
IF nchar ~= '. THEN ErrorMsg["Unknown character '.'"]
ELSE {
[] ← GetNChar[];
IF nchar ~= '. THEN ErrorMsg["Unknown character '.'"]
ELSE tokenType ←HOLE;
};
};
'+ => tokenType ←PLUS;
'* => tokenType ←DELETE;
'> => tokenType ←GTR;
'# => tokenType ←WILD;
'; => {
stcnt ← stcnt + 1;
tokenType ←SEP;
};
'← => tokenType ←ASS;
'= => tokenType ← EQUAL;
'- => {
[] ← GetNChar[] ;
IF nchar = '- THEN {
[] ← GetNChar[];
IF nchar ~= '- THEN {
tokenType ←SEQ;
got ← TRUE;
}
ELSE {
DO
c ← GetNChar[];
IF c = 0C OR c = '\n THEN EXIT;
IF c ~= '- THEN LOOP;
c ← GetNChar[];
IF c = 0C OR c = '\n THEN EXIT;
IF c ~= '- THEN LOOP;
c ← GetNChar[];
IF c = '- OR c = 0C OR c = '\n THEN EXIT;
ENDLOOP;
loop ← TRUE;
got ← TRUE;
}
}
ELSE {
tokenType ←MINUS;
got ← TRUE;
};
};
'? => tokenType ←OPT;
'! => tokenType ←SEQOF;
IN ['a..'z], IN ['A..'Z] => {
i ← 0;
uc ← FALSE;
WHILE nchar IN ['a..'z] OR nchar IN ['A..'Z] OR nchar IN ['0..'9] DO
wk[i] ← nchar;
uc ← uc OR nchar IN['A..'Z];
i ← i + 1;
[] ← GetNChar[];
ENDLOOP;
wk.length ← i;
sym ← P.Lookup[Rope.FromRefText[wk]];
IF sym = NIL THEN {
IF ~uc AND i > 1 THEN ErrorMsg["Unknown primitive function name"];
tokenType ← ID;
tokenID ← P.Insert[Rope.FromRefText[wk],[,,VALUE[NIL]]];
}
ELSE {tokenType ← ID; tokenID ← sym};
got ← TRUE;
};
ENDCASE => ErrorMsg["Unknown character"];
IF ~got THEN [] ← GetNChar[];
ENDLOOP;
};
SetCurrentNode: PUBLIC PROC[n:Node] = {
currn ← n;
};
GetNChar: PROC RETURNS [CHAR] = {
IF nchar = '\n THEN savinput ← progstr;
[nchar, progstr] ← S.Item[progstr];
IF nchar = Ascii.Control['Z] THEN
WHILE nchar ~= '\n DO [nchar,progstr] ← S.Item[progstr] ENDLOOP;
charcnt ← IF nchar = '\n THEN 1 ELSE charcnt + 1;
IF nchar = '\n THEN linecnt ← linecnt + 1;
RETURN[nchar];
};
ErrorMsg: PROC[str: ROPE] = {
c: CHAR;
P.OS.PutF["Syntax error, Line: %g, Stmt: %g, Char: %g %g\nIn command ",
IO.int[linecnt],
IO.int[stcnt],
IO.int[charcnt],
IO.rope[str]];
WHILE ~S.EmptyS[savinput] DO
[c, savinput] ← S.Item[savinput];
IF c = '\n THEN EXIT;
P.OS.Put[IO.char[c]];
ENDLOOP;
P.OS.Put[IO.char['\n]];
P.SErr[""]
};
Usual: PROC[c: CHAR] RETURNS[CHAR] = {
j: CARDINAL;
SELECT c FROM
' => RETURN[' ];
'" => RETURN['"];
'^ => RETURN['^];
'' => RETURN[''];
IN ['0..'9] =>{
j ← (c - '0)*64;
j ← j + (GetNChar[] - '0) * 8;
j ← j + (GetNChar[] - '0);
RETURN[LOOPHOLE[j]];
};
ENDCASE => RETURN[IF c<100C THEN c ELSE c - 100B];
};
ParseSetup: PUBLIC PROC = {
SetCurrentNode[Nail];
[] ← P.Insert["check",[,,ZARY[CheckRoutine]]];
[] ← P.Insert["fill",[,,ZARY[FillRoutine]]];
[] ← P.Insert["fail",[,,VALUE[Fail]]]};
[Fail,MTSt,Nail] ← P.GetSpecialNodes[];
}.