DIRECTORY Atom, Commander, IntToIntTab, IO, Process, RefText, Rope, Scheme, SchemeExtras, SchemePrettyRead, TextEditBogus, TextNode;

SchemePrettyReadImpl: CEDAR PROGRAM
IMPORTS Atom, Commander, IntToIntTab, IO, Process, RefText, Rope, Scheme, SchemeExtras, TextEditBogus, TextNode
EXPORTS SchemePrettyRead
=

BEGIN OPEN Scheme, SE:SchemeExtras, SchemePrettyRead;

Warning: PUBLIC SIGNAL [message: ROPE] ~ CODE;

VectorRep: TYPE ~ REF VectorArray;
VectorArray: TYPE ~ RECORD [length: NAT, elts: SEQUENCE size: NAT OF Any];

closeObj: Any ~ NEW [ROPE ¬ "close paren"];
dotObj: Any ~ NEW [ROPE ¬ "the dot"];

macroName: ARRAY SE.TokenKind[quote .. unquoteSplicing] OF ATOM
~ [$quote, $quasiquote, $unquote, Atom.MakeAtom["unquote-splicing"]];

scanningErrorName: ARRAY SE.ScanningError OF ROPE
~ ["none", "earlyEOF", "unknownCharacterName", "unknownPrimitiveSyntax", "unknownHashDispatch", "unknownStringEscape", "illegalInitialCharacter", "badIdentifier", "badNumber"];

noIdx: INT ~ INT.FIRST;
emptyList: Pair ~ NIL;
emptyVector: PUBLIC Vector ¬ NEW [Scheme.VectorRep ¬ [0, Ref, Set, NIL]];
buffSize: NAT ¬ 100;

Read: PUBLIC PROC [from: Port, stackBase: INT, posnsToNote: SourceFilter ¬ allButOther, interrupt: REF BOOL ¬ NIL, addTo: FormToSource ¬ NIL, deltaIndex: INT ¬ 0] RETURNS [form, nonCommented: Any, posns: FormToSource, maxStack: INT] ~ {
GetIdx: PROC [from: IO.STREAM, deltaIndex: INT] RETURNS [idx: INT] ~ {
idx ¬ noIdx;
idx ¬ from.GetIndex[!IO.Error => CONTINUE] + deltaIndex;
RETURN};
primeIdx: INT ~ GetIdx[from, deltaIndex];
buff: REF TEXT ¬ RefText.ObtainScratch[buffSize];
GetToken: PROC RETURNS [t: Token] ~ {
t.prelbs ¬ SkipWhiteCountBreaks[from];
t.startIdx ¬ GetIdx[from, deltaIndex];
t.cmtNode ¬ FALSE;
[t.tokenKind, t.token, t.error, t.value] ¬ SE.GetToken[from, buff, FALSE, FALSE];
RETURN};
wr: WorkResult;
posns ¬ IF primeIdx=noIdx THEN NIL ELSE IF addTo#NIL THEN addTo ELSE IntToIntTab.Create[];
IF interrupt=NIL THEN interrupt ¬ NEW [BOOL ¬ FALSE];
wr ¬ ReadWork[[posns, posnsToNote, interrupt], GetToken !UNWIND => RefText.ReleaseScratch[buff]];
RefText.ReleaseScratch[buff];
buff ¬ NIL;
IF wr.form = closeObj THEN ERROR Complain[NIL, IO.PutFR1["parse error%g: first token is close paren", [rope[FmtIdx[wr.startIdx]]] ]];
IF wr.form = dotObj THEN ERROR Complain[NIL, IO.PutFR1["parse error%g: first token is dot", [rope[FmtIdx[wr.startIdx]]] ]];
RETURN [wr.form, wr.nc, posns, stackBase-wr.extA]};

