HerculesSyntaxImpl.mesa (ex OldJunoParserEtcImpl)

Last Edited by: Stolfi, February 22, 1984 12:30 pm

Adapted from OldJunoParserEtcImpl
Last Edited by: GNelson, March 1, 1983 6:11 pm

Merged with parts of OldParseWindowImpl
Coded by: GNelson (?) September 6, 1982 12:26 am
Last Edited by: Gnelson, January 17, 1984 11:56 am

ToDo: WellFormed & Cia. .February 22, 1984 5:13 am

Exports the parser/unparser syntax tables for Juno, and a procedure that verifies the well-formedness of a parsed juno expression.

DIRECTORY
Rope,
HerculesAlgebra USING[Se, ],
HerculesSyntax,
HerculesParseUnparse USING
[Syntax, Verifier, NewSyntax, SetCharType,
EnterTwoCharOp, EnterAlias, EnterAtomProps];


HerculesSyntaxImpl: PROGRAM
IMPORTS Rope, HerculesAlgebra
EXPORTS HerculesSyntax =

BEGIN
OPEN HerculesSyntax, HerculesAlgebra, Par: HerculesParseUnparse;

junoSyntax: PUBLIC Par.Syntax ← MakeJunoSyntax[];

MakeJunoSyntax: PROC RETURNS [syntax: Par.Syntax] =

BEGIN

JunoParseType: TYPE = {prefix, postfix, lasfix, rasfix, infix, openfix, closefix};

SetLexProps: PROC [rope: ROPE] =

BEGIN
IF Rope.Length[rope] = 2 AND syntax.chType[rope.Fetch[0]] = op THEN
Par.EnterTwoCharOp[syntax, rope.Fetch[0], rope.Fetch[1]]
END;

SetProps: PROC
[atom: ATOM,
pType: JunoParseType,
power: Par.BindingPower ← 0,
alias: ROPE ← NIL,
extraProps: Props ← []] =

BEGIN
props: Props ← extraProps;
atomName: ROPE = atom.GetPName[];
atomChType: Par.CharType = syntax.chType[atomName.Fetch[0]];

BEGIN OPEN props;
SELECT pType FROM
prefix =>
{prefix ← TRUE; postarg ← TRUE; postbreak ← TRUE,
prepower ← power};
postfix =>
{postfix ← TRUE; prearg ← TRUE; prebreak ← TRUE,
postpower ← power};
lasfix =>
{postfix ← TRUE; prefix ← TRUE;
postpower ← power; prepower ← power+1};
rasfix =>
{postfix ← TRUE; prefix ← TRUE;
postpower ← power+1; prepower ← power};
infix =>
{postfix ← TRUE; prefix ← TRUE;
postpower ← power; prepower ← power};
openfix =>
{prebreak ← TRUE; postarg ← TRUE;
postbreak ← TRUE; prearg ← TRUE};
closefix =>
{postbreak ← TRUE; postarg ← TRUE;
prebreak ← TRUE; prearg ← TRUE};
ENDCASE => ERROR;
IF leftstrength # 0 THEN leftstrength ← postpower;
IF rightstrength # 0 THEN rightstrength ← prepower;
END;

IF atomChType = letter OR atomChType=digit THEN props.alpha ← TRUE;
IF alias # NIL THEN Par.EnterAlias[syntax, Atom.MakeAtom[alias], atom];
EnterAtomProps[atom, props];
SetLexProps[atomName];
SetLexProps[alias]
END;

syntax ← NewSyntax[];

syntax.defaultAtomProps ←
[prebreak: TRUE, postbreak: TRUE,
prearg: TRUE, postarg: TRUE,
prefix: TRUE, prepower: 28, rightoffset: 1,
prestrength: 28, alpha: TRUE];

syntax.defaultLitProps ←
[prebreak: TRUE, postbreak: TRUE,
prearg: TRUE, postarg: TRUE, alpha: TRUE]; -- ! not nice!!!

SetProps[Alg.if, openfix, 0, NIL, [matches: Alg.fi]];
SetProps[Alg.fi, closefix, 0, NIL, [matches: Alg.if]];

SetProps[Alg.do, openfix, 0, NIL, [matches: Alg.od]];
SetProps[Alg.od, closefix, 0, NIL, [matches: Alg.do]];

SetProps[Alg.leftParen, openfix, 0, NIL, [rightstrength: 26, matches: Alg.rightParen]];
SetProps[Alg.rightParen, closefix, 0, NIL,
[prefix: TRUE, prepower: 28, leftstrength: 26, matches: Alg.leftParen]];

SetProps[Alg.leftBrack, openfix, 0, NIL, [rightstrength: 26, matches: Alg.rightBrack]];
SetProps[Alg.rightBrack, closefix, 0, NIL, [leftstrength: 26, matches: Alg.leftBrack]];

