-- 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.