TiogaRead: PUBLIC PROC [start: TextNode.Location, stackBase: INT, posnsToNote: SourceFilter ¬ allButOther, interrupt: REF BOOL ¬ NIL, addTo: FormToSource ¬ NIL, deltaIndex: INT ¬ 0] RETURNS [form, nonCommented: Any, posns: FormToSource, maxStack: INT, next: TextNode.Location, nextIndex: INT] ~ {
buff: REF TEXT ¬ RefText.ObtainScratch[buffSize];
cur: TextNode.Location;
curRope: ROPE;
curLen, curAfter, nodeStartIndex: INT;
instr: IO.STREAM ¬ NIL;
GetToken: PROC RETURNS [t: Token] ~ {
t.prelbs ¬ 0;
t.cmtNode ¬ FALSE;
DO
IF instr=NIL THEN {
IF cur.node=NIL THEN RETURN [[t.prelbs, nodeStartIndex, FALSE, endOfFile, NIL, none, endOfFile]];
curRope ¬ TextEditBogus.GetRope[cur.node];
curAfter ¬ curRope.Length;
curLen ¬ curAfter - cur.where;
IF cur.node.comment THEN {
t ¬ [t.prelbs, nodeStartIndex, TRUE, comment, NIL, none, cur.node];
nodeStartIndex ¬ nodeStartIndex + curLen + 1;
cur ¬ [TextNode.Forward[cur.node].nx, 0];
RETURN};
curRope ¬ curRope.Substr[start: cur.where, len: curLen];
instr ¬ IO.RIS[curRope]};
t.prelbs ¬ t.prelbs + SkipWhiteCountBreaks[instr];
IF NOT instr.EndOf[] THEN EXIT;
nodeStartIndex ¬ nodeStartIndex + curLen + 1;
cur ¬ [TextNode.Forward[cur.node].nx, 0];
t.prelbs ¬ t.prelbs + (IF cur.node#NIL THEN 1 ELSE 0); --so last node of document contributes no linebreak, a la /r/PutFileImpl.WritePlain
instr ¬ NIL;
ENDLOOP;
t.startIdx ¬ nodeStartIndex + instr.GetIndex[];
[t.tokenKind, t.token, t.error, t.value] ¬ SE.GetToken[instr, buff, FALSE, FALSE];
RETURN};
wr: WorkResult;
IF start.node=NIL THEN ERROR;
IF start.where=TextNode.NodeItself THEN start.where ¬ 0;
cur ¬ start;
nodeStartIndex ¬ deltaIndex;
IF cur.node.comment AND cur.where#0 THEN ERROR;
posns ¬ IF addTo#NIL THEN addTo ELSE IntToIntTab.Create[];
IF interrupt=NIL THEN interrupt ¬ NEW [BOOL ¬ FALSE];
wr ¬ ReadWork[[posns, posnsToNote, interrupt], GetToken !UNWIND => RefText.ReleaseScratch[buff]];
RefText.ReleaseScratch[buff];
buff ¬ NIL;
IF wr.form = closeObj THEN ERROR Complain[NIL, IO.PutFR1["parse error%g: first token is close paren", [rope[FmtIdx[wr.startIdx]]] ]];
IF wr.form = dotObj THEN ERROR Complain[NIL, IO.PutFR1["parse error%g: first token is dot", [rope[FmtIdx[wr.startIdx]]] ]];
IF instr#NIL THEN {d: INT ~ instr.GetIndex[];
cur.where ¬ cur.where + d; nodeStartIndex ¬ nodeStartIndex+d};
RETURN [wr.form, wr.nc, posns, stackBase-wr.extA, cur, nodeStartIndex]};

Token: TYPE ~ RECORD [prelbs, startIdx: INT, cmtNode: BOOL, tokenKind: SE.TokenKind, token: REF TEXT, error: SE.ScanningError, value: Any];

ReadStuff: TYPE ~ RECORD [posns: FormToSource, toNote: SourceFilter, interrupt: REF BOOL];

WorkResult: TYPE ~ RECORD [prefix: VectorRep, form, nc: Any, commentStart, startIdx, extA: INT];

