DIRECTORY Rope, ViewerTools, Atom, IO, FS, ParserGen, ParseTable, Lexer;

ParserGenImpl: PROGRAM 
IMPORTS Atom, FS, IO, Rope, ParseTable, Lexer
EXPORTS ParserGen = BEGIN

OPEN ParserGen ;

GenParser: PUBLIC PROCEDURE [ filename : ROPE _ "grammar.text" ]
  RETURNS [ l: Lexer.Handle, h : ParseTable.Handle, g : OpList,  p : ProdList, c : Culprit ] =
{

stream : IO.STREAM _ FS.StreamOpen [ filename ];
text : REF ANY _ IO.GetRefAny [ stream ];

IF ( [ opL : g, prL : p, c : c ] _ BldGrammarDescr [ text ] ) . c # NIL THEN ERROR;

IF ( c _ CheckFixities [ g ] ) # NIL THEN ERROR;

IF ( c _ AddPrecGraphEdges [ opL : g, prL : p ] ) # NIL THEN ERROR;

IF ( c _ SolveForPrecs [ g ] ) # NIL THEN ERROR;

h _ ParseTable.NewHandle[];

l _ Lexer.NewHandle[];

AddGrammarToParseWindow [ opL : g, handle : h, l: l ];
};

BldGrammarDescr:
  PRIVATE PROCEDURE [ text : REF ANY ]
  RETURNS [ opL : OpList _ NIL, prL : ProdList _ NIL, c : Culprit _ NIL ] =
{

IF text = NIL THEN RETURN;

FOR clauseList : List _ NARROW [ text ], clauseList.rest
UNTIL clauseList = NIL DO
{ clause : List = NARROW [ clauseList.first ];
hdr : REF ANY _ clause.first;
tail : List _ clause.rest;

WITH hdr SELECT FROM
h : ATOM =>

SELECT h FROM
$prefix, $postfix, $infix, $openfix, $leftfix, $rightfix =>
[ h : opL, c : c ] _ ProcessFixityTuple [ opL, h,  tail ];
$comment => NULL
ENDCASE => 
[ p : prL, c : c ] _ AddProdRec [ opL, prL, h, tail ]

ENDCASE => ERROR;

IF c # NIL THEN RETURN;
}
   ENDLOOP;
};

ProcessFixityTuple:
  PRIVATE PROCEDURE [ opL : OpList, opKind : ATOM, ops : List ]
  RETURNS [ h : OpList, c : Culprit _ NIL ] =
{

opAtom : ATOM; -- current operator being added
ra : REF ANY;  -- REF to OpRec for opAtom, if any, else NIL
ro : REF OpRec; -- REF to OpRec for opAtom

h _ opL;  ops _ AtomizeList [ ops ]; -- convert any ROPEs to ATOMs.

WHILE ops # NIL -- for each operator: get an OpRec for it and enter its fixity.
DO
opAtom _ NARROW [ ops.first ];  ops _ ops.rest;

IF ( ra _ FindOpRec [ opAtom : opAtom, opL : h ] ) # NIL THEN
ro _ NARROW [ ra ]
ELSE
h _ CONS [ ro _ NEW [ OpRec _ [ op : opAtom, matches : NIL ] ], h ];

[ h : h, ro : ro, ops : ops, c : c ] _
EnterFixity [ opL : h, kind : opKind, refOpRec : ro, restOfOps : ops ];

IF c # NIL THEN ERROR;

ENDLOOP
};

FindOpRec:
  PRIVATE PROCEDURE [ opAtom : ATOM, opL : OpList ]
  RETURNS [ r : REF ANY _ NIL ] =
{
IF opL = NIL THEN
r _ NIL
ELSE IF opL.first.op = opAtom THEN
r _ opL.first
ELSE
r _ FindOpRec [ opAtom : opAtom, opL : opL.rest ];
};

FindOpRec2:
  -- like FindOpRec but deals with EdgeRecs instead of OpRecs.
  PRIVATE PROCEDURE [ opAtom : ATOM, opL : LIST OF EdgeRec ]
  RETURNS [ r : REF ANY _ NIL ] =
{
IF opL = NIL THEN
r _ NIL
ELSE IF opL.first.oprec.op = opAtom THEN
r _ opL.first.oprec
ELSE
r _ FindOpRec2 [ opAtom : opAtom, opL : opL.rest ];
};
EnterFixity:
  PRIVATE PROCEDURE [ opL : OpList, kind : ATOM, refOpRec : REF OpRec, restOfOps : List ]
  RETURNS [ h : OpList, ro : REF OpRec, ops : List, c : Culprit _ NIL ] =
{
OurCulprit : TYPE = RECORD [ op : REF OpRec, msg : ROPE ];

closer : ATOM; -- the operator's matching closefix operator, if any.
rc : REF OpRec; -- ref to OpRec for closer.

h _ opL; ro _ refOpRec; ops _ restOfOps;

SELECT kind FROM
$infix => ro.isInfix _ TRUE;
$prefix => ro.isPrefix _ TRUE;
$postfix => ro.isPostfix _ TRUE;

$openfix, $leftfix, $rightfix =>
{
SELECT kind FROM
$openfix => ro.isOpenfix _ TRUE;
$leftfix => ro.isLeftfix _ TRUE;
$rightfix => ro.isRightfix _ TRUE;
ENDCASE => ERROR;

IF ops = NIL THEN
c _ NEW [ OurCulprit _ [ ro, "missing closefix operator" ] ]
ELSE
{
closer _ NARROW [ ops.first ];  ops _ ops.rest;
[ h : h, rc : rc, c : c ] _ GetCloserRec [ open : ro, opL : h, closer: closer ];
}
}
ENDCASE => ERROR;
};

GetCloserRec:
  PRIVATE PROCEDURE [ open : REF OpRec, opL : OpList, closer : ATOM ]
  RETURNS [ h : OpList, rc : REF OpRec, c : Culprit _ NIL ] =
{

OurCulprit : TYPE = RECORD [ op : ATOM, msg : ROPE ];
ra  : REF ANY; -- nonNIL only if the closer already exists in the opList.
ro : REF OpRec = open; -- points to the open/left/rightfix operator.
IF ( ra_ FindOpRec [ opAtom : closer, opL : opL ] ) = NIL THEN
{
rc _ NEW [ OpRec _ [ op : closer, isClosefix : TRUE ] ];
h _ CONS [ rc, opL ]
}
ELSE
{
rc _ NARROW [ ra, REF OpRec ];
h _ opL
};

SELECT TRUE FROM
ro.matches = NIL =>  ro.matches _ rc;
ro.matches # rc => c _ NEW [ OurCulprit _ [ ro.op, "has more than one closer" ] ]
ENDCASE;

};

