DIRECTORY Rope, Lexer, Parser, OldUnparser,  OldParseWindow,
               OldJunoParserEtc, IO, ViewerTools, ViewerClasses, Atom
               ;

OldJunoParserEtcImpl: PROGRAM
  IMPORTS ViewerTools, OldParseWindow, Atom
  EXPORTS OldJunoParserEtc
= BEGIN OPEN OldJunoParserEtc, Pw: OldParseWindow;

junoA: PUBLIC Pw.Handle;

Algebra: PUBLIC PROC[fileName:Rope.ROPE] =

BEGIN
    junoA _ Pw.NewHandle[ViewerTools.MakeNewTextViewer[
     [file: fileName, name: fileName, iconic: FALSE, column: right]]];
    junoA.WellFormed _ Definition;
    -- WARNING a closefix operator must be added before the corresponding
    -- matchfix or subfix operator. (See def. of Pw.AddOp.)
    Pw.AddOp[junoA, "fi", NIL, 0, closefix, NIL];
    Pw.AddOp[junoA, "od", NIL, 0, closefix, NIL];
    Pw.AddOp[junoA, ")", NIL, 0, closefix, NIL];

    Pw.AddOp[junoA, "->", "then", 2, infix, NIL, 2];
    Pw.AddOp[junoA, ":=", "gets", 4, infix, NIL, 2];
    Pw.AddOp[junoA, "(", NIL, 5, subfixMatchfix, ")", 6];
    Pw.AddOp[junoA, ",", NIL, 5, infix, NIL, 7];
    Pw.AddOp[junoA, "hor", NIL, 7, prefix, NIL, 5]; -- binding power was 5 [JS]
    Pw.AddOp[junoA, "ver", NIL, 7, prefix, NIL, 5]; -- binding power was 5 [JS]
    Pw.AddOp[junoA, "cong", NIL, 7, infix, NIL, 2]; -- binding power was 5 [JS]
    Pw.AddOp[junoA, "para", NIL, 7, infix, NIL, 2]; -- binding power was 5 [JS]
    Pw.AddOp[junoA, "perp", NIL, 7, infix, NIL, 2]; -- new [JS]
    Pw.AddOp[junoA, "=", NIL, 7, infix, NIL, 2]; -- new [JS]
    Pw.AddOp[junoA, "draw", NIL, 4, prefix, NIL, 5];
    Pw.AddOp[junoA, "stroke", NIL, 4, prefix, NIL, 5];
    Pw.AddOp[junoA, "fill", NIL, 4, prefix, NIL, 5];
    Pw.AddOp[junoA, "paint", NIL, 3, infix, NIL, 8];
    Pw.AddOp[junoA, "ends", NIL, 3, infix, NIL, 8];
    Pw.AddOp[junoA, "width", NIL, 3, infix, NIL, 8];
    Pw.AddOp[junoA, "|", "st", 3, infix, NIL, 2];
    Pw.AddOp[junoA, ";", NIL, 3, infix, NIL, 7];
    Pw.AddOp[junoA, ":", NIL, 2, infix, NIL, 7];
    Pw.AddOp[junoA, "and", NIL, 4, infix, NIL, 2];
    Pw.AddOp[junoA, "if", NIL, 0, matchfix, "fi", 3];
    Pw.AddOp[junoA, "do", NIL, 0, matchfix, "od", 3];

    Pw.AddOp[junoA, "==", NIL, 6, infix, NIL, 2];
    Pw.AddOp[junoA, "rel", NIL, 6, infix, NIL, 2];
    Pw.AddOp[junoA, "-", NIL, 6, prefix, NIL, 5];
END;

Parse: PUBLIC PROC = {Pw.ParseViewer[junoA]};

Se: TYPE = REF ANY;  -- Se = "symbolic expression"

Sp: TYPE = Pw.SyntacticPredicate;

