-- UnparserImpl.mesa,
-- last edited by GNelson June 17, 1983 3:02 pm

-- 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, March 20, 1983 11:22 pm

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

UnparserImpl: MONITOR
IMPORTS UnparserBuffer, Atom, Real, IO, ParseTable
EXPORTS Unparser
= 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.CreateOutputStreamToRope[];
UB.Ropeb[" "]; -- indent seven spaces
culpritG ← culprit;
Unp[f, NIL, p, openCount ! Error => CONTINUE];
UB.Newlineb[0];
RETURN [IO.GetOutputStreamRope[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[1000 * x];
UnpInt[ n / 1000];
UB.Charb['.];
n ← n MOD 1000;
{i: INT ← 100;
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 = 2 AND arg2 # NIL
=> {IF uncle = NIL OR Car[op] # Car[uncle] THEN UB.Setb[];
Unp[arg1, NIL, p, 0];
UB.Bp[TRUE, - 2 - Atom.Length
[NARROW[NARROW[op, LIST OF REF ANY].first, ATOM]]];
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[]};

type = 3 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]}};

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 = 5 AND arg2 = NIL
=> {Unp[op, NIL, p, 0];
UB.Charb[' ];
Unp[arg1, NIL, p, openCount]};

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];
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.Length
[NARROW[NARROW[op, LIST OF REF ANY].first, ATOM]]];
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[]};

ENDCASE => ERROR Error};

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

END.