-- SakuraPretty.mesa, module to output pretty text from a parse tree
-- last edit by Russ Atkinson, 9-Jul-81 16:11:43
-- last edited by Suzuki, 19-Apr-82 16:37:13
-- The following comment is useful to measure indentation.
-- 1 2 3 4 5 6 7 8 9
-- 456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
DIRECTORY
IOStream: TYPE USING [CR],
PPCommentTable: TYPE USING [Explode, FindNextComment, GetEnding, Index, Ref, TestBreakHint],
SakuraHelper: TYPE USING
[indent, position, line, page, sizing, lastChar, Break, Excess, GetAttrs,
GetInfo, Indent, Init, WriteChar, WriteId, WriteQuotedText, WriteText],
PPLeaves: TYPE USING [HTIndex, ISEIndex, HTNull, LTIndex],
SakuraTree: TYPE USING [Handle, Link, NodeName],
SakuraTreeOps: TYPE USING [NSons, NthSon, OpName],
SakuraUtil: TYPE USING [],
Rope: TYPE USING [Ref, Size, Text];
SakuraPretty: PROGRAM
IMPORTS SakuraHelper, SakuraTreeOps, CT: PPCommentTable, Rope
EXPORTS SakuraUtil
= BEGIN OPEN IOStream, SakuraHelper, PPLeaves, SakuraTreeOps, Tree: SakuraTree, Rope;
Index: TYPE = LONG INTEGER;
InvalidIndex: Index = LAST[Index];
Char: TYPE = CHARACTER;
-- options
lateTrigger: Index ← 80;
earlyTrigger: Index ← 70;
tryBreak: BOOLEAN ← FALSE;
smallSons: CARDINAL ← 5;
SemiSeparator: Char = ';;
CommaSeparator: Char = ',;
CommaBreakSeparator: Char = '.;
-- sizing procedures
WillExceed: PROC [t: Tree.Link, pattern: Ref, level: Index, pos: NAT]
RETURNS [exceed: BOOLEAN] = {
-- First, save the entire state
oldLastChar: Char ← lastChar;
oldLastIndex: Index ← lastIndex;
oldNextIndex: Index ← nextIndex;
oldIndent: Index ← indent;
oldPosition: Index ← position;
oldLine: Index ← line;
oldPage: Index ← page;
oldOuter: BOOLEAN ← outer;
oldPublic: BOOLEAN ← 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}];
-- last, restore the entire state
lastChar ← oldLastChar;
lastIndex ← oldLastIndex;
nextIndex ← oldNextIndex;
indent ← oldIndent;
position ← oldPosition;
line ← oldLine;
page ← oldPage;
outer ← oldOuter;
defaultPublic ← oldPublic;
sizing ← FALSE};
-- this stuff is the state information
lastIndex: Index ← InvalidIndex;
nextIndex: Index ← 0;
outer: BOOLEAN ← TRUE;
defaultPublic: BOOLEAN ← TRUE;
PrettyPrint: PUBLIC PROC [root: Tree.Link] = {
next: CT.Ref ← CT.FindNextComment[0];
nextIndex ← IF next = NIL THEN InvalidIndex ELSE CT.Explode[next].start;
outer ← defaultPublic ← TRUE;
lastIndex ← InvalidIndex;
lastChar ← ' ;
SakuraHelper.Init[];
PrettyLink[root];
FlushCommentsBefore[InvalidIndex]};
FlushCommentsBefore: PROC [index: Index] = {
comment: CT.Ref ← NIL;
IF index=LAST[PPCommentTable.Index] THEN RETURN;
WHILE index >= nextIndex DO
oldLine: Index ← line;
oldPos: Index ← position;
comment ← CT.FindNextComment[nextIndex];
IF comment = NIL THEN EXIT;
{cIndex, lastToken, prefix: Index;
text: Ref;
[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: Index IN [2..prefix] DO
WriteChar[CR]
ENDLOOP;
Indent[];
WriteText[text]};
IF line = oldLine THEN WriteChar[' ];
Indent[]
ENDLOOP};
PrettyLink: PROC [t: Tree.Link, level: Index ← 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] = {
val: REF ← lti.value;
FlushCommentsBefore[lti.index];
WITH val SELECT FROM
txt: Ref => WriteQuotedText[txt]
ENDCASE => WriteText[lti.literal]};
PrettyHti: PROC [hti: HTIndex] = {
text: Ref ← "(anon)";
IF hti # HTNull THEN
{FlushCommentsBefore[hti.index];
text ← hti.name};
WriteId[text]};
PrettySei: PROC [sei: ISEIndex] = {
IF sei = NIL
THEN WriteText["(anon)"]
ELSE WriteText[sei]};
PrettyNode: PROC [t: Tree.Handle, level: Index ← 0] = {
text: Ref ← NIL;
kind: OpKind ← special;
newLevel: Index ← level;
oldIndent: Index ← indent;
info: Index ← 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 => {[] ← PrettyPattern[t, text, newLevel];
[] ← PrettyPattern[t, "%*[%@%,1]"]};
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: Index = 4; -- level to use for binary relations
MaxLevel: Index = 9; -- max level used in precedence
LookAtNode: PROC [t: Tree.Handle]
RETURNS [text: Ref, level: Index, kind: OpKind] = {
{opName: Tree.NodeName ← t.name;
nSons: CARDINAL = t.sonLimit - 1;
level ← 0;
text ← NIL;
kind ← pattern;
SELECT opName FROM
list => {nSons: CARDINAL = t.sonLimit - 1;
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 "; kind ← applytext};
monitoredTC => {text ← "MONITORED RECORD "; kind ← applytext};
variantTC => text ← "[%@%,1]";
refTC =>
text ←
IF OpName[NthSon[t, 1]] = anyTC AND NOT GetAttrs[t].a3
THEN "REF" ELSE "REF %R%1";
pointerTC => text ← "%(%AORDERED %)POINTER%?1 TO %R%1";
listTC => -- the element type is deeply hidden
text ← "LIST OF %R%*%(1%(1%(1%2%)%)%)";
arrayTC => text ← "%$0%(%CPACKED %)ARRAY %*%(%?1%1 %)%|OF %2";
arraydescTC => text ← "DESCRIPTOR 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};
deviceTC => {text ← "DEVICE"; 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 => {sonny: Tree.NodeName ← OpName[t[1]];
SELECT sonny FROM
refTC, listTC => text ← "%1"
ENDCASE => text ← "LONG %1"};
opaqueTC => text ← "OpaqueTC?? %1";
zoneTC => text ← "%(%AUNCOUNTED %)ZONE";
linkTC => text ← "LinkTC??";
implicitTC => text ← "*";
frameTC => text ← "FRAME [%@%1]";
discrimTC => text ← "%2 %1";
entry => text ← "ENTRY %1";
internal => text ← "INTERNAL %1";
unit => text ← "%(%?1DIRECTORY%+2%/1%.1;%)%/2%2";
diritem => text ← "%1: %+2%(%~?2TYPE%)%(%?2FROM %2%)%?3 USING %↑3[%@%,3]";
module => kind ← special;
body => text ← "%@%(%?1OPEN %@%,1;%/2%)%(%?2%;2;%/3%)%;3";
inline => kind ← special;
lambda => text ← "%2 %?1USING %1";
block => text ← "{%@%(%?1%;1; %/2%)%;2}";
deviceblock => text ← "%@IN %.1 %/2OUT %.2 %/3GUARDIAN %&3 %/4STATE %.4 %/5CONTROL %5";
-- 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";
indent + 20 > lateTrigger => text ← "IF %@1 %/2THEN %&2%/3ELSE %&3"
ENDCASE => text ← "IF %@%1 %↑2%(THEN %@%&2%) %↑3ELSE %@%&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 => text ← "RETURN%?1 [%@%,1]";
result => text ← "RESULT%?1 [%@%,1]";
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 => text ← "RESUME%?1 [%@%,1]";
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";
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};
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};
-- Sakura constructs
compitem => text ← "%1: %2";
connectorcreate => text ← "%1: SakuraRT.Handle ← SakuraRT.Create[]";
connectorfork => text ←
"SakuraRT.IncCurrent[];%|%1 ← FORK %2;%|SakuraRT.CatalogProcId[%1]";
connectorjoin => text ← "SakuraRT.Join[%1]";
when => text ← "WHEN %1 : %2";
event => text ← "%1%(%?2 AND %2%)";
upsignal => text ← "%1 UP";
downsignal => text ← "%1 DOWN";
changesignal => text ← "%1 CHANGE";
transfer => text ← "%1 ← %2";
circuit => text ← "CIRCUIT { COMPONENTS %.1 %/NODES %.2 %/REPRESENTATION %.3 %/CONNECTIONS %.4 }";
alias => text ← "%.1 ALIAS %2";
guardianblock => {
text ← "GUARDIANBLOCK {%+2%/1%1;%/2%2}"};
whenup => text ← "SakuraRT.GetNew[%1, TRUE];%| %2";
whendown => text ← "SakuraRT.GetNew[%1, FALSE];%| %2";
whenchange => text ← "SakuraRT.GetNewChange[%1];%| %2";
connectorassign => text ← "SakuraRT.Put[%1, %2]";
step => text ← "STEP";
-- These constructs should not appear because they are replaced in SakuraRewrite
mossim => text ← "FILE %1 %|REPRESENTATION %2 %|CONTROL %3";
ENDCASE => kind ← special
EXITS
bin => kind ← binary;
max => level ← MaxLevel;
procType => kind ← proc;
textApply => {kind ← applytext; level ← MaxLevel}}};
BreakHintFromNode: PROC [t: Tree.Link] RETURNS [BOOLEAN] = {
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,
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 [BOOLEAN] = {
-- 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 => RETURN [DanglingElse[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: Index ← indent;
IF left # 0C THEN WriteChar[left];
indent ← position;
PrettyList[t, separator];
SELECT left FROM
'{ => WriteChar['}];
'( => WriteChar[')];
'[ => WriteChar[']]
ENDCASE;
indent ← oldIndent};
PrettySons: PROC [tl: Tree.Link, separator: Char ← ';] = {
WITH tl SELECT FROM
t: Tree.Handle =>
{sons: NAT = t.sonLimit - 1;
break: BOOLEAN ← 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: Index ← GetInfo[son1];
lastLine: Index ← line;
FlushCommentsBefore[lastInfo];
lastLine ← line;
PrettyLink[son1];
FOR nth: NAT IN [2..sons] DO
link: Tree.Link ← t[nth];
thisInfo: Index ← GetInfo[link];
thisBreak: BOOLEAN ←
-- 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;
WriteChar[separator];
WriteChar[' ];
FlushCommentsBefore[lastInfo ← thisInfo];
IF thisBreak THEN Break[];
lastLine ← line;
PrettyLink[link]
ENDLOOP}}
ENDCASE};
PrettyDecl: PROC [t: Tree.Link, text: Ref] = {
init: Tree.Link ← NthSon[t, 3];
ids: Tree.Link ← NthSon[t, 1];
equate, public, readonly: BOOLEAN;
pat: Ref ← "%+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%←}%)";
label => pat ← "%+2%P%R%2%?3 = {%*%3}";
ENDCASE;
IF ids # NIL THEN
{oldIndent: Index ← 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: Ref, tail: Tree.Link ← NIL, tailKey: Ref ← NIL] = {
oldIndent: Index ← 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: Ref, level: Index] = {
oldIndent: Index ← 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: Ref ← "%;0";
IF forClause # NIL THEN
{PrettyLink[forClause]; WriteChar[' ]; indent ← oldIndent + 4};
IF whileTest # NIL THEN
{[] ← PrettyPattern[whileTest, "WHILE %@%0 "];
IF indent = oldIndent THEN indent ← oldIndent + 2};
IF whileTest = NIL AND forClause = NIL
THEN {[] ← PrettyPattern[code, "DO "];
indent ← oldIndent + 3}
ELSE [] ← 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];
indent ← position;
IF OpName[code] = block
THEN [] ← PrettyPattern[code, "%(%?1%;1; %/2%)%;2"]
ELSE [] ← PrettyNode[LOOPHOLE[code, Tree.Handle]];
PrettyExits[exits, "%/0EXITS"]};
module =>
{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: BOOLEAN ← GetAttrs[init].a2;
defs: BOOLEAN = OpName[type] = definitionTC;
[] ← PrettyPattern[decl, "%/1%,1: %*%2"];
indent ← oldIndent + 2;
outer ← FALSE;
[] ← 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: Ref, level: Index ← 0, pos: NAT ← 0, enable: BOOLEAN ← 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: Index = IF text = NIL THEN 0 ELSE Rope.Size[text];
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: CHARACTER] = INLINE {
IF pos >= size THEN RETURN ['%];
c ← text[pos];
pos ← pos + 1};
GetNum: PROC RETURNS [NAT] = INLINE {
IF pos >= size THEN RETURN [0];
{nc: CHARACTER ← text[pos];
IF nc IN ['0..'9] THEN {pos ← pos + 1; RETURN [nc - '0]};
RETURN [0]}};
nSons: NAT ← 0;
oldIndent: Index ← indent;
oldLevel: Index ← level;
oldPublic: BOOLEAN ← defaultPublic;
oldOuter: BOOLEAN ← outer;
oldLine: Index ← 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: CHARACTER ← 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: CHARACTER ← GetChar[];
link: Tree.Link ← GetSon[];
lpos: Index ← pos;
lenb: BOOLEAN ← 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] 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] THEN Break[];
indent ← position};
'↑ =>
IF position > indent THEN
{link: Tree.Link ← GetSon[];
IF link # NIL THEN
{start: Index ← GetInfo[t];
next: Index ← GetInfo[link];
IF next # 0 AND
(position > lateTrigger OR CT.TestBreakHint[start, next] OR
WillExceed[t, pattern, level, pos]) 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: Index ← CT.GetEnding[];
FlushCommentsBefore[end];
Break[];
WriteText["END."];
indent ← 0};
'Q => outer ← FALSE;
'P, 'M, 'V, 'R =>
{machineDep, public, other: BOOLEAN;
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.