
DIRECTORY Atom, IO, Rope, RuntimeError, UnparserBuffer; 

UnparserBufferImpl3: CEDAR PROGRAM
IMPORTS Atom, IO, Rope, RuntimeError
EXPORTS UnparserBuffer
=

BEGIN OPEN UnparserBuffer;

LORA: TYPE ~ LIST OF REF ANY;
REFTEXT: TYPE ~ REF READONLY TEXT;
REFCHAR: TYPE ~ REF CHAR;
biggestN: CARDINAL = LAST[Nat];

Privates: TYPE = REF PrivateParts;
PrivateParts: PUBLIC TYPE = RECORD [
miserable, debug: BOOL,
outIndent: Nat Ź 0, --indentation at output end of buffer
newline: ROPE,
n: NAT Ź 0,	--size of queues and stack
bl, cl, br, cr, sr, srx: NAT--[0 .. n)-- Ź 0,
buff: Seq Ź NIL,
bufferWidth: NAT Ź 0,	--sum of widths of chars in c
hasAlways: BOOL Ź FALSE, --there's an always break in the buffer
leftBroke: BOOL Ź FALSE,
maySetb: BOOL Ź TRUE, --at pre-buffer insertion, last miser is in innermost object or ancestor
prebIndent: Nat Ź 0,
rm: OpBreak Ź NIL, --dummy root miser
lm: OpBreak Ź NIL, --rightmost miser that affects coming pre-input
obs: ObStack Ź NIL
];

StuffPtrStack: TYPE ~ LIST OF StuffPtr;
StuffPtr: TYPE ~ RECORD [o: Obj, i: StuffSeqIndex];
nilStuffPtr: StuffPtr ~ [NIL, 0];

StuffSeqIndex: TYPE ~ INTEGER[0..8);
Stuff: TYPE ~ RECORD [
type: {obj, bp, chars, changes},
dwidth: INTEGER, --for a break, this is the sep's width
data: REF ANY --actually UNION [ROPE, REFTEXT, Obj, OpBreak, Changes]
];

ObStack: TYPE ~ LIST OF Obj;
Obj: TYPE ~ REF ObjPrivate;
ObjPrivate: TYPE ~ RECORD [
si: Nat, --prebIndent at setb
dm: OpBreak, --determining miser: rightmost one that affects my setb indent
maxdwidth: Nat Ź 0, --actual maximum excursion beyond setb
broke: BOOL Ź FALSE,
end: StuffPtr Ź nilStuffPtr,
stuff: ARRAY StuffSeqIndex OF Stuff Ź ALL[[obj, 0, NIL]],
stuffNext: Obj Ź NIL];

BreakList: TYPE ~ LIST OF OpBreak;
OpBreak: TYPE ~ REF OpBreakPrivate;
OpBreakPrivate: TYPE ~ RECORD [
cond: XBreakCondition, offset: INTEGER, sep: ROPE,
next: OpBreak Ź NIL, --next takable sibling
advantage, need: Nat Ź 0, children: BreakList Ź NIL,
taken: BOOL Ź FALSE, solns: Solns Ź NIL];

Solns: TYPE ~ REF SolnSeq;
SolnSeq: TYPE ~ RECORD [
maxNeed: Nat, --MAX[need, MAX(over all kids) kid.maxNeed]
minA: INTEGER, --MAX[need, MAX(over all kids) kid.minA] - advantage
size: Nat, --of subtree
len: Nat, --occupied sequence slots
elts: SEQUENCE maxLen: Nat OF SolnInterval];

SolnInterval: TYPE ~ RECORD [startIA, cost: Nat, take: NMY];
NMY: TYPE ~ {no, maybe, yes};

Seq: TYPE = REF Sequence;
Sequence: TYPE = RECORD [elts: SEQUENCE length: NAT OF Element];

Element: TYPE = RECORD [
c: CHAR,
changes: Changes Ź NIL,
s: INTEGER,
bs: BStuff
];

BStuff: TYPE = RECORD [
type: {setb, breakpoint},
cond: BreakCondition,
offset: INTEGER,
sepChars, sepWidth: NAT,
p: NAT	--index in c of following buffer char
];

Changes: TYPE = REF ChangesPrivate;
ChangesPrivate: TYPE = RECORD [
dlooks: ROPE Ź NIL,
chgSet: BOOL Ź FALSE, charSet: CharSet Ź 0,
charProps, nodeProps: PropList Ź NIL,
nodeFormat, nodeComment: ATOM Ź NIL
];

clearProps: PropList = LIST[NIL];
charRefs: REF ARRAY CHAR OF ROPE Ź NIL;

BogusInput: PUBLIC ERROR [msg: ROPE] ~ CODE;

Create: PUBLIC PROC [publics: PublicParts, miserable: BOOL Ź TRUE, newline: ROPE Ź NIL, debug: BOOL Ź FALSE] RETURNS [h: Handle] = {
h Ź NEW [PublicParts Ź publics];
IF h.spacers = NIL THEN h.spacers Ź LIST[IO.SP];
h.ps Ź XCreatePrivates[h.margin, miserable, newline, debug];
Init[h];
RETURN};

NewInittedHandle: PUBLIC PROC [publics: PublicParts] RETURNS [h: Handle]
= {RETURN Create[publics, FALSE]};

XCreatePrivates: PUBLIC PROC [margin: Nat Ź 80, miserable: BOOL Ź TRUE, newline: ROPE Ź NIL, debug: BOOL Ź FALSE] RETURNS [ps: Privates] = {
IF newline=NIL THEN newline Ź "\n";
ps Ź NEW [PrivateParts Ź [miserable: miserable, debug: debug, newline: newline, n: margin+3, buff: NEW [Sequence[margin+3]] ]];
RETURN};

CreatePrivates: PUBLIC PROC [margin: Nat Ź 80] RETURNS [ps: Privates]
~ {RETURN XCreatePrivates[margin, FALSE]};

Init: PUBLIC PROC [h: Handle] = {
ps: Privates ~ h.ps;
ps­ Ź [miserable: ps.miserable, debug: ps.debug, newline: ps.newline, n: ps.n, buff: ps.buff];
IF NOT ps.miserable THEN Setb[h];
RETURN};

