<< HerculesUnparserImpl.mesa (ex OldUnparserImpl + UnparserBufferImpl)>> << Last edited by Stolfi February 22, 1984 8:36 am>> << Adapted from OldUnparserImpl>> <> <> << Merged with UnparserBufferImpl>> <> 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.