improving docs

Makefile

@@ -46,10 +46,12 @@ COMPILED_LIBS = $(CHIBI_COMPILED_LIBS) $(CHIBI_IO_COMPILED_LIBS) \
 BASE_INCLUDES = include/chibi/sexp.h include/chibi/features.h include/chibi/install.h include/chibi/bignum.h
 INCLUDES = $(BASE_INCLUDES) include/chibi/eval.h include/chibi/gc_heap.h
 
-MODULE_DOCS := app ast config diff disasm equiv filesystem generic heap-stats io \
+MODULE_DOCS := app ast base64 bytevector config crypto/md5 crypto/rsa \
-	loop match mime modules net net/http-server parse pathname process repl scribble stty \
+	crypto/sha2 diff disasm doc equiv filesystem generic heap-stats io \
-	system test time trace type-inference uri weak monad/environment \
+	iset/base iset/constructors iset/iterators loop match math/prime \
-	crypto/sha2
+	memoize mime modules net net/http-server net/servlet parse pathname \
+	process repl scribble string stty sxml system temp-file test time \
+	trace type-inference uri weak monad/environment crypto/sha2
 
 IMAGE_FILES = lib/chibi.img lib/red.img lib/snow.img
 

doc/chibi.scrbl

@@ -112,6 +112,7 @@ are listed below.
 \item{\ccode{SEXP_USE_RATIOS} - use exact ratios (enabled by default)}
 \item{\ccode{SEXP_USE_COMPLEX} - use complex numbers (enabled by default)}
 \item{\ccode{SEXP_USE_UTF8_STRINGS} - Unicode support (enabled by default)}
+\item{\ccode{SEXP_USE_STRING_INDEX_TABLE} - precompute offsets for O(1) \scheme{string-ref}}
 \item{\ccode{SEXP_USE_NO_FEATURES} - disable almost all features}
 ]
 
@@ -137,9 +138,10 @@ superset of
 \hyperlink["http://www.schemers.org/Documents/Standards/R5RS/HTML/"]{R5RS}.
 
 The reader defaults to case-sensitive, like R6RS and R7RS but unlike
-R5RS.  The default configuration includes the full numeric tower:
+R5RS.  You can specify the -f option on the command-line to enable
-fixnums, flonums, bignums, exact rationals and complex numbers, though
+case-folding.  The default configuration includes the full numeric
-this can be customized at compile time.
+tower: fixnums, flonums, bignums, exact rationals and complex numbers,
+though this can be customized at compile time.
 
 Full continuations are supported, but currently continuations don't
 take C code into account.  This means that you can call from Scheme to
@@ -179,11 +181,12 @@ other languages.
 
 \subsection{Module System}
 
-Chibi uses the R7RS module system natively, which is a simple static
+Chibi supports the R7RS module system natively, which is a simple
-module system in the style of the
+static module system.  The Chibi implementation is actually a
-\hyperlink["http://s48.org/"]{Scheme48} module system.  As with most
+hierarchy of languages in the style of the
-features this is optional, and can be ignored or completely disabled
+\hyperlink["http://s48.org/"]{Scheme48} module system, allowing easy
-at compile time.
+extension of the module system itself.  As with most features this is
+optional, and can be ignored or completely disabled at compile time.
 
 Modules names are hierarchical lists of symbols or numbers.  A module
 definition uses the following form:
@@ -202,6 +205,7 @@ where \var{<library-declarations>} can be any of
   (include <file> ...)                 ;; load one or more files
   (include-ci <file> ...)              ;; as include, with case-folding
   (include-shared <file> ...)          ;; dynamic load a library (non-R7RS)
+  (alias-for <library>)                ;; a library alias (non-R7RS)
 }
 
 \var{<import-spec>} can either be a module name or any of
@@ -286,23 +290,31 @@ constructors:
 
 \subsection{Unicode}
 
-Chibi supports Unicode strings, encoding them as utf8.  This provides easy
+Chibi supports Unicode strings and I/O natively.  Case mappings and
-interoperability with many C libraries, but means that \scheme{string-ref} and
+comparisons, character properties, formatting and regular expressions
-\scheme{string-set!} are O(n), so they should be avoided in
+are all Unicode aware, supporting the latest version 13.0 of the
-performance-sensitive code.
+Unicode standard.
+
+Internally strings are encoded as UTF-8.  This provides easy
+interoperability with many C libraries, but means that
+\scheme{string-ref} and \scheme{string-set!} are O(n), so they should
+be avoided in performance-sensitive code (unless you compile Chibi
+with SEXP_USE_STRING_INDEX_TABLE).
 
 In general you should use high-level APIs such as \scheme{string-map}
 to ensure fast string iteration.  String ports also provide a simple
