.de foo .fo 0 fonts1;30vrx rwskst .fo 1 31vgb .fo 2 fonts1;30vrix ebmkst .fo 3 37vrb .fo 4 30vrb .fo 5 40vgl .fo 6 s30grk .fo 7 20vg .fo 8 20vr .fo 9 22fg .fo A fonts1;52meta rwskst .fo B 31vg .fo C 25fg .fo D 25vg .fo E 25vgb .em .so rws;escape chars .appendix "Examples" .achapter "Priority Queue Cluster" .sr log log2 .para This cluster is an implementation of priority queues. It inserts elements in O(log`n) time, and removes the "best" element in O(log`n) time, where n is the number of items in the queue, and "best" is determined by a total ordering predicate which the queue is created with. .para The queue is implemented with a binary tree which is balanced such that every element is "better" than its descendents, and the minimum depth of the tree differs from the maximum depth by one. The tree is implemented by keeping the elements in an array, with the left son of a[i] in a[i*2], and the right son in a[i*2+1]. The root of the tree, a[1], is the "best" element. .para Each insertion or deletion must rebalance the tree. Since the tree is of depth strictly less than log`n, the number of comparisons is less than log`n for insertion and less than 2`log`n for removal of an element. Consequently, a sort using this technique takes less than 3`n`log`n comparisons. .para This cluster illustrates the use of a type parameter, and the use of a procedure as an object. .bp .ls 1.1 .nf .fs D .ta 8 12 16 20 24 32 40 .de def_nkeys . for n 0 nargs-1 . sr _\\n E\\n* . end for . em .def_nkeys any array .def_nkeys begin bool break .def_nkeys cand char cluster continue cor cvt .def_nkeys do down .def_nkeys else elseif end except exit .def_nkeys false for force .def_nkeys has .def_nkeys if in int is iter itertype .def_nkeys nil null .def_nkeys oneof others .def_nkeys proc proctype .def_nkeys real record rep return returns .def_nkeys signal signals string .def_nkeys tag tagcase then true type .def_nkeys up .def_nkeys when where while .def_nkeys yield yields .keep p_queue = _cluster [t: _type] _is create,(24)% Create a p_queue with a particular sorting predicate top,(24)% Return the best element size,(24)% Return the number of elements empty,(24)% Return true if there are no elements insert,(24)% Insert an element of type t remove;(24)% Remove the best element and return it .end_keep .keep pt = _proctype (t, t) _returns (_bool); at = _array[t]; _rep = _record [a: at, p: pt]; .end_keep .keep create =(8)_proc (p: pt) _returns (_cvt); _return (_rep${a: at$create(1), p: p});(48)% Low index of array must be 1 ! _end create; .end_keep .keep top =(8)_proc (x: _cvt) _returns (t) _signals (empty); _return (at$bottom(x.a)); _except _when bounds: _signal empty; _end; _end top; .end_keep .keep size =(8)_proc (x: _cvt) _returns (_int); _return (at$size(x.a)); _end size; .end_keep .keep empty =(8)_proc (x: _cvt) _returns (_bool); _return (at$size(x.a) = 0); _end empty; .end_keep .keep insert =(8)_proc (x: _cvt, v: t); a: at := x.a; p: pt := x.p; at$addh(a, v);(48)% Make room for new item son: _int := at$high(a);(48)% Node to place v if father wins dad: _int := son/2;(48)% Get index of father _while dad > 0 _cand p(v, a[dad]) _do(48)% While father loses a[son] := a[dad];(48)% Move father down son, dad := dad, dad/2;(48)% Get new son, father _end; a[son] := v;(48)% Insert the element into place _end insert; .end_keep .keep remove = _proc (x: _cvt) _returns (t) _signals (empty); a: at := x.a; p: pt := x.p; r: t := at$bottom(a);(48)% Save best for later return _except _when bounds: _signal empty; _end; v: t := at$remh(a);(48)% Remove last element max_son: _int := at$size(a);(48)% Get new size _if max_son = 0 _then _return (r); _end;(48)% If now empty, we're done max_dad: _int := max_son/2;(48)% Last node with a son dad: _int := 1;(48)% Node to place v if it beats sons _while dad <= max_dad _do(48)% While node has a son son: _int := dad*2;(48)% Get the first son s: t := a[son]; _if son < max_son(48)% If there is a second son _then(48)% Find the best son ns: t := a[son + 1]; _if p(ns, s) _then son, s := son + 1, ns; _end; _end; _if p(v, s) _then _break; _end;(48)% If v beats son, we're done a[dad] := s;(48)% Move son up dad := son;(48)% Move v down _end; a[dad] := v;(48)% Insert the element into place _return (r);(48)% Return the previous best element _end remove; _end p_queue; .end_keep .pf 0 .fs 0 .bp .nr page 30 .de nshow .be nshow_block .nv ols ls .nv ls 100 .sp (ols-100)/100 .nv indent indent .hx indent indent 10 .nf .nv pfont 12 .nv font 12 .em 3Part D - Text Formatter .sp 2 .para The following program is a simple text formatter. The input consists of a sequence of unformatted text lines mixed with commands lines. Each line is terminated by a newline character, and command lines begin with a period to distinguish them from text lines. For example: .nshow Justification only occurs in "fill" mode. In "nofill" mode, each input text line is output without modification. The .br command causes a line-break. .br Just like this. .eshow The program produces justified, indented, and paginated text. For example: .nshow Justification only occurs in "fill" mode. In "nofill" mode, each input text line is output without modification. The .br command causes a line-break. Just like this. .eshow .para The output text is indented 10 spaces from the left margin, and is divided into pages of 50 text lines each. A header, giving the page number, is output at the beginning of each page. .para An input text line consists of a sequence of words and word-break characters. The word-break characters are space, tab, and newline; all other characters are constituents of words. Tab stops are considered to be every eight spaces. .para The formatter has two basic modes of operation. In "nofill" mode, each input text line is output without modification. In "fill" mode, input is accepted until no more words can fit on the current output line. (An output line has 60 characters.)` Newline characters are treated essentially as spaces. Extra spaces are then added between words until the last word has its last character in the rightmost position of the line. .para In fill mode, any input line that starts with a word-break character causes a line-break: the current output line is neither filled nor adjusted, but is output as is. An "empty" input line (one starting with a newline character) causes a line-break and then causes a blank line to be output. .para The formatter accepts three different commands: .sr list_left_margin 3 .sr list_indent 8 .ilist .br causes a line-break .next .nf causes a line-break, and changes the mode to "nofill" .next .fi causes a line-break, and changes the mode to "fill" .end_list .para The program performs input and output on streams, which are connections (channels) to text files. The following operations on streams are used: .sr list_indent 12 .ilist empty tests if the end of the file has been reached .next getc removes and returns the next character from the stream .next peekc like 2getc, but the character is not removed .next getl removes and returns (the remainder of) the input line and removes but does not return the terminating newline character .next putc outputs a character, with newline indicating end of line .next puts outputs the characters of a string using 2putc .next close closes the stream and associated output file, if any .end_list .bp .nr page 32 .so r;box rmac .nf .nr boxfont 3 1Module Dependency Diagram .sp 2 box(reader) .sp 4 box(do_line) .sp 4 box(do_text_line) box(do_command) .sp 4 dbox(page) box(read_name) .sp 5 dbox(line) .sp 4 dbox(word) box(put_spaces) .sp 7 dbox(stream) .sp 4 Note: boxes with a double line at the top indicate clusters. .fi .bp .nr page 33 .pf D .fs D .nf .ls 1.1 .keep reader = _proc (instream, outstream, errstream: stream) % Read the instream, processing it and placing the output on % outstream and writing error messages on errstream. p: page := page$create (outstream) _while ~stream$empty (instream) _do do_line (instream, p, errstream) _end page$terminate (p) _end reader .end_keep .keep do_line = _proc (instream: stream, p: page, errstream: stream) % Process an input line. This procedure reads one line from % instream. It is then processed either as a text line or as % a command line, depending upon whether or not the first % character of the line is a period. c: _char := stream$peekc (instream) _if c = '.' _then do_command (instream, p, errstream) _else do_text_line (instream, p) _end _end do_line .end_keep .keep do_text_line = _proc (instream: stream, p: page) % Process a text line. This procedure reads one line from % instream and processes it as a text line. If the first % character is a word-break character, then a line-break is % caused. If the line is empty, then a blank line is output. % Otherwise, the words and word-break characters in the line % are processed in turn. c: _char := stream$getc (instream) _if c = '\n' _then(40)% empty input line page$skip_line (p) _return _end _if c = ' ' _cor c = '\t' _then page$break_line (p) _end _while c ~= '\n' _do _if c = ' ' _then page$add_space (p) _elseif c = '\t' _then page$add_tab (p) _else w: word := word$scan (c, instream) page$add_word (p, w) _end c := stream$getc (instream) _end page$add_newline (p) _end do_text_line .end_keep .keep do_command = _proc (instream: stream, p: page, errstream: stream) % Process a command line. This procedure reads one line from % instream and processes it as a command. stream$getc (instream)(40)% skip the period n: _string := read_name (instream) _if n = "br" _then page$break_line (p) _elseif n = "fi" _then page$break_line (p) page$set_fill (p) _elseif n = "nf" _then page$break_line (p) page$set_nofill (p) _else stream$puts ("'", errstream) stream$puts (n, errstream) stream$puts ("' not a command.\n", errstream) _end stream$getl (instream)(32)% read remainder of input line _end do_command .end_keep .keep read_name = _proc (instream: stream) _returns (_string) % This procedure reads a command name from instream. The % command name is terminated by a space or a newline. The % command name is removed from instream; the terminating space % or newline is not. s: _string := "" _while _true _do c: _char := stream$peekc (instream) _except _when end_of_file: _return (s) _end _if c = ' ' _cor c = '\n' _then _return (s) _end s := _string$append (s, stream$getc (instream)) _end _end read_name .end_keep .bp .keep page = _cluster _is create, add_word, add_space, add_tab, add_newline, break_line, skip_line, set_fill, set_nofill, terminate % The page cluster does the basic formatting. It supports the % basic actions: BREAK_LINE, SKIP_LINE, SET_FILL, SET_NOFILL, % TERMINATE. It performs the appropriate actions for the % basic components of the input: WORDs, SPACEs, TABs, and % NEWLINEs. It maintains a current output line for the % purposes of performing justification. It performs % pagination and the production of headings. For this purpose % it maintains the current line number and the current page % number. _rep = _record [ line: line,(40)% The current line. fill: _bool,(40)% True <==> in fill mode. lineno: _int,(40)% The number of lines output % so far on this page (not % including any header lines). pageno: _int,(40)% The number of the current % output page. outstream: stream(40)% The output stream. ] .end_keep .keep create = _proc (outstream: stream) _returns (_cvt) % Create a page object. The first page is number 1, there are % no lines yet output on it. Fill mode is in effect. _return ( _rep${(24)line: line$create (), fill: _true, lineno: 0, pageno: 1, outstream: outstream}) _end create .end_keep .keep add_word = _proc (p: _cvt, w: word) % Process a word. This procedure adds the word w to the % output document. If in nofill mode, then the word is simply % added to the end of the current line (there is no % line-length checking in nofill mode). If in fill mode, then % we first check to see if there is room for the word on the % current line. If the word will not fit on the current line, % we first justify and output the line and then start a new % one. However, if the line is empty and the word won't fit % on it, then we just add the word to the end of the line; if % the word won't fit on an empty line, then it won't fit on % any line, so we have no choice but to put it on the current % line, even if it doesn't fit. _if p.fill _cand ~line$empty (p.line) _then h: _int := word$width (w) _if line$length (p.line) + h > 60 _then line$justify (p.line, 60) output_line (p) _end _end line$add_word (p.line, w) _end add_word .end_keep .keep add_space = _proc (p: _cvt) % Process a space -- just add it to the current line. line$add_space (p.line) _end add_space .end_keep .keep add_tab = _proc (p: _cvt) % Process a tab -- just add it to the current line. line$add_tab (p.line) _end add_tab .end_keep .keep add_newline = _proc (p: _cvt) % Process a newline. If in nofill mode, then the current line % is output as is. Otherwise, a newline is treated just like % a space. _if ~p.fill _then output_line (p) _else line$add_space (p.line) _end _end add_newline .end_keep .keep break_line = _proc (p: _cvt) % Cause a line break. If the line is not empty, then it is % output as is. Line breaks have no effect on empty lines -- % multiple line breaks are the same as one. _if ~line$empty (p.line) _then output_line (p) _end _end break_line .end_keep .keep skip_line = _proc (p: _cvt) % Cause a line break and output a blank line. break_line (_up (p)) output_line (p)(32)% line is empty _end skip_line .end_keep .keep set_fill = _proc (p: _cvt) % Enter fill mode. p.fill := _true _end set_fill .end_keep .keep set_nofill = _proc (p: _cvt) % Enter nofill mode. p.fill := _false _end set_nofill .end_keep .keep terminate = _proc (p: _cvt) % Terminate the output document. break_line (_up (p)) _if p.lineno > 0 _then stream$putc ('\p', p.outstream) _end stream$close (p.outstream) _end terminate .end_keep .keep %(8)Internal procedure. output_line = _proc (p: _rep) % Output line is used to keep track of the line number and the % page number and to put out the header at the top of each % page. _if p.lineno = 0 _then(40)% print header stream$puts ("\n\n", p.outstream) put_spaces (10, p.outstream) stream$puts ("Page ", p.outstream) stream$puts (int2string (p.pageno), p.outstream) stream$puts ("\n\n\n", p.outstream) _end p.lineno := p.lineno + 1 line$output (p.line, p.outstream) _if p.lineno = 50 _then stream$putc ('\p', p.outstream) p.lineno := 0 p.pageno := p.pageno + 1 _end _end output_line _end page .end_keep .keep put_spaces = _proc (n: _int, outstream: stream) % This procedure outputs N spaces to outstream. _for i: _int _in _int$from_to_by (1, n, 1) _do stream$putc (' ', outstream) _end _end put_spaces .end_keep .bp .keep line = _cluster _is create, add_word, add_space, add_tab, length, empty, justify, output % A line is a mutable sequence of words, spaces, and tabs. % The length of a line is the amount of character positions % that would be used if the line were output. One may output % a line onto a stream, in which case the line is made empty % after printing. One may also justify a line to a given % length, which means that some spaces in the line will be % enlarged to make the length of the line equal to the desired % length. Only spaces to the right of all tabs are subject to % justification. Furthermore, spaces preceding the first word % in the output line or preceding the first word following a % tab are not subject to justification. If there are no % spaces subject to justification or if the line is too long, % then no justification is performed and no error message is % produced. token = _oneof [ space: _int,(32)% the int is the width of the space tab: _int,(32)% the int is the width of the tab word: word ] at = _array [token] _rep = _record [ length: _int,(32)% the current length of the line stuff: at(32)% the contents of the line ] .end_keep .keep create = _proc () _returns (_cvt) % Create an empty line. _return (_rep${ length: 0, stuff: at$new () }) _end create .end_keep .keep add_word = _proc (l: _cvt, w: word) % Add a word at the end of the line. at$addh (l.stuff, token$make_word (w)) l.length := l.length + word$width (w) _end add_word .end_keep .keep add_space = _proc (l: _cvt) % Add a space at the end of the line. at$addh (l.stuff, token$make_space (1)) l.length := l.length + 1 _end add_space .end_keep .keep add_tab = _proc (l: _cvt) % Add a tab at the end of the line. width: _int := 8 - (l.length//8) l.length := l.length + width at$addh (l.stuff, token$make_tab (width)) _end add_tab .end_keep .keep length = _proc (l: _cvt) _returns (_int) % Return the current length of the line. _return (l.length) _end length .end_keep .keep empty = _proc (l: _cvt) _returns (_bool) % Return true if the line is empty. _return (at$size(l.stuff) = 0) _end empty .end_keep .keep justify = _proc (l: _cvt, len: _int) % Justify the line, if possible, so that it's length is equal % to LEN. Before justification, any trailing spaces are % removed. If the line length at that point is greater or % equal to the desired length, then no action is taken. % Otherwise, the set of justifiable spaces is found, as % described above. If there are no justifiable spaces, then % no further action is taken. Otherwise, the justifiable % spaces are enlarged to make the line length the desired % length. Failure is signalled if justification is attempted % but the resulting line length is incorrect. This condition % indicates a bug in justify; it should never be signalled, % regardless of the arguments to justify. remove_trailing_spaces (l) _if l.length >= len _then _return _end diff: _int := len - l.length first: _int := find_first_justifiable_space (l) _except _when none: _return _end enlarge_spaces (l, first, diff) _if l.length ~= len _then _signal failure ("justification failed") _end _end justify .end_keep .keep output = _proc (l: _cvt, outstream: stream) % Output the line and reset it. _if ~empty (_up (l)) _then put_spaces (10, outstream) _for t: token _in at$elements (l.stuff) _do _tagcase t _tag word (w: word): word$output (w, outstream) _tag space, tab (width: _int): put_spaces (width, outstream) _end _end _end stream$putc ('\n', outstream) l.length := 0 at$trim (l.stuff, 1, 0) _end output .end_keep .keep %(8)Internal procedures. remove_trailing_spaces = _proc (l: _rep) % Remove all trailing spaces from the line. _while at$size (l.stuff) > 0 _do _tagcase at$top (l.stuff) _tag word, tab: _break _tag space (width: _int): at$remh (l.stuff) l.length := l.length - width _end _end _end remove_trailing_spaces .end_keep .keep find_first_justifiable_space = _proc (l: _rep) _returns (_int) _signals (none) % Find the first justifiable space. This space is the first % space after the first word after the last tab in the line. % Return the index of the space in the array. Signal NONE if % there are no justifiable spaces. a: at := l.stuff _if at$size (a) = 0 _then _signal none _end lo: _int := at$low (a) hi: _int := at$high (a) i: _int := hi % find the last tab in the line (if any) _while i>lo _cand ~token$is_tab (a[i]) _do i := i - 1 _end % find the first word after it (or the first word in the line) _while i<=hi _cand ~token$is_word (a[i]) _do i := i + 1 _end % find the first space after that _while i<=hi _cand ~token$is_space (a[i]) _do i := i + 1 _end _if i>hi _then _signal none _end _return (i) _end find_first_justifiable_space .end_keep .keep enlarge_spaces = _proc (l: _rep, first, diff: _int) % Enlarge the spaces in the array whose indexes are at least % FIRST. Add a total of DIFF extra character widths of space. nspaces: _int := count_spaces (l, first) _if nspaces = 0 _then _return _end neach: _int := diff/nspaces nextra: _int := diff//nspaces _for i: _int _in _int$from_to_by (first, at$high (l.stuff), 1) _do _tagcase l.stuff[i] _tag space (width: _int): width := width + neach l.length := l.length + neach _if nextra > 0 _then width := width + 1 l.length := l.length + 1 nextra := nextra - 1 _end l.stuff[i] := token$make_space (width) _others: _end _end _end enlarge_spaces .end_keep .keep count_spaces = _proc (l: _rep, i: _int) _returns (_int) % Return a count of the number of spaces in the line whose % indexes in the array are at least I. count: _int := 0 _while i <= at$high (l.stuff) _do _tagcase l.stuff[i] _tag space: count := count + 1 _others: _end i := i + 1 _end _return (count) _end count_spaces _end line .end_keep .bp .keep word = _cluster _is scan, width, output % A word is an item of text. It may be output to a stream. % It has a width, which is the number of character positions % that are taken up when the word is printed. _rep = _string .end_keep .keep scan = _proc (c: _char, instream: stream) _returns (_cvt) % Construct a word whose first character is C and whose % remaining characters are to be removed from the instream. s: _string := _string$c2s (c) _while _true _do c := stream$peekc (instream) _except _when end_of_file: _break _end _if c = ' ' _cor c = '\t' _cor c = '\n' _then _break _end s := _string$append (s, stream$getc (instream)) _end _return (s) _end scan .end_keep .keep width = _proc (w: _cvt) _returns (_int) % Return the width of the word. _return (_string$size (w)) _end width .end_keep .keep output = _proc (w: _cvt, outstream: stream) % Output the word. stream$puts (w, outstream) _end output _end word .end_keep .pf 0 .fs 0 .fi .ls 1.5