-- PPPretty.mesa, module to output pretty text from a parse tree
-- Russ Atkinson, August 17, 1982 5:17 pm
-- CAUTION: all of this is OBSOLETE

DIRECTORY
Ascii USING [CR],
PPCommentTable USING
[Explode, FindNextComment, GetEnding, Ref, TestBreakHint],
PPComData USING
[idLOCK],
PPHelper USING
[earlyTrigger, indent, position, lateTrigger, line, page, sizing, lastChar,
Break, Excess, GetAttrs,
GetInfo, Indent, Init, WriteChar, WriteId, WriteText],
PPLeaves USING [HTIndex, ISEIndex, HTNull, LTIndex],
PPP1 USING [IdOfLock],
PPTree USING [Handle, Link, NodeName],
PPTreeOps USING [NSons, NthSon, OpName],
PPUtil USING [SetOutput],
PrintTV USING [NullPutClosure, PutClosure],
Rope USING [Equal, ROPE, Size, Text];

PPPretty: CEDAR MONITOR
IMPORTS PPComData, PPHelper, PPP1, PPTreeOps,
CT: PPCommentTable, PPUtil, Rope
EXPORTS PPUtil
SHARES Rope
= BEGIN OPEN Ascii, PPHelper, PPLeaves, PPTreeOps, Tree: PPTree, PrintTV, Rope;

InvalidIndex: INT = LAST[INT];

-- up-level saved link to mark bodies as we pass them
markedBody: Tree.Link ← NIL;

-- options
tryBreak: BOOL ← TRUE;
smallSons: CARDINAL ← 5;

SemiSeparator: CHAR = ';;
CommaSeparator: CHAR = ',;
CommaBreakSeparator: CHAR = '.;

-- sizing procedures

WillExceed: PROC
[t: Tree.Link, pattern: ROPE, level: INT, pos: NAT,
lineExceed: BOOL ← FALSE]
RETURNS [exceed: BOOL] = {
-- First, save the entire state
oldMarkedBody: Tree.Link ← markedBody;
oldLastChar: CHAR ← lastChar;
oldLastIndex: INT ← lastIndex;
oldNextIndex: INT ← nextIndex;
oldIndent: INT ← indent;
oldPosition: INT ← position;
oldLine: INT ← line;
oldPage: INT ← page;
oldOuter: BOOL ← outer;
oldPublic: BOOL ← defaultPublic;
IF sizing THEN RETURN [FALSE];

-- now, try to determine the size of things
sizing ← TRUE;
exceed ← FALSE;
[] ← PrettyPattern[t, pattern, level, pos
! Excess => {exceed ← TRUE; CONTINUE}];
IF lineExceed AND line > oldLine THEN exceed ← TRUE;

-- last, restore the entire state
lastChar ← oldLastChar;
lastIndex ← oldLastIndex;
nextIndex ← oldNextIndex;
indent ← oldIndent;
position ← oldPosition;
line ← oldLine;
page ← oldPage;
outer ← oldOuter;
defaultPublic ← oldPublic;
markedBody ← oldMarkedBody;
sizing ← FALSE};

-- this stuff is the state information
lastIndex: INT ← InvalidIndex;
nextIndex: INT ← 0;
outer: BOOL ← TRUE;
defaultPublic: BOOL ← TRUE;

PrettyPrint: PUBLIC ENTRY PROC
[root: Tree.Link, put: PutClosure ← NullPutClosure] = {
next: CT.Ref ← CT.FindNextComment[0];
IF root = NIL THEN RETURN;
IF put # NullPutClosure THEN
IF NOT PPUtil.SetOutput[put] THEN ERROR;
nextIndex ← IF next = NIL THEN InvalidIndex ELSE CT.Explode[next].start;
outer ← defaultPublic ← TRUE;
PPHelper.Init[];
lastIndex ← InvalidIndex;
lastChar ← ' ;
PrettyLink[root];
FlushCommentsBefore[InvalidIndex];
IF put # NullPutClosure THEN
IF NOT PPUtil.SetOutput[] THEN ERROR;
};

