- - - - - QUIPUS (UNPARSE BUFFERS)
Inspired by UnparserBuffer.mesa (Coded December 7, 1982 3:57 pm by Greg Nelson)
A "Quipu" is a sequence of ropes separatred by breakpoints. Each breakpoint has a "logical strength", a penalty for breaking lines at that point. A quipu is maintained as a tree structure, in which the ropes are leaves and breakpoints are internal nodes, and such that the logical strengths are strictly increasing with depth.
When breaking a Quipu into lines so as to fit within a given page width, the routines below repeatedly apply the following rules:
(a) if the quipu fits in a single line, do so;
(b) if not, break lines at the weakest breakpoint (i.e., the root) and at all breakpoints with same logical strength, and try to fit each piece independently.
A breakpoint node may also specify
(1) an offset for the left margin of the second line relative to that ofthe first, used if the break is taken, and
(2) the insertion of an extra blank if the break is not taken.
QuipuBody: TYPE = REF; -- to JoinRec, or ROPE
JoinRec: TYPE = RECORD
[left, right: QuipuBody,
length: INT, -- length of contents, assuming no breaks are taken
strength: BindingPower, -- basic strength of this join. Icreases with depth until next group.
group: BOOL ← FALSE, -- root of a new group. (adds lotsa strength to this and descendants)
offset: UnparseOffset ← 0, -- margin offset of second part (rel to first) if break is taken
space: BOOL ← FALSE -- space to be inserted if break is not taken
];
Quipu: TYPE = RECORD
[leftalpha, rightalpha: BOOL ← FALSE,
leftspace, rightspace: BOOL ← FALSE,
body: QuipuBody ← NIL];
QLength:
PROC [body: QuipuBody]
RETURNS [length:
INT] =
-- returns the natural length
of the quipu, in chars (assuming no breakpoints are taken)
BEGIN
RETURN[WITH body SELECT FROM
jj: REF JoinRec => jj.length,
rr: ROPE => rr.Length[],
ENDCASE => ERROR]
END;
QStrength:
PROC [body: QuipuBody]
RETURNS [power:
INT] =
-- returns the strength of the topmost quipu join (infinite if rope or group)
BEGIN
RETURN[WITH body SELECT FROM
jj: REF JoinRec =>
IF jj.group THEN LAST[BindingPower]+1 ELSE jj.strength,
rr: ROPE =>
LAST[BindingPower]+1,
ENDCASE => ERROR]
END;
QCat:
PROC [left: Quipu,
strength: BindingPower,
offset: UnparseOffset ← 0, group:
BOOL ←
FALSE,
right: Quipu]
RETURNS [cat: Quipu] =
-- concatenates two quipus with a breakpoint between them
BEGIN putSpace:
BOOL = left.rightspace
OR right.leftspace
OR (left.rightalpha
AND right.leftalpha);
CatBodies:
PROC [lbody, rbody: QuipuBody]
RETURNS [cbody: REF JoinRec] =
-- Catenates bodies. Rearranges the tree to keep strengths non-decreasing downwards
BEGIN
IF QStrength[lbody] < strength THEN
{lb: REF JoinRec = NARROW [lbody];
lb.right ← CatBodies[lb.right, rbody];
cbody ← lb}
ELSE IF QStrength[rbody] < strength THEN
{rb: REF JoinRec = NARROW [rbody];
rb.left ← CatBodies[lbody, rb.left];
cbody ← rb}
ELSE
{cbody ← NEW [JoinRec ←
[left: lbody,
right: rbody,
length: ,
strength: strength,
offset: offset,
group: group,
space: putSpace]]};
cbody.length ←
QLength[cbody.left]
+QLength[cbody.right]
+(IF cbody.space THEN 1 ELSE 0);
END;
cat ←
[leftalpha: left.leftalpha,
rightalpha: right.rightalpha,
leftspace: left.leftspace,
rightspace: right.rightspace,
body: CatBodies[left.body, right.body]]
END;
QRope:
PROC [rope: ROPE, leftalpha, rightalpha, leftspace, rightspace:
BOOL ←
FALSE]
RETURNS [quipu: Quipu] =
-- Makes a quipu from a rope
BEGIN
quipu ←
[leftalpha: leftalpha,
rightalpha: rightalpha,
leftspace: leftspace,
rightspace: rightspace,
body: rope]
END;
QGroup:
PROC [quipu: Quipu]
RETURNS [Quipu] =
-- Makes a quipu into a group
BEGIN
WITH quipu.body SELECT FROM
jj: REF JoinRec => {jj.group ← TRUE};
rr: ROPE => {};
ENDCASE => ERROR;
RETURN[quipu]
END;
RopeFromQuipu:
PROC [quipu: Quipu, margL, margR:
INT]
RETURNS [rope:
ROPE] =
-- Convers a quipu into a rope with CRs, starting at column margL.
-- Breaks the contents at breakpoints of increasingly higher power,
-- until no line extends beyond the column margR.
-- Ignores leftspace, rightspace, leftalpha, rightalpha.
BEGIN
twenty: ROPE = Rope.Substr[" ", 0, 20]; -- twenty blanks
Blanks:
PROC [n:
INT]
RETURNS [rope:
ROPE] =
-- returns a rope with n blanks
BEGIN
rope ← IF n <=0 THEN NIL
ELSE IF n > 20 THEN Rope.Cat[twenty, Blanks[n-20]]
ELSE Rope.Substr[twenty, 0, n]
END;
SpewIt:
PROC [body: QuipuBody]
RETURNS [rope:
ROPE] =
-- just convert to rope, without breaks and left blanks
BEGIN
rope ← WITH body SELECT FROM
rr: ROPE => rr,
jj: REF JoinRec => Rope.Cat
[SpewIt[jj.left],
IF jj.space THEN " " ELSE NIL,
SpewIt[jj.right]]
ENDCASE => ERROR;
END;
RopeIt:
PROC [body: QuipuBody, margL:
INT]
RETURNS [rope:
ROPE] =
-- converts to rope, breaking if necessary
-- returns NIL if empty, else adds left margin and final CR
BEGIN
rope ← WITH body SELECT FROM
rr: ROPE =>
IF rr.Length[] # 0 THEN Rope.Cat[Blanks[margL], rr, "\n"] ELSE NIL,
jj: REF JoinRec =>
IF jj.length > margR - margL THEN -- break even if group
Rope.Cat
[BreakIt[jj.left, jj.strength, margL],
BreakIt[jj.right, jj.strength, MAX[margL+jj.offset, 0]]]
ELSE IF jj.length # 0 THEN
Rope.Cat [Blanks[margL], SpewIt[jj], "\n"]
ELSE NIL,
ENDCASE => ERROR
END;
BreakIt:
PROC [body: QuipuBody, stress: BindingPower, margL:
INT]
RETURNS [rope:
ROPE] =
-- returns NIL (not blanks nor CR) if line contains nothing,
-- elese adds left blanks and treminal CR
BEGIN
rope ← WITH body SELECT FROM
join: REF JoinRec =>
IF join.strength <= stress AND NOT join.group THEN
Rope.Cat
[BreakIt[join.left, stress, margL],
BreakIt[join.right, stress, MAX[margL+join.offset, 0]]]
ELSE
RopeIt[join, margL],
rr: ROPE =>
IF rr.Length[] # 0 THEN Rope.Cat[Blanks[margL], rr, "\n"] ELSE NIL,
ENDCASE => ERROR
END;
END;
Unparse:
PUBLIC PROC [expr: Se, syntax: Syntax, leftMargin, rightMargin:
INTEGER]
RETURNS [Rope.
ROPE] =
BEGIN
QAtom:
PROC [atom:
ATOM, alpha, leftspace, rightspace:
BOOL ←
FALSE]
RETURNS [quipu: Quipu] =
INLINE
BEGIN
quipu ← QRope[Atom.GetPName[atom], alpha, alpha, leftspace, rightspace]
END;
Unp:
PROC[expr: Se, leftbond, rightbond: BondType]
RETURNS [quipu: Quipu]=
BEGIN
RETURN
[IF expr = missing OR expr = NIL THEN
[]
ELSE IF ISTYPE [expr, LIST OF Se] THEN
UnpApp[NARROW[expr], leftbond, rightbond]
ELSE
UnpProps[expr, GetProps[expr, syntax], leftbond, rightbond]];
END;
BondType: TYPE = {pre, post, break};
UnpProps:
PROC[expr
: Se, props: Props, leftbond, rightbond: BondType]
RETURNS [quipu: Quipu]=
BEGIN
IF expr = missing OR expr = NIL THEN
{RETURN [[]]}
ELSE IF ISTYPE [expr, LIST OF Se] THEN
{RETURN [UnpApp[NARROW[expr], leftbond, rightbond]]}
ELSE
{rope: ROPE ← NIL;
WITH expr SELECT FROM
fi: REF INT =>
{rope ← Convert.RopeFromInt[fi^]};
fa: ATOM =>
{rope ← Atom.GetPName[fa]};
fr: Rope.ROPE =>
{rope ← fr};
fx: REF REAL =>
{rope ← Convert.RopeFromReal[fx^]};
ENDCASE => ERROR;
RETURN[QRope
[rope,
props.alpha, props.alpha,
props.leftspace, props.rightspace]]}
END;
GetAtomicExprProps:
PROC [op: Se]
RETURNS [props: Props] =
-- op is either an atomic operator or an openfix/closefix expression
BEGIN
IF ISTYPE[op, LIST OF Se] THEN
{app: LIST OF Se ← NARROW[op];
open: ATOM = NARROW[app.first];
props ← GetProps[open, syntax];
IF NOT props.openfix THEN ERROR;
props.openfix ← FALSE;
WHILE app.rest # NIL DO app ← app.rest ENDLOOP;
IF app.first = missing THEN
{props.closefix ← FALSE;
props.prefix ← FALSE;
props.prearg ← FALSE;
props.prebreak ← TRUE}
ELSE
{close: ATOM = props.matches;
cprops: Props ← GetProps[close, syntax];
IF NOT cprops.closefix THEN ERROR;
props.prefix ← cprops.prefix;
props.prearg ← FALSE;
props.prebreak ← TRUE}}
ELSE
{props ← GetProps[NARROW[op], syntax]}
END;
UnpApp:
PROC [app:
LIST OF Se, leftbond, rightbond: BondType]
RETURNS [quipu: Quipu] =
-- unparses an application (op arg1 arg2 ... argn)
-- leftbond and rightbond are the bond types at left and right of the expression.
BEGIN op: Se = app.first;
opProps: Props = GetAtomicExprProps[op];
length:
INT = List.Length[app];
SELECT TRUE FROM
opProps.openfix
=>
{-- openfix/closefix expression
cl: ATOM = opProps.matches;
clProps: Props = GetAtomicExprProps[cl];
UnpArgs: PROC [args: LIST OF Se] RETURNS [qargs: Quipu] =
{IF args = NIL THEN
RETURN[QAtom[cl, clProps.alpha, clProps.leftspace, clProps.rightspace]]
ELSE IF args.first = missing THEN
RETURN[QRope[""]]
ELSE IF args.rest = NIL THEN
RETURN[QCat
[left: Unp[app.first, break, break],
strength: clProps.leftstrength, offset: clProps.leftoffset,
right: QAtom[cl, clProps.alpha, clProps.leftspace, clProps.rightspace]]]
ELSE
RETURN[QCat
[left: Unp[app.first, break, break],
strength: 0, offset: 0,
right: UnpArgs[args.rest]]]};
quipu ← QCat
[left: QAtom[NARROW[op], opProps.alpha, opProps.leftspace, opProps.rightspace],
strength: opProps.rightstrength, offset: opProps.rightoffset, group: TRUE,
right: UnpArgs[app.rest]]};
opProps.prefix
AND opProps.postfix
AND length = 3
=>
{-- infix operation
quipu ← QCat
[left: Unp[app.rest.first, leftbond, post],
strength: opProps.leftstrength, offset: opProps.leftoffset,
right: QCat
[left: UnpProps[op, opProps, post, pre],
strength: opProps.rightstrength, offset: opProps.rightoffset,
right: Unp[app.rest.rest.first, pre, rightbond]]]};
opProps.prefix
AND (
NOT opProps.postfix
OR (leftbond = post
AND NOT opProps.postarg))
AND length = 2
=>
{-- prefix operator
quipu ← QCat
[left: UnpProps[op, opProps, leftbond, pre],
strength: opProps.rightstrength, offset: opProps.rightoffset,
right: Unp[app.rest.first, pre, rightbond]]};
opProps.postfix
AND (
NOT opProps.prefix
OR (rightbond = pre
AND NOT opProps.prearg))
AND length = 2
=>
{-- postfix operation
quipu ← QCat
[left: Unp[app.rest.first, leftbond, post],
strength: opProps.leftstrength, offset: opProps.leftoffset,
right: UnpProps[op, opProps, post, rightbond]]};
ENDCASE => -- can't figure out what it is; unparse all elements.
{quipu ← Unp
[app.first, leftbond,
IF app.rest = NIL THEN rightbond ELSE break];
app ← app.rest;
WHILE app # NIL DO
quipu ← QCat
[left: quipu,
strength: 0, offset: 0,
right: Unp
[app.first, leftbond,
IF app.rest = NIL THEN rightbond ELSE break]];
app ← app.rest; leftbond ← break
ENDLOOP;
quipu ← QGroup[quipu]};
END;
RETURN [RopeFromQuipu[Unp[expr, break, break], leftMargin, rightMargin]];
END;