AddProdRec:
  PRIVATE PROCEDURE [ opL : OpList, prL : ProdList, nterm : ATOM, rhsL : List ]
  RETURNS [ p : ProdList, c : Culprit _ NIL ] =
{

rhs : List; -- the current right hand side, a list of ATOMS.
k : ATOM; -- the kind of right hand side, $infix, $prefix, etc.
rp : REF ProdRec; -- Pointer to the new production record.
rr : REF RuleRec; -- Pointer to the current rule record.
rules : RuleList _ NIL; -- The list of rule records built for the production.

p _ prL;
rhsL _ AtomizeList [ rhsL ]; -- Change any ROPEs in rhsL to ATOMs.

WHILE rhsL # NIL DO

rhs _ NARROW [ rhsL.first, List ];
rhsL _ rhsL.rest;

[ kind : k, c : c ]  _ FindKindOfRule [ opL : opL, nterm : nterm, r : rhs.rest ];

IF c # NIL THEN RETURN;

rr _ NEW [ RuleRec _ [ kind : k, seq : rhs.rest, number: NARROW[rhs.first, REF INT]^] ];

rules _ CONS [ rr, rules ]

ENDLOOP;

rp _ NEW [ ProdRec _ [ nonTerminal : nterm, rhsList : rules ] ];

p _  CONS [ rp, prL ]
};

AtomizeList:
  PRIVATE PROCEDURE  [ r : List ]
  RETURNS [ s : List _ NIL] =
{

IF r # NIL THEN
{
atomizedRest : List = AtomizeList [ r.rest ];

WITH r.first SELECT FROM

ra : ATOM => s _ CONS [ r.first, atomizedRest ];
rr : ROPE => s _ CONS [ Atom.MakeAtom [ rr ], atomizedRest ];
rl : List => s _ CONS [ AtomizeList [ rl ], atomizedRest ];
ri: REF INT => s _ CONS[r.first, atomizedRest];

ENDCASE => ERROR
}
};

FindKindOfRule:
  PRIVATE PROCEDURE  [ opL : OpList, nterm : ATOM, r : List ]
  RETURNS [ kind : ATOM, c : Culprit _ NIL ] =
{
n : INT = LengthOfList [ r ];
isOp1, isOp2, isOp3, isOp4 : BOOL;
-- isOpk is TRUE iff the k'th element of r is an operator.

OurCulprit : TYPE = RECORD [ op : ATOM, rhs : List, msg : ROPE ];

IF n = 1 THEN {c _ NIL; kind _ $unit; RETURN};

IF n < 2 THEN

c _ NEW [ OurCulprit _ [ nterm, r, "alternative too short" ] ]

ELSE IF n > 4 THEN

c _ NEW [ OurCulprit _ [ nterm, r, "alternative too long" ] ]

ELSE

isOp1 _ IsOp [ opL : opL, ra : NthElt [ r, 1 ] ];
isOp2 _ IsOp [ opL : opL, ra : NthElt [ r, 2 ] ];
isOp3 _ IF n > 2 THEN IsOp [ opL : opL, ra : NthElt [ r, 3 ] ] ELSE FALSE;
isOp4 _ IF n > 3 THEN IsOp [ opL : opL, ra : NthElt [ r, 4 ] ] ELSE FALSE;

SELECT TRUE FROM
n = 2 AND isOp1 AND ~ isOp2 => kind _ $prefix;
--! but what if op1 is not prefix!
n = 2 AND ~isOp1 AND isOp2 => kind _ $postfix;
n = 3 AND isOp1 AND ~isOp2 AND isOp3 => kind _ $openfix;
n = 3 AND ~isOp1 AND isOp2 AND ~isOp3 => kind _ $infix;
n = 4 AND isOp1 AND ~isOp2 AND isOp3 AND ~isOp4 => kind _ $leftfix;
n = 4 AND ~isOp1 AND isOp2 AND ~isOp3 AND isOp4 =>  kind _ $rightfix
ENDCASE =>
c _ NEW [ OurCulprit _ [ nterm, r, "unknown kind of rule" ] ];
};

LengthOfList:
  PRIVATE PROCEDURE  [ x : List ] RETURNS [ n : INT _ 0 ] =
{
IF x # NIL THEN n _ 1 + LengthOfList [ NARROW [ x, List ] . rest ]
};

NthElt:
  PRIVATE PROCEDURE  [ x : List, n : INT ] RETURNS [ REF ANY ] =
{
RETURN [ IF n = 1 THEN x.first ELSE NthElt [ x : x.rest, n : n - 1 ] ]
};

IsOp:
  PRIVATE PROCEDURE  [ opL : OpList, ra : REF ANY ] RETURNS [ BOOL ] =
{
WITH ra SELECT FROM

a : ATOM => RETURN [ FindOpRec [ opAtom : a, opL : opL ] # NIL ]

ENDCASE => RETURN [ FALSE ]
};

CheckFixities:
  PRIVATE PROCEDURE [ opL : OpList ] RETURNS [ c : Culprit _ NIL ] =
{
OurCulprit : TYPE = RECORD [ op: ATOM, msg : ROPE ];

r : OpRec; -- current operator record.

WHILE opL # NIL DO

r _ opL.first^;
opL _ opL.rest;

IF ( r.isInfix AND r.isRightfix )
OR ( r.isRightfix AND r.isPostfix )
OR ( r.isPostfix AND r.isInfix )
THEN
RETURN
[ NEW
[ OurCulprit _ [ r.op, "Infix, Rightfix, and Postfix are mutually exclusive" ] ]
]
ELSE IF ( r.isOpenfix AND r.isLeftfix )
OR ( r.isLeftfix AND r.isPrefix )
OR ( r.isPrefix AND r.isOpenfix )
THEN
RETURN
[ NEW
[ OurCulprit _ [ r.op, "Openfix, Leftfix, and Prefix are mutually exclusive" ] ]
]

ENDLOOP
};

AddPrecGraphEdges:
  PRIVATE PROCEDURE [ opL : OpList, prL : ProdList ] RETURNS [ c : Culprit ] =
{
lhs1, lhs2 : ATOM; -- the nonterminals of the two rules.
rhs1, rhs2: List; -- the rhs sequences of ATOMS of the two rules.
k1, k2: ATOM; -- the kinds of the two rhs's: $infix, $prefix, etc.
op1, op2: ATOM; -- the left operators of rhs1, rhs2.
r1, r2: REF OpRec; -- the records for the left operators of rhs1, rhs2.

FOR pL1 : ProdList _ prL, pL1.rest UNTIL pL1 = NIL
DO
lhs1 _ pL1.first.nonTerminal;

FOR rL1 : RuleList _ pL1.first.rhsList, rL1.rest UNTIL rL1 = NIL
DO
k1 _ rL1.first.kind; rhs1 _ rL1.first.seq;

IF k1 = $openfix THEN LOOP; -- openfix rules never yield precedence edges.

FOR pL2 : ProdList _ prL, pL2.rest UNTIL pL2 = NIL
DO
lhs2 _ pL2.first.nonTerminal;

FOR rL2 : RuleList _ pL2.first.rhsList, rL2.rest UNTIL rL2 = NIL
DO
k2 _ rL2.first.kind; rhs2 _ rL2.first.seq;

IF k2 = $openfix THEN LOOP; -- openfix rules never yield precedence edges.

IF NeedPrecEdge [ opL, lhs1, lhs2, k1, k2, rhs1, rhs2, prL ] THEN
{
op1 _ LOptr [ k1, rhs1 ];
op2 _ LOptr [ k2, rhs2 ];

r1 _ NARROW [ FindOpRec [ op1, opL ] ];

IF FindOpRec2 [ op2, r1.adj ] = NIL THEN
{
r2 _ NARROW [ FindOpRec [ op2, opL ] ];
r1.adj _ CONS [[rL1.first.number, rL2.first.number, r2], r1.adj ];
r2.indegree _ r2.indegree + 1;

}
}
ENDLOOP
ENDLOOP
ENDLOOP
ENDLOOP;

RETURN
};

NeedPrecEdge:
  PRIVATE PROCEDURE [ opL : OpList, 
                             lhs1, lhs2, k1, k2 : ATOM, 
                             rhs1, rhs2 : List,
                             prodlist: ProdList ]
  RETURNS [ b : BOOL _ TRUE ] =
{
b _ k1 # $unit AND k2 # $unit AND (
   ( LOptr [ k1, rhs1 ] # LOptr [ k2, rhs2 ] AND
 HasUnprotectedLOpnd [k2] AND 
HasUnprotectedROpnd [k1] AND 
Reaches[ROpnd [k1,rhs1], lhs2, prodlist, NIL] )
OR
( HasUnprotectedROpnd [k2] AND 
HasUnprotectedLOpnd [k1] AND 
Reaches[LOpnd [k1,rhs1], lhs2, prodlist, NIL] )  )

};