leftPren: ATOM = Atom.MakeAtom["("];
colon: ATOM = Atom.MakeAtom[":"];
semicolon: ATOM = Atom.MakeAtom[";"];
comma: ATOM = Atom.MakeAtom[","];
assign: ATOM = Atom.MakeAtom[":="];
approx: ATOM = Atom.MakeAtom["=="];
minus: ATOM = Atom.MakeAtom["-"];
rightarrow: ATOM = Atom.MakeAtom["->"];
suchthat: ATOM = Atom.MakeAtom["|"];
equals: ATOM = Atom.MakeAtom["="]; -- new [JS]

Definition: Sp = {RETURN [Pw.HasForm[f, colon, Application, Command]]};

Application: Sp = {RETURN [Pw.HasForm[f, leftPren, Var, VarList]]};

VarList: Sp = {RETURN [Pw.Or[Var[f], Pw.HasForm[f, comma, Var, VarList]]]};

Var: Sp = {IF ISTYPE[NARROW[Car[NARROW[f]], REF ANY], ATOM]
             THEN RETURN [[Yes, NIL]]
             ELSE RETURN [[OfCourseNot, f]]};

Command: Sp = {RETURN [
  Pw.Or[AtomicCommand[f],
  Pw.Or[Alternation[f],
  Pw.Or[Iteration[f],
  Pw.Or[PushState[f],
  Composition[f]]]]]]};

AtomicCommand: Sp = {RETURN [Pw.Or[Draw[f], Pw.Or[Print[f], Pw.Or[Call[f], Assignment[f]]]]]};

Draw: Sp = {RETURN [Pw.Or[Pw.HasForm[f, $stroke, DrawList, NIL],
					        Pw.Or[Pw.HasForm[f, $fill, DrawList, NIL],
					                Pw.HasForm[f, $draw, DrawList, NIL]]]]};
					                
DrawList: Sp = {RETURN [Pw.Or[DrawListElem[f], Pw.HasForm[f, comma, DrawListElem, DrawList]]]};

DrawListElem: Sp = {RETURN [Pw.HasForm[f, leftPren, DLE2, NIL]]};

DLE2: Sp = {RETURN [Pw.Or[TwoVars[f], Pw.HasForm[f, comma, Var, ThreeVars]]]};

ThreeVars: Sp = {RETURN [Pw.HasForm[f, comma, Var, TwoVars]]};

TwoVars: Sp = {RETURN[Pw.HasForm[f, comma, Var, Var]]};

Print: Sp = {RETURN [Pw.HasForm[f, leftPren, PrintAtom, PrintList]]};

PrintAtom: Sp = {IF Car[f] = $print
             	     THEN RETURN [[Yes, NIL]]
             	     ELSE RETURN [[OfCourseNot, f]]};

PrintList: Sp = {RETURN [Pw.HasForm[f, comma, RopeLiteral, PL2]]};

PL2: Sp = {RETURN [Pw.HasForm[f, comma, Var, PL3]]};

PL3: Sp = {RETURN [Pw.HasForm[f, comma, Var, PL4]]};

PL4: Sp = {RETURN [Pw.HasForm[f, comma, IntLiteral, IntLiteral]]};

RopeLiteral: Sp = {IF ISTYPE[NARROW[Car[f], REF ANY], Rope.ROPE]
             		  THEN RETURN [[Yes, NIL]]
             		  ELSE RETURN [[OfCourseNot, f]]};

IntLiteral: Sp = {IF ISTYPE[NARROW[Car[f], REF ANY], REF INT]
             		  THEN RETURN [[Yes, NIL]]
             		  ELSE RETURN [[OfCourseNot, f]]};

Call: Sp = {RETURN [Pw.HasForm[f, leftPren, Var, VarList]]};

Assignment: Sp = {aw: Pw.VerdictAndCulprit _ Pw.HasForm[f, assign, VarList, VarList];
					  IF aw.verdict = Yes AND
					       InfixLength[Cadr[NARROW[Car[NARROW[f]]]]]
					        # InfixLength[Caddr[NARROW[Car[NARROW[f]]]]]
					  THEN RETURN [[No, f]]
					  ELSE  RETURN [aw]};
					  
Alternation: Sp = {RETURN[Pw.HasForm[f, $if, Gcl, NIL]]};