-way to efficiently iterate and construct strings, by looping over an
+and portable way to efficiently iterate and construct strings, by
-input string or accumulating characters in an output string.
+looping over an input string or accumulating characters in an output
+string.
 
 The \scheme{in-string} and \scheme{in-string-reverse} iterators in the
 \scheme{(chibi loop)} module will also iterate over strings
 efficiently while hiding the low-level details.
 
 In the event that you do need a low-level interface, such as when
-writing your own iterator protocol, you should use the following
+writing your own iterator protocol, you should use string cursors.
-string cursor API instead of indexes.
+\scheme{(srfi 130)} provides a portable API for this, or you can use
+\scheme{(chibi string)} which builds on the following core procedures:
 
 \itemlist[
 \item{\scheme{(string-cursor-start str)}
@@ -338,9 +350,10 @@ To use Chibi-Scheme in a program you need to link against the
 
 \ccode{#include <chibi/eval.h>}
 
-All definitions begin with a "sexp_" prefix, or "SEXP_" for constants.
+All definitions begin with a "sexp_" prefix, or "SEXP_" for constants
-In addition to the prototypes and utility macros, this includes the
+(deliberately chosen not to conflict with other Scheme implementations
-following type definitions:
+which typically use "scm_").  In addition to the prototypes and
+utility macros, this includes the following type definitions:
 
 \itemlist[
 \item{\ctype{sexp} - an s-expression, used to represent all Scheme objects}
@@ -673,6 +686,7 @@ need to check manually before applying the predicate.
 \item{\ccode{sexp_numberp(obj)} - \var{obj} is any kind of number}
 \item{\ccode{sexp_charp(obj)} - \var{obj} is a character}
 \item{\ccode{sexp_stringp(obj)} - \var{obj} is a string}
+\item{\ccode{sexp_string_cursorp(obj)} - \var{obj} is a string cursor}
 \item{\ccode{sexp_bytesp(obj)} - \var{obj} is a bytevector}
 \item{\ccode{sexp_symbolp(obj)} - \var{obj} is a symbol}
 \item{\ccode{sexp_idp(obj)} - \var{obj} is a symbol or hygienic identifier}
@@ -730,7 +744,7 @@ check.  The runtime does not prevent embedded NULLs inside strings,
 however data after the NULL may be ignored.
 
 By default (unless you compile with -DSEXP_USE_UTF8_STRING=0), strings
-are interpreted as utf8 encoded on the Scheme side, as describe in
+are interpreted as UTF-8 encoded on the Scheme side, as describe in
 section Unicode above.  In many cases you can ignore this on the C
 side and just treat the string as an opaque sequence of bytes.
 However, if you need to you can use the following macros to safely
@@ -748,7 +762,7 @@ compiled with:
 \item{\ccode{sexp sexp_substring_cursor(sexp ctx, sexp s, sexp i, sexp j)} - returns the substring between raw offsets \var{i} and \var{j}}
 ]
 
-When UTF8 support is not compiled in the cursor and non-cursor
+When UTF-8 support is not compiled in the cursor and non-cursor
 variants are equivalent.
 
 \subsubsection{Accessors}
@@ -766,6 +780,8 @@ once.
 \item{\ccode{sexp_unbox_fixnum(obj)} - converts a fixnum to a C integer}
 \item{\ccode{sexp_make_character(ch)} - creates a new character representing char \var{ch}}
 \item{\ccode{sexp_unbox_character(obj)} - converts a character to a C char}
+\item{\ccode{sexp sexp_make_string_cursor(int offset)} - creates a string cursor for the given byte offset}
+\item{\ccode{int sexp_unbox_string_cursor(sexp sc)} - returns the offset for the given string cursor}
 \item{\ccode{sexp_car(pair)} - the car of \var{pair}}
 \item{\ccode{sexp_cdr(pair)} - the cdr of \var{pair}}
 \item{\ccode{sexp_ratio_numerator(q)} - the numerator of the ratio \var{q}}
@@ -1245,13 +1261,18 @@ snow-fort):
 \item{\hyperlink["http://srfi.schemers.org/srfi-135/srfi-135.html"]{(srfi 135) - immutable texts}}
 \item{\hyperlink["http://srfi.schemers.org/srfi-139/srfi-139.html"]{(srfi 139) - syntax parameters}}
 \item{\hyperlink["http://srfi.schemers.org/srfi-141/srfi-141.html"]{(srfi 141) - integer division}}
+\item{\hyperlink["http://srfi.schemers.org/srfi-143/srfi-142.html"]{(srfi 142) - bitwise operations}}
 \item{\hyperlink["http://srfi.schemers.org/srfi-143/srfi-143.html"]{(srfi 143) - fixnums}}
 \item{\hyperlink["http://srfi.schemers.org/srfi-144/srfi-144.html"]{(srfi 144) - flonums}}
 \item{\hyperlink["http://srfi.schemers.org/srfi-145/srfi-145.html"]{(srfi 145) - assumptions}}
 \item{\hyperlink["http://srfi.schemers.org/srfi-147/srfi-147.html"]{(srfi 147) - custom macro transformers}}
 \item{\hyperlink["http://srfi.schemers.org/srfi-151/srfi-151.html"]{(srfi 151) - bitwise operators}}
 \item{\hyperlink["http://srfi.schemers.org/srfi-154/srfi-154.html"]{(srfi 154) - first-class dynamic extents}}
-\item{\hyperlink["http://srfi.schemers.org/srfi-159/srfi-159.html"]{(srfi 159) - combinator formatting}}
+\item{\hyperlink["http://srfi.schemers.org/srfi-158/srfi-158.html"]{(srfi 158) - generators and accumulators}}
+\item{\hyperlink["http://srfi.schemers.org/srfi-160/srfi-160.html"]{(srfi 160) - homogeneous numeric vector libraries}}
+\item{\hyperlink["http://srfi.schemers.org/srfi-165/srfi-165.html"]{(srfi 165) - the environment Monad}}
+\item{\hyperlink["http://srfi.schemers.org/srfi-166/srfi-166.html"]{(srfi 166) - monadic formatting}}
+\item{\hyperlink["http://srfi.schemers.org/srfi-166/srfi-188.html"]{(srfi 188) - splicing binding constructs for syntactic keywords}}
 
 ]
 
@@ -1264,12 +1285,24 @@ namespace.
 
 \item{\hyperlink["lib/chibi/ast.html"]{(chibi ast) - Abstract Syntax Tree and other internal data types}}
 
+\item{\hyperlink["lib/chibi/base64.html"]{(chibi base64) - Base64 encoding and decoding}}
+
+\item{\hyperlink["lib/chibi/bytevector.html"]{(chibi bytevector) - Bytevector Utilities}}
+
 \item{\hyperlink["lib/chibi/config.html"]{(chibi config) - General configuration management}}
 
-\item{\hyperlink["lib/chibi/disasm.html"]{(chibi diff) - LCS Algorithm and diff utilities}}
+\item{\hyperlink["lib/chibi/crypto/md5.html"]{(chibi crypto md5) - MD5 hash}}
+
+\item{\hyperlink["lib/chibi/crypto/rsa.html"]{(chibi crypto rsa) - RSA public key encryption}}
+
+\item{\hyperlink["lib/chibi/crypto/sha2.html"]{(chibi crypto sha2) - SHA-2 hash}}
+
+\item{\hyperlink["lib/chibi/diff.html"]{(chibi diff) - LCS Algorithm and diff utilities}}
 
 \item{\hyperlink["lib/chibi/disasm.html"]{(chibi disasm) - Disassembler for the virtual machine}}
 
+\item{\hyperlink["lib/chibi/doc.html"]{(chibi doc) - Chibi documentation utilities}}
+
 \item{\hyperlink["lib/chibi/equiv.html"]{(chibi equiv) - A version of \scheme{equal?} which is guaranteed to terminate}}
 
 \item{\hyperlink["lib/chibi/filesystem.html"]{(chibi filesystem) - Interface to the filesystem and file descriptor objects}}
@@ -1280,10 +1313,22 @@ namespace.
 
 \item{\hyperlink["lib/chibi/io.html"]{(chibi io) - Various I/O extensions and custom ports}}
 
+\item{\hyperlink["lib/chibi/iset/base.html"]{(chibi iset base) - Compact integer sets}}
+
+\item{\hyperlink["lib/chibi/iset/base.html"]{(chibi iset base) - Compact integer sets}}
+
+\item{\hyperlink["lib/chibi/iset/constructors.html"]{(chibi iset constructors) - Compact integer set construction}}
+
+\item{\hyperlink["lib/chibi/iset/iterators.html"]{(chibi iset iterators) - Iterating over compact integer sets}}
+
 \item{\hyperlink["lib/chibi/loop.html"]{(chibi loop) - Fast and extensible loop syntax}}
 
 \item{\hyperlink["lib/chibi/match.html"]{(chibi match) - Intuitive and widely supported pattern matching syntax}}
 
+\item{\hyperlink["lib/chibi/math/prime.html"]{(chibi math prime) - Prime number utilities}}
+
+\item{\hyperlink["lib/chibi/memoize.html"]{(chibi memoize) - Procedure memoization}}
+
 \item{\hyperlink["lib/chibi/mime.html"]{(chibi mime) - Parse MIME files into SXML}}
 
 \item{\hyperlink["lib/chibi/modules.html"]{(chibi modules) - Introspection for the module system itself}}
@@ -1292,6 +1337,8 @@ namespace.
 
 \item{\hyperlink["lib/chibi/net/http-server.html"]{(chibi net http-server) - Simple http-server with servlet support}}
 
+\item{\hyperlink["lib/chibi/net/servlet.html"]{(chibi net servlet) - HTTP servlets for http-server or CGI}}
+
 \item{\hyperlink["lib/chibi/parse.html"]{(chibi parse) - Parser combinators with convenient syntax}}
 
 \item{\hyperlink["lib/chibi/pathname.html"]{(chibi pathname) - Utilities to decompose and manipulate pathnames}}
@@ -1302,12 +1349,16 @@ namespace.
 
 \item{\hyperlink["lib/chibi/scribble.html"]{(chibi scribble) - A parser for the scribble syntax used to write this manual}}
 
-\item{\hyperlink["lib/chibi/show.html"]{(chibi show) - A combinator formatting library}}
+\item{\hyperlink["lib/chibi/string.html"]{(chibi string) - Cursor-based string library (predecessor to SRFI 130)}}
 
 \item{\hyperlink["lib/chibi/stty.html"]{(chibi stty) - A high-level interface to ioctl}}
 
+\item{\hyperlink["lib/chibi/sxml.html"]{(chibi sxml) - SXML utilities}}
+
 \item{\hyperlink["lib/chibi/system.html"]{(chibi system) - Access to the host system and current user information}}
 
+\item{\hyperlink["lib/chibi/temp-file.html"]{(chibi temp-file) - Temporary file and directory creation}}
+
 \item{\hyperlink["lib/chibi/test.html"]{(chibi test) - A simple unit testing framework}}
 
 \item{\hyperlink["lib/chibi/time.html"]{(chibi time) - An interface to the current system time}}
@@ -1325,7 +1376,7 @@ namespace.
 \section{Snow Package Manager}
 
 Beyond the distributed modules, Chibi comes with a package manager
-based on \hyperlink["http://trac.sacrideo.us/wg/wiki/Snow"]{Snow2}
+based on \hyperlink["https://small.r7rs.org/wiki/Snow/"]{Snow2}
 which can be used to share R7RS libraries.  Packages are distributed
 as tar gzipped files called "snowballs," and may contain multiple
 libraries.  The program is installed as \scheme{snow-chibi}.  The

lib/chibi/doc.scm

@@ -377,11 +377,15 @@
                (err-str (get-output-string tmp-err)))
            `(,@(if (string-null? out-str)
                    '()
-                   `((div (@ (class . "output")) ,(ansi->sxml out-str))))
+                   `((div (@ (class . "output")) (pre ,(ansi->sxml out-str)))))
              ,@(if (string-null? err-str)
                    '()
-                   `((div (@ (class . "error")) ,(ansi->sxml err-str))))
+                   `((div (@ (class . "error")) (pre ,(ansi->sxml err-str)))))
-             (div (@ (class . "result")) (code ,res-str))))))))
+             ,@(if (and (or (not (string-null? err-str))
+                            (not (string-null? out-str)))
+                        (eq? res (if #f #f)))
+                   '()
+                   `((div (@ (class . "result")) (code ,res-str))))))))))
 
 (define (expand-example-import x env)
   (eval `(import ,@(cdr x))
@@ -486,7 +490,7 @@ div#notes {position: relative; top: 2em; left: 570px; max-width: 200px; height:
 div#footer {padding-bottom: 50px}
 .result { color: #000; background-color: #FFEADF; width: 100%; padding: 3px}
 .output { color: #000; background-color: beige; width: 100%; padding: 3px}
-.error { color: #000; background-color: #330000; width: 100%; padding: 3px}
+.error { color: #000; background-color: #F0B0B0; width: 100%; padding: 3px}
 .command { color: #000; background-color: #FFEADF; width: 100%; padding: 5px}
 "
                  ,(highlight-style))

lib/chibi/test.scm

@@ -42,21 +42,28 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; test interface
 
+;;> \section{Testing}
+
 ;;> \macro{(test [name] expect expr)}
 
 ;;> The primary interface to testing.  Evaluate \var{expr} and check
-;;> that it is \scheme{equal?}  to \var{expect}.  \var{name} is used
+;;> that it is equal to \var{expect}, and report the result, using
-;;> in reporting, and defaults to a printed summary of \var{expr}.
+;;> \var{name} or a printed summary of \var{expr}.
-;;> Returns the status of the test (one of the symbols \scheme{'PASS},
-;;> \scheme{'FAIL}, \scheme{'SKIP}, \scheme{'ERROR}).
 ;;>
 ;;> If used inside a group this will contribute to the overall group
-;;> reporting, but can be used standalone.
+;;> reporting, but can be used standalone:
 ;;>
 ;;> \example{(test 4 (+ 2 2))}
 ;;> \example{(test "add two and two" 4 (+ 2 2))}
 ;;> \example{(test 3 (+ 2 2))}
 ;;> \example{(test 4 (+ 2 "2"))}
+;;>
+;;> The equality comparison is made with
+;;> \scheme{current-test-comparator}, defaulting to
+;;> \scheme{test-equal?}, which is the same as \scheme{equal?} but
+;;> more permissive on floating point comparisons).  Returns the
+;;> status of the test (one of the symbols \scheme{'PASS},
+;;> \scheme{'FAIL}, \scheme{'SKIP}, \scheme{'ERROR}).
 
 (define-syntax test
   (syntax-rules (quote)
@@ -138,10 +145,12 @@
      (test-syntax-error 'test-error "1 or 2 arguments required"
                         (test a ...)))))
 
-;; TODO: Extract interesting variables so we can show their values on
+;;> Low-level macro to pass alist info to the underlying \var{test-run}.
-;; failure.
+
 (define-syntax test-propagate-info
   (syntax-rules ()
+    ;; TODO: Extract interesting variables so we can show their values
+    ;; on failure.  Vars are empty for now.
     ((test-propagate-info name expect expr info)
      (test-vars () name expect expr info))))
 
@@ -156,24 +165,63 @@
                  (var-values . ,(list vars ...))
                  (key . val) ...)))))
 
-;;> Exits with a failure status if any tests have failed,
+;;> The procedural interface to testing.  \var{expect} and \var{expr}
-;;> and a successful status otherwise.
+;;> should be thunks, and \var{info} is an alist of properties used in
+;;> test reporting.
 
-(define (test-exit)
+(define (test-run expect expr info)
-  (exit (zero? (test-failure-count))))
+  (let ((info (test-expand-info info)))
+    (if (and (cond ((current-test-group)
+                    => (lambda (g) (not (test-group-ref g 'skip-group?))))
+                   (else #t))
+             (or (and (not (any (lambda (f) (f info)) (current-test-removers)))
+                      (or (pair? (current-test-removers))
+                          (null? (current-test-filters))))
+                 (any (lambda (f) (f info)) (current-test-filters))))
+        ((current-test-applier) expect expr info)
+        ((current-test-skipper) info))))
+
+;;> Returns true if either \scheme{(equal? expect res)}, or
+;;> \var{expect} is inexact and \var{res} is within
+;;> \scheme{current-test-epsilon} of \var{expect}.
+
+(define (test-equal? expect res)
+  (or (equal? expect res)
+      (if (real? expect)
+          (and (inexact? expect)
+               (real? res)
+               ;; tests which expect an inexact value can
+               ;; accept an equivalent exact value
+               ;; (inexact? res)
+               (approx-equal? expect res (current-test-epsilon)))
+          (and (complex? res)
+               (complex? expect)
+               (test-equal? (real-part expect) (real-part res))
+               (test-equal? (imag-part expect) (imag-part res))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; group interface
 
+;;> \section{Test Groups}
+
+;;> Tests can be collected in groups for
+
 ;;> Wraps \var{body} as a single test group, which can be filtered
 ;;> and summarized separately.
 
+;;> \example{
+;;> (test-group "pi"
+;;>   (test 3.14159 (acos -1))
+;;>   (test 3 (acos -1))
+;;>   (test 3.14159 (acos "-1")))
+;;> }
+
 (define-syntax test-group
   (syntax-rules ()
     ((_ name-expr body ...)
      (let ((name name-expr)
            (old-group (current-test-group)))
-       (if (not (string? name))
+       (when (not (string? name))
          (error "a name is required, got " 'name-expr name))
        (test-begin name)
        (guard
@@ -188,6 +236,78 @@
        (test-end name)
        (current-test-group old-group)))))
 
+;;> Begin testing a new group until the closing \scheme{(test-end)}.
+
+(define (test-begin . o)
+  (let* ((name (if (pair? o) (car o) ""))
+         (parent (current-test-group))
+         (group (make-test-group name parent)))
+    ;; include a newline if we are directly nested in a parent with no
+    ;; tests yet
+    (when (and parent
+               (zero? (test-group-ref parent 'subgroups-count 0))
+               (not (test-group-ref parent 'verbose)))
+      (newline))
+    ;; header
+    (cond
+     ((test-group-ref group 'skip-group?)
+      (display (make-string (or (test-group-indent-width group) 0) #\space))
+      (display (strikethrough (bold (string-append name ":"))))
+      (display " SKIP"))
+     ((test-group-ref group 'verbose)
+      (display
+       (test-header-line
+        (string-append "testing " name)
+        (or (test-group-indent-width group) 0))))
+     (else
+      (display
+       (string-append
+        (make-string (or (test-group-indent-width group) 0)
+                     #\space)
+        (bold (string-append name ": "))))))
+    ;; set the current test group
+    (current-test-group group)))
+
+;;> Ends testing group introduced with \scheme{(test-begin)}, and
+;;> summarizes the results.  The \var{name} is optional, but if
+;;> present should match the corresponding \scheme{test-begin} name,
+;;> or a warning is printed.
+
+(define (test-end . o)
+  (let ((name (and (pair? o) (car o))))
+    (cond
+     ((current-test-group)
+      => (lambda (group)
+           (when (and name (not (equal? name (test-group-name group))))
+             (warning "mismatched test-end:" name (test-group-name group)))
+           (let ((parent (test-group-ref group 'parent)))
+             (when (and (test-group-ref group 'skip-group?)
+                        (zero? (test-group-ref group 'subgroups-count 0)))
+               (newline))
+             ;; only report if there's something to say
+             ((current-test-group-reporter) group)
+             (when parent
+               (test-group-inc! parent 'subgroups-count)
+               (cond
+                ((test-group-ref group 'skip-group?)
+                 (test-group-inc! parent 'subgroups-skip))
+                ((and (zero? (test-group-ref group 'FAIL 0))
+                      (zero? (test-group-ref group 'ERROR 0))
+                      (= (test-group-ref group 'subgroups-pass 0)
+                         (test-group-ref group 'subgroups-count 0)))
+                 (test-group-inc! parent 'subgroups-pass))))
+             (current-test-group parent)
+             group))))))
+
+;;> Exits with a failure status if any tests have failed,
+;;> and a successful status otherwise.
+
+(define (test-exit)
+  (when (current-test-group)
+    (warning "calling test-exit with unfinished test group:"
+             (test-group-name (current-test-group))))
+  (exit (zero? (test-failure-count))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; utilities
 
@@ -198,6 +318,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; test-group representation
 
+;;> \section{Accessors}
+
 ;; (name (prop value) ...)
 (define (make-test-group name . o)
   (let ((parent (and (pair? o) (car o)))
@@ -223,7 +345,7 @@
 
 ;;> Returns the name of a test group info object.
 
-(define test-group-name car)
+(define (test-group-name group) (car group))
 
 ;;> Returns the value of a \var{field} in a test var{group} info
 ;;> object.  \var{field} should be a symbol, and predefined fields
@@ -394,18 +516,6 @@
           ,@info)
         info)))
 
-(define (test-run expect expr info)
-  (let ((info (test-expand-info info)))
-    (if (and (cond ((current-test-group)
-                    => (lambda (g) (not (test-group-ref g 'skip-group?))))
-                   (else #t))
-             (or (and (not (any (lambda (f) (f info)) (current-test-removers)))
-                      (or (pair? (current-test-removers))
-                          (null? (current-test-filters))))
-                 (any (lambda (f) (f info)) (current-test-filters))))
-        ((current-test-applier) expect expr info)
-        ((current-test-skipper) info))))
-
 (define (test-default-applier expect expr info)
   (let* ((group (current-test-group))
          (indent (and group (test-group-indent-width group))))
@@ -425,7 +535,7 @@
       (guard
           (exn
            (else
-            ((current-test-handler)
+            ((current-test-reporter)
              (if (assq-ref info 'expect-error) 'PASS 'ERROR)
              (append `((exception . ,exn)) info))))
         (let ((res (expr)))
@@ -437,10 +547,10 @@
                      'PASS
                      'FAIL))
                 (info `((result . ,res) (expected . ,expect-val) ,@info)))
-            ((current-test-handler) status info)))))))
+            ((current-test-reporter) status info)))))))
 
 (define (test-default-skipper info)
-  ((current-test-handler) 'SKIP info))
+  ((current-test-reporter) 'SKIP info))
 
 (define (test-status-color status)
   (case status
@@ -454,6 +564,8 @@
 
 (define (test-status-code status)
   ((test-status-color status)
+   ;; alternatively: ❗, ✗, ‒, ✓
+   ;; unfortunately, these have ambiguous width
    (case status
      ((ERROR) "!")
      ((FAIL) "x")
@@ -697,100 +809,62 @@
            (test-group-inc! parent 'total-fail fail)
            (test-group-inc! parent 'total-error err))))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (test-equal? expect res)
-  (or (equal? expect res)
-      (if (real? expect)
-          (and (inexact? expect)
-               (real? res)
-               ;; tests which expect an inexact value can
-               ;; accept an equivalent exact value
-               ;; (inexact? res)
-               (approx-equal? expect res (current-test-epsilon)))
-          (and (complex? res)
-               (complex? expect)
-               (test-equal? (real-part expect) (real-part res))
-               (test-equal? (imag-part expect) (imag-part res))))))
-
-;;> Begin testing a new group until the closing \scheme{(test-end)}.
-
-(define (test-begin . o)
-  (let* ((name (if (pair? o) (car o) ""))
-         (parent (current-test-group))
-         (group (make-test-group name parent)))
-    ;; include a newline if we are directly nested in a parent with no
-    ;; tests yet
-    (cond
-     ((and parent
-           (zero? (test-group-ref parent 'subgroups-count 0))
-           (not (test-group-ref parent 'verbose)))
-      (newline)))
-    ;; header
-    (cond
-     ((test-group-ref group 'skip-group?)
-      (display (make-string (or (test-group-indent-width group) 0) #\space))
-      (display (strikethrough (bold (string-append name ":"))))
-      (display " SKIP"))
-     ((test-group-ref group 'verbose)
-      (display
-       (test-header-line
-        (string-append "testing " name)
-        (or (test-group-indent-width group) 0))))
-     (else
-      (display
-       (string-append
-        (make-string (or (test-group-indent-width group) 0)
-                     #\space)
-        (bold (string-append name ": "))))))
-    ;; set the current test group
-    (current-test-group group)))
-
-;;> Ends testing group introduced with \scheme{(test-begin)}, and
-;;> summarizes the results.
-
-(define (test-end . o)
-  (cond
-   ((current-test-group)
-    => (lambda (group)
-         (if (and (pair? o) (not (equal? (car o) (test-group-name group))))
-             (warning "mismatched test-end:" (car o) (test-group-name group)))
-         (let ((parent (test-group-ref group 'parent)))
-           (if (and (test-group-ref group 'skip-group?)
-                    (zero? (test-group-ref group 'subgroups-count 0)))
-               (newline))
-           ;; only report if there's something to say
-           ((current-test-group-reporter) group)
-           (cond
-            (parent
-             (test-group-inc! parent 'subgroups-count)
-             (cond
-              ((test-group-ref group 'skip-group?)
-               (test-group-inc! parent 'subgroups-skip))
-              ((and (zero? (test-group-ref group 'FAIL 0))
-                    (zero? (test-group-ref group 'ERROR 0))
-                    (= (test-group-ref group 'subgroups-pass 0)
-                       (test-group-ref group 'subgroups-count 0)))
-               (test-group-inc! parent 'subgroups-pass)))))
-           (current-test-group parent)
-           group)))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; parameters
 
+;;> \section{Parameters}
+
+;;> The current test group as started by \scheme{test-group} or
+;;> \scheme{test-begin}.
+
 (define current-test-group (make-parameter #f))
+
+;;> If true, show more verbose output per test.  Inferred from the
+;;> environment variable TEST_VERBOSE.
+
 (define current-test-verbosity
   (make-parameter
    (cond ((get-environment-variable "TEST_VERBOSE")
           => (lambda (s) (not (member s '("" "0")))))
          (else #f))))
+
+;;> The epsilon used for floating point comparisons.
+
 (define current-test-epsilon (make-parameter 1e-5))
+
+;;> The underlying comparator used in testing, defaults to
+;;> \scheme{test-equal?}.
+
 (define current-test-comparator (make-parameter test-equal?))
+
+;;> The test applier - what we do with non-skipped tests.  Takes the
+;;> same signature as \scheme{test-run}, should be responsible for
+;;> evaluating the thunks, determining the status of the test, and
+;;> passing this information to \scheme{current-test-reporter}.
+
 (define current-test-applier (make-parameter test-default-applier))
-(define current-test-handler (make-parameter test-default-handler))
+
+;;> The test skipper - what we do with non-skipped tests.  This should
+;;> not evaluate the thunks and simply pass off to
+;;> \scheme{current-test-reporter}.
+
 (define current-test-skipper (make-parameter test-default-skipper))
+
+;;> Takes two arguments, the symbol status of the test and the info
+;;> alist.  Reports the result of the test and updates bookkeeping in
+;;> the current test group for reporting.
+
+(define current-test-reporter (make-parameter test-default-handler))
+
+;;> Takes one argument, a test group, and prints a summary of the test
+;;> results for that group.
+
 (define current-test-group-reporter
   (make-parameter test-default-group-reporter))
+
+;;> A running count of all test failures and errors across all groups
+;;> (and threads).  Used by \scheme{test-exit}.
+
 (define test-failure-count (make-parameter 0))
 
 (define test-first-indentation

lib/chibi/test.sld

@@ -5,13 +5,13 @@
    test test-equal test-error test-assert test-not test-values
    test-group current-test-group
    test-begin test-end test-syntax-error test-propagate-info
-   test-vars test-run test-exit
+   test-run test-exit test-equal?
    ;; test and group data
    test-get-name! test-group-name test-group-ref
    test-group-set! test-group-inc! test-group-push!
    ;; parameters
    current-test-verbosity
-   current-test-applier current-test-handler current-test-skipper
+   current-test-applier current-test-skipper current-test-reporter
    current-test-group-reporter test-failure-count
    current-test-epsilon current-test-comparator
    current-test-filters current-test-removers

lib/chibi/trace.scm

@@ -34,11 +34,16 @@
         (show-trace-result cell args res)
         res))))
 
+;;> Write a trace of all calls to the procedure \var{proc} to
+;;> \scheme{(current-error-port)}.
+
 (define-syntax trace
   (syntax-rules ()
     ((trace id)
      (trace-cell (env-cell (interaction-environment) 'id)))))
 
+;;> Remove any active traces on the procedure \var{proc}.
+
 (define-syntax untrace
   (syntax-rules ()
     ((untrace id)
@@ -50,6 +55,8 @@
     (for-each (lambda (x) (display x out)) args)
     (newline out)))
 
+;;> Trace a specific environment cell.
+
 (define (trace-cell cell)
   (let ((tab (all-traces)))
     (cond
@@ -61,6 +68,8 @@
       (hash-table-set! tab cell (cdr cell))
       (set-cdr! cell (make-tracer cell))))))
 
+;;> Untrace an environment cell.
+
 (define (untrace-cell cell)
   (let ((tab (all-traces)))
     (cond
@@ -73,6 +82,8 @@
         (hash-table-delete! tab cell)
         (set-cdr! cell proc))))))
 
+;;> Remove all active procedure traces.
+
 (define (untrace-all)
   (hash-table-walk (all-traces) (lambda (cell proc) (set-cdr! cell proc)))
   (all-traces (make-hash-table eq?)))

lib/chibi/trace.sld

@@ -1,17 +1,4 @@
 
-;;> \subsubsubsection{(trace proc)}
-
-;;> Write a trace of all calls to the procedure \var{proc} to
-;;> \scheme{(current-error-port)}.
-
-;;> \subsubsubsection{(untrace proc)}
-
-;;> Remove any active traces on the procedure \var{proc}.
-
-;;> \subsubsubsection{(untrace-all)}
-
-;;> Remove all active procedure traces.
-
 (define-library (chibi trace)
   (export trace untrace untrace-all trace-cell untrace-cell)
   (import (chibi) (chibi ast) (srfi 38) (srfi 39) (srfi 69))

lib/chibi/weak.sld

@@ -1,6 +1,24 @@
 
 ;;> Library for weak data structures.
 
+;;> \procedure{(make-ephemeron key value)}
+
+;;> Returns a new ephemeron.  This ephemeron holds a weak reference to
+;;> \var{key}, such that \var{value} will only be traced by the GC if
+;;> \var{key} is referenced from an external object.
+
+;;> \procedure{(ephemeron? x)}
+;;> Returns true iff \var{x} is an ephemeron.
+
+;;> \procedure{(ephemeron-broken? ephemeron)}
+;;> Returns true iff \var{ephemeron}s \var{key} has been GCed.
+
+;;> \procedure{(ephemeron-key ephemeron)}
+;;> Returns \var{ephemeron}s \var{key}, or \scheme{#f} if it has been GCed.
+
+;;> \procedure{(ephemeron-value ephemeron)}
+;;> Returns \var{ephemeron}s \var{value}.
+
 (define-library (chibi weak)
   (export make-ephemeron ephemeron? ephemeron-broken?
           ephemeron-key ephemeron-value