<<>> <> <> <> <> <> <> <> <> 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}, 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 max 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]; <> <= maxNeed.>> <> 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 [ 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. 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. 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; { IF NOT CBuffering[ps] THEN {OutputRope[h, r]; outIndent ¬ outIndent + ELSE IF miserable THEN {AddStuff[ps, [chars, ELSE {AddChars[h, ps, r, 0, len]; bufferWidth ¬ bufferWidth + 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; 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]}; IF NOT CBuffering[ps] THEN { OutputText[h, rt, startIndex, count]; ps.outIndent ¬ ps.outIndent + 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, ELSE AddStuff[ps, [chars, ENDCASE => AddStuff[ps, [chars, ps.prebIndent ¬ ps.prebIndent + ELSE { AddChars[h, ps, lr, startIndex, startIndex+count]; ps.bufferWidth ¬ ps.bufferWidth + }; 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] ~ { FOR i: INT IN [from .. to) DO ENDLOOP; RETURN [ 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]; <<[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 [ <> <> <> max 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; max 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 => { max 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. curMaxWidth ¬ curMaxWidth - outS. 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. curMaxWidth ¬ curMaxWidth - outS. minIndento ¬ minIndento + outS. 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. curMaxWidth ¬ MAX[curMaxWidth, curWidth]; minIndenti ¬ minIndenti + inS. wtb ¬ wtb - inS. x: REFTEXT => { curWidth ¬ curWidth + inS. curMaxWidth ¬ MAX[curMaxWidth, curWidth]; minIndenti ¬ minIndenti + inS. wtb ¬ wtb - inS. 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. StuffSet[inSP, inS]; IF outSP=inSP THEN outS ¬ inS; curMaxWidth ¬ MAX[curMaxWidth, curWidth+sub.max curWidth ¬ curWidth + inS. minIndenti ¬ minIndenti + inS. IF NOT moveOn THEN wtb ¬ wtb - inS. 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. IF bp.cond=miser AND NOT bp.taken THEN { minIndenti ¬ minIndenti + inS. wtb ¬ wtb - inS. 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; obj.max 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. x: REFTEXT => wtb ¬ wtb + stuff. 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. 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. r: REFTEXT => TRUSTED {OutputRope[h, LOOPHOLE[r]]; outIndent ¬ outIndent + stuff. 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. changes: Changes => WITH h.output SELECT FROM so: BufferOutput.stream => { IF changes. 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.