ReadWork: PROC [rs: ReadStuff, GetToken: PROC RETURNS [Token] ] RETURNS [WorkResult] ~ {
la: INT ~ GetStackAddr[];
prefix: VectorRep ¬ NIL;
first: BOOL ¬ TRUE;
commentStart: INT ¬ 0;
Process.CheckForAbort[];
IF rs.interrupt­ THEN ERROR ABORTED;
DO
prelbs, startIdx: INT;
cmtNode: BOOL; kind: SE.TokenKind;
tokenText: REF TEXT;
error: SE.ScanningError;
tokVal: Any;
[[prelbs, startIdx, cmtNode, kind, tokenText, error, tokVal]] ¬ GetToken[];
IF first THEN {commentStart ¬ startIdx; first ¬ FALSE};
IF cmtNode THEN {
IF prelbs#0 THEN prefix ¬ VRAppend[prefix, NEW [LinebreaksRep ¬ [prelbs]]];
prefix ¬ VRAppend[prefix, tokVal];
}
ELSE SELECT kind FROM
error => SELECT error FROM
unknownCharacterName, unknownPrimitiveSyntax, unknownHashDispatch, badIdentifier, badNumber => {
tokRope: ROPE ~ RopeFromString[NARROW[tokVal]];
RETURN Fix[prefix, prelbs, NIL, commentStart, startIdx, rs, tokRope, other, la]};
ENDCASE => ERROR Complain[NIL, IO.PutFR["scanning error %g%g: %g", [rope[scanningErrorName[error]]], [rope[FmtIdx[startIdx]]], [text[tokenText]] ]];
endOfFile => RETURN Fix[prefix, prelbs, NIL, commentStart, startIdx, rs, endOfFile, eof, la];
comment => {
IF prelbs#0 THEN prefix ¬ VRAppend[prefix, NEW [LinebreaksRep ¬ [prelbs]]];
prefix ¬ VRAppend[prefix, Rope.FromRefText[tokenText]];
};
identifier => RETURN Fix[prefix, prelbs, NIL, commentStart, startIdx, rs, Atom.MakeAtomFromRefText[tokenText], other, la];
moduleReference, boolean, number, character, string, primitiveSyntax => RETURN Fix[prefix, prelbs, NIL, commentStart, startIdx, rs, Rope.FromRefText[tokenText], other, la];
openParenthesis => {
list: Any;
lextA: INT;
[list, lextA] ¬ ParseList[startIdx, rs, GetToken];
RETURN Fix[prefix, prelbs, NIL, commentStart, startIdx, rs, list, compound, lextA]};
closeParenthesis => RETURN [[FixL[prefix, prelbs, closeObj], closeObj, closeObj, commentStart, startIdx, la]];
openVector => {
list: Any;
lextA: INT;
[list, lextA] ¬ ParseList[startIdx, rs, GetToken];
IF list=emptyList THEN RETURN Fix[prefix, prelbs, NIL, commentStart, startIdx, rs, NEW [VectorAsListRep ¬ [emptyList]], compound, lextA];
WITH list SELECT FROM
x: Pair => RETURN Fix[prefix, prelbs, NIL, commentStart, startIdx, rs, NEW [VectorAsListRep ¬ [x]], compound, lextA];
ctd: Commented => {inrpre: VectorRep ~ NARROW[ctd.prefix.data];
IF prefix#NIL OR inrpre#NIL THEN prefix ¬ VRCat[FixL[prefix, prelbs, NIL], inrpre];
RETURN Fix[prefix, 0, NARROW[ctd.postfix.data], commentStart, startIdx, rs, NEW [VectorAsListRep ¬ [NARROW[ctd.nonComment]]], compound, lextA]};
ENDCASE => ERROR};
quote, quasiquote, unquote, unquoteSplicing => {
sub: WorkResult ~ ReadWork[rs, GetToken];
IF sub.nc=closeObj THEN ERROR Complain[NIL, IO.PutFR1["parse error%g: quote(un)(quasi)(splicing) close paren", [rope[FmtIdx[startIdx]]] ]];
IF sub.nc=dotObj THEN ERROR Complain[NIL, IO.PutFR1["parse error%g: quote(un)(quasi)(splicing) dot", [rope[FmtIdx[startIdx]]] ]];
RETURN Fix[prefix, prelbs, NIL, commentStart, startIdx, rs, Cons[macroName[kind], Cons[sub.form, emptyList]], compound, sub.extA]};
dot => RETURN [[FixL[prefix, prelbs, dotObj], dotObj, dotObj, commentStart, startIdx, la]];
ENDCASE => ERROR;
ENDLOOP;
};