Iteration: Sp = {RETURN[Pw.HasForm[f, $do, Gcl, NIL]]};

PushState: Sp =

{RETURN[
   Pw.Or[Pw.HasForm[f, $width, TwoVars, Command],
   Pw.Or[Pw.HasForm[f, $width, PrenTwoVars, Command],
   Pw.Or[Pw.HasForm[f, $width, Num, Command],
   Pw.Or[Pw.HasForm[f, $paint, Var, Command],
   Pw.Or[Pw.HasForm[f, $paint, PrenNumTriple, Command],
   Pw.HasForm[f, $ends, Var, Command]]]]]]]};
									    
PrenNumTriple: Sp =

{RETURN [Pw.HasForm[f, leftPren, NumTriple, NIL]]};

NumTriple: Sp =

{RETURN [Pw.HasForm[f, comma, Num, NumPair]]};

Gcl: Sp = GuardedCommand;

GuardedCommand: Sp = {RETURN[Pw.HasForm[f, rightarrow, Predicate, Command]]};

Predicate: Sp = {RETURN[Pw.HasForm[f, suchthat, LocalList, CList]]};

LocalList: Sp = {RETURN[Pw.Or[Local[f], Pw.HasForm[f, comma, Local, LocalList]]]};

Local: Sp = {RETURN[Pw.Or[Var[f], Pw.HasForm[f, approx, Var, HintCoords]]]};

HintCoords: Sp = {RETURN
   [Pw.Or[PrenNumPair[f],
            Pw.HasForm[f, $rel, PrenNumPair, PrenFrame]]]};

PrenNumPair: Sp = {RETURN [Pw.HasForm[f, leftPren, NumPair, NIL]]};

NumPair: Sp = {RETURN [Pw.HasForm[f, comma, Num, Num]]};

Num: Sp = {RETURN [Pw.Or[Num2[f], Pw.HasForm[f, minus, Num2, NIL]]]};

Num2: Sp = {IF ISTYPE[Car[f], REF INT] OR ISTYPE[Car[f], REF REAL]
             THEN RETURN [[Yes, NIL]]
             ELSE RETURN [[OfCourseNot, f]]};

PrenFrame: Sp = {RETURN[Pw.HasForm[f, leftPren, Frame, NIL]]};

Frame: Sp = {RETURN[Pw.Or[Var[f], Pw.Or[TwoVars[f], ThreeVars[f]]]]};

CList: Sp = {RETURN[Pw.Or[Constraint[f], Pw.HasForm[f, $and, Constraint, CList]]]};

Constraint: Sp =  -- new [JS]

{RETURN[Pw.Or[NakedConstraint[f],
           Pw.HasForm[f, $rel, RelConstraint, PrenFrame]]]};

NakedConstraint: Sp =  -- old Constraint [JS]

{RETURN[
    Pw.Or[LitTrue[f],
    Pw.Or[Para[f],
    Pw.Or[Ver[f],
    Pw.Or[Hor[f],
            RelConstraint[f]]]]]]};

RelConstraint: Sp =  -- A constraint that can be relativized - new [JS]

{RETURN[
    Pw.Or[Cong[f],
    Pw.Or[Perp[f],
            Equal[f]]]]};

LitTrue: Sp = {IF Car[NARROW[f]] = $T
          THEN RETURN [[Yes, NIL]]
          ELSE RETURN [[OfCourseNot, f]]};

Cong: Sp = {RETURN[Pw.HasForm[f, $cong, PrenTwoVars, PrenTwoVars]]};

Para: Sp = {RETURN[Pw.HasForm[f, $para, PrenTwoVars, PrenTwoVars]]};

Perp: Sp = {RETURN[Pw.HasForm[f, $perp, PrenTwoVars, PrenTwoVars]]};

Equal: Sp = {RETURN[Pw.HasForm[f, equals, Var, PrenNumPair]]};

Hor: Sp = {RETURN[Pw.HasForm[f, $hor, PrenTwoVars, NIL]]};

Ver: Sp = {RETURN[Pw.HasForm[f, $ver, PrenTwoVars, NIL]]};

