DIRECTORY Atom, BasicTime, Commander, Feedback, FeedbackClasses, IntToIntTab, IO, PFS, Process, RefTab, Rope, Scheme, SchemePrettyRead, SchemePrinting, SimpleFeedback, StructuredStreams, TextEditBogus, TextNode, UnparserBuffer, UserProfile;

SchemeExtPrint: CEDAR PROGRAM
IMPORTS Atom, Commander, Feedback, FeedbackClasses, IntToIntTab, IO, PFS, Process, RefTab, Rope, Scheme, SchemePrettyRead, SimpleFeedback, StructuredStreams, TextEditBogus, UnparserBuffer, UserProfile
EXPORTS SchemePrinting
=

BEGIN OPEN Scheme, SchemePrettyRead, SchemePrinting, SS:StructuredStreams, UB:UnparserBuffer;

PPState: TYPE ~ REF PPStateRep;
PPStateRep: TYPE ~ RECORD [
buffHead, buffTail: BuffList ¬ NIL,
bufferedLineWithBreak: BOOL ¬ FALSE,
wantSep: BOOL ¬ FALSE,
do0: BOOL ¬ FALSE, --default offset = 0 or sia?
emitStack, emitFree: EmitStack ¬ NIL,
steplenLimit: INTEGER ¬ 100,
srcIdx: INT ¬ noIdx,
how: How,
rules: RefTab.Ref--context:ATOM -> CtxStuff--,
formDefaultRules, listDefaultRules: CtxStuff,
posns: FormToSource,
quit: REF BOOL,
to, log: IO.STREAM];

BuffList: TYPE ~ REF BuffCons;
BuffdLine: TYPE ~ REF BuffCons[line];
BuffdBreak: TYPE ~ REF BuffCons[break];
BuffdObj: TYPE ~ REF BuffCons[obj];
BuffCons: TYPE ~ RECORD [rest: BuffList, first: SELECT kind: * FROM
line => [chars, looks, unlooks: ROPE, break, space: BOOL, node: TextNode.Ref],
break => [cond: UB.XBreakCondition, offset: INTEGER, sep: ROPE],
obj => [begin: BOOL],
ENDCASE];

BreakMetaSpec: TYPE ~ RECORD [cond: UB.XBreakCondition, sia: BOOL];

CtxStuff: TYPE ~ REF CtxStuffPrivate;
CtxStuffPrivate: TYPE ~ RECORD [
ntv, bcv: SCVar,
nRules: INT ¬ 0,
rsHead, rsTail: RuleSpecList ¬ NIL];

RuleSpecList: TYPE ~ LIST OF RuleSpec;
RuleSpec: TYPE ~ RECORD [depth: INT ¬ anyDepth, ntv, bcv: SCVar, me: Any, tc: TestClosure, ec: EmitClosure];

NT: TYPE ~ {form, list};

SCVar: TYPE ~ REF SCCell;
SCCell: TYPE ~ RECORD [
descr: ROPE,
val, defined, free: BOOL ¬ FALSE,
un: SCVar ¬ NIL, --NIL or pointer 'round ring of unified variables
ur: SCVar ¬ NIL --NIL or representative of this set of unified variables
];

constFree: SCVar ~ NEW [SCCell ¬ ["unconstrained", FALSE, TRUE, TRUE]];
constForm: SCVar ~ NEW [SCCell ¬ ["Form", FALSE, TRUE]];
constList: SCVar ~ NEW [SCCell ¬ ["Tail", TRUE, TRUE]];
constWhite: SCVar ~ NEW [SCCell ¬ ["White", TRUE, TRUE]];
constBlack: SCVar ~ NEW [SCCell ¬ ["Black", FALSE, TRUE]];

TestClosure: TYPE ~ REF TestClosureRep;
TestClosureRep: TYPE ~ RECORD [test: TestProc, rest: TestClosure, data, rule: Any];
TestProc: TYPE ~ PROC [subject: Any, pps: PPState, tc: TestClosure] RETURNS [BOOL];

EmitClosure: TYPE ~ REF EmitClosureRep;
EmitClosureRep: TYPE ~ RECORD [emit: EmitProc, rest: EmitClosure, data, rule: Any];
EmitProc: TYPE ~ PROC [pps: PPState, ec: EmitClosure, subject: Any, context: ATOM, depth, steplen: INTEGER, srcIdx: INT, es: EmitStack] RETURNS [EmitStackFrame, EmitStack];

EmitStack: TYPE ~ LIST OF EmitStackFrame;
EmitStackFrame: TYPE ~ RECORD [ec: EmitClosure, subject: Any, context: ATOM, depth, steplen: INTEGER, srcIdx: INT];

Classification: TYPE ~ {leaf, atom, simple, complex};

CommentTest: TYPE ~ RECORD [noPre, noPost: BOOL];
CD: TYPE ~ RECORD [context: ATOM, depth: INTEGER];

noRule: RuleSpec ~ [me: NIL, tc: noTest, ec: noEmit, ntv: NIL, bcv: NIL];
noTest: TestClosure ~ NIL;
noEmit: EmitClosure ~ NIL;
anyDepth: INTEGER ~ INTEGER.FIRST;
noIdx: INT ~ INT.FIRST;
emptyList: Pair ~ NIL;
formDefault: ATOM ~ Atom.MakeAtom["form-default"];
listDefault: ATOM ~ Atom.MakeAtom["list-default"];
beginObj: ATOM ~ Atom.MakeAtom["begin-obj"];
endObj: ATOM ~ Atom.MakeAtom["end-obj"];
stripObj: ATOM ~ Atom.MakeAtom["strip-list"];
closeParenRope: ROPE ~ ")";
stop: EmitClosure ~ ae[$endofstack, stopEmit];
closeParen: EmitClosure ~ ae[closeParenRope, ropeEmit, NIL, closeParenRope];
closeObjAndNaught: EmitClosure ~ ae[endObj, cobEmit];
closeObjAndParen: EmitClosure ~ ae[$endlob, clobEmit];
improperTailIntroEC: EmitClosure ~ ae[$improperTailIntro, improperTailIntroEmit];
commentsEC: EmitClosure ~ ae[$comments, commentsEmit];
neverMatchTC: TestClosure ~ at[$neverMatch, neverMatchTest];
defLooks: ROPE ¬ "n";
defUnlooks: ROPE ¬ "N";
argLooks: ROPE ¬ "c";
argUnlooks: ROPE ¬ "C";
kwdLooks: ROPE ¬ "k";
kwdUnlooks: ROPE ¬ "K";
defaultHow: How ¬ [];
defaultMargin: INT ¬ 80;
rules: RefTab.Ref ~ RefTab.Create[];
formDefaultRules, listDefaultRules: CtxStuff ¬ NIL;
debugRules: BOOL ¬ FALSE;

PrettyPrint: PUBLIC PROC [to: IO.STREAM, val: Any, how: How, context: ATOM, posns: FormToSource ¬ NIL, debugLog: IO.STREAM ¬ NIL, quit: REF BOOL ¬ NIL] ~ {
pps: PPState ~ NEW [PPStateRep ¬ [how: how, rules: rules, formDefaultRules: formDefaultRules, listDefaultRules: listDefaultRules, posns: posns, to: to, log: debugLog, quit: quit]];
IF pps.quit=NIL THEN pps.quit ¬ NEW [BOOL ¬ FALSE];
IF pps.rules.GetSize[] = 0 THEN Complain[NIL, "can't pretty-print for lack of rules"];
EmitBreak[pps, never, 0, NIL];
EnterEmit[pps, val, context, 0, 0];
Flush[pps];
RETURN};

at: PROC [me: Any, test: TestProc, rest: TestClosure ¬ NIL, data: REF ANY ¬ NIL] RETURNS [TestClosure]
~ {RETURN [NEW [TestClosureRep ¬ [test, rest, data, me]]]};

ae: PROC [me: Any, emit: EmitProc, rest: EmitClosure ¬ NIL, data: REF ANY ¬ NIL] RETURNS [EmitClosure]
~ {RETURN [NEW [EmitClosureRep ¬ [emit, rest, data, me]]]};

Compile: PROC [context: ATOM, recNT, recBC: SCVar, depth: INT, me: Any, tsx: BOOL] RETURNS [RuleSpec] ~ {
tc: TestClosure; ec: EmitClosure; ntv, bcv: SCVar;
[tc, ec, ntv, bcv] ¬ CompileWork[context, recNT, recBC, depth, me, tsx];
RETURN [[depth, ntv, bcv, me, tc, ec]]};