ParseList: PROC [listStart: INT, rs: ReadStuff, GetToken: PROC RETURNS [Token]] RETURNS [Any, INT] ~ {
extA: INT ¬ INT.LAST;
head, tail: Pair ¬ NIL;
DO
wr: WorkResult ¬ ReadWork[rs, GetToken];
extA ¬ MIN[extA, wr.extA];
IF wr.nc = endOfFile THEN ERROR Complain[NIL, IO.PutFR["parse error: end of file%g before end of list%g", [rope[FmtIdx[wr.startIdx]]], [rope[FmtIdx[listStart]]] ]];
IF wr.nc = closeObj THEN {
IF wr.prefix#NIL THEN {
IF tail=NIL THEN {
SIGNAL Warning[IO.PutFR["comment%g in empty list%g moved after list", [rope[FmtIdx[wr.startIdx]]], [rope[FmtIdx[listStart]]] ]];
RETURN [Fix[NIL, 0, wr.prefix, wr.commentStart, wr.startIdx, rs, emptyList, compound, extA].form, extA]};
tail.car ¬ Fix[NIL, 0, wr.prefix, noIdx, noIdx, rs, tail.car, other, extA].form;
};
RETURN [head, extA]};
IF wr.nc = dotObj THEN {
last, close: WorkResult;
IF tail=NIL THEN ERROR Complain[NIL, IO.PutFR["parse error for list%g: no element before dot%g", [rope[FmtIdx[listStart]]], [rope[FmtIdx[wr.startIdx]]] ]];
IF wr.prefix # NIL THEN [[form: tail.car, extA: extA]] ¬ Fix[NIL, 0, wr.prefix, noIdx, noIdx, rs, tail.car, other, extA];
last ¬ ReadWork[rs, GetToken];
extA ¬ MIN[extA, last.extA];
IF last.nc = endOfFile THEN ERROR Complain[NIL, IO.PutFR["parse error%g for list%g: end of file after dot", [rope[FmtIdx[last.startIdx]]], [rope[FmtIdx[listStart]]] ]];
IF last.nc = closeObj THEN ERROR Complain[NIL, IO.PutFR["parse error%g for list%g: close after dot", [rope[FmtIdx[last.startIdx]]], [rope[FmtIdx[listStart]]] ]];
IF last.nc = dotObj THEN ERROR Complain[NIL, IO.PutFR["parse error%g for list%g: two dots", [rope[FmtIdx[last.startIdx]]], [rope[FmtIdx[listStart]]] ]];
tail.cdr ¬ last.form;
close ¬ ReadWork[rs, GetToken];
extA ¬ MIN[extA, close.extA];
IF close.nc = endOfFile THEN ERROR Complain[NIL, IO.PutFR["parse error: end of file%g before end of list%g", [rope[FmtIdx[close.startIdx]]], [rope[FmtIdx[listStart]]] ]];
IF close.nc # closeObj THEN ERROR Complain[NIL, IO.PutFR["parse error: dot obj%g of list%g not followed by close paren", [rope[FmtIdx[close.startIdx]]], [rope[FmtIdx[listStart]]] ]];
RETURN [head, extA]};
{this: Pair ~ Cons[wr.form, emptyList];
IF head=NIL THEN head ¬ this ELSE tail.cdr ¬ this;
tail ¬ this};
ENDLOOP;
};

AffixVector: PUBLIC PROC [to: Any, v: Vector--of Comment, CommentNode, or Linebreaks--] RETURNS [Any] ~ {
ctd: Commented;
WITH to SELECT FROM
ictd: Commented => {
ipostr: VectorRep ~ NARROW[ictd.postfix.data];
opostr: VectorRep ~ NARROW[v.data];
postr: VectorRep ~ VRCat[ipostr, opostr];
ctd ¬ NEW[CommentedRep ¬ [ictd.prefix, Publish[postr], ictd.nonComment]];
};
ENDCASE => ctd ¬ NEW[CommentedRep ¬ [Publish[NIL], v, to]];
RETURN [ctd]};

Fix: PROC [prefix: VectorRep, prelbs: INT, postfix: VectorRep, commentStart, startIdx: INT, rs: ReadStuff, form: Any, kind: SourceKind, extA: INT] RETURNS [WorkResult] ~ {
la: INT ~ GetStackAddr[];
extA ¬ MIN[extA, la];
IF rs.posns#NIL AND startIdx#noIdx AND rs.toNote[kind] THEN [] ¬ rs.posns.Store[LOOPHOLE[form], startIdx];
IF prefix=NIL AND postfix=NIL AND prelbs<(IF form=endOfFile THEN 1 ELSE 2) THEN RETURN [[NIL, form, form, commentStart, startIdx, extA]];
WITH form SELECT FROM
ctd: Commented => {inrpre: VectorRep ~ NARROW[ctd.prefix.data];
subFound: BOOL; subStart: INT;
IF prefix#NIL OR inrpre#NIL THEN prefix ¬ VRCat[FixL[prefix, prelbs, form], inrpre];
ctd.prefix ¬ Publish[prefix];
ctd.postfix ¬ Publish[VRCat[NARROW[ctd.postfix.data], postfix]];
IF rs.posns#NIL AND commentStart#noIdx AND rs.toNote[comment] THEN [] ¬ rs.posns.Store[LOOPHOLE[ctd], commentStart];
IF rs.posns#NIL THEN {
[subFound, subStart] ¬ rs.posns.Fetch[LOOPHOLE[ctd.nonComment]];
IF subFound THEN startIdx ¬ subStart};
RETURN [[NIL, ctd, ctd.nonComment, commentStart, startIdx, extA]]};
ENDCASE => {
ctd: Commented ~ NEW[CommentedRep ¬ [Publish[FixL[prefix, prelbs, form]], Publish[postfix], form]];
IF rs.posns#NIL AND commentStart#noIdx AND rs.toNote[comment] THEN [] ¬ rs.posns.Store[LOOPHOLE[ctd], commentStart];
RETURN [[NIL, ctd, form, commentStart, startIdx, extA]]};
};

