-- 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.