CompileWork: PROC [context: ATOM, recNT, recBC: SCVar, depth: INT, me: Any, tsx: BOOL] RETURNS [TestClosure, EmitClosure, SCVar, SCVar] ~ {
IF me=emptyList THEN RETURN [at[me, emptyTest], ae[me, emptyEmit, NIL, NIL], constList, constFree];
WITH me SELECT FROM
s: Symbol => SELECT s FROM
$any => RETURN [at[me, anyTest], ae[me, EmitByEnter], recNT, recBC];
$leaf => RETURN [at[me, leafTest], ae[me, EmitDirectly], constForm, constBlack];
$definee => RETURN [at[me, leafTest], ae[me, EmitDefinee], constForm, constBlack];
$argument => RETURN [at[me, leafTest], ae[me, EmitArgument], constForm, constBlack];
$atom => RETURN [at[me, atomTest], ae[me, EmitByEnter], recNT, recBC];
$simple => RETURN [at[me, simpleTest], ae[me, EmitByEnter], recNT, recBC];
$complex => RETURN [at[me, complexTest], ae[me, EmitByEnter], recNT, recBC];
ENDCASE => RETURN [at[me, anyTest], ae[me, EmitByEnterContext, NIL, s], GetCtxNtv[s], GetCtxBcv[s]];
p: Pair => {
WITH p.car SELECT FROM
a: ATOM => SELECT a FROM
$precommentless, $postcommentless, $commentless => {
subR: Any ~ Scheme.Car[p.cdr];
subRS: RuleSpec ~ Compile[context, recNT, recBC, depth, subR, tsx];
data: REF ANY ~ NEW [CommentTest ¬ [a#$postcommentless, a#$precommentless]];
RETURN [at[me, commentTest, subRS.tc, data], subRS.ec, subRS.ntv, subRS.bcv]};
$enter => {e1: Any ~ Scheme.Car[p.cdr]; t1: Any ~ Scheme.Cdr[p.cdr];
e2: Any ~ Scheme.Car[t1];
newc: Symbol ~ NarrowToSymbol[e1];
newd: INTEGER ~ TheINT[e2];
cd: REF CD ~ NEW [CD ¬ [newc, newd]];
RETURN [at[me, anyTest], ae[me, EmitByEnterContextAndDepth, NIL, cd], GetCtxNtv[newc], GetCtxBcv[newc]]};
$inc, $dec => {newc: Symbol ~ NarrowToSymbol[Scheme.Car[p.cdr]];
cd: REF CD ~ NEW [CD ¬ [newc, IF a=$inc THEN 1 ELSE -1]];
RETURN [at[me, anyTest], ae[me, EmitByEnterContextAndDelta, NIL, cd], GetCtxNtv[newc], GetCtxBcv[newc]]};
$me => {
subr1: Any ~ Scheme.Car[p.cdr]; t1: Pair ~ NarrowToPair[Scheme.Cdr[p.cdr]];
subr2: Any ~ t1.car;
rs1: RuleSpec ~ Compile[context, recNT, recBC, depth, subr1, FALSE];
rs2: RuleSpec ~ Compile[context, recNT, recBC, depth, subr2, tsx];
RETURN [rs1.tc, rs2.ec, rs2.ntv, rs2.bcv]};
$mei, $med => {
pat: Any ~ Scheme.Car[p.cdr]; t1: Pair ~ NarrowToPair[Scheme.Cdr[p.cdr]];
ctx: Symbol ~ NarrowToSymbol[t1.car];
rsp: RuleSpec ~ Compile[context, recNT, recBC, depth, pat, FALSE];
cd: REF CD ~ NEW [CD ¬ [ctx, IF a=$mei THEN 1 ELSE -1]];
RETURN [rsp.tc, ae[me, EmitByEnterContextAndDelta, NIL, cd], GetCtxNtv[ctx], GetCtxBcv[ctx]]};
$quote => {s: Any ~ Scheme.Car[p.cdr];
WITH s SELECT FROM
x: Symbol => NULL;
x: String => NULL;
ENDCASE => ERROR Complain[a, "not a symbol or string"];
RETURN [at[me, quoteTest, NIL, s], ae[me, quoteEmit, NIL, s], constForm, constBlack]};
$quasiquote => {s: Symbol ~ NarrowToSymbol[Scheme.Car[p.cdr]];
RETURN [at[me, quoteTest, NIL, s], ae[me, quasiquoteEmit, NIL, s], constForm, constBlack]};
$lb => {subRS: RuleSpec ~ Compile[context, recNT, recBC, depth, Scheme.Car[p.cdr], tsx];
IF tsx THEN Unify[subRS.ntv, constList];
RETURN [at[me, listTest, subRS.tc], ae[me, lbEmit, subRS.ec, NIL], constForm, constBlack]};
$ob => {subRS: RuleSpec ~ Compile[context, recNT, recBC, depth, Scheme.Car[p.cdr], tsx];
RETURN [subRS.tc, ae[me, obEmit, subRS.ec, NIL], subRS.ntv, subRS.bcv]};
beginObj => {subRS: RuleSpec ~ Compile[context, recNT, recBC, depth, p.cdr, tsx];
RETURN [subRS.tc, ae[me, bobEmit, subRS.ec, NIL], subRS.ntv, subRS.bcv]};
endObj => {subRS: RuleSpec ~ Compile[context, recNT, recBC, depth, p.cdr, tsx];
RETURN [subRS.tc, ae[me, eobEmit, subRS.ec, NIL], subRS.ntv, subRS.bcv]};
$lob => {subRS: RuleSpec ~ Compile[context, recNT, recBC, depth, Scheme.Car[p.cdr], tsx];
IF tsx THEN Unify[subRS.ntv, constList];
RETURN [at[me, listTest, subRS.tc], ae[me, lobEmit, subRS.ec, NIL], constForm, constBlack]};
$vp => {subRS: RuleSpec ~ Compile[context, recNT, recBC, depth, Scheme.Car[p.cdr], tsx];
IF tsx THEN {Unify[subRS.ntv, constForm]; Unify[subRS.bcv, constBlack]};
RETURN [at[me, vpTest, subRS.tc], ae[me, vpEmit, subRS.ec, NIL], constForm, constBlack]};
stripObj => {subRS: RuleSpec ~ Compile[context, recNT, recBC, depth, Scheme.Car[p.cdr], tsx];
IF tsx THEN Unify[subRS.ntv, constList];
RETURN [at[me, listTest, subRS.tc], ae[me, striplistEmit, subRS.ec, NIL], constForm, constBlack]};
$or => {
meTail: Any ¬ p.cdr;
rsl: RuleSpecList ¬ LIST[noRule];
rslTail: RuleSpecList ¬ rsl;
lastNTV, lastBCV: SCVar ¬ NIL;
FOR meTail: Any ¬ p.cdr, Cdr[meTail] WHILE meTail#emptyList DO
this: RuleSpecList ~ LIST[Compile[context, recNT, recBC, depth, Scheme.Car[meTail], tsx]];
IF tsx AND lastNTV#NIL
THEN {Unify[lastNTV, this.first.ntv]; Unify[lastBCV, this.first.bcv]};
lastNTV ¬ this.first.ntv; lastBCV ¬ this.first.bcv; 
rslTail.rest ¬ this; rslTail ¬ this;
ENDLOOP;
IF lastNTV=NIL THEN Complain[NIL, "empty (or) rule"];
RETURN [at[me, orTest, NIL, rsl.rest], ae[me, orEmit, NIL, rsl.rest], lastNTV, lastBCV]};
$n0 => RETURN CompileBreak[context, recNT, recBC, depth, never, FALSE, p, tsx];
$ns => RETURN CompileBreak[context, recNT, recBC, depth, never, TRUE, p, tsx];
$m0 => RETURN CompileBreak[context, recNT, recBC, depth, miser, FALSE, p, tsx];
$ms => RETURN CompileBreak[context, recNT, recBC, depth, miser, TRUE, p, tsx];
$l0 => RETURN CompileBreak[context, recNT, recBC, depth, lookLeft, FALSE, p, tsx];
$ls => RETURN CompileBreak[context, recNT, recBC, depth, lookLeft, TRUE, p, tsx];
$u0 => RETURN CompileBreak[context, recNT, recBC, depth, united, FALSE, p, tsx];
$us => RETURN CompileBreak[context, recNT, recBC, depth, united, TRUE, p, tsx];
$a0 => RETURN CompileBreak[context, recNT, recBC, depth, always, FALSE, p, tsx];
$as => RETURN CompileBreak[context, recNT, recBC, depth, always, TRUE, p, tsx];	
$readermacro => {str: String ~ TheString[Scheme.Car[p.cdr]];
t1: Pair ~ NarrowToPair[Scheme.Cdr[p.cdr]]; y: Any ~ t1.car;
rsy: RuleSpec ~ Compile[context, recNT, recBC, depth, y, tsx];
IF tsx THEN Unify[rsy.ntv, constForm];
RETURN [neverMatchTC, ae[me, rmEmit, rsy.ec, RopeFromString[str]], constForm, constBlack]};
$dotform => {y: Any ~ Scheme.Car[p.cdr];
rsy: RuleSpec ~ Compile[context, recNT, recBC, depth, y, tsx];
IF tsx THEN Unify[rsy.ntv, constForm];
RETURN [neverMatchTC, ae[me, dfEmit, rsy.ec, NIL], constList, constBlack]};
$skip => {
t1: Pair ~ NarrowToPair[p.cdr];
subCar: RuleSpec ~ Compile[context, recNT, recBC, depth, t1.car, tsx];
subCdr: RuleSpec ~ Compile[context, recNT, recBC, depth, t1.cdr, tsx];
RETURN [at[me, pairTest, subCdr.tc, subCar.tc], ae[me, skipEmit, subCdr.ec], subCdr.ntv, subCdr.bcv]};
$insert => {str: String ~ TheString[Scheme.Car[p.cdr]];
t1: Pair ~ NarrowToPair[Scheme.Cdr[p.cdr]]; y: Any ~ t1.car;
rsy: RuleSpec ~ Compile[context, recNT, recBC, depth, y, tsx];
RETURN [rsy.tc, ae[me, insertEmit, rsy.ec, RopeFromString[str]], rsy.ntv, constWhite]};
ENDCASE => NULL;
ENDCASE => NULL;
{subCar: RuleSpec ~ Compile[context, constForm, recBC, depth, p.car, tsx];
subCdr: RuleSpec ~ Compile[context, constList, recBC, depth, p.cdr, tsx];
IF tsx THEN {
Unify[subCar.ntv, constForm];
Unify[subCdr.ntv, constList];
Unify[subCdr.bcv, constWhite]};
RETURN [at[me, pairTest, subCdr.tc, subCar.tc], ae[me, pairEmit, subCdr.ec, subCar.ec], constList, subCar.bcv]}};
ENDCASE => ERROR;
};

CompileBreak: PROC [context: ATOM, recNT, recBC: SCVar, depth: INT, cond: UB.XBreakCondition, sia: BOOL, p: Pair, tsx: BOOL] RETURNS [TestClosure, EmitClosure, SCVar, SCVar] ~ {
bms: REF BreakMetaSpec ¬ NEW [BreakMetaSpec ¬ [cond, sia]];
rest: RuleSpec ~ Compile[context, recNT, recBC, depth, p.cdr, tsx];
RETURN [rest.tc, ae[p, breakEmit, rest.ec, bms], rest.ntv, constWhite]};

Unify: PROC [a, b: SCVar] ~ {
IF a.defined AND a.free OR b.defined AND b.free THEN RETURN;
IF b.defined AND NOT a.defined THEN {c: SCVar ~ a; a ¬ b; b ¬ c};
IF NOT a.defined THEN {
ura: SCVar ~ Ur[a];
urb: SCVar ~ Ur[b];
IF b.defined THEN ERROR;
IF ura = urb THEN RETURN;
IF debugRules THEN SimpleFeedback.PutFL[$SchemePretty, oneLiner, $DebugRules, "Unify[%g, %g]", LIST[ [rope[Descr[a]]], [rope[Descr[b]]] ]];
urb.ur ¬ ura;
IF a.un=NIL
THEN IF b.un=NIL
THEN {a.un ¬ b; b.un ¬ a}
ELSE {a.un ¬ b.un; b.un ¬ a}
ELSE IF b.un=NIL
THEN {b.un ¬ a.un; a.un ¬ b}
ELSE {c: SCVar ~ a.un; a.un ¬ b.un; b.un ¬ c};
RETURN};
IF NOT b.defined THEN {
c: SCVar ¬ b;
IF debugRules THEN SimpleFeedback.PutFL[$SchemePretty, oneLiner, $DebugRules, "%g _ %g", LIST[ [rope[Descr[b]]], [rope[Descr[a]]] ]];
DO d: SCVar ¬ c.un;
c.defined ¬ TRUE; c.val ¬ a.val;
c.un ¬ c.ur ¬ NIL; c ¬ d;
IF c=b OR c=NIL THEN EXIT;
ENDLOOP;
RETURN};
IF a.val # b.val THEN Complain[NIL, IO.PutFR["static inconsistency in rules (%g # %g)", [rope[Descr[a]]], [rope[Descr[b]]] ]];
RETURN};

Ur: PROC [ntv: SCVar] RETURNS [SCVar] ~ {
IF ntv.ur=NIL OR ntv.ur=ntv THEN RETURN [ntv];
ntv.ur ¬ Ur[ntv.ur];
RETURN [ntv.ur]};

Descr: PROC [scv: SCVar] RETURNS [ROPE] ~ {
IF scv.un=NIL THEN RETURN [scv.descr];
{ans: ROPE ¬ scv.descr.Concat["("];
FOR t: SCVar ¬ scv.un, t.un WHILE t#scv DO
ans ¬ ans.Cat["=", t.descr];
ENDLOOP;
RETURN [ans.Concat[")"]]}};

GetCtxNtv: PROC [ctx: Symbol] RETURNS [SCVar]
~ {RETURN [GetCtxStuff[ctx].ntv]};

GetCtxBcv: PROC [ctx: Symbol] RETURNS [SCVar]
~ {RETURN [GetCtxStuff[ctx].bcv]};

GetCtxStuff: PROC [ctx: Symbol] RETURNS [cs: CtxStuff] ~ {
cs ¬ NARROW[rules.Fetch[ctx].val];
IF cs=NIL THEN IF NOT rules.Insert[ctx, cs ¬ NEW [CtxStuffPrivate ¬ [
ntv: NEW [SCCell ¬ [Rope.Concat[Atom.GetPName[ctx], ".NT"] ]],
bcv: NEW [SCCell ¬ [Rope.Concat[Atom.GetPName[ctx], ".BC"] ]]
]]] THEN ERROR;
RETURN};

NarrowToSymbol: PROC [a: Any] RETURNS [Symbol] ~ {
WITH a SELECT FROM
x: Symbol => RETURN [x];
ENDCASE => ERROR Complain[a, "not a symbol"]};

NarrowToPair: PROC [a: Any] RETURNS [Pair] ~ {
WITH a SELECT FROM
x: Pair => RETURN [x];
ENDCASE => ERROR Complain[a, "not a pair"]};

LogTest: PROC [pps: PPState, rule, subject: Any] ~ {
IF pps.log#NIL THEN {
srcIdx: INT ~ SeekSrc[pps, subject, noIdx];
pps.log.PutRope["Test "];
Scheme.Print[rule, pps.log];
pps.log.PutRope[" "];
InfoPrint[pps.log, subject];
pps.log.PutRope[FmtIdx[srcIdx]];
pps.log.PutRope["\n"]};
};

commentTest: TestProc ~ {
ct: REF CommentTest ~ NARROW[tc.data];
LogTest[pps, tc.rule, subject];
WITH subject SELECT FROM
ctd: Commented => {
IF ctd.prefix.length#0 AND ct.noPre THEN RETURN [FALSE];
IF ctd.postfix.length#0 AND ct.noPost THEN RETURN [FALSE]};
ENDCASE => NULL;
RETURN tc.rest.test[subject, pps, tc.rest]};

emptyTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
RETURN [subject = emptyList]};

emptyEmit: EmitProc ~ {RETURN ESPop[pps, es]};

anyTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
RETURN [TRUE]};

neverMatchTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
RETURN [FALSE]};

EmitByEnter: EmitProc ~ {RETURN EntrySearch[pps, subject, context, depth, steplen.SUCC, srcIdx, es]};

EmitByEnterContext: EmitProc ~ {RETURN EntrySearch[pps, subject, NARROW[ec.data], depth, steplen.SUCC, srcIdx, es]};

leafTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
RETURN IsLeaf[subject]};

EmitDirectly: EmitProc ~ {
WITH subject SELECT FROM
x: FakeAtom => EmitRope[pps, x];
s: Symbol => EmitRope[pps, Atom.GetPName[s]];
ENDCASE => {Flush[pps]; Print[subject, pps.to]; pps.do0 ¬ NOT (pps.wantSep ¬ TRUE)};
RETURN ESPop[pps, es]};

EmitDefinee: EmitProc ~ {
WITH subject SELECT FROM
x: FakeAtom => EmitRope[pps, x, defLooks, defUnlooks];
s: Symbol => EmitRope[pps, Atom.GetPName[s], defLooks, defUnlooks];
ENDCASE => PrintWithLooks[pps, subject, defLooks, defUnlooks];
RETURN ESPop[pps, es]};

EmitArgument: EmitProc ~ {
WITH subject SELECT FROM
x: FakeAtom => EmitRope[pps, x, argLooks, argUnlooks];
s: Symbol => EmitRope[pps, Atom.GetPName[s], argLooks, argUnlooks];
ENDCASE => PrintWithLooks[pps, subject, argLooks, argUnlooks];
RETURN ESPop[pps, es]};

atomTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
RETURN Atomic[subject, pps.how, TRUE]};

simpleTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
RETURN [Classify[subject, pps.how] < complex]};

complexTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
RETURN [Classify[subject, pps.how] = complex]};

EmitByEnterContextAndDepth: EmitProc ~ {
cd: REF CD ~ NARROW[ec.data];
RETURN EntrySearch[pps, subject, cd.context, cd.depth, steplen.SUCC, srcIdx, es]};

EmitByEnterContextAndDelta: EmitProc ~ {
cd: REF CD ~ NARROW[ec.data];
RETURN EntrySearch[pps, subject, cd.context, depth+cd.depth, steplen.SUCC, srcIdx, es]};

obEmit: EmitProc ~ {
EmitObj[pps, TRUE];
es ¬ ESPush[pps, [closeObjAndNaught, emptyList, context, depth, steplen.SUCC, srcIdx], es];
RETURN [[ec.rest, subject, context, depth, steplen.SUCC, srcIdx], es]};

bobEmit: EmitProc ~ {
EmitObj[pps, TRUE];
RETURN [[ec.rest, subject, context, depth, steplen.SUCC, srcIdx], es]};

eobEmit: EmitProc ~ {
EmitObj[pps, FALSE];
RETURN [[ec.rest, subject, context, depth, steplen.SUCC, srcIdx], es]};

cobEmit: EmitProc ~ {
EmitObj[pps, FALSE];
RETURN ESPop[pps, es]};

listTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
subject ¬ StripComment[subject];
IF subject#emptyList THEN WITH subject SELECT FROM
p: Pair => NULL;
ENDCASE => RETURN [FALSE];
RETURN tc.rest.test[subject, pps, tc.rest]};

striplistEmit: EmitProc ~ {
RETURN [[ec.rest, subject, context, depth, steplen.SUCC, srcIdx], es]};

lbEmit: EmitProc ~ {
EmitRope[pps, "("];
es ¬ ESPush[pps, [closeParen, NIL, context, depth, steplen.SUCC, srcIdx], es];
RETURN [[ec.rest, subject, context, depth, steplen.SUCC, srcIdx], es]};

lobEmit: EmitProc ~ {
EmitRope[pps, "("];
EmitObj[pps, TRUE];
es ¬ ESPush[pps, [closeObjAndParen, NIL, context, depth, steplen.SUCC, srcIdx], es];
RETURN [[ec.rest, subject, context, depth, steplen.SUCC, srcIdx], es]};

clobEmit: EmitProc ~ {
EmitObj[pps, FALSE];
EmitRope[pps, ")"];
RETURN ESPop[pps, es]};

vpTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
subject ¬ StripComment[subject];
WITH subject SELECT FROM
vl: VectorAsList => RETURN tc.rest.test[vl.list, pps, tc.rest];
ENDCASE => RETURN [FALSE]};

vpEmit: EmitProc ~ {
WITH subject SELECT FROM
vl: VectorAsList => {
EmitRope[pps, "#"];
RETURN [[ec.rest, vl.list, context, depth, 0, SeekSrc[pps, subject, srcIdx]], es]};
ENDCASE => ERROR Complain[subject, IO.PutFR1["trying to emit non-vector%g like vector (rule bug?)", [rope[FmtIdx[srcIdx]]]]]};