PrenThreeVars: Sp = {RETURN[Pw.HasForm[f, leftPren, ThreeVars, NIL]]};

PrenTwoVars: Sp = {RETURN[Pw.HasForm[f, leftPren, TwoVars, NIL]]};

Composition: Sp = {RETURN[Pw.HasForm[f, semicolon, Command, Command]]};

InfixLength: PROC[l: Se] RETURNS [INT] =
  {IF ISTYPE[NARROW[l, REF ANY], ATOM]
    THEN RETURN[1]
    ELSE RETURN[1 + InfixLength[Caddr[NARROW[l]]]]};

WellFormed: PUBLIC PROC [f: Se] RETURNS [Pw.VerdictAndCulprit]  =
    {RETURN[Definition[f]]};

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

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

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

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

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

Caar: PROC [r: Se] RETURNS [Se] = {RETURN[Car[Car[r]]]};

Cadar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Car[ l ] ] ] ] };

Caddar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Cdr[ Car[ l ] ] ] ] ]   };

Cadddar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Cdr[ Cdr[ Car[ l ] ] ] ] ] ]  };

Cadddr: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Cdr[ Cdr[ l ] ] ] ] ]  };

Caddddar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Car[ Cdr[ Cdr[ Cdr[ Cdr[ Car[ l ] ] ] ] ] ] ]   };

Cddar: PROC [l: Se] RETURNS [Se] =
{ RETURN[ Cdr[ Cdr[ Car[ l ] ] ] ]  };

END.

´December 7, 1982 4:18 pm

OldJunoParserEtcImpl.mesa

Last Edited by: Gnelson, January 19, 1984 1:35 pm

Last Edited by: Stolfi, January 28, 1984 2:19 am

Edited on January 26, 1984 5:20 pm, by Stolfi
-- Added perpendicular constraint
-- Added relativized constraints
-- Added = (eq) constraint
-- Added (n,n,n) paint option
-- Allowed syntactic variannt (v, v) width as equivalent to v,v width
changes to: Algebra (added perp, equals; changed binding powers to allow relativized constraints), equal (new), Constraint (allowed relativization), NakedConstraint (new: old Constraint plus perp and =), PushState (added (n,n,n) paint; allowed (v,v) width as an alternative to v,v width), PrenNumTriple (new), NumTriple (new), RelPoint (old Rel), PrenNumPair (old NumPair), NumPair (old NumPair2), PrenFrame (old RelList), Frame (old RelList2),

Edited on January 28, 1984 2:06 am, by Stolfi
-- Restricted relativizable constraints to cong, perp and $=
-- Restored binding power of $== to 6, so that local declarations return to the form
   ($== <var> ($rel <coords> <frame>)) instead of ($rel ($== <var> <coords>) <frame>)