FixL: PROC [prefix: VectorRep, prelbs: INT, obj: Any] RETURNS [VectorRep] ~ {
IF prefix#NIL AND prelbs#0 OR prelbs>=(IF obj=endOfFile THEN 1 ELSE 2) THEN prefix ¬ VRAppend[prefix, NEW [LinebreaksRep ¬ [prelbs]]];
RETURN [prefix]};

VRAppend: PROC [old: VectorRep, elt: Any] RETURNS [new: VectorRep] ~ {
IF old=NIL THEN {old ¬ NEW [VectorArray[3]]; old.length ¬ 0};
new ¬ old;
IF old.length.SUCC = old.size THEN {
new ¬ NEW [VectorArray[old.size*2]];
FOR i: NAT IN [0 .. old.length) DO new[i] ¬ old[i] ENDLOOP;
new.length ¬ old.length};
new[new.length] ¬ elt;
new.length ¬ new.length.SUCC;
RETURN};

VRCat: PROC [a, b: VectorRep] RETURNS [c: VectorRep] ~ {
IF a=NIL THEN RETURN [b];
IF b=NIL THEN RETURN [a];
{len: INT ~ a.length + b.length;
IF len <= a.size THEN {
FOR i: NAT IN [0 .. b.length) DO a[a.length+i] ¬ b[i] ENDLOOP;
a.length ¬ len;
RETURN [a]};
IF len <= b.size THEN {
FOR i: NAT DECREASING IN [0 .. b.length) DO b[a.length+i] ¬ b[i] ENDLOOP;
FOR i: NAT IN [0 .. a.length) DO b[i] ¬ a[i] ENDLOOP;
RETURN [b]};
c ¬ NEW [VectorArray[len]];
FOR i: NAT IN [0 .. a.length) DO c[i] ¬ a[i] ENDLOOP;
FOR i: NAT IN [0 .. b.length) DO c[a.length+i] ¬ b[i] ENDLOOP;
c.length ¬ len;
RETURN [c]}};

Publish: PROC [vr: VectorRep] RETURNS [Vector] ~ {
IF vr=NIL THEN RETURN [emptyVector];
RETURN [NEW [Scheme.VectorRep ¬ [vr.length, Ref, Set, vr]]]};

Ref: PROC [self: Vector, index: INT] RETURNS [Any] ~ {
vr: VectorRep ~ NARROW[self.data];
IF NOT index IN [0..self.length) THEN ERROR Complain[Cons[self, MakeFixnum[index]], "vector reference out of bounds"];
RETURN [vr[index]]};

Set: PROC [self: Vector, index: INT, value: Any] ~ {
vr: VectorRep ~ NARROW[self.data];
IF NOT index IN [0..self.length) THEN ERROR Complain[Cons[self, MakeFixnum[index]], "vector reference out of bounds"];
vr[index] ¬ value;
RETURN};

