-- 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. %JJJ 1