-- OldUnparserImpl.mesa, 
-- last edited by GNelson January 17, 1984 11:33 am

-- For unparsing, the operators fall into the following classes:

-- 1. Infix ops preceded by their breakpoint with offset zero:     -> := cong para

-- 2. Infix ops preceded by their breakpoints with negative offsets:     // | and

-- 3. Matchfix ops with space-padded arguments:      if do

-- 4. Infix ops followed by their breakpoint with zero offset:    , ; :

-- 5. Prefix ops:     hor, ver, cc, draw, ex

-- 6. Matchfix ops with un-space-padded arguments that are also Subfix ops 
--    with un-space-padded arguments:       (

-- 7. Infix ops preceded by their breakpoints with negative offsets, but with
-- no space  before them: , and ; 
--
-- Last Edited by: Gnelson, November 2, 1983 11:59 am

DIRECTORY Rope, UnparserBuffer, List, Atom, OldUnparser, Real, IO, ParseTable;

OldUnparserImpl: MONITOR
  IMPORTS UnparserBuffer, Atom, Real, IO, ParseTable, Rope
  EXPORTS OldUnparser
= BEGIN OPEN PT: ParseTable;
   UB: UnparserBuffer.Handle _ UnparserBuffer.NewHandle[];

Unparse: PUBLIC ENTRY PROC[f: REF ANY, -- unparse Car[f], ignore Cdr[f].
                            		 culprit: REF ANY,
                            		 margin: INTEGER, 
                            		 p: PT.Handle,
                            		 openCount: INT] 
          RETURNS [Rope.ROPE] =
  {UB.Init[];
   UB.margin _ margin;   
   UB.output _ IO.ROS[];
   UB.Ropeb["  "];  -- indent two spaces
   culpritG _ culprit;
   Unp[f, NIL, p, openCount ! Error => CONTINUE];
   UB.Newlineb[0];
   RETURN [IO.RopeFromROS[UB.output]]};

culpritG: REF ANY; --! global var storing culprit, to be replaced by local 

Error: ERROR = CODE;

Unp: PROC[f: REF ANY, uncle: REF ANY, p: PT.Handle, openCount: INT] =
  {ff: LIST OF REF ANY = NARROW[f];
   IF ff = culpritG THEN UB.Charb[0C];
   WITH ff.first SELECT FROM
    fi: REF INT =>  UnpInt[fi^];
    fa: ATOM => UB.Ropeb[Atom.GetPName[fa]];
    fr: Rope.ROPE => {UB.Charb['"]; UB.Ropeb[fr]; UB.Charb['"]};
    fx: REF REAL => UnpReal[fx^];
    fl: LIST OF REF ANY => UnpList[fl, uncle, p, openCount];
    ENDCASE => NULL;
    IF ff = culpritG THEN UB.Charb[0C];
    };
  
 UnpReal: PROC [x: REAL] = 
   {IF x < 0 THEN {UB.Charb['-]; x _ - x};
    {n: INT _ Real.RoundLI[10000 * x];
     UnpInt[ n / 10000];
     UB.Charb['.];
     n _ n MOD 10000;
     {i: INT _ 1000;
     WHILE n # 0 DO UB.Charb['0 + (n / i)]; n _ n MOD i; i _ i / 10 ENDLOOP;
     }}};
 
 UnpInt: PROC[i: INT] = 
  {IF i = 0 THEN UB.Charb['0] 
   ELSE {IF i < 0 THEN {UB.Charb['-]; i _ - i};
           UnpInt2[i]}};
 
 LexemeToRope: PUBLIC PROC[f: REF ANY] RETURNS [Rope.ROPE] =
   {RETURN[IO.PutFR[NIL, IO.refAny[f]]]};
     
 UnpInt2: PROC[i: INT] =
   {IF i # 0 THEN {UnpInt2[i / 10]; UB.Charb['0 + (i MOD 10)]}};
 
 UnpList: --recursive-- PROC [l: LIST OF REF ANY,
                                    uncle: REF ANY,
                                    p: PT.Handle,
                                    openCount: INT] =
   {op: REF ANY = l;
    arg1: REF ANY = l.rest;
    arg2: REF ANY =  l.rest.rest;
    opType: PT.Properties = p.Search[NARROW[op, LIST OF REF ANY].first, NIL];
    type: INT _ opType.unparserType;
    
    SELECT TRUE FROM
      
     type = 1 AND arg2 # NIL
     => {UB.Setb[]; 
          Unp[arg1, NIL, p, 0];
          UB.Charb[' ];
          UB.Bp[TRUE, 0];
          Unp[op, NIL, p, 0];
          UB.Charb[' ];
          Unp[arg2, NIL, p, openCount];
          UB.Endb[]};
        
       type = 4 AND arg2 # NIL
       => {IF uncle = NIL OR Car[op] # Car[uncle] THEN UB.Setb[];
            Unp[arg1, NIL, p, 0];
            Unp[op, NIL, p, 0];
            UB.Bp[FALSE, -1];
            UB.Charb[' ];
            Unp[arg2, op, p, openCount];
            IF uncle = NIL OR Car[op] # Car[uncle] THEN UB.Endb[]};
        
        type = 6 AND arg2 = NIL
        => {Unp[op, NIL, p, 0];
             Unp[arg1, NIL, p, openCount - 1];
             IF openCount <= 0 THEN UB.Atomb[opType.closer.name]};
        
        type = 6 AND arg2 # NIL
        => {UB.Setb[];
             Unp[arg1, NIL, p, 0];
             UB.Bp[TRUE, - 1 - Atom.GetPName
                                  [NARROW[NARROW[op, LIST OF REF ANY].first, ATOM]].Length];
             Unp[op, NIL, p, 0];
             Unp[arg2, NIL, p, openCount - 1];
             IF openCount <= 0 THEN UB.Atomb[opType.closer.name];
             UB.Endb[]};

         type = 7 AND arg2 # NIL
      => {IF uncle = NIL OR Car[op] # Car[uncle] THEN UB.Setb[];
          Unp[arg1, NIL, p, 0];
          UB.Bp[TRUE, - 1 - Atom.GetPName
                                  [NARROW[NARROW[op, LIST OF REF ANY].first, ATOM]].Length];
          Unp[op, NIL, p, 0];
          UB.Charb[' ];
          Unp[arg2, op, p, openCount];
          IF uncle = NIL OR Car[op] # Car[uncle] THEN UB.Endb[]};
          
       type = 8 AND arg2 # NIL
       => {UB.Setb[];
            Unp[arg1, NIL, p, 0];
            UB.Charb[' ];
            Unp[op, NIL, p, 0];
            UB.Charb[' ];
            UB.Bp[FALSE, 0];
            Unp[arg2, op, p, openCount];
            UB.Endb[]};

      opType.infix AND arg2 # NIL
      => {IF uncle = NIL OR Car[op] # Car[uncle] THEN UB.Setb[];
          Unp[arg1, NIL, p, 0];
          UB.Bp[TRUE, - 2 - Atom.GetPName
                                  [NARROW[NARROW[op, LIST OF REF ANY].first, ATOM]].Length];
          UB.Charb[' ];
          Unp[op, NIL, p, 0];
          UB.Charb[' ];
          Unp[arg2, op, p, openCount];
          IF uncle = NIL OR Car[op] # Car[uncle] THEN UB.Endb[]};
       
       opType.matchfix AND arg2 = NIL
       => {Unp[op, NIL, p, 0];
            UB.Charb[' ];
            Unp[arg1, NIL, p, openCount - 1];
            IF openCount <= 0 THEN {UB.Charb[' ];
                                           UB.Atomb[opType.closer.name]}};
        
        opType.prefix AND arg2 = NIL
        => {Unp[op, NIL, p, 0];
             UB.Charb[' ];
             Unp[arg1, NIL, p, openCount]};
        
        opType.postfix AND arg2 = NIL
        => {Unp[arg1, NIL, p, openCount];
             UB.Charb[' ];
             Unp[op, NIL, p, 0]};
        opType.subfix AND arg2 # NIL
        => {UB.Setb[];
             Unp[arg1, NIL, p, 0];
             UB.Charb[' ];
             UB.Bp[TRUE, - 2 - Atom.GetPName
                                  [NARROW[NARROW[op, LIST OF REF ANY].first, ATOM]].Length];
             Unp[op, NIL, p, 0];
             UB.Charb[' ];
             Unp[arg2, NIL, p, openCount - 1];
             UB.Charb[' ];
             IF openCount <= 0 THEN UB.Atomb[opType.closer.name];
             UB.Endb[]};
       
       opType.busfix AND arg2 # NIL
       =>  {Unp[op, NIL, p, 0];
             UB.Setb[];
             UB.Charb[' ];
             Unp[arg1, NIL, p, 0];
             UB.Charb[' ];
             UB.Bp[TRUE, - Atom.GetPName[opType.closer.name].Length];
             UB.Atomb[opType.closer.name];
             UB.Charb[' ];
             Unp[arg2, NIL, p, openCount];
             UB.Endb[]};

     
     ENDCASE => ERROR Error};
     
Car: PROC [s: REF ANY] RETURNS [REF ANY] =
 {RETURN [NARROW[s, LIST OF REF ANY].first]};
     
  END.