-- December 7, 1982 4:18 pm
-- OldJunoParserEtcImpl.mesa
-- Last Edited by: Gnelson, October 11, 1983 9:39 pm

DIRECTORY Rope, Lexer, Parser, OldUnparser,  OldParseWindow, JunoButtons,
               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] =
  {  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, 5, prefix, NIL, 5];
    PW.AddOp[junoA, "ver", NIL, 5, prefix, NIL, 5];
    PW.AddOp[junoA, "cong", NIL, 5, infix, NIL, 2];
    PW.AddOp[junoA, "para", NIL, 5, infix, NIL, 2];
    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];
  };

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["|"];


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, Num, Command],
								PW.Or[PW.HasForm[f, $paint, Var, Command],
									    PW.HasForm[f, $ends, Var, Command]]]]]};

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, Rel]]]};

Rel: Sp = {RETURN [PW.HasForm[f, $rel, NumPair, Rellist]]};

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

NumPair2: 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]]};
             
Rellist: Sp = {RETURN[PW.HasForm[f, leftPren, Rellist2, NIL]]};

Rellist2: 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 = {RETURN[PW.Or[T[f], PW.Or[Cong[f], PW.Or[Para[f], PW.Or[Hor[f], Ver[f]]]]]]};

T: 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]]};

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.