
<<
JunoExpressionsImpl.mesa (was OldJunoParserEtcImpl.mesa)>>
<<>>
<<Coded December 7, 1982 4:18 pm>>
<<Last Edited by: Gnelson, January 19, 1984 1:35 pm>>
<<Last Edited by: Stolfi    June 13, 1984 1:07:04 pm PDT>>

DIRECTORY

  Rope USING [ROPE],
  JunoExpressions,
  JunoParseUnparse USING
     [Se, Verdict, SyntacticPredicate, Or, HasForm, Is, VerdictAndCulprit, False],
  Atom USING [MakeAtom];

JunoExpressionsImpl: CEDAR PROGRAM

IMPORTS

JunoParseUnparse,
Atom

EXPORTS

JunoExpressions =

BEGIN

OPEN

Rope,
JunoExpressions,
JunoParseUnparse;
<<
- - - - IMPORTED TYPES>>

Sp: TYPE = SyntacticPredicate;  -- Se = "symbolic expression"

VaC: TYPE = VerdictAndCulprit;
<<
- - - - RESERVED ATOMS>>
<<
Tokens that have special meaning for the Juno interpreter: >>

and: PUBLIC ATOM _ $and;
approx: PUBLIC ATOM _ Atom.MakeAtom["=="];
assign: PUBLIC ATOM _ Atom.MakeAtom[":="];
at: PUBLIC ATOM _ $at;
ccw: PUBLIC ATOM _ $ccw;
colon: PUBLIC ATOM _ Atom.MakeAtom[":"];
comma: PUBLIC ATOM _ Atom.MakeAtom[","];
cong: PUBLIC ATOM _ $cong;
cons: PUBLIC ATOM _ $cons;
dec: PUBLIC ATOM _ $dec;
dist: PUBLIC ATOM _ Atom.MakeAtom["--"];
div: PUBLIC ATOM _ Atom.MakeAtom["/"];
do: PUBLIC ATOM _ $do;
draw: PUBLIC ATOM _ $draw;
ends: PUBLIC ATOM _ $ends;
fill: PUBLIC ATOM _ $fill;
first: PUBLIC ATOM _ $first;
floor: PUBLIC ATOM _ $floor;
font: PUBLIC ATOM _ $font;
hor: PUBLIC ATOM _ $hor;
if: PUBLIC ATOM _ $if;
inc: PUBLIC ATOM _ $inc;
justified: PUBLIC ATOM _ $justified;
lambda: PUBLIC ATOM _ Atom.MakeAtom[">>"];
leftPren: PUBLIC ATOM _ Atom.MakeAtom["("];
minus: PUBLIC ATOM _ Atom.MakeAtom["-"];
obox: PUBLIC ATOM _ Atom.MakeAtom["//"];
paint: PUBLIC ATOM _ $paint;
para: PUBLIC ATOM _ $para;
perp: PUBLIC ATOM _ $perp;
plus: PUBLIC ATOM _ Atom.MakeAtom["+"];
print: PUBLIC ATOM _ $print;
rel: PUBLIC ATOM _ $rel;
rest: PUBLIC ATOM _ $rest;
rightArrow: PUBLIC ATOM _ Atom.MakeAtom["->"];
semicolon: PUBLIC ATOM _ Atom.MakeAtom[";"];
size: PUBLIC ATOM _ $size;
skip: PUBLIC ATOM _ $skip;
stroke: PUBLIC ATOM _ $stroke;
face: PUBLIC ATOM _ $face;
suchThat: PUBLIC ATOM _ Atom.MakeAtom["|"];
times: PUBLIC ATOM _ Atom.MakeAtom["*"];
true: PUBLIC ATOM _ $T;
ver: PUBLIC ATOM _ $ver;
width: PUBLIC ATOM _ $width;
xcoord: PUBLIC ATOM _ $xcoord;
ycoord: PUBLIC ATOM _ $ycoord;
<<
- - - - SYNTAX CHECKING TOOLS>>