quoteTest: TestProc ~ {
p: Any ~ tc.data;
s: Any ~ StripComment[subject];
LogTest[pps, tc.rule, subject];
WITH p SELECT FROM
px: Symbol => RETURN [s=px];
px: String => WITH s SELECT FROM
r: ROPE => RETURN [r.Length[]>0 AND r.Fetch[0]='"];
sx: String => RETURN RopeFromString[px].Equal[RopeFromString[sx]];
ENDCASE => RETURN [FALSE];
ENDCASE => ERROR};

quoteEmit: EmitProc ~ {
WITH subject SELECT FROM
aSymbol: Symbol => {
EmitRope[pps, Atom.GetPName[aSymbol], kwdLooks, kwdUnlooks];
RETURN ESPop[pps, es]};
aString: ROPE => {
EmitRope[pps, aString, kwdLooks, kwdUnlooks];
RETURN ESPop[pps, es]};
aString: String => {
PrintWithLooks[pps, aString, kwdLooks, kwdUnlooks];
RETURN ESPop[pps, es]};
ENDCASE => ERROR Complain[subject, IO.PutFR1["trying to emit non-symbol%g like symbol (rule bug?)", [rope[FmtIdx[srcIdx]]]]]};

quasiquoteEmit: EmitProc ~ {
WITH subject SELECT FROM
aSymbol: Symbol => {
EmitRope[pps, Atom.GetPName[aSymbol]];
RETURN ESPop[pps, es]};
ENDCASE => ERROR Complain[subject, IO.PutFR1["trying to emit non-symbol%g like symbol (rule bug?)", [rope[FmtIdx[srcIdx]]]]]};

orTest: TestProc ~ {
rsl: RuleSpecList ~ NARROW[tc.data];
found: BOOL; rs: RuleSpec;
LogTest[pps, tc.rule, subject];
[found, rs] ¬ Seek[rsl, subject, pps];
RETURN [found]};

orEmit: EmitProc ~ {
rsl: RuleSpecList ~ NARROW[ec.data];
found: BOOL; rs: RuleSpec;
[found, rs] ¬ Seek[rsl, subject, pps];
IF NOT found THEN ERROR--we shouldn't get here unless Seek already found it in Test--;
RETURN [[rs.ec, subject, context, depth, steplen.SUCC, srcIdx], es]};

breakEmit: EmitProc ~ {
bms: REF BreakMetaSpec ~ NARROW[ec.data];
EmitBreak[pps, bms.cond, IF bms.sia THEN pps.how.sia ELSE 0, " "];
RETURN [[ec.rest, subject, context, depth, steplen.SUCC, srcIdx], es]};

pairTest: TestProc ~ {
LogTest[pps, tc.rule, subject];
subject ¬ StripComment[subject];
WITH subject SELECT FROM
q: Pair => {
car: TestClosure ~ NARROW[tc.data];
IF NOT car.test[q.car, pps, car] THEN RETURN [FALSE];
{tail: Any ~ IF q.cdr#emptyList
THEN WITH q.cdr SELECT FROM x: Pair => x, ENDCASE => Cons[q.cdr, emptyList]
ELSE emptyList;
RETURN tc.rest.test[tail, pps, tc.rest]}};
ENDCASE => RETURN [FALSE]};

pairEmit: EmitProc ~ {
car: EmitClosure ~ NARROW[ec.data];
WITH subject SELECT FROM
q: Pair => {
cdrIdx: INT ~ SeekSrc[pps, q.cdr, srcIdx];
carIdx: INT ~ SeekSrc[pps, q.car, srcIdx];
IF q.cdr=emptyList THEN es ¬ ESPush[pps, [ec.rest, q.cdr, context, depth, 0, cdrIdx], es]
ELSE WITH q.cdr SELECT FROM
x: Pair => es ¬ ESPush[pps, [ec.rest, x, context, depth, 0, cdrIdx], es];
ENDCASE => {tail: Pair ~ Cons[q.cdr, emptyList];
es ¬ ESPush[pps, [ec.rest, tail, context, depth, steplen.SUCC--not quite right, but it catches another kind of bug--, cdrIdx], es];
es ¬ ESPush[pps, [improperTailIntroEC, NIL, context, depth, steplen.SUCC, cdrIdx], es]};
RETURN [[car, q.car, context, depth, 0, carIdx], es]};
ENDCASE => ERROR Complain[subject, IO.PutFR1["trying to emit non-pair%g like pair (rule bug?)", [rope[FmtIdx[srcIdx]]]]]};

ropeEmit: EmitProc ~ {
rope: ROPE ~ NARROW[ec.data];
EmitRope[pps, rope];
RETURN ESPop[pps, es]};

kwdRopeEmit: EmitProc ~ {
rope: ROPE ~ NARROW[ec.data];
EmitRope[pps, rope, kwdLooks, kwdUnlooks];
RETURN ESPop[pps, es]};

rmEmit: EmitProc ~ {
rope: ROPE ~ NARROW[ec.data];
EmitRope[pps, rope];
WITH subject SELECT FROM
p1: Pair => WITH p1.cdr SELECT FROM
p2: Pair => IF p2.cdr = emptyList
THEN RETURN [[ec.rest, p2.car, context, depth, 0, srcIdx], es];
ENDCASE => NULL;
ENDCASE => NULL;
Complain[subject, IO.PutFR1["trying to emit non-reader-macro%g like (quote form) - rule bug?", [rope[FmtIdx[srcIdx]]] ]]};

insertEmit: EmitProc ~ {
rope: ROPE ~ NARROW[ec.data];
EmitRope[pps, rope];
RETURN [[ec.rest, subject, context, depth, 0, srcIdx], es]};

skipEmit: EmitProc ~ {
WITH subject SELECT FROM
p: Pair => RETURN [[ec.rest, p.cdr, context, depth, 0, srcIdx], es];
ENDCASE => Complain[subject, IO.PutFR1["trying to emit non-pair%g via skip - rule bug?", [rope[FmtIdx[srcIdx]]] ]]};

dfEmit: EmitProc ~ {
BufferRope[pps, ".", NIL, NIL, TRUE];
RETURN [[ec.rest, subject, context, depth, steplen.SUCC, srcIdx], es]};

improperTailIntroEmit: EmitProc ~ {
BufferRope[pps, ".", NIL, NIL, TRUE];
RETURN ESPop[pps, es]};

commentsEmit: EmitProc ~ {
v: Vector ~ NARROW[subject];
Emitfix[pps, v];
RETURN ESPop[pps, es]};

stopEmit: EmitProc ~ {ERROR--shouldn't ever be called--};

Seek: PROC [rsl: RuleSpecList, subject: Any, pps: PPState] RETURNS [found: BOOL, rs: RuleSpec] ~ {
DO
IF rsl=NIL THEN RETURN [FALSE, noRule];
IF rsl.first.tc.test[subject, pps, rsl.first.tc] THEN RETURN [TRUE, rsl.first];
rsl ¬ rsl.rest;
ENDLOOP};

EnterEmit: PROC [pps: PPState, subject: Any, context: ATOM, depth, steplen: INTEGER] ~ {
sf0: EmitStackFrame;
srcIdx: INT ~ SeekSrc[pps, subject, 0];
es: EmitStack ¬ ESPush[pps, [stop, NIL, NIL, 0, 0, INT.LAST.PRED], NIL];
[sf0, es] ¬ EntrySearch[pps, subject, context, depth, steplen, srcIdx, es];
Emit[pps, sf0, es !
UB.BogusInput => Complain[NIL, IO.PutFR["Internal error%g (rules ok?) %g", [rope[FmtIdx[pps.srcIdx]]], [rope[msg]] ]]
];
RETURN};

EntrySearch: PROC [pps: PPState, subject: Any, context: ATOM, depth, steplen: INTEGER, srcIdx: INT, es: EmitStack] RETURNS [EmitStackFrame, EmitStack] ~ {
cs: CtxStuff ¬ NARROW[pps.rules.Fetch[context].val];
rsl: RuleSpecList ¬ cs.rsHead;
defaultsTried: BOOL ¬ FALSE;
WITH subject SELECT FROM
ctd: Commented => {
IF ctd.nonComment # endOfFile THEN {tmp: EmitStackFrame;
IF ctd.postfix.length#0 THEN es ¬ ESPush[pps, [commentsEC, ctd.postfix, context, depth, steplen.SUCC, srcIdx], es];
[tmp, es] ¬ EntrySearch[pps, ctd.nonComment, context, depth, 0, SeekSrc[pps, ctd.nonComment, srcIdx], es];
es ¬ ESPush[pps, tmp, es]};
RETURN [[commentsEC, ctd.prefix, context, depth, steplen.SUCC, srcIdx], es]};
ENDCASE => NULL;
DO
IF rsl=NIL THEN {
IF defaultsTried THEN ERROR Complain[NIL, IO.PutFR1["default rules couldn't handle %g", [rope[FmtInfo[subject]]] ]];
defaultsTried ¬ TRUE;
IF NOT cs.ntv.defined THEN ERROR;
rsl ¬ (SELECT cs.ntv.val FROM constForm.val => pps.formDefaultRules, constList.val => pps.listDefaultRules, ENDCASE => ERROR).rsHead;
LOOP};
IF rsl.first.depth = depth OR rsl.first.depth = anyDepth THEN {
IF rsl.first.tc.test[subject, pps, rsl.first.tc] THEN RETURN [[rsl.first.ec, subject, context, depth, steplen.SUCC, srcIdx], es];
};
rsl ¬ rsl.rest;
ENDLOOP;
};

Emit: PROC [pps: PPState, esf: EmitStackFrame, es: EmitStack] ~ {
WHILE esf.ec.emit # stopEmit DO
Process.CheckForAbort[];
IF pps.quit­ THEN ERROR ABORTED;
IF esf.steplen > pps.steplenLimit THEN Complain[NIL, IO.PutFLR["took more than %g steps to format %g (currently at rule %g in %g %g) - suspect rules or internal bug", LIST[ [integer[pps.steplenLimit]], [rope[FmtInfo[esf.subject]]], [rope[FmtScheme[esf.ec.rule]]], [atom[esf.context]], [integer[esf.depth]] ]]];
pps.srcIdx ¬ esf.srcIdx;
IF pps.log#NIL THEN {pps.log.PutRope["Emit "]; Scheme.Print[esf.ec.rule, pps.log]; pps.log.PutRope[" "]; InfoPrint[pps.log, esf.subject]; pps.log.PutF[" %g %g %g\n", [atom[esf.context]], [integer[esf.depth]], [integer[esf.srcIdx]] ]};
WITH esf.subject SELECT FROM
ctd: Commented => {
IF ctd.postfix.length#0 THEN es ¬ ESPush[pps, [commentsEC, ctd.postfix, esf.context, esf.depth, esf.steplen.SUCC, esf.srcIdx], es];
Emitfix[pps, ctd.prefix];
IF ctd.nonComment = endOfFile
THEN [esf, es] ¬ ESPop[pps, es]
ELSE esf ¬ [esf.ec, ctd.nonComment, esf.context, esf.depth, 0, SeekSrc[pps, ctd.nonComment, esf.srcIdx]];
};
ENDCASE => [esf, es] ¬ esf.ec.emit[pps, esf.ec, esf.subject, esf.context, esf.depth, esf.steplen, esf.srcIdx, es];
ENDLOOP;
RETURN};

SeekSrc: PROC [pps: PPState, form: Any, default: INT] RETURNS [INT] ~ {
found: BOOL; new: INT;
IF pps.posns=NIL THEN RETURN [default];
[found, new] ¬ pps.posns.Fetch[LOOPHOLE[form]];
IF found THEN RETURN [new];
RETURN [default]};

Emitfix: PROC [pps: PPState, v: Vector] ~ {
FOR i: INT IN [0 .. v.length) DO
elt: Any ~ VectorRef[v, i];
WITH elt SELECT FROM
lbs: Linebreaks => FOR j: INT IN [1 .. lbs.num] DO
BufferRope[pps, "\n"];
ENDLOOP;
c: Comment => BufferRope[pps, c, "c", "C"];
cn: CommentNode => BufferCommentNode[pps, cn];
ENDCASE => ERROR;
ENDLOOP;
RETURN};

BufferCommentNode: PROC [pps: PPState, cn: CommentNode] ~ {
this: BuffList ~ NEW [BuffCons ¬ [NIL, line[NIL, NIL, NIL, TRUE, FALSE, cn]]];
IF pps.buffTail=NIL THEN pps.buffHead ¬ pps.buffTail ¬ this
ELSE pps.buffTail ¬ pps.buffTail.rest ¬ this;
pps.bufferedLineWithBreak ¬ TRUE};

BufferRope: PROC [pps: PPState, r: ROPE, looks, unlooks: ROPE ¬ NIL, space: BOOL ¬ FALSE] ~ {
lm1: INT ~ r.Length[]-1;
lc: CHAR ~ r.Fetch[lm1];
brk: BOOL ~ lc='\r OR lc='\l OR lc='\n;
this: BuffList ~ NEW [BuffCons ¬ [NIL,
line[IF brk THEN r.Substr[len: lm1] ELSE r, looks, unlooks, brk, space, NIL]]];
IF pps.buffTail=NIL THEN pps.buffHead ¬ pps.buffTail ¬ this
ELSE pps.buffTail ¬ pps.buffTail.rest ¬ this;
pps.bufferedLineWithBreak ¬ pps.bufferedLineWithBreak OR brk};

EmitRope: PROC [pps: PPState, r: ROPE, looks, unlooks: ROPE ¬ NIL] ~ {
Flush[pps];
IF looks#NIL THEN pps.to.PutF1["%l", [rope[looks]]];
pps.to.PutRope[r];
IF looks#NIL THEN pps.to.PutF1["%l", [rope[unlooks]]];
pps.do0 ¬ FALSE; pps.wantSep ¬ TRUE};

PrintWithLooks: PROC [pps: PPState, a: Any, looks, unlooks: ROPE] ~ {
Flush[pps];
IF looks#NIL THEN pps.to.PutF1["%l", [rope[looks]]];
Print[a, pps.to];
IF looks#NIL THEN pps.to.PutF1["%l", [rope[unlooks]]];
pps.do0 ¬ FALSE; pps.wantSep ¬ TRUE};

EmitBreak: PROC [pps: PPState, cond: UB.XBreakCondition, offset: INTEGER, sep: ROPE] ~ {
this: BuffList ~ NEW [BuffCons ¬ [NIL, break[cond, offset, sep]]];
IF pps.buffTail=NIL THEN pps.buffHead ¬ this ELSE pps.buffTail.rest ¬ this;
pps.buffTail ¬ this;
RETURN};

EmitObj: PROC [pps: PPState, begin: BOOL] ~ {
this: BuffList ~ NEW [BuffCons ¬ [NIL, obj[begin]]];
pps.buffTail ¬ (IF pps.buffTail=NIL THEN pps.buffHead ¬ this ELSE pps.buffTail.rest ¬ this);
RETURN};

FindOffset: PROC [pps: PPState, from: BuffList] RETURNS [offset: INT] ~ {
offset ¬ <<IF pps.do0 THEN 0 ELSE pps.how.sia>>0;
FOR bl: BuffList ¬ from, bl.rest WHILE bl#NIL DO
WITH bl SELECT FROM
x: BuffdBreak => {offset ¬ x.offset; EXIT};
x: BuffdObj => EXIT;
ENDCASE => NULL;
ENDLOOP;
RETURN};

Flush: PROC [pps: PPState] ~ {
IF pps.bufferedLineWithBreak THEN {
offset: INT ¬ FindOffset[pps, pps.buffHead];
WHILE pps.buffHead#NIL DO
WITH pps.buffHead SELECT FROM
x: BuffdLine => {
IF x.node#NIL THEN {
IF pps.wantSep THEN Complain[NIL, "SchemePretty bug: comment node doesn't begin on new line"];
PutNode[pps.to, x.node, offset]}
ELSE IF x.chars.Length[]#0 THEN {
IF pps.wantSep THEN pps.to.PutChar[' ] ELSE pps.wantSep ¬ TRUE;
IF x.looks#NIL THEN pps.to.PutF1["%l", [rope[x.looks]]];
pps.to.PutRope[x.chars];
IF x.looks#NIL THEN pps.to.PutF1["%l", [rope[x.unlooks]]];
IF x.space THEN {pps.to.PutChar[' ]; pps.wantSep ¬ FALSE};
};
IF x.break AND x.node=NIL --PutNode outputs the break-- THEN {
SS.XBp[pps.to, always, offset, " "];
pps.wantSep ¬ FALSE};
};
x: BuffdBreak => {
FOR l: BuffList ¬ pps.buffHead.rest, l.rest WHILE l#NIL DO
WITH l SELECT FROM
y: BuffdLine => {
IF y.node#NIL OR y.chars.Length[]#0 THEN EXIT;
IF y.break THEN {
SS.XBp[pps.to, always, offset, " "];
pps.wantSep ¬ y.break ¬ FALSE;
EXIT};
};
ENDCASE => NULL;
ENDLOOP;
};
x: BuffdObj => {
(IF x.begin THEN SS.Begin ELSE SS.End)[pps.to];
pps.do0 ¬ x.begin;
offset ¬ FindOffset[pps, pps.buffHead.rest]};
ENDCASE => ERROR;
pps.buffHead ¬ pps.buffHead.rest;
ENDLOOP;
pps.buffTail ¬ NIL;
pps.bufferedLineWithBreak ¬ FALSE}
ELSE {
WHILE pps.buffHead#NIL DO
WITH pps.buffHead SELECT FROM
x: BuffdLine => {
IF x.node#NIL THEN ERROR;
IF x.chars.Length[]=0 THEN ERROR;
IF x.break THEN ERROR;
IF pps.wantSep THEN pps.to.PutChar[' ] ELSE pps.wantSep ¬ TRUE;
IF x.looks#NIL THEN pps.to.PutF1["%l", [rope[x.looks]]];
pps.to.PutRope[x.chars];
IF x.looks#NIL THEN pps.to.PutF1["%l", [rope[x.unlooks]]];
IF x.space THEN {pps.to.PutChar[' ]; pps.wantSep ¬ FALSE};
pps.do0 ¬ FALSE};
x: BuffdBreak => {pps.wantSep ¬ FALSE; SS.XBp[pps.to, x.cond, x.offset, x.sep]};
x: BuffdObj => {(IF x.begin THEN SS.Begin ELSE SS.End)[pps.to]; pps.do0 ¬ x.begin};
ENDCASE => ERROR;
pps.buffHead ¬ pps.buffHead.rest;
ENDLOOP;
pps.buffTail ¬ NIL};
RETURN};

PutNode: PROC [to: IO.STREAM, n: TextNode.Ref, offset: INT] ~ {
r: ROPE ~ TextEditBogus.GetRope[n];
to.PutRope[r];
to.PutF1["%n", [boolean[TRUE]] ];
SS.XBp[to, always, offset, " "];
to.PutF1["%n", [boolean[FALSE]] ];
RETURN};

ESPush: PROC [pps: PPState, esf: EmitStackFrame, es: EmitStack] RETURNS [nes: EmitStack] ~ {
IF pps.emitFree=NIL THEN pps.emitFree ¬ LIST[[noEmit, NIL, NIL, 0, 0, 0]];
nes ¬ pps.emitFree;
pps.emitFree ¬ nes.rest;
nes.first ¬ esf;
nes.rest ¬ es;
RETURN};

ESPop: PROC [pps: PPState, es: EmitStack] RETURNS [esf: EmitStackFrame, nes: EmitStack] ~ {
esf ¬ es.first;
nes ¬ es.rest;
es.rest ¬ pps.emitFree;
pps.emitFree ¬ es;
RETURN};

Classify: PROC [val: Any, how: How, mayCo: BOOL ¬ TRUE] RETURNS [Classification] ~ {
IF val=emptyList THEN RETURN [simple];
WITH val SELECT FROM
p: Pair => {
len: Nat ¬ 1;
car: Any ¬ p.car;
rest: Any ¬ p.cdr;
IF how.simpleQuote AND IsQuote[car]
THEN WITH rest SELECT FROM
q: Pair => IF q.cdr=NIL THEN RETURN [MAX[Classify[q.car, how, FALSE], atom]];
ENDCASE => len ¬ len;
DO
IF len>how.simpleLen THEN RETURN [complex];
IF NOT Atomic[car, how, FALSE] THEN RETURN [complex];
IF rest=NIL THEN RETURN [simple];
WITH rest SELECT FROM
q: Pair => {car ¬ q.car; rest ¬ q.cdr; len ¬ len.SUCC};
ENDCASE => RETURN [IF len<how.simpleLen AND Atomic[rest, how, FALSE] THEN simple ELSE complex];
ENDLOOP};
v: Vector => {
IF v.length > how.simpleLen THEN RETURN [complex];
FOR i: INT IN [0 .. v.length) DO
elt: Any ~ v.ref[v, i];
IF NOT Atomic[elt, how, FALSE] THEN RETURN [complex];
ENDLOOP;
RETURN [simple]};
sv: SimpleVector => {
IF sv.length > how.simpleLen THEN RETURN [complex];
FOR i: NAT IN [0 .. sv.length) DO
elt: Any ~ sv[i];
IF NOT Atomic[elt, how, FALSE] THEN RETURN [complex];
ENDLOOP;
RETURN [simple]};
vl: VectorAsList => RETURN Classify[vl.list, how];
ctd: Commented => IF mayCo AND CommentlessLeaf[ctd.nonComment] THEN RETURN [leaf] ELSE RETURN [complex];
ENDCASE => RETURN [leaf]};

Atomic: PROC [val: Any, how: How, mayCo: BOOL] RETURNS [BOOL] ~ INLINE {
WITH val SELECT FROM
ctd: Commented => RETURN [mayCo AND CommentlessLeaf[ctd.nonComment]];
ENDCASE => NULL;
IF val=emptyList THEN RETURN [FALSE];
WITH val SELECT FROM
p: Pair => IF how.simpleQuote AND IsQuote[p.car]
THEN WITH p.cdr SELECT FROM
q: Pair => RETURN [q.cdr=NIL AND CommentlessLeaf[q.car]];
ENDCASE => RETURN [FALSE]
ELSE RETURN [FALSE];
sv: Vector => RETURN [FALSE];
v: Vector => RETURN [FALSE];
vl: VectorAsList => RETURN [FALSE];
ENDCASE => RETURN [TRUE]};

IsLeaf: PROC [val: Any] RETURNS [BOOL] ~ INLINE {
WITH val SELECT FROM
ctd: Commented => RETURN CommentlessLeaf[ctd.nonComment];
ENDCASE => RETURN CommentlessLeaf[val]};

CommentlessLeaf: PROC [val: Any] RETURNS [BOOL] ~ INLINE {
IF val=emptyList THEN RETURN [FALSE];
WITH val SELECT FROM
p: Pair => RETURN [FALSE];
ctd: Commented => RETURN [FALSE];
sv: Vector => RETURN [FALSE];
v: Vector => RETURN [FALSE];
vl: VectorAsList => RETURN [FALSE];
ENDCASE => RETURN [TRUE]};

IsQuote: PROC [val: Any] RETURNS [BOOL] ~ INLINE {
RETURN [val=$quote OR val=$quasiquote]};

StripComment: PROC [val: Any] RETURNS [Any] ~ {
WITH val SELECT FROM
ctd: Commented => RETURN [ctd.nonComment];
ENDCASE => RETURN [val]};

ReadRulesFromFile: PROC [name: PFS.PATH, errlog: IO.STREAM] ~ {
from: IO.STREAM ~ PFS.StreamOpen[name];
ReadRulesFromStream[from, errlog];
from.Close[];
RETURN};

ReadRulesFromStream: PROC [from, errlog: IO.STREAM] ~ {
InnerReadRules[from, errlog !
Complain => {
errlog.PutRope[msg];
errlog.PutRope[" while reading rules.\n"];
rules.Erase[];
formDefaultRules ¬ listDefaultRules ¬ NIL;
CONTINUE}];
RETURN};

InnerReadRules: PROC [from, errlog: IO.STREAM] ~ {--some implementations of Mesa signals aren't quite correct
rules.Erase[];
formDefaultRules ¬ listDefaultRules ¬ NIL;
DO
a1: Any ¬ Scheme.Read[from];
context: ATOM;
depth: INT ¬ anyDepth;
this: RuleSpecList ¬ NIL;
rule: Any;
cs: CtxStuff;
IF a1 = endOfFile THEN EXIT;
WITH a1 SELECT FROM
s: Symbol => context ¬ s;
ENDCASE => {t1: Any ~ Cdr[a1];
context ¬ NarrowToSymbol[Scheme.Car[a1]];
depth ¬ TheINT[Scheme.Car[t1]]};
cs ¬ GetCtxStuff[context];
rule ¬ Scheme.Read[from];
{ENABLE Complain => {
errlog.PutF1["%g while compiling rule ", [rope[msg]] ];
IF depth#anyDepth THEN errlog.PutF1["%g ", [integer[depth]] ];
errlog.PutF["%g %g\n", [atom[context]], [rope[FmtScheme[rule]]] ];
GOTO AbortRules};
this ¬ LIST[Compile[context, cs.ntv, cs.bcv, depth, rule, TRUE]];
Unify[this.first.ntv, cs.ntv];
Unify[this.first.bcv, cs.bcv];
};
cs.rsTail ¬ (IF cs.rsTail#NIL THEN cs.rsTail.rest ¬ this ELSE cs.rsHead ¬ this);
cs.nRules ¬ cs.nRules.SUCC;
ENDLOOP;
IF rules.Pairs[CheckRule] THEN ERROR;
formDefaultRules ¬ NARROW[rules.Fetch[formDefault].val];
listDefaultRules ¬ NARROW[rules.Fetch[listDefault].val];
Unify[formDefaultRules.ntv, constForm];
Unify[listDefaultRules.ntv, constList];
RETURN;
EXITS AbortRules => {
rules.Erase[];
formDefaultRules ¬ listDefaultRules ¬ NIL}
};

CheckRule: PROC [key, val: REF ANY] RETURNS [quit: BOOL ¬ FALSE] ~ {
context: ATOM ~ NARROW[key];
cs: CtxStuff ~ NARROW[val];
IF NOT cs.ntv.defined THEN Complain[context, IO.PutFR1["syntactic category for context %g unclear", [atom[context]] ]];
IF NOT cs.bcv.defined THEN Complain[context, IO.PutFR1["color category for context %g unclear", [atom[context]] ]];
RETURN [FALSE]};

PrintRulesToStream: PROC [to: IO.STREAM] ~ {
PerContext: PROC [key, val: REF ANY] RETURNS [quit: BOOL ¬ FALSE] ~ {
context: ATOM ~ NARROW[key];
rsl: RuleSpecList ¬ NARROW[val];
FOR rsl: RuleSpecList ¬ NARROW[val], rsl.rest WHILE rsl#NIL DO
IF rsl.first.depth # anyDepth THEN to.PutF1["%g ", [integer[rsl.first.depth]]];
to.PutF1["%g ", [atom[context]]];
Scheme.Print[rsl.first.me, to];
to.PutRope["\n"];
ENDLOOP;
RETURN [FALSE]};
IF rules.Pairs[PerContext] THEN ERROR;
RETURN};

PrettyPrintCmd: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] --Commander.CommandProc-- ~ {
Car: PROC [a: Any] RETURNS [Any] ~ {
WITH a SELECT FROM
p: Pair => RETURN[p.car];
ENDCASE => Complain[a, "spec must be of form (name val)"]};
specIn: IO.STREAM ~ IO.RIS[cmd.commandLine];
how: How ¬ defaultHow;
margin: INT ¬ defaultMargin;
barfum: ROPE ¬ NIL;
context: ATOM ¬ NARROW[cmd.procData.clientData];
debugSS: BOOL ¬ FALSE;
debugLog: IO.STREAM ¬ NIL;
msg ¬ NIL;
DO
ENABLE Complain => {
barfum ¬ Rope.Concat["Scheme err on command line: ", msg];
GOTO Abort};
spec: Any ¬ Scheme.Read[specIn];
IF spec=endOfFile THEN EXIT;
WITH spec SELECT FROM
p: Pair => SELECT p.car FROM
$margin => margin ¬ TheINT[Car[p.cdr]];
$sia => how.sia ¬ TheINT[Car[p.cdr]];
$simplelen => how.simpleLen ¬ TheINT[Car[p.cdr]];
$simplequote => how.simpleQuote ¬ True[Car[p.cdr]];
$debug => debugLog ¬ IF True[Car[p.cdr]] THEN cmd.err ELSE NIL;
$debugss => debugSS ¬ True[Car[p.cdr]];
$context => WITH Car[p.cdr] SELECT FROM
a: ATOM => context ¬ a;
ENDCASE => RETURN [$Failure, Rope.Concat["unrecognized spec: ", Fmt[spec]]];
ENDCASE => RETURN [$Failure, Rope.Concat["unrecognized spec: ", Fmt[spec]]];
ENDCASE => RETURN [$Failure, Rope.Concat["unrecognized spec: ", Fmt[spec]]];
REPEAT
Abort => RETURN [$Failure, barfum];
ENDLOOP;
{h: UB.Handle ~ UB.Create[publics: [margin: margin, output: [stream[cmd.out]]], debug: debugSS];
out: IO.STREAM ~ SS.Create[h];
cmd.out.PutF1["%l", [rope["f"]]];
DO
ENABLE {
Complain => {barfum ¬ msg; GOTO AbortRPP};
Warning => {cmd.err.PutRope[message.Concat["\n"]]; RESUME}};
arg, anc: Any;
posns: FormToSource;
[arg, anc, posns] ¬ Read[cmd.in, GetStackAddr[]];
IF arg=endOfFile THEN EXIT;
PrettyPrint[out, arg, how, context, posns, debugLog];
out.PutRope["\n"];
IF anc=endOfFile THEN EXIT;
ENDLOOP;
EXITS AbortRPP => {result ¬ $Failure; msg ¬ barfum}
};
cmd.out.PutF1["%l", [rope[" "]]];
RETURN};

ReadRulesCmd: Commander.CommandProc ~ {
ReadRulesFromStream[cmd.in, cmd.err];
RETURN};

PrintRulesCmd: Commander.CommandProc ~ {
PrintRulesToStream[cmd.out];
RETURN};

DoProfile: Commander.CommandProc ~ {NoteProfile[edit]};

Fmt: PROC [a: Any] RETURNS [ROPE] ~ {
buf: IO.STREAM ~ IO.ROS[];
Print[a, buf];
RETURN buf.RopeFromROS[]};

FmtScheme: PROC [a: Any] RETURNS [ROPE] ~ {
buf: IO.STREAM ~ IO.ROS[];
Print[a, buf !Complain => GOTO Abort];
RETURN buf.RopeFromROS[];
EXITS Abort => RETURN ["(can't print)"]};

FmtInfo: PROC [a: Any] RETURNS [ROPE] ~ {
buf: IO.STREAM ~ IO.ROS[];
InfoPrint[buf, a !Complain => GOTO Abort];
RETURN buf.RopeFromROS[];
EXITS Abort => RETURN ["(can't print)"]};

AnaLooks: PROC [raw: ROPE] RETURNS [pos, neg: ROPE] ~ {
Add: PROC [pc: CHAR] ~ {
pos ¬ pos.Concat[Rope.FromChar[pc]];
neg ¬ neg.Concat[Rope.FromChar[pc-'a+'A]]};
pos ¬ neg ¬ NIL;
FOR i: INT IN [0 .. raw.Length) DO
c: CHAR ~ raw.Fetch[i];
SELECT c FROM
IN ['a .. 'a+31] => Add[c];
IN ['A .. 'A+31] => Add[c-'A+'a];
ENDCASE => NULL;
ENDLOOP;
RETURN};

NoteProfile: PROC [reason: UserProfile.ProfileChangeReason] --UserProfile.ProfileChangedProc--~ {
profileRules: ROPE ~ UserProfile.Token["SchemePretty.rules", defaultRulesName];
defaultMargin ¬ UserProfile.Number["SchemePretty.margin", 80];
defaultHow ¬ [
sia: UserProfile.Number["SchemePretty.sia", 2],
simpleLen: UserProfile.Number["SchemePretty.simpleLen", 2],
simpleQuote: UserProfile.Boolean["SchemePretty.simpleQuote", TRUE]
];
[defLooks, defUnlooks] ¬ AnaLooks[UserProfile.Token["SchemePretty.defineeLooks", "n"]];
[argLooks, argUnlooks] ¬ AnaLooks[UserProfile.Token["SchemePretty.argumentLooks", "c"]];
[kwdLooks, kwdUnlooks] ¬ AnaLooks[UserProfile.Token["SchemePretty.keywordLooks", "k"]];
IF NOT TryRead[profileRules] THEN [] ¬ TryRead[defaultRulesName];
};
defaultRulesName: ROPE ¬ "SchemePretty.rules";

TryRead: PROC [given: ROPE] RETURNS [BOOL] ~ {
givenPath: PFS.PATH ~ ParsePath[given];
IF givenPath=NIL THEN RETURN [FALSE];
{full: PFS.PATH ~ PFS.FileSearch[givenPath, famousPath];
IF full=NIL THEN RETURN [FALSE];
{myRouter: Feedback.MsgRouter ~ Feedback.EnsureRouter[$SchemePretty];
errbuf: IO.STREAM ~ FeedbackClasses.CreateStreamOnRouter[myRouter, $RuleError];
ReadRulesFromFile[full, errbuf];
RETURN [TRUE]}}};

ParsePath: PROC [rope: ROPE] RETURNS [path: PFS.PATH] ~ {
path ¬ NIL;
path ¬ PFS.PathFromRope[rope !PFS.Error => CONTINUE];
RETURN};

FmtIdx: PROC [idx: INT] RETURNS [ROPE] ~ {
IF idx=noIdx THEN RETURN [NIL];
RETURN IO.PutFR1[" at %g", [integer[idx]]]};

GetStackAddr: PROC RETURNS [INT] ~ TRUSTED INLINE {
local: INT ¬ 3;
lp: LONG POINTER ¬ @local;
RETURN [LOOPHOLE[lp]]};

DebugRulesCmd: Commander.CommandProc ~ {
cmd.out.PutF1["SchemePrety.debugRules = %g\n", [boolean[debugRules ¬ NOT debugRules]]];
RETURN};

famousPath: LIST OF PFS.PATH ~ LIST[
PFS.GetWDir[],
PFS.PathFromRope["/PCedar/FamousFiles/"],
PFS.PathFromRope["/CedarCommon/FamousFiles/"]];

UserProfile.CallWhenProfileChanges[NoteProfile];

Commander.Register[key: "SchemePrettyPrintRules", proc: PrintRulesCmd, doc: "write rules to stdout"];
Commander.Register[key: "SchemePrettyReadRules", proc: ReadRulesCmd, doc: "read rules from stdin"];
Commander.Register[key: "SchemePrettyPrintExpr", proc: PrettyPrintCmd, doc: "Pretty prints stdin to stdout", clientData: $expr];
Commander.Register[key: "SchemePrettyPrintData", proc: PrettyPrintCmd, doc: "Pretty prints stdin to stdout", clientData: $data];
Commander.Register[key: "SchemePrettyPrintDoProfile", proc: DoProfile, doc: "do profile processing again"];
Commander.Register[key: "SchemePrettyDebugRules", proc: DebugRulesCmd, doc: "toggle rule static checking debugging"];

END.
ΈSchemeExtPrint.mesa
Copyright Σ 1992 by Xerox Corporation.  All rights reserved.
Spreitze, April 9, 1990 3:12 pm PDT
Last tweaked by Mike Spreitzer on May 12, 1992 12:59 pm PDT
Κ0Η•NewlineDelimiter

–
(cedarcode) style˜
code™Kšœ
Οe
œ1™<K™#K™;—K˜KšΟk	œEžœžœ›
˜π
K˜šΟnœžœ
ž˜Kšžœ:žœžœ€
˜Θ
Kšžœ˜K˜
—K˜Kšžœ
žœ+žœžœ˜]K˜Kšœ	žœžœ˜šœžœžœ˜Kšœžœ
˜#Kšœžœžœ
˜$Kšœ	žœžœ
˜KšœžœžœΟc˜/Kšœ!žœ
˜%Kšœžœ˜Kšœžœ	˜Kš
œ	˜	Kšœ œ
˜.Kš
œ-˜-Kš
œ˜Kšœžœ
žœ
˜Kšœ	žœ
žœ˜—K˜Kšœ
žœžœ
˜Kšœžœžœ˜%Kšœžœžœ˜'Kšœ
žœžœ˜#šœ
žœžœžœ	ž˜CKšœ žœžœ˜NKšœžœžœžœ˜@Kšœžœ˜Kšžœ˜	—K˜Kš	œžœžœžœžœ˜CK˜Kšœ
žœžœ˜%šœžœžœ˜ K˜Kšœžœ˜Kšœžœ˜$—K˜Kšœžœžœ
žœ
˜&Kšœ
žœžœ	žœI˜lK˜Kšžœžœ˜K˜Kšœžœžœ˜šœžœžœ˜Kšœžœ
˜Kšœžœžœ
˜!Kšœžœ 1˜BKšœžœ
 8˜HKš
œ˜—K˜Kš	œžœžœžœžœ˜GKšœžœžœžœ˜8Kšœžœžœžœ˜7Kšœžœžœžœ˜9Kšœžœžœžœ˜:K˜Kšœ
žœžœ˜'Kšœžœžœ6˜SKš	œ
žœžœ/žœžœ˜SK˜Kšœ
žœžœ˜'Kšœžœžœ6˜SKš
œ
žœžœ8žœžœ
žœžœ˜¬
K˜Kšœžœžœ
žœ˜)Kšœžœžœ*žœžœ
žœ˜sK˜Kšœžœ!˜5K˜Kšœ
žœžœžœ˜1Kš
žœžœžœžœ	žœ˜2K˜Kšœžœžœžœ˜IKšœžœ
˜Kšœžœ
˜Kšœ
žœžœ
žœ
˜"Kšœžœžœ
žœ
˜Kšœžœ
˜Kšœ
žœ!˜2Kšœ
žœ!˜2Kšœ
žœ˜,Kšœžœ˜(Kšœ
žœ˜-Kšœžœ˜Kš
œ.˜.Kšœ7žœ˜LKš
œ5˜5Kš
œ6˜6Kš
œQ˜QKš
œ6˜6K˜<Kšœ
žœ˜Kšœžœ˜Kšœ
žœ˜Kšœžœ˜Kšœ
žœ˜Kšœžœ˜K˜Kšœžœ˜Kš
œ$˜$Kšœ/žœ
˜3Kšœžœžœ
˜K˜šŸœžœ
žœžœ
žœžœžœžœ
žœžœžœ
žœžœ˜›
Kšœžœ’
˜΄
Kšžœ
žœ
žœžœžœžœ˜3Kšžœžœ
žœ*˜VKšœžœ˜K˜#K˜Kšžœ˜—K˜š
œžœ/žœžœ
žœžœžœ˜fKšœžœžœ-˜;—K˜š
œžœ/žœžœ
žœžœžœ˜fKšœžœžœ-˜;—K˜šŸœžœžœžœžœžœ˜iKš
œ2˜2K˜HKšžœ"˜(—K˜šŸœžœžœžœžœžœ-˜‹
Kš
žœžœ
žœ'žœžœ˜cšžœžœ
ž˜šœ
žœž˜Kšœžœ6˜DKšœ	žœA˜PKšœžœ@˜RKšœ
žœA˜TKšœ	žœ7˜FKšœžœ9˜JKšœžœ:˜LKšžœžœ.žœ"˜d—š
œ˜šžœžœ
ž˜šœžœžœž˜š
œ4˜4Kš
œ˜K˜CKšœžœ
žœžœ9˜LKšžœH˜N—š
œD˜DK˜Kš
œ"˜"Kšœžœ˜Kš	œžœ
žœžœžœ˜%Kšžœ6žœ*˜i—š
œ@˜@Kšœžœ
žœžœžœ
žœžœžœ˜9Kšžœ6žœ*˜i—˜Kš
œK˜KK˜Kšœ=žœ˜DK˜BKšžœ%˜+—˜Kš
œI˜IKš
œ%˜%Kšœ;žœ˜BKšœžœ
žœžœžœ	žœžœžœ˜8Kšžœ-žœ(˜^—š
œ&˜&šžœžœ
ž˜Kšœ
žœ
˜Kšœ
žœ
˜Kšžœžœ'˜7—Kšžœžœžœ˜V—š
œ>˜>Kšžœžœžœ˜[—˜XKšžœžœ˜(Kšžœ7žœ˜[—˜XKšžœ%žœ˜H—š
œQ˜QKšžœ&žœ˜I—š
œO˜OKšžœ&žœ˜I—˜YKšžœžœ˜(Kšžœ8žœ˜\—˜XKšžœžœ=˜HKšžœ5žœ˜Y—˜]Kšžœžœ˜(Kšžœ>žœ˜b—˜K˜Kšœžœ	˜!K˜Kšœžœ
˜šžœ"žœž˜>KšœžœA˜Zšžœžœ	ž˜KšžœB˜F—K˜4K˜$Kšžœ
˜—Kšžœ	žœ
žœ
žœ˜5Kšžœžœžœ ˜Y—Kšœžœ3žœ
˜OKšœžœ3žœ
˜NKšœžœ3žœ
˜OKšœžœ3žœ
˜NKšœžœ6žœ
˜RKšœžœ6žœ
˜QKšœžœ4žœ
˜PKšœžœ4žœ
˜OKšœžœ4žœ
˜PKšœžœ4žœ˜Pš
œ<˜<Kš
œ<˜<K˜>Kšžœžœ˜&KšžœU˜[—š
œ(˜(K˜>Kšžœžœ˜&Kšžœ'žœ˜K—˜
Kš
œ˜K˜FK˜FKšžœ`˜f—š
œ7˜7Kš
œ<˜<K˜>KšžœQ˜W—Kšžœžœ
˜—Kšžœžœ
˜—Kš
œJ˜JK˜Išžœžœ˜
Kš
œ˜Kš
œ˜Kš
œ˜—Kšžœk˜q—Kšžœžœ
˜—Kš
œ˜—K˜šŸœžœžœžœžœžœžœžœ-˜±
Kšœžœžœ˜;K˜CKšžœB˜H—K˜šŸœžœ˜Kšžœžœžœžœžœ
žœ
˜<Kšžœžœ
žœžœ˜Ašžœ
žœžœ˜K˜K˜Kšžœžœ
žœ
˜Kšžœžœ
žœ
˜KšžœžœMžœ(˜‹
K˜
šžœž˜šžœ
žœž˜Kšžœ˜Kšžœ˜—šžœ
žœž˜Kšžœ˜Kšžœ*˜.——Kšžœ˜—šžœ
žœžœ˜K˜
KšžœžœGžœ(˜…
šžœ˜Kšœžœ˜ Kšœžœ˜Kš
žœžœžœ
žœ
žœ
˜Kšžœ
˜—Kšžœ˜—Kšžœžœ
žœžœX˜~Kšžœ˜—K˜šŸœžœžœ˜)Kš
žœžœ
žœžœ
žœ˜.K˜Kšžœ˜—K˜šŸœžœžœžœ˜+Kšžœžœ
žœ
žœ
˜&Kšœžœ˜#šžœžœž˜*K˜Kšžœ
˜—Kšžœ˜—K˜šŸ	œžœžœ˜-Kšœžœ˜"—K˜šŸ	œžœžœ˜-Kšœžœ˜"—K˜šŸœžœžœ˜:Kšœžœ˜"šžœžœ
žœ
žœ
žœžœ˜EKšœžœ6˜>Kšœžœ5˜=Kšœžœ
žœ
˜—Kšžœ˜—K˜šŸœžœ
žœ
˜2šžœžœ
ž˜Kšœ
žœ˜Kšžœžœ˜.——K˜šŸœžœ
žœ˜.šžœžœ
ž˜Kšœžœ˜Kšžœžœ˜,——K˜šŸœžœ'˜4šžœ	žœ
žœ˜Kšœžœ ˜+Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜ Kš
œ˜—K˜—K˜š
œ˜Kšœžœžœ
˜&K˜šžœ	žœ
ž˜˜Kš
žœžœ
žœ
žœžœ˜8Kš
žœžœžœ
žœžœ˜;—Kšžœžœ
˜—Kšžœ&˜,—K˜š
œ˜K˜Kšžœ˜—K˜Kšœžœ˜.K˜˜K˜Kšžœžœ˜—K˜˜K˜Kšžœžœ˜—K˜KšŸœžœ3žœ˜eK˜KšŸœžœžœžœ˜tK˜˜K˜Kšžœ˜—K˜šŸœ˜šžœ	žœ
ž˜Kš
œ ˜ K˜-Kšžœ3žœžœ˜T—Kšžœ˜—K˜šŸœ˜šžœ	žœ
ž˜Kš
œ6˜6K˜CKšžœ7˜>—Kšžœ˜—K˜šŸœ˜šžœ	žœ
ž˜Kš
œ6˜6K˜CKšžœ7˜>—Kšžœ˜—K˜˜K˜Kšžœžœ˜'—K˜š
œ˜K˜Kšžœ)˜/—K˜š
œ˜K˜Kšžœ)˜/—K˜šŸœ˜(Kšœžœ
žœžœ
˜Kšžœ9žœ˜R—K˜šŸœ˜(Kšœžœ
žœžœ
˜Kšžœ?žœ˜X—K˜š
œ˜Kšœ
žœ˜KšœHžœ˜[Kšžœ-žœ˜G—K˜˜Kšœ
žœ˜Kšžœ-žœ˜G—K˜˜Kšœ
žœ˜Kšžœ-žœ˜G—K˜˜Kšœ
žœ˜Kšžœ˜—K˜˜K˜K˜ š	žœžœ
žœ	žœ
ž˜2Kšœžœ
˜Kšžœžœžœ˜—Kšžœ&˜,—K˜˜Kšžœ-žœ˜G—K˜˜K˜Kšœžœžœ˜NKšžœ-žœ˜G—K˜˜K˜Kšœ
žœ˜Kšœ$žœžœ˜TKšžœ-žœ˜G—K˜š
œ˜Kšœ
žœ˜K˜Kšžœ˜—K˜˜K˜K˜ šžœ	žœ
ž˜Kšœžœ%˜?Kšžœžœžœ˜——K˜˜šžœ	žœ
ž˜š
œ˜Kš
œ˜KšžœM˜S—KšžœžœžœY˜~——K˜˜Kš
œ˜Kš
œ˜K˜šžœžœ
ž˜Kšœžœ˜šœžœžœ
ž˜ Kšœžœžœžœ˜3Kšœžœ.˜BKšžœžœžœ˜—Kšžœžœ˜——K˜˜šžœ	žœ
ž˜š
œ˜Kš
œ<˜<Kšžœ˜—šœ	žœ˜Kš
œ-˜-Kšžœ˜—š
œ˜Kš
œ3˜3Kšžœ˜—KšžœžœžœY˜~——K˜˜šžœ	žœ
ž˜š
œ˜Kš
œ&˜&Kšžœ˜—KšžœžœžœY˜~——K˜˜Kšœžœ
˜$Kšœžœ˜K˜K˜&Kšžœ
˜—K˜˜Kšœžœ
˜$Kšœžœ˜K˜&Kš	žœ
žœžœ
ž >œ
˜VKšžœ+žœ˜E—K˜˜Kšœžœžœ
˜)Kšœžœ	žœ
žœ	˜BKšžœ-žœ˜G—K˜˜K˜K˜ šžœ	žœ
ž˜˜Kšœžœ
˜#Kš
žœ
žœžœ
žœžœ˜5šœ
žœ˜Kš
žœ
žœžœ
žœžœ˜KKšžœ˜—Kšžœ$˜*—Kšžœžœžœ˜——K˜˜Kšœžœ
˜#šžœ	žœ
ž˜š
œ˜Kšœžœ˜*Kšœžœ˜*KšžœžœB˜Yšžœ
žœžœ
ž˜K˜Išžœ)˜0Kšœ9ž 7œ˜ƒ
Kšœ'žœžœ˜X——Kšžœ0˜6—KšžœžœžœU˜z——K˜˜Kšœžœžœ
˜K˜Kšžœ˜—K˜˜Kšœžœžœ
˜K˜*Kšžœ˜—K˜š
œ˜Kšœžœžœ
˜Kš
œ˜šžœ	žœ
ž˜šœžœžœ
ž˜#šœžœ˜!Kšžœ
žœ4˜?—Kšžœžœ
˜—Kšžœžœ
˜—Kšœžœf˜z—K˜š
œ˜Kšœžœžœ
˜Kš
œ˜Kšžœ6˜<—K˜˜šžœ	žœ
ž˜Kšœžœ3˜DKšžœžœU˜t——K˜š
œ˜Kšœžœžœžœ˜%Kšžœ-žœ˜G—K˜š
œ#˜#Kšœžœžœžœ˜%Kšžœ˜—K˜š
œ˜Kšœžœ
˜K˜Kšžœ˜—K˜Kšœž œ˜9K˜šŸœžœ1žœ	žœ˜bš
ž˜Kš
žœžœ
žœ
žœžœ
˜'Kšžœ/žœ
žœžœ
˜OK˜Kšžœ˜	——K˜šŸ	œžœ'žœžœ˜XK˜Kšœžœ˜'Kš
œ#žœžœžœ
žœ
žœžœ˜HK˜K˜KšžœžœžœT˜uK˜—Kšžœ˜—K˜šŸœžœ'žœžœ
žœžœ ˜š
Kšœžœ˜4K˜Kšœžœžœ
˜šžœ	žœ
ž˜˜šžœžœ˜8KšžœžœDžœ˜sK˜jK˜—Kšžœ3žœ˜M—Kšžœžœ
˜—š
ž˜šžœžœ
žœ˜Kš
žœžœ
žœ
žœžœH˜tKšœžœ
˜Kšžœ
žœžœ
žœ
˜!Kš	œžœžœOžœžœ	˜…
Kšžœ˜—šžœžœžœ˜?Kšžœ/žœ
žœ2žœ˜
K˜—K˜Kšžœ
˜—K˜—K˜šŸœžœ7˜Ašžœž˜Kš
œ˜Kšžœžœ
žœ
žœ
˜ Kš
žœ žœ
žœžœpžœ‹
˜ΆK˜Kšžœ	žœ
žœΧ
˜κ
šžœ
žœ
ž˜˜KšžœžœPžœ˜ƒ
Kš
œ˜šžœ˜Kšžœ˜Kšžœe˜i—Kš
œ˜—Kšžœk˜r—Kšžœ
˜—Kšžœ˜—K˜š
Ÿœžœ$žœžœžœ˜GKšœžœžœ
˜Kšžœžœ
žœ
žœ˜'Kšœžœ˜/Kšžœžœ
žœ˜Kšžœ˜—K˜šŸœžœ˜+šžœžœ
žœž˜ K˜šžœžœ
ž˜šœžœžœ
žœž˜2Kš
œ˜Kšžœ
˜—Kš
œ+˜+K˜.Kšžœžœ
˜—Kšžœ
˜—Kšžœ˜—K˜šŸœžœ$˜;Kšœžœžœžœžœžœžœžœ˜NKšžœžœ
žœ#˜;Kšžœ)˜-Kšœžœ˜"—K˜šŸ
œžœžœžœžœ	žœžœ˜]Kšœžœ˜Kšœžœ˜Kšœžœ
žœžœ˜'šœžœžœ
˜&Kš	œžœžœžœ žœ˜O—Kšžœžœ
žœ#˜;Kšžœ)˜-Kšœ6žœ˜>—K˜š
Ÿœžœžœžœžœ˜FKš
œ˜Kšžœžœ
žœ#˜4Kš
œ˜Kšžœžœ
žœ%˜6Kšœ
žœžœ˜%—K˜šŸœžœ(žœ˜EKš
œ˜Kšžœžœ
žœ#˜4K˜Kšžœžœ
žœ%˜6Kšœ
žœžœ˜%—K˜š
Ÿ	œžœžœžœžœ˜XKšœžœžœ˜BKšžœžœ
žœžœ˜KK˜Kšžœ˜—K˜šŸœžœžœ˜-Kšœžœžœ˜4Kš	œžœžœ
žœžœ˜\Kšžœ˜—K˜šŸ
œžœ žœ
žœ˜IK˜1šžœžœžœ
ž˜0šžœžœ
ž˜Kšœ%žœ˜+Kšœžœ
˜Kšžœžœ
˜—Kšžœ
˜—Kšžœ˜—K˜šŸœžœ˜šžœžœ˜#Kšœžœ!˜,šžœžœ
ž˜šžœžœ
ž˜š
œ˜šžœžœ
žœ˜Kšžœ
žœ
žœ>˜^Kš
œ ˜ —šžœ
žœžœ˜!Kšžœ
žœžœžœ
˜?Kšžœ	žœ
žœ%˜8Kš
œ˜Kšžœ	žœ
žœ'˜:Kšžœ	žœ$žœ˜:Kš
œ˜—š
žœ	žœžœ
 œ
žœ˜>Kšžœ"˜$Kšœžœ˜—K˜—š
œ˜šžœ)žœžœ
ž˜:šžœžœ
ž˜š
œ˜Kš
žœžœ
žœžœ
žœ
˜.šžœ	žœ˜Kšžœ"˜$Kšœžœ
˜Kšžœ˜—K˜—Kšžœžœ
˜—Kšžœ
˜—K˜—š
œ˜Kšœ
žœ	žœ
žœžœ
žœ˜/K˜K˜-—Kšžœžœ
˜—K˜!Kšžœ
˜—Kšœžœ
˜Kšœžœ
˜"—šžœ˜šžœžœ
ž˜šžœžœ
ž˜š
œ˜Kšžœžœ
žœ
žœ
˜Kšžœžœ
žœ
˜!Kšžœ	žœ
žœ
˜Kšžœ
žœžœžœ
˜?Kšžœ	žœ
žœ%˜8Kš
œ˜Kšžœ	žœ
žœ'˜:Kšžœ	žœ$žœ˜:Kšœ
žœ˜—Kšœ žœžœ'˜PKšœžœ	žœ
žœžœ
žœ"˜SKšžœžœ
˜—K˜!Kšžœ
˜—Kšœžœ˜—Kšžœ˜—K˜š
Ÿœžœžœ
žœžœ˜?Kšœžœ˜#K˜Kšœžœ˜!Kšžœ˜ Kšœžœ˜"Kšžœ˜—K˜šŸœžœ4žœ˜\Kšžœžœ
žœžœ
žœžœ˜JK˜K˜K˜K˜Kšžœ˜—K˜šŸœžœžœ*˜[K˜K˜K˜K˜Kšžœ˜—K˜š
Ÿœžœžœžœžœ˜TKšžœžœ
žœ
˜&šžœžœ
ž˜š
œ˜K˜
K˜K˜šžœžœ
˜#šžœ
žœžœ
ž˜Kš
œžœžœ
žœ
žœžœžœ
˜MKšžœ˜——š
ž˜Kšžœžœ
žœ˜+Kš
žœ
žœžœžœ
žœ˜5Kšžœžœ
žœ
žœ
˜!šžœžœ
ž˜Kšœ1žœ˜7Kšžœžœžœžœžœžœžœ
˜_—Kšžœ˜	——˜Kšžœžœ
žœ˜2šžœžœ
žœž˜ K˜Kš
žœ
žœžœžœ
žœ˜5Kšžœ
˜—Kšžœ˜—˜Kšžœžœ
žœ˜3šžœžœ
žœž˜!K˜Kš
žœ
žœžœžœ
žœ˜5Kšžœ
˜—Kšžœ˜—Kšœžœ˜2Kš
œžœžœ!žœ
žœžœ
žœ˜hKšžœžœ	˜——K˜šŸœžœžœžœžœžœ˜Hšžœžœ
ž˜Kšœžœžœ"˜EKšžœžœ
˜—Kšžœžœ
žœžœ˜%šžœžœ
ž˜šœžœžœ˜0šžœ
žœžœ
ž˜Kšœžœžœ
žœ˜9Kšžœžœžœ
˜—Kšžœ
žœžœ˜—Kšœžœžœ˜Kšœ
žœžœ˜Kšœžœžœ˜#Kšžœžœžœ˜——K˜š
Ÿœžœžœžœžœ˜1šžœžœ
ž˜Kšœžœ!˜9Kšžœžœ˜(——K˜š
Ÿœžœžœžœžœ˜:Kšžœžœ
žœžœ˜%šžœžœ
ž˜Kšœžœžœ˜Kšœžœžœ˜!Kšœžœžœ˜Kšœ
žœžœ˜Kšœžœžœ˜#Kšžœžœžœ˜——K˜š
Ÿœžœžœžœžœ˜2Kšžœ
žœ˜(—K˜šŸœžœžœ
˜/šžœžœ
ž˜Kšœžœ˜*Kšžœžœ˜——K˜šŸœžœžœ
žœ
žœ
žœ˜?Kšœžœ
žœžœ˜'Kš
œ"˜"K˜
Kšžœ˜—K˜šŸœžœžœ
žœ˜7š
œ˜š
œ
˜
K˜K˜*K˜Kšœ&žœ
˜*Kšžœ˜——Kšžœ˜—K˜š	Ÿœžœžœ
žœ ;˜mK˜Kšœ&žœ
˜*š
ž˜K˜Kšœ	žœ
˜Kšœžœ˜Kšœžœ
˜K˜
K˜
Kšžœžœ
žœ
˜šžœžœ
ž˜K˜šžœ˜K˜)K˜ ——K˜K˜šœ
žœ˜K˜7Kšžœžœ(˜>Kš
œB˜BKšžœ
˜—Kšœžœ/žœ˜AK˜K˜K˜Kš	œ
žœžœ
žœžœ˜PKšœžœ
˜Kšžœ
˜—Kšžœžœ
žœ
˜%Kšœžœ˜8Kšœžœ˜8Kš
œ'˜'Kš
œ'˜'Kšžœ
˜šžœ˜K˜Kšœ&žœ
˜*—K˜—K˜šŸ	œžœžœ
žœžœžœžœ˜DKšœ	žœžœ˜Kšœžœ˜Kšžœ
žœžœžœH˜wKšžœ
žœžœžœD˜sKšžœžœ˜—K˜šŸœžœžœ
žœ˜,šŸ
œžœžœ
žœžœžœžœ˜EKšœ	žœžœ˜Kšœžœ˜ š	žœžœžœžœ
ž˜>Kšžœžœ-˜OK˜!Kš
œ˜Kš
œ˜Kšžœ
˜—Kšžœžœ˜—Kšžœžœ
žœ
˜&Kšžœ˜—K˜šŸœžœžœ
žœ
žœžœžœžœ œ˜{šŸœžœ
žœ
˜$šžœžœ
ž˜Kšœžœ˜Kšžœ4˜;——Kš	œžœ
žœžœ
žœ˜,K˜Kšœžœ˜Kšœžœžœ
˜Kšœ	žœžœ˜0Kšœ	žœžœ
˜Kšœ
žœ
žœžœ
˜Kšœžœ
˜
š
ž˜šžœ˜K˜:Kšžœ˜—K˜ Kšžœžœ
žœ
˜šžœžœ
ž˜šœžœž˜K˜'K˜%K˜1K˜3Kš	œžœžœ	žœ
žœ
˜?K˜'šœžœžœ
ž˜'Kšœžœ˜Kšžœžœ;˜L—Kšžœžœ;˜L—Kšžœžœ;˜L—š
ž˜Kšœ	žœ˜#—Kšžœ
˜—Kšœžœ
žœN˜`Kšœžœ
žœžœ˜K˜!š
ž˜šžœ˜Kšœžœ˜*Kšœ3žœ˜<—K˜K˜K˜1Kšžœžœ
žœ
˜Kš
œ5˜5K˜Kšžœžœ
žœ
˜Kšžœ
˜—Kšžœ.˜3Kš
œ˜K˜!Kšžœ˜—K˜šŸœ˜'K˜%Kšžœ˜—K˜šŸ
œ˜(Kš
œ˜Kšžœ˜—K˜KšŸ	œ.˜7K˜šŸœžœ
žœžœ˜%Kš	œžœ
žœžœ
žœ˜K˜Kšžœ˜—K˜šŸ	œžœ
žœžœ˜+Kš	œžœ
žœžœ
žœ˜Kšœžœ˜&Kšžœ˜Kšžœ
žœ˜)—K˜šŸœžœ
žœžœ˜)Kš	œžœ
žœžœ
žœ˜Kšœžœ˜*Kšžœ˜Kšžœ
žœ˜)—K˜š
Ÿœžœžœžœžœ˜7šŸœžœžœ˜K˜$K˜+—Kšœžœ
˜šžœžœ
žœž˜"Kšœžœ˜šžœž˜
Kšžœ˜Kšžœ˜!Kšžœžœ
˜—Kšžœ
˜—Kšžœ˜—K˜šŸœžœ+ "œ˜aKšœžœ=˜OK˜>˜Kš
œ/˜/Kš
œ;˜;Kšœ=žœ
˜BK˜—K˜WK˜XK˜WKšžœ
žœžœ ˜AK˜Kšœžœ˜.—K˜š
Ÿœžœ	žœžœžœ˜.Kšœžœ
žœ˜'Kš
žœžœ
žœ
žœžœ˜%Kšœžœ
žœžœ#˜8Kš
žœžœ
žœ
žœžœ˜ Kš
œE˜EKšœžœ
žœ>˜OKš
œ ˜ Kšžœžœ˜—K˜šŸ	œžœžœžœžœ
žœ˜9Kšœžœ
˜Kšœžœžœ
žœ˜5Kšžœ˜—K˜š
Ÿœžœžœžœžœ˜*Kšžœžœ
žœžœ˜Kšžœ
žœ#˜,—K˜šŸœžœ
žœžœžœ
žœ˜3Kšœžœ˜Kšœžœ
žœ
˜Kšžœžœ˜—K˜šŸ
œ˜(KšœEžœ˜WKšžœ˜—K˜šœžœ
žœ
žœ
žœžœ
˜$Kšžœ˜Kšžœ&˜)Kšžœ,˜/—K˜Kš
œ0˜0K˜Kš
œe˜eKš
œc˜cKš
œ€
˜€
Kš
œ€
˜€
Kš
œk˜kKš
œu˜uK˜Kšžœ
˜—…—©Ϊƒ