DIRECTORY

JunoParseUnparse,
Atom USING [MakeAtom, PutProp, GetProp, MakeAtomFromChar],
IO USING [CR, LF, SP, NUL, FF, TAB],
Rope USING [ROPE, Cat, Fetch, Substr, FromChar, Length];


JunoParserImpl: CEDAR PROGRAM
  IMPORTS
    Rope, Atom
  EXPORTS
    JunoParseUnparse =

BEGIN OPEN JunoParseUnparse;

ROPE: TYPE = Rope.ROPE;

NewTable: PUBLIC PROC RETURNS [table: Table] =

BEGIN
  table _ NEW [TableRep _ 
     [maxAtomLength: 200,
      maxStringLength: 200,
      chType: ALL [op],
      twoCharOps: NIL,

      defaultAtomProps: NEW [Props _ 
         [identifier: TRUE, unparseType: zero]]
      ]];

  SetDefaultCharTypes[table]
END;

SetCharType: PUBLIC PROC[table: Table, from, to: CHAR, chType: CharType] =

BEGIN
   FOR c: CHAR IN [from..to] DO table.chType[c] _ chType ENDLOOP
END;

SetDefaultCharTypes: PROC [table: Table] =

BEGIN OPEN table;
   ops: Rope.ROPE = "+-*/|\\()[]{}<>=~@#$%&^_:;,.!?";
   FOR c: CHAR IN [0C .. 255C] DO chType[c] _ other ENDLOOP;
   FOR c: CHAR IN ['a .. 'z] DO chType[c] _ letter ENDLOOP;
   FOR c: CHAR IN ['A .. 'Z] DO chType[c] _ letter ENDLOOP;
   FOR c: CHAR IN ['0 .. '9] DO chType[c] _ digit ENDLOOP;
   FOR i: INT IN [0..ops.Length[]) DO chType[ops.Fetch[i]] _ op ENDLOOP; 
   chType['"] _ quote;
   chType[IO.CR] _ blank;
   chType[IO.SP] _ blank;
   chType[IO.LF] _ blank;
   chType[IO.FF] _ blank;
   chType[IO.NUL] _ blank;
   chType[IO.TAB] _ blank
END;

EnterTwoCharOp: PUBLIC PROC [table: Table, c1, c2: CHAR] =

BEGIN
  atom: ATOM = Atom.MakeAtom[Rope.Cat[Rope.FromChar[c1], Rope.FromChar[c2]]];
  table.twoCharOps _ CONS[[chars: [c1, c2],  atom: atom], table.twoCharOps]
END;

EnterAlias: PUBLIC PROC [table: Table, alias, standard: ATOM] =

BEGIN
  Atom.PutProp[atom: alias, prop: table, val: standard]
END;

PropRec: TYPE = RECORD [name: ATOM, props: Props];

EnterAtomProps: PUBLIC PROC [table: Table, atom: ATOM, props: Props] =

{Atom.PutProp[atom: atom, prop: table, val: NEW [Props _ props]]};

GetAtomProps: PUBLIC PROC [atom: ATOM, table: Table]
  RETURNS [name: ATOM, rp: REF Props] =

BEGIN
  DO
     ref: REF _ Atom.GetProp[atom: atom, prop: table];
     IF ref=NIL THEN RETURN [atom, table.defaultAtomProps]; -- no special props defined
     WITH ref SELECT FROM
       p: REF Props => {RETURN [atom, p]}; -- properties
       a: ATOM => {atom _ a}; -- alias
       ENDCASE => ERROR;
  ENDLOOP
END;

Exhausted: PUBLIC PROC [stream: Stream, table: Table] RETURNS [BOOL] =

{WHILE stream.pos < stream.len DO
    IF table.chType[stream.rope.Fetch[stream.pos]] # blank THEN RETURN[FALSE];
    stream.pos_stream.pos+1
  ENDLOOP;
 RETURN[TRUE]};

Lex: PUBLIC PROC [stream: Stream, table: Table]
  RETURNS [lex: Lexeme, error: ROPE, rp: REF Props] =

BEGIN OPEN table;

EndOfStream: PROC RETURNS [BOOL] = INLINE
  -- returns true if next char in lexer.stream is c

BEGIN
   RETURN [stream.pos >= stream.len]
END;

CurChar: PROC RETURNS [c: CHAR] = INLINE
  -- returns next char in lexer.stream

BEGIN
   RETURN [stream.rope.Fetch[stream.pos]]
END;

SeeChar: PROC [c: CHAR] RETURNS [BOOL] = INLINE
  -- returns true if next char in lexer.stream is c

BEGIN
   RETURN [NOT EndOfStream[] AND CurChar[] = c]
END;

SeeType: PROC [t: CharType] RETURNS [BOOL] = INLINE
  -- returns true if next char in lexer.stream is of type t

BEGIN
   RETURN [NOT EndOfStream[] AND chType[CurChar[]] = t]
END;

Skip: PROC = INLINE
  --  advances lexer.stream.

BEGIN
   stream.pos _ stream.pos+1
END;

first: INT _ stream.pos; -- position of first char of current lexeme in lexer.stream

NextID: PROC =

BEGIN
   atom: ATOM; 
   Skip[];
   WHILE SeeType[letter] OR SeeType[digit] DO
      IF stream.pos-first >= table.maxAtomLength THEN
         {error _ "identifier too long"; RETURN};
      Skip[]
     ENDLOOP;
   [lex, rp] _ GetAtomProps[Atom.MakeAtom
      [Rope.Substr[stream.rope, first, stream.pos-first]], table]
END;

NextOp: PROC =

BEGIN
    atom: ATOM;
    c1: CHAR _ CurChar[];  Skip[];
    -- Check if it is a two-character op
    IF SeeType[op] THEN
       {c2: CHAR = CurChar[];
        FOR ops: LIST OF TwoCharOp _ table.twoCharOps, ops.rest UNTIL ops = NIL DO
           IF ops.first.chars = [c1, c2] THEN
              {atom _ ops.first.atom; Skip[]; EXIT}
          ENDLOOP}
    ELSE
       {-- Nope - single char op
        atom _ Atom.MakeAtomFromChar[c1]};
    [lex, rp] _ GetAtomProps[atom, table] -- props should be non-NIL if table is OK  
END;

NextNumber: PROC =

BEGIN
   d: INT;
   n: INT _ CurChar[] - '0; Skip[];
   WHILE SeeType[digit] DO
      d _ CurChar[] - '0;
      IF n > (LAST[INT] - d)/10 THEN
         {error _ "number too big"; RETURN};
      n _ n * 10 + d;
      Skip[] 
     ENDLOOP;
   IF SeeChar['.] THEN -- get decimal part
      {x: REAL _ n;
       y: REAL _ 0.1;
       Skip[];
       WHILE SeeType[digit] DO
          x _ x + y * (CurChar[] - '0);
          y _ y/10; 
          Skip[] 
         ENDLOOP;
       lex _ NEW[REAL _ x]}
   ELSE
      {lex _ NEW[INT _ n]}
END;

NextString: PROC =

BEGIN
   delim: CHAR _ CurChar[] ;  Skip[];
   WHILE  NOT EndOfStream[] AND CurChar[] # delim DO
      IF CurChar[] = IO.CR OR CurChar[] = IO.LF
         OR SeeType[invalid] THEN
         {error _ "invalid character in string"; RETURN};
      IF stream.pos-first >= table.maxStringLength THEN
         {error _ "string too long"; RETURN};
      Skip[] 
     ENDLOOP;
   IF NOT SeeChar[delim] THEN
      {error _ "runaway string"; RETURN};
   lex _ Rope.Substr[stream.rope, first+1, stream.pos-first-1];
   Skip[]
END;

error _ NIL; rp _ NIL; lex _ NIL;
SELECT table.chType[CurChar[]] FROM
     letter => NextID[];
     digit => NextNumber[];
     op => NextOp[];
     quote => NextString[];
   ENDCASE => {error _ "invalid character"};
IF error # NIL THEN -- backup stream to beginning of parsed string
   {stream.pos _ first; lex _ NIL; rp _ NIL}

END;

 weakOp: REF Props _  NEW[Props _ [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];

Parse: PUBLIC PROC [stream: Stream, table: Table]
  RETURNS [expr: Se, error: ROPE, openCount: INTEGER] =

BEGIN

e: LIST OF REF ANY;

savepos: INT;

lex: Lexeme; 
rp: REF Props; 

qm: BOOL _ TRUE;

IsMatchfixOrSubfixOp: PROC [x: Lexeme] RETURNS [BOOL] = INLINE

{WITH x SELECT FROM
    atom: ATOM =>
       {rpx: REF Props = GetAtomProps[atom].rp;
        RETURN [rpx.matchfix OR rpx.subfix]};
    ENDCASE => RETURN[FALSE]};
 
Beats: PROC [x: Lexeme, rp: REF Props] RETURNS [BOOL] = INLINE

{WITH x SELECT FROM
    atom: ATOM =>
       {rpx: REF Props = GetAtomProps[atom].rpx;
        RETURN [rpx.bindingPower > rp.bindingPower]};
    ENDCASE => RETURN[FALSE]};
 
Retract: PROC = INLINE

{t: LIST OF REF ANY _ e.rest; e.rest _ NIL; e _ t};

e _ s3;
openCount _ 0; 
e.first _ NIL;
       
WHILE NOT Exhausted [stream, table] DO
   savepos _ stream.pos;
   [lex, error, rp] _ Lex[stream, table];
   IF error # NIL THEN EXIT;
   SELECT TRUE FROM
   
      qm AND rp = NIL
      => {e.first _ lex; qm _ FALSE};
      
      qm AND rp # NIL AND (rp.prefix OR rp.matchfix)
      => {e.first _ CONS[lex, CONS[NIL, e]];  e _ NARROW[Cdar[e]]};
      
      ~ qm AND rp # NIL AND (rp.infix OR rp.subfix)
      => {WHILE Beats[Caadr[e], rp] AND ~ IsMatchfixOrSubfixOp[Caadr[e]]
           DO Retract[] ENDLOOP;
           e.first _ CONS[lex, CONS[e.first, CONS[NIL, e]]]; e _ NARROW[Cddar[e]];
           qm _ TRUE};
       
       ~qm AND rp # NIL AND rp.postfix
       => {WHILE Beats[Caadr[e], rp] DO Retract[] ENDLOOP;
            e.first _ CONS[lex, CONS[e.first, NIL]]};
        
        ~qm AND rp # NIL AND rp.closefix
        => {WHILE ~ IsMatchfixOrSubfixOp[Caadr[e]] DO Retract[] ENDLOOP;
             IF Matches[Caadr[e], rp]  
                THEN Retract[]
                ELSE {error _ "Parse Error"; EXIT}}
     
     ENDCASE => EXIT
   ENDLOOP;

WHILE Caadr[e] # weakOp DO
   IF IsMatchfixOrSubfixOp[Caadr[e]] THEN openCount _ openCount + 1;
   Retract[];
 ENDLOOP;
IF error = NIL AND (qm OR openCount # 0)  THEN {error _ "Parse error "};
expr _ s3.first

END;

Car: PUBLIC PROC [r: Se] RETURNS [Se] = {RETURN[NARROW[r, LIST OF REF ANY].first]};

Cdr: PUBLIC PROC [r: Se] RETURNS [Se] = {RETURN[NARROW[r, LIST OF REF ANY].rest]};

Cadr: PUBLIC PROC [r: Se] RETURNS [Se] = {RETURN[Car[Cdr[r]]]};

Caddr: PUBLIC PROC [r: Se] RETURNS [Se] = {RETURN[Car[Cdr[Cdr[r]]]]};

Cddr: PUBLIC PROC [r: Se] RETURNS [Se] = {RETURN[Cdr[Cdr[r]]]};

Caadr: PUBLIC PROC [r: Se] RETURNS [Se] = {RETURN[Car[Car[Cdr[r]]]]};

Cdar: PUBLIC PROC [r: Se] RETURNS [Se] = {RETURN[Cdr[Car[r]]]};

Cddar: PUBLIC PROC [r: Se] RETURNS [Se] = {RETURN[Cdr[Cdr[Car[r]]]]};
 
Or: PUBLIC PROC
   [v1, v2, v3, v4, v5: VerdictAndCulprit _ [ofCourseNot]] RETURNS [r: VerdictAndCulprit] =

  {r _ [ofCourseNot];
   IF v1.verdict = yes THEN RETURN [[yes]];
   IF v1.verdict = no THEN r _ v1;
   IF v2.verdict = yes THEN RETURN [[yes]];
   IF v2.verdict = no THEN r _ v2;
   IF v3.verdict = yes THEN RETURN [[yes]];
   IF v3.verdict = no THEN r _ v3;
   IF v4.verdict = yes THEN RETURN [[yes]];
   IF v4.verdict = no THEN r _ v5;
   IF v5.verdict = yes THEN RETURN [[yes]];
   IF v5.verdict = no THEN r _ v5};

False: SyntacticPredicate = {RETURN [[ofCourseNot]]};

HasForm: PUBLIC PROC [f: Se, op: REF, Arg1: SyntacticPredicate, Arg2: SyntacticPredicate _ NIL]  
  RETURNS [VerdictAndCulprit] =

  {WITH Car[f] SELECT FROM
    g: LIST OF REF ANY =>
      {IF NOT Is[g, op] THEN RETURN [[OfCourseNot, g]];
       IF (Arg2 = NIL) # (Cddr[g] = NIL) THEN RETURN[[ofCourseNot, f]];
       {v: VerdictAndCulprit _ Arg1[Cdr[g]];
        IF v.verdict # yes THEN RETURN [[no, v.culprit]];
        IF Cddr[g] = NIL THEN RETURN [[no, NIL]];
        v _ Arg2[Cddr[g]];
        IF v.verdict # yes THEN RETURN [[no, aw.culprit]];
        RETURN [[yes, NIL]]}}
     ENDCASE => RETURN [[ofCourseNot, f]]};

Is: PUBLIC PROC [f: Se, op: REF] RETURNS [r: VerdictAndCulprit] =

  {WITH Car[f] SELECT FROM
    atom: ATOM =>
      WITH op SELECT FROM
         lst: LIST OF REF ANY => 
            {FOR p: LIST OF REF ANY _ lst, p.rest WHILE p # NIL DO 
                IF p.first = atom THEN RETURN [[yes, NIL]]
               ENDLOOP;
              RETURN [[no, f]]};
         atop =>
            {IF atop = atom THEN RETURN [[yes, NIL]] ELSE RETURN [[no, f]]};
         ENDCASE => ERROR;
    ENDCASE => RETURN [[ofCourseNot, f]]}

END.
ì
JunoParserImpl.mesa (was LexerImpl + ParseTableImpl + ParserImpl)

Copied from ParserImpl.mesa, last Edited by: GNelson, January 10, 1983 5:53 pm
Merged with Parser.mesa, last Edited by: GNelson, January 10, 1983 5:50 pm
Merged with ParseTableImpl.mesa, last Edited by GNelson, March 1, 1983 6:11 pm
Merged with ParseTable.mesa, last Edited by: GNelson, August 24, 1983 10:30 pm
Merged with LexerImpl.mesa, coded by GNelson (?), December 7, 1982 3:26 pm
Merged with Lexer.mesa, coded by by GNelson (?), September 9, 1982 4:13 pm

Last Edited by: Stolfi, June 15, 1984 8:07:29 am PDT

- - - - - LEXER/PARSER/UNPARSER TABLES

- - - - - LEXING

- - - - - PARSER

Unthread right branch of tree:

- - - - CAR, CDR, ETC

- - - - - SYNTAX CHECKER

�Ê<˜š
œB™B™Jš
œN™NJš
œJ™JJš
œN™NJš
œN™NJš
œJ™JJš
œJ™J—Jš
œ5™5šœ
Ïk	˜
Jšœx�œ�œ)˜¬
——JšÏbœ�
œ�œ�œ˜YJš�œ
�œ˜Jš�œ�œ�œ
˜š
œ'™'š	œ
Ïnœ�œ
�œ
�œ˜/Jšœ
�œ�œR�œ�œ�œ!�œ>�œ
˜Š—š	œ
Ÿœ�œ
�œ�œ˜KJšœ
�œ�œ�œ
�œ�œ�œ
�œ
˜L—šœ
Ÿœ�œ˜+JšWœ
�œ
�œ�œžœ
žœ�œ�œ
�œ�œ�œ�œ�œ
�œ�œ�œ�œ�œ
�œ�œ�œ�œ�œ
�œ�œ�œ�œ�œ
�œ�œ�œ$�œ
�œ�œ
�œ�œ
�œ�œ
�œ�œ
�œ�œ
�œ
�œ
˜»—š	œ
Ÿœ�œ
�œ�œ˜;Jš	œ
�œ	�œW�œ3�œ
˜¥
—š	œ
Ÿ
œ�œ
�œ!�œ˜@Jšœ
�œ9�œ
˜C—Jšœ
�œ�œ�œ˜3š	œ
Ÿœ�œ
�œ�œ˜GJšœ-�œ˜C—šœ
Ÿœ�œ
�œ�œ�œ�œ�œ	˜]Jš)œ
�œ�œ�œ/�œ�œ
�œ
�œ!Ïcœ�œ�œ
�œ�œ�œ
 œ
�œ 	œ�œ�œ�œ
�œ
˜¼——š
œ™š	œ
Ÿ	œ�œ �œ�œ˜GJšœ�œ�œ�œ5�œ
�œ
�œ!�œ�œ
�œ˜¨
—šœ
Ÿœ�œ
�œ"�œ �œ	˜fšœ
�œ
�œ˜šœ
Ÿœ�œ
�œ�œ�œ 1˜^Jšœ
�œ�œ�œ
˜0—šœ
Ÿœ�œ
�œ�œ�œ $˜PJšœ
�œ�œ!�œ
˜5—šœ
Ÿœ�œ�œ�œ�œ�œ 1˜dJšœ
�œ�œ�œ�œ�œ
˜;—šœ
Ÿœ�œ�œ�œ�œ 9˜pJšœ
�œ�œ�œ�œ�œ
˜C—šœ
Ÿœ�œ�œ
 ˜1Jšœ
�œ�œ
˜(—Jšœ�œ ;˜Ušœ
Ÿœ�œ˜Jšœ
�œ
�œ�œ�œ�œ�œ)�œ*�œ�œn�œ
˜Ã—šœ
Ÿœ�œ˜Jš*œ
�œ�œ
�œ %œ�œ
�œ
�œ�œ�œ
�œ(�œ�œ
�œ�œ�œ/�œ�œ�œ	 œU ,�œ
˜�—šœ
Ÿ
œ�œ˜Jš3œ
�œ�œ�œ�œ�œ!�œ�œ
�œ
�œ%�œ,�œ�œ
�œ
 œ
�œ�œ�œ�œY�œ�œ
�œ
�œ�œ
�œ�œ
˜–—šœ
Ÿ
œ�œ˜Jš1œ
�œ�œ�œ�œ�œ�œ�œ
�œ
�œ
�œ
�œ
�œ
�œ�œ2�œ	�œ+�œ&�œ�œ�œ
�œ�œ"�œM�œ
˜†—Jšœ	�œ�œ�œ�œ�œj�œ#�œ	�œ
�œ
 /œ�œ�œ
˜É—Jšœ
�œ
˜——š
œ™Jšœ
�œ
�œ�œ˜GJš%œ	�œ
�œ
�œ
�œ�œ	�œ�œ
�œ
�œ
�œ�œ�œ�œ
�œ
�œ
�œ�œ
�œ˜wš
œ
Ÿœ�œ
�œ"�œ�œ
�œ˜jšœ
�˜Jš	œ�œ
�œ
�œ
�œ
˜Jšœ
�œ
˜Jšœ�œ˜Jšœ�œ�œ
˜š
œ
Ÿœ�œ
�œ�œ�˜?Jšœ�œ�œ
�œ�œ�œ(�œ�œ�œ�œ
�œ˜£
—šœŸœ�œ�œ�œ�œ�˜@Jšœ�œ�œ
�œ�œ�œ)�œ,�œ�œ
�œ˜¬
—šœŸœ�œ�˜Jšœ�œ
�œ
�œ
�œ�œ	˜4—Jšœ#�œ
�œ
�œ�œG�œ	�œ
�œ
�œ�œ
�œ
�˜Ê
Jšœ
�œ�œ�œ˜?Jšœ�œ�œ
�œ�œ"�œ�œ
�œ�œ˜Jšœ�œ�œ
�œ�œ�œ�œ-�œ�œ�œ�œ
�œ
�œ�œ�œ˜ŽJšœ�œ�œ
�œ�œ�œ�œ�œ�œ
�œ˜Ÿ
Jšœ�œ�œ
�œ�œ"�œ�œ�œ)�œ�œ�œ˜õ
Jšœ�œ�œ�œ
˜&Jš
 ™Jšœ
�œ�œ�œ �œ+�œ�œ	�œ
�œ�œ�œ*˜Ñ
—Jšœ
�œ
˜——š
œ™Jšœ
Ÿœ�œ
�œ	�œ	�œ
�œ�œ
�œ
�œ
�œ
˜TJšœ
Ÿœ�œ
�œ	�œ	�œ
�œ�œ
�œ
�œ
�œ	˜SJšœ
Ÿœ�œ
�œ	�œ	�œ˜@Jšœ
Ÿœ�œ
�œ	�œ	�œ˜FJšœ
Ÿœ�œ
�œ	�œ	�œ˜@Jš	œ
Ÿœ�œ	�œ	�œ˜FJš	œ
Ÿœ�œ	�œ	�œ˜@Jš	œ
Ÿœ�œ	�œ	�œ˜F—š
œ™š	œŸœ�œ
�œ<�œ˜mJš3œ�œ�œ
�œ
�œ�œ�œ�œ
�œ
�œ�œ�œ�œ
�œ
�œ�œ�œ�œ
�œ
�œ�œ�œ�œ
�œ
�œ�œ	˜¢—Jšœ
žœ�œ˜6š
œ
Ÿœ�œ
�œ�œ7�œ�œ˜‚
Jš?œ�œ�œ
�œ�œ
�œ
�œ
�œ�œ
�œ�œ
�œ�œ	�œ�œ�œ
�œI�œ�œ
�œ�œ�œ
�œ
�œ�œ'�œ�œ
�œ�œ�œ
�œ�œ˜î—šœ
Ÿœ�œ
�œ
�œ�œ˜BJšGœ�œ�œ
�œ�œ
�œ�œ
�œ�œ
�œ
�œ
�œ�œ�œ
�œ
�œ
�œ�œ�œ
�œ�œ�œ
�œ�œ�œ�œ+�œ
�œ
�œ�œ�œ
�œ�œ�œ�œ�œ˜Ä——Jš�œ
˜J™—…—(º7â