-- Fixed syntax to accept absolute hints:  p == (0, 1) (without reference frame)
changes to: T (renamed LitTrue), Local (accepts Hint without $rel), NakedConstraint (either $para, $ver, $hor, $T, or RelConstraint), RelConstraint (matched $perp, $= and $cong constraints), Algebra (priority of $rel), Local, HintCoords (changed syntax)
�ÊU˜Jš
œ™Jš
œ™Jš
œ2™2Jš
œ1™1JšÏk	œU�œ4˜”
Jšœ�œ�œ%�œ�œ
�œ'˜˜
Jšœ�œ˜šÏnœ�œ
�œ�œ˜+Jš|�œg�œ;ÏcFœŸ8œ�œ�œ�œ�œ�œ�œ0�œ2�œ�œ7�œ�œ!�œ
�œŸœ�œ
�œŸœ�œ�œŸœ�œ�œŸœ�œ�œŸœ�œ�œŸœ�œ
�œ$�œ
�œ"�œ
�œ#�œ�œ"�œ�œ#�œ�œ/�œ�œ�œ�œ�œ!�œ�œ �œ3�œ4�œ�œŸ
œ�œ�œ�œ
�œ�œ˜å—Jšžœ�œ
�œ˜.Jšœ�œ�œ
�œŸ˜3Jšœ�œ˜"Jšœ
�œ˜$Jšœ�œ˜!Jšœ�œ˜%Jšœ�œ˜!Jšœ�œ˜#Jšœ�œ˜#Jšœ�œ˜!Jšœ�œ˜'Jšœ
�œ˜$Jšœ�œŸ˜/Jšœ�œ0˜HJšœ�œ+˜DJšœ�œ7˜LJšœ�œ
�œ
�œ�œ�œ
�œ�œ�œ
�œ�œ�œ
�œ˜�
Jšœ�œy˜Ž
Jšœ�œD˜_Jš	œ�œ)�œ5�œ7�œ˜Ì
Jšœ�œJ˜`Jšœ�œ �œ˜BJšœ�œ=˜OJšœ�œ(˜?Jšœ�œ#˜8Jšœ
�œ3˜FJš
œ�œ$�œ
�œ�œ�œ
�œ˜„
Jšœ�œ,˜CJšœ�œ$˜5Jšœ�œ$˜5Jšœ�œ2˜CJšœ�œ
�œ
�œ	�œ
�œ�œ�œ
�œ�œ�œ
�œ˜�
Jšœ�œ
�œ
�œ	�œ
�œ�œ
�œ�œ
�œ�œ�œ
�œ˜š
Jšœ�œ+˜=Jšœ]�œ�œ�œ�œ)�œ�œ�œ
�œ�œ�œ˜¤Jšœ�œ�œ˜:Jšœ�œ�œ˜8š
œ˜Jšœ
�œ¹˜À—š
œ˜Jšœ
�œ-˜4—š
œ˜Jšœ
�œ(˜/—J˜Jšœ�œ2˜NJšœ�œ.˜EJšœ�œ<˜SJšœ
�œ:˜MJšœ�œW˜oJšœ�œ#�œ˜DJšœ�œ$˜9Jšœ�œ,�œ˜FJšœ�œ
�œ	�œ
�œ�œ
�œ	�œ
�œ�œ
�œ�œ�œ
�œ˜—
Jšœ�œ �œ˜?Jšœ
�œ3˜FJšœ
�œA˜Tš
œ˜Jšœ
�œX˜_—šœŸ˜.Jšœ
�œ<Ÿ
œ6˜z—šœŸ3˜HJšœ
�œ'Ÿ
œ˜I—Jšœ�œ�œ�œ
�œ�œ
�œ
�œ˜tJšœ�œ3˜EJšœ�œ3˜EJšœ�œ3˜EJšœ
�œ,˜?Jšœ�œ"�œ˜;Jšœ�œ"�œ˜;Jšœ�œ$�œ˜GJšœ�œ"�œ˜CJšœ�œ/˜HJšžœ�œ�œ�œ�œ
�œ
�œ�œ
�œ�œ�œ
�œ�œ
�œ�œ	˜˜
Jš
ž
œ�œ
�œ	�œ �œ˜_Jšžœ�œ	�œ	�œ
�œ�œ
�œ
�œ
�œ˜MJšžœ�œ	�œ	�œ
�œ�œ
�œ
�œ
�œ
˜LJšžœ�œ	�œ	�œ˜9Jšžœ�œ	�œ	�œ˜?Jšžœ�œ	�œ	�œ˜9Jšžœ�œ	�œ	�œ˜9Jšžœ�œ	�œ
�œ˜IJšžœ�œ	�œ
�œ'˜SJšžœ�œ	�œ
�œ-˜ZJšžœ�œ	�œ
�œ&˜RJšžœ�œ	�œ
�œ5˜cJšžœ�œ	�œ
�œ˜JJš�œ˜™-JšœgÏr
œ& œ 	™Á
Jš'œ œN œ œ œ& œ 
œ
 œ 	œ
 œ œ 
œ œ
 
œ œ œ
 œ œ
 œ œ™¼—J™™-Jšœ+ œ œ ™<Jšœ œ7 #œ #™ª
Jšœ+ œ™PJš&œ 
œ œ
 œ	 œ
 œ	 œ œ œ œ 
œ
 œ
 œ œ œž
 œ œ œ 
œ™ý
——…—#(11