SetProps[Alg.rightArrow, infix, 4, "then",
[leftspace: TRUE, rightspace: TRUE, leftofffset: -2, rightoffset: 2]];
SetProps[Alg.semicolon, infix, 6];
SetProps[Alg.paint, rasfix, 7, NIL, [rightoffset: 1]];
SetProps[Alg.ends, rasfix, 7, NIL, [rightoffset: 1]];
SetProps[Alg.width, rasfix, 7, NIL, [rightoffset: 1]];
SetProps[Alg.assign, rasfix, 12, "gets", [rightoffset: 2]];
SetProps[Alg.draw, prefix, 9, NIL, [rightoffset: 2]];
SetProps[Alg.stroke, prefix, 9, NIL, [rightoffset: 2]];
SetProps[Alg.fill, prefix, 9, NIL, [rightoffset: 2]];
SetProps[Alg.comma, rasfix, 10, NIL, [rightspace: TRUE]];
SetProps[Alg.plus, lasfix, 22, NIL, [rightspace: TRUE, leftspace: TRUE, leftoffset: -2]];
SetProps[Alg.minus, lasfix, 22, NIL,
[prearg: TRUE, prebreak: TRUE, rightspace: TRUE, leftspace: TRUE, leftoffset: -2]];
SetProps[Alg.times, lasfix, 24, NIL, [leftoffset: -1]];
SetProps[Alg.slash, lasfix, 24, NIL, [leftoffset: -1]];
SetProps[Alg.div, lasfix, 24, NIL, [leftoffset: -4]];
SetProps[Alg.mod, lasfix, 24, NIL, [leftoffset: -4]];

SetProps[Alg.approx, infix, 20, NIL];
SetProps[Alg.rel, infix, 22, NIL];
SetProps[Alg.hor, prefix, 24, NIL];
SetProps[Alg.ver, prefix, 24, NIL];
SetProps[Alg.cong, infix, 24, NIL];
SetProps[Alg.para, infix, 24, NIL];
SetProps[Alg.perp, infix, 24, NIL];
SetProps[Alg.at, infix, 24, NIL];
SetProps[Alg.gtr, infix, 20, NIL];
SetProps[Alg.lss, infix, 20, NIL];

SetProps[Alg.suchThat, infix, 6, NIL, [leftofffset: -3, rightoffset: 3]];
SetProps[Alg.colon, infix, 4, NIL,
[rightspace: TRUE, leftstrength: 5]];
SetProps[Alg.and, rasfix, 16, NIL];
SetProps[Alg.obox, rasfix, 2, NIL,
[leftspace: TRUE, rightspace: TRUE,
leftofffset: -3, rightoffset: 3]];
SetProps[Alg.is, infix, 2, NIL,
[leftspace: TRUE, rightspace: TRUE,
leftstrength: 3, rightoffset: 3]];

END;
Sp: TYPE = Pw.SyntacticPredicate;
WellFormed: PUBLIC Sp = Definition;
Definition: Sp = {RETURN [Pw.HasForm[f, Alg.is, Var, Expr]]};
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[Call[f], Assignment[f]]]};
Call: Sp = {RETURN [Pw.Or
[Pw.HasForm[f, leftPren, PrefixOp, Expr],
PrefixCall[f]]]};
PrefixCall: Sp = {RETURN [ISTYPE [Car[f], LIST OF Se] AND
PrefixOp [Car [Car[Se]] AND
[Pw.HasForm[f, leftPren, PrefixOp, Expr],
PrefixCall[f]]]};
PrefixOp: Sp = {RETURN [Pw.Or[Var[f], LambdaExpr[f]]]};
LambdaExpr: Sp = {RETURN [FALSE]}; -- will be Pw.HasForm[f, colon, Parms, Expr]
Expr: Sp = {RETURN
[Pw.Or[Var[f],
Pw.Or[Literal[f],
Pw.Or[Call[f],
InfixExpr[f]]]]]};
InfixExpr: Sp = {RETURN [Pw.HasForm[f, InfixOp, Args, Args]]}; --- OOOPS - types!
infixOps: LIST = LIST [Alg.plus, Alg.minus, Alg.times, Alg.slash, Alg.div, Alg.mod, Alg.comma, Alg.semicolon, Alg.equals, Alg.paint, Alg.ends, Alg.width];
InfixOp: Sp = {RETURN
[List.Memb[Car[f], infixOps]]};
Literal: Sp = {RETURN
[Pw.Or[RopeLiteral[f],
NumLiteral[f]]]};
RopeLiteral: Sp = {IF ISTYPE[Car[f], Rope.ROPE]
   THEN RETURN [[Yes, NIL]]
   ELSE RETURN [[OfCourseNot, f]]};
NumLiteral: Sp = {IF ISTYPE[Car[f], REF INT] OR ISTYPE[Car[f], REF REAL]
   THEN RETURN [[Yes, NIL]]
   ELSE RETURN [[OfCourseNot, f]]};
NumExpr: Sp = {RETURN
[Pw.Or[NumLiteral[f],
Pw.Or[Var[f], -- evaluating to a number
Pw.Or[Call[f], -- returning a number
InfixExpr[f]]]]]};
CoordsExpr: Sp = {RETURN
[Pw.Or[NumPairExpr[f],
Pw.HasForm[f, Alg.rel, NumExpr, FrameExpr]]]]};
CoordExpr: Sp = {RETURN
[Pw.Or[Var[f], -- evaluating to either a point or a real pair
Pw.Or[NumPairExpr[f],
Pw.HasForm[f, Alg.rel, NumPairExpr, FrameExpr]]]]};
Num: Sp = {RETURN [Pw.Or[Num2[f], Pw.HasForm[f, minus, Num2, NIL]]]};
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]};
     
ThreeVars: Sp = {RETURN [Pw.HasForm[f, comma, Var, TwoVars]]};
TwoVars: Sp = {RETURN[Pw.HasForm[f, comma, Var, Var]]};
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]]};
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]]};
END.