SkipWhiteCountBreaks: PROC [from: IO.STREAM] RETURNS [lbs: INT] ~ {
lbs ¬ 0;
WHILE NOT from.EndOf[] DO
c: CHAR ~ from.GetChar[];
SELECT c FROM
'\n, '\r, '\l => lbs ¬ lbs.SUCC;
IN [0C .. ' ] => lbs ¬ lbs;
ENDCASE => {from.Backup[c]; RETURN};
ENDLOOP;
RETURN};

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

R: PROC [r: ROPE] RETURNS [ROPE] ~ INLINE {RETURN [r]};

InfoPrint: PUBLIC PROC [to: IO.STREAM, form: Any] ~ {
IF form=emptyList THEN to.PutRope[" <empty>"]
ELSE WITH form SELECT FROM
ctd: Commented => {
to.PutRope[" <commented"];
Printfix[to, ctd.prefix];
InfoPrint[to, ctd.nonComment];
Printfix[to, ctd.postfix];
to.PutRope[">"]};
p: Pair => {sep: ROPE ¬ " [";
tail: Any ¬ p;
DO
WITH tail SELECT FROM
q: Pair => {
to.PutRope[sep];
InfoPrint[to, q.car];
tail ¬ q.cdr;
IF tail=emptyList THEN EXIT;
}
ENDCASE => {
to.PutRope[sep];
to.PutRope["."];
InfoPrint[to, tail];
EXIT};
sep ¬ " ";
ENDLOOP;
to.PutRope["]"]};
val: VectorAsList => {
to.PutRope[" <VectorAsList "];
InfoPrint[to, val.list];
to.PutRope[">"]};
s: Symbol => to.PutF1[" $%g", [atom[s]]];
a: FakeAtom => {to.PutChar[' ]; to.PutRope[a]};
ENDCASE => {
to.PutRope[" <Scheme "];
Scheme.Print[form, to];
to.PutRope[">"]};
};

Printfix: PROC [to: IO.STREAM, v: Vector] ~ {
FOR i: INT IN [0 .. v.length) DO
elt: Any ~ VectorRef[v, i];
WITH elt SELECT FROM
x: Linebreaks => to.PutF1[" [linebrks %g]", [integer[x.num]]];
x: Comment => to.PutF1[" [comment \"%q\"]", [rope[x]]];
x: CommentNode => to.PutF1[" [node \"%q\"]", [rope[TextEditBogus.GetRope[x]]]];
ENDCASE => ERROR;
ENDLOOP;
RETURN};

PrettyReadTest: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] ~ {
ENABLE {
Warning => {cmd.err.PutF1["%g\n", [rope[message]]]; RESUME};
Complain => {cmd.err.PutF1["%g\n", [rope[msg]]]; GOTO Abort};
};
PRTLocal: PROC ~ {};
form: Any ~ Read[cmd.in, GetStackAddr[]].form;
InfoPrint[cmd.out, form];
cmd.out.PutRope["\n"];
RETURN;
EXITS Abort => result ¬ $Failure};

PlainReadTest: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] ~ {
ENABLE {
Warning => {cmd.err.PutF1["%g\n", [rope[message]]]; RESUME};
Complain => {cmd.err.PutF1["%g\n", [rope[msg]]]; GOTO Abort};
};
form: Any ~ Scheme.Read[cmd.in];
InfoPrint[cmd.out, form];
cmd.out.PutRope["\n"];
RETURN;
EXITS Abort => result ¬ $Failure};

DiveCmd: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY ¬ NIL, msg: ROPE ¬ NIL] ~ {
in: IO.STREAM ~ IO.RIS[cmd.commandLine];
n: INT ~ in.GetInt[];
base: INT ~ GetStackAddr[];
minA, maxA, minD, maxD: INT;
[minA, maxA] ¬ Dive[n];
minD ¬ minA - base;
maxD ¬ maxA - base;
cmd.out.PutFL["min delta = %g (%xH); max delta = %g (%xH)\n", LIST[ [integer[minD]], [integer[minD]], [integer[maxD]], [integer[maxD]] ]];
RETURN};

Dive: PROC [n: INT] RETURNS [minA, maxA: INT] ~ {
sn: INT ~ n - 1;
la: INT ~ GetStackAddr[];
IF n<=0 THEN RETURN [la, la];
[minA, maxA] ¬ Dive[sn];
minA ¬ MIN[minA, la];
maxA ¬ MAX[maxA, la];
RETURN};

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

Commander.Register["SchemePrettyReadTest", PrettyReadTest, "a filter"];
Commander.Register["SchemePlainReadTest", PlainReadTest, "a filter"];
Commander.Register["Dive", DiveCmd, "a stack test"];

END.

Ψ
SchemePrettyReadImpl.mesa
Copyright Σ 1990, 1992 by Xerox Corporation.  All rights reserved.
Last tweaked by Mike Spreitzer on May 12, 1992 11:45 am PDT
Non-empty prefix only if form=closeObj or form=dotObj.
Κ«–
(cedarcode) style•NewlineDelimiter