Setb: PUBLIC PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;
IF debug THEN Charb[h, '{]
ELSE IF miserable THEN {
IF obs=NIL THEN {
lm Ź rm Ź NEW [OpBreakPrivate Ź [miser, 0, NIL]];
prebIndent Ź outIndent};
IF NOT maySetb THEN ERROR BogusInput["miser restriction violated"];
{obj: Obj ~ NEW [ObjPrivate Ź [si: prebIndent, dm: lm]];
obj.end Ź [obj, 0];
IF obs#NIL THEN AddStuff[ps, [obj, 0, obj]];
obs Ź CONS[obj, obs];
RETURN}}
ELSE {
IF bl = br AND cl = cr
THEN {
Ensure[h, sr+2];
buff[sr].s Ź outIndent;
sr Ź sr + 1}
ELSE {
Ensure[h, BCount[h]+2];
buff[br].bs Ź [setb, width, 0, 0, 0, cr];
br Ź Right[h, br]};
RETURN}}};

Endb: PUBLIC PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;
IF debug THEN Charb[h, '}]
ELSE IF miserable THEN {
IF obs.rest=NIL THEN {
lm.need Ź MAX[lm.need, prebIndent-margin];
SolveTree[h, ps];
[] Ź SolveObj[h, ps, obs.first, outIndent, 0, LIST[nilStuffPtr]];
OutputObj[h, ps, obs.first];
};
maySetb Ź lm = obs.first.dm;
obs Ź obs.rest;
RETURN}
ELSE {brl: NAT;
WHILE bl # br AND buff[brl Ź Left[h, br]].bs.type = breakpoint DO br Ź brl ENDLOOP;
IF bl # br THEN br Ź Left[h, br]
ELSE {
WHILE cl # cr DO OutputC[h] ENDLOOP;
IF sr = 0 THEN ERROR BogusInput["Endb with no matching Setb"]
ELSE {
IF srx = sr THEN {
srx Ź srx - 1;
leftBroke Ź TRUE};
sr Ź sr - 1};
};
RETURN}}};

OutputC: PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;
IF buff[cl].changes # NIL THEN OutputChanges[h, buff[cl].changes];
OutputChar[h, buff[cl].c];
outIndent Ź outIndent + width[buff[cl].c];
bufferWidth Ź bufferWidth - width[buff[cl].c];
cl Ź Right[h, cl];
IF cl = cr AND buff[cr].changes # NIL THEN {OutputChanges[h, buff[cr].changes]; buff[cr].changes Ź NIL}}};

OutputChanges: PROC [h: Handle, changes: Changes] = {
ps: Privates = h.ps; {OPEN ps, h;
WITH h.output SELECT FROM
so: BufferOutput.stream => {
IF changes.dlooks # NIL THEN IO.PutF1[so.stream, "%l", [rope[changes.dlooks]]];
IF changes.charProps # NIL THEN IO.PutF1[so.stream, "%p", [refAny[Newize[changes.charProps]]]];
IF changes.nodeProps # NIL THEN IO.PutF1[so.stream, "%n", [refAny[Newize[changes.nodeProps]]]];
IF changes.nodeFormat # NIL THEN IO.PutF1[so.stream, "%n", [atom[changes.nodeFormat]]];
IF changes.nodeComment # NIL THEN IO.PutF1[so.stream, "%n", [boolean[changes.nodeComment = $TRUE]]];
};
ENDCASE => ERROR;
}};

Bp: PUBLIC PROC [h: Handle, cond: BreakCondition, offset: INTEGER, sep: ROPE]
~ {XBp[h, advance[cond], offset, sep]};

advance: ARRAY BreakCondition OF XBreakCondition
~ [width: width, lookLeft: lookLeft, united: united, always: always];

retreat: ARRAY XBreakCondition[width..always] OF BreakCondition
~ [width: width, lookLeft: lookLeft, united: united, always: always];

condChar: ARRAY XBreakCondition OF CHAR ~ [never: 'n, miser: 'm, width: 'w, lookLeft: 'l, united: 'u, always: 'a];

XBp: PUBLIC PROC [h: Handle, cond: XBreakCondition, offset: INTEGER, sep: ROPE] = {
ps: Privates = h.ps;
IF cond=always THEN sep Ź NIL;
IF ps.debug THEN {Ropeb[h, IO.PutFR["<%g%g\"%q\">", [character[condChar[cond]]], [integer[offset]], [rope[sep]] ]]; RETURN};
IF cond=never THEN {Ropeb[h, sep]; RETURN};
{OPEN ps, h;
sepChars: Nat ~ sep.Length;
sepWidth: Nat ~ RopeWidth[h, ps, sep, 0, sepChars];
IF miserable THEN {
IF obs#NIL THEN {
bp: OpBreak Ź NEW [OpBreakPrivate Ź [cond, offset, sep]];
lm.need Ź MAX[lm.need, prebIndent-margin];
IF cond=miser THEN {
advantage: INTEGER ~ prebIndent+sepWidth-(obs.first.si+offset);
IF lm # obs.first.dm THEN ERROR BogusInput["miser restriction violated"];
maySetb Ź TRUE;
IF advantage <= 0 THEN {Ropeb[h, sep]; RETURN};
bp.advantage Ź advantage;
obs.first.dm.children Ź CONS[bp, obs.first.dm.children];
lm Ź bp;
prebIndent Ź prebIndent + sepWidth;
}
ELSE {
lm Ź obs.first.dm;
maySetb Ź TRUE;
bp.taken Ź cond=always;
prebIndent Ź obs.first.si + offset};
AddStuff[ps, [bp, sepWidth, bp]];
RETURN};
IF cond#always THEN ERROR BogusInput["miser-able top-level restriction violated"];
Breakline[h, offset];
maySetb Ź TRUE;
RETURN}
ELSE IF cond=miser THEN ERROR BogusInput["miser break given to non-miser-able implementation"]
ELSE {rCond: BreakCondition ~ retreat[cond];
crOrig: Nat ~ cr;
IF cond = always THEN hasAlways Ź TRUE;
Ensure[h, CCount[h] + sepChars + 1];
FOR i: NAT IN [0 .. sepChars) DO
ch: CHAR = Rope.Fetch[sep, i];
buff[cr].c Ź ch;
cr Ź Right[h, cr];
buff[cr].changes Ź NIL;
ENDLOOP;
bufferWidth Ź bufferWidth + sepWidth;
Ensure[h, BCount[h]+2];
buff[br].bs Ź [breakpoint, rCond, offset, sepChars, sepWidth, crOrig];
br Ź Right[h, br];
LeftLoop[h]}}};