Reaches: PROC [ x, y: ATOM, pl: ProdList, f: LIST OF ATOM] RETURNS [BOOL] =
{IF x = y THEN RETURN [TRUE]
 ; {p: REF ProdRec _ NARROW[FindProdRec[x, pl]]
   ; IF p = NIL THEN RETURN [FALSE]
   ; RETURN[Reach2[p.rhsList, y, pl, CONS[x, f]]]}};

Reach2: PROC[rl: RuleList, y: ATOM, pl: ProdList, f: LIST OF ATOM] RETURNS [BOOL] =
{IF rl = NIL THEN RETURN [FALSE]
; IF rl.first.kind = $unit
  AND ~Memq[NARROW[rl.first.seq.first], f]
  AND Reaches[NARROW[rl.first.seq.first], y, pl, f]
  THEN RETURN[TRUE]
; RETURN[Reach2[rl.rest, y, pl, f]]};

Memq: PROC[a: ATOM, l: LIST OF ATOM] RETURNS [BOOL] =
{IF l = NIL THEN RETURN[FALSE];
 IF l.first = a THEN RETURN[TRUE];
 RETURN[Memq[a, l.rest]]};


LOptr:
  PRIVATE PROCEDURE [ kind : ATOM, rhs : List ] RETURNS [ optr : ATOM ] =
{

SELECT kind FROM
$prefix, $leftfix, $openfix => optr _ NARROW [ NthElt [ rhs, 1 ] ];
$infix, $postfix, $rightfix => optr _ NARROW [ NthElt [ rhs, 2 ] ]
ENDCASE => ERROR;
};

HasUnprotectedLOpnd:
  PRIVATE PROCEDURE [ kind : ATOM ] RETURNS [ BOOL ] =
{

RETURN [ kind = $infix OR kind = $postfix OR kind = $rightfix ]
};

LOpnd:
  PRIVATE PROCEDURE [ kind : ATOM, rhs : List ] RETURNS [ opnd : ATOM ] =
{
SELECT kind FROM
$infix, $postfix, $rightfix => opnd _ NARROW [ NthElt [ rhs, 1 ] ];
$prefix, $leftfix, $openfix => opnd _ NARROW [ NthElt [ rhs, 2 ] ];
ENDCASE => ERROR
};

HasUnprotectedROpnd:
  PRIVATE PROCEDURE [ kind : ATOM ] RETURNS [ BOOL ] =
{

RETURN [ kind = $prefix OR kind = $infix OR kind = $leftfix ]
};

ROpnd:
  PRIVATE PROCEDURE [ kind : ATOM, rhs : List ] RETURNS [ opnd : ATOM ] =
{
SELECT kind FROM
$postfix => opnd _ NARROW [ NthElt [ rhs, 1 ] ];
$prefix, $openfix => opnd _ NARROW [ NthElt [ rhs, 2 ] ];
$infix, $rightfix => opnd _ NARROW [ NthElt [ rhs, 3 ] ];
$leftfix => opnd _ NARROW [ NthElt [ rhs, 4 ] ];
ENDCASE => ERROR;
};

SolveForPrecs:
  PRIVATE PROCEDURE [ opL : OpList ] RETURNS [ c : Culprit _ NIL ] =
{

OurCulprit : TYPE = RECORD [ opL : LIST OF REF ANY, msg : ROPE ];

S : OpList _ NIL;  -- the source nodes of Gi, excluding closefix operators.
N : OpList _ NIL;  -- the nonsource nodes of Gi.
n : INT;  -- the current step number.
x : REF OpRec;


n _ closefixPrec + 1;

FOR g : OpList _ opL, g.rest UNTIL g = NIL
DO
IF ~ ( x _ g.first ) . isClosefix THEN
IF x.indegree = 0 THEN S _ CONS [ x, S ] ELSE N _ CONS [ x, N ]
ENDLOOP;

FOR g : OpList _ S, g.rest UNTIL g = NIL DO g.first.prec _ 0 ENDLOOP;



WHILE S # NIL
DO
[ S, N ] _ DeleteSources [ S, N ];

FOR g : OpList _ S, g.rest UNTIL g = NIL DO g.first.prec _ n + 1 ENDLOOP;

n _ n + 1
ENDLOOP;

IF N # NIL THEN
c _ NEW [ OurCulprit _ [ FindCycle[N], "cyclic precedences" ] ]
};