FlushCommentsBefore: PROC [index: INT] = {
comment: CT.Ref ← NIL;
WHILE index >= nextIndex DO
oldLine: INT ← line;
oldPos: INT ← position;
comment ← CT.FindNextComment[nextIndex];
IF comment = NIL THEN EXIT;
{cIndex, lastToken, prefix: INT;
text: ROPE;
[cIndex, text, lastToken, prefix] ← CT.Explode[comment];
nextIndex ← cIndex;
IF nextIndex > index THEN EXIT;
nextIndex ← nextIndex + 1;
IF NOT (sizing OR index = InvalidIndex) THEN
IF prefix > 0 OR position + text.Size[] > lateTrigger THEN Break[];
IF text = NIL OR text.Size[] < 2
THEN WriteChar[CR]
ELSE IF position > indent AND lastChar # ' THEN WriteChar[' ];
FOR i: INT IN [2..prefix] DO
WriteChar[CR]
ENDLOOP;
Indent[];
WriteText[text]};
IF line = oldLine THEN WriteChar[' ];
Indent[]
ENDLOOP};

PrettyLink: PROC [t: Tree.Link, level: INT ← 0] = {
IF t = NIL THEN RETURN;
SELECT position FROM
indent => {};
< indent => Indent[];
> lateTrigger => IF NOT sizing THEN Break[]
ENDCASE;
WITH t SELECT FROM
hti: HTIndex => PrettyHti[hti];
sei: ISEIndex => PrettySei[sei];
lti: LTIndex => PrintLti[lti];
node: Tree.Handle => PrettyNode[node, level]
ENDCASE => ERROR};

PrintLti: PROC [lti: LTIndex] = {
lit: ROPE ← lti.literal;
FlushCommentsBefore[lti.index];
IF lit = NIL
THEN WriteText["\"\""]
ELSE WriteText[lit]};

PrettyHti: PROC [hti: HTIndex] = {
text: ROPE ← "(anon)";
IF hti # HTNull THEN
{FlushCommentsBefore[hti.index];
text ← hti.name};
WriteId[text]};

LinkToName: PROC [link: Tree.Link] RETURNS [ROPE] = {
WITH link SELECT FROM
hti: HTIndex => RETURN [hti.name];
sei: ISEIndex => RETURN [sei];
ENDCASE;
RETURN [NIL];
};

PrettySei: PROC [sei: ISEIndex] = {
IF sei = NIL
THEN WriteText["(anon)"]
ELSE WriteText[sei]};

PrettyNode: PROC [t: Tree.Handle, level: INT ← 0] = {
text: ROPE ← NIL;
kind: OpKind ← special;
newLevel: INT ← level;
oldIndent: INT ← indent;
info: INT ← GetInfo[t];
IF t = NIL THEN RETURN;
IF info # 0 THEN FlushCommentsBefore[info];
[text, newLevel, kind] ← LookAtNode[t];
IF newLevel < level THEN {WriteChar['(]; indent ← position};
SELECT kind FROM
special => PrettySpecial[t, text, newLevel];
applytext =>
{indent ← position + 2;
[] ← PrettyPattern[t, text, newLevel];
[] ← PrettyPattern[t, "%^[%@%,1]"];
  indent ← oldIndent};
binary =>
{left: Tree.Link ← NthSon[t, 1];
right: Tree.Link ← NthSon[t, 2];
IF left # NIL
THEN {[] ←
PrettyPattern[left, "%0 ",
-- kludge for binary relations!
IF newLevel = MidLevel THEN MidLevel + 1 ELSE newLevel];
WriteText[text];
[] ← PrettyPattern[right, "%+2%|%0", newLevel + 1]}
ELSE {WriteText[text];
[] ← PrettyPattern[right, "%+2%|%0", newLevel + 1]}};
decl => PrettyDecl[t, text];
proc => {[] ← PrettyPattern[t, text];
IF NthSon[t, 1] = NIL
THEN [] ← PrettyPattern[t, "%?2%* RETURNS [%@%,2]"]
ELSE [] ← PrettyPattern[t, "%* %([%@%,1]%)%?2%^2 RETURNS [%@%,2]"]};
pattern => [] ← PrettyPattern[t, text, newLevel]
ENDCASE => ERROR;
IF newLevel < level THEN WriteChar[')];
indent ← oldIndent};

OpKind: TYPE = {applytext, binary, decl, proc, pattern, record, special};

MidLevel: INT = 4; -- level to use for binary relations
MaxLevel: INT = 9; -- max level used in precedence

LookAtNode: PROC [t: Tree.Handle]
RETURNS [text: ROPE, level: INT, kind: OpKind] = {
{opName: Tree.NodeName ← t.name;
nSons: CARDINAL = t.sonLimit - 1;
level ← 0;
text ← NIL;
kind ← pattern;
SELECT opName FROM
list => {SELECT TRUE FROM
nSons = 2 AND OpName[t[2]] = void => text ← "%1 | NULL";
nSons > 0 => text ← "{%*%;0}";
nSons = 0 => {}
ENDCASE};
item => kind ← special;

-- declarations
decl =>
kind ← decl;
typedecl =>
text ← "%,1: %+2%PTYPE%?2 = %|%2%?3 %*← %3";
enumeratedTC =>
text ← "%M{%@%,1}";
recordTC =>
{text ← "%MRECORD "; GO TO textApply};
monitoredTC =>
{text ← "MONITORED RECORD "; GO TO textApply};
variantTC =>
text ← "%$0[%@%,1]";
refTC =>
text ←
IF OpName[NthSon[t, 1]] = anyTC AND NOT GetAttrs[t].a3
THEN "REF" ELSE "%$0REF %R%1";
pointerTC =>
{son: Tree.Link ← NthSon[t, 1];
text ← "%$0%(%AORDERED %)POINTER%?1 TO %$0%R%1";
IF LinkToName[son].Equal["UNSPECIFIED"] THEN
text ← "POINTER";
};
listTC => -- the element type is deeply hidden
text ← "%$0LIST OF %$0%R%*%(1%(1%(1%2%)%)%)";
arrayTC =>
text ← "%$0%(%CPACKED %)ARRAY %*%(%?1%1 %)%|OF %2";
arraydescTC =>
text ← "%$0DESCRIPTOR FOR %R%1";
sequenceTC =>
text ← "%$0%(%CPACKED %)%MSEQUENCE %*%V1 OF %2";
procTC =>
{text ← "PROC"; GO TO procType};
processTC =>
{text ← "PROCESS"; GO TO procType};
portTC =>
{text ← "PORT"; GO TO procType};
signalTC =>
{text ← "SIGNAL"; GO TO procType};
errorTC =>
{text ← "ERROR"; GO TO procType};
programTC =>
{text ← "%(%~APROGRAM%)%(%AMONITOR%)"; GO TO procType};
anyTC =>
{text ← "ANY"; GO TO max};
definitionTC =>
text ← "DEFINITIONS";
unionTC => -- for variant records only, not a true union
text ← "%@%(SELECT %+2%(%@%V1%) FROM %[,2%/%,1 => %2%(%?3 ← %3%)%]%/ENDCASE%)";
relativeTC =>
text ← "%1 RELATIVE %2";
subrangeTC => {son: Tree.Link ← t[1];
text ← "%$0%1 %2";
IF OpName[son] = pointerTC THEN
-- unfortunately funny case
text ← "%(1%(%AORDERED %)%BBASE %)%RPOINTER %2 %*TO %(1%1%)";
GO TO max};
intCC => {text ← "%$0[%@%1..%|%2]"; GO TO max};
intCO => {text ← "%$0[%@%1..%|%2)"; GO TO max};
intOC => {text ← "%$0(%@%1..%|%2]"; GO TO max};
intOO => {text ← "%$0(%@%1..%|%2)"; GO TO max};
longTC =>
{son: Tree.Link ← t[1];
sonny: Tree.NodeName ← OpName[son];
text ← "LONG %1";
SELECT sonny FROM
refTC, listTC => text ← "%1";
none =>
IF LinkToName[son].Equal["INTEGER"] THEN
text ← "INT";
ENDCASE};
opaqueTC => text ← "TYPE%?1[%1]";
zoneTC => text ← "%(%AUNCOUNTED %)ZONE";
linkTC => text ← "LinkTC??";
implicitTC => text ← "*";
frameTC => text ← "FRAME %+2%|[%@%1]";
discrimTC => text ← "%1%+2%|[%2]";
entry => text ← "ENTRY %1";
internal => text ← "INTERNAL %1";
unit => text ← "%(%?1DIRECTORY%+2%/1%.1;%)%/2%2";
diritem => text ← "%1%+2%(%?2: FROM %2%)%?3 USING %^3[%@%,3]";
module => kind ← special;
body =>
{markedBody ← t;
  text ←
"%@%(%?1OPEN %@%,1;%)%(%?2%/2%;2;%/%)%(%?3%/3%;3%)%?4;%/%;4"};
inline => kind ← special;
lambda => text ← "%2 %?1USING %1";
block => text ← "{%@%(%?1%;1; %/2%)%;2}";

-- statements (and some expressions)
assignx, assign => text ← "%1 ← %*%2";
extractx, extract => text ← "[%@%,1] ← %*%2";
if => SELECT TRUE FROM
t[3] = NIL =>
  text ← "IF %@%1 THEN %^2%@%&2";
DanglingElse[t[2]] =>
  text ← "IF %@%1 %/2THEN %({%@%2%}%)%/3ELSE %@%3";
position > earlyTrigger =>
  text ← "IF %@%1 %/2THEN %+2%^2%&2%/3ELSE %+2%^3%&3"
ENDCASE =>
  text ← "IF %@%1 %^2%(THEN %+2%^2%&2%) %^3%(ELSE %+2%^3%&3%)";
bindx =>
text ←
"WITH %@%1 %(%|SELECT%(%?2 %2%) FROM %)%+2%[,3%/%,1%+2 => %*%2%]%/ENDCASE%?4 => %+4%|%4";
bind =>
text ←
"WITH %@%1 %(%|SELECT%(%?2 %2%) FROM %)%+2%[;3%/%,1%+2 => %^2%&2%]%/ENDCASE%?4 => %+4%|%4";
casex =>
text ← "SELECT %1 FROM %+2%[,2%$1%/%,1%+2 => %$0%*%2%]%/ENDCASE%?3 => %+4%|%3";
case =>
text ← "SELECT %1 FROM %+2%[;2%$1%/%,1%+2 => %^2%&2%]%/ENDCASE%?3 => %+4%|%3";
do => kind ← special;
forseq => text ← "FOR %1 ← %@%2%?3, %@%3";
upthru => text ← "%(%?1FOR %1 IN %2%!%)THROUGH %2";
downthru => text ← "%(%?1FOR %1 DECREASING IN %2%!%)THROUGH %2 DECREASING ";
return =>
IF nSons = 0 OR t[1] = NIL
  THEN text ← "RETURN"
  ELSE {text ← "RETURN "; GO TO textApply};
result =>
IF nSons = 0 OR t[1] = NIL
  THEN text ← "RESULT"
  ELSE {text ← "RESULT "; GO TO textApply};
goto => text ← "GO TO %1";
exit => text ← "EXIT";
loop => text ← "LOOP";
free => -- son3 is always NIL, to agree with NEW, I guess
{text ← "%$0%(%?1%1.%)FREE%*[%@%2%(%?4%/! %@%4%)]"; GO TO max};
resume =>
IF nSons = 0 OR t[1] = NIL
  THEN text ← "RESUME"
  ELSE {text ← "RESUME "; GO TO textApply};
reject => text ← "REJECT";
continue => text ← "CONTINUE";
retry => text ← "RETRY";
restart => text ← "RESTART %1";
stop => text ← "STOP %1";
lock => text ← "LOCK %1";
wait => text ← "WAIT %1";
notify => text ← "NOTIFY %1";
broadcast => text ← "BROADCAST %1";
unlock => text ← "UNLOCK %1";
null => text ← "NULL";
label => kind ← special;
open => text ← "{%*OPEN %(%@%,1;%)%/2%;2}";
enable =>
{son2: Tree.Link ← IF nSons < 2 THEN NIL ELSE NthSon[t, 2];
  IF son2 # NIL AND OpName[son2] = block
  THEN
  text ← "{%@ENABLE %({%@%*%1}%);%/2%(2%(%?1%;1; %/2%)%;2%)}"
  ELSE
  text ← "{%@ENABLE %({%@%*%1}%)%?2;%/2%;2}"};
catch => text ← "%[;1%/0%,1 => %+2%^2%&2%]%?2%(%?1;%)%/2ANY => %*%&2";
dst => text ← "%1 ← STATE";
lst => text ← "TRANSFER WITH%?1 %1";
lstf => text ← "RETURN WITH%?1 %1";
signalx, signal => text ← "SIGNAL%?1 %1";
errorx, syserrorx, error, syserror => text ← "ERROR%?1 %1";
xerror => text ← "RETURN WITH ERROR%?1 %1";
startx, start => text ← "START%?1 %1";
joinx, join => text ← "JOIN%?1 %1";

-- expressions
apply => {text ← "%1%*[%@%,2%(%?3%/! %@%;3%)]"; GO TO max};
fork => text ← "FORK %1";
index, dindex, seqindex, reloc => {text ← "%1[%+2%,2(%?3%/! %@%;3%)]"; GO TO max};
ifx => text ← "IF %@%1 %|%@THEN %(%@%2%) %|ELSE %@%3";
listcons => {text ← "%(%?1%1.%)LIST%*[%@%,2]"; GO TO max};
or => {text ← "OR "; level ← 2; GO TO bin};
and => {text ← "AND "; level ← 3; GO TO bin};
relE => {IF t[1] = NIL
THEN level ← 0
ELSE {text ← "= "; level ← 4};
GO TO bin};
relN => {text ← "# "; level ← 4; GO TO bin};
relL => {text ← "< "; level ← 4; GO TO bin};
relGE => {text ← ">= "; level ← 4; GO TO bin};
relG => {text ← "> "; level ← 4; GO TO bin};
relLE => {text ← "<= "; level ← 4; GO TO bin};
in => {text ← "IN "; level ← 8; GO TO bin};
notin => {text ← "NOT IN "; level ← 8; GO TO bin};
plus => {text ← "+ "; level ← 6; GO TO bin};
minus => {text ← "- "; level ← 6; GO TO bin};
times => {text ← "* "; level ← 7; GO TO bin};
div => {text ← "/ "; level ← 7; GO TO bin};
mod => {text ← "MOD "; level ← 7; GO TO bin};
dot => {text ← "%1.%2"; GO TO max};
create => text ← "NEW %1";
not => {text ← "NOT %1"; level ← 8};
uminus => {text ← "-%1"; level ← 8};
addr => {text ← "@%1"; GO TO max};
uparrow => {text ← "%1^"; GO TO max};
min => {text ← "MIN"; GO TO textApply};
max => {text ← "MAX"; GO TO textApply};
lengthen => {text ← "LONG"; GO TO textApply};
abs => {text ← "ABS"; GO TO textApply};
all => {text ← "ALL"; GO TO textApply};
size => text ← "SIZE[%$0%@%1%(%?2, %2%)]";
first => {text ← "FIRST"; GO TO textApply};
last => {text ← "LAST"; GO TO textApply};
pred => {text ← "PRED"; GO TO textApply};
succ => {text ← "SUCC"; GO TO textApply};
arraydesc => -- son1 is a list of 1 or 3 elements
-- DESCRIPTOR[exp] | DESCRIPTOR[exp, exp] | DESCRIPTOR[exp, exp, type]
-- son3 of son1 is NIL if type is absent
{text ← "DESCRIPTOR[%(1%@%(%~?2%0%!%)%1, %|%2%?3, %|%3%)]";
GO TO max};
length => {text ← "LENGTH"; GO TO textApply};
base => {text ← "BASE"; GO TO textApply};
loophole => {text ← "LOOPHOLE[%$0%@%1%(%?2, %|%2%)]"; GO TO max};
nil => {text ← "NIL"; GO TO max};
new => {text ← "%$0%(%?1%1.%)NEW%*[%@%2%(%?3%| ← %@%3%)%(%?4%/! %@%4%)]";
GO TO max};
float => {text ← "FLOAT"; GO TO textApply};
narrow => {text ← "NARROW[%$0%@%1%(%?2, %2%)%(%?3%/! %@%;3%)]"; GO TO max};
istype => {text ← "ISTYPE[%$0%@%1%(%?2, %2%)%(%?3%/! %@%;3%)]"; GO TO max};
cons => {text ← "%$0%(%?1%1.%)CONS%*[%@%,2%(%?3%/! %@%3%)]"; GO TO max};
typecode => {text ← "CODE[%$0%@%1]"; GO TO max};
signalinit => {text ← "CODE"; GO TO max};
clit => {text ← "%1"; GO TO max};
llit => {text ← "%1L"; GO TO max};
mwconst => {text ← "%1"; GO TO max};
void => {text ← "NULL"; GO TO max}
ENDCASE => kind ← special
EXITS
bin => kind ← binary;
max => level ← MaxLevel;
procType => kind ← proc;
textApply => {kind ← applytext; level ← MaxLevel}}};

BreakHintFromNode: PROC [t: Tree.Link] RETURNS [BOOL] = {
WITH t SELECT FROM
node: Tree.Handle =>
SELECT node.name FROM

-- declartions
decl, typedecl => RETURN [BreakHintFromNode[node[2]]];

-- type constructors
recordTC, monitoredTC, variantTC, unionTC,

-- statements
assign, extract, if, case, casetest, caseswitch, bind, do, forseq,
upthru, downthru, return, result, goto, exit, loop, free, resume,
reject, continue, retry, catchmark, restart, stop, lock, wait,
notify, broadcast, unlock, null, label, open, enable, catch, dst,
lst, lstf, syscall, subst, call, portcall, signal, error, syserror,
xerror, start, join,

-- expressions
openx, casex, startx, joinx, fork =>
RETURN [TRUE]
ENDCASE
ENDCASE;

RETURN [FALSE]};

DanglingElse: PROC [t: Tree.Link] RETURNS [BOOL] = {
-- this routine returns TRUE if an optional ELSE is missing at the end of a statement
DO WITH t SELECT FROM
node: Tree.Handle =>
SELECT node.name FROM
if => t ← node[3];
case => t ← node[3];
bind => t ← node[4]
ENDCASE => EXIT
ENDCASE => EXIT
ENDLOOP;
RETURN [t = NIL]};

PrettyList: PROC [t: Tree.Link, separator: CHAR ← ';] = {
IF OpName[t] = list
THEN PrettySons[t, separator]
ELSE PrettyLink[t]};

PrettyItem: PROC [t: Tree.Link] = {
WITH t SELECT FROM
node: Tree.Handle =>
{left: Tree.Link = node[1];
right: Tree.Link = node[2];
PrettyLink[left];
IF left # right THEN
{IF left # NIL THEN WriteText[": "];
PrettyLink[right]}}
ENDCASE};

PrettyBrackets: PROC [t: Tree.Link, left: CHAR ← 0C, separator: CHAR ← ';] = {
oldIndent: INT ← indent;
IF left # 0C THEN WriteChar[left];
indent ← position;
PrettyList[t, separator];
SELECT left FROM
'{ => WriteChar['}];
'( => WriteChar[')];
'[ => WriteChar[']]
ENDCASE;
indent ← oldIndent};

