Commits

Taylor Venable committed fb18447

Switch back to the good ol' Lua implementation moving forward

Comments (0)

Files changed (10)

 
 all:	tensile.sty $(HTML_FILES)
 
-chicken:	
-	make -C chicken
-
-lua:	
-	make -C lua
+tensile:	tensile.tnsl
+	tensile -indented-refs -tangle-to tensile -unit tensile tensile.tnsl
+	chmod +x tensile
 
 tensile.tex:	tensile.tnsl
 	tensile -indented-refs tensile.tnsl

chicken/Makefile

-OPTIMIZE_OPTIONS=-optimize-level 3
-#PROFILE_OPTIONS=-accumulate-profile -profile-name PROFILE
-
-all:	tensile
-
-clean:
-	rm -f tensile
-
-tensile:	tensile.scm
-	csc -output-file tensile $(OPTIMIZE_OPTIONS) $(PROFILE_OPTIONS) -postlude '(main (command-line-arguments))' tensile.scm

chicken/tensile.scm

-;;; Copyright (c) 2010, Taylor Venable
-;;; All rights reserved.
-;;;
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions are met:
-;;;
-;;;     * Redistributions of source code must retain the above copyright
-;;;       notice, this list of conditions and the following disclaimer.
-;;;
-;;;     * Redistributions in binary form must reproduce the above copyright
-;;;       notice, this list of conditions and the following disclaimer in the
-;;;       documentation and/or other materials provided with the distribution.
-;;;
-;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-;;; POSSIBILITY OF SUCH DAMAGE.
-
-(use chicken data-structures extras regex srfi-1 srfi-13 srfi-37 srfi-69 coops coops-primitive-objects fmt)
-
-(define *usage*
-"This is Tensile, Chicken edition.
-
-Tensile (c) 2009-2011 Taylor Venable.  All rights reserved.
-Provided under the terms of the Simplified (2-Clause) BSD license.
-LaTeX support provided under the LaTeX Project Public License, v1.3c or later.
-
-USAGE:
-    tensile <options> <literate-file>
-
-OPTIONS:
-
-  Standard:
-
-    -h / -help          Show this message.
-
-  File Handling:
-
-    -indented-refs      Allow references to be indented in source.
-    -list-tops          Print all toplevel units and quit.
-    -noweb-compat       Enable Noweb-compatible parsing.
-    -show-tops          Same as \"-list-tops\".
-    -write-ir           Write intermediate form to file.
-
-  Tangled Output:
-
-    -extract-all        Extract all toplevel units.
-    -tangle-to          Write single a single unit's source to <file>.
-                        This option will be ignored if > 1 unit is tangled.
-    -unit <name>        Tangle unit <name>.
-
-  Woven Output:
-
-    -no-weave           Do not produce woven output.
-    -weave-to <file>    Write woven output to <file>.
-    -thread <name>      Only weave output for doc chunks in thread <name>.
-    -hide margin-tags   Don't display definition tag number in the margin.
-    -hide defn-page     Don't show references to first definition.
-    -hide back-refs     Don't print references to usage location.
-    -hide source-code   Don't output source code in documentation.
-
-Email bug reports to taylor@metasyntax.net.")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  CLASSES
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-class <doc> ()
-  ((elements  initform: '()               accessor: doc-elements)
-    (unit-map initform: (make-hash-table) accessor: doc-unit-map)))
-
-(define-class <doc-elt> ())
-
-(define-class <doc-chunk> (<doc-elt>)
-  ((body         initform: (list) accessor: doc-chunk-body)
-    (thread-list initform: (list) accessor: doc-chunk-thread-list)))
-
-(define-class <nonstop-ref> (<doc-elt>)
-  ((which initform: #f accessor: nonstop-ref-which)))
-
-(define-class <src-chunk> ()
-  ((name      initform: #f     accessor: src-chunk-name)
-    (body     initform: (list) accessor: src-chunk-body)
-    (refs     initform: (list) accessor: src-chunk-refs)
-    (backrefs initform: (list) accessor: src-chunk-backrefs)
-    (label    initform: #f     accessor: src-chunk-label)
-    (sequence initform: 0      accessor: src-chunk-sequence)))
-
-(define-class <backref> ()
-  ((name      initform: #f     accessor: backref-name)
-    (sequence initform: #f     accessor: backref-sequence)))
-
-(define-class <unit-ref> ()
-  ((name  initform: #f accessor: unit-ref-name)
-    (pre  initform: #f accessor: unit-ref-pre)
-    (post initform: #f accessor: unit-ref-post)))
-
-(define (unit-ref? x) (eq? (class-of x) <unit-ref>))
-(define (doc-chunk? x) (eq? (class-of x) <doc-chunk>))
-(define (nonstop-ref? x) (eq? (class-of x) <nonstop-ref>))
-(define (src-chunk? x) (eq? (class-of x) <src-chunk>))
-(define (backref? x) (eq? (class-of x) <backref>))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  REGULAR EXPRESSIONS
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define r:unit-ref (regexp "^(.*)<<(.+)>>(.*)$"))
-(define r:thread-decl (regexp "^@\\|(.*)\\|$"))
-(define r:unit-decl (regexp "^<<(.+)>>=$"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  PARAMETERS
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; When #f, use (current-output-port).
-(define *tangled-output-file* (make-parameter #f))
-
-;; When #f, use (string-append unit ".tex").
-(define *woven-output-file*   (make-parameter #f))
-
-(define *code/doc-counter* 0)
-(define *id/doc*          "HARDCODED")
-
-(define operation             (make-parameter (list 'weave)))
-(define indented-refs?        (make-parameter #t))
-(define weave?                (make-parameter #t))
-(define margin-tags?          (make-parameter #t))
-(define defn-page?            (make-parameter #t))
-(define back-refs?            (make-parameter #t))
-(define source-code?          (make-parameter #t))
-(define weave-output-path     (make-parameter (current-output-port)))
-(define thread                (make-parameter "*"))
-
-(define *tex-escape/typeset*
-  '(("{"  . "\\{")
-    ("}"  . "\\}")
-    ("_"  . "\\_")
-    ("<"  . "<{}")
-    (">"  . ">{}")
-    ("\\" . "\\verb+\\+")
-    ("|"  . "\\verb+|+")
-    ("-"  . "-{}")))
-
-(define *tex-escape/typeset/keys* (string->char-set "{}_<>\\|-"))
-
-(define *tex-escape/label*
-  '(("{"  . "\\{")
-    ("}"  . "\\}")
-    ("_"  . "\\_")
-    ("<"  . "<{}")
-    (">"  . ">{}")
-    ("\\" . "\\verb+\\+")
-    ("|"  . "\\verb+|+")
-    ("-"  . "-{}")))
-
-(define *tex-escape/label/keys* (string->char-set "{}_<>\\|-"))
-
-;; The last newline of a source chunk doesn't count, because its context
-;; determines when a newline is used. When tangling, the unit reference
-;; indicates what follows the code that is inserted: this may be any text
-;; followed by a newline. Therefore we remove the newline which is inserted at
-;; the end of the last element in any source chunk. This function is a
-;; convenient place to do so because it is called for every source chunk.
-(define (reverse-body! chunk)
-  (cond ((src-chunk? chunk)
-         (if (not (null? (src-chunk-body chunk)))
-           (let ((last (car (src-chunk-body chunk))))
-             (if (unit-ref? last)
-               (set! (unit-ref-post last) (string-drop-right (unit-ref-post last) 1))
-               (set! (src-chunk-body chunk) (cons (string-drop-right last 1) (cdr (src-chunk-body chunk)))))))
-         (set! (src-chunk-body chunk) (reverse (src-chunk-body chunk)))
-         (set! (src-chunk-refs chunk) (reverse (src-chunk-refs chunk))))
-        ((doc-chunk? chunk)
-         (set! (doc-chunk-body chunk) (reverse (doc-chunk-body chunk))))))
-
-(define (weave/counter output)
-  (display *code/doc-counter* output)
-  (set! *code/doc-counter* (+ *code/doc-counter* 1)))
-
-(define (make-safe-output/label engine s)
-  (case engine
-    ((tex latex) s)
-    (else
-      (error "Unhandled engine" engine))))
-
-(define (make-safe-output/typeset engine s)
-  (case engine
-    ((tex latex)
-     (let loop ((start 0)
-                (result ""))
-       (let ((index (string-index s *tex-escape/typeset/keys* start)))
-         (if (not (eq? index #f))
-           (let* ((char (string-ref s index))
-                  (replacement (cdar (member (string char) *tex-escape/typeset*
-                                             (lambda (x elem) (string=? x (car elem)))))))
-             (loop (+ index 1)
-                   (string-append
-                     (string-append result (substring s start index))
-                     replacement)))
-           (string-append result (substring s start))))))
-    (else
-      (error "Unhandled engine" engine))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  OUTPUT MESSAGES GOING TO THE USER
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (user-error message . args)
-  (apply format (cons* #t message args))
-  (exit 1))
-
-(define (parser-error line-number message . args)
-  (apply user-error (cons (format #f "Input line ~a: ~a" line-number message) args)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  LABELS
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (make-label name)
-  (let* ((no-spaces (string-substitute* name '(("[ \t\r\n]" . ""))))
-         (result (string-substitute* no-spaces '(("[^A-Za-z0-9-]" . "")))))
-    result))
-
-;; Convert something to a source chunk. If it is a string, look that source
-;; chunk up by name (returning the first one in the sequence). If it is a
-;; backref, return the appropriate source chunk (including the right sequence
-;; number). If it is a source chunk to begin with, just return it.
-(define (->src-chunk doc x)
-  (cond ((string? x)
-         (if (not (hash-table-exists? (doc-unit-map doc) x))
-           (error "No such unit" x)
-           (car (hash-table-ref (doc-unit-map doc) x))))
-        ((backref? x)
-         (if (not (hash-table-exists? (doc-unit-map doc) (backref-name x)))
-           (error "No such unit" x)
-           (list-ref (hash-table-ref (doc-unit-map doc) (backref-name x)) (backref-sequence x))))
-        ((src-chunk? x)
-         x)
-        (else
-          (error "Cannot convert to source chunk" x))))
-
-(define (label doc chunk)
-  (let ((src (->src-chunk doc chunk)))
-    (if (eq? (src-chunk-label src) #f)
-      (set! (src-chunk-label src) (make-label (src-chunk-name src))))
-    (string-append "tnsl:lbl:" *id/doc* ":" (src-chunk-label src) ":" (number->string (src-chunk-sequence src)))))
-
-(define (label/first doc chunk)
-  (let ((src (->src-chunk doc chunk)))
-    (if (eq? (src-chunk-label src) #f)
-      (set! (src-chunk-label src) (make-label (src-chunk-name src))))
-    (string-append "tnsl:lbl:" *id/doc* ":" (src-chunk-label src) ":" "0")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  WEAVING
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (weave/label doc def engine output)
-  (display "\\sublabel{" output)
-  (display (label doc def) output)
-  (display "}" output))
-
-(define (weave/margin-tag doc def engine output)
-  (display "\\tnslMarginTag{{\\subpageref{" output)
-  (display (label doc def) output)
-  (display "}}}" output))
-
-(define (weave/unit-def doc def engine output)
-  (display "\\tnslBeginUnitDef{" output)
-  (display (make-safe-output/label engine (src-chunk-name def)) output)
-  (display "~{\\subpageref{" output)
-  (display (label/first doc def) output)
-  (display "}}" output)
-  (if (zero? (src-chunk-sequence def))
-    (display "}\\tnslEndUnitDef" output)
-    (display "}\\tnslEndUnitDefPlus" output)))
-
-(define (weave/back-refs doc def engine output)
-  (if (not (zero? (length (src-chunk-backrefs def))))
-    (begin
-      (display "\\tnslBackRef{\\\\{" output)
-      ;; FIXME make this use the real backref, not some fudged thing
-      (display (label/first doc (car (src-chunk-backrefs def))) output)
-      (display "}}" output))))
-
-;; Display a reference to another unit from within a source chunk.
-(define (weave/unit-ref doc ref engine output)
-  (display (unit-ref-pre ref) output)
-  (display "\\tnslStartUnitName{}" output)
-  (display (unit-ref-name ref) output)
-  (display "~{\\rm\\subpageref{" output)
-  (display (label/first doc (unit-ref-name ref)) output)
-  (display "}}" output)
-  (display "\\tnslEndUnitName{}" output)
-  (display (unit-ref-post ref) output))
-
-;; Write out a complete source chunk.
-(define (weave/src-chunk doc def engine output)
-  (display "\\tnslBeginCode{" output)
-  (weave/counter output)
-  (display "}" output)
-  (weave/label doc def engine output)
-  (weave/margin-tag doc def engine output)
-  (weave/unit-def doc def engine output)
-  (display "\\tnslBeginDefLine" output)
-  (weave/back-refs doc def engine output)
-  (display "\\tnslEndDefLine\n" output)
-  (let loop ((elts (src-chunk-body def)))
-    (if (null? elts) #f
-      (let ((x (car elts)))
-        (cond ((string? x)
-               (display (make-safe-output/typeset engine x) output))
-              ((unit-ref? x)
-               (weave/unit-ref doc x engine output))
-              (else
-                (error "Invalid internal structure" x)))
-        (loop (cdr elts)))))
-  (display "\\tnslEndCode{}\n" output))
-
-(define (weave/doc-chunk doc engine output)
-  (display "\\tnslBeginDoc{" output)
-  (weave/counter output)
-  (display "}\\tnslDocPar" output)
-  (newline output)
-  (for-each (lambda (line)
-              (display line output)
-              (newline output))
-            (doc-chunk-body doc))
-  (display "\\tnslEndDoc{}" output)
-  (newline output))
-
-(define (weave doc engine output)
-  (let loop ((elts (doc-elements doc)))
-    (if (null? elts) #f
-      (let ((x (car elts)))
-        (cond ((doc-chunk? x)
-               (weave/doc-chunk x engine output))
-              ((nonstop-ref? x)
-               (display "NON-STOP REF: " output)
-               (display (nonstop-ref-which x) output)
-               (newline output))
-              ((src-chunk? x)
-               (weave/src-chunk doc x engine output))
-              (else
-                (error "Invalid internal structure" x)))
-        (loop (cdr elts))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  TANGLING
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-method (tangle (doc <doc>) (unit <string>) (output <port>))
-  (if (not (string? unit))
-    (error "bad argument type - not a string" unit))
-  (if (not (output-port? output))
-    (error "bad argument type - not an output port" output))
-  (tangle doc unit 0 output)
-  (newline output))
-
-(define-method (tangle (doc <doc>) (unit <string>) (indent <fixnum>) (output <port>))
-  (if (not (fixnum? indent))
-    (error "bad argument type - not a fixnum" indent))
-  (if (not (output-port? output))
-    (error "bad argument type - not an output port" output))
-  (if (not (hash-table-exists? (doc-unit-map doc) unit))
-    (error "No such unit" unit)
-    ;; Iterate through all the sequenced chunks with that name.
-    ;; IMPORTANT: They are consed to the list when added, so reverse them!
-    (fold (lambda (e countdown)
-            (tangle doc e indent output)
-            (if (> countdown 1)
-              (newline output))
-            (- countdown 1))
-          (length (hash-table-ref (doc-unit-map doc) unit))
-          (reverse (hash-table-ref (doc-unit-map doc) unit)))))
-
-(define-method (tangle (doc <doc>) (chunk <src-chunk>) (indent <fixnum>) (output <port>))
-  (if (not (fixnum? indent))
-    (error "bad argument type - not a fixnum" indent))
-  (if (not (output-port? output))
-    (error "bad argument type - not an output port" output))
-  (fold (lambda (e index)
-          (cond ((string? e)
-                 (if (> index 0)
-                   (display (make-string indent #\space) output))
-                 (display e output))
-                ((unit-ref? e)
-                 (if (> index 0)
-                   (display (make-string indent #\space) output))
-                 (display (unit-ref-pre e) output)
-                 (tangle doc (unit-ref-name e) (+ indent (string-length (unit-ref-pre e))) output)
-                 (display (unit-ref-post e) output))
-                (else
-                  (error "Internal error: unknown type" e)))
-          (+ index 1))
-        0
-        (src-chunk-body chunk)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  SUMMARY
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-method (summarise (doc <doc>))
-  (display "DOCUMENT")
-  (newline)
-  (for-each summarise (doc-elements doc)))
-
-(define-method (summarise (doc <doc-chunk>))
-  (display "  Document Chunk (")
-  (display (length (doc-chunk-body doc)))
-  (display " lines)")
-  (newline))
-
-(define-method (summarise (src <src-chunk>))
-  (display "  Source Chunk <<")
-  (display (src-chunk-name src))
-  (display ">> [")
-  (display (src-chunk-sequence src))
-  (display "]")
-  (newline)
-  (display "    References:")
-  (newline)
-  (for-each (lambda (ref)
-              (display "      ")
-              (display ref)
-              (newline))
-            (src-chunk-refs src))
-  (display "    Back References:")
-  (newline)
-  (for-each (lambda (ref)
-              (display "      ")
-              (display (backref-name ref))
-              (display " [")
-              (display (backref-sequence ref))
-              (display "]")
-              (newline))
-            (src-chunk-backrefs src)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  VALIDATION
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Checks the references in all units within the document, and prints out
-;; missing references. Returns #t if there are no missing references, and #f if
-;; any references used are not defined.
-(define-method (valid/existence? (doc <doc>))
-  (hash-table-fold
-    (doc-unit-map doc)
-    (lambda (key value old)
-      (let ((absent (filter (lambda (name)
-                              (not (hash-table-exists? (doc-unit-map doc) name)))
-                            (src-chunk-refs value))))
-        (if (not (null? absent))
-            (display (string-append "Warning: Missing (from <<"
-                                    key
-                                    ">>):\n  ["
-                                    (string-join (map (cut string-append "\"" <> "\"") absent) ", ")
-                                    "]\n")))
-        (and old (null? absent))))
-    #t))
-
-;; Finds circular references in the document, and prints them if found. Returns
-;; #t if there are no circular references, or #f if there are.
-;; FIXME Only finds circular references that are one level deep.
-(define-method (valid/circular? (doc <doc>))
-  (hash-table-fold
-    (doc-unit-map doc)
-    (lambda (key value old)
-      (let ((circular (filter (lambda (x)
-                                (not (eq? x #f)))
-                              (map (lambda (ref)
-                                     (if (and (hash-table-exists? (doc-unit-map doc) ref)
-                                              (member key (src-chunk-refs (hash-table-ref (doc-unit-map doc) ref)))) ref #f))
-                                   (src-chunk-refs value)))))
-        (if (not (null? circular))
-          (display (string-append "Warning: Circular refs (from <<"
-                                  key
-                                  ">>):\n  ["
-                                  (string-join (map (cut string-append "\"" <> "\"") circular) ", ")
-                                  "]\n")))
-        (and old (null? circular))))
-    #t))
-
-(define (backref-exists? backref lst)
-  (member backref lst (lambda (x elem)
-                        (and (string=? (backref-name x) (backref-name elem))
-                             (= (backref-sequence x) (backref-sequence elem))))))
-
-(define (add-backrefs! doc)
-  (for-each (lambda (x)
-              (if (src-chunk? x)
-                (for-each (lambda (ref)
-                            (for-each (lambda (def)
-                                        (let ((backref (make <backref>)))
-                                          (set! (backref-name backref) (src-chunk-name x))
-                                          (set! (backref-sequence backref) (src-chunk-sequence x))
-                                          (if (not (backref-exists? backref (src-chunk-backrefs def)))
-                                            (set! (src-chunk-backrefs def) (cons backref (src-chunk-backrefs def))))))
-                                      (hash-table-ref/default (doc-unit-map doc) ref (list))))
-                          (src-chunk-refs x))))
-            (doc-elements doc)))
-
-(define (add-line! chunk line)
-  (cond ((doc-chunk? chunk)
-         (set! (doc-chunk-body chunk) (cons line (doc-chunk-body chunk))))
-        ((src-chunk? chunk)
-         (cond ((string-search r:unit-ref line)
-                => (lambda (m)
-                     (let ((pre  (list-ref m 1))
-                           (name (list-ref m 2))
-                           (post (list-ref m 3)))
-                       (if (and (> (string-length pre) 0) (string=? (string-take-right pre 1) "@"))
-                         (set! (src-chunk-body chunk)
-                           (cons (string-append (string-drop-right pre 1) "<<" name ">>" post "\n")
-                                 (src-chunk-body chunk)))
-                         (let ((ref (make <unit-ref>)))
-                           (set! (unit-ref-name ref) name)
-                           (set! (unit-ref-pre ref) pre)
-                           (set! (unit-ref-post ref) (string-append post "\n"))
-                           (set! (src-chunk-body chunk) (cons ref (src-chunk-body chunk)))
-                           (if (not (member name (src-chunk-refs chunk)))
-                             (set! (src-chunk-refs chunk) (cons name (src-chunk-refs chunk)))))))))
-               (else
-                 (set! (src-chunk-body chunk)
-                   (cons (string-append line "\n") (src-chunk-body chunk))))))
-        (else
-          (error "Unknown type" chunk))))
-
-(define (parse input)
-  (let ((doc (make <doc>))
-        (chunk (make <doc-chunk>))
-        (last-chunk-name #f))
-
-    (letrec ((commit!  (lambda ()
-                         ;; Remember, we cons when we add-line! so we need to reverse it sometime.
-                         (reverse-body! chunk)
-                         (set! (doc-elements doc)
-                           (cons chunk (doc-elements doc))))))
-
-      (let loop ((line (read-line input))
-                 (line-number 0)
-                 (state 'doc))
-        (if (eof-object? line)
-          (commit!)
-          (cond ((string-search "^@$" line)
-                 (commit!)
-                 (set! chunk (make <doc-chunk>))
-                 (set! (doc-chunk-thread-list chunk) (list "*"))
-                 (loop (read-line input) (+ line-number 1) 'doc))
-
-                ;; A document chunk that has threads defined.
-                ((string-search r:thread-decl line)
-                 => (lambda (m)
-                      (commit!)
-                      (let ((threads (string-split (list-ref m 1) #\|)))
-                        (set! chunk (make <doc-chunk>))
-                        (set! (doc-chunk-thread-list chunk) threads))
-                      (loop (read-line input) (+ line-number 1) 'doc)))
-
-                ;; A source chunk definition.
-                ((string-search r:unit-decl line)
-                 => (lambda (m)
-                      (commit!)
-                      (let ((name (list-ref m 1)))
-                        (if (string=? name "...")
-                          (if (eq? last-chunk-name #f)
-                            (error "Tried to use \"...\" chunk name with no preceding chunk")
-                            (set! name last-chunk-name)))
-                        (set! last-chunk-name name)
-                        (set! chunk (make <src-chunk>))
-                        (set! (src-chunk-name chunk) name)
-                        (set! (src-chunk-sequence chunk)
-                          (length (hash-table-ref/default (doc-unit-map doc) name (list))))
-                        ;; Stick this chunk onto the list of chunks keyed by name.
-                        (hash-table-update!/default (doc-unit-map doc) name (cut cons chunk <>) (list)))
-                      (loop (read-line input) (+ line-number 1) 'src)))
-
-                ;; Otherwise just add to whatever chunk we're in.
-                (else
-                  (if (eq? chunk #f)
-                    (parser-error line-number "Not inside a chunk.~%"))
-                  (add-line! chunk line)
-                  (loop (read-line input) (+ line-number 1) state))))))
-
-    (add-backrefs! doc)
-    (set! (doc-elements doc) (reverse (doc-elements doc)))
-    doc))
-
-(define (parse-file path)
-  (call-with-input-file path parse))
-
-(define-method (units/all (doc <doc>))
-  (hash-table-keys (doc-unit-map doc)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  WEAVING FEATURES
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define *weaving-features* (make-hash-table))
-(define *tangling-features* (make-hash-table))
-
-(define (init-weaving-features)
-  (for-each (lambda (x)
-              (hash-table-set! *weaving-features* x #t))
-            '("margin-tags" "defn-page" "back-refs" "source-code")))
-
-(define (init-tangling-features)
-  (for-each (lambda (x)
-              (hash-table-set! *tangling-features* x #t))
-            '("indented-refs")))
-
-(define (disable-weaving-feature which)
-  (if (not (hash-table-exists? *weaving-features* which))
-    (user-error "Not a valid weaving feature: ~a~%" which))
-  (hash-table-set! *weaving-feature* which #f))
-
-(define (disable-tangling-feature which)
-  (if (not (hash-table-exists? *tangling-features* which))
-    (user-error "Not a valid tangling feature: ~a~%" which))
-  (hash-table-set! *tangling-feature* which #f))
-
-(define (process-args argv return)
-  (let loop ((args argv))
-    (if (null? args)
-      (return (list))
-      (let ((arg (car args)))
-        (cond ((string=? arg "--")
-               (return (cdr args)))
-              ((or (string=? arg "-h") (string=? arg "-help"))
-               (print *usage*)
-               (return #f))
-              ((string=? arg "-tangle-to")
-               (*tangled-output-file* (cadr args))
-               (loop (cddr args)))
-              ((string=? arg "-weave-to")
-               (*woven-output-file* (cadr args))
-               (loop (cddr args)))
-              ((string=? arg "-list-tops")
-               (operation (list 'list-tops))
-               (loop (cdr args)))
-              ((string=? arg "-extract-all")
-               (operation (list 'extract-all))
-               (loop (cdr args)))
-              ((string=? arg "-no-weave")
-               (weave? #f)
-               (loop (cdr args)))
-              ((string=? arg "-unit")
-               (operation (list 'tangle (cadr args)))
-               (loop (cddr args)))
-              ((string=? arg "-hide")
-               (disable-weaving-feature (cadr args))
-               (loop (cddr args)))
-              ((string=? arg "-indented-refs")
-               (loop (cdr args)))
-              ((string-prefix? "-" arg)
-               (user-error "Unknown option: ~a~%" arg))
-              (else
-                (return args)))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  MAIN PROGRAM DRIVER
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (main argv)
-  (init-weaving-features)
-  (let ((leftover (call/cc (lambda (k) (process-args argv k)))))
-    (if (not (eq? leftover #f))
-      (let loop ((xs leftover))
-        (if (null? xs) #f
-          (let ((x (car xs)))
-            (case (car (operation))
-              ((weave) (main/weave x))
-              ((tangle) (main/tangle x))
-              ((list-tops)
-               (print "I'm listing tops!"))
-              ((extract-all)
-               (print "I'm extracting everything!"))
-              (else
-                (print "OMG, what am I doing?")))
-            (loop (cdr xs))))))))
-
-(define (main/weave x)
-  (let* ((doc (parse-file x))
-         (output (if (*woven-output-file*)
-                   (if (string=? (*woven-output-file*) "-")
-                     (current-output-port)
-                     (open-output-file (*woven-output-file*)))
-                   (open-output-file (string-append x ".tex")))))
-    (weave doc 'tex output)
-    (if (not (eq? output (current-output-port)))
-      (close-output-port output))))
-
-(define (main/tangle x)
-  (let* ((unit-name (cadr (operation)))
-         (doc (parse-file x))
-         (output (if (*tangled-output-file*)
-                   (if (string=? (*tangled-output-file*) "-")
-                     (current-output-port)
-                     (open-output-file (*tangled-output-file*)))
-                   (open-output-file unit-name))))
-    (tangle doc unit-name output)
-    (if (not (eq? output (current-output-port)))
-      (close-output-port output))))

common.scm

-;;; Copyright (c) 2010, Taylor Venable
-;;; All rights reserved.
-;;;
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions are met:
-;;;
-;;;     * Redistributions of source code must retain the above copyright
-;;;       notice, this list of conditions and the following disclaimer.
-;;;
-;;;     * Redistributions in binary form must reproduce the above copyright
-;;;       notice, this list of conditions and the following disclaimer in the
-;;;       documentation and/or other materials provided with the distribution.
-;;;
-;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-;;; POSSIBILITY OF SUCH DAMAGE.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  PARAMETERS
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define *code/doc-counter* 0)
-(define *id/doc*          "HARDCODED")
-
-(define indented-refs?    (make-parameter #t))
-
-(define weave?            (make-parameter #t))
-(define margin-tags?      (make-parameter #t))
-(define defn-page?        (make-parameter #t))
-(define source-code?      (make-parameter #t))
-(define weave-output-path (make-parameter (current-output-port)))
-(define thread            (make-parameter "*"))
-
-(define *tex-escape/typeset*
-  '(("{"  . "\\{")
-    ("}"  . "\\}")
-    ("_"  . "\\_")
-    ("<"  . "<{}")
-    (">"  . ">{}")
-    ("\\" . "\\verb+\\+")
-    ("|"  . "\\verb+|+")
-    ("-"  . "-{}")))
-
-(define *tex-escape/typeset-keys* (string-join (map car *tex-escape/typeset*) ""))
-
-(define *tex-escape/label*
-  '(("{"  . "\\{")
-    ("}"  . "\\}")
-    ("_"  . "\\_")
-    ("<"  . "<{}")
-    (">"  . ">{}")
-    ("\\" . "\\verb+\\+")
-    ("|"  . "\\verb+|+")
-    ("-"  . "-{}")))
-
-(define *tex-escape/label-keys* (string-join (map car *tex-escape/label*) ""))
-
-;; The last newline of a source chunk doesn't count, because its context
-;; determines when a newline is used. When tangling, the unit reference
-;; indicates what follows the code that is inserted: this may be any text
-;; followed by a newline. Therefore we remove the newline which is inserted at
-;; the end of the last element in any source chunk. This function is a
-;; convenient place to do so because it is called for every source chunk.
-(define-method (reverse-body! (chunk <src-chunk>))
-  (let ((last (car (src-chunk-body chunk))))
-    (if (unit-ref? last)
-      (set! (unit-ref-post last) (string-drop-right (unit-ref-post last) 1))
-      (set! (src-chunk-body chunk) (cons (string-drop-right last 1) (cdr (src-chunk-body chunk))))))
-  (set! (src-chunk-body chunk) (reverse (src-chunk-body chunk)))
-  (set! (src-chunk-refs chunk) (reverse (src-chunk-refs chunk))))
-
-;; Reverse the body of a documentation chunk.
-(define-method (reverse-body! (chunk <doc-chunk>))
-  (set! (doc-chunk-body chunk) (reverse (doc-chunk-body chunk))))
-
-(define (weave/counter output)
-  (display *code/doc-counter*)
-  (set! *code/doc-counter* (+ *code/doc-counter* 1)))
-
-(define (make-safe-output/label engine s)
-  (case engine
-    ((tex latex) s)
-    (else
-      (error "Unhandled engine" engine))))
-
-(define (make-safe-output/typeset engine s)
-  (case engine
-    ((tex latex)
-     (magic-escape *tex-escape/typeset-keys* *tex-escape/typeset* s))
-    (else
-      (error "Unhandled engine" engine))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  LABELS
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (make-label name)
-  (let* ((no-spaces (regexp-substitute/global #f "[ \t\r\n]" name 'pre "-" 'post))
-         (result (regexp-substitute/global #f "[^A-Za-z0-9-]" no-spaces 'pre "." 'post)))
-    result))
-
-;; Convert something to a source chunk. If it is a string, look that source
-;; chunk up by name (returning the first one in the sequence). If it is a
-;; backref, return the appropriate source chunk (including the right sequence
-;; number). If it is a source chunk to begin with, just return it.
-(define (->src-chunk doc x)
-  (cond ((string? x)
-         (if (not (hash-table-exists? (doc-unit-map doc) x))
-           (error "No such unit" x)
-           (car (hash-table-ref (doc-unit-map doc) x))))
-        ((backref? x)
-         (if (not (hash-table-exists? (doc-unit-map doc) (backref-name x)))
-           (error "No such unit" x)
-           (list-ref (hash-table-ref (doc-unit-map doc) (backref-name x)) (backref-sequence x))))
-        ((src-chunk? x)
-         x)
-        (else
-          (error "Cannot convert to source chunk" x))))
-
-(define (label doc chunk)
-  (let ((src (->src-chunk doc chunk)))
-    (if (eq? (src-chunk-label src) #f)
-      (set! (src-chunk-label src) (make-label (src-chunk-name src))))
-    (string-append "tnsl:lbl:" *id/doc* ":" (src-chunk-label src) ":" (number->string (src-chunk-sequence src)))))
-
-(define (label/first doc chunk)
-  (let ((src (->src-chunk doc chunk)))
-    (if (eq? (src-chunk-label src) #f)
-      (set! (src-chunk-label src) (make-label (src-chunk-name src))))
-    (string-append "tnsl:lbl:" *id/doc* ":" (src-chunk-label src) ":" "0")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  WEAVING
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (weave/label doc def engine output)
-  (display "\\sublabel{" output)
-  (display (label doc def) output)
-  (display "}" output))
-
-(define (weave/margin-tag doc def engine output)
-  (display "\\tnslMarginTag{{\\subpageref{" output)
-  (display (label doc def) output)
-  (display "}}}" output))
-
-(define (weave/unit-def doc def engine output)
-  (display "\\tnslBeginUnitDef{" output)
-  (display (make-safe-output/label engine (src-chunk-name def)) output)
-  (display "~{\\subpageref{" output)
-  (display (label/first doc def))
-  (display "}}" output)
-  (if (zero? (src-chunk-sequence def))
-    (display "}\\tnslEndUnitDef" output)
-    (display "}\\tnslEndUnitDefPlus" output)))
-
-(define (weave/back-refs doc def engine output)
-  (if (not (zero? (length (src-chunk-backrefs def))))
-    (begin
-      (display "\\tnslBackRef{\\\\{" output)
-      ;; FIXME make this use the real backref, not some fudged thing
-      (display (label/first doc (car (src-chunk-backrefs def))))
-      (display "}}" output))))
-
-;; Display a reference to another unit from within a source chunk.
-(define (weave/unit-ref doc ref engine output)
-  (display (unit-ref-pre ref) output)
-  (display "\\tnslStartUnitName{}" output)
-  (display (unit-ref-name ref) output)
-  (display "~{\\rm\\subpageref{" output)
-  (display (label/first doc (unit-ref-name ref)) output)
-  (display "}}" output)
-  (display "\\tnslEndUnitName{}" output)
-  (display (unit-ref-post ref) output))
-
-;; Write out a complete source chunk.
-(define-method (weave (doc <doc>) (def <src-chunk>) engine output)
-  (display "\\tnslBeginCode{" output)
-  (weave/counter output)
-  (display "}" output)
-  (weave/label doc def engine output)
-  (weave/margin-tag doc def engine output)
-  (weave/unit-def doc def engine output)
-  (display "\\tnslBeginDefLine" output)
-  (weave/back-refs doc def engine output)
-  (display "\\tnslEndDefLine\n" output)
-  (let loop ((elts (src-chunk-body def)))
-    (if (null? elts) #f
-      (let ((x (car elts)))
-        (cond ((string? x)
-               (display (make-safe-output/typeset engine x) output))
-              ((unit-ref? x)
-               (weave/unit-ref doc x engine output))
-              (else
-                (error "Invalid internal structure" x)))
-        (loop (cdr elts)))))
-  (display "\\tnslEndCode{}\n" output)
-  )
-
-(define-method (weave (doc <doc>) engine output)
-  (let loop ((elts (doc-elements doc)))
-    (if (null? elts) #f
-      (let ((x (car elts)))
-        (cond ((doc-chunk? x)
-               (weave x engine output))
-              ((nonstop-ref? x)
-               (display "NON-STOP REF: " output)
-               (display (nonstop-ref-which x) output)
-               (newline output))
-              ((src-chunk? x)
-               (weave doc x engine output))
-              (else
-                (error "Invalid internal structure" x)))
-        (loop (cdr elts))))))
-
-(define-method (weave (doc <doc-chunk>) engine output)
-  (display "\\tnslBeginDoc{" output)
-  (weave/counter output)
-  (display "}\\tnslDocPar" output)
-  (newline output)
-  (for-each (lambda (line)
-              (display line output)
-              (newline output))
-            (doc-chunk-body doc))
-  (display "\\tnslEndDoc{}")
-  (newline))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  TANGLING
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-method (tangle (doc <doc>) (unit <string>) output)
-  (tangle doc unit 0 output)
-  (newline output))
-
-(define-method (tangle (doc <doc>) (unit <string>) indent output)
-  (if (not (hash-table-exists? (doc-unit-map doc) unit))
-    (error "No such unit" unit)
-    ;; Iterate through all the sequenced chunks with that name.
-    ;; IMPORTANT: They are consed to the list when added, so reverse them!
-    (fold (lambda (e countdown)
-            (tangle doc e indent output)
-            (if (> countdown 1)
-              (newline))
-            (- countdown 1))
-          (length (hash-table-ref (doc-unit-map doc) unit))
-          (reverse (hash-table-ref (doc-unit-map doc) unit)))))
-
-(define-method (tangle (doc <doc>) (chunk <src-chunk>) indent output)
-  (fold (lambda (e index)
-          (cond ((string? e)
-                 (if (> index 0)
-                   (display (make-string indent #\space)))
-                 (display e output))
-                ((unit-ref? e)
-                 (if (> index 0)
-                   (display (make-string indent #\space)))
-                 (display (unit-ref-pre e) output)
-                 (tangle doc (unit-ref-name e) (+ indent (string-length (unit-ref-pre e))) output)
-                 (display (unit-ref-post e) output))
-                (else
-                  (error "Internal error: unknown type" e)))
-          (+ index 1))
-        0
-        (src-chunk-body chunk)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  SUMMARY
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-method (summarise (doc <doc>))
-  (display "DOCUMENT")
-  (newline)
-  (for-each summarise (doc-elements doc)))
-
-(define-method (summarise (doc <doc-chunk>))
-  (display "  Document Chunk (")
-  (display (length (doc-chunk-body doc)))
-  (display " lines)")
-  (newline))
-
-(define-method (summarise (src <src-chunk>))
-  (display "  Source Chunk <<")
-  (display (src-chunk-name src))
-  (display ">> [")
-  (display (src-chunk-sequence src))
-  (display "]")
-  (newline)
-  (display "    References:")
-  (newline)
-  (for-each (lambda (ref)
-              (display "      ")
-              (display ref)
-              (newline))
-            (src-chunk-refs src))
-  (display "    Back References:")
-  (newline)
-  (for-each (lambda (ref)
-              (display "      ")
-              (display (backref-name ref))
-              (display " [")
-              (display (backref-sequence ref))
-              (display "]")
-              (newline))
-            (src-chunk-backrefs src)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  VALIDATION
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Checks the references in all units within the document, and prints out
-;; missing references. Returns #t if there are no missing references, and #f if
-;; any references used are not defined.
-(define-method (valid/existence? (doc <doc>))
-  (hash-table-fold
-    (doc-unit-map doc)
-    (lambda (key value old)
-      (let ((absent (filter (lambda (name)
-                              (not (hash-table-exists? (doc-unit-map doc) name)))
-                            (src-chunk-refs value))))
-        (if (not (null? absent))
-            (display (string-append "Warning: Missing (from <<"
-                                    key
-                                    ">>):\n  ["
-                                    (string-join (map (cut string-append "\"" <> "\"") absent) ", ")
-                                    "]\n")))
-        (and old (null? absent))))
-    #t))
-
-;; Finds circular references in the document, and prints them if found. Returns
-;; #t if there are no circular references, or #f if there are.
-;; FIXME Only finds circular references that are one level deep.
-(define-method (valid/circular? (doc <doc>))
-  (hash-table-fold
-    (doc-unit-map doc)
-    (lambda (key value old)
-      (let ((circular (filter (lambda (x)
-                                (not (eq? x #f)))
-                              (map (lambda (ref)
-                                     (if (and (hash-table-exists? (doc-unit-map doc) ref)
-                                              (member key (src-chunk-refs (hash-table-ref (doc-unit-map doc) ref)))) ref #f))
-                                   (src-chunk-refs value)))))
-        (if (not (null? circular))
-          (display (string-append "Warning: Circular refs (from <<"
-                                  key
-                                  ">>):\n  ["
-                                  (string-join (map (cut string-append "\"" <> "\"") circular) ", ")
-                                  "]\n")))
-        (and old (null? circular))))
-    #t))
-
-(define (backref-exists? backref lst)
-  (member backref lst (lambda (x elem)
-                        (and (string=? (backref-name x) (backref-name elem))
-                             (= (backref-sequence x) (backref-sequence elem))))))
-
-(define (add-backrefs! doc)
-  (for-each (lambda (x)
-              (if (src-chunk? x)
-                (for-each (lambda (ref)
-                            (for-each (lambda (def)
-                                        (let ((backref (make <backref>)))
-                                          (set! (backref-name backref) (src-chunk-name x))
-                                          (set! (backref-sequence backref) (src-chunk-sequence x))
-                                          (if (not (backref-exists? backref (src-chunk-backrefs def)))
-                                            (set! (src-chunk-backrefs def) (cons backref (src-chunk-backrefs def))))))
-                                      (hash-table-ref/default (doc-unit-map doc) ref (list))))
-                          (src-chunk-refs x))))
-            (doc-elements doc)))
-
-;; Add a line to the body of a documentation chunk. That means just adding it
-;; to the list that's already there.
-(define-method (add-line! (chunk <doc-chunk>) line)
-  (set! (doc-chunk-body chunk)
-    (cons line (doc-chunk-body chunk))))
-
-;; Add a line to the body of a source chunk. We have to check and see if it
-;; contains a reference to another unit or not, and if it does, make sure to
-;; handle that appropriately.
-(define-method (add-line! (chunk <src-chunk>) line)
-  (cond ((string-match "^(.*)<<(.+)>>(.*)$" line)
-         => (lambda (m)
-              (let ((name (match:substring m 2)))
-                (let ((ref (make <unit-ref>)))
-                  (set! (unit-ref-name ref) name)
-                  (set! (unit-ref-pre ref) (match:substring m 1))
-                  (set! (unit-ref-post ref) (string-append (match:substring m 3) "\n"))
-                  (set! (src-chunk-body chunk) (cons ref (src-chunk-body chunk)))
-                  (if (not (member name (src-chunk-refs chunk)))
-                    (set! (src-chunk-refs chunk) (cons name (src-chunk-refs chunk))))))))
-        (else
-          (set! (src-chunk-body chunk)
-            (cons (string-append line "\n") (src-chunk-body chunk))))))
-
-(define (parse input)
-  (let ((doc (make <doc>))
-        (chunk #f)
-        (last-chunk-name #f))
-
-    (letrec ((commit!
-               (lambda ()
-                 (if (not (eq? chunk #f))
-                   (begin
-                     ;; Remember, we cons when we add-line! so we need to reverse it sometime.
-                     (reverse-body! chunk)
-                     (set! (doc-elements doc)
-                       (cons chunk (doc-elements doc))))))))
-
-      (let loop ((line (read-line input))
-                 (state 'doc))
-        (if (eof-object? line)
-          (commit!)
-          (cond ((string-match "^@$" line)
-                 (commit!)
-                 (set! chunk (make <doc-chunk>))
-                 (set! (doc-chunk-thread-list chunk) (list "*"))
-                 (loop (read-line input) 'doc))
-
-                ;; A document chunk that has threads defined.
-                ((string-match "^@\\|(.*)\\|$" line)
-                 => (lambda (m)
-                      (commit!)
-                      (let ((threads (string-split (match:substring m 1) #\|)))
-                        (set! chunk (make <doc-chunk>))
-                        (set! (doc-chunk-thread-list chunk) threads))
-                      (loop (read-line input) 'doc)))
-
-                ;; A source chunk definition.
-                ((string-match "^<<(.+)>>=$" line)
-                 => (lambda (m)
-                      (commit!)
-                      (let ((name (match:substring m 1)))
-                        (if (string=? name "...")
-                          (if (eq? last-chunk-name #f)
-                            (error "Tried to use \"...\" chunk name with no preceding chunk")
-                            (set! name last-chunk-name)))
-                        (set! last-chunk-name name)
-                        (set! chunk (make <src-chunk>))
-                        (set! (src-chunk-name chunk) name)
-                        (set! (src-chunk-sequence chunk)
-                          (length (hash-table-ref/default (doc-unit-map doc) name (list))))
-                        ;; Stick this chunk onto the list of chunks keyed by name.
-                        (hash-table-update!/default (doc-unit-map doc) name (cut cons chunk <>) (list)))
-                      (loop (read-line input) 'src)))
-
-                ;; Otherwise just add to whatever chunk we're in.
-                (else
-                  (add-line! chunk line)
-                  (loop (read-line input) state))))))
-
-    (add-backrefs! doc)
-    (set! (doc-elements doc) (reverse (doc-elements doc)))
-    doc))
-
-(define (parse-file path)
-  (call-with-input-file path parse))
-
-(define-method (units/all (doc <doc>))
-  (hash-table-keys (doc-unit-map doc)))

guile/tensile.scm

-;;; Copyright (c) 2010, Taylor Venable
-;;; All rights reserved.
-;;;
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions are met:
-;;;
-;;;     * Redistributions of source code must retain the above copyright
-;;;       notice, this list of conditions and the following disclaimer.
-;;;
-;;;     * Redistributions in binary form must reproduce the above copyright
-;;;       notice, this list of conditions and the following disclaimer in the
-;;;       documentation and/or other materials provided with the distribution.
-;;;
-;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-;;; POSSIBILITY OF SUCH DAMAGE.
-
-#:use-module (ice-9 rdelim)
-#:use-module (ice-9 regex)
-#:use-module (oop goops)
-#:use-module (srfi srfi-1)
-#:use-module (srfi srfi-26)
-#:use-module (srfi srfi-39)
-#:use-module (srfi srfi-69)
-
-(define-class <doc> ()
-  (elements #:init-form '()               #:accessor doc-elements)
-  (unit-map #:init-form (make-hash-table) #:accessor doc-unit-map))
-
-(define-class <doc-elt> ())
-
-(define-class <doc-chunk> (<doc-elt>)
-  (body        #:init-form (list) #:accessor doc-chunk-body)
-  (thread-list #:init-form (list) #:accessor doc-chunk-thread-list))
-
-(define-class <nonstop-ref> (<doc-elt>)
-  (which #:init-form #f #:accessor nonstop-ref-which))
-
-(define-class <src-chunk> ()
-  (name     #:init-form #f     #:accessor src-chunk-name)
-  (body     #:init-form (list) #:accessor src-chunk-body)
-  (refs     #:init-form (list) #:accessor src-chunk-refs)
-  (backrefs #:init-form (list) #:accessor src-chunk-backrefs)
-  (label    #:init-form #f     #:accessor src-chunk-label)
-  (sequence #:init-form 0      #:accessor src-chunk-sequence))
-
-(define-class <unit-ref> ()
-  (name #:init-form #f #:accessor unit-ref-name)
-  (pre  #:init-form #f #:accessor unit-ref-pre)
-  (post #:init-form #f #:accessor unit-ref-post))
-
-(define-class <backref> ()
-  (name     #:init-form #f #:accessor backref-name)
-  (sequence #:init-form #f #:accessor backref-sequence))
-
-(define (unit-ref? x) (is-a? x <unit-ref>))
-(define (doc-chunk? x) (is-a? x <doc-chunk>))
-(define (nonstop-ref? x) (is-a? x <nonstop-ref>))
-(define (src-chunk? x) (is-a? x <src-chunk>))
-(define (backref? x) (is-a? x <backref>))
-
-(define (magic-escape keys tr-table s)
-  (regexp-substitute/global
-    #f
-    (string-append "[" keys "]")
-    s
-    'pre
-    (lambda (m)
-      (let ((pair (member (match:substring m) tr-table (lambda (x elem) (string=? (car elem) x)))))
-        (if (eq? pair #f)
-          (error "Not in the replacement list" (match:substring m))
-          (cdr (car pair)))))
-    'post))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  PARAMETERS
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define *code/doc-counter* 0)
-(define *id/doc*          "HARDCODED")
-
-(define indented-refs?    (make-parameter #t))
-
-(define weave?            (make-parameter #t))
-(define margin-tags?      (make-parameter #t))
-(define defn-page?        (make-parameter #t))
-(define source-code?      (make-parameter #t))
-(define weave-output-path (make-parameter (current-output-port)))
-(define thread            (make-parameter "*"))
-
-(define *tex-escape/typeset*
-  '(("{"  . "\\{")
-    ("}"  . "\\}")
-    ("_"  . "\\_")
-    ("<"  . "<{}")
-    (">"  . ">{}")
-    ("\\" . "\\verb+\\+")
-    ("|"  . "\\verb+|+")
-    ("-"  . "-{}")))
-
-(define *tex-escape/typeset-keys* (string-join (map car *tex-escape/typeset*) ""))
-
-(define *tex-escape/label*
-  '(("{"  . "\\{")
-    ("}"  . "\\}")
-    ("_"  . "\\_")
-    ("<"  . "<{}")
-    (">"  . ">{}")
-    ("\\" . "\\verb+\\+")
-    ("|"  . "\\verb+|+")
-    ("-"  . "-{}")))
-
-(define *tex-escape/label-keys* (string-join (map car *tex-escape/label*) ""))
-
-;; The last newline of a source chunk doesn't count, because its context
-;; determines when a newline is used. When tangling, the unit reference
-;; indicates what follows the code that is inserted: this may be any text
-;; followed by a newline. Therefore we remove the newline which is inserted at
-;; the end of the last element in any source chunk. This function is a
-;; convenient place to do so because it is called for every source chunk.
-(define-method (reverse-body! (chunk <src-chunk>))
-  (let ((last (car (src-chunk-body chunk))))
-    (if (unit-ref? last)
-      (set! (unit-ref-post last) (string-drop-right (unit-ref-post last) 1))
-      (set! (src-chunk-body chunk) (cons (string-drop-right last 1) (cdr (src-chunk-body chunk))))))
-  (set! (src-chunk-body chunk) (reverse (src-chunk-body chunk)))
-  (set! (src-chunk-refs chunk) (reverse (src-chunk-refs chunk))))
-
-;; Reverse the body of a documentation chunk.
-(define-method (reverse-body! (chunk <doc-chunk>))
-  (set! (doc-chunk-body chunk) (reverse (doc-chunk-body chunk))))
-
-(define (weave/counter output)
-  (display *code/doc-counter*)
-  (set! *code/doc-counter* (+ *code/doc-counter* 1)))
-
-(define (make-safe-output/label engine s)
-  (case engine
-    ((tex latex) s)
-    (else
-      (error "Unhandled engine" engine))))
-
-(define (make-safe-output/typeset engine s)
-  (case engine
-    ((tex latex)
-     (magic-escape *tex-escape/typeset-keys* *tex-escape/typeset* s))
-    (else
-      (error "Unhandled engine" engine))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  LABELS
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (make-label name)
-  (let* ((no-spaces (regexp-substitute/global #f "[ \t\r\n]" name 'pre "-" 'post))
-         (result (regexp-substitute/global #f "[^A-Za-z0-9-]" no-spaces 'pre "." 'post)))
-    result))
-
-;; Convert something to a source chunk. If it is a string, look that source
-;; chunk up by name (returning the first one in the sequence). If it is a
-;; backref, return the appropriate source chunk (including the right sequence
-;; number). If it is a source chunk to begin with, just return it.
-(define (->src-chunk doc x)
-  (cond ((string? x)
-         (if (not (hash-table-exists? (doc-unit-map doc) x))
-           (error "No such unit" x)
-           (car (hash-table-ref (doc-unit-map doc) x))))
-        ((backref? x)
-         (if (not (hash-table-exists? (doc-unit-map doc) (backref-name x)))
-           (error "No such unit" x)
-           (list-ref (hash-table-ref (doc-unit-map doc) (backref-name x)) (backref-sequence x))))
-        ((src-chunk? x)
-         x)
-        (else
-          (error "Cannot convert to source chunk" x))))
-
-(define (label doc chunk)
-  (let ((src (->src-chunk doc chunk)))
-    (if (eq? (src-chunk-label src) #f)
-      (set! (src-chunk-label src) (make-label (src-chunk-name src))))
-    (string-append "tnsl:lbl:" *id/doc* ":" (src-chunk-label src) ":" (number->string (src-chunk-sequence src)))))
-
-(define (label/first doc chunk)
-  (let ((src (->src-chunk doc chunk)))
-    (if (eq? (src-chunk-label src) #f)
-      (set! (src-chunk-label src) (make-label (src-chunk-name src))))
-    (string-append "tnsl:lbl:" *id/doc* ":" (src-chunk-label src) ":" "0")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  WEAVING
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (weave/label doc def engine output)
-  (display "\\sublabel{" output)
-  (display (label doc def) output)
-  (display "}" output))
-
-(define (weave/margin-tag doc def engine output)
-  (display "\\tnslMarginTag{{\\subpageref{" output)
-  (display (label doc def) output)
-  (display "}}}" output))
-
-(define (weave/unit-def doc def engine output)
-  (display "\\tnslBeginUnitDef{" output)
-  (display (make-safe-output/label engine (src-chunk-name def)) output)
-  (display "~{\\subpageref{" output)
-  (display (label/first doc def))
-  (display "}}" output)
-  (if (zero? (src-chunk-sequence def))
-    (display "}\\tnslEndUnitDef" output)
-    (display "}\\tnslEndUnitDefPlus" output)))
-
-(define (weave/back-refs doc def engine output)
-  (if (not (zero? (length (src-chunk-backrefs def))))
-    (begin
-      (display "\\tnslBackRef{\\\\{" output)
-      ;; FIXME make this use the real backref, not some fudged thing
-      (display (label/first doc (car (src-chunk-backrefs def))))
-      (display "}}" output))))
-
-;; Display a reference to another unit from within a source chunk.
-(define (weave/unit-ref doc ref engine output)
-  (display (unit-ref-pre ref) output)
-  (display "\\tnslStartUnitName{}" output)
-  (display (unit-ref-name ref) output)
-  (display "~{\\rm\\subpageref{" output)
-  (display (label/first doc (unit-ref-name ref)) output)
-  (display "}}" output)
-  (display "\\tnslEndUnitName{}" output)
-  (display (unit-ref-post ref) output))
-
-;; Write out a complete source chunk.
-(define-method (weave (doc <doc>) (def <src-chunk>) engine output)
-  (display "\\tnslBeginCode{" output)
-  (weave/counter output)
-  (display "}" output)
-  (weave/label doc def engine output)
-  (weave/margin-tag doc def engine output)
-  (weave/unit-def doc def engine output)
-  (display "\\tnslBeginDefLine" output)
-  (weave/back-refs doc def engine output)
-  (display "\\tnslEndDefLine\n" output)
-  (let loop ((elts (src-chunk-body def)))
-    (if (null? elts) #f
-      (let ((x (car elts)))
-        (cond ((string? x)
-               (display (make-safe-output/typeset engine x) output))
-              ((unit-ref? x)
-               (weave/unit-ref doc x engine output))
-              (else
-                (error "Invalid internal structure" x)))
-        (loop (cdr elts)))))
-  (display "\\tnslEndCode{}\n" output)
-  )
-
-(define-method (weave (doc <doc>) engine output)
-  (let loop ((elts (doc-elements doc)))
-    (if (null? elts) #f
-      (let ((x (car elts)))
-        (cond ((doc-chunk? x)
-               (weave x engine output))
-              ((nonstop-ref? x)
-               (display "NON-STOP REF: " output)
-               (display (nonstop-ref-which x) output)
-               (newline output))
-              ((src-chunk? x)
-               (weave doc x engine output))
-              (else
-                (error "Invalid internal structure" x)))
-        (loop (cdr elts))))))
-
-(define-method (weave (doc <doc-chunk>) engine output)
-  (display "\\tnslBeginDoc{" output)
-  (weave/counter output)
-  (display "}\\tnslDocPar" output)
-  (newline output)
-  (for-each (lambda (line)
-              (display line output)
-              (newline output))
-            (doc-chunk-body doc))
-  (display "\\tnslEndDoc{}")
-  (newline))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  TANGLING
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-method (tangle (doc <doc>) (unit <string>) output)
-  (tangle doc unit 0 output)
-  (newline output))
-
-(define-method (tangle (doc <doc>) (unit <string>) indent output)
-  (if (not (hash-table-exists? (doc-unit-map doc) unit))
-    (error "No such unit" unit)
-    ;; Iterate through all the sequenced chunks with that name.
-    ;; IMPORTANT: They are consed to the list when added, so reverse them!
-    (fold (lambda (e countdown)
-            (tangle doc e indent output)
-            (if (> countdown 1)
-              (newline))
-            (- countdown 1))
-          (length (hash-table-ref (doc-unit-map doc) unit))
-          (reverse (hash-table-ref (doc-unit-map doc) unit)))))
-
-(define-method (tangle (doc <doc>) (chunk <src-chunk>) indent output)
-  (fold (lambda (e index)
-          (cond ((string? e)
-                 (if (> index 0)
-                   (display (make-string indent #\space)))
-                 (display e output))
-                ((unit-ref? e)
-                 (if (> index 0)
-                   (display (make-string indent #\space)))
-                 (display (unit-ref-pre e) output)
-                 (tangle doc (unit-ref-name e) (+ indent (string-length (unit-ref-pre e))) output)
-                 (display (unit-ref-post e) output))
-                (else
-                  (error "Internal error: unknown type" e)))
-          (+ index 1))
-        0
-        (src-chunk-body chunk)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  SUMMARY
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-method (summarise (doc <doc>))
-  (display "DOCUMENT")
-  (newline)
-  (for-each summarise (doc-elements doc)))
-
-(define-method (summarise (doc <doc-chunk>))
-  (display "  Document Chunk (")
-  (display (length (doc-chunk-body doc)))
-  (display " lines)")
-  (newline))
-
-(define-method (summarise (src <src-chunk>))
-  (display "  Source Chunk <<")
-  (display (src-chunk-name src))
-  (display ">> [")
-  (display (src-chunk-sequence src))
-  (display "]")
-  (newline)
-  (display "    References:")
-  (newline)
-  (for-each (lambda (ref)
-              (display "      ")
-              (display ref)
-              (newline))
-            (src-chunk-refs src))
-  (display "    Back References:")
-  (newline)
-  (for-each (lambda (ref)
-              (display "      ")
-              (display (backref-name ref))
-              (display " [")
-              (display (backref-sequence ref))
-              (display "]")
-              (newline))
-            (src-chunk-backrefs src)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;;  VALIDATION
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Checks the references in all units within the document, and prints out
-;; missing references. Returns #t if there are no missing references, and #f if
-;; any references used are not defined.
-(define-method (valid/existence? (doc <doc>))
-  (hash-table-fold
-    (doc-unit-map doc)
-    (lambda (key value old)
-      (let ((absent (filter (lambda (name)
-                              (not (hash-table-exists? (doc-unit-map doc) name)))
-                            (src-chunk-refs value))))
-        (if (not (null? absent))
-            (display (string-append "Warning: Missing (from <<"
-                                    key
-                                    ">>):\n  ["
-                                    (string-join (map (cut string-append "\"" <> "\"") absent) ", ")
-                                    "]\n")))
-        (and old (null? absent))))
-    #t))
-
-;; Finds circular references in the document, and prints them if found. Returns
-;; #t if there are no circular references, or #f if there are.
-;; FIXME Only finds circular references that are one level deep.
-(define-method (valid/circular? (doc <doc>))
-  (hash-table-fold
-    (doc-unit-map doc)
-    (lambda (key value old)
-      (let ((circular (filter (lambda (x)
-                                (not (eq? x #f)))
-                              (map (lambda (ref)
-                                     (if (and (hash-table-exists? (doc-unit-map doc) ref)
-                                              (member key (src-chunk-refs (hash-table-ref (doc-unit-map doc) ref)))) ref #f))
-                                   (src-chunk-refs value)))))
-        (if (not (null? circular))
-          (display (string-append "Warning: Circular refs (from <<"
-                                  key
-                                  ">>):\n  ["
-                                  (string-join (map (cut string-append "\"" <> "\"") circular) ", ")
-                                  "]\n")))
-        (and old (null? circular))))
-    #t))
-
-(define (backref-exists? backref lst)
-  (member backref lst (lambda (x elem)
-                        (and (string=? (backref-name x) (backref-name elem))
-                             (= (backref-sequence x) (backref-sequence elem))))))
-
-(define (add-backrefs! doc)
-  (for-each (lambda (x)
-              (if (src-chunk? x)
-                (for-each (lambda (ref)
-                            (for-each (lambda (def)
-                                        (let ((backref (make <backref>)))
-                                          (set! (backref-name backref) (src-chunk-name x))
-                                          (set! (backref-sequence backref) (src-chunk-sequence x))
-                                          (if (not (backref-exists? backref (src-chunk-backrefs def)))
-                                            (set! (src-chunk-backrefs def) (cons backref (src-chunk-backrefs def))))))
-                                      (hash-table-ref/default (doc-unit-map doc) ref (list))))
-                          (src-chunk-refs x))))
-            (doc-elements doc)))
-
-;; Add a line to the body of a documentation chunk. That means just adding it
-;; to the list that's already there.
-(define-method (add-line! (chunk <doc-chunk>) line)
-  (set! (doc-chunk-body chunk)
-    (cons line (doc-chunk-body chunk))))
-
-;; Add a line to the body of a source chunk. We have to check and see if it
-;; contains a reference to another unit or not, and if it does, make sure to
-;; handle that appropriately.
-(define-method (add-line! (chunk <src-chunk>) line)
-  (cond ((string-match "^(.*)<<(.+)>>(.*)$" line)
-         => (lambda (m)
-              (let ((name (match:substring m 2)))
-                (let ((ref (make <unit-ref>)))
-                  (set! (unit-ref-name ref) name)
-                  (set! (unit-ref-pre ref) (match:substring m 1))
-                  (set! (unit-ref-post ref) (string-append (match:substring m 3) "\n"))
-                  (set! (src-chunk-body chunk) (cons ref (src-chunk-body chunk)))
-                  (if (not (member name (src-chunk-refs chunk)))
-                    (set! (src-chunk-refs chunk) (cons name (src-chunk-refs chunk))))))))
-        (else
-          (set! (src-chunk-body chunk)
-            (cons (string-append line "\n") (src-chunk-body chunk))))))
-
-(define (parse input)
-  (let ((doc (make <doc>))
-        (chunk #f)
-        (last-chunk-name #f))
-
-    (letrec ((commit!
-               (lambda ()
-                 (if (not (eq? chunk #f))
-                   (begin
-                     ;; Remember, we cons when we add-line! so we need to reverse it sometime.
-                     (reverse-body! chunk)
-                     (set! (doc-elements doc)
-                       (cons chunk (doc-elements doc))))))))
-
-      (let loop ((line (read-line input))
-                 (state 'doc))
-        (if (eof-object? line)
-          (commit!)
-          (cond ((string-match "^@$" line)
-                 (commit!)
-                 (set! chunk (make <doc-chunk>))
-                 (set! (doc-chunk-thread-list chunk) (list "*"))
-                 (loop (read-line input) 'doc))
-
-                ;; A document chunk that has threads defined.
-                ((string-match "^@\\|(.*)\\|$" line)
-                 => (lambda (m)
-                      (commit!)
-                      (let ((threads (string-split (match:substring m 1) #\|)))
-                        (set! chunk (make <doc-chunk>))
-                        (set! (doc-chunk-thread-list chunk) threads))
-                      (loop (read-line input) 'doc)))
-
-                ;; A source chunk definition.
-                ((string-match "^<<(.+)>>=$" line)
-                 => (lambda (m)
-                      (commit!)
-                      (let ((name (match:substring m 1)))
-                        (if (string=? name "...")
-                          (if (eq? last-chunk-name #f)
-                            (error "Tried to use \"...\" chunk name with no preceding chunk")
-                            (set! name last-chunk-name)))
-                        (set! last-chunk-name name)
-                        (set! chunk (make <src-chunk>))
-                        (set! (src-chunk-name chunk) name)
-                        (set! (src-chunk-sequence chunk)
-                          (length (hash-table-ref/default (doc-unit-map doc) name (list))))
-                        ;; Stick this chunk onto the list of chunks keyed by name.
-                        (hash-table-update!/default (doc-unit-map doc) name (cut cons chunk <>) (list)))
-                      (loop (read-line input) 'src)))
-
-                ;; Otherwise just add to whatever chunk we're in.
-                (else
-                  (add-line! chunk line)
-                  (loop (read-line input) state))))))
-
-    (add-backrefs! doc)
-    (set! (doc-elements doc) (reverse (doc-elements doc)))
-    doc))
-
-(define (parse-file path)
-  (call-with-input-file path parse))
-
-(define-method (units/all (doc <doc>))
-  (hash-table-keys (doc-unit-map doc)))

lua/Makefile

-tensile:	tensile.tnsl
-	tensile -indented-refs -tangle-to tensile -unit tensile tensile.tnsl
-	chmod +x tensile

lua/tensile.tnsl

-@
-%% BEGIN ZONE: LUA
-<<tensile>>=
-#!/usr/bin/env lua
-
-<<Gather CVS Information>>
-<<Generate Intermediate Representation>>
-<<Write Intermediate Representation>>
-<<Read Intermediate Representation>>
-<<Tangle --- Create Source>>
-<<Weave --- Create Documentation>>
-<<Find Toplevel Units>>
-<<Program Initialization>>
-<<Option Processing>>
-@
-
-<<Gather CVS Information>>=
-version = {}
-do
-    local rev = "$Revision$"
-    version.revision = rev:gsub("%$[^:]+: ", ""):sub(1, -3)
-    local date = "$Date$"
-    version.date = date:gsub("%$[^:]+: ", ""):sub(1, -3)
-end
-@
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\section{Generating Intermediate Representation}
-Our first function generates the Lua table to represent the literate code.
-
-\subsection{Noweb Compatibility}
-
-Tensile aims to provide a mode which is compatible with Noweb 2.11b, that which inspired Tensile.
-There are several differences between what Noweb accepts and what Tensile provides in its default
-strict mode:
-
-\begin{itemize}
-    \item Noweb allows you to embed code references in the middle of lines which then expand inline.
-Tensile forces code references to be on their own line.  The former is more flexible, unless you're
-using C++ or doing a lot of bit shifting, in which case it may be better to have that restriction.
-
-    \item Noweb treats an at-sign in column zero as a documentation block marker, whereas Tensile
-requires it to be the only thing on the line.  There isn't really much pro or con to this, unless
-you want to use perhaps a row of at-signs as a visual indicator in the file.
-\end{itemize}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% BEGIN ZONE: LUA
-
-<<Generate Intermediate Representation>>=
-function generateIR(file)
-    local state = "doc"
-    local code = nil
-    local doc = nil
-    local ir = {src = {}, doc = {}, ref = {}}
-    local unit = {}
-    local unitName = ""
-    local threads = nil
-    <<Create Unit IR Object>>
-    <<Create Documentation IR Object>>
-    <<Flush Documentation to IR Structure>>
-    <<Flush Code to IR Structure>>
-@
-
-%% BEGIN ZONE: TEX
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-This helper function shall be called when we encounter a new program unit definition in the code.
-If the name is not ``\ldots'' then we are either reusing an old unit with the same name (in which
-case we should find it) or we are creating a new unit (in which case we should create it).  If there
-have already been code entries given for that unit, we will insert a break marker before the
-location where this new code will be entered.  This allows the \TeX\ output system to distinguish
-between the first part of a module definition and any subsequent parts.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% BEGIN ZONE: LUA
-
-<<Create Unit IR Object>>=
-local function defineUnit(name)
-    if name ~= "..." then
-        unitName = name
-        ir.src[unitName] = ir.src[unitName] or {}
-        unit = ir.src[unitName]
-    end
-    if #unit ~= 0 then
-        unit[#unit + 1] = { type = "break" }
-    end
-end
-@
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-A bit of a misnomer, this function creates an entry into the documentation part of the intermediate
-representation that a code definition was given.  This is called when we first encounter the
-beginning of a definition.  First we set the properties that all code definitions will have, viz.
-the type (being ``def'') and the name of the unit.  If the unit was already partially defined and
-the last item in the definition was a break entry, we indicate in the documentation that it should
-start listing code at the line that we are about to read, which will become the next entry in the
-source list of the unit.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-<<Create Documentation IR Object>>=
-local function createDoc(name)
-    ir.doc[#ir.doc + 1] = { type = "def", name = unitName }
-    if #unit > 0 and unit[#unit].type == "break" then
-        ir.doc[#ir.doc].start = #unit + 1
-    end
-end
-@
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-When we transition from one state to another, we'll need to flush to the table the documentation or
-code fragment that we've been reading.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-<<Flush Documentation to IR Structure>>=
-local function flushDoc()
-    if doc then
-        ir.doc[#ir.doc + 1] = { type = "text", text = doc }
-        if threads and #threads > 0 then
-            ir.doc[#ir.doc].threads = threads
-        end
-        doc = nil
-    end
-end
-<<Flush Code to IR Structure>>=
-local function flushCode()
-    if code then unit[#unit + 1] = { type = "code", text = code } ; code = nil end
-end
-@
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\subsection{Parsing the Input File}
-
-To begin the actual work, we need only iterate through all the lines in the input file.  Tensile
-works on a single pass to produce an intermediate representation, which is then used for both
-tangling and weaving; this allows fairly easy extension by manipulation of this intermediate
-representation.  Note that we do nothing \TeX-specific in the reading phase, and thus any kind of
-documentation markup that the user may desire can be used.  (Although of course, \TeX\ is the best!)
-
-There are two parser states, ``doc'' which indicates that the parser is reading documentation, and
-``code'' which indicates that we are processing a code unit definition.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% BEGIN ZONE: LUA
-
-<<Generate Intermediate Representation>>=
-    for line in io.lines(file) do
-        if state == "doc" then
-            <<Process Line in Documentation Mode>>
-        elseif state == "code" then
-            <<Process Line in Source Mode>>
-        end
-    end
-    flushCode()
-    flushDoc()
-    return ir
-end
-@
-
-%% BEGIN ZONE: TEX
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\subsubsection{Reading: Documentation Mode}
-
-If we've found a definition in the middle of a documentation block, then store any documentation
-we've accumulated into the table.  This may potentially be nothing at all if the at-sign were
-followed immediately by a unit definition.  Then we create a new unit for the name (or reuse an
-existing one), and add the reference to this definition chunk to the documentation object.  Finally
-we transition to the code-reading state.
-
-However, if we haven't found a definition then we simply add the line to the documentation block.
-If the line consists of merely an at-sign (in other words, the start of another documentation block
-immediately following a documentation block) then we skip it.
-
-{\bf Note:} my little trickery here of using percent signs in the pattern is simply a way to be able
-to run this program in {\sf Noweb}-compatibility mode without having {\sf Tensile} think that these
-are references to a program unit with the name {\tt .*} --- we shall see this tactic several times
-throughout this source, and I hope one day to exorcise it by providing a {\sf Noweb}-like workaround
-for explicitly identifying non-referencing {\tt <{}<} characters.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% BEGIN ZONE: LUA
-
-<<Process Line in Documentation Mode>>=
-local name, kind = line:match("^%<%<(.*)%>%>([=*])$")
-if name then
-    flushDoc()
-    if kind == "*" then
-        ir.doc[#ir.doc + 1] = { type = "def*", name = name }
-    elseif kind == "=" then
-        defineUnit(name)
-        createDoc(name)
-        state = "code"
-    else
-        error("Internal error: unknown kind " .. kind)
-    end
-elseif line == "@" or line:match("^@|.+|$") or
-        (g_opts["noweb-compat"] and line:match("^@"))then
-    flushDoc()
-    threads = line:match("^@|.+|")
-    if threads then
-        local threadList = {}
-        for t in threads:gmatch("|[^|]+") do
-            threadList[#threadList + 1] = t:sub(2)
-        end
-        threads = threadList
-    end
-else
-    doc = (doc and doc .. "\n" or "") .. line
-end
-@
-
-%% BEGIN ZONE: TEX
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\subsubsection{Reading: Source Mode}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% BEGIN ZONE: LUA
-
-<<Process Line in Source Mode>>=
-if line == "@" or line:match("^@|.+|$") or
-        (g_opts["noweb-compat"] and line:match("^@")) then
-    flushCode()
-    threads = line:match("^@|.+|$")
-    if threads then
-        local threadList = {}
-        for t in threads:gmatch("|[^|]+") do
-            threadList[#threadList + 1] = t:sub(2)
-        end
-        threads = threadList
-    end
-    state = "doc"
-else
-    local name = line:match("^%<%<(.*)%>%>=$") or
-        (g_opts["noweb-compat"] and line:match("^%s*%<%<(.*)%>%>=%s*$"))
-@
-
-%% BEGIN ZONE: TEX
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-When we've found a definition while processing a definition, it's time to dump the existing code
-that we've been spooling up into the table, and create a new unit.  We also add its place to the
-documentation part of the table.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% BEGIN ZONE: LUA
-
-<<...>>=
-    if name then
-        flushCode()
-        defineUnit(name)
-        createDoc(name)
-    else
-        local pre = nil
-        local post = nil
-        local ref = nil
-        if g_opts["noweb-compat"] or g_opts["indented-refs"] then
-            pre, ref, post = line:match("^(.*)%<%<(.*)%>%>(.*)$")
-        else
-            ref = line:match("^%<%<(.*)%>%>$")
-        end
-@
-
-
-%% BEGIN ZONE: TEX
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-We can also find a reference to another bit of code.  If we do, we must first flush the code we've
-read up until this point to the table.  We then create a new entry for this unit list, with the type
-``ref'' and pointing to the name of the reference.
-
-In order to track forward and back references, we use a different part of the intermediate
-representation.  Each unit has a list of links in both directions.  For both the reference and the
-parent (which is the current unit name) we ensure that the reference link entries are present in the
-intermediate representation.  Then we add a forward link from the parent to the child, and a
-backwards link from the child to the parent.  Now we can insert cross-references in the output
-document showing where each unit is defined and used.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% BEGIN ZONE: LUA
-
-<<...>>=
-        if ref then
-            if pre and pre:len() > 0 then
-                code = (code or "") .. pre
-            end
-            flushCode()
-            unit[#unit + 1] = { type = "ref", name = ref }
-
-            if pre then
-                unit[#unit].indent = pre:len()
-            end
-            if post and post:len() > 0 then
-                unit[#unit].followed = true
-            end
-
-            local r1 = ir.ref[unitName]
-            r1 = r1 or { fwd = {}, back = {} }
-            r1.fwd[#r1.fwd + 1] = ref
-            ir.ref[unitName] = r1
-
-            local r2 = ir.ref[ref]
-            r2 = r2 or { fwd = {}, back = {} }
-            r2.back[#r2.back + 1] = unitName
-            ir.ref[ref] = r2
-            if post and post:len() > 0 then
-                code = post .. "\n"
-            end
-        else
-@
-%% BEGIN ZONE: TEX
-Otherwise this is just another line of code, and we add it to the list of entries in the unit's definition.
-%% BEGIN ZONE: LUA
-<<...>>=
-            code = (code or "") .. line .. "\n"
-        end
-    end
-end
-@
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-<<Write Intermediate Representation>>=
-function writeIR(ir, file)
-    local stream = io.open(file, "w")
-    stream:write("return {\n")
-    stream:write("  src = {\n")
-    <<Write Source Code Intermediate Representation>>
-    stream:write("  },\n")
-    stream:write("  doc = {\n")
-    <<Write Documentation Intermediate Representation>>
-    stream:write("  },\n")
-    stream:write("  ref = {\n")
-    <<Write Reference Intermediate Representation>>
-    stream:write("  }\n")
-    stream:write("}\n")
-    stream:close()
-end
-<<Write Source Code Intermediate Representation>>=
-    for k,v in pairs(ir.src) do
-        stream:write("    [" .. string.format("%q", k) .. "] = {\n")
-        for i,v2 in ipairs(v) do
-            stream:write("      {\n")
-            for k3,v3 in pairs(v2) do
-                stream:write("        [\"" .. k3 .. "\"] = ")
-                if type(v3) == "boolean" then
-                    stream:write(v3 and "true" or "false")
-                else
-                    stream:write(string.format("%q", v3))
-                end
-                stream:write(",\n")
-            end
-            stream:write("      },\n")
-        end
-        stream:write("    },\n")
-    end
-<<Write Documentation Intermediate Representation>>=
-    for i,v in ipairs(ir.doc) do
-        stream:write("    {\n")
-        for k2,v2 in pairs(v) do
-            stream:write("      [" .. string.format("%q", k2) .. "] = ")
-            if type(v2) == "table" then
-                stream:write("{")
-                for i3,v3 in ipairs(v2) do
-                    stream:write(string.format("%q", v3))
-                    if i3 < #v2 then stream:write(",") end
-                end
-                stream:write("}")
-            else
-                stream:write(string.format("%q", v2))
-            end
-            stream:write(",\n")
-        end
-        stream:write("    },\n")
-    end
-<<Write Reference Intermediate Representation>>=
-    for k,v in pairs(ir.ref) do
-        stream:write("    [" .. string.format("%q", k) .. "] = {\n")
-        stream:write("      fwd = {")
-        for i2,v2 in ipairs(ir.ref[k].fwd) do
-            stream:write(string.format("%q", v2) .. ", ")
-        end
-        stream:write("},\n")
-        stream:write("      back = {")
-        for i2,v2 in ipairs(ir.ref[k].back) do
-            stream:write(string.format("%q", v2) .. ", ")
-        end
-        stream:write("}\n")
-        stream:write("    },\n")
-    end
-<<Read Intermediate Representation>>=
-function readIR(file)
-    return dofile(file)
-end
-@
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\section{Tangling Source Code}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% BEGIN ZONE: LUA
-
-<<Tangle --- Create Source>>=
-function generateCode(ir, unit, output)
-    if not ir.src[unit] then
-        error("no such unit: " .. unit)
-    end
-    output = output or unit
-
-    pcall(os.rename, output, output .. ".bak")
-
-    stream, err = io.open(output, "w")
-
-    if not stream then
-        io.stderr:write("! Unable to open output file `" .. output .. "' for tangled code from unit `" .. unit .. "'.\n")
-        io.stderr:write("! " .. err .. ".  Emergency stop.\n")
-        os.exit(1)
-    end
-
-    local x, y = pcall(GenerateCode, ir, unit, stream, 0)
-    if not x then
-        pcall(os.rename, output .. ".bak", output)
-        io.stderr:write(y .. "\n")
-        os.exit(1)
-    end
-    stream:write("\n")
-    stream:close()
-    os.remove(output .. ".bak")
-end
-
-function GenerateCode(ir, unit, stream, indent)
-    --print("Indenting " .. unit .. " at " .. indent .. " spaces.")
-    if not ir.src[unit] then
-        error("Program module '" .. unit .. "' was not defined.")
-    end
-    for i,v in ipairs(ir.src[unit]) do
-        if v.type == "code" then
-            local s = v.text
-            -- Insert indentation at every newline.
-            -- Strip off the last indentation (since the code
-            -- invariably ends with a newline).
-            if indent > 0 then
-                local strip = false
-                if s:sub(s:len()) == "\n" then
-                    strip = true
-                end
-                s = s:gsub("\n", "\n" .. string.rep(" ", indent))
-                if strip then
-                    s = s:sub(1, s:len() - indent)
-                end
-            end
-            -- Trim off the newline of the last entry.
-            -- Let the referring unit decide if it wants to put something
-            -- after it (v.type == ref && v.followed) or not.
-            if i == #ir.src[unit] then
-                s = s:sub(0, s:len() - 1)
-            end
-            stream:write(s)
-        elseif v.type == "ref" then
-            <<Write Referenced Code>>
-        end
-    end
-end
-@
-
-We have encountered a reference to another piece of code.  The first thing we need to do is to
-indent the current line according to the current indentation level.  This is necessary to properly
-propagate the indentation level to the first line of the referenced code.  Without it, we get a
-problem:
-
-\begin{Verbatim}[frame=single,commandchars=\\\{\}]
-<{}<alpha>>=
-  <{}<beta>>