SchemePrettyReadImpl.mesa
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
Last tweaked by Mike Spreitzer on May 12, 1992 11:45 am PDT
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];
Non-empty prefix only if form=closeObj or form=dotObj.
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.