saveInhibit: Tree.Handle ← NIL;
PrettySons: PROC [tl: Tree.Link, separator: CHAR ← ';] = {
WITH tl SELECT FROM
t: Tree.Handle =>
{sons: NAT = t.sonLimit - 1;
break: BOOL ← separator = '; AND sons > smallSons;
IF separator = '. THEN {break ← TRUE; separator ← ',};
IF separator = ': THEN {break ← FALSE; separator ← ';};
IF sons = 0 THEN RETURN;
{son1: Tree.Link ← t[1];
lastInfo: INT ← GetInfo[son1];
lastLine: INT ← line;
  inhibit1: BOOL ← IsUnnamedLock[son1];
  IF inhibit1
  THEN {lastInfo ← 0;
  saveInhibit ← t}
ELSE {FlushCommentsBefore[lastInfo];
lastLine ← line;
   PrettyLink[son1]};
FOR nth: NAT IN [2..sons] DO
link: Tree.Link ← t[nth];
thisInfo: INT ← GetInfo[link];
thisBreak: BOOL ←
-- lots of ways to break here
break OR line # lastLine OR position > earlyTrigger AND sons - nth >
1 OR separator = '; AND CT.TestBreakHint[lastInfo, thisInfo] OR
position > indent AND WillExceed[link, ",%@ %0", 0, 0] OR
separator = ', AND BreakHintFromNode[link];
IF nth = 2 AND NOT break AND thisInfo > lastInfo AND lastInfo > 0 AND
CT.TestBreakHint[lastInfo, thisInfo] THEN
-- HINT: first two items in list are on separate lines
break ← thisBreak ← TRUE;
IF link = NIL AND separator = '; THEN LOOP;
IF NOT inhibit1 THEN {
  WriteChar[separator];
WriteChar[' ]};
FlushCommentsBefore[lastInfo ← thisInfo];
IF thisBreak THEN Break[];
lastLine ← line;
PrettyLink[link]
ENDLOOP}}
ENDCASE};