™
codeš
œ™Kšœ
Οe
œ7™BK™;—K˜KšΟk	œžœZ˜„
K˜šΟnœžœ
ž˜#KšžœžœG˜oKšžœ˜Kš
œ
˜
—K˜Kšžœ
žœ	žœ ˜5K˜Kš
Ÿœžœ
žœžœžœ
˜.K˜Kšœžœžœ
˜"Kš
œ
žœžœ
žœžœžœ
žœ˜JK˜Kšœžœžœ˜+Kšœžœžœ˜%K˜šœžœ
žœ%žœ
ž˜?Kš
œE˜E—K˜šœžœ
žœžœ
ž˜1Kš
ϡ
˜°
—K˜Kšœžœžœ
žœ
˜Kšœžœ
˜Kšœ
žœ
žœ#žœ˜IKšœ
žœ˜K˜šŸœžœ
žœžœ6žœ
žœžœžœžœžœ:žœ˜μ
šŸœžœžœ
žœžœžœžœ˜FK˜Kšœžœ
žœ˜8Kšžœ˜—Kšœ
žœ˜)Kšœžœ
žœ#˜1šŸœžœ
žœ˜%K˜&K˜&Kšœžœ
˜Kšœ+žœžœžœ˜QKšžœ˜—Kš
œ˜Kšœžœžœ
žœ
žœ
žœžœ
žœžœ˜ZKšžœžœ
žœ
žœžœžœ˜5Kšœ9žœ"˜aKš
œ˜Kšœžœ
˜Kš
žœžœ
žœ
žœžœT˜…
Kš
žœžœ
žœ
žœžœL˜{Kšžœ-˜3—K˜šŸ	œžœ
žœ'žœ6žœ
žœžœžœžœžœ:žœ&žœ˜¨Kšœžœ
žœ#˜1K˜Kšœ	žœ
˜Kšœ"žœ
˜&Kšœžœ
žœžœ
˜šŸœžœ
žœ˜%K˜
Kšœžœ
˜š
ž˜šžœžœ
žœ˜Kšžœ
žœ
žœ
žœžœ
žœ˜aK˜*K˜K˜šžœžœ˜Kšœžœžœ˜CK˜-K˜)Kšžœ˜—K˜8Kšœžœ
žœ˜—K˜2Kšžœ
žœžœ
žœ
˜K˜-K˜)Kš	œžœ
žœ
žœžœX˜Š
Kšœžœ
˜Kšžœ
˜—K˜/Kšœ+žœžœžœ˜RKšžœ˜—Kš
œ˜Kšžœžœ
žœ
žœ
˜Kšžœ!žœ˜8K˜K˜Kšžœžœ
žœ
žœ
˜/Kš	œžœžœ
žœžœ˜:Kšžœžœ
žœ
žœžœžœ˜5Kšœ9žœ"˜aKš
œ˜Kšœžœ
˜Kš
žœžœ
žœ
žœžœT˜…
Kš
žœžœ
žœ
žœžœL˜{šžœžœ
žœžœ˜-K˜>—KšžœB˜H—K˜Kšœžœžœžœžœ
žœžœ
žœ	žœ˜‹
K˜Kš	œžœžœ8žœ
žœ˜ZK˜šœžœžœBžœ˜`Kšœ
œ	
œœ
™6—K˜šŸœžœŸœžœ
žœžœ˜XKšœžœ˜Kšœžœ
˜Kšœžœžœ
˜Kšœžœ˜K˜Kšžœžœ
žœ
žœ
˜$š
ž˜Kšœžœ
˜Kšœ	žœžœ˜"Kšœžœ
žœ
˜Kšœžœ˜K˜K˜KKšžœžœ#žœ˜7šžœ	žœ˜Kšžœ
žœžœ˜KK˜"K˜
—šžœ
žœž˜šœ	žœž˜š
œ`˜`Kšœ	žœžœ
˜/Kšžœžœ3˜Q—Kšžœžœ
žœžœs˜”
—Kšœ
žœžœ2˜]˜Kšžœ
žœžœ˜KK˜7Kš
œ˜—KšœžœžœN˜zKšœHžœžœF˜¬
š
œ˜K˜
Kšœžœ
˜K˜2Kšžœžœ6˜T—KšœžœT˜nš
œ˜K˜
Kšœžœ
˜K˜2Kš
žœžœ
žœžœžœ3˜‰
šžœžœ
ž˜Kšœžœžœžœ+˜ušœ'žœ˜?Kšžœžœ
žœžœ
žœ%žœ˜SKšžœžœ0žœžœ&˜
—Kšžœžœ˜——š
œ0˜0Kš
œ)˜)Kš
žœžœ
žœ
žœžœ]˜‹
Kš
žœžœ
žœ
žœžœU˜
Kšžœžœe˜ƒ
—KšœžœN˜[Kšžœžœ
˜—Kšžœ
˜—K˜—K˜šŸ	œžœ
žœŸœžœ
žœ
žœžœ˜fKšœžœžœ
žœ
˜Kšœžœ
˜š
ž˜K˜(Kšœžœ˜Kš
žœžœ
žœ
žœžœt˜€
šžœžœ˜šžœžœ
žœ˜šžœžœ
žœ˜Kšžœ	žœo˜€
KšžœžœZ˜i—Kšœžœ>˜PK˜—Kšžœ˜—šžœžœ˜Kš
œ˜Kšžœžœ
žœ
žœ
žœžœt˜›
Kšžœ
žœ
žœ&žœ9˜yK˜Kšœžœ˜Kš
žœžœ
žœ
žœžœv˜¨
Kš
žœžœ
žœ
žœžœp˜‘
Kš
žœžœ
žœ
žœžœi˜˜
K˜K˜Kšœžœ˜Kš
žœžœ
žœ
žœžœw˜ͺ
Kš
žœžœ
žœ
žœžœ„
˜Ά
Kšžœ˜—K˜'Kšžœžœ
žœ
žœ˜2K˜
Kšžœ
˜—K˜—K˜š
Ÿœžœ
žœΟc*œžœ
˜iKš
œ˜šžœžœ
ž˜˜Kšœžœ˜.Kšœžœ	˜#Kš
œ)˜)Kšœžœ@˜IK˜—Kšžœ
žœžœ˜;—Kšžœ˜—K˜šŸœžœžœ.žœ4žœžœ˜«
Kšœžœ˜Kšœžœ˜Kšžœ
žœ
žœžœžœžœ˜jKšžœžœ
žœ	žœ
žœ	žœžœžœžœ
žœžœ-˜‰
šžœžœ
ž˜šœ'žœ˜?Kšœ
žœžœ
˜Kš
žœžœ
žœžœ
žœ4˜TK˜Kšœžœ˜@Kšžœ
žœ
žœžœžœžœ˜tšžœ
žœ
žœ˜Kšœ&žœ˜@Kšžœ
žœ˜&—Kšžœžœ7˜C—šžœ˜KšœžœO˜cKšžœ
žœ
žœžœžœžœ˜tKšžœžœ-˜9——Kš
œ˜—K˜šŸœžœžœžœ˜MKšžœžœ
žœ
žœ
žœžœžœžœžœ˜†
Kšžœ˜—K˜šŸœžœžœ˜FKšžœžœ
žœžœ#˜=K˜
šžœžœžœ˜$Kšœžœ˜$Kš
žœžœ
žœžœžœ
˜;K˜—K˜Kšœžœ
˜Kšžœ˜—K˜šŸœžœžœ˜8Kšžœžœ
žœ
žœ˜Kšžœžœ
žœ
žœ˜Kšœžœ˜ šžœžœ˜Kš
žœžœ
žœžœžœ
˜>K˜Kšžœ˜—šžœžœ˜Kšžœžœ
ž
œ
žœžœžœ
˜IKš
žœžœ
žœžœ
žœ
˜5Kšžœ˜—Kšœžœ˜Kš
žœžœ
žœžœ
žœ
˜5Kš
žœžœ
žœžœžœ
˜>K˜Kšžœ˜
—K˜šŸœžœžœ
˜2Kšžœžœ
žœ
žœ˜$Kšžœžœ2˜=—K˜šŸœžœžœžœ
˜6Kšœžœ˜"Kš
žœ
žœžœžœ
žœK˜vKšžœ˜—K˜šŸœžœžœ˜4Kšœžœ˜"Kš
žœ
žœžœžœ
žœK˜vK˜Kšžœ˜—K˜šŸœžœžœ
žœžœžœ˜CK˜šžœ
žœž˜Kšœžœ˜šžœž˜
Kšœžœ
˜ Kšžœ˜Kšžœžœ˜$—Kšžœ
˜—Kšžœ˜—K˜š
Ÿœžœžœžœžœ˜*Kšžœžœ
žœžœ˜Kšžœ
žœ#˜,—K˜KšŸ
œžœžœžœžœžœžœ˜7K˜š
Ÿ	œžœ
žœžœ
žœ˜5Kšžœžœ˜-šžœ
žœžœ
ž˜˜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˜—K˜šŸœžœžœ
žœ˜-šžœžœ
žœž˜ K˜šžœžœ
ž˜K˜>K˜7K˜OKšžœžœ
˜—Kšžœ
˜—Kšžœ˜—K˜šŸœžœžœ
žœ
žœžœžœžœ˜ašžœ˜Kšœ4žœ˜<Kšœ1žœ˜=K˜—KšŸœžœ˜Kš
œ.˜.K˜K˜Kšžœ
˜Kšžœ˜"—K˜šŸ
œžœžœ
žœ
žœžœžœžœ˜`šžœ˜Kšœ4žœ˜<Kšœ1žœ˜=K˜—K˜ K˜K˜Kšžœ
˜Kšžœ˜"—K˜šŸœžœžœ
žœ
žœžœžœžœ˜ZKš	œžœ
žœžœ
žœ˜(Kšœžœ˜Kšœžœ˜Kšœžœ
˜K˜K˜K˜Kšœ>žœH˜Š
Kšžœ˜—K˜š
Ÿœžœžœžœžœ˜1Kšœžœ	˜Kšœžœ˜Kšžœžœ
žœ
˜K˜Kšœžœ˜Kšœžœ˜Kšžœ˜—K˜šŸœžœ
žœžœžœ
žœ˜3Kšœžœ˜Kšœžœ
žœ
˜Kšžœžœ˜—K˜Kš
œG˜GKš
œE˜EKš
œ4˜4K˜Kšžœ
˜K˜—…—DjXν