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