FindCycle: PROC[ops: OpList] RETURNS [cycle: LIST OF REF ANY] =
  {op: ATOM _ ops.first.op;
    l: LIST OF REF ANY _ NIL;
    WHILE ~ Memqq[op, l] 
    DO {op2: ATOM;
          n, m: INT;
          [op2, n, m] _ FindPredecessor[op, ops];
          l _ CONS[NEW[INT _ n], CONS[NEW [INT _ m], CONS[op, l]]];
          op _ op2}
    ENDLOOP;
    cycle _ CONS[op, NIL];
    WHILE l.first # op DO cycle _ CONS[l.first, cycle]; l _ l.rest ENDLOOP};

Memqq: PROC[r: REF, l: LIST OF REF] RETURNS [BOOL] =
  {IF l = NIL THEN RETURN [FALSE];
   IF r = l.first THEN RETURN [TRUE];
   RETURN[Memqq[r, l.rest]]};

FindPredecessor: PROC[op: ATOM, ops: OpList] RETURNS [ATOM, INT, INT] =
  {DO {a:LIST OF EdgeRec _ ops.first.adj;
         WHILE a # NIL 
         DO 
           IF a.first.oprec.op = op THEN RETURN[ops.first.op, a.first.n, a.first.m]; 
           a _ a.rest 
         ENDLOOP};
         ops _ ops.rest
   ENDLOOP};   

DeleteSources:
  PRIVATE PROCEDURE [ S, N : OpList ] RETURNS [ newS, newN : OpList _ NIL ] =
{

u : REF OpRec;  -- current node being deleted, if any, else NIL.
a : REF OpRec;  -- current node adjacent to u, if any, else NIL.

newS _ NIL;  newN _ N;

FOR undeleted : OpList _ S, undeleted.rest UNTIL undeleted = NIL
DO
u _ undeleted.first;

FOR adjacent : LIST OF EdgeRec _ u.adj, adjacent.rest UNTIL adjacent = NIL
DO
a _ adjacent.first.oprec;

IF a.indegree = 1 THEN
{
newN _ RemoveOp [ a, newN ];
newS _ CONS [ a, newS ]
};

a.indegree _ a.indegree - 1

ENDLOOP
ENDLOOP
};
RemoveOp:
  PRIVATE PROCEDURE [ n : REF OpRec, x : OpList ] RETURNS [ y : OpList ] =
{

y _
SELECT TRUE FROM
x = NIL => NIL,
n.op = x.first.op => x.rest
ENDCASE => CONS [ x.first, RemoveOp [ n, x.rest ] ];
};

AddGrammarToParseWindow:
  PRIVATE PROCEDURE 
   [ opL : OpList, handle : ParseTable.Handle, l: Lexer.Handle ] =
{

r : REF OpRec; -- index for the loops.

FOR rs : OpList _ opL, rs.rest UNTIL rs = NIL -- must add closefix operators first
DO
r _ rs.first;
{p: ParseTable.Properties 
 _ NEW[ParseTable.PRec _ [name: r.op]];
 opname: ROPE _ Atom.GetPName [r.op];
 aname: ROPE _ NIL;
 p.infix _ r.isInfix;
 p.prefix _ r.isPrefix;
 p.postfix _ r.isPostfix;
 p.matchfix _ r.isOpenfix;
 p.subfix _ r.isRightfix;
 p.closefix _ r.isClosefix;
 p.bindingPower _ r.prec;
 p.unparserType _ 0;
 IF Rope.Length[opname] = 2 
 AND l.type[Rope.Fetch[opname, 0]] = op
 THEN Lexer.AddOpPair[l, opname.Fetch[0], opname.Fetch[1]];
 IF Rope.Length[aname] = 2 
 AND l.type[Rope.Fetch[aname, 0]] = op
 THEN Lexer.AddOpPair[l, aname.Fetch[0], aname.Fetch[1]];
 ParseTable.Enter[handle, p]}
ENDLOOP;
 
 FOR rs : OpList _ opL, rs.rest UNTIL rs = NIL DO
   r _ rs.first;
   IF r.isOpenfix OR r.isLeftfix OR r.isRightfix
   THEN {p: ParseTable.Properties _ ParseTable.Search[handle, r.op, NIL];
            p.closer _ ParseTable.Search[handle, r.matches.op, NIL]}
 ENDLOOP };
 
OpDoesntLookLikeWord: PRIVATE PROCEDURE [ n : ROPE ] RETURNS [ b : BOOL ] =
{
b _ Rope.Equal [ n, "(" ] OR Rope.Equal [ n, "{" ] OR Rope.Equal [ n, "[" ]
};

IsGeneratedBy:
  PUBLIC PROCEDURE [ prL : ProdList, lhs : ATOM, p : ParseTree ]
  RETURNS [ vc : VerdictAndCulprit ] =
{

SELECT TRUE FROM

lhs = $id =>
WITH Car [ p ] SELECT FROM
atom : ATOM => RETURN [ [ Yes, NIL, 0 ] ];
ENDCASE => RETURN [ [ No, Car[p], 0 ] ];

lhs = $Int =>
WITH Car [ p ] SELECT FROM
ri : REF INT => RETURN [ [ Yes, NIL, 0 ] ];
ENDCASE => RETURN [ [ No, Car[p] , 0] ];

lhs = $Real =>
WITH Car [ p ] SELECT FROM
ri : REF INT => RETURN [ [ Yes, NIL, 0 ] ];
ENDCASE => RETURN [ [ No, Car[p] , 0] ];

lhs = $Rope =>
WITH Car [ p ] SELECT FROM
r: ROPE => RETURN [[ Yes, NIL, 0 ]];
ENDCASE => RETURN [ [ No, Car[p] , 0] ];

FindProdRec[lhs, prL] = NIL =>
  IF Car [ p ] = lhs 
  THEN RETURN [ [Yes, NIL, 0] ]
  ELSE RETURN [ [ No, Car[p], 0] ];

TRUE =>
  RETURN[
  CheckRhsList [ prL, p,  NARROW[FindProdRec[lhs, prL], REF ProdRec].rhsList]]

ENDCASE => ERROR;  

};
 
FindProdRec:
  PRIVATE PROCEDURE [ opAtom : ATOM, prL : ProdList ]
  RETURNS [ r : REF ANY _ NIL ] =
{
IF prL = NIL THEN
r _ NIL
ELSE IF prL.first.nonTerminal = opAtom THEN
r _ prL.first
ELSE
r _ FindProdRec [ opAtom : opAtom, prL : prL.rest ];
};

CheckRhsList:
  PRIVATE PROCEDURE [ prL : ProdList, p : ParseTree, rhsL : RuleList ]
  RETURNS [ vc : VerdictAndCulprit ] =
{
-- We are given a parse tree Car[p], a grammar, and a list of alternatives.  We take each alternative, find out whether or not Car[p] is generated by it, and OR the results.

IF rhsL = NIL THEN RETURN [[No, NIL, 0]];

vc _ CheckRhs [ prL, p, rhsL.first ];

IF vc.verdict = Yes THEN RETURN;

vc _ Or [ vc, CheckRhsList [ prL, p, rhsL.rest ] ]
};

CheckRhs:
  PRIVATE PROCEDURE [ prL : ProdList, p : ParseTree, rhs : REF RuleRec ]
  RETURNS [ vc : VerdictAndCulprit ] =
{

k : ATOM = rhs.kind;  -- kind of rule; $infix, $prefix, etc.
s : List = rhs.seq;  -- the symbols of the right hand side, each an atom.
cp : REF = Car[p];  -- Car [ p ], as a list.
optr : ATOM;  -- the leading operator of cp, if one exists.

IF k = $unit THEN RETURN[IsGeneratedBy[prL, NARROW[s.first], p]];

IF ~ ISTYPE[cp, List] THEN RETURN [[No, p, 0]];

optr _ NARROW [ Car[ cp ], ATOM];

IF LOptr [ k, s ] # optr
OR LengthOfList[s] # LengthOfList[ NARROW[ cp ] ]  
+ (IF k = $openfix OR k = $leftfix OR k = $rightfix THEN 1 ELSE 0)
THEN RETURN [ [ No, p, 0 ] ];

vc _ IsGeneratedBy [ prL, LOpnd [ k, s ] , Cdr [ cp ] ];

IF k = $prefix OR k = $postfix OR k = $openfix
THEN {vc.depth _ vc.depth + 1; RETURN};

vc _ And[vc, IsGeneratedBy [ prL, ROpnd [ k, s ], Cddr [ cp ] ] ];
vc.depth _ vc.depth + 1

};

And: PROC[vc1, vc2: VerdictAndCulprit] RETURNS [VerdictAndCulprit] =
{SELECT TRUE FROM
  vc1.verdict = Yes AND vc2.verdict = Yes => RETURN[[Yes, NIL, 0]];
  vc1.verdict = Yes AND vc2.verdict = No => RETURN[[No, vc2.culprit, vc2.depth]];
  vc1.verdict = No AND vc2.verdict = Yes => RETURN[[No, vc1.culprit, vc1.depth]]; 
  -- vc1.verdict = No AND vc2.verdict = No
  vc1.depth >= vc2.depth => RETURN[[No, vc1.culprit, vc1.depth]];
  vc1.depth <= vc2.depth => RETURN[[No, vc2.culprit, vc2.depth]]
 ENDCASE => ERROR};

Car: PROC [r: REF ANY] RETURNS [REF ANY] = {RETURN[NARROW[r, List].first]};
Cdr: PROC [r: REF ANY] RETURNS [REF ANY] = {RETURN[NARROW[r, List].rest]};
Cddr: PROC [r: REF ANY] RETURNS [REF ANY] = {RETURN[Cdr[Cdr[r]]]};

Open: PRIVATE PROCEDURE [ fileName: ROPE ] RETURNS [ IO.STREAM ] =
{ 
RETURN [ FS.StreamOpen [ fileName ] ]
};

GetRefAnyFrom: PRIVATE PROCEDURE [ fileName: ROPE ] RETURNS [ REF ANY ] =
{ 
RETURN [ IO.GetRefAny [ FS.StreamOpen [ fileName ] ] ]
};

NthOp:
  PRIVATE PROCEDURE [ x : OpList, n : INT ] RETURNS [ REF OpRec ] =
{
RETURN [ IF n = 1 THEN x.first ELSE NthOp [ x : x.rest, n : n - 1 ] ]
};




Or:  PROC [aw1, aw2: VerdictAndCulprit] 
    RETURNS [r: VerdictAndCulprit] =
  {SELECT TRUE FROM
     aw1.verdict = Yes OR aw2.verdict = Yes => r _ [Yes, NIL, 0];
     aw1.depth >= aw2.depth => r _ aw1;
     aw1.depth <= aw2.depth => r _ aw2
   ENDCASE => ERROR};
     


END.
æ-- ParserGenImpl.mesa
-- Last edited by Jim Sasaki on August 24, 1983 4:03 pm
Last Edited by: Gnelson, December 10, 1983 1:35 pm
-- We read a grammar description from the named file, do some consistency checks on it, construct an operator precedence graph from it, solve for the operator precedences, and build a new parse window for its language.  (A parse window is a viewer into which one can type strings to be parsed.)
-- The text input is the result of GetRefAny on the following:
      Grammar ::= ( ClauseList )
      Clause  ::= (infix Op ...) | (prefix Op ...) | (postfix Op ...) |
                  (openfix Op ...) | (leftfix Op ...) | (rightfix Op ...) |
                  (Nonterm Rhs ...)
      Rhs     ::= (Nonterm Op Nonterm) | (Op Nonterm) | (Nonterm Op) | etc
      Op      ::= a string within double quotes
      Nonterm ::= an identifier, not infix, prefix, etc.
  
-- The clauses may appear in any order except that the fixity clauses must
  all appear before the production clauses.  Each kind of clause may appear
  more than once.  The open/left/rightfix clauses must include the matching
  closefix operators, as in (openfix "(" ")" "[" "]").
  
  For example:
  
     ((infix "*" "+") (S (S "+" S) (S "*" S)))
  
 is a description for
 
    S ::= S + S | S * S
-- We take the operators and add them and their fixities to opL, yielding h.  Note that infix, rightfix, and postfix are mutually exclusive fixities, as are openfix, leftfix, and prefix.
-- If opL contains an OpRec with operator opAtom, return a ref to it, else return NIL.

-- If opL contains an OpRec with operator opAtom, return a ref to it, else return NIL.

-- We fill in the fixity fields for the OpRec.  If the operator is openfix, leftfix, or rightfix, we make sure its matching closefix operator exists in the op list, adding it if necessary.

-- We look for the closer in the list of operators; if it isn't there, we build a new op record for it and add it to the list.  We return rc, a ref to the closer's op rec, and h, the (possibly updated) list of operators.


-- We take nterm, a nonterminal, and rhsL, the list of its right hand sides, build a production record with them and add it to opL, yielding p.  Note each rhs gets its own rule record.
-- Recursively replace ROPEs by their atoms.
-- Look at the sequence r of symbols and figure out whether or not they look like an infix, prefix, postfix, openfix, leftfix, or rightfix rule.  We assume the symbols are ATOMs.

-- Return the length of the list.

-- Returns the n'th element of the list.

-- Return TRUE iff the given atom is an operator in the OpList.

-- Make sure that the fixities of each operator are acceptable: infix, rightfix, and postfix are mutually exclusive, as are openfix, leftfix, and prefix.  Other combinations are ok.

-- For each pair of rules, look at them to see whether or not we need an edge in the precedence graph for them; if we do, add it to the graph if it isn't already there.  (NOTE : we're cheating a bit in this routine.  See NeedPrecEdge for details.)