Nest: PROC [f: Se, Elem: Sp, op: ATOM _ comma, min: INT _ 0, max: INT _ LAST[INT],
   Zero: Sp _ False] RETURNS [r: VaC] =
<<Checks for a nest of a specific binary operator. The Zero may occur only on the right side.   >>

BEGIN
   nel: INT _ 0;
   CtElem: Sp = {r _ Elem[f]; IF r.verdict = yes THEN nel _ nel+1};
   NestRest: Sp = {RETURN [Or[Zero[f], HasForm[f, op, CtElem, NestRest]]]};
   r _ NestRest[f];
   IF r.verdict = yes THEN
     {IF nel > max OR nel < min THEN r _ [no, f]}
END;   

OptParNest: PROC [f: Se, Elem: Sp, op: ATOM _ comma,
   min: INT _ 0, max: INT _ LAST[INT], Zero: Sp _ False] RETURNS [r: VaC] =
<<Checks for a nest, possibly enclosed in parenthesis  >>

BEGIN
   Nst: Sp = {RETURN [Nest[f, Elem, op, min, max, Zero]]};
   RETURN[Or[HasForm[f, leftPren, Nst], Nst[f]]]
END;

InfixLength: PROC[l: Se] RETURNS [INT] =
  {IF ISTYPE[NARROW[l, REF ANY], ATOM] 
    THEN RETURN[1]
    ELSE RETURN[1 + InfixLength[Caddr[NARROW[l]]]]};
<<
- - - - SYNTAX OF JUNO SYMBOLIC EXPRESSIONS>>

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

AtomicCommand: Sp = {RETURN [Or
   [Draw[f],
    Print[f],
    ProcCall[f],
    Assignment[f],
    Is[f, skip]]]};

Draw: Sp = {RETURN [Or
    [HasForm[f, stroke, DrawList], 
     HasForm[f, fill, DrawList], 
     HasForm[f, draw, DrawList]]]};

DrawList: Sp = {RETURN [Or
   [DrawListElem[f],
    HasForm[f, comma, DrawListElem, DrawList]]]};

DrawListElem: Sp = {RETURN [Or[PointPairExpr[f], PointQuadExpr[f]]]};

PointPairExpr: Sp = {RETURN [OptParNest[f: f, Elem: PointExpr, min: 2, max: 2]]};

PointQuadExpr: Sp = {RETURN [OptParNest[f: f, Elem: PointExpr, min: 4, max: 4]]};

PointExpr: Sp = {RETURN [Or
   [Or[Var[f],
    NumPairExpr[f],
    FuncCall[f],
    HasForm[f, leftPren, PointExpr],
    HasForm[f, rel, NumPairExpr, FrameExpr]]]]};

Var: Sp = {IF ISTYPE[Car[f], ATOM]
             THEN RETURN [[yes, NIL]] ELSE RETURN [[ofCourseNot, f]]};

FuncCall: Sp = {RETURN [HasForm[f, leftPren, Var, ExprList]]};

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

ExprList: Sp = {RETURN [Nest[f: f, Elem: Expr, op: comma, Zero: NIL]]};

NumPairExpr: Sp = {RETURN [HasForm[f, leftPren, TwoNumExprs]]};

TwoNumExprs: Sp = {RETURN [HasForm[f, comma, NumExpr, NumExpr]]};

NumExpr: Sp = {RETURN [Or
   [Var[f],
    FuncCall[f],
    NumLit[f],
    ArithOp[f],
    HasForm[f, leftPren, NumExpr]]]};

NumLit: Sp = {IF ISTYPE[Car[f], REF INT] OR ISTYPE[Car[f], REF REAL] 
                       THEN RETURN [[yes, NIL]]
                       ELSE RETURN [[ofCourseNot, f]]};

ArithOp: Sp = {RETURN [Or
   [HasForm[f, LIST[minus, inc, dec, floor, first, xcoord, ycoord], NumExpr],
    HasForm[f, LIST[plus, times, minus, div], NumExpr, NumExpr],
    HasForm[f, dist, PointExpr, PointExpr]]]};

