[Cyan]<PreISLCedar>Stolfi>Hercules>HerculesUnparserImpl.mesa!1

HerculesUnparserImpl.mesa (ex OldUnparserImpl + UnparserBufferImpl)

Last edited by Stolfi February 22, 1984 8:36 am

Adapted from OldUnparserImpl

Last edited by GNelson January 17, 1984 11:33 am

Last Edited by: Gnelson, November 2, 1983 11:59 am

Merged with UnparserBufferImpl

Last Edited by: Gnelson, December 6, 1983 2:05 am

DIRECTORY
Rope USING [ROPE, Cat, Substr, Length],
Convert USING [RopeFromReal, RopeFromInt],
List USING [Length],
Atom USING [GetPName],
HerculesParseUnparse;

HerculesUnparserImpl: PROGRAM
IMPORTS
HerculesParseUnparse,
Atom,
List,
Rope,
Convert
EXPORTS
HerculesParseUnparse =

BEGIN OPEN Rope, HerculesParseUnparse;

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

- - - - UNPARSER

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;

END.