Adding documentation.

lib/chibi/ast.scm

@@ -1,12 +1,22 @@
 ;; ast.scm -- ast utilities
-;; Copyright (c) 2010 Alex Shinn.  All rights reserved.
+;; Copyright (c) 2010-2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
-(define (macroexpand x)
+;;> Abstract Syntax Tree.  Interface to the types used by
-  (ast->sexp (analyze x)))
+;;> the compiler, and other core types less commonly
+;;> needed in user code, plus related utilities.
 
-(define (procedure-name x)
+;;> @subsubsection{Analysis and Expansion}
-  (bytecode-name (procedure-code x)))
+
+;;> @subsubsubsection{@scheme{(analyze x [env])}}
+
+;;> Expands and analyzes the expression @var{x} and returns the
+;;> resulting AST.
+
+;;> @subsubsubsection{@scheme{(optimize ast)}}
+
+;;> Runs an optimization pass on @var{ast} and returns the
+;;> resulting simplified expression.
 
 (define (ast-renames ast)
   (define i 0)
@@ -67,6 +77,15 @@
         ((null? ls) '())
         (else (f ls))))
 
+;;> Performs a full syntax expansion of the form @var{x} and
+;;> returns the resulting s-expression.
+
+(define (macroexpand x)
+  (ast->sexp (analyze x)))
+
+;;> Convert @var{ast} to a s-expression, renaming variables if
+;;> necessary.
+
 (define (ast->sexp ast)
   (let ((renames (ast-renames ast)))
     (let a2s ((x ast))
@@ -89,8 +108,244 @@
        ((opcode? x) (or (opcode-name x) x))
        (else x)))))
 