Charb: PUBLIC PROC [h: Handle, ch: CHAR] = {ps: Privates = h.ps; {OPEN ps, h;
w: INTEGER ~ width[ch];
IF miserable THEN {
IF obs#NIL
THEN {AddStuff[ps, [chars, w, charRefs[ch]]]; prebIndent Ź prebIndent + w}
ELSE {OutputChar[h, ch]; outIndent Ź outIndent+w}}
ELSE {
Ensure[h, CCount[h]+2];
buff[cr].c Ź ch;
cr Ź Right[h, cr];
buff[cr].changes Ź NIL;
bufferWidth Ź bufferWidth + w;
LeftLoop[h]};
RETURN}};

OutputChar: PROC [h: Handle, ch: CHAR] ~ {
WITH h.output SELECT FROM
so: BufferOutput.stream => IO.PutChar[so.stream, ch];
ENDCASE => ERROR;
RETURN};

Looksb: PUBLIC PROC [h: Handle, looks: ROPE] = {
ps: Privates = h.ps; {OPEN ps, h;
IF CBuffering[ps] THEN {
cs: Changes ~ EnsureChangeOp[ps];
cs.dlooks Ź cs.dlooks.Concat[looks]}
ELSE OutputEscape[h, "%l", [rope[looks]]];
RETURN}};

