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
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.
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)