-- UnparserBufferImpl.mesa
-- Last Edited by: Gnelson, December 6, 1983 2:05 am

DIRECTORY IO, UnparserBuffer, Rope, Atom;

UnparserBufferImpl: PROGRAM
IMPORTS IO, Rope, Atom
EXPORTS UnparserBuffer
= BEGIN OPEN UnparserBuffer;

-- The comments here apply to any handle.

-- n : INT = 256; both queues and the stack will have n elements

-- bl, cl, br, cr, sr, srx: INTEGER; in [0, n).

-- c: ARRAY [0 .. n) OF CHAR; a queue with pointers cl, cr
-- b: ARRAY [0 .. n) OF a queue with pointers bl, br
-- RECORD [type: {setb, breakpoint},
-- united: BOOL, relevant only if type = breakpoint
-- offset: INTEGER, relevant only if type = breakpoint
-- p: [0 .. n)]; index in c of following buffer char
-- s: ARRAY [0 .. n) OF INTEGER; a stack with pointer sr

-- The indentations of the setbs that have been removed from the
-- buffer but whose matching endbs have not yet been processed
-- are stored in s[0], s[1], ... s[sr-1]. Furthermore, for i < srx, the
-- setb whose indentation is stored in s[i] has been broken; for
-- srx <= i < sr, s[i] is the indentation of a setb on the "current line"
-- that may or may not be broken.

-- indentation: INTEGER;

-- margin: PUBLIC INTEGER;

-- bufferWidth: INTEGER;

-- output: PUBLIC IO.STREAM;

-- Width: PROC [c: CHAR] RETURNS [INTEGER] = {RETURN [1]};

NewHandle: PUBLIC PROC RETURNS [Handle] =
{h: Handle ← NEW[HandleRec];
RETURN [h]};

Init: PUBLIC PROC [h: Handle] =
{h.bufferWidth ← h.bl ← h.cl ← h.br ← h.cr ← h.sr ← h.srx ← h.indentation ← 0;
-- now do a setb
h.s[0] ← 0;
h.sr ← 1};

Right: PROC [m: INTEGER] RETURNS [INTEGER] = INLINE
{IF m + 1 = n THEN RETURN [0] ELSE RETURN [m + 1]};

Left: PROC [m: INTEGER] RETURNS [INTEGER] = INLINE
{IF m = 0 THEN RETURN [n - 1] ELSE RETURN [m - 1]};

Setb: PUBLIC PROC[h: Handle] =
{OPEN h;
IF bl = br AND cl = cr
THEN {s[sr] ← indentation;
sr ← sr + 1;
IF sr = n THEN ERROR} -- Setb's too deeply nested
ELSE {b[br] ← [setb, FALSE, 0, cr];
br ← Right[br];
IF br = bl THEN ERROR}}; -- Too many active Setbs and Bps

Endb: PUBLIC PROC[h: Handle] =
{OPEN h;
WHILE bl # br AND b[Left[br]].type = breakpoint
DO br ← Left[br] ENDLOOP;
IF bl # br
THEN br ← Left[br]
ELSE {WHILE cl # cr
DO OutputChar[h] ENDLOOP;
IF sr = 0
THEN ERROR -- Endb with no matching Setb
ELSE {IF srx = sr THEN srx ← srx - 1;
sr ← sr - 1}}};

OutputChar: PROC[h: Handle] =
{OPEN h;
IO.PutChar[output, c[cl]];
indentation ← indentation + width[c[cl]];
bufferWidth ← bufferWidth - width[c[cl]];
cl ← Right[cl]};

Bp: PUBLIC PROC[h: Handle, united: BOOL, offset: INTEGER] =
{OPEN h;
b[br] ← [breakpoint, united, offset, cr];
br ← Right[br];
IF br = bl THEN ERROR; -- Too many active Setbs and Bps
LeftLoop[h]};

Charb: PUBLIC PROC [h: Handle, ch: CHAR] =
{OPEN h;
c[cr] ← ch;
cr ← Right[cr];
IF cr = cl THEN ERROR; -- Too many characters
bufferWidth ← bufferWidth + width[ch];
LeftLoop[h]};

Ropeb: PUBLIC PROC[h: Handle, r: Rope.ROPE] =
{FOR i: INT IN [0 .. Rope.Length[r])
DO Charb[h, Rope.Fetch[r, i]] ENDLOOP};

Atomb: PUBLIC PROC[h: Handle, a: ATOM] = {Ropeb[h, Atom.GetPName[a]]};

LeftLoop: PROC[h: Handle] =
{OPEN h;
DO SELECT TRUE FROM

cl # cr AND (bl = br OR b[bl].p # cl) => OutputChar[h];

bl # br AND (cl = cr OR b[bl].p = cl) AND b[bl].type = setb
=> {s[sr] ← indentation;
sr ← sr + 1;
IF sr = n THEN ERROR; -- Too many nested Setb
bl ← Right[bl]};

bl # br AND (cl = cr OR b[bl].p = cl) AND b[bl].type = breakpoint
AND (srx = sr AND b[bl].united OR indentation + bufferWidth > margin)
=> {Breakline[h, s[sr-1] + b[bl].offset]; srx ← sr; bl ← Right[bl]}; 

bl # br AND (cl = cr OR b[bl].p = cl) AND b[bl].type = breakpoint
AND Right[bl] # br AND b[Right[bl]].type = breakpoint
AND ~ b[Right[bl]].united
=> bl ← Right[bl]

ENDCASE => EXIT ENDLOOP};

Breakline: PROC[h: Handle, indent: INTEGER] =
{IO.PutChar[h.output, IO.CR];
FOR i: INT IN [0 .. indent) DO IO.PutChar[h.output, IO.SP] ENDLOOP;
h.indentation ← indent};

Newlineb: PUBLIC PROC[h: Handle, offset: INTEGER] =
{m: INTEGER = h.margin;
Bp[h, TRUE, offset];
h.margin ← -1;
LeftLoop[h];
h.margin ← m};

END.