CBuffering: PROC [ps: Privates] RETURNS [BOOL]
~ INLINE {RETURN [IF ps.miserable THEN ps.obs#NIL ELSE ps.cl#ps.cr]};

EnsureChangeOp: PROC [ps: Privates] RETURNS [cs: Changes] ~ {
IF ps.miserable THEN {
stuff: Stuff ~ StuffRef[ps.obs.first.end];
IF stuff.type = changes THEN RETURN [NARROW[stuff.data]];
AddStuff[ps, [changes, 0, cs Ź NEW [ChangesPrivate Ź []]]];
RETURN}
ELSE {
IF ps.buff[ps.cr].changes = NIL THEN ps.buff[ps.cr].changes Ź NEW [ChangesPrivate Ź []];
RETURN [ps.buff[ps.cr].changes]}};

OutputEscape: PROC [h: Handle, fmt: ROPE, val: IO.Value] ~ {
WITH h.output SELECT FROM
so: BufferOutput.stream => IO.PutF1[so.stream, fmt, val];
ENDCASE => ERROR;
RETURN};

CharPropsb: PUBLIC PROC [h: Handle, props: PropList] = {
ps: Privates = h.ps; {OPEN ps, h;
IF CBuffering[ps]
THEN EnsureChangeOp[ps].charProps Ź Oldize[props]
ELSE OutputEscape[h, "%p", [refAny[props]]];
RETURN}};

CharSetb: PUBLIC PROC [h: Handle, charSet: CharSet] = {
ps: Privates = h.ps; {OPEN ps, h;
IF CBuffering[ps] THEN {
cs: Changes ~ EnsureChangeOp[ps];
cs.chgSet Ź TRUE; cs.charSet Ź charSet}
ELSE OutputEscape[h, "%p", [cardinal[charSet]]];
RETURN}};

NodeFormatb: PUBLIC PROC [h: Handle, format: ATOM] = {
ps: Privates = h.ps; {OPEN ps, h;
IF CBuffering[ps] THEN {
cs: Changes ~ EnsureChangeOp[ps];
cs.nodeFormat Ź format}
ELSE OutputEscape[h, "%n", [atom[format]]];
RETURN}};

NodePropsb: PUBLIC PROC [h: Handle, props: PropList] = {
ps: Privates = h.ps; {OPEN ps, h;
IF CBuffering[ps] THEN {
cs: Changes ~ EnsureChangeOp[ps];
cs.nodeProps Ź Oldize[props]}
ELSE OutputEscape[h, "%n", [refAny[props]]];
RETURN}};

NodeCommentb: PUBLIC PROC [h: Handle, comment: BOOL] = {
ps: Privates = h.ps; {OPEN ps, h;
IF CBuffering[ps] THEN {
cs: Changes ~ EnsureChangeOp[ps];
cs.nodeComment Ź IF comment THEN $TRUE ELSE $FALSE}
ELSE OutputEscape[h, "%n", [boolean[comment]]];
RETURN}};

Ropeb: PUBLIC PROC [h: Handle, r: ROPE] = {
ps: Privates = h.ps; {OPEN ps, h;
len: Nat ~ r.Length[];
IF len=0 THEN RETURN;
{dwidth: Nat ~ RopeWidth[h, ps, r, 0, len];
IF NOT CBuffering[ps] THEN {OutputRope[h, r]; outIndent Ź outIndent + dwidth}
ELSE IF miserable THEN {AddStuff[ps, [chars, dwidth, r]]; prebIndent Ź prebIndent + dwidth}
ELSE {AddChars[h, ps, r, 0, len]; bufferWidth Ź bufferWidth + dwidth};
RETURN}}};

Textb: PUBLIC PROC [h: Handle, rt: REF READONLY TEXT, startIndex: NAT Ź 0, count: NAT Ź NAT.LAST] ~ {
ps: Privates = h.ps;
diff: INTEGER ~ INTEGER[rt.length] - startIndex;
dwidth: Nat;
lr: ROPE;
IF count=0 THEN RETURN;
SELECT diff FROM
>0 => count Ź MIN[count, diff];
=0 => RETURN;
<0 => ERROR RuntimeError.BoundsFault[];
ENDCASE => ERROR;
TRUSTED {lr Ź LOOPHOLE[rt]};
dwidth Ź RopeWidth[h, ps, lr, startIndex, startIndex+count];
IF NOT CBuffering[ps] THEN {
OutputText[h, rt, startIndex, count];
ps.outIndent Ź ps.outIndent + dwidth}
ELSE IF ps.miserable THEN {
ra: REF ANY;
TRUSTED {ra Ź LOOPHOLE[rt]}; --remove the READONLY attribute, 'cause ROPE isn't REF READONLY Something
WITH ra SELECT FROM
r: ROPE => IF startIndex#0 OR count<=rt.length
THEN AddStuff[ps, [chars, dwidth, r.Substr[startIndex, count]]]
ELSE AddStuff[ps, [chars, dwidth, r]]
ENDCASE => 
AddStuff[ps, [chars, dwidth, Rope.FromRefText[rt, startIndex, count]]];
ps.prebIndent Ź ps.prebIndent + dwidth}
ELSE {
AddChars[h, ps, lr, startIndex, startIndex+count];
ps.bufferWidth Ź ps.bufferWidth + dwidth;
};
RETURN};

AddChars: PROC [h: Handle, ps: Privates, r: ROPE, from, to: INT] ~ {
Ensure[h, CCount[h]+1+to-from];
FOR i: INT IN [from .. to) DO
c: CHAR ~ Rope.Fetch[r, i];
ps.buff[ps.cr].c Ź c;
ps.cr Ź Right[h, ps.cr];
ps.buff[ps.cr].changes Ź NIL;
ENDLOOP;
RETURN};

RopeWidth: PROC [h: Handle, ps: Privates, r: ROPE, from, to: INT] RETURNS [Nat] ~ {
dwidth: Nat Ź 0;
FOR i: INT IN [from .. to) DO
dwidth Ź dwidth + h.width[Rope.Fetch[r, i]]
ENDLOOP;
RETURN [dwidth]};

OutputRope: PROC [h: Handle, r: ROPE] ~ {
WITH h.output SELECT FROM
so: BufferOutput.stream => IO.PutRope[so.stream, r];
ENDCASE => ERROR;
RETURN};

OutputText: PROC [h: Handle, rt: REF READONLY TEXT, startIndex, count: NAT] ~ {
WITH h.output SELECT FROM
so: BufferOutput.stream => IO.PutBlock[so.stream, rt, startIndex, count];
ENDCASE => ERROR;
RETURN};

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

Newize: PROC [props: PropList] RETURNS [new: PropList] = INLINE {
new Ź IF props # clearProps THEN props ELSE NIL};

Oldize: PROC [props: PropList] RETURNS [new: PropList] = INLINE {
new Ź IF props # NIL THEN props ELSE clearProps};

SolveTree: PROC [h: Handle, ps: Privates] ~ {OPEN ps;
IF NOT miserable THEN ERROR;
FOR problems: BreakList Ź rm.children, problems.rest WHILE problems#NIL DO
[] Ź SolveMiserBreak[problems.first];
MarkSolution[problems.first, 0];
ENDLOOP;
RETURN};

MarkSolution: PROC [brk: OpBreak, ia: Nat] ~ {
solns: Solns ~ brk.solns;
oa: Nat Ź ia;
IF ia >= solns[solns.len.PRED].startIA THEN brk.taken Ź FALSE
ELSE IF ia < solns[0].startIA THEN brk.taken Ź TRUE
ELSE FOR idx: Nat IN [1 .. solns.len) DO
IF ia < solns[idx].startIA THEN {
brk.taken Ź SELECT solns[idx.PRED].take FROM
no => FALSE,
yes => TRUE,
maybe => preferEarly,
ENDCASE => ERROR;
EXIT};
REPEAT FINISHED => ERROR;
ENDLOOP;
IF brk.taken THEN oa Ź ia + brk.advantage;
FOR kids: BreakList Ź brk.children, kids.rest WHILE kids#NIL DO
MarkSolution[kids.first, oa];
ENDLOOP;
RETURN};
preferEarly: BOOL Ź TRUE;

FindCostRun: PROC [brk: OpBreak, startIdx, decA: Nat] RETURNS [SeqPtr] ~ {
solns: Solns ~ brk.solns;
cost: Nat ~ solns[startIdx].cost;
startIA: Nat ~ MAX[solns[startIdx].startIA - decA, 0];
next: Nat;
FOR next Ź startIdx.SUCC, next.SUCC WHILE next < solns.len AND solns[next].cost = cost DO NULL ENDLOOP;
IF next=solns.len THEN RETURN [[brk, startIA, biggestN, cost, biggestN]];
RETURN [[brk, startIA, solns[next].startIA-decA, cost, next]]};

SeqPtrList: TYPE ~ LIST OF SeqPtr;
SeqPtr: TYPE ~ RECORD [brk: OpBreak, startIA, nextIA, cost, nextIdx: Nat];

SolveMiserBreak: PROC [brk: OpBreak] RETURNS [solns: Solns] ~ {
Advance: PROC [sp: SeqPtr, advtg, c0: Nat] RETURNS [SeqPtr] ~ {
IF sp.brk#brk
THEN RETURN FindCostRun[sp.brk, sp.nextIdx, advtg]
ELSE RETURN [[brk, sp.nextIA, biggestN, c0, sp.nextIdx.SUCC]]};
maxNeed: Nat Ź brk.need;
minA: INTEGER Ź brk.need;
size: Nat Ź 1;
ohnes: SeqPtrList Ź LIST[IF brk.need>0
THEN [brk, 0, brk.need, biggestN, 1]
ELSE [brk, 0, biggestN, 0, 1]];
mits: SeqPtrList Ź LIST[IF brk.need>brk.advantage
THEN [brk, 0, brk.need-brk.advantage, biggestN, 1]
ELSE [brk, 0, biggestN, 1, 1]];
startIA: Nat;
FOR kids: BreakList Ź brk.children, kids.rest WHILE kids#NIL DO
kidSolns: Solns ~ SolveMiserBreak[kids.first];
size Ź size + kidSolns.size;
maxNeed Ź MAX[maxNeed, kidSolns.maxNeed];
minA Ź MAX[minA, kidSolns.minA];
IF kidSolns.minA > 0
THEN ohnes Ź CONS[[kids.first, 0, kidSolns.minA, biggestN, 0], ohnes]
ELSE ohnes Ź CONS[FindCostRun[kids.first, 0, 0], ohnes];
IF kidSolns.minA > brk.advantage
THEN mits Ź CONS[[kids.first, 0, kidSolns.minA-brk.advantage, biggestN, 0], mits]
ELSE {
FOR j: Nat IN [1 .. kidSolns.len) DO
IF kidSolns[j].startIA > brk.advantage THEN {
mits Ź CONS[FindCostRun[kids.first, j.PRED, brk.advantage], mits];
EXIT};
REPEAT FINISHED => mits Ź CONS[[kids.first, 0, biggestN, 0, biggestN], mits];
ENDLOOP;
};
ENDLOOP;
solns Ź NEW [SolnSeq[2*size+1]];
solns.maxNeed Ź maxNeed;
solns.minA Ź minA Ź minA - brk.advantage;
solns.size Ź size;
solns.len Ź 0;
startIA Ź MAX[minA, 0];
FOR to: SeqPtrList Ź ohnes, to.rest WHILE to#NIL DO
WHILE to.first.nextIA <= startIA DO to.first Ź Advance[to.first, 0, 0] ENDLOOP;
ENDLOOP;
FOR tm: SeqPtrList Ź mits, tm.rest WHILE tm#NIL DO
WHILE tm.first.nextIA <= startIA DO tm.first Ź Advance[tm.first, brk.advantage, 1] ENDLOOP;
ENDLOOP;
DO
nextIA: Nat Ź biggestN;
costo, costm: Nat Ź 0;
FOR to: SeqPtrList Ź ohnes, to.rest WHILE to#NIL DO
SELECT to.first.nextIA - startIA FROM
>0 => NULL;
=0 => to.first Ź Advance[to.first, 0, 0];
<0 => ERROR;
ENDCASE => ERROR;
nextIA Ź MIN[nextIA, to.first.nextIA];
IF costo#biggestN THEN costo Ź IF to.first.cost#biggestN THEN costo + to.first.cost ELSE biggestN;
ENDLOOP;
FOR tm: SeqPtrList Ź mits, tm.rest WHILE tm#NIL DO
SELECT tm.first.nextIA - startIA FROM
>0 => NULL;
=0 => tm.first Ź Advance[tm.first, brk.advantage, 1];
<0 => ERROR;
ENDCASE => ERROR;
nextIA Ź MIN[nextIA, tm.first.nextIA];
IF costm#biggestN THEN costm Ź IF tm.first.cost#biggestN THEN costm + tm.first.cost ELSE biggestN;
ENDLOOP;
{dif: INTEGER ~ costm-costo;
nsi: SolnInterval ~ SELECT dif FROM
>0 => [startIA, costo, no],
=0 => [startIA, costo, maybe],
<0 => [startIA, costm, yes],
ENDCASE => ERROR;
new: BOOL;
IF solns.len=0 THEN new Ź TRUE ELSE {
osi: SolnInterval ~ solns[solns.len.PRED];
new Ź nsi.cost # osi.cost OR nsi.take # osi.take};
IF new THEN {
IF solns.len >= solns.maxLen THEN ERROR;
solns[solns.len] Ź nsi;
solns.len Ź solns.len.SUCC};
IF nextIA=biggestN OR costo=0 THEN EXIT;
startIA Ź nextIA;
}ENDLOOP;
brk.solns Ź solns;
RETURN};

SolveObj: PROC [h: Handle, ps: Privates, obj: Obj, smin, iwtb: Nat, inbs: StuffPtrStack] RETURNS [dwidth: INTEGER] ~ {
maxdwidth: Nat Ź 0;
minIndenti: Nat Ź smin; --minimum possible indentation at inSP
minIndento: Nat Ź smin; --minimum possible indentation at outSP (only variability comes from breakpoints of enclosing objects)
curWidth: INTEGER Ź 0; --maximum possible difference between indentation at inSP and minIndento
curMaxWidth: INTEGER Ź 0; --maximum possible difference between any right-end in [outSP .. inSP) and minIndento
rb: OpBreak Ź NIL; --rightmost takeable break in [outSP .. inSP)
wtb: Nat; --width 'till next takeable break after inSP
nbs: StuffPtrStack; --points at next takeable break after inSP
leftBroke, bufferedTake: BOOL Ź FALSE;
outSP, inSP: StuffPtr Ź [obj, 0];
outS, inS: Stuff;
IF outSP = obj.end THEN RETURN [0];
outS Ź inS Ź StuffRef[outSP];
[wtb, nbs] Ź NextTakeable[[obj, 0], obj.end, iwtb, inbs];
DO
IF outSP=obj.end THEN EXIT;
IF outSP#inSP THEN {nextSP: StuffPtr ~ Next[outSP];
{--a spurrious block so we can see nextSP in NextO
{--another spurrious block so we can see NextO from Advance
WITH outS.data SELECT FROM
x: ROPE => GOTO Advance;
x: REFTEXT => GOTO Advance;
cs: Changes => GOTO NextO;
sub: Obj => {sub4Cirio: Obj Ź sub;
leftBroke Ź leftBroke OR sub.broke;
maxdwidth Ź MAX[maxdwidth, minIndento + sub.maxdwidth - smin];
GOTO Advance};
bp: OpBreak => {bp4Cirio: OpBreak Ź bp;
IF bp.cond=miser
THEN {IF bp.taken THEN GOTO TakeIt ELSE GOTO SkipIt};
IF minIndento+curMaxWidth > h.margin THEN GOTO TakeIt;
IF inSP=obj.end AND minIndento+curWidth+iwtb > h.margin THEN GOTO TakeIt;
SELECT bp.cond FROM
width => NULL;
united => IF obj.broke THEN GOTO TakeIt;
lookLeft => IF leftBroke THEN GOTO TakeIt;
always => GOTO TakeIt;
ENDCASE => ERROR;
IF bp.next#NIL AND bp.cond#united THEN GOTO SkipIt;
IF inSP=obj.end OR bufferedTake THEN GOTO SkipIt;
bp4Cirio Ź bp--don't know what to do, so fall through to examining next input--;
EXITS
TakeIt => {
maxdwidth Ź MAX[maxdwidth, minIndento - smin];
IF bp.taken THEN {
IF nextSP # inSP THEN ERROR--these guys should get sucked up as soon as they're entered--;
curMaxWidth Ź curWidth Ź 0}
ELSE {
curWidth Ź curWidth - outS.dwidth;
curMaxWidth Ź curMaxWidth - outS.dwidth};
minIndento Ź smin + bp.offset;
obj.broke Ź bp.taken Ź TRUE; leftBroke Ź FALSE;
GOTO NextO};
SkipIt => {bp.taken Ź FALSE; leftBroke Ź FALSE; GOTO Advance};
};
ENDCASE => ERROR;
EXITS Advance => {curWidth Ź curWidth - outS.dwidth;
curMaxWidth Ź curMaxWidth - outS.dwidth;
minIndento Ź minIndento + outS.dwidth;
GOTO NextO};
};
EXITS NextO => {
IF (outSP Ź nextSP) # obj.end THEN outS Ź StuffRef[outSP];
IF outSP = inSP THEN bufferedTake Ź FALSE;
LOOP};
}};
IF inSP=obj.end THEN ERROR--need to examine next input, and there is none--;
WITH inS.data SELECT FROM
x: ROPE => {
curWidth Ź curWidth + inS.dwidth;
curMaxWidth Ź MAX[curMaxWidth, curWidth];
minIndenti Ź minIndenti + inS.dwidth;
wtb Ź wtb - inS.dwidth};
x: REFTEXT => {
curWidth Ź curWidth + inS.dwidth;
curMaxWidth Ź MAX[curMaxWidth, curWidth];
minIndenti Ź minIndenti + inS.dwidth;
wtb Ź wtb - inS.dwidth};
cs: Changes => NULL;
sub: Obj => {sub4Cirio: Obj Ź sub;
moveOn: BOOL ~ inSP = nbs.first;
IF moveOn THEN [wtb, nbs] Ź NextTakeable[Next[inSP], obj.end, iwtb, inbs];
inS.dwidth Ź SolveObj[h, ps, sub, minIndenti, wtb, nbs];
StuffSet[inSP, inS];
IF outSP=inSP THEN outS Ź inS;
curMaxWidth Ź MAX[curMaxWidth, curWidth+sub.maxdwidth];
curWidth Ź curWidth + inS.dwidth;
minIndenti Ź minIndenti + inS.dwidth;
IF NOT moveOn THEN wtb Ź wtb - inS.dwidth;
obj.broke Ź obj.broke OR sub.broke};
bp: OpBreak => {bp4Cirio: OpBreak Ź bp;
IF bp.taken THEN {
curWidth Ź smin + bp.offset - minIndento;
obj.broke Ź bufferedTake Ź TRUE}
ELSE curMaxWidth Ź MAX[curMaxWidth, (curWidth Ź curWidth + inS.dwidth)];
IF bp.cond=miser AND NOT bp.taken THEN {
minIndenti Ź minIndenti + inS.dwidth;
wtb Ź wtb - inS.dwidth}
ELSE {
minIndenti Ź smin + bp.offset;
[wtb, nbs] Ź NextTakeable[Next[inSP], obj.end, iwtb, inbs];
IF rb#NIL THEN rb.next Ź bp;
rb Ź bp};
};
ENDCASE => ERROR;
inSP Ź Next[inSP];
IF inSP # obj.end THEN inS Ź StuffRef[inSP];
ENDLOOP;
IF curWidth#0 THEN ERROR;
dwidth Ź minIndento - smin;
obj.maxdwidth Ź MAX[maxdwidth, dwidth];
RETURN};

NextTakeable: PROC [sp, end: StuffPtr, endW: Nat, endS: StuffPtrStack] RETURNS [wtb: Nat, nbs: StuffPtrStack] ~ {
wtb Ź 0;
DO
IF sp=end THEN RETURN [wtb+endW, endS];
{stuff: Stuff ~ StuffRef[sp];
WITH stuff.data SELECT FROM
x: ROPE => wtb Ź wtb + stuff.dwidth;
x: REFTEXT => wtb Ź wtb + stuff.dwidth;
cs: Changes => NULL;
sub: Obj => {
subW: NAT;
subS: StuffPtrStack;
[subW, subS] Ź NextTakeable[[sub, 0], sub.end, 0, NIL];
wtb Ź wtb + subW;
IF subS#NIL THEN RETURN [wtb, CONS[sp, subS]];
};
bp: OpBreak => IF bp.cond#miser OR bp.taken THEN RETURN [wtb, LIST[sp]] ELSE wtb Ź wtb + stuff.dwidth;
ENDCASE => ERROR;
sp Ź Next[sp];
}ENDLOOP;
};

OutputObj: PROC [h: Handle, ps: Privates, obj: Obj] ~ {OPEN ps, h;
soi: Nat ~ outIndent;
FOR sp: StuffPtr Ź [obj, 0], Next[sp] UNTIL sp = obj.end DO
stuff: Stuff ~ StuffRef[sp];
WITH stuff.data SELECT FROM
r: ROPE => {OutputRope[h, r]; outIndent Ź outIndent + stuff.dwidth};
r: REFTEXT => TRUSTED {OutputRope[h, LOOPHOLE[r]]; outIndent Ź outIndent + stuff.dwidth};
sub: Obj => OutputObj[h, ps, sub];
bp: OpBreak => IF bp.taken
THEN Breakline[h, soi+bp.offset]
ELSE {OutputRope[h, bp.sep]; outIndent Ź outIndent + stuff.dwidth};
changes: Changes => WITH h.output SELECT FROM
so: BufferOutput.stream => {
IF changes.dlooks # NIL THEN IO.PutF1[so.stream, "%l", [rope[changes.dlooks]]];
IF changes.chgSet THEN IO.PutF1[so.stream, "%p", [cardinal[changes.charSet]]];
IF changes.charProps # NIL THEN IO.PutF1[so.stream, "%p", [refAny[Newize[changes.charProps]]]];
IF changes.nodeProps # NIL THEN IO.PutF1[so.stream, "%n", [refAny[Newize[changes.nodeProps]]]];
IF changes.nodeFormat # NIL THEN IO.PutF1[so.stream, "%n", [atom[changes.nodeFormat]]];
IF changes.nodeComment # NIL THEN IO.PutF1[so.stream, "%n", [boolean[changes.nodeComment = $TRUE]]];
};
ENDCASE => ERROR;
ENDCASE => ERROR;
ENDLOOP;
RETURN};

LeftLoop: PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;
IF miserable THEN ERROR;
DO
IF cl # cr AND (bl = br OR buff[bl].bs.p # cl) THEN
OutputC[h]
ELSE IF cl = cr AND bl = br THEN
EXIT
ELSE IF buff[bl].bs.type = setb THEN {
Ensure[h, sr+2];
buff[sr].s Ź outIndent;
sr Ź sr + 1;
bl Ź Right[h, bl];
leftBroke Ź FALSE;
}
ELSE IF outIndent + bufferWidth > margin
OR (SELECT buff[bl].bs.cond FROM
width => FALSE,
united => srx=sr OR hasAlways,
lookLeft => leftBroke,
always => TRUE,
ENDCASE => ERROR) THEN {
Breakline[h, buff[sr-1].s + buff[bl].bs.offset];
srx Ź sr;
bufferWidth Ź bufferWidth - buff[bl].bs.sepWidth;
cl Ź RightL[h, cl, buff[bl].bs.sepChars];
IF br = (bl Ź Right[h, bl]) THEN
hasAlways Ź FALSE;
leftBroke Ź FALSE;
}
ELSE IF Right[h, bl] # br AND (buff[Right[h, bl]].bs.type = breakpoint OR hasAlways) AND buff[bl].bs.cond # united THEN {
bl Ź Right[h, bl];
leftBroke Ź FALSE;
}
ELSE 
EXIT;
ENDLOOP;

IF hasAlways THEN
ERROR; 
}};

Breakline: PROC [h: Handle, indent: INTEGER] = {ps: Privates = h.ps; {OPEN ps, h;
goalIndent: INTEGER = indent;

WITH h.output SELECT FROM

so: BufferOutput.stream => {
IO.PutRope[so.stream, newline];
FOR sl: LIST OF CHAR Ź h.spacers, sl.rest WHILE indent # 0 DO
rep: INTEGER Ź indent/h.width[sl.first];
THROUGH [0 .. rep) DO
IO.PutChar[so.stream, sl.first];
ENDLOOP;
indent Ź indent - rep * h.width[sl.first];
ENDLOOP;
};

ENDCASE => ERROR;

outIndent Ź goalIndent;
}};

AddStuff: PROC [ps: Privates, stuff: Stuff] ~ {
obj: Obj ~ ps.obs.first;
newEnd: StuffPtr ~ Next[obj.end];
obj.end.o.stuff[obj.end.i] Ź stuff;
obj.end Ź newEnd;
RETURN};

StuffRef: PROC [sp: StuffPtr] RETURNS [Stuff]
~ INLINE {RETURN [sp.o.stuff[sp.i]]};

StuffSet: PROC [sp: StuffPtr, s: Stuff]
~ INLINE {sp.o.stuff[sp.i] Ź s};

Next: PROC [sp: StuffPtr] RETURNS [StuffPtr] ~ {
IF sp.i < StuffSeqIndex.LAST THEN RETURN [[sp.o, sp.i.SUCC]];
IF sp.o.stuffNext = NIL THEN {
sp.o.stuffNext Ź NEW [ObjPrivate];
sp.o.stuffNext.stuffNext Ź NIL};
RETURN [[sp.o.stuffNext, 0]]};

Ensure: PROC [h: Handle, m: NAT] = INLINE {
IF h.ps.n >= m THEN RETURN;
IF h.ps.n = biggestN THEN ERROR;
Enlarge[h, MIN[biggestN, CARDINAL[m]+m/2]]};

Enlarge: PROC [h: Handle, m: NAT] = {
news: Seq = NEW [Sequence[m]];
oldCL: NAT = h.ps.cl;
nb, nc: NAT Ź 0;
FOR ci: NAT Ź h.ps.cl, Right[h, ci] WHILE ci # h.ps.cr DO
news[nc].c Ź h.ps.buff[ci].c;
news[nc].changes Ź h.ps.buff[ci].changes;
nc Ź nc + 1;
ENDLOOP;
h.ps.cl Ź 0; h.ps.cr Ź nc;
FOR bi: NAT Ź h.ps.bl, Right[h, bi] WHILE bi # h.ps.br DO
news[nb].bs Ź h.ps.buff[bi].bs;
news[nb].bs.p Ź IF h.ps.buff[bi].bs.p >= oldCL THEN h.ps.buff[bi].bs.p - oldCL ELSE (h.ps.n - oldCL + h.ps.buff[bi].bs.p);
nb Ź nb + 1;
ENDLOOP;
h.ps.bl Ź 0; h.ps.br Ź nb;
FOR i: NAT IN [0 .. h.ps.sr) DO news[i].s Ź h.ps.buff[i].s ENDLOOP;
h.ps.buff Ź news;
h.ps.n Ź m;
};

BCount: PROC [h: Handle] RETURNS [nb: NAT] = {
nb Ź IF h.ps.br >= h.ps.bl THEN h.ps.br - h.ps.bl ELSE (h.ps.n - h.ps.bl + h.ps.br)};

CCount: PROC [h: Handle] RETURNS [nc: NAT] = {
nc Ź IF h.ps.cr >= h.ps.cl THEN h.ps.cr - h.ps.cl ELSE (h.ps.n - h.ps.cl + h.ps.cr)};

Right: PROC [h: Handle, m: NAT] RETURNS [NAT] = INLINE
{RETURN [IF m + 1 # h.ps.n THEN m + 1 ELSE 0]};

RightL: PROC [h: Handle, m, l: NAT] RETURNS [NAT] = INLINE
{cm2: CARDINAL Ź CARDINAL[m] + l;
IF cm2 >= h.ps.n THEN cm2 Ź cm2 - h.ps.n;
RETURN [cm2]};

Left: PROC [h: Handle, m: NAT] RETURNS [NAT] = INLINE
{RETURN [(IF m = 0 THEN h.ps.n ELSE m) - 1]};

LeftL: PROC [h: Handle, m, l: NAT] RETURNS [NAT] = INLINE
{RETURN [IF m < l THEN (m + h.ps.n - l) ELSE (m - l)]};

Start: PROC ~ {
charRefs Ź NEW [ARRAY CHAR OF ROPE];
FOR c: CHAR IN CHAR DO
charRefs[c] Ź Rope.FromChar[c];
ENDLOOP;
RETURN};

Start[];

END.
  l  
UnparserBufferImpl3.mesa 
Copyright Ó 1990, 1991 by Xerox Corporation.  All rights reserved.
Gnelson, December 6, 1983 2:05 am
Last tweaked by Mike Spreitzer on April 24, 1990 2:19 pm PDT
Last changed by Pavel on March 26, 1988 12:16:04 pm PST
JKF October 2, 1988 1:13:14 pm PDT
Willie-s, September 25, 1991 10:05 pm PDT
Michael Plass, November 22, 1991 5:17 pm PST
Common to both implementations:
Only used in non-miser-able implementation:
buff.c & buff.changes is circular buffer with pointers [cl .. cr).
changes[i] is the tioga changes between c[i-1] and c[i].
buff.bs is circular buffer with pointers [bl .. br).
buff.s is stack with sr elts in it.
TRUE iff an object has (recursively) broken since last setb removed from buffer or its latest breakpoint removed from buffer, whichever is later.
Only used in miser-able implementation:
indentation at the insertion end of pre-buffer, assuming misers not taken, others taken; maintained only while obs#NIL
cost is biggestN for incoming advantage < minA.
cost is 0 for incoming advantage >= maxNeed.
last elt is for cost=0. first elt's startIA = MAX[minA, 0].
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.
The following are only relevent for breakpoints:
IA stands for Incoming (to brk, not kid) Advantage.
startIA IN [s.startIA .. s.nextIA] for each SeqPtr s.
[startIA .. nextIA) is subrange of [to.first.startIA .. to.first.nextIA)
[startIA .. nextIA) is subrange of [tm.first.startIA .. tm.first.nextIA)
[startIA .. nextIA) is subrange of [s.startIA .. s.nextIA) for each SeqPtr s.
misers have been solved.
smin is minimum possible indentation at setb.
iwtb is width 'till next takeable break after this obj; inbs points at it.
We now have bl # br AND (cl = cr OR buff[bl].bs.p = cl)
This shouldn't be able to happen; the last two cases in the loop are supposed to screen this out.
 Ę'Ď  NewlineDelimiter
(cedarcode) style codeK
Ďe7BK!!K<K7K"K)K,K KĎk	&8K Ńbnx"K$KKK KK KK
"KK
K K
"$KKĎc%9K	+K &K -KBBK88K4K#K 3K '@K''K	 H^KX vK %K /BKKK K
'K
3K!K K$K KĎg &7K 7EKK K	KK	 K >KKĄ &:KKK		
9KK K	"K	#K2K +K04K)K K		K +9K 4CK K
 #K,K/K,K;K K<KK K
K
	
@K 	KKKăăK
KK K0KKKK %,KK K	#KĄK+K!%K#KK K!K
'K K
Ďn
,K ˘#	K K0K<<KKK ˘HK"K ˘	K	#K[KK ˘EK*K ˘!KK^K	!KK ˘&BKK
1KK	*CK)8KK,KK	KKKKK))KK
K ˘&BK
K
*KK.AKKKKKK	.
SK	 K	$K)=
KKKKK
K ˘&>K$BKK*K.KK
	9jK ˘"5K!
