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
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;
DO
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];
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
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;
}
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.