-- The four deep loop just goes through every pair of right hand sides from each production.  Inside the loop, we check the two right hand sides and decide whether or not we need a precedence edge because of them.

-- Return TRUE iff we need an edge in the graph to connect the left operator of rhs1 to the left operator of rhs2.  NOTE : we're cheating a bit here: the full algorithm actually uses two kinds of edges in the graph: less than ("LT") edges and less than or equal to ("LE") edges.  (If operator x has a LT edge to operator y, then the precedence of x must be less than the precedence of y; LE edges are similar.)  Anyway, in the full algorithm, if we have two rules where x and y are the left operators of rules 1 and 2 and Y is the lhs nonterminal of rule 2, then if (1) Y is also the rightmost operand of rule 1 and y has a left operand, then we need an LE edge from x to y.  On the other hand, if (2) Y is the left operand of rule 1 and y has a right operand, then we need a LT edge from x to y.  In this actual routine, we've cut some corners: we eliminate all edges from a node to itself, and we treat all the remaining edges as LT edges.

-- We are given the kind of and symbols for the right hand side of a rule.  We return the leftmost operator of the rule.
-- Return TRUE iff the given kind of rule has an unprotected left operand.  (That is, one not surrounded by matching parens/brackets/whatever.
-- We are given the kind of and symbols for the right hand side of a rule.  We return the leftmost operand of the rule, unprotected or not.

-- Return TRUE iff the given kind of rule has an unprotected right operand.  (That is, one not surrounded by matching parens/brackets/whatever.
-- We are given the kind of and symbols for the right hand side of a rule.  We return the rightmost operand of the rule, unprotected or not.

-- We need to calculate the precedences of the operators in opL so that if x -> y is an edge in the precedence graph, then x.prec < y.prec.  It suffices to set prec(x) = length of longest path from a source of the graph to the node x.

-- Invariant for the algorithm: G0 = < S0, N0 > is the original graph, Sn and Nn are the sources and nonsources of Gn (all n > 0), and Gn = G0 minus the nodes in union ( S0, S1, ... Sn-1 ).  The precedence of x is p iff x is in Sp.
-- Initialize the list of source/nonsource nodes.  Throw away closefix operators, since their precedences are uninteresting. (Actually, that's false: the precedence of closefix operators must be less than the precedence of the other operators.  We've already initialized them that way.)
-- Set the precedences of the nodes in Sn to n, and remove Sn from Gn, yielding Gn+1.  Repeat until Sn+1 is empty.
-- We remove the nodes in S from the precedence graph and return the new sources and nonsources of the graph.

-- We remove the node n from the OpList x. If n isn't in x, we return x as is.
-- Add the operators to the parse window handle so that the parse viewer will actually know about them.  This is where we use the precedences of the operators.

-- NOTE : some of this is skeletoned because the parser and unparser haven't been augmented yet.
-- Take the the open/close/left/rightfix operator name, n, and return TRUE if it doesn't look like a word.  As a hack, left parens/braces/brackets don't look like word; everything else does.

-- We are given a parse tree Car[p], a grammar (via its operators and productions), and a left hand side nonterminal of the grammar.  We find out whether Car[p] is generated by the nonterminal by trying each of the right hand sides of the nonterminal's productions.
-- If prL contains a production with lhs opAtom, return a ref to it, else return NIL.

-- We find out whether Car[p] is generated from the right hand side rhs.  
-- Some testing routines; not normally used otherwise.

-- Returns the n'th element of the operator list.

HasForm:  PROC[f: REF ANY, 
                  op: ATOM, 
                   Arg1: SyntacticPredicate, 
                   Arg2: SyntacticPredicate _ NIL]  
      RETURNS [VerdictAndCulprit] =
  {WITH Car[NARROW[f]] SELECT FROM
    g: LIST OF REF ANY =>
      {IF Car[g] # op THEN RETURN [[OfCourseNot, g]];
       IF (Arg2 = NIL) # (Cddr[g] = NIL)
       THEN RETURN[[OfCourseNot, f]];
       {aw: VerdictAndCulprit _ Arg1[Cdr[g]];
        IF aw.verdict # Yes THEN RETURN [[No, aw.culprit]];
        IF Cddr[g] = NIL THEN RETURN [[Yes, NIL]];
        aw _ Arg2[Cddr[g]];
        IF aw.verdict # Yes THEN RETURN [[No, aw.culprit]];
        RETURN [[Yes, NIL]]}}
     ENDCASE => RETURN [[OfCourseNot, f]]};
�ÊY˜Jš
œM™MJ™2JšÏk	œ�œ#˜HJ˜šœ�œ
˜Jš�œ�œ˜-Jš�œ
�˜J˜Jš�œ˜J˜Jš
Ïn	œ�œ
�	œ�œ�œU˜Ÿ
š
œ
˜
š
œ¦™¦J˜Jšœ	�œ
�œ˜0Jšœ�œ
�œ�œ˜)J˜Jš�œB�œ
�œ
�œ
˜SJ˜Jš�œ�œ
�œ
�œ
˜0J˜Jš�œ2�œ
�œ
�œ
˜CJ˜Jš�œ�œ
�œ
�œ
˜0J˜Jš
œ˜J˜J˜J˜J˜6——J˜J˜Jšžœ�œ
�	œ
�œ
�œ�œ�œ�œ�œ˜ƒ
š
œ
˜
š
œÎ™ÎJš
œ�™�J˜Jš�œ�œ
�œ
�œ
˜J˜š�œ�œ˜8Jš�œ�œ
�˜šœ�œ˜.Jšœ�œ
�œ˜Jš
œ˜J˜š�œ�œ
�˜šœ�œ˜J˜š�œ�˜
˜;Jš
œ:˜:—Jšœ�˜—š�œ˜Jš
œ5˜5—J˜—Jš�œ�œ
˜—J˜Jš�œ�œ
�œ
�œ
˜—J˜
—Jšœ�œ
˜——J˜J˜Jšžœ�œ
�	œ�œ�œ�œ˜�
š
œ
˜
šÏcœ¸
™º
J˜Jšœ	�œŸ˜.Jšœ�œ
�œŸ,˜;Jšœ�œŸ˜*J˜Jšœ%Ÿ˜CJ˜Jš�œ�œ
Ÿ?˜Oš
�˜Jšœ	�œ ˜/J˜š�œ3�œ
�˜=Jšœ�œ˜—š
�˜Jšœ�œ�œ$�œ
˜D—J˜˜&J˜G—J˜Jš�œ�œ
�œ
�œ
˜J˜—Jš
�˜——J˜J˜Jšž	œ�œ
�	œ�œ�œ�œ
�œ�œ˜`š
œ
˜
š
œV™VJ™š�œ�œ
�˜Jšœ�˜—š�œ
�œ�˜"Jš
œ
˜
—š
�˜Jš
œ2˜2———J˜J˜Jšž
œ
˜Jšœ
ž	œ.�œ
�	œ�œ�œ�œ
�œ�œ˜�
š
œ
˜
š
œV™VJ™š�œ�œ
�˜Jšœ�˜—š�œ
�œ�˜(Jš
œ˜—š
�˜Jš
œ3˜3———J˜Jšžœ�œ
�	œ�œ
�œ�œ�œ"�œ˜°
š
œ
˜
š
œ¼
™¼
J™Jš	œ
�œ�œ�œ�œ˜:J˜Jšœ	�œŸ5˜DJšœ�œŸ˜+J˜J˜(J˜š�œ�˜Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ
˜ J˜J˜ ˜
š�œ�˜Jšœ�œ
˜ Jšœ�œ
˜ Jšœ�œ
˜"—Jš�œ�œ
˜J˜š�œ�œ
�˜Jšœ�œ5˜<—Jš
�˜˜
Jšœ	�œ ˜/J˜P—J˜
—J˜
Jš�œ�œ
˜———J˜J˜Jšžœ�œ
�	œ
�œ�œ�œ�œ�œ˜‘
š
œ
˜
š
φ
™Ü
J˜Jš	œ
�œ�œ�œ�œ˜5J™Jšœ�œ
�œŸ:˜IJšœ�œŸ-˜DJ™Jš�œ4�œ
�˜>š
œ
˜
Jšœ�œ'�œ˜8Jšœ�œ˜—J˜
Jš
�˜˜
Jšœ�œ�œ	˜Jš
œ˜—J˜J˜š�œ
�œ
�˜Jšœ
�œ˜%Jšœ�œ7˜Q—Jš�œ
˜J˜——J˜J˜Jšž
œ�œ
�	œ)�œ�œ�œ˜‹
š
œ
˜
š
œ¸
™¸
J˜JšœŸ0˜<Jšœ�œŸ5˜?Jšœ�œ
Ÿ(˜:Jšœ�œ
Ÿ&˜8Jšœ�œŸ5˜MJ˜J˜JšœŸ%˜BJ˜š�œ�œ
�˜J˜Jšœ�œ˜"J˜J˜J˜QJ˜Jš�œ�œ
�œ
�œ
˜J˜Jšœ�œP˜XJ˜Jšœ�œ˜J˜—Jš�œ
˜J˜Jšœ�œ8˜@J˜Jšœ�œ˜——J˜J˜Jš
žœ�œ
�	œ�œ�œ˜Lš
œ
˜
™,J˜Jš�œ�œ
�˜˜
J˜-J˜Jš�œ	�œ
�˜˜Jšœ�œ�œ˜0Jšœ�œ�œ(˜=Jšœ�œ&˜;J˜/J˜—Jš�œ�˜—J˜
——J˜J˜Jšžœ�œ
�	œ�œ�œ
�œ�œ˜|š
œ
˜
š
œ²
™²
J™Jšœ�œ˜Jšœ�œ
Ÿ;˜]J˜Jš	œ
�œ�œ�œ�œ˜AJ˜J˜.J˜š�œ�˜
J˜Jšœ�œ7˜>J˜—š�œ
�œ�˜J˜Jšœ�œ6˜=J˜—š
�˜J˜Jš
œ1˜1Jš
œ1˜1Jš	œ�œ�œ*�œ
�œ
˜JJš	œ�œ�œ*�œ
�œ
˜JJ˜š�œ
�œ
�˜Jšœ�œ�œ>˜QJšœ�œ�œ˜.Jšœ�œ�œ�œ˜8Jšœ�œ�œ�œ˜7Jš	œ�œ�œ�œ�œ˜CJš	œ�œ�œ�œ�œ˜D—š�œ˜
Jšœ�œ7˜>————J˜J˜Jš
žœ�œ
�	œ�œ�œ˜Iš
œ
˜
š
œ!™!J™Jš�œ�œ
�œ�œ˜B——J˜J˜Jšžœ�œ
�	œ�œ�œ�œ
�œ˜Hš
œ
˜
š
œ(™(J™Jš�œ�œ�œ	�œ#˜F——J˜J˜Jšžœ�œ
�	œ�œ
�œ�œ�œ˜Lš
œ
˜
š
œ?™?J™š�œ�œ
�˜J˜Jšœ�œ�œ)�œ˜@J˜—Jš�œ�œ�œ˜——J˜J˜Jš
ž
œ�œ
�	œ�œ�œ˜Sš
œ
˜
š
ϵ
™µ
J™Jš	œ
�œ�œ�œ�œ˜4J˜IdefaultxšœŸ˜&K˜š�œ�œ
�˜K˜K˜K˜K˜š�œ
�œ˜!Kš�œ�œ˜#Kš�œ�œ˜ —š
�˜Jš
�˜šœ�˜Jš
œP˜P—J˜
—š�œ
�œ�œ˜'Jš�œ�œ
˜!Jš�œ�œ˜!—š
�˜Jš
�˜šœ�˜Jš
œP˜P—J˜
—J˜—Jš
�˜——J˜J˜Jšžœ�œ
�	œ"�œ˜aš
œ
˜
Jšœª
žœ,žœ™÷
™Jšœ
�œŸ%˜8JšœŸ/˜AJšœ�œŸ4˜BJšœ
�œŸ$˜4Jšœ�œŸ4˜GJ˜J™J™Õ
J™Jš�œ �œ�˜2š
�˜Jš
œ˜J˜Jš�œ.�œ�˜@š
�˜Jš
œ*˜*J˜Jš�œ�œ
�œŸ.˜JJ˜Jš�œ �œ�˜2š
�˜Jš
œ˜J˜Jš�œ.�œ�˜@š
�˜Jš
œ*˜*J˜Jš�œ�œ
�œŸ.˜JJ˜Jš�œ;�˜A˜
Jš
œ˜J˜Jšœ�œ˜'J˜Jš�œ�œ
�˜(˜
Jšœ�œ˜'Jšœ	�œ5˜BJ˜J˜—J˜
—J˜
—Jš
�˜—Jš
�˜—Jš
�˜—Jš
�˜J˜Jš
�˜——J˜J˜Jšžœ�œ
�	œD�œg�œ�œ�œ˜í
š
œ
˜
šœrž#œ˜™­J™—š
œ#˜#šœ,�˜0Jšœ�œ�œ1˜l—š
�˜Jšœ�œ�œ4˜p—J˜——J˜J˜
J˜²Jšžœ�œ
�	œ
�œ�œ
�œ˜Pš
œ
˜
š
Ÿx™xJ˜š�œ�˜Jšœ&�œ˜CJšœ&�œ˜B—Jš�œ�œ
˜——J˜J˜Jšžœ�œ
�	œ
�œ�œ�œ˜Kš
œ
˜
š
ŸŽ
™Ž
J˜Jš�œ�œ�œ˜?——J˜J˜Jšžœ�œ
�	œ
�œ�œ
�œ˜Pš
œ
˜
š
Ÿ‹
™‹
J™š�œ�˜Jšœ&�œ˜CJšœ&�œ˜C—Jš�œ�˜——J˜J˜Jšžœ�œ
�	œ
�œ�œ�œ˜Kš
œ
˜
š
Ÿ�
™�
J˜Jš�œ�œ�œ˜=——J˜J˜Jšžœ�œ
�	œ
�œ�œ
�œ˜Pš
œ
˜
š
ŸŒ
™Œ
J™š�œ�˜Jšœ�œ˜0Jšœ�œ˜9Jšœ�œ˜9Jšœ�œ˜0—Jš�œ�œ
˜——J˜J˜Jš
ž
œ�œ
�	œ�œ�œ˜Sš
œ
˜
Jš
ϐ
™ê
J™™ç
J˜Jšœ
�œ�œ �œ˜AJ˜Jš�
œ�œŸ8˜KJš�
œ�œŸ˜0Jšœ�œŸ˜%Jšœ�œ˜J˜šœ~ž 
™žJ˜J˜J˜Jš�œ�œ�˜*š
�˜š�œ �˜&Jš�œ�œ
�
œ�œ�
œ�œ
�
œ�œ�
œ˜?——Jš�œ
˜J˜Jš�œ�
œ	�œ�œ
�œ�œ
˜EJ˜J˜—™rJ˜Jš�œ
�
œ�˜
š
�˜Jš	œ�
œ�
œ�
œ�
œ˜"J˜Jš�œ�
œ	�œ�œ
�œ�œ
˜IJ˜J˜	—Jš�œ
˜J˜š�œ
�
œ�œ
�˜Jšœ�œ�œ˜?————J˜¾J˜ÜJ˜Jšž
œ�œ
�	œ�
œ�
œ�œ�œ˜\š
œ
˜
š
œm™mJ˜Jšœ�œ	Ÿ0˜@Jšœ�œ	Ÿ0˜@J˜Jšœ�œ
�
œ
˜J˜Jš�œ�
œ�œ
�˜@š
�˜J˜J˜Jš�œ3�œ�˜Jš
�˜J˜J˜Jš�œ�˜˜
Jš
œ˜Jšœ�œ˜—J˜J˜J˜J˜—Jš
�˜—Jš
�˜——J˜J™Jš
žœ�œ
�	œ�œ�œ˜Tš
œ
˜
š
œN™NJ˜˜š�œ
�œ
�˜Jšœ�œ�œ
˜Jš
œ˜—Jš�œ�œ%˜4———J˜J˜Jšžœ�œ
�	œD˜pš
œ
˜
Jš
œŸ
™Ÿ
J™Jš
ž`™`˜Jšœ�œŸ˜&J˜Jš�œ�œ�œ
Ÿ$˜RJš*�œ-�œ+�œ!�œ�œË
�œ�œ%�œ8�œ�œ$�œS�œ�œ�œ�œ
�œ�œ
�œ
�œ�œ‰
�	œ˜�——Jšžœ�œ
�	œ�œ�œ�œ˜K˜
J™¾
J™Jšœ�œ�œ˜K—J˜J˜Jš
ž
œ�œ
�	œ�œ�œ˜v˜
™‰J˜š�œ�˜˜˜š�œ�œ
�˜Jšœ�œ�œ
�œ˜*—Jš�œ�œ˜(—J˜˜
š�œ�œ
�˜Jš	œ�œ
�œ�œ
�œ˜+—Jš�œ�œ˜(—J˜˜š�œ�œ
�˜Jš	œ�œ
�œ�œ
�œ˜+—Jš�œ�œ˜(—J˜˜š�œ�œ
�˜Jšœ�œ�œ	�œ˜$—Jš�œ�œ˜(—J˜Jšœ�œ�œ�œ
�œ	�œ	�œ
�œ˜xJ˜š�œ�œ�œ�œ˜`J˜———Jš�œ�œ˜J˜——Jš
œ˜J˜
Jšžœ�œ
�	œ�œ�œ�œ
�œ�œ˜dš
œ
˜
š
œU™UJ™š�œ�œ
�˜Jšœ�˜—š�œ
�œ �˜+Jš
œ
˜
—š
�˜Jš
œ4˜4———J˜J˜Jšžœ�œ
�	œ6�œ˜{˜
Jš
Ϩ
˜®
Jš
œ*˜*J˜&J˜ J˜Jš
œ2˜2—J˜J˜Jš
žœ�œ
�	œ(�œ
�œ˜y˜
š
œJ™JJ˜Jšœ�œŸ&˜<JšœŸ4˜IJšœ�œŸ˜,Jšœ�œŸ-˜;J˜Jš�œ�œ
�œ�œ˜AJ˜Jš�œ�œ�œ
�œ˜/J˜Jšœ�œ�œ˜!J˜Jš�œ˜š�œ!�œ
˜3Jšœ�œ�œ�œ�œ�œ˜B—Jš�œ
�œ˜Jš
œ8˜8J˜Jšœ�œ�œ
˜.Jš
œ'˜'J˜J˜BJ˜J˜——J˜J˜�J˜Jšžœ�œ�œ
�œ�œ�œ
�œ�œ
�œ˜KJšžœ�œ�œ
�œ�œ�œ
�œ�œ
�œ˜JJšžœ�œ�œ
�œ�œ�œ
�œ�œ˜BJ˜™6J™Jšžœ�œ
�	œ
�œ�œ�œ
�œ˜Bš
œ˜Jš�œ˜%—Jš
œ˜J˜Jšž
œ�œ
�	œ
�œ�œ�œ
�œ˜Iš
œ˜Jš�œ�œ+˜6—J˜J˜Jšžœ�œ
�	œ�œ�œ�œ
˜Jš
œ
˜
š
œ1™1J™Jš�œ�œ�œ	�œ"˜E——J˜Jš
œ
˜
JšLžœ�œ�œ
�œ�œ_�œ
�œ�œ�œ�œ
�œ�œ
�œ
�œ
�œ�œ
�œ
�œ�œ	�œ�œ	�œ
�œJ�œ�œ
�œ�œ�œ
�œ
�œ�œ(�œ�œ
�œ�œ�œ
�œ�œ™ÀJšœžœ�œ$�œ�œ
�œ
�œ�œ �œU�œ�œ	˜‘J˜—Jš�œ
˜——…—M„U