K	Ą&Ą	OK=_K=_K4WK@dKKK 
˘+MK''K 	0KEEK 	 ?KEEK K
KrK 
˘,SKKK
W|K+KKK33K(9K
*K-?K*IK
K/KK8KK##KKK
KK$$K!!KK9RKK
KKA^(,KK'K$$ KKKKKK%%KKFFKKK 
˘MK
KFJK.2KKKKKKK	K ˘
*
K5KKK ˘0K!K!!KĄĄ$K&*K	K ˘
.KEK ˘=K**K9K;KKXK"K ˘<
K9KKK ˘
!8K!K-1K(,K	K ˘"7K!K!!K'K,0K	K ˘6K!K!!KK'+K	K ˘
!8K!K!!KK(,K	K ˘8K!K!!K	3K+/K	K ˘+K!KKKĄ)+K,ĄMK
Ą&Ą[K:ĄFK
K ˘eKK0KĄK	K	KKK'KKKĄ;<K%%KĄ%KK If.KĄ$?KĄ
%KĄ1GK Ą'K22K"Ą)KKK ˘DKKKKKKKK 
˘	
SKĄKĄĄ!+KKĄK ˘
)
K4KKK ˘
O
K,IKKK K˘!GK ˘AK	1K ˘AK		1K ˘	5K2
JK%%K  KKK ˘.KKK
=K3
(!,KKKKKKKK*+?KKKKK ˘%JKK!K$6K

KgK,IK9?K K"5JK3K ˘?˘?K'2K,?KKK&K $K1K.2KK+?K..KK
)K K	4EK	'8 KAQ$%-KBKK/MKKKK KK))KKK

!3K$OK 2K0[KK5KK!3%KK))KKK	&KHK
	
bK 2%KK55KKK	&KHK
	
bKKMK#KKKKK
%K$*K2K(KKK	(KK	KKK 
˘KĄvKK--KJJKĄK	Ďd &>K	Ł f~K
 GĐcd_K T¤oK -@K
 ,6K *>K&K!KK#KK99K!3K 12K :;K	K	K""K#KĄĄŁ
Ą>K
''K
	5K
Ł6K

ŁI	K	K
(K*K
KK
	3K1K BPK	ĄĄŁ	.
K >ZKKĄ"K!Ą)K	ŁK/KK
>KK(Ą4K!Ą(K	ŁŁĄ&KKK:K*KKK 1L
KĄ!K)K	ŁŁĄ%KĄKĄ!K)K	ŁŁĄ%KĄK""K K<JKĄ&Ł8KKKĄ7KĄ!K	ŁŁĄ%KĄ*K$'
K'Ł)K K)ĄH
(K	ŁŁĄ%KĄK	ŁK;;KK	KKKK,KKKĄŁK	ĄĄĄ'KK ˘5#qKK'KKĄ$KĄ'KK
KK27KK
.KK
ĄfKKK	KK ˘	(BK#;KK5ĄDK	$ĄYK""	K K7ĄC
-K	Ą&Ą	OK5NK=_K=_K4WK@dKKKKKK ˘%?K	
3K

		 KK
7&KKKKKK!(
-K00K		K11K)) KKK*yKKKKKK KaaKKK ˘	QK
K 
K K=K(K KK**KKK KK KKK ˘!/KK!K##KKK ˘-K%K ˘'K K ˘0K
=K"K KK ˘+KK K,K ˘%KKK9KK))KKK9KK'zKKKK
CKKKK ˘.KUK ˘.KUK ˘6K	/K ˘:K!K)KK ˘5	
-K ˘9	7K ˘K$	KKKK KK K     m~  š  