Expr: PUBLIC Sp = {RETURN [Or
   [Var[f],
    FuncCall[f],
    NumLit[f],
    RopeLit[f], Or[
    ArithOp[f],
    OtherOp[f],
    Lambda[f],
    HasForm[f, leftPren, Expr]]]]};

OtherOp: Sp = {RETURN [Or
   [HasForm[f, LIST[rest], Expr],
    HasForm[f, LIST[cons], Expr, Expr],
    HasForm[f, dist, PointExpr, PointExpr]]]};

Print: Sp = {RETURN [HasForm[f, leftPren, PrintOp, PrintList]]};

PrintOp: Sp = {RETURN [Is[f, print]]};

PrintList: Sp = {RETURN [HasForm[f, comma, RopeLit, PointExpr]]};

RopeLit: Sp = {IF ISTYPE[Car[f], ROPE]  
                       THEN RETURN [[yes]]
                       ELSE RETURN [[ofCourseNot, f]]};

ProcCall: Sp = {RETURN [Or[Var[f], HasForm[f, leftPren, Var, ExprList]]]};

Assignment: Sp =
   {v: VaC _ HasForm[f, assign, VarList, VarList];
    IF v.verdict = yes AND InfixLength[Cadr[Car[f]]] # InfixLength[Caddr[Car[f]]]
       THEN RETURN [[no, f]]
       ELSE  RETURN [v]};

Alternation: Sp = {RETURN[HasForm[f, if, GuardedCmdList, NIL]]};

Iteration: Sp = {RETURN[HasForm[f, do, GuardedCmdList, NIL]]};

GuardedCmdList: Sp = {RETURN[Or
   [GuardedCmd[f],
    HasForm[f, obox, GuardedCmd, GuardedCmdList]]]};

GuardedCmd: Sp = {RETURN[HasForm[f, rightArrow, Guard, Command]]};

Guard: Sp = {RETURN[Or [PredicateList[f], HasForm[f, suchThat, LocalList, PredicateList]]]};

LocalList: Sp = {RETURN[Or[LocalDecl[f], HasForm[f, comma, LocalDecl, LocalList]]]};

PredicateList: Sp = {RETURN[Or [Constraint[f], HasForm[f, and, Constraint, PredicateList]]]};

Constraint: Sp = {RETURN[Or
  [Is[f, true],
   HasForm[f, rel, PointConstraint, FrameExpr],
   PointConstraint[f]]]};

PointConstraint: Sp = {RETURN[Or
  [HasForm[f, LIST [hor, ver], PointPairExpr],
   HasForm[f, LIST [cong, para, perp], PointPairExpr, PointPairExpr],
   HasForm[f, ccw, PointTripletExpr],
   HasForm[f, at, PointExpr, PointExpr]]]};

PointTripletExpr: Sp = {RETURN [OptParNest[f:f, Elem: PointExpr, min: 3, max: 3]]};

FrameExpr: Sp = {RETURN [OptParNest[f:f, Elem: PointExpr, min: 1, max: 3]]};

LocalDecl: Sp = {RETURN[Or[Var[f], HasForm[f, approx, Var, PointExpr]]]};

PushState: Sp = {RETURN[Or
  [HasForm[f, LIST[width, size], NumExpr, Command],
   HasForm[f, font, RopeLit, Command],
   HasForm[f, LIST[face, paint, ends, justified], Var, Command]]]};

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

Lambda: PUBLIC Sp = {RETURN[HasForm[f, lambda, Formals, Body]]};

Body: PUBLIC Sp = {RETURN[Or[Command[f], Expr[f]]]};

Formals: Sp = {RETURN[Nest[f: f, Elem: Var]]};

Definition: PUBLIC Sp = {RETURN[HasForm[f, colon, Header, Command]]};

Header: Sp = {RETURN[Or[Var[f], HasForm[f, leftPren, Var, Formals]]]};
<<
- - - - CAR, CDR, ETC>>

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

END.