[_CDCSL_93-16_]<1>Cedar>release>StructuredStreams>UnparserBufferImpl3.mesa

UnparserBufferImpl3.mesa

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

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,

Common to both implementations:

outIndent: Nat ¬ 0, --indentation at output end of buffer

newline: ROPE,

Only used in non-miser-able implementation:

n: NAT ¬ 0, --size of queues and stack

bl, cl, br, cr, sr, srx: NAT--[0 .. n)-- ¬ 0,

buff: Seq ¬ NIL,

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.

bufferWidth: NAT ¬ 0, --sum of widths of chars in c

hasAlways: BOOL ¬ FALSE, --there's an always break in the buffer

leftBroke: BOOL ¬ FALSE,

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:

maySetb: BOOL ¬ TRUE, --at pre-buffer insertion, last miser is in innermost object or ancestor

prebIndent: Nat ¬ 0,

indentation at the insertion end of pre-buffer, assuming misers not taken, others taken; maintained only while obs#NIL

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];

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

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,

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.

bs: BStuff

];

BStuff: TYPE = RECORD [

type: {setb, breakpoint},

The following are only relevent for breakpoints:

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];

IA stands for Incoming (to brk, not kid) Advantage.

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;

startIA IN [s.startIA .. s.nextIA] for each SeqPtr s.

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];

[startIA .. nextIA) is subrange of [to.first.startIA .. 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];

[startIA .. nextIA) is subrange of [tm.first.startIA .. tm.first.nextIA)

IF costm#biggestN THEN costm ¬ IF tm.first.cost#biggestN THEN costm + tm.first.cost ELSE biggestN;

ENDLOOP;

[startIA .. nextIA) is subrange of [s.startIA .. s.nextIA) for each SeqPtr s.

{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] ~ {

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.

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];

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;

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;

ENDLOOP;

RETURN};

LeftLoop: PROC [h: Handle] = {ps: Privates = h.ps; {OPEN ps, h;

IF miserable THEN ERROR;

IF cl # cr AND (bl = br OR buff[bl].bs.p # cl) THEN

OutputC[h]

ELSE IF cl = cr AND bl = br THEN

EXIT

We now have bl # br AND (cl = cr OR buff[bl].bs.p = cl)

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

This shouldn't be able to happen; the last two cases in the loop are supposed to screen this out.

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.