LockId: HTIndex ← PPP1.IdOfLock[];
IsUnnamedLock: PROC [t: Tree.Link] RETURNS [BOOL] = {
IF t = NIL THEN RETURN [FALSE];
WITH t SELECT FROM
sei: ISEIndex => RETURN [sei = PPComData.idLOCK];
hti: HTIndex => RETURN [hti = LockId];
node: Tree.Handle =>
{IF NSons[node] > 0 THEN
  {SELECT node.name FROM
  decl, item, list => t ← node.son[1];
  lambda => t ← node.son[2];
  ENDCASE => RETURN [FALSE];
  RETURN [IsUnnamedLock[t]];
  }};
ENDCASE;
RETURN [FALSE];
};

PrettyDecl: PROC [t: Tree.Link, text: ROPE] = {
init: Tree.Link ← NthSon[t, 3];
ids: Tree.Link ← NthSon[t, 1];
equate, public, readonly: BOOL;
pat: ROPE ← "%+2%P%R%2%?3 ← %*%3";
[equate, public, readonly] ← GetAttrs[t];
IF equate THEN pat ← "%+2%P%R%2%?3 = %*%3";
SELECT OpName[init] FROM
body => pat ← "%+2%P%Q%2%?3 = %(3%CINLINE %){%^3%|%3%←}";
inline => pat ← "%+2%P%Q%2%?3 = %|%3";
internal => pat ← "%+2%P%QINTERNAL %2%(3%?1 = %(1%CINLINE %){%^1%|%1%←}%)";
entry => pat ← "%+2%P%QENTRY %2%(3%?1 = %(1%CINLINE %){%^1%|%1%←}%)"
ENDCASE;
IF ids # NIL THEN
{oldIndent: INT ← indent;
base: Tree.Link ← t;
nsons: NAT ← 1;
IF OpName[ids] = list THEN {base ← ids; nsons ← NSons[ids]};
FOR i: NAT IN [1..nsons] DO
id: Tree.Link ← NthSon[base, i];
IF i > 1 THEN WriteText[", "];
IF OpName[id] # item THEN {[] ← PrettyPattern[id, "%|%0"]; LOOP};
-- finally, this is of the form id(X: Y..Z) OR id(X)
[] ← PrettyPattern[id, "%|%,1"];
IF (id ← NthSon[id, 2]) = NIL THEN LOOP;
[] ← PrettyPattern[id, "%|(%,1%(%?1%?2: %)%(2%?0%1..%2%))"]
ENDLOOP;
WriteText[": "];
indent ← oldIndent};
[] ← PrettyPattern[t, pat]};