-(define (type-parent x)
+;;> @subsubsection{Types}
-  (let ((v (type-cpl x)))
+
+;;> All objects have an associated type, and types may have parent
+;;> types.  When using SRFI-9 @scheme{define-record-type}, the
+;;> name is bound to a first class type object.
+
+;;> The following core types are also available by name, and may be
+;;> used in the @scheme{match} @scheme{($ ...)} syntax.
+
+;;> @itemlist[
+;;> @item{@scheme{<object>} - the parent of all types}
+;;> @item{@scheme{<number>} - abstract numeric type}
+;;> @item{@scheme{<bignum>} - arbitrary precision exact integers}
+;;> @item{@scheme{<flonum>} - inexact real numbers}
+;;> @item{@scheme{<integer>} - abstract integer type}
+;;> @item{@scheme{<symbol>} - symbols}
+;;> @item{@scheme{<char>} - character}
+;;> @item{@scheme{<boolean>} - @scheme{#t} or @scheme{#f}}
+;;> @item{@scheme{<string>} - strings of characters}
+;;> @item{@scheme{<byte-vector>} - uniform vector of octets}
+;;> @item{@scheme{<pair>} - a @var{car} and @var{cdr}, the basis for lists}
+;;> @item{@scheme{<vector>} - vectors}
+;;> @item{@scheme{<opcode>} - a primitive opcode or C function}
+;;> @item{@scheme{<procedure>} - a closure}
+;;> @item{@scheme{<bytecode>} - the compiled code for a closure}
+;;> @item{@scheme{<env>} - an environment structure}
+;;> @item{@scheme{<macro>} - a macro object, usually not first-class}
+;;> @item{@scheme{<lam>} - a lambda AST type}
+;;> @item{@scheme{<cnd>} - an conditional AST type (i.e. @scheme{if})}
+;;> @item{@scheme{<ref>} - a reference AST type}
+;;> @item{@scheme{<set>} - a mutation AST type (i.e. @scheme{set!})}
+;;> @item{@scheme{<seq>} - a sequence AST type}
+;;> @item{@scheme{<lit>} - a literal AST type}
+;;> @item{@scheme{<sc>} - a syntactic closure}
+;;> @item{@scheme{<context>} - a context object (including threads)}
+;;> @item{@scheme{<exception>} - an exception object}
+;;> ]
+
+;;> The following extended type predicates may also be used to test
+;;> individual objects for their type:
+
+;;> @itemlist[
+;;> @item{@scheme{environment?}}
+;;> @item{@scheme{bytecode?}}
+;;> @item{@scheme{macro?}}
+;;> @item{@scheme{syntactic-closure?}}
+;;> @item{@scheme{lambda?}}
+;;> @item{@scheme{cnd?}}
+;;> @item{@scheme{ref?}}
+;;> @item{@scheme{set?}}
+;;> @item{@scheme{seq?}}
+;;> @item{@scheme{lit?}}
+;;> @item{@scheme{opcode?}}
+;;> @item{@scheme{type?}}
+;;> @item{@scheme{context?}}
+;;> @item{@scheme{exception?}}
+;;> ]
+
+;;> @subsubsubsection{@scheme{(type-of x)}}
+
+;;> Returns the type of any object @var{x}.
+
+;;> @subsubsubsection{@scheme{(type-name type)}}
+
+;;> Returns the name of type @var{type}.
+
+;;> @subsubsubsection{@scheme{(type-parent type)}}
+
+;;> Returns the immediate parent of type @var{type},
+;;> or @scheme{#f} for a type with no parent.
+
+(define (type-parent type)
+  (let ((v (type-cpl type)))
     (and (vector? v)
          (> (vector-length v) 1)
          (vector-ref v (- (vector-length v) 2)))))
+
+;;> @subsubsubsection{@scheme{(type-cpl type)}}
+
+;;> Returns the class precedence list of type @var{type} as a
+;;> vector, or @scheme{#f} for a type with no parent.
+
+;;> @subsubsubsection{@scheme{(type-slots type)}}
+
+;;> Returns the slot list of type @var{type}.
+
+;;> @subsubsection{Accessors}
+
+;;> This section describes additional accessors on AST and other core
+;;> types.
+
+;;> @subsubsubsection{Procedures}
+
+;;> @itemlist[
+;;> @item{@scheme{(procedure-code f)} - the compiled bytecode object}
+;;> @item{@scheme{(procedure-vars f)} - the variables closed over by @var{f}}
+;;> @item{@scheme{(procedure-name f)} - the name of @var{f} if known, else @scheme{#f}}
+;;> ]
+
+(define (procedure-name x)
+  (bytecode-name (procedure-code x)))
+
+;;> @subsubsubsection{Macros}
+
+;;> @itemlist[
+;;> @item{@scheme{(macro-procedure f)} - the macro procedure}
+;;> @item{@scheme{(macro-env f)} - the environment the macro was defined in}
+;;> @item{@scheme{(macro-source f)} - the source location the macro was defined in}
+;;> ]
+
+;;> @subsubsubsection{Bytecode Objects}
+
+;;> @itemlist[
+;;> @item{@scheme{(bytecode-name bc)} - the macro procedure}
+;;> @item{@scheme{(bytecode-literals bc)} - literals the bytecode references}
+;;> @item{@scheme{(bytecode-source bc)} - the source location the procedure was defined in}
+;;> ]
+
+;;> @subsubsubsection{Syntactic Closures}
+
+;;> @itemlist[
+;;> @item{@scheme{(syntactic-closure-env sc)}}
+;;> @item{@scheme{(syntactic-closure-vars sc)}}
+;;> @item{@scheme{(syntactic-closure-expr sc)}}
+;;> ]
+
+;;> Return the environment, free variables, and expression
+;;> associated with @var{sc} respectively.
+
+;;> @subsubsubsection{Exceptions}
+
+;;> @itemlist[
+;;> @item{@scheme{(exception-kind exn)}}
+;;> @item{@scheme{(exception-message exn)}}
+;;> @item{@scheme{(exception-irritants exn)}}
+;;> ]
+
+;;> Return the kind, message, and irritants
+;;> associated with @var{exn} respectively.
+
+;;> @subsubsubsection{Lambdas}
+
+;;> @itemlist[
+;;> @item{@scheme{(lambda-name lam)} - the name of the lambda, if known}
+;;> @item{@scheme{(lambda-name-set! lam x)}}
+;;> @item{@scheme{(lambda-params lam)} - the lambda parameter list}
+;;> @item{@scheme{(lambda-params-set! lam x)}}
+;;> @item{@scheme{(lambda-body lam)} - the body of the lambda}
+;;> @item{@scheme{(lambda-body-set! lam x)}}
+;;> @item{@scheme{(lambda-defs lam)} - internal definitions of the lambda}
+;;> @item{@scheme{(lambda-defs-set! lam x)}}
+;;> @item{@scheme{(lambda-locals lam)} - local variables as a list of identifiers}
+;;> @item{@scheme{(lambda-locals-set! lam x)}}
+;;> @item{@scheme{(lambda-flags lam)} - various flags describing the lambda}
+;;> @item{@scheme{(lambda-flags-set! lam x)}}
+;;> @item{@scheme{(lambda-free-vars lam)} - free variables the lambda will need to close over}
+;;> @item{@scheme{(lambda-free-vars-set! lam x)}}
+;;> @item{@scheme{(lambda-set-vars lam)} - variables the lambda mutates}
+;;> @item{@scheme{(lambda-set-vars-set! lam x)}}
+;;> @item{@scheme{(lambda-return-type lam)} - the return type of the lambda}
+;;> @item{@scheme{(lambda-return-type-set! lam x)}}
+;;> @item{@scheme{(lambda-param-types lam)} - the types of the input parameters}
+;;> @item{@scheme{(lambda-param-types-set! lam x)}}
+;;> @item{@scheme{(lambda-source lam)} - the source code of the lambda}
+;;> @item{@scheme{(lambda-source-set! lam x)}}
+;;> ]
+
+;;> @subsubsubsection{Conditionals}
+
+;;> @itemlist[
+;;> @item{@scheme{(cnd-test cnd)} - the test for the conditional}
+;;> @item{@scheme{(cnd-test-set! cnd x)}}
+;;> @item{@scheme{(cnd-pass cnd)} - the success branch}
+;;> @item{@scheme{(cnd-pass-set! cnd x)}}
+;;> @item{@scheme{(cnd-fail cnd)} - the failure branch}
+;;> @item{@scheme{(cnd-fail-set! cnd x)}}
+;;> ]
+
+;;> @subsubsubsection{Sequences}
+
+;;> @itemlist[
+;;> @item{@scheme{(seq-ls seq)} - the list of sequence expressions}
+;;> @item{@scheme{(seq-ls-set! seq x)}}
+;;> ]
+
+;;> @subsubsubsection{References}
+
+;;> @itemlist[
+;;> @item{@scheme{(ref-name ref)} - the name of the referenced variable}
+;;> @item{@scheme{(ref-name-set! ref x)}}
+;;> @item{@scheme{(ref-cell ref)} - the environment cell the reference resolves to}
+;;> @item{@scheme{(ref-cell-set! ref x)}}
+;;> ]
+
+;;> @subsubsubsection{Mutations}
+
+;;> @itemlist[
+;;> @item{@scheme{(set-var set)} - a reference to the mutated variable}
+;;> @item{@scheme{(set-var-set! set x)}}
+;;> @item{@scheme{(set-value set)} - the value to set the variable to}
+;;> @item{@scheme{(set-value-set! set x)}}
+;;> ]
+
+;;> @subsubsubsection{Literals}
+
+;;> @itemlist[
+;;> @item{@scheme{(lit-value lit)} - the literal value}
+;;> @item{@scheme{(lit-value-set! lit x)}}
+;;> ]
+
+;;> @subsubsubsection{Pairs}
+
+;;> @itemlist[
+;;> @item{@scheme{(pair-source x)}}
+;;> @item{@scheme{(pair-source-set! x source)}}
+;;> ]
+
+;;> Set or return the source code info associated with a pair x.
+;;> Source info is represented as another pair whose @var{car} is
+;;> the source file name and whose @var{cdr} is the line number.
+
+;;> @subsubsection{Miscellaneous Utilities}
+
+;;> @subsubsubsection{@scheme{(gc)}}
+
+;;> Force a garbage collection.
+
+;;> @subsubsubsection{@scheme{(object-size x)}}
+
+;;> Returns the heap space directly used by @var{x}, not
+;;> counting any elements of @var{x}.
+
+;;> @subsubsubsection{@scheme{(integer->immediate n)}}
+
+;;> Returns the interpretation of the integer @var{n} as
+;;> an immediate object, useful for debugging.
+
+;;> @subsubsubsection{@scheme{(string-contains str pat)}}
+
+;;> Returns the first string cursor of @var{pat} in @var{str},
+;;> of @scheme{#f} if it's not found.

lib/chibi/disasm.module

@@ -1,4 +1,9 @@
 
+;;> @subsubsubsection{(disasm f [out])}
+
+;;> Write a human-readable disassembly for the procedure @var{f} to
+;;> the port @var{out}, defaulting to @scheme{(current-output-port)}.
+
 (module (chibi disasm)
   (export disasm)
   (import-immutable (scheme))

lib/chibi/equiv.scm

@@ -1,4 +1,9 @@
 
+;;> Cycle-aware equality.  Returns @scheme{#t} iff @scheme{a} and
+;;> @scheme{b} are @scheme{equal?}, including cycles.  Another way
+;;> to think of it is they are @scheme{equiv} if they print the
+;;> same, assuming all elements can be printed.
+
 (define (equiv? a b)
   (let ((equivs (make-hash-table eq?)))
     (define (get-equivs x)

lib/chibi/filesystem.module

@@ -1,4 +1,9 @@
 
+;;> Interface to the filesystem and file descriptor objects.
+;;> Note that file descriptors are currently represented as
+;;> integers, but may be replaced with opaque (and gc-managed)
+;;> objects in a future release.
+
 (module (chibi filesystem)
   (export open-input-file-descriptor open-output-file-descriptor
           duplicate-file-descriptor duplicate-file-descriptor-to

lib/chibi/filesystem.scm

@@ -1,19 +1,28 @@
 ;; filesystem.scm -- additional filesystem utilities
-;; Copyright (c) 2009 Alex Shinn.  All rights reserved.
+;; Copyright (c) 2009-2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
+;;> The fundamental directory iterator.  Applies @var{kons} to
+;;> each filename in directory @var{dir} and the result of the
+;;> previous application, beginning with @var{knil}.  With
+;;> @var{kons} as @scheme{cons} and @var{knil} as @scheme{'()},
+;;> equivalent to @scheme{directory-files}.
+
 (define (directory-fold dir kons knil)
   (let ((dir (opendir dir)))
     (let lp ((res knil))
       (let ((file (readdir dir)))
         (if file (lp (kons (dirent-name file) res)) res)))))
 
+;;> Returns a list of the files in @var{dir} in an unspecified
+;;> order.
+
 (define (directory-files dir)
   (directory-fold dir cons '()))
 
-(define (renumber-file-descriptor old new)
+;;> Returns the @scheme{status} object for the given @var{file},
-  (and (duplicate-file-descriptor-to old new)
+;;> which should be a string indicating the path or a file
-       (close-file-descriptor old)))
+;;> descriptor.
 
 (define (file-status file)
   (if (string? file) (stat file) (fstat file)))
@@ -32,6 +41,10 @@
 (define (file-modification-time x) (stat-mtime (if (stat? x) x (file-status x))))
 (define (file-change-time x) (stat-ctime (if (stat? x) x (file-status x))))
 
+;;> File status accessors.  @var{x} should be a string indicating
+;;> the file to lookup the status for, or an existing status object.
+;;/
+
 (define (file-regular? x) (S_ISREG (file-mode x)))
 (define (file-directory? x) (S_ISDIR (file-mode x)))
 (define (file-character? x) (S_ISCHR (file-mode x)))
@@ -39,5 +52,17 @@
 (define (file-fifo? x) (S_ISFIFO (file-mode x)))
 (define (file-link? x) (S_ISLNK (file-mode x)))
 (define (file-socket? x) (S_ISSOCK (file-mode x)))
-
 (define (file-exists? x) (and (file-status x) #t))
+
+;;> File type tests.  @var{x} should be a string indicating the
+;;> file to lookup the status for, or an existing status object.
+;;> Returns @scheme{#t} if the file exists and the given type
+;;> is satisfied, and @scheme{#f} otherwise.
+;;/
+
+;;> Equivalent to duplicating the file descriptor @var{old} to
+;;> @var{new} and closing @var{old}.
+
+(define (renumber-file-descriptor old new)
+  (and (duplicate-file-descriptor-to old new)
+       (close-file-descriptor old)))

lib/chibi/filesystem.stub

@@ -1,3 +1,6 @@
+;; filesystem.stub -- filesystem bindings
+;; Copyright (c) 2009-2011 Alex Shinn.  All rights reserved.
+;; BSD-style license: http://synthcode.com/license.txt
 
 (c-system-include "sys/types.h")
 (c-system-include "unistd.h")
@@ -62,30 +65,79 @@
 (define-c errno fstat (int (result stat)))
 (define-c errno (file-link-status "lstat") (string (result stat)))
 
+;;> Creates a new input-port from the file descriptor @var{int}.
+
 (define-c input-port (open-input-file-descriptor "fdopen")
   (int (value "r" string)))
+
+;;> Creates a new output-port from the file descriptor @var{int}.
+
 (define-c output-port (open-output-file-descriptor "fdopen")
   (int (value "w" string)))
 
+;;> Unlinks the file named @var{string} from the filesystem.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (delete-file "unlink") (string))
+
+;;> Creates a hard link to the first arg from the second.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (link-file "link") (string string))
+
+;;> Creates a symbolic link to the first arg from the second.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (symbolic-link-file "symlink") (string string))
+
+;;> Renames the first arg to the second.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (rename-file "rename") (string string))
 
+;;> Returns the current working directory of the process as a string.
+
 (define-c non-null-string (current-directory "getcwd")
   ((result (array char (auto-expand arg1))) (value 256 int)))
 
+;;> Creates a new directory with the given mode.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (create-directory "mkdir") (string int))
+
+;;> Deletes the directory named @var{string} from the filesystem.
+;;> Does not attempt to delete recursively.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (delete-directory "rmdir") (string))
 
 (define-c (free DIR) opendir (string))
 (define-c dirent readdir ((link (pointer DIR))))
 
+;;> Duplicates the given file descriptor, returning he new value,
+;; or -1 on failure.
+
 (define-c int (duplicate-file-descriptor "dup") (int))
+
+;;> Copies the first file descriptor to the second, closing
+;;> it if needed.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (duplicate-file-descriptor-to "dup2") (int int))
+
+;;> Closes the given file descriptor.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (close-file-descriptor "close") (int))
 
+;;> Returns a list of 2 new file descriptors, the input and
+;;> output end of a new pipe, respectively.
+
 (define-c errno (open-pipe "pipe") ((result (array int 2))))
+
+;;> Creates a new named pipe in the given path.
+;;> Returns @scheme{#t} on success and @scheme{#f} on failure.
+
 (define-c errno (make-fifo "mkfifo") (string (default #o644 int)))
 
 (define-c int (get-file-descriptor-flags "fcntl")
@@ -93,11 +145,17 @@
 (define-c errno (set-file-descriptor-flags! "fcntl")
   (int (value F_SETFD int) long))
 
+;;> Get and set the flags for the given file descriptor.
+;;/
+
 (define-c int (get-file-descriptor-status "fcntl")
   (int (value F_GETFL int)))
 (define-c errno (set-file-descriptor-status! "fcntl")
   (int (value F_SETFL int) long))
 
+;;> Get and set the status for the given file descriptor.
+;;/
+
 ;; (define-c int (get-file-descriptor-lock "fcntl")
 ;;   (int (value F_GETLK int) flock))
 ;; (define-c errno (set-file-descriptor-lock! "fcntl")
@@ -114,5 +172,10 @@
 (define-c-const int (open/append "O_APPEND"))
 (define-c-const int (open/non-block "O_NONBLOCK"))
 
-(define-c boolean (is-a-tty? "isatty") (port-or-fd))
+;;> File opening modes.
+;;/
 
+;;> Returns @scheme{#t} if the given port of file descriptor
+;;> if backed by a TTY object, and @scheme{#f} otherwise.
+
+(define-c boolean (is-a-tty? "isatty") (port-or-fd))

lib/chibi/generic.module

@@ -1,4 +1,6 @@
 
+;;> Simple generic function interface.
+
 (module (chibi generic)
   (export define-generic define-method make-generic generic-add!)
   (import-immutable (scheme))

lib/chibi/generic.scm

@@ -1,9 +1,12 @@
 
+;;> Define a new generic function named @var{name}.
+
 (define-syntax define-generic
   (syntax-rules ()
     ((define-generic name)
      (define name (make-generic 'name)))))
 
+;; call-next-method needs to be unhygienic
 '(define-syntax define-method
   (syntax-rules ()
     ((define-method (name (param type) ...) . body)
@@ -13,6 +16,11 @@
                      (let-syntax ((call))
                        . body))))))
 
+;;> @subsubsubsection{(define-method (name (param type) ...) body ...)}
+
+;;> Extends the generic function @var{name} with a new method that
+;;> applies when the given param types all match.
+
 (define-syntax define-method
   (er-macro-transformer
    (lambda (e r c)
@@ -38,6 +46,8 @@
 
 (define add-method-tag (list 'add-method-tag))
 
+;;> Create a new first-class generic function named @var{name}.
+
 (define (make-generic name)
   (let ((name name)
         (methods (make-vector 6 '())))
@@ -75,5 +85,9 @@
       (vector-set! res plen (cons (cons preds f) (vector-ref res plen)))
       res)))
 
+;;> Extend the generic @var{g} with a new method @var{f}
+;;> that applies when all parameters match the given list
+;;> of predicates @var{preds}.
+
 (define (generic-add! g preds f)
   (g add-method-tag preds f))

lib/chibi/heap-stats.module

@@ -1,4 +1,23 @@
 
+;;> Utilities for gathering statistics on the heap.  Just measuring
+;;> runtime memory usage doesn't give a good idea of how to optimize
+;;> that usage, so this module is provided for profiling.
+
+;;> @subsubsubsection{(heap-stats)}
+
+;;> Returns an alist summarizing all heap allocated objects.  The
+;;> @var{car} of each cell is the type-name, and the @var{cdr} is the
+;;> count of objects of that type in the heap.  Garbage is collected
+;;> before the counts are taken.
+
+;;> @subsubsubsection{(heap-dump [depth])}
+
+;;> Returns the same value as @scheme{(heap-stats)}, but also prints
+;;> all objects on the heap as it runs.  @var{depth} indicates the
+;;> printing depth for compound objects and defaults to 1.
+
+;;> These functions just return @scheme{'()} when using the Boehm GC.
+
 (module (chibi heap-stats)
   (export heap-stats heap-dump)
   (import-immutable (scheme))

lib/chibi/highlight.scm

@@ -2,6 +2,9 @@
 ;; Copyright (c) 2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
+;;> Library for highlighting source code in different
+;;> languages.  Currently supports Scheme, C and Assembly.
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (string-concatenate-reverse ls)
@@ -10,6 +13,18 @@
 (define (reverse-list->string ls)
   (list->string (reverse ls)))
 
+;;> Returns an sxml structure representing the code from source
+;;> with various language constructs wrapped in highlighting
+;;> forms.  @var{source} should be a string or port.  The
+;;> language to highlight for is auto-detected.
+
+(define (highlight source)
+  (let ((str (if (string? source) source (port->string source))))
+    ((highlighter-for (highlight-detect-language str)) str)))
+
+;;> Attempst to auto-detect which language @var{str} is code
+;;> for, and returns a symbol representing that language.
+
 (define (highlight-detect-language str)
   (cond
    ((guard (exn (else #f))
@@ -20,6 +35,8 @@
    (else
     'c)))
 
+;;> Return a procedure for highlighting the given language.
+
 (define (highlighter-for language)
   (case language
     ((scheme) highlight-scheme)
@@ -27,10 +44,6 @@
     ((none) (lambda (x) x))
     (else highlight-c)))
 
-(define (highlight source)
-  (let ((str (if (string? source) source (port->string source))))
-    ((highlighter-for (highlight-detect-language str)) str)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define highlight-themes
@@ -54,6 +67,11 @@
   ;;'("#BAFFFF" "#FFCACA" "#FFFFBA" "#CACAFF" "#CAFFCA" "FFBAFF")
   '("#AAAAAA" "#888888" "#666666" "#444444" "#222222" "#000000"))
 
+;;> Returns a string representing the CSS needed for the output
+;;> of @var{highlight}.  This should be included in a referenced
+;;> CSS file, or in a @var{<script>} section in the generated in
+;;> the generated HTML output.
+
 (define (highlight-style . theme)
   (string-concatenate
    (append
@@ -151,6 +169,8 @@
              summing multpliying up-from down-from else
              )))
 
+;;> Highlighter for Scheme source code.
+
 (define (highlight-scheme source)
   (let ((in (if (string? source) (open-input-string source) source)))
     (define (read-identifier ls)
@@ -170,7 +190,7 @@
            (highlight-class "string"
                             (read-identifier (list (read-char in) #\\ #\#))))
           (else
-           "#"))))
+           (string-append "#" (if (char? c) (string c) ""))))))
     (define (highlight n str res)
       (let ((c (read-char in)))
         (if (eof-object? c)
@@ -261,6 +281,8 @@
              short signed static struct union unsigned void volatile wchar_t
              sexp sexp_uint_t sexp_sint_t)))
 
+;;> Highlighter for C source code.
+
 (define (highlight-c source)
   (let ((in (if (string? source) (open-input-string source) source)))
     (define (char-c-initial? c)
@@ -369,6 +391,8 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;> Highlighter for Assembly source code.
+
 (define (highlight-assembly source)
   (let ((in (if (string? source) (open-input-string source) source)))
     (define (char-asm-initial? c)

lib/chibi/io/io.scm

@@ -24,11 +24,21 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; reading and writing
 
+;; Display @var{str} to the given output port, defaulting to
+;; @scheme{(current-output-port)}, followed by a newline.
+
 (define (write-line str . o)
   (let ((out (if (pair? o) (car o) (current-output-port))))
     (display str out)
     (newline out)))
 
+;;> @subsubsubsection{(read-line [in [n]])}
+
+;;> Read a line from the input port @var{in}, defaulting to
+;;> @scheme{(current-input-port)}, and return the result as
+;;> a string not including the newline.  Reads at most @var{n}
+;;> characters, defaulting to 8192.
+
 (define (read-line . o)
   (let ((in (if (pair? o) (car o) (current-input-port)))
         (n (if (and (pair? o) (pair? (cdr o))) (car (cdr o)) 8192)))
@@ -43,6 +53,15 @@
                     (substring res 0 (- len 1)))
                 res))))))
 
+;;> @subsubsubsection{(read-string n [in])}
+
+;;> Reads @var{n} characters from input-port @var{in},
+;;> defaulting to @scheme{(current-input-port)}, and
+;;> returns the result as a string.  Returns @scheme{""}
+;;> if @var{n} is zero.  May return a string with fewer
+;;> than @var{n} characters if the end of file is reached,
+;;> or the eof-object if no characters are available.
+
 (define (read-string n . o)
   (if (zero? n)
       ""
@@ -56,7 +75,18 @@
                                   (port-line in)))
             (cadr res)))))))
 
+;;> @subsubsubsection{(read-string! str n [in])}
+
+;;> Reads @var{n} characters from port @var{in}, which
+;;> defaults to @scheme{(current-input-port)}, and writes
+;;> them into the string @var{str} starting at index 0.
+;;> Returns the number of characters read.
+;;> An error is signalled if the length of @var{str} is smaller
+;;> than @var{n}.
+
 (define (read-string! str n . o)
+  (if (>= n (string-length str))
+      (error "string to small to read chars" str n))
   (let* ((in (if (pair? o) (car o) (current-input-port)))
          (res (%read-string! str n in)))
     (port-line-set! in (+ (string-count #\newline str 0 n) (port-line in)))
@@ -65,6 +95,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; higher order port operations
 
+;;> The fundamental port iterator.
+
 (define (port-fold kons knil . o)
   (let ((read (if (pair? o) (car o) read))
         (in (if (and (pair? o) (pair? (cdr o)))

lib/chibi/loop/loop.scm

@@ -3,9 +3,9 @@
 ;; Copyright (c) 2009-2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
-;; The loop API is compatible with Taylor Campbell's foof-loop, but
+;;> The loop API is mostly compatible with Taylor Campbell's
-;; the iterator API is different and subject to change.  All loop
+;;> @hyperlink["http://mumble.net/~campbell/scheme/foof-loop.txt"]{foof-loop},
-;; variables may be implicitly destructured with MATCH semantics.
+;;> but the iterator API is different and subject to change.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -49,6 +49,8 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;> @subsubsubsection{@scheme{(loop [name] (vars ...) [=> result] body ...)}}
+
 (define-syntax loop
   (syntax-rules ()
     ;; unnamed, implicit recursion
@@ -122,21 +124,29 @@
         . rest))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Iterators
+;;> @subsubsection{Iterators}
 
-;; Each gets passed two lists, those items left of the <- and those to
+;; Each gets passed two lists, those items left of the macro and those to
 ;; the right, followed by a NEXT and REST continuation.
-
+;;
 ;; Should finish with
 ;;
+;; @schemeblock{
 ;;  (next (outer-vars ...) (cursor-vars ...) (done?-tests ...)
 ;;        (loop-vars ...) (final-vars ...) . rest)
+;; }
 ;;
-;;  OUTER-VARS: bound once outside the loop in a LET*
+;; @itemlist[
-;;  CURSOR-VARS: DO-style bindings of the form (name init update)
+;; @item{@var{outer-vars} - bound once outside the loop in a LET*}
-;;  DONE?-TESTS: possibly empty list of forms that terminate the loop on #t
+;; @item{@var{cursor-vars} - DO-style bindings of the form (name init update)}
-;;  LOOP-VARS: inner variables, updated in parallel after the cursors
+;; @item{@var{done?-tests} - possibly empty list of forms that terminate the loop on #t}
-;;  FINAL-VARS: final variables, bound only in the => result
+;; @item{@var{loop-vars} - inner variables, updated in parallel after the cursors}
+;; @item{@var{final-vars} - final variables, bound only in the => result}
+;; ]
+
+;;> @subsubsubsection{@scheme{(for var [pair] (in-list ls [cdr]))}}
+
+;;> Basic list iterator.
 
 (define-syntax in-list                  ; called just "IN" in ITER
   (syntax-rules ()
@@ -145,13 +155,13 @@
     ((in-list ((var cursor) source) next . rest)
      (in-list ((var cursor succ) source) next . rest))
     ((in-list ((var cursor succ) (source)) next . rest)
-     (next ()                              ; outer let bindings
+     (next ()                         ; outer let bindings
-           ((cursor source succ))          ; iterator, init, step
+           ((cursor source succ))     ; iterator, init, step
-           ((not (pair? cursor)))          ; finish tests for iterator vars
+           ((not (pair? cursor)))     ; finish tests for iterator vars
            ;; step variables and values
            ((var (car cursor))
             (succ (cdr cursor)))
-           ()                              ; final result bindings
+           ()                           ; final result bindings
            . rest))
     ((in-list ((var cursor succ) (source step)) next . rest)
      (next ()
@@ -162,9 +172,12 @@
            ()
            . rest))))
 
-;; Iterator from Taylor R. Campbell.  If you know the number of lists
+;;> @subsubsubsection{@scheme{(for elts [pairs] (in-lists lol [cdr [done?]]))}}
-;; ahead of time it's much more efficient to iterate over each one
+
-;; separately.
+;;> Iterator from Taylor R. Campbell.  If you know the number of lists
+;;> ahead of time it's much more efficient to iterate over each one
+;;> separately.
+
 (define-syntax in-lists
   (syntax-rules ()
     ((in-lists ((elts) lol) next . rest)
@@ -202,8 +215,13 @@
             (%in-idx < (lambda (x i) (- i 1)) (lambda (x) (- (length x) 1)) (lambda (x) 0) ref tmp seq next . rest))))
        ))))
 
+;;> @subsubsubsection{@scheme{(for var [index] (in-vector vec))}}
+;;> @subsubsubsection{@scheme{(for var [index] (in-vector-reverse vec))}}
+
 (define-in-indexed in-vector in-vector-reverse vector-length vector-ref)
 
+;;> @subsubsubsection{@scheme{(for ch [cursor] (in-string str))}}
+
 (define-syntax in-string
   (syntax-rules ()
     ((in-string s next . rest)
@@ -211,6 +229,8 @@
               string-cursor-start string-cursor-end string-cursor-ref
               tmp s next . rest))))
 
+;;> @subsubsubsection{@scheme{(for ch [cursor] (in-string-reverse str))}}
+
 (define-syntax in-string-reverse
   (syntax-rules ()
     ((in-string-reverse s next . rest)
@@ -238,6 +258,8 @@
        . rest))
     ))
 
+;;> @subsubsubsection{@scheme{(for ch (in-port [input-port [reader [eof?]]]))}}
+
 (define-syntax in-port
   (syntax-rules ()
     ((in-port ((var) source) next . rest)
@@ -256,6 +278,8 @@
            ()
        . rest))))
 
+;;> @subsubsubsection{@scheme{(for ch (in-file [input-port [reader [eof?]]]))}}
+
 (define-syntax in-file
   (syntax-rules ()
     ((in-file ((var) source) next . rest)
@@ -272,6 +296,8 @@
            ((dummy (close-input-port p)))
        . rest))))
 
+;;> @subsubsubsection{@scheme{(for x (up-from [start] [(to limit)] [(by step)]))}}
+
 (define-syntax up-from
   (syntax-rules (to by)
     ((up-from (() . args) next . rest)
@@ -296,6 +322,8 @@
      (next ((s start)) ((var s (+ var 1))) () () () . rest))
     ))
 
+;;> @subsubsubsection{@scheme{(for x (down-from [start] [(to limit)] [(by step)]))}}
+
 (define-syntax down-from
   (syntax-rules (to by)
     ((down-from (() . args) next . rest)
@@ -343,11 +371,15 @@
         ((var (final cursor)))
         . rest))))
 
+;;> @subsubsubsection{@scheme{(for x [pair] (listing expr))}}
+
 (define-syntax listing
   (syntax-rules ()
     ((listing args next . rest)
      (accumulating (cons reverse '()) args next . rest))))
 
+;;> @subsubsubsection{@scheme{(for x [pair] (listing-reverse expr))}}
+
 (define-syntax listing-reverse
   (syntax-rules ()
     ((listing-reverse args next . rest)
@@ -356,21 +388,29 @@
 (define (append-reverse rev tail)
   (if (null? rev) tail (append-reverse (cdr rev) (cons (car rev) tail))))
 
+;;> @subsubsubsection{@scheme{(for x [pair] (appending expr))}}
+
 (define-syntax appending
   (syntax-rules ()
     ((appending args next . rest)
      (accumulating (append-reverse reverse '()) args next . rest))))
 
+;;> @subsubsubsection{@scheme{(for x [pair] (appending-reverse expr))}}
+
 (define-syntax appending-reverse
   (syntax-rules ()
     ((appending-reverse args next . rest)
      (accumulating (append-reverse (lambda (x) x) '()) args next . rest))))
 
+;;> @subsubsubsection{@scheme{(for x (summing expr))}}
+
 (define-syntax summing
   (syntax-rules ()
     ((summing args next . rest)
      (accumulating (+ (lambda (x) x) 0) args next . rest))))
 
+;;> @subsubsubsection{@scheme{(for x (multiplying expr))}}
+
 (define-syntax multiplying
   (syntax-rules ()
     ((multiplying args next . rest)

lib/chibi/mime.scm

@@ -1,68 +1,8 @@
 ;; mime.scm -- RFC2045 MIME library
-;; Copyright (c) 2005-2009 Alex Shinn.  All rights reserved.
+;; Copyright (c) 2005-2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;> A library to parse MIME headers and bodies into SXML.
-;; RFC2822 headers
-
-;; Procedure: mime-header-fold kons knil [source [limit [kons-from]]]
-;;
-;;  Performs a fold operation on the MIME headers of source which can be
-;;  either a string or port, and defaults to current-input-port.  kons
-;;  is called on the three values:
-;;     kons header value accumulator
-;;  where accumulator begins with knil.  Neither the header nor the
-;;  value are modified, except wrapped lines are handled for the value.
-;;
-;;  The optional procedure KONS-FROM is a procedure to be called when
-;;  the first line of the headers is an "From <address> <date>" line, to
-;;  enable this procedure to be used as-is on mbox files and the like.
-;;  It defaults to KONS, and if such a line is found the fold will begin
-;;  with (KONS-FROM "%from" <address> (KONS-FROM "%date" <date> KNIL)).
-;;
-;; The optional LIMIT gives a limit on the number of headers to read.
-
-;; Procedure: mime-headers->list [source]
-;;   Return an alist of the MIME headers from source with headers all
-;;   downcased.
-
-;; Procedure: mime-parse-content-type str
-;;   Parses STR as a Content-Type style-value returning the list
-;;     (type (attr . val) ...)
-;;  For example:
-;;     (mime-parse-content-type
-;;        "text/html; CHARSET=US-ASCII; filename=index.html")
-;;       => ("text/html" ("charset" . "US-ASCII") ("filename" . "index.html"))
-
-;; Procedure: mime-decode-header str
-;;   Replace all occurrences of RFC1522 =?ENC?...?= escapes in STR with
-;;   the appropriate decoded and charset converted value.
-
-;; Procedure: mime-ref headers str [default]
-;;   A case-insensitive assoc-ref.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; RFC2045 MIME encoding
-
-;; Procedure: mime-message-fold src headers kons knil
-;;   Performs a fold operation on the given string or port SRC as a MIME
-;;   body corresponding to the headers give in HEADERS.  KONS is called
-;;   on the successive values:
-;;
-;;      KONS part-headers part-body accumulator
-;;
-;;   where part-headers are the headers for the given MIME part (the
-;;   original headers for single-part MIME), part-body is the
-;;   appropriately decoded and charset-converted body of the message,
-;;   and the accumulator begins with KNIL.
-;;
-;; TODO: Extend mime-message-fold to (optionally?) pass KONS an
-;; input-port instead of string for the body to handle very large bodies
-;; (this is not much of an issue for SMTP since the messages are in
-;; practice limited, but it could be problematic for large HTTP bodies).
-;;
-;; This does a depth-first search, folding in sequence.  It should
-;; probably be doing a tree-fold as in html-parser.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -85,6 +25,9 @@
     (cond ((assoc* key ls eq) => cdr)
           (else default))))
 
+;;> @subsubsubsection{@scheme{(mime-ref headers str [default])}}
+;;> A case-insensitive @scheme{assoc-ref}.
+
 (define (mime-ref ls key . o)
   (assoc-ref ls key (and (pair? o) (car o)) string-ci=?))
 
@@ -205,7 +148,24 @@
             (reverse (cons (substring str i len) res)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; header parsing
+;;> @subsubsection{RFC2822 Headers}
+
+;;> @subsubsubsection{@scheme{(mime-header-fold kons knil [source [limit [kons-from]]])}}
+;;>
+;;> Performs a fold operation on the MIME headers of source which can be
+;;> either a string or port, and defaults to current-input-port.  @var{kons}
+;;> is called on the three values:
+;;>    @scheme{(kons header value accumulator)}
+;;> where accumulator begins with @var{knil}.  Neither the header nor the
+;;> value are modified, except wrapped lines are handled for the value.
+;;>
+;;> The optional procedure @var{kons-from} is a procedure to be called when
+;;> the first line of the headers is an "From <address> <date>" line, to
+;;> enable this procedure to be used as-is on mbox files and the like.
+;;> It defaults to @var{kons}, and if such a line is found the fold will begin
+;;> with @scheme{(kons-from "%from" <address> (kons-from "%date" <date> knil))}.
+;;>
+;;> The optional @var{limit} gives a limit on the number of headers to read.
 
 (define (mime-header-fold kons knil . o)
   (let ((src (and (pair? o) (car o)))
@@ -254,6 +214,10 @@
      (else
       (out first-line knil 0)))))
 
+;;> @subsubsubsection{@scheme{(mime-headers->list [source])}}
+;;> Return an alist of the MIME headers from source with headers all
+;;> downcased.
+
 (define (mime-headers->list . o)
   (reverse
    (apply
@@ -273,9 +237,21 @@
                 (substring s (+ i 1) (string-length s)))))
       (cons (string-downcase (string-trim-white-space s)) ""))))
 
+;;> @subsubsubsection{@scheme{(mime-parse-content-type str)}}
+;;> Parses @var{str} as a Content-Type style-value returning the list
+;;> @scheme{(type (attr . val) ...)}.
+
+;;> @example{
+;;> (mime-parse-content-type "text/html; CHARSET=UTF-8; filename=index.html")
+;;> }
+
 (define (mime-parse-content-type str)
   (map mime-split-name+value (string-split str #\;)))
 
+;;> @subsubsubsection{@scheme{(mime-decode-header str)}}
+;;> Replace all occurrences of RFC1522 =?ENC?...?= escapes in @var{str} with
+;;> the appropriate decoded and charset converted value.
+
 (define (mime-decode-header str)
   (let* ((len (string-length str))
          (limit (- len 8))) ; need at least 8 chars: "=?Q?X??="
@@ -334,9 +310,20 @@
    (lambda (x) (next (mime-convert-part x cte enc)))
    (lambda (x) (final (mime-convert-part x cte enc)))))
 
-;; (kons parent-headers part-headers part-body seed)
+;;> @subsubsection{RFC2045 MIME Encoding}
-;; (start headers seed)
+
-;; (end headers parent-seed seed)
+;;> @subsubsubsection{@scheme{(mime-message-fold src kons knil [start end headers])}}
+;;> Performs a fold operation on the given string or port @var{src} as a
+;;> MIME body corresponding to the headers give in @var{headers}.  @var{kons}
+;;> is called on the successive values:
+;;>
+;;> @schemeblock{(kons parent-headers part-headers part-body accumulator)}
+;;>
+;;> where @var{part-headers} are the headers for the given MIME part (the
+;;> original headers for single-part MIME), @var{part-body} is the
+;;> appropriately decoded and charset-converted body of the message,
+;;> and the @var{accumulator} begins with @var{knil}.
+
 (define (mime-message-fold src kons init-seed . o)
   (let ((port (if (string? src) (open-input-string src) src)))
     (let ((kons-start
@@ -392,7 +379,12 @@
              (lambda (x) (next (kons parent-headers headers x seed)))
              (lambda (x) (final (kons parent-headers headers x seed)))))))))))
 
-;; (mime (^ (header . value) ...) parts ...)
+;;> @subsubsubsection{@scheme{(mime-message->sxml [src])}}
+;;> 
+;;> Parse the given source as a MIME message and return
+;;> the result as an SXML object of the form:
+;;> @scheme{(mime (^ (header . value) ...) parts ...)}.
+
 (define (mime-message->sxml . o)
   (car
    (apply
@@ -407,4 +399,3 @@
               ,@(if (pair? seed) (reverse seed) seed))
         ,@parent-seed))
     (if (pair? o) (cdr o) '()))))
-

lib/chibi/modules.module

@@ -3,7 +3,7 @@
   (export module-name module-dir module-includes module-shared-includes
           module-ast module-ast-set! module-ref module-contains?
           analyze-module containing-module load-module module-exports
-          procedure-analysis)
+          module-name->file procedure-analysis)
   (import-immutable (scheme) (config))
   (import (chibi ast))
   (include "modules.scm"))

lib/chibi/modules.scm

@@ -2,6 +2,8 @@
 ;; Copyright (c) 2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
+;;> Module introspection library.
+
 (define (file->sexp-list file)
   (call-with-input-file file
     (lambda (in)