-- October 18, 1982 10:05 pm
-- ParserImpl.mesa
-- Last Edited by: Gnelson, January 10, 1983 5:53 pm
DIRECTORY List, Atom, IO, Parser, RefText, Rope, Lexer, ParseTable;
ParserImpl: MONITOR
IMPORTS Rope, List, ParseTable, Lexer
EXPORTS Parser =
BEGIN OPEN Parser, PT: ParseTable;
ROPE: TYPE = Rope.ROPE;
NewHandle: PUBLIC PROC RETURNS [h: Handle] =
{h ← NEW[HandleRec ← [error: NIL, eof: FALSE, result: NIL, openCount: 0, in: NIL, table: NIL]]};
Parse: PUBLIC ENTRY PROC [h: Handle] =
{h.error ← NIL;
h.eof ← FALSE;
h.openCount ← 0;
qm ← TRUE;
e ← s3;
e.first ← NIL;
ParseLoop[h];
IF qm OR h.in.error # NIL OR h.openCount # 0
THEN h.error ← Rope.Cat["Parse error ", h.in.error];
h.result ← s3.first;
h.eof ← h.in.eof};
e: LIST OF REF ANY;
a: PT.Properties;
qm: BOOL;
defaultProps: PT.Properties ← NEW[PT.PRec ← [name: NIL, identifier: TRUE]];
Next: PROC[h: Handle] =
{h.in.Lex[];
IF ISTYPE[h.in.a, ATOM]
THEN a ← h.table.Search[h.in.a, NIL]
ELSE a ← NIL};
ParseLoop: PROC [h: Handle] = --! should be testing for lexical error
{IF ISTYPE[h.in.a, ATOM]
THEN a ← h.table.Search[h.in.a, NIL]
ELSE a ← NIL;
DO SELECT TRUE FROM
~ h.in.eof AND h.in.error = NIL AND qm AND a = NIL
=> {e.first ← h.in.a; qm ← FALSE; Next[h]};
~ h.in.eof AND h.in.error = NIL AND qm AND a # NIL
AND (a.prefix OR a.matchfix)
=> {e.first ← CONS[a, CONS[NIL, e]];
e ← Cdar[e];
Next[h]};
~ h.in.eof AND h.in.error = NIL AND ~ qm AND a # NIL
AND (a.infix OR a.subfix)
=> {WHILE Beats[Caadr[e], a] AND ~ IsMatchfixOrSubfixOp[Caadr[e]]
DO Retract[] ENDLOOP;
e.first ← CONS[a, CONS[e.first, CONS[NIL, e]]];
e ← Cddar[e];
qm ← TRUE;
Next[h]};
~ h.in.eof AND h.in.error = NIL AND ~qm AND a # NIL AND a.postfix
=> {WHILE Beats[Caadr[e], a] DO Retract[] ENDLOOP;
e.first ← CONS[a, CONS[e.first, NIL]];
Next[h]};
~ h.in.eof AND h.in.error = NIL AND ~qm AND a # NIL AND a.closefix
=> {WHILE ~ IsMatchfixOrSubfixOp[Caadr[e]]
DO Retract[] ENDLOOP;
IF Matches[Caadr[e], a]
THEN Retract[]
ELSE {h.error ← "Parse Error"; EXIT};
Next[h]}
ENDCASE => EXIT ENDLOOP;
-- unthread right branch of tree:
WHILE Caadr[e] # weakOp
DO IF IsMatchfixOrSubfixOp[Caadr[e]] THEN h.openCount ← h.openCount + 1;
Retract[];
ENDLOOP};
Retract: PROC = INLINE
{t: LIST OF REF ANY ← e.rest;
e.rest ← NIL;
e ← t;
NARROW[e.first, LIST OF REF ANY].first
← NARROW[NARROW[e.first, LIST OF REF ANY].first, PT.Properties].name};
Beats: PROC [p, q: REF ANY] RETURNS [BOOL] = INLINE
{RETURN [NARROW[p, PT.Properties].bindingPower
> NARROW[q, PT.Properties].bindingPower]};
IsMatchfixOrSubfixOp: PROC [p: REF ANY] RETURNS [BOOL] = INLINE
{RETURN [NARROW[p, PT.Properties].matchfix OR
NARROW[p, PT.Properties].subfix]};
Matches: PROC [p, q: REF ANY] RETURNS [BOOL] = INLINE
{RETURN [NARROW[p, PT.Properties].closer = q]};
Caar: PROC [l: LIST OF REF ANY] RETURNS [REF ANY] =
{ RETURN[ List.Car[ NARROW[List.Car[ l ]] ] ] };
Cdar: PROC [l: LIST OF REF ANY] RETURNS [LIST OF REF ANY] =
{ RETURN [ List.Cdr[ NARROW[List.Car[ l ] ] ] ] };
Caadr: PROC [l: LIST OF REF ANY] RETURNS [REF ANY] =
{ RETURN[ List.Car[ NARROW[List.Car[ List.Cdr[ l ] ] ] ] ] };
Cadar: PROC [l: LIST OF REF ANY] RETURNS [REF ANY] =
{ RETURN[ List.Car[ List.Cdr[ NARROW[List.Car[ l ]] ] ] ] };
Caddar: PROC [l: LIST OF REF ANY] RETURNS [REF ANY] =
{ RETURN[ List.Car[ List.Cdr[ List.Cdr[ NARROW[List.Car[ l ]] ] ] ] ] };
Cadddar: PROC [l: LIST OF REF ANY] RETURNS [REF ANY] =
{ RETURN[ List.Car[ List.Cdr[ List.Cdr[ List.Cdr[ NARROW[List.Car[ l ]] ] ] ] ] ] };
Cadddr: PROC [l: LIST OF REF ANY] RETURNS [REF ANY] =
{ RETURN[ List.Car[ List.Cdr[ List.Cdr[ List.Cdr[ l ] ] ] ] ] };
Caddddar: PROC [l: LIST OF REF ANY] RETURNS [REF ANY] =
{ RETURN[ List.Car[ List.Cdr[ List.Cdr[ List.Cdr[ List.Cdr[ NARROW[List.Car[ l ] ] ] ] ] ] ] ] };
Cddar: PROC [l: LIST OF REF ANY] RETURNS [LIST OF REF ANY] =
{ RETURN[ List.Cdr[ List.Cdr[ NARROW[List.Car[ l ] ] ] ] ] };
weakOp: PT.Properties ←
NEW[PT.PRec ← [name: NIL, matchfix: TRUE, bindingPower: -1]];
s2: LIST OF REF ANY ← CONS[weakOp, NIL];
s1: LIST OF REF ANY ← CONS[s2, NIL];
s3: LIST OF REF ANY ← CONS[NIL, s1];
END.