PrettyExits: PROC
[exits: Tree.Link, key: ROPE, tail: Tree.Link ← NIL, tailKey: ROPE ← NIL] = {
oldIndent: INT ← indent;
IF exits = NIL AND tail = NIL THEN RETURN;
IF key # NIL THEN [] ← PrettyPattern[exits, key];
indent ← oldIndent + 2;
[] ← PrettyPattern[exits, "%[;0%/1%,1 => %+2%^2%&2%]"];
IF tail # NIL THEN
{IF exits # NIL THEN WriteChar[';];
IF tailKey # NIL THEN [] ← PrettyPattern[tail, tailKey];
indent ← oldIndent + 4;
[] ← PrettyPattern[tail, "%|%0;"]};
indent ← oldIndent};

PrettySpecial: PROC [t: Tree.Link, text: ROPE, level: INT] = {
oldIndent: INT ← indent;
opName: Tree.NodeName ← OpName[t];
nSons: NAT ← NSons[t];
son1: Tree.Link ← IF nSons >= 1 THEN NthSon[t, 1] ELSE NIL;
son2: Tree.Link ← IF nSons >= 2 THEN NthSon[t, 2] ELSE NIL;
son3: Tree.Link ← IF nSons >= 3 THEN NthSon[t, 3] ELSE NIL;
SELECT opName FROM
item => PrettyItem[t];
atom =>
{WriteChar['$];
WITH son1 SELECT FROM
lti: LTIndex => WriteText[lti.literal]
ENDCASE => PrettyLink[son1]};
inline =>
{WriteText["MACHINE CODE"];
Break[];
WriteChar['{];
indent ← position;
FOR i: NAT IN [1..NSons[son1]] DO
IF i > 1 THEN {WriteChar[';]; Break[]};
PrettyList[NthSon[son1, i], CommaSeparator]
ENDLOOP;
[] ← PrettyPattern[t, "%^}"]};
do =>
{forClause: Tree.Link ← NthSon[t, 1];
whileTest: Tree.Link ← NthSon[t, 2];
code: Tree.Link ← NthSon[t, 4];
codePat: ROPE ← "%;0";
IF forClause # NIL THEN
{PrettyLink[forClause]; WriteChar[' ]; indent ← oldIndent + 4};
IF whileTest # NIL
  THEN
{[] ← PrettyPattern[whileTest, "%+2%|WHILE %@%0 "];
IF indent = oldIndent THEN indent ← oldIndent + 2}
  ELSE IF forClause = NIL THEN indent ← oldIndent + 3;
[] ← PrettyPattern[code, "DO %/"];
IF OpName[code] = block THEN codePat ← "%(%?1%;1;%/%)%;2";
[] ← PrettyPattern[code, codePat];
PrettyExits[NthSon[t, 5], "%/REPEAT%/", NthSon[t, 6], "%/FINISHED => "];
[] ← PrettyPattern[t, "%/ENDLOOP"]};
label =>
{code: Tree.Link ← NthSon[t, 1];
exits: Tree.Link ← NthSon[t, 2];
  needBrackets: BOOL ←
  markedBody = NIL
  OR NSons[markedBody] <= 2
  OR NthSon[markedBody, 2] # NIL
  OR NthSon[markedBody, 3] # t;
  IF needBrackets THEN [] ← PrettyPattern[t, "%/{"];
indent ← position;
  SELECT OpName[code] FROM
block =>
[] ← PrettyPattern[code, "%(%?1%;1; %/2%)%;2"];
list =>
  [] ← PrettyPattern[code, "%;0"];
  ENDCASE =>
  [] ← PrettyLink[code];
PrettyExits[exits, "%/0EXITS"];
  IF needBrackets THEN WriteChar['}];
};
module =>
{locks: Tree.Link ← NthSon[t, 4];
  decl: Tree.Link ← NthSon[t, 5];
name: Tree.Link ← NthSon[decl, 1];
type: Tree.Link ← NthSon[decl, 2];
init: Tree.Link ← NthSon[decl, 3];
public: BOOL ← GetAttrs[init].a2;
defs: BOOL = OpName[type] = definitionTC;
[] ← PrettyPattern[decl, "%/1%,1: %*%2"];
indent ← oldIndent + 2;
outer ← FALSE;
IF locks # NIL AND NOT IsUnnamedLock[locks]
  THEN [] ← PrettyPattern[t, "%Q%?4%/4LOCKS %@%,4"];
[] ← PrettyPattern[t, "%?1%/1IMPORTS %@%,1"];
[] ← PrettyPattern[t, "%?2%/2EXPORTS %@%,2"];
[] ← PrettyPattern[t, "%?3%/3SHARES %@%,3"];

-- get inner/outer distinction right for PUBLIC
defaultPublic ← public;
outer ← NOT defs;
[] ← PrettyPattern[init, "%/= %PBEGIN"];

-- get inner/outer distinction right for PUBLIC
defaultPublic ← defs OR public;
outer ← TRUE;
[] ← PrettyPattern[init, "%(%?1 OPEN %@%,1;%)%(%?2%/2%;2;%)%/3%;3%E"]}
ENDCASE => ERROR;
indent ← oldIndent};

PrettyPattern: PROC
[t: Tree.Link, pattern: ROPE, level: INT ← 0, pos: NAT ← 0, enable: BOOL ← TRUE]
RETURNS [NAT] = {

-- This procedure takes care of expanding formatting patterns
-- The '%' character is used to denote the start of an expansion.
-- The characters following the % character are decoded specially, as follows:

-- (the following options are interpreted regardless of the enable flag)
-- (n: start a new recursion level, saving context, using son n
-- [n: start iteration over son n
-- ): return from current level, should pair with '(
-- ]: end of iteration, should pair with '[

-- (the following options are interpreted only when enable is true)
-- 0..9: expand the Nth son (where NthSon[t, 0] = t)
-- ,n: expand list using son n, ', separator, default no break
-- ;n: expand list using son n, '; separator, default break
-- .n: expand list using son n, ', separator, default break
-- :n: expand list using son n, '; separator, default no break
-- ?n: enable ← Nth son # NIL
-- A..C: enable ← (A: attr1, B: attr2, C: attr3)
-- ~?n: enable ← Nth son = NIL
-- ~A..~C: enable ← NOT (A: attr1, B: attr2, C: attr3)
-- |: break if remainder of pattern will exceed margin
-- &n: IF Nth son = NIL THEN {} ELSE expand Nth son
-- *: same as %+2%|%@
-- ^n: break if break hint between t and son n, or remainder exceeds margin
-- +n: indent ← MIN[original indent + n, position]
-- /n: flush comments before son n, then break
-- @: indent ← position
-- !: exit entire pattern
-- E: handle END. case
-- M: MACHINE DEPENDENT, based on attributes
-- P: PUBLIC or PRIVATE, based on defaults and attributes
-- Q: outer ← FALSE, useful in modules
-- R: READONLY, based on attributes
-- Vn: expand son n, OVERLAID, or COMPUTED, based on attributes

-- all other characters following % are written literally
text: Text = NARROW[pattern];
size: INT = IF text = NIL THEN 0 ELSE text.length;
GetSon: PROC RETURNS [Tree.Link] = {
i: NAT ← GetNum[];
IF i = 0 THEN RETURN [t];
IF i > nSons THEN RETURN [NIL];
RETURN [th[i]]};
GetChar: PROC RETURNS [c: CHAR] = INLINE {
IF pos >= size THEN RETURN ['%];
c ← text[pos];
pos ← pos + 1};
GetNum: PROC RETURNS [NAT] = INLINE {
IF pos >= size THEN RETURN [0];
{nc: CHAR ← text[pos];
IF nc IN ['0..'9] THEN {pos ← pos + 1; RETURN [nc - '0]};
RETURN [0]}};
nSons: NAT ← 0;
oldIndent: INT ← indent;
oldLevel: INT ← level;
oldPublic: BOOL ← defaultPublic;
oldOuter: BOOL ← outer;
oldLine: INT ← line;
th: Tree.Handle ← NIL;
WITH t SELECT FROM
tt: Tree.Handle => {th ← tt; nSons ← th.sonLimit - 1}
ENDCASE;
outer ← oldOuter;
WHILE pos < size DO
c: CHAR ← GetChar[];
IF c # '% THEN {IF enable THEN WriteChar[c]; LOOP};
SELECT c ← GetChar[] FROM
'), '] => EXIT;
'( => {pos ← PrettyPattern[GetSon[], pattern, level, pos, enable]; LOOP};
'[ => {-- looping construct
term: CHAR ← GetChar[];
link: Tree.Link ← GetSon[];
lpos: INT ← pos;
lenb: BOOL ← enable AND link # NIL;
IF lenb AND OpName[link] = list THEN
{node: Tree.Handle = NARROW[link];
nls: NAT = node.sonLimit - 1;
FOR i: NAT IN [1..nls - 1] DO
lson: Tree.Link ← node[i];
[] ← PrettyPattern[lson, pattern, 0, pos];
WriteChar[term]
ENDLOOP;
link ← node[nls]};
pos ← PrettyPattern[link, pattern, 0, pos, lenb];
LOOP}
ENDCASE;
IF NOT enable THEN LOOP;
IF c IN ['a..'z] THEN c ← LOOPHOLE[c - 40C];
SELECT c FROM
'0, '1, '2, '3, '4, '5, '6, '7, '8, '9 =>
{pos ← pos - 1; PrettyLink[GetSon[], level]};
'?, '~, 'A, 'B, 'C =>
{IF c = '~ THEN {c ← GetChar[]; enable ← FALSE};
IF c IN ['a..'z] THEN c ← LOOPHOLE[c - 40C];
SELECT c FROM
'? => IF GetSon[] = NIL THEN enable ← NOT enable;
IN ['A..'C] => {IF th # NIL THEN
SELECT c FROM
'A => IF th.attr[1] THEN LOOP;
'B => IF th.attr[2] THEN LOOP;
'C => IF th.attr[3] THEN LOOP
ENDCASE;
enable ← NOT enable}
ENDCASE => enable ← FALSE};
';, ',, '., ': => PrettyList[GetSon[], c];
'← => IF tryBreak AND line > oldLine THEN Break[];
'| => IF position > indent
  AND WillExceed[t, pattern, level, pos, TRUE] THEN Break[];
'& => {link: Tree.Link ← GetSon[];
IF link = NIL
THEN WriteText["{}"]
ELSE PrettyLink[link]};
'* => {indent ← MIN[oldIndent + 2, position];
IF position > indent
  AND WillExceed[t, pattern, level, pos, TRUE]
   THEN Break[];
indent ← position};
'^ =>
IF position > indent THEN
{link: Tree.Link ← GetSon[];
IF link # NIL THEN
  {start: INT ← GetInfo[t];
next: INT ← GetInfo[link];
IF position > earlyTrigger
   OR (start # 0 AND next > start AND CT.TestBreakHint[start, next])
   OR WillExceed[t, pattern, level, pos, TRUE] THEN
{FlushCommentsBefore[next]; Break[]}}};
'/, '= => {FlushCommentsBefore[GetInfo[GetSon[]]]; IF c = '/ THEN Break[]};
'$ => level ← GetNum[];
'! => {pos ← pos - 2; EXIT};
'@ => indent ← MAX[position, indent];
'+ => indent ← MIN[oldIndent + GetNum[], position];
'E => {end: INT ← CT.GetEnding[];
FlushCommentsBefore[end];
Break[];
WriteText["END."];
indent ← 0};
'Q => outer ← FALSE;
'P, 'M, 'V, 'R =>
{machineDep, public, other: BOOL;
IF OpName[t] = enumeratedTC
THEN [public, machineDep, other] ← GetAttrs[t]
ELSE [machineDep, public, other] ← GetAttrs[t];
SELECT c FROM
'M => IF machineDep THEN WriteText["MACHINE DEPENDENT "];
'P => {IF outer AND public # defaultPublic THEN
WriteText[IF public THEN "PUBLIC " ELSE "PRIVATE "];
defaultPublic ← public};
'V => {link: Tree.Link ← GetSon[];
son1: Tree.Link ← IF link = NIL THEN NIL ELSE NthSon[link, 1];
IF OpName[t] = unionTC THEN other ← public;
IF son1 = NIL
THEN WriteText[IF other THEN "OVERLAID " ELSE "COMPUTED "]
ELSE [] ← PrettyPattern[son1, "%,0: "];
IF link # NIL THEN PrettyLink[NthSon[link, 2]]};
'R => IF other THEN WriteText["READONLY "]
ENDCASE}
ENDCASE => WriteChar[c]
ENDLOOP;
indent ← oldIndent;
level ← oldLevel;
defaultPublic ← oldPublic;
outer ← oldOuter;
RETURN [pos]};

END.