Import Upstream version 2a6upstream/2a6

126 files changed, 44217 insertions, 0 deletions

diff --git a/ANNOUNCE b/ANNOUNCE
new file mode 100644
index 0000000..f34c063
--- /dev/null
+++ b/ANNOUNCE
@@ -0,0 +1,70 @@
+This message announces the availability of Scheme Library release
+slib2a6.
+
+New in SLIB2a6:
+
+	* structure.scm scaoutp.scm scamacr.scm scainit.scm scaglob.scm
+        scaexpp.scm: Added missing copyright notice and terms.
+
+	* rbtest.scm rbtree.scm: removed for lack of copying permissions.
+
+	* root.scm (newton:find-integer-root integer-sqrt newton:find-root
+	laguerre:find-root laguerre:find-root): added.
+
+	* scanf.scm (stdio:scan-and-set): removed gratuitous char-downcase
+	by changing all (next-format-char) ==> (read-char format-port).
+
+SLIB is a portable scheme library meant to provide compatibiliy and
+utility functions for all standard scheme implementations.
+
+SLIB includes initialization files for Chez, ELK 2.1, GAMBIT,
+MacScheme, MITScheme, scheme->C, Scheme48, T3.1, and VSCM.  SCM also
+supports SLIB.
+
+Documentation includes a manifest, installation instructions, and
+coding standards for the library.  Documentation on each library
+package is supplied.  SLIB Documentation is online at:
+
+	    http://ftp-swiss.ai.mit.edu/~jaffer/SLIB.html
+
+SLIB is a portable Scheme library:
+ ftp-swiss.ai.mit.edu:pub/scm/slib2a6.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib2a6.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2a6.tar.gz
+
+SLIB-PSD is a portable debugger for Scheme (requires emacs editor):
+ ftp-swiss.ai.mit.edu:pub/scm/slib-psd1-3.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib-psd1-3.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz
+
+SLIB-SCHELOG is an embedding of Prolog in Scheme:
+ ftp-swiss.ai.mit.edu:pub/scm/slib-schelog.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib-schelog.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-schelog.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-schelog.tar.gz
+
+Programs for printing and viewing TexInfo documentation (which SLIB
+has) come with GNU Emacs or can be obtained via ftp from:
+prep.ai.mit.edu:pub/gnu/texinfo-3.1.tar.gz
+
+Files in these directories are compressed with patent-free gzip (no
+relation to zip).  The program to uncompress them is available from
+ prep.ai.mit.edu:pub/gnu/gzip-1.2.4.tar
+ prep.ai.mit.edu:pub/gnu/gzip-1.2.4.shar
+ prep.ai.mit.edu:pub/gnu/gzip-1.2.4.msdos.exe
+
+  ftp ftp-swiss.ai.mit.edu (anonymous)
+  bin
+  cd pub/scm
+  get slib2a6.tar.gz
+or
+  ftp prep.ai.mit.edu (anonymous)
+  cd pub/gnu/jacal
+  bin
+  get slib2a6.tar.gz
+
+  `slib2a6.tar.gz' is a compressed tar file of a Scheme Library.
+
+Remember to use binary mode when transferring the *.tar.gz files.
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..977f23e
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,1094 @@
+Fri Jul 19 11:24:45 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* structure.scm scaoutp.scm scamacr.scm scainit.scm scaglob.scm
+        scaexpp.scm: Added missing copyright notice and terms.
+
+Thu Jul 18 17:37:14 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* rbtest.scm rbtree.scm: removed for lack of copying permissions.
+
+Wed Jun  5 00:22:33 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* root.scm (newton:find-integer-root integer-sqrt newton:find-root
+	laguerre:find-root laguerre:find-root): added.
+
+Wed May 15 09:59:00 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* scanf.scm (stdio:scan-and-set): removed gratuitous char-downcase
+	by changing all (next-format-char) ==> (read-char format-port).
+
+Tue Apr  9 19:22:40 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* slib2a5 released.
+
+	* mwtest.scm: removed from distribution for lack of copyright
+	info.
+
+	* batch.scm (batch:apply-chop-to-fit): added
+	(batch:try-system): renamed from batch:system.
+	(batch:system): now signals error if line length over limit or
+	system calls fail.
+
+Sun Aug 20 19:20:35 1995  Gary Leavens <leavens@cs.iastate.edu>
+
+	* struct.scm (check-define-record-syntax check-variant-case-syntax):
+
+	For using the file "struct.scm" with the EOPL book, one has to
+	make 2 corrections.  To correct it, there are two places where "-"
+	has to be replaced by "->" as in the code below...
+
+Sat Apr  6 14:31:19 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* batch.scm (must-be-first must-be-last): added.
+
+	* paramlst.scm (check-parameters): made error message more
+	informative.
+
+Mon Mar 18 08:46:36 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* modular.scm (modular:*): non-bignum symmetric modulus case was
+	dividing by 0.  Algorithm still needs to be fixed.
+
+Mon Mar 13 00:41:00 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* slib2a4 released.
+
+Sat Mar  9 21:36:19 1996  Mikael Djurfeldt <mdj@nada.kth.se>
+
+	* tsort.scm (topological-sort): Added.
+
+Fri Mar  8 19:25:52 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* printf.scm: Removed use of string-ports.  Cleaned up error
+	handling.
+
+Tue Mar  5 14:30:09 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* printf.scm (%a %A): General scheme output specifier added.
+
+Mon Feb 19 15:48:06 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* scanf.scm (stdio:scan-and-set): Removed flush-whitespace from
+	all conversion specifications per suggestion from
+	oleg@mozart.compsci.com (Oleg Kiselyov).
+
+Sat Feb  3 00:02:06 1996  Oleg Kiselyov (oleg@ponder.csci.unt.edu)
+
+	* strsrch.scm (string-index substring? find-string-from-port?): added.
+
+Mon Jan 29 23:56:33 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* printf.scm (stdio:iprintf): Rewrote for Posix compliance (+
+	extensions which are both BSD and GNU).
+
+Sat Jan 27 09:55:03 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* FAQ: printf vs. format explained.
+
+	* printf.scm: renamed from "stdio.scm".  (require 'printf) now
+	brings in "printf.scm".
+
+Sun Jan 14 21:00:17 1996  Aubrey Jaffer  <jaffer@jacal.bertronics>
+
+	* scanf.scm: Rewrote from scratch.
+
+Mon Oct  9 22:48:58 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* modular.scm (modular:invertable?): added.
+
+Wed Sep 27 10:01:04 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* debug.scm: augmented, reorganized, and split.
+	(print): removed.
+
+	* break.scm: created.
+
+	* qp.scm: created.
+
+Sun Sep 24 22:23:19 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* require.scm (*catalog*): test.scm removed.
+
+Sun Sep 17 21:32:02 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* modular.scm: rewritten so that if modulus is:
+		positive? -- work as before (Z_modulus)
+		zero?	  -- perform integer operations (Z)
+		negative? -- perform operations using symmetric
+			     representation (Z_(1-2*modulus))
+	(symmetric:modulus modulus->integer modular:normalize): added.
+	(modular:*): not completed for fixnum-only implementations.
+
+Sat Sep  9 16:53:22 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* slib.texi (Legacy): added for t, nil, last-pair, and identity,
+	which are now required of all implementations.
+
+Mon Aug 28 00:42:29 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* require.scm (require:feature->path require:provided?
+	require:require): cleaned up.  feature->path now returns a path,
+	whether the module is loaded or not.
+
+Sun Aug 27 11:05:19 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* genwrite.scm (generic-write): Fixed "obj2str"
+	OBJECT->LIMITED-STRING non-terminating wr-lst for cases like
+	(set-car! foo foo).
+
+	* obj2str.scm (object->limited-string): uncommented.
+
+Sun Aug 20 17:10:40 1995  Stephen Adams <adams@martigny.ai.mit.edu>
+
+	* wttest.scm wttree.scm: Weight Balanced Trees added.
+
+Sun Aug 20 16:06:20 1995  Dave Love <d.love@dl.ac.uk>
+
+	* tree.scm yasyn.scm collect.scm: Uppercase identifiers changed to
+	lower case for compatability with case sensitive implementations.
+
+Sat Aug 19 21:27:55 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* arraymap.scm (array-copy!): added.
+
+	* primes.scm (primes:primes< primes:primes>): primes:primes split
+	into ascending and descending versions.
+
+Sun Jul 16 22:44:36 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* makcrc.scm (make-port-crc): added.  POSIX.2 checksums.
+
+Mon Jun 12 16:20:54 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* synclo.scm (internal-syntactic-environment
+	top-level-syntactic-environment): replaced call to alist-copy.
+
+	* require.scm (*catalog*): 'schelog, 'primes, and 'batch added.
+	'prime renamed to 'factor.
+
+	From: mhc@edsdrd.eds.com (Michael H Coffin)
+	* primes.scm (primes probably-prime?): added.  prime.scm renamed
+	to factor.scm.
+
+Fri Mar 24 23:35:25 1995  Matthew McDonald <mafm@cs.uwa.edu.au>
+
+	* struct.scm (define-record): added field-setters.
+
+Sun Jun 11 23:36:55 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* batch.scm: added
+
+	* Makefile (schelogfiles): SLIB schelog distribution created.
+
+Mon Apr 17 15:57:32 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* comlist.scm (coerce type-of): added.
+
+	* debug.scm (debug:qp): with *qp-width* of 0 just `write's.
+
+	* paramlst.scm (getopt->parameter-list): Now accepts long-named
+	options.  Now COERCEs according to types.
+
+Sat Apr 15 23:15:26 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* require.scm (require:feature->path): Returns #f instead of
+	string if feature not in *catalog* or *modules*.
+
+Sun Mar 19 22:26:52 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* getopt.scm (getopt-- argc argv optstring): added wrapper for
+	getopt which parses long-named-options.
+
+Tue Feb 28 21:12:14 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* paramlst.scm (parameter-list-expand expanders parms): added.
+
+Mon Feb 27 17:23:54 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* report.scm (dbutil:print-report): added.
+
+	* comparse.scm (read-command): added.  Reads from a port and
+	returns a list of strings: the arguments (and options).
+
+Sat Feb 25 01:05:25 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* repl.scm (repl:repl): Added loop, conditional on CHAR-READY?
+	being PROVIDED?, which reads through trailing white-space.
+
+Sun Feb  5 16:34:03 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* paramlst.scm ((make-parameter-list parameter-names)): 
+	((fill-empty-parameters defaults parameter-list)): 
+	((check-parameters checks parameter-list)): 
+	((parameter-list->arglist positions arities parameter-list)): 
+	((parameter-list-ref parameter-list i)): 
+	((adjoin-parameters! parameter-list parameters)): 
+	Procedures for making, merging, defaulting, checking and
+	converting `parameter lists' (named parameters).
+	((getopt->parameter-list argc argv optnames arities aliases)): 
+	((getopt->arglist argc argv optnames positions
+			 arities defaults checks aliases)): 
+	Procedures for converting options and arguments processed by
+	getopt to parameter-list or arglist form.
+
+	* dbutil.scm ((make-command-server rdb command-table)): added
+	procedure which calls commands and processes parameters.
+
+	* rdms.scm ((make-relational-system base)): add-domain and
+	delete-domain commands moved to "dbutil.scm" (create-database).
+
+Fri Feb  3 11:07:46 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* debug.scm (debug:tracef debug:untracef): removed (duplicates of
+	code in "trace.scm").
+	(trace-all): utility to trace all defines in a file added.
+
+Thu Jan 19 00:26:14 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* logical.scm (logbit? logtest): added.
+
+Sun Jan 15 20:38:42 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* dbutil.scm (dbutil:create-database)): Added parameter
+	description tables for "commands".
+
+	* require.scm (software-type): standardize msdos -> ms-dos.
+
+Mon Jan  2 10:26:45 1995  Aubrey Jaffer  (jaffer@jacal)
+
+	* comlist.scm (comlist:atom?): renamed from comlist:atom.
+
+	* scheme48.init	(char->integer integer->char): Now use integers in
+	the range 0 to 255.  Fixed several other problems.
+	(modulo): Worked around negative modulo bug.
+
+	* Makefile (slib48): `make slib48' loads "scheme48.init", `,dump's
+	a scheme48 image file, and creates an `slib48' shell script to
+	invoke it.
+
+	* hash.scm (hash:hash-number): no longer does inexact->exact to
+	exacts, etc.
+
+	* trnscrpt.scm (read): no longer transcripts eof-objects.
+
+	From: johnm@vlibs.com (John Gerard Malecki)
+	* priorque.scm (heap:heapify): internal defines incorrectly
+	dependent on order-of-eval replaced with let*.
+
+Thu Dec 22 13:28:16 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* dbutil.scm (open-database! open-database create-database): This
+        enhancement wraps a utility layer on `relational-database' which
+        provides:
+	  * Automatic loading of the appropriate base-table package when
+	    opening a database.
+	  * Automatic execution of initialization commands stored in
+	    database.
+	  * Transparent execution of database commands stored in
+	    `*commands*' table in database.
+
+Wed Dec 21 22:53:57 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* rdms.scm (make-relational-system base): Now more careful about
+	protecting read-only databases.
+
+Mon Dec 19 00:06:36 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* dbutil.scm (dbutil:define-tables): added utility which provides:
+	Data definition from Scheme lists for any SLIB
+	relational-database.
+
+Sat Dec 17 12:10:02 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* alistab.scm rdms.scm (make-getter row-eval): evaluation of
+	`expression' fields no longer done when retrieved from base
+	tables (which made copying of many tables impossible).
+
+	* alistab.scm 
+	(write-base): rewrote to not use pretty-print.
+
+	* sc3.scm: removed (only contained last-pair, t, and nil).
+
+	* Template.scm scheme48.init vscm.init (last-pair t nil): added.
+
+Thu Dec  8 00:02:18 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* mularg.scm pp.scm ratize.scm: copyright line removed from files
+	(still lacking terms) less than 12 lines.
+
+	From: johnm@vlibs.com (John Gerard Malecki)
+	* sort.scm (sort:sort!): long standing bug in sort! with vector
+	argument fixed.
+
+Thu Dec  1 17:10:24 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* *.scm: Most missing copyright notices supplied.
+
+Sun Nov 27 23:57:41 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* rdms.scm (make-relational-system base): now checks field types
+	when table is opened.  Domains table now has foreign-table field.
+	(for-each-row): ordered for-each function added.
+	* alistab.scm (ordered-for-each-key supported-key-type?): added.
+
+Thu Oct 27 12:20:41 1994  Tom Tromey  <tromey@drip.colorado.edu>
+
+	* priorque.scm: Renamed everything to conform to coding standards
+	and updated docs.  Changed names: heap-extract-max to
+	heap-extract-max!, heap-insert to heap-insert! and heap-size to
+	heap-length.
+
+Sat Nov 26 22:52:31 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Template.scm *.init (identity): Now required; moved from
+	"comlist.scm".
+
+	* alistab.scm (alist-table): Converted to representing rows as
+	lists.  Non-row operations removed.
+
+	* rdms.scm (make-relational-system base): Most individual column
+	operations removed.  Only get and get* remain.  Row operations
+	renamed.   Row inserts and updates distinguished.
+
+Tue Nov 15 16:37:16 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* rdms.scm (make-relational-system base): Generalized database
+	system inspired by the Relational Model.
+
+	* alistab.scm (alist-table): Base table implementation suitable
+	for small databases and testing rdms.scm.
+
+Tue Oct 25 22:36:01 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: Tommy Thorn <Tommy.Thorn@irisa.fr>
+	* chez.init (scheme-implementation-version): fixed (changed to "?").
+	(library-vicinity): The definition of library-vicinity used
+	getenv, which was defined later.
+	(slib:chez:quit): The definition of slib:chez:quit was illegal.
+	Fixed.
+	(chez:merge!): had a typo.
+	(defmacro:load): (require 'struct) didn't work, because defmacro:load
+	doesn't add suffix.  Workaround: defmacro:load and macro:load is
+	the same as slib:load-source.
+
+Wed Oct 19 11:44:12 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* require.scm time.scm cltime.scm (difftime offset-time): added to
+	allow 'posix-time functions to work with a non-numeric type
+	returned by (current-time).
+
+Tue Aug  2 10:44:32 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* repl.scm (repl:top-level repl:repl): Multiple values at top
+	level now print nicely.
+
+Sun Jul 31 21:39:54 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* cltime.scm (get-decoded-time get-universal-time
+	decode-universal-time encode-universal-time): 
+	Common-Lisp time conversion routines created.
+
+	* time.scm (*timezone* tzset gmtime localtime mktime asctime ctime):
+	Posix time conversion routines created.
+
+Mon Jul 11 14:16:44 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Template.scm mitscheme.init scheme2c.init t3.init (*features*):
+	trace added.
+
+Fri Jul  8 11:02:34 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* chap.scm ((chap:string<? s1 s2) (chap:next-string s)): Functions
+	for "chapter ordering" of strings.
+
+Mon Jun 20 22:36:44 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* slib.texi (R4RS Macros section): added.
+
+	From: jjb@isye.gatech.edu (John Bartholdi)
+	* sierpinski.scm (MAKE-SIERPINSKI-INDEXER): added.
+	* soundex.scm (SOUNDEX): added.
+
+	From: hugh@cosc.canterbury.ac.nz (Hugh Emberson)
+	* mwexpand.scm ((mw:quasiquote exp env)): Fixed bug which occured
+	when mw:quasiquote expanded things like `(1 2 3 . ,(+ 1 a)).  I
+	added support for vectors in quasiquotes while I was there.
+
+Sun Jun 19 00:37:09 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* defmacex.scm ((defmacro:expand* e)): fixed problem with varargs
+	define.
+
+Sat Jun 18 13:08:33 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* randinex.scm ((random:size-float l x)): no longer assumes that
+	inexact numbers have finite precision, which is not necessarily
+	true (pointed out by jar@ai.mit.edu).  Limits size to 4.
+
+Mon Jun  6 00:46:48 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* trace.scm (trace untrace): created.
+	(debug:tracef debug:untracef): moved from debug.scm
+
+Sun May 22 23:44:03 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* yasyn.scm: replaces yasos.scm
+
+Sat May 21 22:28:01 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* comlist.scm ((comlist:has-duplicates? lst)): added.
+
+Mon May 16 13:40:18 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: jjb@isye.gatech.edu (John Bartholdi)
+	* macscheme.init (slib:exit): fixed.  Version set to 4.2.
+
+Wed Apr 27 00:48:54 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: jjb@isye.gatech.edu (John Bartholdi)
+	* scanf.scm (scanf fscanf sscanf): created.
+
+Thu Apr 14 12:59:41 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: pegelow@moorea.uni-muenster.de (Ulrich Pegelow)
+	* mbe.scm (hyg:tag-do): Scoping was wrong.  The region of binding
+	of a <variable> did not include the <step> expression and the
+	<test> expression, instead it incorrectly included the <init>
+	expression. (rf. R4RS, 4.2.4)
+	(hyg:tag-lambda): the body of a lambda expression should be
+	generated using hyg:tag-generic instead of hyg:tag-vanilla. This
+	allows expressions within lambda to behave hygienically.
+	(hyg:tag-let):  extended to support `named let'.
+
+Sun Apr 10 00:22:04 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* README: INSTALLATION INSTRUCTIONS greatly improved.
+	* Template.scm *.init:  Path configurations move to top of files
+	for easier installation.
+
+	* FAQ: File of Frequently Asked Questions and answers added.
+
+Sat Apr  9 21:28:46 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* slib.texi (Vicinity): scheme-file-suffix removed.  Use
+	slib:load or slib:load-source instead.
+
+Wed Apr  6 00:55:16 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* require.scm (slib:report):
+	(slib:report-version): 
+	(slib:report-locations):  added to display SLIB configuration
+	information.
+
+Mon Apr  4 08:48:37 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Template.scm *.init (slib:exit): added.
+
+Fri Apr  1 14:36:46 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Makefile (intro): Added idiot message for those who make.
+	Cleaned up and reorganized Makefile.
+
+Wed Mar 30 00:28:30 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Template.scm *.init ((slib:eval-load <pathname> evl)): created
+	to service all macro loads.
+
+	From: whumeniu@datap.ca (Wade Humeniuk)
+	* recobj.scm yasyn.scm: added.  These implement RECORDS and
+	YASOS using object.scm object system.
+
+Sun Mar  6 01:10:53 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: barnett@armadillo.urich.edu (Lewis Barnett)
+	* gambit.init (implementation-vicinity library-vicinity): Relative
+	pathnames for Slib in MacGambit.
+
+	From: lucier@math.purdue.edu (Brad Lucier)
+	* random.scm (random:random random:chunks/float): fixed off-by-one
+	and slop errors.
+
+Thu Mar  3 23:06:41 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: lutzeb@cs.tu-berlin.de (Dirk Lutzebaeck)
+	* format.scm slib.texi: Format 3.0.
+  * format's configuration is rearranged to fit only into SLIB. All
+    implementation dependent configurations are done in the SLIB init files
+  * format's output routines rely on call-with-output-string now if 
+    output to a string is desired
+  * The floating point formatting code (formatfl.scm) moved into
+    format.scm so that there is only one source code file; this
+    eliminates the configuration of the load path for the former
+    formatfl.scm and the unspecified scope of the load primitive
+  * floating point formatting doesn't use any floating point operation or
+    procedure except number->string now; all formatting is now based
+    solely on string, character and integer manipulations
+  * major rewrite of the floating point formatting code; use global
+    buffers now  
+  * ~f,~e,~g, ~$ may use also number strings as an argument
+  * ~r, ~:r, ~@r, ~:@r roman numeral, and ordinal and cardinal
+    English number printing added (from dorai@cs.rice.edu)
+  * ~a has now a working `colinc' parameter
+  * ~t tabulate directive implemented
+  * ~/ gives a tabulator character now (was ~T in version < 2.4)
+  * ~& fresh line directive implemented
+  * ~@d, ~@b, ~@o and ~@x now has the CL meaning (plus sign printed)
+    automatic prefixing of radix representation is removed
+  * ~i prints complex numbers as ~f~@fi with passed parameters
+  * ~:c prints control characters like emacs (eg. ^C) and 8bit characters
+    as an octal number
+  * ~q gives information and copyright notice on this format implementation
+    ~:q gives format:version 
+  * case type of symbol conversion can now be forced (see
+    format:symbol-case-conv in format.scm)
+  * case type of the representation of internal objects can now be
+    forced (see format:iobj-case-conv format.scm)
+  * format error messages are now printed on the current error port
+    if available by the implementation
+  * format now accepts a number as a destination port; the output
+    is then always directed to the current error port if available by
+    the implementation
+  * if format's destination is a string it is regarded as a format string now
+    and output is the current output port; this is a contribution to
+    Scheme->C to use format with the runtime system; the former semantics
+    to append tothe destination string is given up  
+  * obj->string syntax change and speedup
+  * tested with scm4d, Elk 2.2, MIT Scheme 7.1, Scheme->C 01Nov91
+
+
+Wed Mar  2 13:16:37 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: Matthias Blume <blume@cs.Princeton.EDU>
+	* vscm.init: added.
+
+Fri Feb 18 23:51:41 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: jjb@isye.gatech.edu (John Bartholdi)
+	* macscheme.init: added.
+
+Thu Feb 17 01:19:47 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* ppfile.scm ((pprint-filter-file inport filter outport)): added.
+	Useful for pre-expanding macros.  Preserves top-level comments.
+
+Wed Feb 16 12:44:34 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: dorai@cs.rice.edu (Dorai Sitaram)
+	* mbe.scm: Macro by Example define-syntax using	defmacro.
+
+Tue Feb 15 17:18:56 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: whumeniu@datap.ca (Wade Humeniuk)
+	* object.scm: Macroless Object System
+
+Mon Feb 14 00:48:18 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* defmacex.scm (defmacro:expand*): replaces "defmacro.scm".  Other
+	defmacro functions now supported in all implementations.
+
+Sun Feb 13 12:38:39 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* defmacro.scm (defmacro:macroexpand*): now expands quasiquotes
+	correctly.
+
+Sat Feb 12 21:23:56 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* hashtab.scm ((predicate->hash pred)): moved from hash.scm.
+
+Tue Feb  8 01:07:00 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* Template.scm *.init (slib:load-source slib:load-compiled
+	slib:load): support for loading compiled modules added.
+	Dependence on SCHEME-FILE-SUFFIX removed.
+
+	* require.scm (require:require): Added support for 'source and
+	'compiled features.
+
+Sat Feb  5 00:19:38 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* stdio.scm ((stdio:sprintf)): Now truncates printing if you run
+	out of string.
+
+Fri Feb  4 00:54:14 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	From: pk@kaulushaikara.cs.tut.fi (Kellom{ki Pertti)
+	* (psd/primitives.scm): Here is a patch removing some problems
+	with psd-1.1, especially when used with Scheme 48. Thanks to
+	Jonathan Rees for poiting them out. The patch fixes two problems:
+	references to an unused variable *psd-previous-line*, and the
+	correct number of arguments to write-char.
+
+Fri Jan 14 00:37:19 1994  Aubrey Jaffer  (jaffer@jacal)
+
+	* require.scm (require:require): Now supports (feature .
+	argument-list) associations.
+
+Sat Nov 13 22:07:54 1993    (jaffer at jacal)
+
+	* slib.info (Structures): added.  Bug - struct.scm and
+	structure.scm do not implement the same macros.
+
+Mon Nov  1 22:17:01 1993    (jaffer at jacal)
+
+	* array.scm (array-dimensions array-rank array-in-bounds?):
+	added.
+
+Sat Oct  9 11:54:54 1993    (jaffer at jacal)
+
+	* require.scm (*catalog* portable-scheme-debugger): support added
+	for psd subdirectory.
+
+Tue Sep 21 11:48:26 1993  Aubrey Jaffer  (jaffer at wbtree)
+
+	* Makefile (lineio.scm rbtree.scm rbtest.scm scmacro.scm
+	sc4sc3.scm scaespp.scm scaglob.scm scainit.scm scamacr.scm
+	scaoutp.scm strcase.scm): hyphens removed from names.
+
+Mon Sep 20 00:57:29 1993    (jaffer at jacal)
+
+	* arraymap.scm (array-map! array-for-each array-indexes): added.
+
+Sun Sep 19 19:20:49 1993    (jaffer at jacal)
+
+	* require.scm (require:feature->path require:require *catalog*):
+	associations of the form (symbol1 . symbol2) in *catalog* look up
+	symbol2 whenever symbol1 is specified.
+
+Mon Sep 13 22:12:00 1993    (jaffer at jacal)
+
+	From: sperber@provence.informatik.uni-tuebingen.de (Michael Sperber)
+	* elk.init: updated to ELK version 2.1.
+
+Sat Sep 11 21:17:45 1993    (jaffer at jacal)
+
+	* hashtab.scm (hash-for-each): fixed and documented (also
+	documented alist.scm).
+
+Fri Sep 10 15:57:50 1993    (jaffer at jacal)
+
+	* getopt.scm (getopt *optind* *optarg*): added.
+
+Tue Sep  7 23:57:40 1993    (jaffer at jacal)
+
+	* slib1d3 released.
+	* comlist.scm: prefixed all functions with "comlist:".
+
+Tue Aug 31 23:59:28 1993    (jaffer at jacal)
+
+	* Template.scm *.init (output-port-height): added.
+
+Wed May 26 00:00:51 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* hashtab.scm (hash-map hash-for-each): added.
+	* alist.scm (alist-map alist-for-each): added.
+
+Tue May 25 22:49:01 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* comlist.scm (delete delete-if atom): renamed as in common lisp.
+	* comlist.scm (delete-if-not): added.
+	* tree.scm: moved tree functions out of comlist.scm
+
+Mon May 24 10:28:22 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: hanche@ams.sunysb.edu (Harald Hanche-Olsen)
+	* modular.scm: improvements and fixed bug in modular:expt.
+
+Fri May 14 01:26:44 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* slib1d2 released.
+
+	From: Dave Love <d.love@daresbury.ac.uk>
+	* comlist.scm: added some tree functions.
+	* yasos.scm collect.scm: fixed name conflicts and documentation.
+
+Tue May 11 01:22:40 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* eval.scm: removed because all *.init files support it.
+
+	* hash.scm: made all hash functions case-insensitive.  Equal
+	inexact and exact numbers now hash to the same code.
+
+	From: eigenstr@falstaff.cs.rose-hulman.edu:
+	* slib.texi: revised.
+	
+Sun May  9 01:43:11 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: kend@newton.apple.com (Ken Dickey)
+	* macwork.scm mwexpand.scm mwdenote.scm mwsynrul.scm: Macros no
+	longer expand builtin Scheme forms.
+
+	From: William Clinger <will@skinner.cs.uoregon.edu>
+	* macwork.scm mwexpand.scm mwdenote.scm mwsynrul.scm: Macros that
+	work added.
+
+Sat May  1 23:55:42 1993  Aubrey Jaffer  (jaffer at montreux)
+
+	* random.scm (random:random): sped up for exact arguments.
+
+Wed Apr 28 00:24:36 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: lutzeb@flp.cs.tu-berlin.de (Dirk Lutzebaeck)
+	* format.scm formatfl.scm formatst.scm slib.texi: Format 2.3.
+   * implemented floating point support ~F,~E,~G,~$
+   * automatic detection if the scheme interpreter support flonums.
+   * the representation of internal objects can be selected to be
+     #<...> or #[...] or other forms
+   * new/redefintion of configuration variables format:abort,
+     format:floats, format:formatfl-path, format:iobj-pref, format:iobj-post
+   * added string-index
+   * added MIT Scheme 7.1 custom types
+   * for efficiencies reasons the error continuation is only used if
+     format:abort is not available
+   * improved error presentation and error handling
+   * tested with scm4b/c, Elk 2.0, MIT Scheme 7.1, Scheme->C 01Nov91,
+     UMB Scheme 2.5/2.10
+
+Sun Apr 25 22:40:45 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: Dave Love <d.love@daresbury.ac.uk>
+	* scheme2c.init: corrections and portability improvements.
+	* yasos.scm collect.scm:
+These correct the scheme2c.init and a couple of other things as well as
+hiding some non-exported definitions and removing an example from
+collect.scm to the manual.
+
+Sat Apr  3 00:48:13 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: eigenstr@cs.rose-hulman.edu (Todd R. Eigenschink)
+	* slib.texi: created.
+
+Thu Mar 25 01:47:38 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: hanche@ams.sunysb.edu (Harald Hanche-Olsen)
+	* sca-init.scm sca-glob.scm sca-macr.scm sca-outp.scm
+	sca-expp.scm: syntax-case macros added.
+
+Wed Mar 24 23:12:49 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* comlist.scm (some every notany notevery): Now accept multiple
+	arguments.  NOTANY added.
+
+Wed Mar  3 01:19:11 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: "Dan Friedman" <dfried@cs.indiana.edu>
+	* struct.scm structst.scm: added.
+
+Tue Mar  2 00:28:00 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* obj2str (object->string): now handles symbols and number without
+	going to string-port.
+
+Sun Feb 28 22:22:50 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* all files with Jaffer copyright: Now have explicit conditions
+	for use and copying.
+
+Fri Feb 26 00:29:18 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* obj2str: redefined in terms of string ports.
+
+	* pp2str: eliminated.
+
+Mon Feb 22 17:21:21 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: dorai@cs.rice.edu (Dorai Sitaram)
+	* strport.scm: string ports.
+
+	From: Alan@LCS.MIT.EDU (Alan Bawden)
+	* array.scm: functions which implement arrays.
+
+Wed Feb 17 00:18:57 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* repl.scm: split off from sc-macro.scm.
+
+	* eval.scm *.init Template.scm (eval!): eliminated.
+
+	From: dorai@cs.rice.edu (Dorai Sitaram)
+	* defmacro.scm: added.  Chez, elk, mitscheme, scheme2c, and scm
+	support.
+
+Tue Feb 16 00:23:07 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* require.doc (output-port-width current-error-port tmpnam
+	file-exists? delete-file force-output char-code-limit
+	most-positive-fixnum slib:tab slib:form-feed error):descriptions
+	added.
+
+	* *.init (tmpnam): now supported by all.
+
+	From: dorai@cs.rice.edu (Dorai Sitaram)
+	* chez.init elk.init mitscheme.init scheme2c.init (defmacro macro?
+	macro-expand): added.
+
+Mon Feb 15 00:51:22 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* Template.scm *.init (file-exists? delete-file): now defined for
+	all implementations.
+
+Sat Feb 13 23:40:22 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* chez.init (slib:error): output now directed to
+	(current-error-port).
+
+Thu Feb 11 01:23:25 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* withfile.scm (with-input-from-file with-output-from-file): now
+	close file on thunk return.
+
+	* *.init (current-error-port): added.
+
+Wed Feb 10 17:57:15 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* mitscheme.init (values dynamic-wind): added to *features*.
+
+	From: mafm@cs.uwa.edu.au (Matthew MCDONALD)
+	* mitcomp.pat: added patch file of definitions for compiling SLIB
+	with MitScheme.
+
+Tue Feb  9 10:49:12 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: jt@linus.mitre.org (F. Javier Thayer)
+	* t3.init: additions and corrections.
+
+Mon Feb  8 20:27:18 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: dorai@cs.rice.edu (Dorai Sitaram)
+	* chez.init: added.
+
+Wed Feb  3 23:33:49 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* sc-macro.scm (macro:repl): now prints error message for errors.
+
+Mon Feb  1 22:22:17 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* logical.scm (logor): changed to logior to be compatible with
+	common Lisp.
+
+Fri Jan 29 17:15:03 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: jt@linus.mitre.org (F. Javier Thayer)
+	* t3.init: modified so it passes most of SCM/test.scm.
+
+Sun Jan 24 00:18:13 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* comlist.scm (intersection): added.
+
+Wed Jan 13 19:01:11 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* debug.scm: (debug:qp): needed to shadow quotient.
+
+Sat Jan  9 13:44:44 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* rb-tree.scm: changed use of '() and NULL? to #f and NOT.
+
+	* rb-tree.scm (rb-insert! rb-delete!) added ! to names.
+
+Fri Jan  8 01:17:16 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	* rb-tree.doc: added.
+
+	From: pgs@ai.mit.edu (Patrick Sobalvarro)
+	* rb-tree.scm rbt-test.scm: code for red-black trees added.
+
+Tue Jan  5 14:57:02 1993  Aubrey Jaffer  (jaffer at camelot)
+
+	From: lutzeb@cs.tu-berlin.de (Dirk Lutzebaeck)
+	* format.scm formatst.scm format.doc: version 2.2
+   * corrected truncation for fixed fields by negative field parameters
+     inserted a '<' or a '>' when field length was equal to object string
+     length
+   * changed #[...] outputs to #<...> outputs to be conform to SCM's
+     display and write functions
+   * changed #[non-printable-object] output to #<unspecified>
+   * ~:s and ~:a print #<...> messages in strings "#<...>" so that the
+     output can always be processed by (read)
+   * changed implementation dependent part: to configure for various scheme
+     systems define the variable format:scheme-system
+   * format:version is a variable returning the format version in a string
+   * format:custom-types allows to use scheme system dependent predicates
+     to identify the type of a scheme object and its proper textual
+     representation
+   * tested with scm4a14, Elk 2.0
+
+Tue Dec 22 17:36:23 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* Template.scm *.init (char-code-limit): added.
+
+	* debug.scm (qp): qp-string had bug when printing short strings
+	when room was less than 3.
+
+	* random.scm (random:size-int): now takes most-positive-fixnum
+	into account.
+
+Wed Nov 18 22:59:34 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	From: hanche@ams.sunysb.edu (Harald Hanche-Olsen)
+	* randinex.scm (random:normal-vector! random:normal
+	random:solid-sphere random:hollow-sphere): new versions fix bug.
+
+Tue Nov 17 14:00:15 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* str-case.scm (string-upcase string-downcase string-capitalize
+	string-upcase! string-downcase! string-capitalize!): moved from
+	format.scm.
+
+Fri Nov  6 01:09:38 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* require.scm (require): uses base:load instead of load.
+
+	* sc-macro.scm (macro:repl): now uses dynamic-wind.
+
+Mon Oct 26 13:21:04 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* comlist.scm (nthcdr last) added.
+
+Sun Oct 25 01:50:07 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* line-io.scm: created
+
+Mon Oct 19 12:53:01 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	From: dorai@cs.rice.edu
+	* fluidlet.scm: FLUID-LET that works.
+
+Thu Oct  8 22:17:01 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	From: Robert Goldman <rpg@rex.cs.tulane.edu>
+	* mitscheme.init: improvements.
+
+Sun Oct  4 11:37:57 1992  Aubrey Jaffer  (jaffer at camelot)
+
+	* values.scm values.doc: Documentation rewritten and combined
+	into values.scm
+
+Thu Oct  1 23:29:43 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sc-macro.scm sc-macro.doc: documentation improved and moved into
+	sc-macro.doc.
+
+Mon Sep 21 12:07:13 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sc-macro.scm (macro:load): now sets and restores *load-pathname*.
+
+	* eval.scm (slib:eval!): (program-vicinity) now correct during
+	evaluation.
+
+	* Template.scm, *.init: i/o-redirection changed to with-file.
+	*features* documentation changed.
+
+	From: Stephen J Bevan <bevan@computer-science.manchester.ac.uk>
+	* t3.init: new.  Fixes problems with require, substring, and
+	<,>,<=,>= with more than 2 arguments.
+
+Fri Sep 18 00:10:57 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	From andrew@astro.psu.edu Wed Sep 16 17:58:21 1992
+	* dynamic.scm: added.
+
+	From raible@nas.nasa.gov Thu Sep 17 22:28:25 1992
+	* fluidlet.scm: added.
+
+Sun Sep 13 23:08:46 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* sc-macro.scm (macro:repl): moved (require 'debug) into syntax-error.
+
+	* dynwind.scm, withfile.scm, trnscrpt.scm: created.
+
+	From kend@data.rain.com Sun Sep 13 21:26:59 1992
+	* collect.scm: created.
+	* oop.scm => yasos.scm: updated.
+	* oop.doc: removed.
+
+	From: Stephen J. Bevan <bevan@cs.man.ac.uk> 19920912
+	* elk.init: created
+
+Tue Jul 14 11:42:57 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* tek41.scm tek40.scm: added.
+
+Tue Jul  7 00:55:58 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* record.scm record.doc (record-sub-predicate): added.
+
+	* sc-macro.scm (macro:repl): syntax-errors now return into
+	macro:repl.
+
+	* debug.scm (qp): removed (newline).  Added qpn (qp with newline).
+
+Sun Jun 14 22:57:32 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* slib1b8 released.
+
+Sat Jun 13 17:01:41 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* alist.scm ppfile.scm: added.
+
+	* hash.scm hashtab.scm scheme48.init: added.
+
+	* sc-macro.scm (macro:repl): created.  macro:load now uses
+	eval:eval!. 
+
+	* eval.scm (eval:eval!) created and eval done in terms of it.
+
+	* prime.scm (prime:prime?) fixed misplaced parenthesis.
+
+Wed May 27 16:13:17 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	From: "Chris Hanson" <cph@martigny.ai.mit.edu>
+	* synrul.scm (generate-match): fixed for CASE syntax.
+
+Wed May 20 00:25:40 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* slib1b6 released.
+
+	* Template.scm gambit.init mitscheme.init scheme2c.init:
+	rearranged *features*.
+
+Tue May 19 22:51:28 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* scmactst.scm: test cases fixed.
+
+	From: "Chris Hanson" <cph@martigny.ai.mit.edu>
+	* r4syn.scm (make-r4rs-primitive-macrology):  TRANSFORMER added
+	back in.
+
+	* require.scm (load): load now passes through additional
+	arguments to *old-load*.
+
+Mon May 18 00:59:36 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* mulapply.scm (apply): written.
+
+	* record.scm record.doc (make-record-sub-type): added.
+
+Fri May  8 17:55:14 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* process.scm: created, but not finished.
+
+	From: hugh@ear.mit.edu (Hugh Secker-Walker)
+	* comlist.scm (nreverse make-list): non-recursive versions added.
+
+	* sc2.scm (1+ -1+): versions which capture +.
+
+	* mularg.scm (- /): created.
+
+Wed Apr  8 00:05:30 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* require.scm sc-macro.scm (catalog): Now uses macro:load if
+	'macro is part of catalog entry.
+
+	From: Andrew Wilcox (awilcox@astro.psu.edu)
+	* queue.scm: created.
+
+Sun Mar 15 12:23:06 1992  Aubrey Jaffer  (jaffer at Ivan)
+
+	* comlist.scm (notevery): fixed.  Now (not (every ..)).
+
+	* eval.scm (eval:eval): renamed to slib:eval.
+
+	* record.scm: replaced with version from From: david carlton
+	<carlton@husc.harvard.edu>.  I changed updater => modifier, put
+	record-predicate into the rtd, and bummed code mercilessly.
+
+	From: plogan@std.mentor.com (Patrick Logan)
+	* sc3.scm (last-pair): changed from testing null? to pair?.
diff --git a/FAQ b/FAQ
new file mode 100644
index 0000000..3b4d812
--- /dev/null
+++ b/FAQ
@@ -0,0 +1,216 @@
+FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib2a6).
+Written by Aubrey Jaffer (jaffer@ai.mit.edu).
+
+		INTRODUCTION AND GENERAL INFORMATION
+
+[]	What is SLIB?
+
+SLIB is a portable scheme library meant to provide compatibiliy and
+utility functions for all standard scheme implementations.
+
+[]	What is Scheme?
+
+Scheme is a programming language in the Lisp family.
+
+[]	Which implementations has SLIB been ported to?
+
+SLIB is currently supported by Chez, ELK 2.1, GAMBIT, MacScheme,
+MITScheme, scheme->C, Scheme48, T3.1, SCM and VSCM
+
+[]	How can I get SLIB?
+
+SLIB is available via ftp from:
+ ftp-swiss.ai.mit.edu:pub/scm/slib2a6.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib2a6.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2a6.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2a6.tar.gz
+
+SLIB is also included with SCM floppy disks.
+
+[]	How do I install SLIB?
+
+Read the INSTALLATION INSTRUCTIONS in "slib/README".
+
+[]	What are slib.texi and slib.info?
+
+"slib.texi" is the `texinfo' format documentation for SLIB.
+"slib.info" is produced from "slib.texi" by either Gnu Emacs or the
+program `makeinfo'.  "slib.info" can be viewed using either Gnu Emacs
+or `info' or a text editor.
+
+Programs for printing and viewing TexInfo documentation (which SLIB
+has) come with GNU Emacs or can be obtained via ftp from:
+prep.ai.mit.edu:pub/gnu/texinfo-3.1.tar.gz
+
+[]	How often is SLIB released?
+
+SLIB was released 9 times in 1993.
+
+[]	What is the latest version?
+
+The version as of this writing is slib2a6.
+
+[]	What version am I using?
+
+The Version is in the first line of the files slib/FAQ, slib/ANNOUNCE,
+and slib/README.  If you have Scheme and SLIB running, type
+(slib:report-version)
+
+		SLIB INSTALLATION PROBLEMS
+
+[]	When I load an SLIB initialization file for my Scheme
+	implementation, I get ERROR: Couldn't find "require.scm"
+
+Did you remember to set either the environment variable
+SCHEME_LIBRARY_PATH or the library-vicinity in your initialization
+file to the correct location?  Make sure if you set only the
+environment variable SCHEME_LIBRARY_PATH that your implementation
+supports getenv.
+
+[]	When I load an SLIB initialization file for my Scheme
+	implementation, I get ERROR: Couldn't find
+	"/usr/local/lib/slibrequire.scm"
+
+Notice that it is looking for "slibrequire.scm" rather than
+"slib/require.scm".  You need to put a trailing slash on either the
+environment variable SCHEME_LIBRARY_PATH or in the library-vicinity in
+your initialization file.
+
+[]	SLIB used to work, but now I get ERROR: Couldn't find
+	"slib/require.scm".  What happened?
+
+You changed directories and now the relative pathname
+"slib/require.scm" no longer refers to the same directory.  The
+environment variable SCHEME_LIBRARY_PATH and library-vicinity in your
+initialization file should be absolute pathnames.
+
+[]	When I type (require 'macro) I get "ERROR: unbound variable:
+	require".
+
+You need to arrange to have your Scheme implementation load the
+appropriate SLIB initialization file ("foo.init") before using SLIB.
+If your implementation loads an initialization file on startup, you
+can have it load the SLIB initialization file automatically.  For
+example (load "/usr/local/lib/slib/foo.init").
+
+[]	Why do I get a string-ref (or other) error when I try to load
+	or use SLIB.
+
+Check that the version of the Scheme implementation you are using
+matches the version for which the SLIB initialization file was
+written.  There are some notes in the SLIB initialization files about
+earlier versions.  You may need to get a more recent version of your
+Scheme implementation.
+
+		USING SLIB PROCEDURES
+
+[]	I installed SLIB.  When I type (random 5) I get "ERROR:
+	unbound variable:  random".  Doesn't SLIB have a `random'
+	function?
+
+Before you can use most SLIB functions, the associated module needs to
+be loaded.  You do this by typing the line that appears at the top of
+the page in slib.info (or slib.texi) where the function is documented.
+In the case of random, the line is (require 'random).
+
+[]	Why doesn't SLIB just load all the functions so I don't have
+	to type require statements?
+
+SLIB currently has more than 1 Megabyte of Scheme source code.  Many
+scheme implementations take unacceptably long to load 1 Megabyte of
+source; some implementations cannot allocate enough storage.  If you
+use a package often, you can put the require statement in your Scheme
+initialization file.  Consult the manual for your Scheme
+implementation to find out the initialization file's name.
+
+`Autoloads' will work with many Scheme implementations.  You could put
+the following in your initialization file:
+ (define (random . args) (require 'random) (apply random args))
+
+I find that I only type require statements at top level when
+debugging.  I put require statements in my Scheme files so that the
+appropriate modules are loaded automatically.
+
+[]	Why does SLIB have PRINTF when it already has the more
+	powerful (CommonLisp) FORMAT?
+
+CommonLisp FORMAT does not support essential features which PRINTF
+does.  For instance, how do you format a signed 0 extended number?
+
+  (format t "~8,'0,X~%" -3)	==>	000000-3
+
+But printf gets it right:
+
+  (printf "%08x\n" -3)		==>	-0000003
+
+How can one trunctate a non-numeric field using FORMAT?  This feature
+is essential for printing reports.  The first 20 letters of a name is
+sufficient to identify it.  But if that name doesn't get trucated to
+the desired length it can displace other fields off the page.  Once
+again, printf gets it right:
+
+  (printf "%.20s\n" "the quick brown fox jumped over the lazy dog")
+				==>	the quick brown fox 
+
+FORMAT also lacks directives for formatting date and time.  printf
+does not handle these directly, but a related function strftime does.
+
+[]	Why doesn't SLIB:ERROR call FORMAT?
+
+Format does not provide a method to truncate fields.  When an error
+message contains non-terminating or large expressions, the essential
+information of the message may be lost in the ensuing deluge.
+
+FORMAT as currently written in SLIB is not reentrant.  Until this is
+fixed exception handlers and errors which might occur while using
+FORMAT cannot use it.
+
+		MACROS
+
+[]	Why are there so many macro implementations in SLIB?
+
+The R4RS committee specified only the high level pattern language in
+the Revised^4 Report on Scheme and left to the free marketplace of
+ideas the details of the low-level facility.  Each macro package has a
+different low-level facility.  The low-level facilities are sometimes
+needed because the high level pattern language is insufficiently
+powerful to accomplish tasks macros are often written to do.
+
+[]	Why are there both R4RS macros and Common-Lisp style defmacros
+	in SLIB?
+
+Most current Scheme implementations predate the adoption of the R4RS
+macro specification.  It turns out that all of the implementations
+can support defmacro natively.
+
+[]	I did (LOAD "slib/yasos.scm").  The error I get is "variable
+	define-syntax is undefined".
+
+The way to load the struct macro package is (REQUIRE 'YASOS).
+
+[]	I did (REQUIRE 'YASOS).  Now when I type (DEFINE-PREDICATE
+	CELL?)  The error I get is "variable define-predicate is
+	undefined".
+
+If like most implementations, your Scheme does not natively support
+R4RS macros you will need to install a macro-capable read-eval-print
+loop.  This is done by:
+ (require 'macro)	;already done if you did (require 'yasos)
+ (require 'repl)
+ (repl:top-level macro:eval)
+
+This is also true for Schemes which don't support DEFMACRO.  The lines
+in this case are:
+ (require 'repl)
+ (repl:top-level defmacro:eval)
+
+[]	I always use R4RS macros.  How can I avoid having to type
+	require statements every time I start Scheme?
+
+As is explained in the Repl entry in slib.info (or slib.texi):
+
+ To have your top level loop always use macros, add any interrupt
+ catching lines and the following lines to your Scheme init file:
+  (require 'macro)
+  (require 'repl)
+  (repl:top-level macro:eval)
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..a2b8de7
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,229 @@
+# Makefile for Scheme Library
+# Copyright (C) 1991, 1992, 1993, 1994, 1995 Aubrey Jaffer.
+
+SHELL = /bin/sh
+intro:
+	@echo
+	@echo "Welcome to SLIB.  Read \"README\" and \"slib.info\" (or"
+	@echo "\"slib.texi\") to learn how to install and use SLIB."
+	@echo
+	@echo
+	-make slib.info
+
+srcdir=$(HOME)/slib/
+dvidir=../dvi/
+dvi:	$(dvidir)slib.dvi
+$(dvidir)slib.dvi:	$(srcdir)slib.texi $(dvidir)slib.fn
+#	cd $(dvidir);texi2dvi $(srcdir)slib.texi
+	-(cd $(dvidir);texindex slib.??)
+	cd $(dvidir);tex $(srcdir)slib.texi
+$(dvidir)slib.fn:
+	cd $(dvidir);tex $(srcdir)slib.texi
+xdvi:	$(dvidir)slib.dvi
+	xdvi $(dvidir)slib.dvi
+
+prefix = /usr/local
+exec_prefix = $(prefix)
+bindir = $(exec_prefix)/bin
+libdir = $(exec_prefix)/lib
+infodir = $(exec_prefix)/info
+RUNNABLE = scheme48
+LIB = $(libdir)/$(RUNNABLE)
+VM = scheme48vm
+IMAGE = slib.image
+
+slib48:
+	(echo ,load `pwd`/scheme48.init; \
+	 echo "(define *args* '())"; \
+	 echo "(define (program-arguments) (cons \"$(VM)\" *args*))"; \
+	 echo ,dump $(LIB)/$(IMAGE); \
+	 echo ,exit) | scheme48
+	(echo '#!/bin/sh'; \
+	 echo exec '$(LIB)/$(VM)' -i '$(LIB)/$(IMAGE)' \"\$$\@\") \
+	  > $(bindir)/slib48
+	chmod +x $(bindir)/slib48
+
+info:	$(infodir)/slib.info
+	-make schelog-info
+$(infodir)/slib.info:	slib.texi
+	makeinfo slib.texi -o $(infodir)/slib.info
+
+infoz:	$(infodir)/slib.info.gz
+	-make schelog-infoz
+$(infodir)/slib.info.gz:	$(infodir)/slib.info
+	-rm $(infodir)/slib.info*.gz
+	gzip $(infodir)/slib.info*
+
+#### Stuff for maintaining SLIB below ####
+
+VERSION = 2a6
+ver = $(VERSION)
+ffiles = printf.scm format.scm genwrite.scm obj2str.scm pp.scm \
+	ppfile.scm strcase.scm debug.scm trace.scm lineio.scm \
+	strport.scm scanf.scm chap.scm qp.scm break.scm stdio.scm \
+	strsrch.scm
+lfiles = sort.scm comlist.scm tree.scm logical.scm random.scm tsort.scm
+revfiles = sc4opt.scm sc4sc3.scm sc2.scm mularg.scm mulapply.scm \
+	trnscrpt.scm withfile.scm dynwind.scm promise.scm values.scm
+afiles = ratize.scm randinex.scm modular.scm primes.scm factor.scm \
+	 charplot.scm time.scm cltime.scm root.scm
+bfiles = collect.scm fluidlet.scm struct.scm \
+	object.scm recobj.scm yasyn.scm
+#	yasos.scm
+scfiles = r4rsyn.scm scmacro.scm synclo.scm synrul.scm synchk.scm \
+	repl.scm macwork.scm mwexpand.scm mwdenote.scm mwsynrul.scm
+scafiles = scainit.scm scaglob.scm scamacr.scm scaoutp.scm scaexpp.scm \
+	structure.scm
+dfiles = defmacex.scm mbe.scm
+efiles = record.scm dynamic.scm queue.scm process.scm \
+	priorque.scm hash.scm hashtab.scm alist.scm \
+	wttree.scm wttest.scm array.scm arraymap.scm \
+	sierpinski.scm soundex.scm
+rfiles = rdms.scm alistab.scm dbutil.scm paramlst.scm report.scm \
+	batch.scm makcrc.scm dbrowse.scm comparse.scm getopt.scm
+gfiles = tek40.scm tek41.scm
+docfiles = ANNOUNCE README FAQ ChangeLog slib.texi
+mfiles = Makefile require.scm Template.scm
+ifiles = chez.init elk.init macscheme.init \
+	mitscheme.init scheme2c.init scheme48.init gambit.init t3.init \
+	vscm.init mitcomp.pat syncase.sh
+tfiles = plottest.scm formatst.scm macrotst.scm scmactst.scm \
+	dwindtst.scm structst.scm
+sfiles = $(ffiles) $(lfiles) $(revfiles) $(afiles) $(scfiles) $(efiles) \
+	$(rfiles) $(gfiles) $(scafiles) $(dfiles)
+allfiles = $(docfiles) $(mfiles) $(ifiles) $(sfiles) $(tfiles) $(bfiles)
+
+makedev = make -f $(HOME)/makefile.dev
+CHPAT=$(HOME)/bin/chpat
+dest = $(HOME)/dist/
+temp/slib:	$(allfiles)
+	-rm -rf temp
+	mkdir temp
+	mkdir temp/slib
+	ln  $(allfiles) temp/slib
+
+infotemp/slib:	slib.info
+	-rm -rf infotemp
+	mkdir infotemp
+	mkdir infotemp/slib
+	ln slib.info slib.info-* infotemp/slib
+
+distinfo:	$(dest)slib.info.tar.gz
+$(dest)slib.info.tar.gz:	infotemp/slib
+	$(makedev) TEMP=infotemp/ DEST=$(dest) PROD=slib ver=.info tar.gz
+	rm -rf infotemp
+
+dist:	$(dest)slib$(VERSION).tar.gz
+$(dest)slib$(VERSION).tar.gz:	temp/slib
+	$(makedev) DEST=$(dest) PROD=slib ver=$(VERSION) tar.gz
+shar:	slib.shar
+slib.shar:	temp/slib
+	$(makedev) PROD=slib shar
+dclshar:	slib.com
+com:	slib.com
+slib.com:	temp/slib
+	$(makedev) PROD=slib com
+zip:	slib.zip
+slib.zip:	temp/slib
+	$(makedev) PROD=slib zip
+distzip:	slib$(VERSION).zip
+slib$(VERSION).zip:	temp/slib
+	$(makedev) DEST=$(dest) PROD=slib ver=$(VERSION) zip
+	mv $(dest)slib$(VERSION).zip /c/scm/dist/
+pubzip:	temp/slib
+	$(makedev) DEST=$(HOME)/pub/ PROD=slib zip
+
+diffs:	pubdiffs
+pubdiffs:	temp/slib
+	$(makedev) DEST=$(HOME)/pub/ PROD=slib pubdiffs
+distdiffs:	temp/slib
+	$(makedev) DEST=$(dest) PROD=slib ver=$(ver) distdiffs
+announcediffs:	temp/slib
+	$(makedev) DEST=$(dest) PROD=slib ver=2a1 announcediffs
+
+psdfiles=COPYING.psd README.psd cmuscheme.el comint.el instrum.scm pexpr.scm \
+	primitives.scm psd-slib.scm psd.el read.scm runtime.scm version.scm
+psdocfiles=article.bbl article.tex manual.bbl manual.tex quick-intro.tex
+
+psdtemp/slib:
+	-rm -rf psdtemp
+	mkdir psdtemp
+	mkdir psdtemp/slib
+	mkdir psdtemp/slib/psd
+	cd psd; ln $(psdfiles) ../psdtemp/slib/psd
+	mkdir psdtemp/slib/psd/doc
+	cd psd/doc; ln $(psdocfiles) ../../psdtemp/slib/psd/doc
+
+psdist:	$(dest)slib-psd.tar.gz
+$(dest)slib-psd.tar.gz:	psdtemp/slib
+	$(makedev) DEST=$(dest) PROD=slib ver=-psd tar.gz TEMP=psdtemp/
+
+schelogfiles = copying schelog.doc schelog.scm schelog.texi
+schelogexamples = bible.scm england2.scm holland.scm mapcol.scm \
+	schelogt.scm england.scm games.scm houses.scm puzzle.scm \
+	toys.scm
+
+schelogtemp/slib:
+	-rm -rf schelogtemp
+	mkdir schelogtemp
+	mkdir schelogtemp/slib
+	mkdir schelogtemp/slib/schelog
+	cd schelog; ln $(schelogfiles) ../schelogtemp/slib/schelog
+	mkdir schelogtemp/slib/schelog/examples
+	cd schelog/examples; ln $(schelogexamples) \
+	../../schelogtemp/slib/schelog/examples
+
+schelogdist:	schelog-dist
+schelog-dist:	$(dest)slib-schelog.tar.gz
+$(dest)slib-schelog.tar.gz:	schelogtemp/slib
+	$(makedev) DEST=$(dest) PROD=slib ver=-schelog tar.gz TEMP=schelogtemp/
+
+schelog-info:	$(infodir)/schelog.info
+$(infodir)/schelog.info:	schelog/schelog.texi
+	makeinfo schelog/schelog.texi -o $(infodir)/schelog.info
+
+schelog-infoz:	$(infodir)/schelog.info.gz
+$(infodir)/schelog.info.gz:	$(infodir)/schelog.info
+	-rm $(infodir)/schelog.info*.gz
+	gzip $(infodir)/schelog.info*
+
+schelog.dvi:	$(dvidir)schelog.dvi
+$(dvidir)schelog.dvi:	$(srcdir)schelog/schelog.texi $(dvidir)schelog.fn
+#	cd $(dvidir);texi2dvi $(srcdir)schelog/schelog.texi
+	-(cd $(dvidir);texindex schelog.??)
+	cd $(dvidir);tex $(srcdir)schelog/schelog.texi
+$(dvidir)schelog.fn:
+	cd $(dvidir);tex $(srcdir)schelog/schelog.texi
+schelog-xdvi:	$(dvidir)schelog.dvi
+	xdvi $(dvidir)schelog.dvi
+
+new:
+	$(CHPAT) slib$(VERSION) slib$(ver) ANNOUNCE FAQ ../scm/ANNOUNCE \
+		../jacal/ANNOUNCE ../wb/README ../wb/ANNOUNCE \
+		/c/scm/dist/install.bat /c/scm/dist/makefile \
+		../public_html/README.html ../dist/README \
+		../public_html/SLIB.html ../public_html/JACAL.html \
+		../public_html/SCM.html ../public_html/Hobbit.html \
+		/c/scm/dist/mkdisk.bat \
+		../scm/README ../scm/scm.texi
+	$(CHPAT) $(VERSION) $(ver) README slib.texi require.scm Makefile
+
+tagfiles = slib.texi $(mfiles) $(sfiles) $(bfiles) $(tfiles)
+# README and $(ifiles) cause semgentation faults in ETAGS for Emacs version 19.
+tags:	$(tagfiles)
+	etags $(tagfiles)
+test:	$(sfiles)
+	scheme Template.scm $(sfiles)
+rights:
+	scm -ladmin -e"(admin:check-all)" $(sfiles) $(tfiles) \
+		$(bfiles) $(ifiles)
+clean:
+	-rm -f *~ *.bak *.orig *.rej core a.out *.o \#*
+	-rm -rf *temp
+distclean:	realclean
+realclean:
+	-rm -f *~ *.bak *.orig *.rej TAGS core a.out *.o \#*
+	-rm -f slib.info* slib.?? slib.???
+	-rm -rf *temp
+realempty:	temp/slib
+	-rm -f $(allfiles)
diff --git a/README b/README
new file mode 100644
index 0000000..35f7448
--- /dev/null
+++ b/README
@@ -0,0 +1,220 @@
+This directory contains the distribution of Scheme Library slib2a3.
+Slib conforms to Revised^4 Report on the Algorithmic Language Scheme
+and the IEEE P1178 specification.  Slib supports Unix and similar
+systems, VMS, and MS-DOS.
+
+The maintainer can be reached at jaffer@ai.mit.edu.
+
+			       MANIFEST
+
+  `README' is this file.  It contains a MANIFEST, INSTALLATION
+	INSTRUCTIONS, and proposed coding standards.
+  `FAQ' Frequently Asked Questions and answers.
+  `ChangeLog' documents changes to slib.
+  `slib.texi' has documentation on library packages in TexInfo format.
+
+  `Template.scm' Example configuration file.  Copy and customize to
+	reflect your system.
+  `chez.init' is a configuration file for Chez Scheme.
+  `elk.init' is a configuration file for ELK 2.1
+  `gambit.init' is a configuration file for Gambit Scheme.
+  `macscheme.init' is a configuration file for MacScheme.
+  `mitscheme.init' is a configuration file for MIT Scheme.
+  `mitcomp.pat' is a patch file which adds definitions to SLIB files
+	for the MitScheme compiler.
+  `scheme2c.init' is a configuration file for DEC's scheme->c.
+  `scheme48.init' is a configuration file for Scheme48.
+  `t3.init' is a configuration file for T3.1 in Scheme mode.
+  `vscm.init' is a configuration file for VSCM.
+  `require.scm' has code which allows system independent access to
+	the library files.
+
+  `format.scm' has Common-Lisp style format.
+  `formatst.scm' has code to test format.scm
+  `pp.scm' has pretty-print.
+  `ppfile.scm' has pprint-file and pprint-filter-file.
+  `obj2str.scm' has object->string.
+  `strcase.scm' has functions for manipulating the case of strings.
+  `genwrite.scm' has a generic-write which is used by pp.scm,
+	pp2str.scm and obj2str.scm
+  `printf.scm' has printf, fprintf, and sprintf compatible with C.
+  `scanf.scm' has scanf, fscanf, and sscanf compatible by C.
+  `lineio' has line oriented input/output functions.
+  `qp.scm' has printer safe for circular structures.
+  `break.scm' has break and continue.
+  `trace.scm' has trace and untrace for tracing function execution.
+  `debug.scm' has handy higher level debugging aids.
+  `strport.scm' has routines for string-ports.
+  `strsrch.scm' search for chars or substrings in strings and ports.
+
+  `alist.scm' has functions accessing and modifying association lists.
+  `hash.scm' defines hash, hashq, and hashv.
+  `hashtab.scm' has hash tables.
+  `sierpinski.scm' 2-dimensional coordinate hash.
+  `soundex.scm' English name hash.
+  `logical.scm' emulates 2's complement logical operations.
+  `random.scm' has random number generator compatible with Common Lisp.
+  `randinex.scm' has inexact real number distributions.
+  `primes.scm' has primes and probably-prime?.
+  `factor.scm' has factor.
+  `root.scm' has Newton's and Laguerre's methods for finding roots.
+  `charplot.scm' has procedure for plotting on character screens.
+  `plottest.scm' has code to test charplot.scm.
+  `tek40.scm' has routines for Tektronix 4000 series graphics.
+  `tek41.scm' has routines for Tektronix 4100 series graphics.
+  `getopt.scm' has posix-like getopt for parsing command line arguments. 
+  `time.scm' has Posix time conversion routines.
+  `cltime.scm' has Common-Lisp time conversion routines.
+  `comparse.scm' has shell-like command parsing.
+
+  `rdms.scm' has code to construct a relational database from a base
+	table implementation.
+  `alistab.scm' has association list base tables.
+  `dbutil.scm' has utilities for creating and manipulating relational
+	databases.
+  `dbrowse.scm' browses relational databases.
+  `paramlst.scm' has procedures for passing parameters by name.
+  `report.scm' prints database reports.
+  `batch.scm' Group and execute commands on various operating systems.
+  `makcrc.scm' Create Scheme procedure to calculate POSIX.2 checksums
+	or other CRCs.
+
+  `record.scm' a MITScheme user-definable datatypes package
+  `promise.scm' has code from R4RS for supporting DELAY and FORCE.
+
+  `repl.scm' has a read-eval-print-loop.
+  `defmacex.scm' has defmacro:expand*.
+  `mbe.scm' has "Macro by Example" define-syntax.
+  `scmacro.scm' is a syntactic closure R4RS macro package.
+	r4rsyn.scm, synclo.scm, synrul.scm have syntax definitions
+	and support.
+  `scmactst.scm' is code for testing SYNTACTIC CLOSURE macros.
+  `scainit.scm' is a syntax-case R4RS macro package.
+	scaglob.scm scamacr.scm scaoutp.scm scaexpp.scm have
+	syntax definitions and support.  `syncase.sh' is a shell
+	script for producing the SLIB version from the original.
+  `macwork.scm' is a "Macros that work" package.
+	mwexpand.scm mwdenote.scm mwsynrul.scm have support.
+  `macrotst.scm' is code from R4RS for testing macros.
+
+  `values.scm' is multiple values.
+  `queue.scm' has queues and stacks.
+
+  `object.scm' is object oriented programming (using no macros).
+  `recobj.scm' is records implemented using object.scm.
+  `yasyn.scm' is a macro package implementing YASOS using object.scm.
+
+  `yasos.scm' is object oriented programming (using R4RS macros).
+  `collect.scm' is collection operators (like CL sequences).
+  `priorque.scm' has code and documentation for priority queues.
+  `wttree.scm' has weight-balanced trees.
+  `wttest.scm' tests weight-balanced trees.
+  `process.scm' has multi-processing primitives.
+  `array.scm' has multi-dimensional arrays and sub-arrays.
+  `arraymap.scm' has array-map!, array-for-each, and array-indexes.
+
+  `sort.scm' has sorted?, sort, sort!, merge, and merge!.
+  `tsort.scm' has topological-sort.
+  `comlist.scm' has many common list and mapping procedures.
+  `tree.scm' has functions dealing with trees.
+  `chap.scm' has functions which compare and create strings in
+	"chapter order".
+
+  `sc4opt.scm' has optional rev4 procedures.
+  `sc4sc3.scm' has procedures to make a rev3 implementation run rev4
+	code. 
+  `sc2.scm' has rev2 procedures eliminated in subsequent versions.
+  `mularg.scm' redefines - and / to take more than 2 arguments.
+  `mulapply.scm' redefines apply to take more than 2 arguments.
+  `ratize.scm' has function rationalize from Revised^4 spec.
+  `trnscrpt.scm' has transcript-on and transcript-off from Revised^4 spec.
+  `withfile.scm' has with-input-from-file and with-output-to-file from R4RS.
+  `dynwind.scm' has proposed dynamic-wind from R5RS.
+  `dwindtst.scm' has routines for characterizing dynamic-wind.
+  `dynamic.scm' has proposed DYNAMIC data type.
+  `fluidlet.scm' has fluid-let syntax.
+  `struct.scm' has defmacros which implement RECORDS from the book:
+	"Essentials of Programming Languages".
+  `structure.scm' has syntax-case macros for the same.
+  `structst.scm' has test code for struct.scm.
+
+		      INSTALLATION INSTRUCTIONS
+
+  Check the manifest in `README' to find a configuration file for your
+Scheme implementation.  Initialization files for most IEEE P1178
+compliant Scheme Implementations are included with this distribution.
+
+  If the Scheme implementation supports `getenv', then the value of the
+shell environment variable SCHEME_LIBRARY_PATH will be used for
+`(library-vicinity)' if it is defined.  Currently, Chez, Elk,
+MITScheme, scheme->c, VSCM, and SCM support `getenv'.
+
+  You should check the definitions of `software-type',
+`scheme-implementation-version', `implementation-vicinity', and
+`library-vicinity' in the initialization file.  There are comments in
+the file for how to configure it.
+
+  Once this is done you can modify the startup file for your Scheme
+implementation to `load' this initialization file.  SLIB is then
+installed.
+
+  Multiple implementations of Scheme can all use the same SLIB
+directory. Simply configure each implementation's initialization file
+as outlined above.
+
+  The SCM implementation does not require any initialization file as
+SLIB support is already built in to SCM.  See the documentation with
+SCM for installation instructions.
+
+  SLIB includes methods to create heap images for the VSCM and Scheme48
+implementations.  The instructions for creating a VSCM image are in
+comments in `vscm.init'.  To make a Scheme48 image, `cd' to the SLIB
+directory and type `make slib48'.  This will also create a shell script
+with the name `slib48' which will invoke the saved image.
+
+			 PORTING INSTRUCTIONS
+
+  If there is no initialization file for your Scheme implementation, you
+will have to create one.  Your Scheme implementation must be largely
+compliant with `IEEE Std 1178-1990' or `Revised^4 Report on the
+Algorithmic Language Scheme' to support SLIB.
+
+  `Template.scm' is an example configuration file.  The comments inside
+will direct you on how to customize it to reflect your system. Give
+your new initialization file the implementation's name with `.init'
+appended.  For instance, if you were porting `foo-scheme' then the
+initialization file might be called `foo.init'.
+
+  Your customized version should then be loaded as part of your scheme
+implementation's initialization.  It will load `require.scm' from the
+library; this will allow the use of `provide', `provided?', and
+`require' along with the "vicinity" functions.  The rest of the
+library will then be accessible in a system independent fashion.
+
+  Please mail new working configuration files to `jaffer@ai.mit.edu' so
+that they can be included in the SLIB distribution.
+
+			   CODING STANDARDS
+
+  All library packages are written in IEEE P1178 Scheme and assume that
+a configuration file and `require.scm' package have already been
+loaded.  Other versions of Scheme can be supported in library packages
+as well by using, for example, `(provided? 'rev3-report)' or `(require
+'rev3-report)'.
+
+  `require.scm' defines `*catalog*', an association list of module
+names and filenames.  When a new package is added to the library, an
+entry should be added to `require.scm'.  Local packages can also be
+added to `*catalog*' and even shadow entries already in the table.
+
+  The module name and `:' should prefix each symbol defined in the
+package.  Definitions for external use should then be exported by having
+`(define foo module-name:foo)'.
+
+  Submitted packages should not duplicate routines which are already in
+SLIB files.  Use `require' to force those features to be supported in
+your package.  Care should be taken that there are no circularities in
+the `require's and `load's between the library packages.
+
+  Documentation should be provided in Emacs Texinfo format if possible,
+But documentation must be provided.
diff --git a/Template.scm b/Template.scm
new file mode 100644
index 0000000..a03b76b
--- /dev/null
+++ b/Template.scm
@@ -0,0 +1,267 @@
+;"Template.scm" configuration template of *features* for Scheme	-*-scheme-*-
+; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; (software-type) should be set to the generic operating system type.
+;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
+
+(define (software-type) 'UNIX)
+
+;;; (scheme-implementation-type) should return the name of the scheme
+;;; implementation loading this file.
+
+(define (scheme-implementation-type) 'Template)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "?")
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxillary files to your Scheme
+;;; implementation reside.
+
+(define (implementation-vicinity)
+  (case (software-type)
+    ((UNIX)	 "/usr/local/src/scheme/")
+    ((VMS)	"scheme$src:")
+    ((MS-DOS)	"C:\\scheme\\")))
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+(define library-vicinity
+  (let ((library-path
+	 (or
+	  ;; Use this getenv if your implementation supports it.
+	  (getenv "SCHEME_LIBRARY_PATH")
+	  ;; Use this path if your scheme does not support GETENV
+	  ;; or if SCHEME_LIBRARY_PATH is not set.
+	  (case (software-type)
+	    ((UNIX) "/usr/local/lib/slib/")
+	    ((VMS) "lib$scheme:")
+	    ((MS-DOS) "C:\\SLIB\\")
+	    (else "")))))
+    (lambda () library-path)))
+
+;;; *FEATURES* should be set to a list of symbols describing features
+;;; of this implementation.  Suggestions for features are:
+
+(define *features*
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+;	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+;	rev4-report			;conforms to
+;	rev3-report			;conforms to
+;	ieee-p1178			;conforms to
+;	sicp				;runs code from Structure and
+					;Interpretation of Computer
+					;Programs by Abelson and Sussman.
+;	rev4-optional-procedures	;LIST-TAIL, STRING->LIST,
+					;LIST->STRING, STRING-COPY,
+					;STRING-FILL!, LIST->VECTOR,
+					;VECTOR->LIST, and VECTOR-FILL!
+;	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
+					;SUBSTRING-MOVE-RIGHT!,
+					;SUBSTRING-FILL!,
+					;STRING-NULL?, APPEND!, 1+,
+					;-1+, <?, <=?, =?, >?, >=?
+;	multiarg/and-			;/ and - can take more than 2 args.
+;	multiarg-apply			;APPLY can take more than 2 args.
+;	rationalize
+;	delay				;has DELAY and FORCE
+;	with-file			;has WITH-INPUT-FROM-FILE and
+					;WITH-OUTPUT-FROM-FILE
+;	string-port			;has CALL-WITH-INPUT-STRING and
+					;CALL-WITH-OUTPUT-STRING
+;	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
+;	char-ready?
+;	macro				;has R4RS high level macros
+;	defmacro			;has Common Lisp DEFMACRO
+;	eval				;SLIB:EVAL is single argument eval
+;	record				;has user defined data structures
+;	values				;proposed multiple values
+;	dynamic-wind			;proposed dynamic-wind
+;	ieee-floating-point		;conforms to
+	full-continuation		;can return multiple times
+;	object-hash			;has OBJECT-HASH
+
+;	sort
+;	queue				;queues
+;	pretty-print
+;	object->string
+;	format
+;	trace				;has macros: TRACE and UNTRACE
+;	compiler			;has (COMPILER)
+;	ed				;(ED) is editor
+;	system				;posix (system <string>)
+	getenv				;posix (getenv <string>)
+;	program-arguments		;returns list of strings (argv)
+;	Xwindows			;X support
+;	curses				;screen management package
+;	termcap				;terminal description package
+;	terminfo			;sysV terminal description
+;	current-time			;returns time in seconds since 1/1/1970
+	))
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define (output-port-width . arg) 79)
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (let ((port (current-output-port)))
+    (lambda () port)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam (let ((cntr 100))
+		 (lambda () (set! cntr (+ 1 cntr))
+			 (string-append "slib_" (number->string cntr)))))
+
+;;; (FILE-EXISTS? <string>)
+(define (file-exists? f) #f)
+
+;;; (DELETE-FILE <string>)
+(define (delete-file f) #f)
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;; use this definition if your system doesn't have such a procedure.
+(define (force-output . arg) #t)
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.
+(define char-code-limit 256)
+
+;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum #x0FFFFFFF)
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+;(define slib:eval eval)
+
+;;; If your implementation provides R4RS macros:
+;(define macro:eval slib:eval)
+;(define macro:load load)
+
+(define *defmacros*
+  (list (cons 'defmacro
+	      (lambda (name parms . body)
+		`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
+				      *defmacros*))))))
+(define (defmacro? m) (and (assq m *defmacros*) #t))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a) (set! a (assq a *defmacros*))
+				     (if a (apply (cdr a) (cdr e)) e))
+			(else e)))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a)
+			 (set! a (assq a *defmacros*))
+			 (if a (macroexpand (apply (cdr a) (cdr e))) e))
+			(else e)))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define base:eval slib:eval)
+(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+(define (defmacro:expand* x)
+  (require 'defmacroexpand) (apply defmacro:expand* x '()))
+
+(define (defmacro:load <pathname>)
+  (slib:eval-load <pathname> defmacro:eval))
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;;; define an error procedure for the library
+;(define slib:error error)
+
+;;; define these as appropriate for your system.
+(define slib:tab (integer->char 9))
+(define slib:form-feed (integer->char 12))
+
+;;; Support for older versions of Scheme.  Not enough code for its own file.
+(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l))
+(define t #t)
+(define nil #f)
+
+;;; Define these if your implementation's syntax can support it and if
+;;; they are not already defined.
+
+;(define (1+ n) (+ n 1))
+;(define (-1+ n) (+ n -1))
+;(define 1- -1+)
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:exit (lambda args #f))
+
+;;; Here for backward compatability
+(define scheme-file-suffix
+  (let ((suffix (case (software-type)
+		  ((NOSVE) "_scm")
+		  (else ".scm"))))
+    (lambda () suffix)))
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+(define (slib:load-source f) (load (string-append f ".scm")))
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/alist.scm b/alist.scm
new file mode 100644
index 0000000..65ddb22
--- /dev/null
+++ b/alist.scm
@@ -0,0 +1,66 @@
+;;;"alist.scm", alist functions for Scheme.
+;;;Copyright (c) 1992, 1993 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define (predicate->asso pred)
+  (cond ((eq? eq? pred) assq)
+	((eq? = pred) assv)
+	((eq? eqv? pred) assv)
+	((eq? char=? pred) assv)
+	((eq? equal? pred) assoc)
+	((eq? string=? pred) assoc)
+	(else (lambda (key alist)
+		(let l ((al alist))
+		  (cond ((null? al) #f)
+			((pred key (caar al)) (car al))
+			(else (l (cdr al)))))))))
+
+(define (alist-inquirer pred)
+  (let ((assofun (predicate->asso pred)))
+    (lambda (alist key)
+      (let ((pair (assofun key alist)))
+	(and pair (cdr pair))))))
+
+(define (alist-associator pred)
+  (let ((assofun (predicate->asso pred)))
+    (lambda (alist key val)
+      (let* ((pair (assofun key alist)))
+	(cond (pair (set-cdr! pair val)
+		    alist)
+	      (else (cons (cons key val) alist)))))))
+
+(define (alist-remover pred)
+  (lambda (alist key)
+    (cond ((null? alist) alist)
+	  ((pred key (caar alist)) (cdr alist))
+	  ((null? (cdr alist)) alist)
+	  ((pred key (caadr alist))
+	   (set-cdr! alist (cddr alist)) alist)
+	  (else
+	   (let l ((al (cdr alist)))
+	     (cond ((null? (cdr al)) alist)
+		   ((pred key (caadr al))
+		    (set-cdr! al (cddr al)) alist)
+		   (else (l (cdr al)))))))))
+
+(define (alist-map proc alist)
+  (map (lambda (pair) (cons (car pair) (proc (car pair) (cdr pair))))
+       alist))
+
+(define (alist-for-each proc alist)
+  (for-each (lambda (pair) (proc (car pair) (cdr pair))) alist))
diff --git a/alistab.scm b/alistab.scm
new file mode 100644
index 0000000..c8149bf
--- /dev/null
+++ b/alistab.scm
@@ -0,0 +1,227 @@
+;;; "alistab.scm" database tables using association lists (assoc)
+; Copyright 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; LLDB	is (filename . alist-table)
+;;; HANDLE	is (table-name . TABLE)
+;;; TABLE	is an alist of (Primary-key . ROW)
+;;; ROW		is a list of non-primary VALUEs
+
+(define alist-table
+(let ((catalog-id 0)
+      (resources '*base-resources*))
+
+(define (make-base filename dim types)
+  (list filename
+	(list catalog-id)
+	(list resources (list 'free-id 1))))
+
+(define (open-base infile writable)
+  (cons (if (input-port? infile) #f infile)
+	((lambda (fun)
+	   (if (input-port? infile)
+	       (fun infile)
+	       (call-with-input-file infile fun)))
+	 read)))
+
+(define (write-base lldb outfile)
+  ((lambda (fun)
+     (cond ((output-port? outfile) (fun outfile))
+	   ((string? outfile) (call-with-output-file outfile fun))
+	   (else #f)))
+   (lambda (port)
+     (display (string-append
+	       ";;; \"" outfile "\" SLIB alist-table database	 -*-scheme-*-")
+	      port)
+     (newline port) (newline port)
+     (display "(" port) (newline port)
+     (for-each
+      (lambda (table)
+	(display " (" port)
+	(write (car table) port) (newline port)
+	(for-each
+	 (lambda (row)
+	   (display "  " port) (write row port) (newline port))
+	 (cdr table))
+	(display " )" port) (newline port))
+      (cdr lldb))
+     (display ")" port) (newline port)
+;     (require 'pretty-print)
+;     (pretty-print (cdr lldb) port)
+     (set-car! lldb (if (string? outfile) outfile #f))
+     #t)))
+
+(define (sync-base lldb)
+  (cond ((car lldb) (write-base lldb (car lldb)) #t)
+	(else
+;;;	 (display "sync-base: database filename not known")
+	 #f)))
+
+(define (close-base lldb)
+  (cond ((car lldb) (write-base lldb (car lldb))
+		    (set-cdr! lldb #f)
+		    (set-car! lldb #f) #t)
+	((cdr lldb) (set-cdr! lldb #f)
+		    (set-car! lldb #f) #t)
+	(else
+;;;	 (display "close-base: database not open")
+	 #f)))
+
+(define (make-table lldb dim types)
+  (let ((free-hand (open-table lldb resources 1 '(atom integer))))
+    (and free-hand
+	 (let* ((row (remover free-hand 'free-id))
+		(id #f))
+	   (cond (row
+		  (set! id (car row))
+		  ((make-putter 1 '(atom integer)) free-hand 'free-id
+						   (list (+ 1 id)))
+		  (set-cdr! lldb (cons (list id) (cdr lldb)))
+		  id)
+		 (else #f))))))
+
+(define (open-table lldb base-id dim types)
+  (assoc base-id (cdr lldb)))
+
+(define (remover nalist key)
+  (let ((alist (cdr nalist)))
+    (cond ((null? alist) #f)
+	  ((equal? key (caar alist))
+	   (set-cdr! nalist (cdr alist))
+	   (cdar alist))
+	  ((null? (cdr alist)) #f)
+	  ((equal? key (caadr alist))
+	   (set! nalist (cdadr alist))
+	   (set-cdr! alist (cddr alist))
+	   nalist)
+	  (else
+	   (let l ((al (cdr alist)))
+	     (cond ((null? (cdr al)) #f)
+		   ((equal? key (caadr al))
+		    (set! nalist (caadr al))
+		    (set-cdr! al (cddr al))
+		    nalist)
+		   (else (l (cdr al)))))))))
+
+(define (kill-table lldb base-id dim types)
+  (and (remover lldb base-id) #t))
+
+(define handle->base-id car)
+(define handle->alist cdr)
+(define set-handle-alist! set-cdr!)
+
+(define (present? handle key)
+  (assoc key (handle->alist handle)))
+
+(define (make-putter prinum types)
+  (lambda (handle ckey restcols)
+    (let ((row (assoc ckey (handle->alist handle))))
+      (cond (row (set-cdr! row restcols))
+	    (else (set-handle-alist!
+		   handle (cons (cons ckey restcols)
+				(handle->alist handle))))))))
+
+(define (make-getter prinum types)
+  (lambda (handle ckey)
+    (let ((row (assoc ckey (handle->alist handle))))
+      (and row (cdr row)))))
+
+(define (make-list-keyifier prinum types)
+  (if (= 1 prinum) car list->vector))
+
+(define (make-keyifier-1 type)
+  identity)
+
+(define (make-key->list prinum types)
+  (cond ((= 1 prinum) list)
+	(else vector->list)))
+
+(define (make-key-extractor primary-limit column-type-list index)
+  (if (= 1 primary-limit) identity
+      (let ((i (+ -1 index)))
+	(lambda (v) (vector-ref v i)))))
+
+(define (for-each-key handle operation)
+  (for-each (lambda (x) (operation (car x))) (handle->alist handle)))
+
+(define (map-key handle operation)
+  (map (lambda (x) (operation (car x))) (handle->alist handle)))
+
+(define (ordered-for-each-key handle operation)
+  (define (key->sortable k)
+    (cond ((number? k) k)
+	  ((string? k) k)
+	  ((symbol? k) (symbol->string k))
+	  ((vector? k) (map key->sortable (vector->list k)))
+	  (else (slib:error "unsortable key" k))))
+  ;; This routine assumes that the car of its operands are either
+  ;; numbers or strings (or lists of those).
+  (define (car-key-< x y)
+    (key-< (car x) (car y)))
+  (define (key-< x y)
+    (cond ((and (number? x) (number? y)) (< x y))
+	  ((number? x) #t)
+	  ((number? y) #f)
+	  ((string? x) (string<? x y))
+	  ((key-< (car x) (car y)) #t)
+	  ((key-< (car y) (car x)) #f)
+	  (else (key-< (cdr x) (cdr y)))))
+  (require 'sort)
+  (for-each operation
+	    (map cdr (sort! (map (lambda (p) (cons (key->sortable (car p))
+						   (car p)))
+				 (handle->alist handle))
+			    car-key-<))))
+
+(define (supported-type? type)
+  (case type
+    ((base-id atom integer boolean string symbol expression) #t)
+    (else #f)))
+
+(define (supported-key-type? type)
+  (case type
+    ((atom integer symbol string) #t)
+    (else #f)))
+
+  (lambda (operation-name)
+    (case operation-name
+      ((make-base) make-base)
+      ((open-base) open-base)
+      ((write-base) write-base)
+      ((sync-base) sync-base)
+      ((close-base) close-base)
+      ((make-table) make-table)
+      ((open-table) open-table)
+      ((kill-table) kill-table)
+      ((make-keyifier-1) make-keyifier-1)
+      ((make-list-keyifier) make-list-keyifier)
+      ((make-key->list) make-key->list)
+      ((make-key-extractor) make-key-extractor)
+      ((supported-type?) supported-type?)
+      ((supported-key-type?) supported-key-type?)
+      ((present?) present?)
+      ((make-putter) make-putter)
+      ((make-getter) make-getter)
+      ((delete) remover)
+      ((for-each-key) for-each-key)
+      ((map-key) map-key)
+      ((ordered-for-each-key) ordered-for-each-key)
+      ((catalog-id) catalog-id)
+      (else #f)
+      ))
+  ))
diff --git a/array.scm b/array.scm
new file mode 100644
index 0000000..3eecb7a
--- /dev/null
+++ b/array.scm
@@ -0,0 +1,279 @@
+;;;;"array.scm" Arrays for Scheme
+; Copyright (C) 1993 Alan Bawden
+;
+; Permission to copy this software, to redistribute it, and to use it
+; for any purpose is granted, subject to the following restrictions and
+; understandings.
+;
+; 1.  Any copy made of this software must include this copyright notice
+; in full.
+;
+; 2.  Users of this software agree to make their best efforts (a) to
+; return to me any improvements or extensions that they make, so that
+; these may be included in future releases; and (b) to inform me of
+; noteworthy uses of this software.
+;
+; 3.  I have made no warrantee or representation that the operation of
+; this software will be error-free, and I am under no obligation to
+; provide any services, by way of maintenance, update, or otherwise.
+;
+; 4.  In conjunction with products arising from the use of this material,
+; there shall be no use of my name in any advertising, promotional, or
+; sales literature without prior written consent in each case.
+;
+; Alan Bawden
+; MIT Room NE43-510
+; 545 Tech. Sq.
+; Cambridge, MA 02139
+; Alan@LCS.MIT.EDU
+
+(require 'record)
+
+;(declare (usual-integrations))
+
+(define array:rtd
+  (make-record-type "Array"
+    '(indexer		; Must be a -linear- function!
+      shape		; Inclusive bounds: ((lower upper) ...)
+      vector		; The actual contents
+      )))
+
+(define array:indexer (record-accessor array:rtd 'indexer))
+(define array-shape (record-accessor array:rtd 'shape))
+(define array:vector (record-accessor array:rtd 'vector))
+
+(define array? (record-predicate array:rtd))
+
+(define (array-rank obj)
+  (if (array? obj) (length (array-shape obj)) 0))
+
+(define (array-dimensions ra)
+  (map (lambda (ind) (if (zero? (car ind)) (cadr ind) ind))
+       (array-shape ra)))
+
+(define array:construct
+  (record-constructor array:rtd '(shape vector indexer)))
+
+(define (array:compute-shape specs)
+  (map (lambda (spec)
+	 (cond ((and (integer? spec)
+		     (< 0 spec))
+		(list 0 (- spec 1)))
+	       ((and (pair? spec)
+		     (pair? (cdr spec))
+		     (null? (cddr spec))
+		     (integer? (car spec))
+		     (integer? (cadr spec))
+		     (<= (car spec) (cadr spec)))
+		spec)
+	       (else (slib:error "array: Bad array dimension: " spec))))
+       specs))
+
+(define (make-array initial-value . specs)
+  (let ((shape (array:compute-shape specs)))
+    (let loop ((size 1)
+	       (indexer (lambda () 0))
+	       (l (reverse shape)))
+      (if (null? l)
+	  (array:construct shape
+			   (make-vector size initial-value)
+			   (array:optimize-linear-function indexer shape))
+	  (loop (* size (+ 1 (- (cadar l) (caar l))))
+		(lambda (first-index . rest-of-indices)
+		  (+ (* size (- first-index (caar l)))
+		     (apply indexer rest-of-indices)))
+		(cdr l))))))
+
+(define (make-shared-array array mapping . specs)
+  (let ((new-shape (array:compute-shape specs))
+	(old-indexer (array:indexer array)))
+    (let check ((indices '())
+		(bounds (reverse new-shape)))
+      (cond ((null? bounds)
+	     (array:check-bounds array (apply mapping indices)))
+	    (else
+	     (check (cons (caar bounds) indices) (cdr bounds))
+	     (check (cons (cadar bounds) indices) (cdr bounds)))))
+    (array:construct new-shape
+		     (array:vector array)
+		     (array:optimize-linear-function
+		       (lambda indices
+			 (apply old-indexer (apply mapping indices)))
+		       new-shape))))
+
+(define (array:in-bounds? array indices)
+  (let loop ((indices indices)
+	     (shape (array-shape array)))
+    (if (null? indices)
+	(null? shape)
+	(let ((index (car indices)))
+	  (and (not (null? shape))
+	       (integer? index)
+	       (<= (caar shape) index (cadar shape))
+	       (loop (cdr indices) (cdr shape)))))))
+
+(define (array:check-bounds array indices)
+  (or (array:in-bounds? array indices)
+      (slib:error "array: Bad indices for " array indices)))
+
+(define (array-ref array . indices)
+  (array:check-bounds array indices)
+  (vector-ref (array:vector array)
+	      (apply (array:indexer array) indices)))
+
+(define (array-set! array new-value . indices)
+  (array:check-bounds array indices)
+  (vector-set! (array:vector array)
+	       (apply (array:indexer array) indices)
+	       new-value))
+
+(define (array-in-bounds? array . indices)
+  (array:in-bounds? array indices))
+
+; Fast versions of ARRAY-REF and ARRAY-SET! that do no error checking,
+; and don't cons intermediate lists of indices:
+
+(define (array-1d-ref a i0)
+  (vector-ref (array:vector a) ((array:indexer a) i0)))
+
+(define (array-2d-ref a i0 i1)
+  (vector-ref (array:vector a) ((array:indexer a) i0 i1)))
+
+(define (array-3d-ref a i0 i1 i2)
+  (vector-ref (array:vector a) ((array:indexer a) i0 i1 i2)))
+
+(define (array-1d-set! a v i0)
+  (vector-set! (array:vector a) ((array:indexer a) i0) v))
+
+(define (array-2d-set! a v i0 i1)
+  (vector-set! (array:vector a) ((array:indexer a) i0 i1) v))
+
+(define (array-3d-set! a v i0 i1 i2)
+  (vector-set! (array:vector a) ((array:indexer a) i0 i1 i2) v))
+
+; STOP!  Do not read beyond this point on your first reading of
+; this code -- you should simply assume that the rest of this file
+; contains only the following single definition:
+;
+;   (define (array:optimize-linear-function f l) f)
+;
+; Of course everything would be pretty inefficient if this were really the
+; case, but it isn't.  The following code takes advantage of the fact that
+; you can learn everything there is to know from a linear function by
+; simply probing around in its domain and observing its values -- then a
+; more efficient equivalent can be constructed.
+
+(define (array:optimize-linear-function f l)
+  (let ((d (length l)))
+    (cond
+     ((= d 0)
+      (array:0d-c (f)))
+     ((= d 1)
+      (let ((c (f 0)))
+	(array:1d-c0 c (- (f 1) c))))
+     ((= d 2)
+      (let ((c (f 0 0)))
+	(array:2d-c01 c (- (f 1 0) c) (- (f 0 1) c))))
+     ((= d 3)
+      (let ((c (f 0 0 0)))
+	(array:3d-c012 c (- (f 1 0 0) c) (- (f 0 1 0) c) (- (f 0 0 1) c))))
+     (else
+      (let* ((v (map (lambda (x) 0) l))
+	     (c (apply f v)))
+	(let loop ((p v)
+		   (old-val c)
+		   (coefs '()))
+	  (cond ((null? p)
+		 (array:Nd-c* c (reverse coefs)))
+		(else
+		 (set-car! p 1)
+		 (let ((new-val (apply f v)))
+		   (loop (cdr p)
+			 new-val
+			 (cons (- new-val old-val) coefs)))))))))))
+
+; 0D cases:
+
+(define (array:0d-c c)
+  (lambda () c))
+
+; 1D cases:
+
+(define (array:1d-c c)
+  (lambda (i0) (+ c i0)))
+
+(define (array:1d-0 n0)
+  (cond ((= 1 n0) +)
+	(else (lambda (i0) (* n0 i0)))))
+
+(define (array:1d-c0 c n0)
+  (cond ((= 0 c) (array:1d-0 n0))
+	((= 1 n0) (array:1d-c c))
+	(else (lambda (i0) (+ c (* n0 i0))))))
+
+; 2D cases:
+
+(define (array:2d-0 n0)
+  (lambda (i0 i1) (+ (* n0 i0) i1)))
+
+(define (array:2d-1 n1)
+  (lambda (i0 i1) (+ i0 (* n1 i1))))
+
+(define (array:2d-c0 c n0)
+  (lambda (i0 i1) (+ c (* n0 i0) i1)))
+
+(define (array:2d-c1 c n1)
+  (lambda (i0 i1) (+ c i0 (* n1 i1))))
+
+(define (array:2d-01 n0 n1)
+  (cond ((= 1 n0) (array:2d-1 n1))
+	((= 1 n1) (array:2d-0 n0))
+	(else (lambda (i0 i1) (+ (* n0 i0) (* n1 i1))))))
+
+(define (array:2d-c01 c n0 n1)
+  (cond ((= 0 c) (array:2d-01 n0 n1))
+	((= 1 n0) (array:2d-c1 c n1))
+	((= 1 n1) (array:2d-c0 c n0))
+	(else (lambda (i0 i1) (+ c (* n0 i0) (* n1 i1))))))
+
+; 3D cases:
+
+(define (array:3d-01 n0 n1)
+  (lambda (i0 i1 i2) (+ (* n0 i0) (* n1 i1) i2)))
+
+(define (array:3d-02 n0 n2)
+  (lambda (i0 i1 i2) (+ (* n0 i0) i1 (* n2 i2))))
+
+(define (array:3d-12 n1 n2)
+  (lambda (i0 i1 i2) (+ i0 (* n1 i1) (* n2 i2))))
+
+(define (array:3d-c12 c n1 n2)
+  (lambda (i0 i1 i2) (+ c i0 (* n1 i1) (* n2 i2))))
+
+(define (array:3d-c02 c n0 n2)
+  (lambda (i0 i1 i2) (+ c (* n0 i0) i1 (* n2 i2))))
+
+(define (array:3d-c01 c n0 n1)
+  (lambda (i0 i1 i2) (+ c (* n0 i0) (* n1 i1) i2)))
+
+(define (array:3d-012 n0 n1 n2)
+  (cond ((= 1 n0) (array:3d-12 n1 n2))
+	((= 1 n1) (array:3d-02 n0 n2))
+	((= 1 n2) (array:3d-01 n0 n1))
+	(else (lambda (i0 i1 i2) (+ (* n0 i0) (* n1 i1) (* n2 i2))))))
+
+(define (array:3d-c012 c n0 n1 n2)
+  (cond ((= 0 c) (array:3d-012 n0 n1 n2))
+	((= 1 n0) (array:3d-c12 c n1 n2))
+	((= 1 n1) (array:3d-c02 c n0 n2))
+	((= 1 n2) (array:3d-c01 c n0 n1))
+	(else (lambda (i0 i1 i2) (+ c (* n0 i0) (* n1 i1) (* n2 i2))))))
+
+; ND cases:
+
+(define (array:Nd-* coefs)
+  (lambda indices (apply + (map * coefs indices))))
+
+(define (array:Nd-c* c coefs)
+  (cond ((= 0 c) (array:Nd-* coefs))
+	(else (lambda indices (apply + c (map * coefs indices))))))
diff --git a/arraymap.scm b/arraymap.scm
new file mode 100644
index 0000000..18ee64a
--- /dev/null
+++ b/arraymap.scm
@@ -0,0 +1,76 @@
+;;;; "arraymap.scm", applicative routines for arrays in Scheme.  
+;;; Copyright (c) 1993 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'array)
+
+(define (array-map! ra0 proc . ras)
+  (define (ramap rshape inds)
+    (if (null? (cdr rshape))
+	(do ((i (cadar rshape) (+ -1 i))
+	     (is (cons (cadar rshape) inds)
+		 (cons (+ -1 i) inds)))
+	    ((< i (caar rshape)))
+	  (apply array-set! ra0
+		 (apply proc (map (lambda (ra) (apply array-ref ra is))
+				  ras))
+		 is))
+	(let ((crshape (cdr rshape))
+	      (ll (caar rshape)))
+	  (do ((i (cadar rshape) (+ -1 i)))
+	      ((< i ll))
+	    (ramap crshape (cons i inds))))))
+  (ramap (reverse (array-shape ra0)) '()))
+
+(define (array-for-each proc . ras)
+  (define (rafe rshape inds)
+    (if (null? (cdr rshape))
+	(do ((i (caar rshape) (+ 1 i)))
+	    ((> i (cadar rshape)))
+	  (apply proc
+		 (map (lambda (ra)
+			(apply array-ref ra (reverse (cons i inds)))) ras)))
+	(let ((crshape (cdr rshape))
+	      (ll (cadar rshape)))
+	  (do ((i (caar rshape) (+ 1 i)))
+	      ((> i ll))
+	    (rafe crshape (cons i inds))))))
+  (rafe (array-shape (car ras)) '()))
+
+(define (shape->indexes shape)
+  (define ra0 (apply make-array '() shape))
+  (define (ramap rshape inds)
+    (if (null? (cdr rshape))
+	(do ((i (cadar rshape) (+ -1 i))
+	     (is (cons (cadar rshape) inds)
+		 (cons (+ -1 i) inds)))
+	    ((< i (caar rshape)))
+	  (apply array-set! ra0 is is))
+	(let ((crshape (cdr rshape))
+	      (ll (caar rshape)))
+	  (do ((i (cadar rshape) (+ -1 i)))
+	      ((< i ll))
+	    (ramap crshape (cons i inds))))))
+  (ramap (reverse shape) '())
+  ra0)
+
+(define (array-indexes ra)
+  (shape->indexes (array-shape ra)))
+
+(define (array-copy! source dest)
+  (array-map! dest identity source))
diff --git a/batch.scm b/batch.scm
new file mode 100644
index 0000000..685dd3e
--- /dev/null
+++ b/batch.scm
@@ -0,0 +1,417 @@
+;;; "batch.scm" Group and execute commands on various systems.
+;Copyright (C) 1994, 1995 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'line-i/o)			;Just for write-line
+(require 'parameters)
+(require 'database-utilities)
+
+;;(define (batch parms op . args) ??)
+
+(define (batch:port parms)
+  (car (parameter-list-ref parms 'batch-port)))
+
+(define (batch:dialect parms)		; was batch-family
+  (car (parameter-list-ref parms 'batch-dialect)))
+
+(define (batch:line-length-limit parms)
+  (let ((bl (parameter-list-ref parms 'batch-line-length-limit)))
+    (cond (bl (car bl))
+	  (else (case (batch:dialect parms)
+		  ((unix) 1023)
+		  ((dos) 127)
+		  ((vms) 1023)
+		  ((system) 1023)
+		  ((*unknown*) -1))))))
+
+(define (batch-line parms str)
+  (let ((bp (parameter-list-ref parms 'batch-port))
+	(ln (batch:line-length-limit parms)))
+    (cond ((not bp) (slib:error 'batch-line "missing batch-port parameter"
+				parms))
+	  ((>= (string-length str) ln) #f)
+	  (else (write-line str (car bp)) #t))))
+
+;;; add a Scheme batch-dialect?
+
+(define (batch:apply-chop-to-fit proc . args)
+  (define args-but-last (butlast args 1))
+  (let loop ((fodder (car (last-pair args))))
+    (let ((hlen (quotient (length fodder) 2)))
+      (cond ((apply proc (append args-but-last (list fodder))))
+	    ((not (positive? hlen))
+	     (slib:error 'batch:apply-chop-to-fit "can't split"
+			 (cons proc (append args-but-last (list fodder)))))
+	    (else (loop (nthcdr (+ 1 hlen) fodder))
+		  (loop (butlast fodder hlen)))))))
+
+(define (batch:system parms . strings)
+  (or (apply batch:try-system parms strings)
+      (slib:error 'batch:system 'failed strings)))
+
+(define (batch:try-system parms . strings)
+  (define port (batch:port parms))
+  (set! strings (batch:flatten strings))
+  (case (batch:dialect parms)
+    ((unix) (batch-line parms (apply string-join " " strings)))
+    ((dos) (batch-line parms (apply string-join " " strings)))
+    ((vms) (batch-line parms (apply string-join " " "$" strings)))
+    ((system) (write `(system ,(apply string-join " " strings)) port)
+	      (newline port)
+	      (zero? (system (apply string-join " " strings))))
+    ((*unknown*) (write `(system ,(apply string-join " " strings)) port)
+		 (newline port)
+		 #f)))
+
+(define (batch:run-script parms . strings)
+  (case (batch:dialect parms strings)
+    ((unix) (batch:system parms strings name))
+    ((dos) (batch:system parms strings name))
+    ((vms) (batch:system parms (cons #\@ strings)))
+    ((system) (batch:system parms strings name))
+    ((*unknown*) (batch:system parms strings name)
+		 #f)))
+
+(define (batch:comment parms . lines)
+  (define port (batch:port parms))
+  (set! lines (batch:flatten lines))
+  (case (batch:dialect parms)
+    ((unix) (every (lambda (line)
+		     (batch-line parms (string-append "# " line)))
+		   lines))
+    ((dos) (every (lambda (line)
+		    (batch-line parms
+				(string-append
+				 "rem" (if (equal? "  " line) ".") line)))
+		  lines))
+    ((vms) (every (lambda (line)
+		    (batch-line parms (string-append "$! " line)))
+		  lines))
+    ((system) (every (lambda (line)
+		       (batch-line parms (string-append "; " line)))
+		     lines))
+    ((*unknown*) (for-each (lambda (line)
+			     (batch-line parms (string-append ";;; " line))
+			     (newline port))
+			   lines)
+		 #f)))
+
+(define (batch:lines->file parms file . lines)
+  (define port (batch:port parms))
+  (set! lines (batch:flatten lines))
+  (case (or (batch:dialect parms) '*unknown*)
+    ((unix) (batch-line parms (string-append "rm -f " file))
+	    (every
+	     (lambda (string)
+	       (batch-line parms (string-append "echo '" string "'>>" file)))
+	     lines))
+    ((dos) (batch-line parms (string-append "DEL " file))
+	   (every
+	    (lambda (string)
+	      (batch-line parms
+			  (string-append "ECHO" (if (equal? "" string) "." " ")
+					 string ">>" file)))
+	    lines))
+    ((vms) (and (batch-line parms (string-append "$DELETE " file))
+		(batch-line parms (string-append "$CREATE " file))
+		(batch-line parms (string-append "$DECK"))
+		(every (lambda (string) (batch-line parms string))
+		       lines)
+		(batch-line parms (string-append "$EOD"))))
+    ((system) (write `(delete-file ,file) port) (newline port)
+	      (delete-file file)
+	      (pretty-print `(call-with-output-file ,file
+			       (lambda (fp)
+				 (for-each
+				  (lambda (string) (write-line string fp))
+				  ',lines)))
+			    port)
+	      (call-with-output-file file
+		(lambda (fp) (for-each (lambda (string) (write-line string fp))
+				       lines)))
+	      #t)
+    ((*unknown*)
+     (write `(delete-file ,file) port) (newline port)
+     (pretty-print
+      `(call-with-output-file ,file
+	 (lambda (fp)
+	   (for-each
+	    (lambda (string)
+	      (write-line string fp))
+	    ,lines)))
+      port)
+     #f)))
+
+(define (batch:delete-file parms file)
+  (define port (batch:port parms))
+  (case (batch:dialect parms)
+    ((unix) (batch-line parms (string-append "rm -f " file))
+	    #t)
+    ((dos) (batch-line parms (string-append "DEL " file))
+	   #t)
+    ((vms) (batch-line parms (string-append "$DELETE " file))
+	   #t)
+    ((system) (write `(delete-file ,file) port) (newline port)
+	      (delete-file file))	; SLIB provides
+    ((*unknown*) (write `(delete-file ,file) port) (newline port)
+		 #f)))
+
+(define (batch:rename-file parms old-name new-name)
+  (define port (batch:port parms))
+  (case (batch:dialect parms)
+    ((unix) (batch-line parms (string-join " " "mv -f" old-name new-name)))
+    ((dos) (batch-line parms (string-join " " "MOVE" "/Y" old-name new-name)))
+    ((vms) (batch-line parms (string-join " " "$RENAME" old-name new-name)))
+    ((system) (batch:extender 'rename-file batch:rename-file))
+    ((*unknown*) (write `(rename-file ,old-name ,new-name) port)
+		 (newline port)
+		 #f)))
+
+(define (batch:call-with-output-script parms name proc)
+  (case (batch:dialect parms)
+    ((unix) ((cond ((string? name)
+		    (lambda (proc)
+		      (let ((ans (call-with-output-file name proc)))
+			(system (string-append "chmod +x " name))
+			ans)))
+		   ((output-port? name) (lambda (proc) (proc name)))
+		   (else  (lambda (proc) (proc (current-output-port)))))
+	     (lambda (port)
+	       (write-line "#!/bin/sh" port)
+	       (cond
+		((and (string? name) (provided? 'bignum))
+		 (require 'posix-time)
+		 (write-line
+		  (string-append
+		   "# \""  name "\" build script created "
+		   (ctime (current-time)))
+		  port)))
+	       (proc port))))
+
+    ((dos) ((cond ((string? name)
+		   (lambda (proc)
+		     (call-with-output-file (string-append name ".bat") proc)))
+		  ((output-port? name) (lambda (proc) (proc name)))
+		  (else  (lambda (proc) (proc (current-output-port)))))
+	    (lambda (port)
+	      (cond
+	       ((and (string? name) (provided? 'bignum))
+		(require 'posix-time)
+		(write-line
+		 (string-append
+		  "rem " name
+		  " build script created "
+		  (ctime (current-time)))
+		 port)))
+	      (proc port))))
+
+    ((vms) ((cond ((string? name)
+		   (lambda (proc)
+		     (call-with-output-file (string-append name ".COM") proc)))
+		  ((output-port? name) (lambda (proc) (proc name)))
+		  (else  (lambda (proc) (proc (current-output-port)))))
+	    (lambda (port)
+	      (cond
+	       ((and (string? name) (provided? 'bignum))
+		(require 'posix-time)
+		;;(write-line
+		;; "$DEFINE/USER SYS$OUTPUT BUILD.LOG" port)
+		(write-line
+		 (string-append
+		  "$! " name
+		  " build script created "
+		  (ctime (current-time)))
+		 port)))
+	      (proc port))))
+
+    ((system) ((cond ((string? name)
+		      (lambda (proc)
+			(let ((ans (call-with-output-file name
+				     (lambda (port) (proc name)))))
+			  (system (string-append "chmod +x " name))
+			  ans)))
+		     ((output-port? name) (lambda (proc) (proc name)))
+		     (else  (lambda (proc) (proc (current-output-port)))))
+	       (lambda (port)
+		 (cond
+		  ((and (string? name) (provided? 'bignum))
+		   (require 'posix-time)
+		   (write-line
+		    (string-append
+		     ";;; \""  name
+		     "\" build script created " (ctime (current-time)))
+		    port)))
+		 (proc port))))
+
+    ((*unknown*) ((cond ((string? name)
+			 (lambda (proc)
+			   (let ((ans (call-with-output-file name
+					(lambda (port) (proc name)))))
+			     (system (string-append "chmod +x " name))
+			     ans)))
+			((output-port? name) (lambda (proc) (proc name)))
+			(else  (lambda (proc) (proc (current-output-port)))))
+		  (lambda (port)
+		    (cond
+		     ((and (string? name) (provided? 'bignum))
+		      (require 'posix-time)
+		      (write-line
+		       (string-append
+			";;; \""  name
+			"\" build script created " (ctime (current-time)))
+		       port)))
+		    (proc port)))
+		 #f)))
+
+;;; This little ditty figures out how to use a Scheme extension or
+;;; SYSTEM to execute a command that is not available in the batch
+;;; mode chosen.
+
+(define (batch:extender NAME BATCHER)
+  (lambda (parms . args)
+    (define port (batch:port parms))
+    (cond
+     ((provided? 'i/o-extensions)	; SCM specific
+      (write `(,NAME ,@args) port)
+      (newline port)
+      (apply (slib:eval NAME) args))
+     (else
+      (let ((pl (make-parameter-list (map car parms))))
+	(adjoin-parameters!
+	 pl (cons 'batch-dialect (os->batch-dialect
+				  (parameter-list-ref parms 'platform))))
+	(system
+	 (call-with-output-string
+	  (lambda (port)
+	    (batch:call-with-output-script
+	     port
+	     (lambda (batch-port)
+	       (define new-parms (copy-tree pl))
+	       (adjoin-parameters! new-parms (list 'batch-port batch-port))
+	       (apply BATCHER new-parms args)))))))))))
+
+(define (replace-suffix str old new)
+  (define (cs str)
+    (let* ((len (string-length str))
+	   (re (- len (string-length old))))
+      (cond ((string-ci=? old (substring str re len))
+	     (string-append (substring str 0 re) new))
+	    (else
+	     (slib:error 'replace-suffix "suffix doens't match:"
+			 old str)))))
+  (if (string? str) (cs str) (map cs str)))
+
+(define (must-be-first firsts lst)
+  (append (remove-if-not (lambda (i) (member i lst)) firsts)
+	  (remove-if (lambda (i) (member i firsts)) lst)))
+
+(define (must-be-last lst lasts)
+  (append (remove-if (lambda (i) (member i lasts)) lst)
+	  (remove-if-not (lambda (i) (member i lst)) lasts)))
+
+(define (string-join joiner . args)
+  (if (null? args) ""
+      (apply string-append
+	     (car args)
+	     (map (lambda (s) (string-append joiner s)) (cdr args)))))
+
+(define (batch:flatten strings)
+  (apply
+   append (map
+	   (lambda (obj)
+	     (cond ((eq? "" obj) '())
+		   ((string? obj) (list obj))
+		   ((eq? #f obj) '())
+		   ((null? obj) '())
+		   ((list? obj) (batch:flatten obj))
+		   (else (slib:error 'batch:flatten "unexpected type"
+				     obj "in" strings))))
+	   strings)))
+
+(define batch:platform (software-type))
+(cond ((and (eq? 'unix batch:platform) (provided? 'system))
+       (let ((file-name (tmpnam)))
+	 (system (string-append "uname > " file-name))
+	 (set! batch:platform (call-with-input-file file-name read))
+	 (delete-file file-name))))
+
+(define batch:database #f)
+(define (os->batch-dialect os)
+  ((((batch:database 'open-table) 'operating-system #f)
+    'get 'os-family) os))
+
+(define (batch:initialize! database)
+  (set! batch:database database)
+  (define-tables database
+
+    '(batch-dialect
+      ((family atom))
+      ()
+      ((unix)
+       (dos)
+       (vms)
+       (system)
+       (*unknown*)))
+
+    '(operating-system
+      ((name symbol))
+      ((os-family batch-dialect))
+      (;;(3b1		*unknown*)
+       (acorn		*unknown*)
+       (aix		unix)
+       (alliant		*unknown*)
+       (amiga		*unknown*)
+       (apollo		unix)
+       (apple2		*unknown*)
+       (arm		*unknown*)
+       (atari.st	*unknown*)
+       (cdc		*unknown*)
+       (celerity	*unknown*)
+       (concurrent	*unknown*)
+       (convex		*unknown*)
+       (encore		*unknown*)
+       (harris		*unknown*)
+       (hp-ux		unix)
+       (hp48		*unknown*)
+       (isis		*unknown*)
+       (linux		unix)
+       (mac		*unknown*)
+       (masscomp	unix)
+       (ms-dos		dos)
+       (mips		*unknown*)
+       (ncr		*unknown*)
+       (newton		*unknown*)
+       (next		unix)
+       (novell		*unknown*)
+       (os/2		dos)
+       (prime		*unknown*)
+       (psion		*unknown*)
+       (pyramid		*unknown*)
+       (sequent		*unknown*)
+       (sgi		*unknown*)
+       (stratus		*unknown*)
+       (sun-os		unix)
+       (transputer	*unknown*)
+       (unicos		unix)
+       (unix		unix)
+       (vms		vms)
+       (*unknown*	*unknown*)
+       )))
+
+  ((database 'add-domain) '(operating-system operating-system #f symbol #f))
+  )
diff --git a/break.scm b/break.scm
new file mode 100644
index 0000000..e6ba634
--- /dev/null
+++ b/break.scm
@@ -0,0 +1,151 @@
+;;;; "break.scm" Breakpoints for debugging in Scheme.
+;;; Copyright (C) 1991, 1992, 1993, 1995 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'qp)
+
+;;;; BREAKPOINTS
+
+;;; Typing (init-debug) at top level sets up a continuation for
+;;; breakpoint.  When (breakpoint arg1 ...) is then called it returns
+;;; from the top level continuation and pushes the continuation from
+;;; which it was called on breakpoint:continuation-stack.  If
+;;; (continue) is later called, it pops the topmost continuation off
+;;; of breakpoint:continuation-stack and returns #f to it.
+
+(define breakpoint:continuation-stack '())
+
+(define debug:breakpoint
+  (let ((call-with-current-continuation call-with-current-continuation)
+	(apply apply) (qpn qpn)
+	(cons cons) (length length))
+    (lambda args
+      (apply qpn "BREAKPOINT:" args)
+      (let ((ans
+	     (call-with-current-continuation
+	      (lambda (x)
+		(set! breakpoint:continuation-stack
+		      (cons x breakpoint:continuation-stack))
+		(debug:top-continuation
+		 (length breakpoint:continuation-stack))))))
+	(cond ((not (eq? ans breakpoint:continuation-stack)) ans))))))
+
+(define debug:continue
+  (let ((null? null?) (car car) (cdr cdr))
+    (lambda args
+      (cond ((null? breakpoint:continuation-stack)
+	     (display "; no break to continue from")
+	     (newline))
+	    (else
+	     (let ((cont (car breakpoint:continuation-stack)))
+	       (set! breakpoint:continuation-stack
+		     (cdr breakpoint:continuation-stack))
+	       (if (null? args) (cont #f)
+		   (apply cont args))))))))
+
+(define debug:top-continuation
+  (if (provided? 'abort)
+      (lambda (val) (display val) (newline) (abort))
+      (begin (display "; type (init-debug)") #f)))
+
+(define (init-debug)
+  (call-with-current-continuation
+   (lambda (x) (set! debug:top-continuation x))))
+
+(define breakpoint debug:breakpoint)
+(define bkpt debug:breakpoint)
+(define continue debug:continue)
+
+(define debug:breakf
+  (let ((null? null?)			;These bindings are so that
+	(not not)			;breakf will not break on parts
+	(car car) (cdr cdr)		;of itself.
+	(eq? eq?) (+ +) (zero? zero?) (modulo modulo)
+	(apply apply) (display display) (breakpoint debug:breakpoint))
+    (lambda (function . optname)
+;;;      (set! debug:indent 0)
+      (let ((name (if (null? optname) function (car optname))))
+	(lambda args
+	  (cond ((and (not (null? args))
+		      (eq? (car args) 'debug:unbreak-object)
+		      (null? (cdr args)))
+		 function)
+		(else
+		 (breakpoint name args)
+		 (apply function args))))))))
+
+;;; the reason I use a symbol for debug:unbreak-object is so
+;;; that functions can still be unbreaked if this file is read in twice.
+
+(define (debug:unbreakf function)
+;;;  (set! debug:indent 0)
+  (function 'debug:unbreak-object))
+
+;;;;The break: functions wrap around the debug: functions to provide
+;;; niceties like keeping track of breakd functions and dealing with
+;;; redefinition.
+
+(require 'alist)
+(define break:adder (alist-associator eq?))
+(define break:deler (alist-remover eq?))
+
+(define *breakd-procedures* '())
+(define (break:breakf fun sym)
+  (cond ((not (procedure? fun))
+	 (display "WARNING: not a procedure " (current-error-port))
+	 (display sym (current-error-port))
+	 (newline (current-error-port))
+	 (set! *breakd-procedures* (break:deler *breakd-procedures* sym))
+	 fun)
+	(else
+	 (let ((p (assq sym *breakd-procedures*)))
+	   (cond ((and p (eq? (cdr p) fun))
+		  fun)
+		 (else
+		  (let ((tfun (debug:breakf fun sym)))
+		    (set! *breakd-procedures*
+			  (break:adder *breakd-procedures* sym tfun))
+		    tfun)))))))
+
+(define (break:unbreakf fun sym)
+  (let ((p (assq sym *breakd-procedures*)))
+    (set! *breakd-procedures* (break:deler *breakd-procedures* sym))
+    (cond ((not (procedure? fun)) fun)
+	  ((not p) fun)
+	  ((eq? (cdr p) fun)
+	   (debug:unbreakf fun))
+	  (else fun))))
+
+(define breakf debug:breakf)
+(define unbreakf debug:unbreakf)
+
+;;;; Finally, the macros break and unbreak
+
+(defmacro break xs
+  (if (null? xs)
+      `(begin ,@(map (lambda (x) `(set! ,x (break:breakf ,x ',x)))
+		     (map car *breakd-procedures*))
+	      (map car *breakd-procedures*))
+      `(begin ,@(map (lambda (x) `(set! ,x (break:breakf ,x ',x))) xs))))
+(defmacro unbreak xs
+  (if (null? xs)
+      (slib:eval
+       `(begin ,@(map (lambda (x) `(set! ,x (break:unbreakf ,x ',x)))
+		      (map car *breakd-procedures*))
+	       '',(map car *breakd-procedures*)))
+      `(begin ,@(map (lambda (x) `(set! ,x (break:unbreakf ,x ',x))) xs))))
diff --git a/chap.scm b/chap.scm
new file mode 100644
index 0000000..ed559c9
--- /dev/null
+++ b/chap.scm
@@ -0,0 +1,150 @@
+;;;; "chap.scm" Chapter ordering		-*-scheme-*-
+;;; Copyright 1992, 1993, 1994 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; The CHAP: functions deal with strings which are ordered like
+;;; chapters in a book.  For instance, a_9 < a_10 and 4c < 4aa.  Each
+;;; section of the string consists of consecutive numeric or
+;;; consecutive aphabetic characters.
+
+(define (chap:string<? s1 s2)
+  (let ((l1 (string-length s1))
+	(l2 (string-length s2)))
+    (define (match-so-far i ctypep)
+      (cond ((>= i l1) (not (>= i l2)))
+	    ((>= i l2) #f)
+	    (else
+	     (let ((c1 (string-ref s1 i))
+		   (c2 (string-ref s2 i)))
+	       (cond ((char=? c1 c2)
+		      (if (ctypep c1)
+			  (match-so-far (+ 1 i) ctypep)
+			  (delimited i)))
+		     ((ctypep c1)
+		      (if (ctypep c2)
+			  (length-race (+ 1 i) ctypep (char<? c1 c2))
+			  #f))
+		     ((ctypep c2) #t)
+		     (else
+		      (let ((ctype1 (ctype c1)))
+			(cond
+			 ((and ctype1 (eq? ctype1 (ctype c2)))
+			  (length-race (+ 1 i) ctype1 (char<? c1 c2)))
+			 (else (char<? c1 c2))))))))))
+    (define (length-race i ctypep def)
+      (cond ((>= i l1) (if (>= i l2) def #t))
+	    ((>= i l2) #f)
+	    (else
+	     (let ((c1 (string-ref s1 i))
+		   (c2 (string-ref s2 i)))
+	       (cond ((ctypep c1)
+		      (if (ctypep c2)
+			  (length-race (+ 1 i) ctypep def)
+			  #f))
+		     ((ctypep c2) #t)
+		     (else def))))))
+    (define (ctype c1)
+      (cond
+       ((char-numeric? c1) char-numeric?)
+       ((char-lower-case? c1) char-lower-case?)
+       ((char-upper-case? c1) char-upper-case?)
+       (else #f)))
+    (define (delimited i)
+      (cond ((>= i l1) (not (>= i l2)))
+	    ((>= i l2) #f)
+	    (else
+	     (let* ((c1 (string-ref s1 i))
+		    (c2 (string-ref s2 i))
+		    (ctype1 (ctype c1)))
+	       (cond ((char=? c1 c2)
+		      (if ctype1 (match-so-far (+ i 1) ctype1)
+			  (delimited (+ i 1))))
+		     ((and ctype1 (eq? ctype1 (ctype c2)))
+		      (length-race (+ 1 i) ctype1 (char<? c1 c2)))
+		     (else (char<? c1 c2)))))))
+    (delimited 0)))
+
+(define chap:char-incr (- (char->integer #\2) (char->integer #\1)))
+
+(define (chap:inc-string s p)
+  (let ((c (string-ref s p)))
+    (cond ((char=? c #\z)
+	   (string-set! s p #\a)
+	   (cond ((zero? p) (string-append "a" s))
+		 ((char-lower-case? (string-ref s (+ -1 p)))
+		  (chap:inc-string s (+ -1 p)))
+		 (else
+		  (string-append 
+		   (substring s 0 p)
+		   "a"
+		   (substring s p (string-length s))))))
+	  ((char=? c #\Z)
+	   (string-set! s p #\A)
+	   (cond ((zero? p) (string-append "A" s))
+		 ((char-upper-case? (string-ref s (+ -1 p)))
+		  (chap:inc-string s (+ -1 p)))
+		 (else
+		  (string-append 
+		   (substring s 0 p)
+		   "A"
+		   (substring s p (string-length s))))))
+	  ((char=? c #\9)
+	   (string-set! s p #\0)
+	   (cond ((zero? p) (string-append "1" s))
+		 ((char-numeric? (string-ref s (+ -1 p)))
+		  (chap:inc-string s (+ -1 p)))
+		 (else
+		  (string-append 
+		   (substring s 0 p)
+		   "1"
+		   (substring s p (string-length s))))))
+	  ((or (char-alphabetic? c) (char-numeric? c))
+	   (string-set! s p (integer->char
+			     (+ chap:char-incr
+				(char->integer (string-ref s p)))))
+	   s)
+	  (else (slib:error "inc-string error" s p)))))
+
+(define (chap:next-string s)
+  (do ((i (+ -1 (string-length s)) (+ -1 i)))
+      ((or (negative? i)
+	   (char-numeric? (string-ref s i))
+	   (char-alphabetic? (string-ref s i)))
+       (if (negative? i) (string-append s "0")
+	   (chap:inc-string (string-copy s) i)))))
+
+;;; testing utilities
+;(define (ns s1) (chap:next-string s1))
+
+;(define (ts s1 s2)
+;  (let ((s< (chap:string<? s1 s2))
+;	(s> (chap:string<? s2 s1)))
+;    (cond (s<
+;	   (display s1)
+;	   (display " < ")
+;	   (display s2)
+;	   (newline)))
+;    (cond (s>
+;	   (display s1)
+;	   (display " > ")
+;	   (display s2)
+;	   (newline)))))
+
+(define (chap:string>? s1 s2) (chap:string<? s2 s1))
+(define (chap:string>=? s1 s2) (not (chap:string<? s1 s2)))
+(define (chap:string<=? s1 s2) (not (chap:string<? s2 s1)))
diff --git a/charplot.scm b/charplot.scm
new file mode 100644
index 0000000..2a2a49a
--- /dev/null
+++ b/charplot.scm
@@ -0,0 +1,142 @@
+;;;; "charplot.scm", plotting on character devices for Scheme
+;;; Copyright (C) 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'sort)
+
+(define charplot:rows 24)
+(define charplot:columns (output-port-width (current-output-port)))
+
+(define charplot:xborder #\_)
+(define charplot:yborder #\|)
+(define charplot:xaxchar #\-)
+(define charplot:yaxchar #\:)
+(define charplot:curve1 #\*)
+(define charplot:xtick #\.)
+
+(define charplot:height (- charplot:rows 5))
+(define charplot:width (- charplot:columns 15))
+
+(define (charplot:printn! n char)
+  (cond ((positive? n)
+	 (write-char char)
+	 (charplot:printn! (+ n -1) char))))
+
+(define (charplot:center-print! str width)
+  (let ((lpad (quotient (- width (string-length str)) 2)))
+    (charplot:printn! lpad #\ )
+    (display str)
+    (charplot:printn! (- width (+ (string-length  str) lpad)) #\ )))
+
+(define (scale-it z scale)
+  (if (and (exact? z) (integer? z))
+      (quotient (* z (car scale)) (cadr scale))
+      (inexact->exact (round (/ (* z (car scale)) (cadr scale))))))
+
+(define (find-scale isize delta)
+  (if (inexact? delta) (set! isize (exact->inexact isize)))
+  (do ((d 1 (* d 10)))
+      ((<= delta isize)
+       (do ((n 1 (* n 10)))
+	   ((>= (* delta 10) isize)
+	    (list (* n (cond ((< (* delta 8) isize) 8)
+			     ((< (* delta 6) isize) 6)
+			     ((< (* delta 5) isize) 5)
+			     ((< (* delta 4) isize) 4)
+			     ((< (* delta 3) isize) 3)
+			     ((< (* delta 2) isize) 2)
+			     (else 1)))
+		  d))
+	 (set! delta (* delta 10))))
+    (set! isize (* isize 10))))
+
+(define (charplot:iplot! data xlabel ylabel xmin xscale ymin yscale)
+  (define xaxis (- (scale-it ymin yscale)))
+  (define yaxis (- (scale-it xmin xscale)))
+  (charplot:center-print! ylabel 11)
+  (charplot:printn! (+ charplot:width 1) charplot:xborder)
+  (newline)
+  (set! data (sort! data (lambda (x y) (if (= (cdr x) (cdr y))
+					   (< (car x) (car y))
+					   (> (cdr x) (cdr y))))))
+  (do ((ht (- charplot:height 1) (- ht 1)))
+      ((negative? ht))
+    (let ((a (make-string (+ charplot:width 1)
+			  (if (= ht xaxis) charplot:xaxchar #\ )))
+	  (ystep (if (= 1 (gcd (car yscale) 3)) 2 3)))
+      (string-set! a charplot:width charplot:yborder)
+      (if (< -1 yaxis charplot:width) (string-set! a yaxis charplot:yaxchar))
+      (do ()
+	  ((or (null? data) (not (>= (cdar data) ht))))
+	(string-set! a (caar data) charplot:curve1)
+	(set! data (cdr data)))
+      (if (zero? (modulo (- ht xaxis) ystep))
+	  (let* ((v (number->string (/ (* (- ht xaxis) (cadr yscale))
+				       (car yscale))))
+		 (l (string-length v)))
+	    (if (> l 10)
+		(display (substring v 0 10))
+		(begin
+		  (charplot:printn! (- 10 l) #\ )
+		  (display v)))
+	    (display charplot:yborder)
+	    (display charplot:xaxchar))
+	  (begin
+	    (charplot:printn! 10 #\ )
+	    (display charplot:yborder)
+	    (display #\ )))
+      (display a) (newline)))
+  (let* ((xstep (if (= 1 (gcd (car xscale) 3)) 10 12))
+	 (xstep/2 (quotient (- xstep 2) 2))
+	 (fudge (modulo yaxis xstep)))
+    (charplot:printn! 10 #\ ) (display charplot:yborder)
+    (charplot:printn! (+ 1 fudge) charplot:xborder)
+    (display charplot:yaxchar)
+    (do ((i fudge (+ i xstep)))
+	((> (+ i xstep) charplot:width)
+	 (charplot:printn! (modulo (- charplot:width (+ i 1)) xstep)
+			   charplot:xborder))
+      (charplot:printn! xstep/2 charplot:xborder)
+      (display charplot:xtick)
+      (charplot:printn! xstep/2 charplot:xborder)
+      (display charplot:yaxchar))
+    (display charplot:yborder) (newline)
+    (charplot:center-print! xlabel (+ 12 fudge (- xstep/2)))
+    (do ((i fudge (+ i xstep)))
+	((> (+ i xstep) charplot:width))
+      (charplot:center-print! (number->string (/ (* (- i yaxis) (cadr xscale))
+						 (car xscale)))
+			      xstep))
+    (newline)))
+
+(define (charplot:plot! data xlabel ylabel)
+  (let* ((xmax (apply max (map car data)))
+	 (xmin (apply min (map car data)))
+	 (xscale (find-scale charplot:width (- xmax xmin)))
+	 (ymax (apply max (map cdr data)))
+	 (ymin (apply min (map cdr data)))
+	 (yscale (find-scale charplot:height (- ymax ymin)))
+	 (ixmin (scale-it xmin xscale))
+	 (iymin (scale-it ymin yscale)))
+    (charplot:iplot! (map (lambda (p)
+			    (cons (- (scale-it (car p) xscale) ixmin)
+				  (- (scale-it (cdr p) yscale) iymin)))
+			  data)
+		     xlabel ylabel xmin xscale ymin yscale)))
+
+(define plot! charplot:plot!)
diff --git a/chez.init b/chez.init
new file mode 100644
index 0000000..a91cce3
--- /dev/null
+++ b/chez.init
@@ -0,0 +1,266 @@
+;"chez.init" Initialization file for SLIB for Chez Scheme	-*-scheme-*-
+; Copyright (C) 1993 dorai@cs.rice.edu (Dorai Sitaram)
+; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; (software-type) should be set to the generic operating system type.
+;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
+
+(define (software-type) 'UNIX)
+
+(define (scheme-implementation-type) 'Chez)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "?")
+
+(define implementation-vicinity
+  (lambda () "/usr/local/lib/scheme/"))
+
+;; library-vicinity is moved below the defination of getenv
+
+(define *features*
+  '(
+    source				;can load scheme source files
+					;(slib:load-source "filename")
+    compiled				;can load compiled files
+					;(slib:load-compiled "filename")
+    char-ready?
+    delay
+    dynamic-wind
+    fluid-let
+    format
+    full-continuation
+    getenv
+    ieee-p1178
+    macro
+    multiarg/and-
+    multiarg-apply
+    pretty-print
+    random
+    random-inexact
+    rationalize
+    rev3-procedures
+    rev3-report
+    rev4-optional-procedures
+    rev4-report
+    sort
+    system
+    transcript
+    with-file
+    string-port
+    ))
+
+;R4RS define-syntax in terms of Chez's extend-syntax.
+;Caveat: no let-syntax
+
+(extend-syntax (define-syntax syntax-rules)
+  ((define-syntax name (syntax-rules kwds . clauses))
+   (extend-syntax (name . kwds) . clauses)))
+
+;DEFINED?
+(define-syntax defined?
+  (syntax-rules ()
+    ((defined? x) (or (bound? 'x) (get 'x '*expander*)))))
+
+;Chez's sort routines have the opposite parameter order to Slib's
+(define chez:sort sort)
+(define chez:sort! sort!)
+(define chez:merge merge)
+(define chez:merge! merge!)
+
+(define sort
+  (lambda (s p)
+    (chez:sort p s)))
+(define sort!
+  (lambda (s p)
+    (chez:sort! p s)))
+(define merge
+  (lambda (s1 s2 p)
+    (chez:merge p s1 s2)))
+(define merge!
+  (lambda (s1 s2 p)
+    (chez:merge! p s1 s2)))
+
+;RENAME-FILE
+(define rename-file
+  (lambda (src dst)
+    (system (string-append "mv " src " " dst))))
+
+;OUTPUT-PORT-WIDTH
+(define output-port-width (lambda arg 79))
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (let ((port (current-output-port)))
+    (lambda () port)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam
+  (let ((cntr 100))
+    (lambda () (set! cntr (+ 1 cntr))
+	    (let ((tmp (string-append "slib_" (number->string cntr))))
+	      (if (file-exists? tmp) (tmpnam) tmp)))))
+
+;GETENV
+(provide-foreign-entries '("getenv"))
+(define getenv
+  (foreign-procedure "getenv"
+    (string) string))
+
+(define library-vicinity
+  (let ((library-path (or (getenv "SCHEME_LIBRARY_PATH")
+			  "/usr/local/lib/slib/")))
+    (lambda () library-path)))
+
+;FORCE-OUTPUT
+(define force-output flush-output)
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+(define (call-with-output-string f)
+  (let ((outsp (open-output-string)))
+    (f outsp)
+    (let ((s (get-output-string outsp)))
+      (close-output-port outsp)
+      s)))
+
+(define (call-with-input-string s f)
+  (let* ((insp (open-input-string s))
+	 (res (f insp)))
+    (close-input-port insp)
+    res))
+
+;CHAR-CODE-LIMIT
+(define char-code-limit 256)
+
+;Chez's MOST-POSITIVE-FIXNUM is a thunk rather than a number
+(if (procedure? most-positive-fixnum)
+    (set! most-positive-fixnum (most-positive-fixnum)))
+
+;;; Return argument
+(define (identity x) x)
+
+(define slib:eval eval)
+
+(define-macro! defmacro z `(define-macro! ,@z))
+
+(define (defmacro? m) (get m '*expander*))
+
+(define macroexpand-1 eps-expand-once)
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (if (and (symbol? a) (getprop a '*expander*))
+		      (macroexpand (expand-once e))
+		      e))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define defmacro:eval slib:eval)
+(define macro:eval slib:eval)
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;Chez's (FORMAT f . a) corresponds to Slib's (FORMAT #f f . a)
+
+(define chez:format format)
+(define format
+  (lambda (where how . args)
+    (let ((str (apply chez:format how args)))
+      (cond ((not where) str)
+	    ((eq? where #t) (display str))
+	    (else (display str where))))))
+
+(define slib:error
+  (lambda args
+    (let ((port (current-error-port)))
+      (display "Error: " port)
+      (for-each (lambda (x) (display x port)) args)
+      (error #f ""))))
+
+(define slib:tab #\tab)
+(define slib:form-feed #\page)
+
+;Chez's nil variable is bound to '() rather than #f
+
+(define nil #f)
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:chez:quit
+  (let ([arg (call-with-current-continuation (lambda (x) x))])
+    (cond [(procedure? arg) arg]
+	  [arg (exit)]
+	  [else (exit 1)])))
+
+(define slib:exit
+  (lambda args
+    (cond ((null? args) (slib:chez:quit #t))
+	  ((eqv? #t (car args)) (slib:chez:quit #t))
+	  ((eqv? #f (car args)) (slib:chez:quit #f))
+	  ((zero? (car args)) (slib:chez:quit #t))
+	  (else (slib:chez:quit #f)))))
+
+;;; Here for backward compatability
+;Note however that ".ss" is a common Chez file suffix
+(define (scheme-file-suffix) ".scm")
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+(define (slib:load-source f) (load (string-append f (scheme-file-suffix))))
+
+;;; defmacro:load and macro:load also need the default suffix
+(define defmacro:load slib:load-source)
+(define macro:load slib:load-source)
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
+;end chez.init
diff --git a/cltime.scm b/cltime.scm
new file mode 100644
index 0000000..248f638
--- /dev/null
+++ b/cltime.scm
@@ -0,0 +1,74 @@
+;;;; "cltime.scm" Common-Lisp time conversion routines.
+;;; Copyright (C) 1994 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'values)
+(require 'posix-time)
+
+(define (get-decoded-time)
+  (decode-universal-time (get-universal-time)))
+
+(define (get-universal-time)
+  (difftime (current-time) time:1900))
+
+(define (decode-universal-time utime . tzarg)
+  (let* ((tz (if (null? tzarg) *timezone* (* 3600 (car tzarg))))
+	 (tv (time:split
+	      (offset-time time:1900 utime)
+	      (if (null? tzarg) time:daylight 0)
+	      tz
+	      (if (= tz *timezone*) (vector-ref time:tzname time:daylight)
+		  ""))))
+    (values
+     (vector-ref tv 0)			;second	[0..59]
+     (vector-ref tv 1)			;minute	[0..59]
+     (vector-ref tv 2)			;hour	[0..23]
+     (vector-ref tv 3)			;date	[1..31]
+     (+ 1 (vector-ref tv 4))		;month	[1..12]
+     (+ 1900 (vector-ref tv 5))		;year	[0....]
+     (modulo (+ -1 (vector-ref tv 6)) 7);day-of-week	[0..6] (0 is Monday)
+     (eqv? 1 (vector-ref tv 8))		;daylight-saving-time?
+     (if (provided? 'inexact)
+	 (inexact->exact (/ (vector-ref tv 9) 3600))
+	 (/ (vector-ref tv 9) 3600))	;time-zone	[-24..24]
+     )))
+
+(define time:1900 (time:invert time:gmtime #(0 0 0 1 0 0 #f #f 0 0 "GMT")))
+
+(define (encode-universal-time second minute hour date month year . tzarg)
+  (let* ((tz (if (null? tzarg) *timezone*
+		 (* 3600 (car tzarg))))
+	 (tv (vector second
+		     minute
+		     hour
+		     date
+		     (+ -1 month)
+		     (+ -1900 year)
+		     #f			;ignored
+		     #f			;ignored
+		     (if (= tz *timezone*) time:daylight 0)
+		     tz
+		     (cond ((= tz *timezone*)
+			    (vector-ref time:tzname time:daylight))
+			   ((zero? tz) "GMT")
+			   (else ""))
+		     )))
+    (if (= tz *timezone*) (difftime (time:invert localtime tv) time:1900)
+	(difftime (offset-time (time:invert gmtime tv) tz) time:1900))))
+
+(tzset)
diff --git a/collect.scm b/collect.scm
new file mode 100644
index 0000000..abdf209
--- /dev/null
+++ b/collect.scm
@@ -0,0 +1,236 @@
+;"collect.scm" Sample collection operations
+; COPYRIGHT (c) Kenneth Dickey 1992
+;
+;               This software may be used for any purpose whatever
+;               without warrantee of any kind.
+; AUTHOR        Ken Dickey
+; DATE          1992 September 1
+; LAST UPDATED  1992 September 2
+; NOTES         Expository (optimizations & checks elided).
+;               Requires YASOS (Yet Another Scheme Object System).
+
+(require 'yasos)
+
+(define-operation (collect:collection? obj)
+ ;; default
+  (cond
+    ((or (list? obj) (vector? obj) (string? obj)) #t)
+    (else #f)
+) )
+
+(define (collect:empty? collection) (zero? (yasos:size collection)))
+
+(define-operation (collect:gen-elts <collection>) ;; return element generator
+  ;; default behavior
+  (cond                      ;; see utilities, below, for generators
+    ((vector? <collection>) (collect:vector-gen-elts <collection>)) 
+    ((list?   <collection>) (collect:list-gen-elts   <collection>))
+    ((string? <collection>) (collect:string-gen-elts <collection>))
+    (else 
+     (slib:error "Operation not supported: GEN-ELTS " (yasos:print obj #f)))
+) )
+
+(define-operation (collect:gen-keys collection)
+  (if (or (vector? collection) (list? collection) (string? collection))
+      (let ( (max+1 (yasos:size collection)) (index 0) )
+	 (lambda ()
+            (cond
+	      ((< index max+1)
+	       (set! index (collect:add1 index))
+	       (collect:sub1 index))
+	      (else (slib:error "no more keys in generator"))
+      ) ) )
+      (slib:error "Operation not handled: GEN-KEYS " collection)
+) )
+
+(define (collect:do-elts <proc> . <collections>)
+  (let ( (max+1 (yasos:size (car <collections>)))
+         (generators (map collect:gen-elts <collections>))
+       )
+    (let loop ( (counter 0) )
+       (cond
+          ((< counter max+1)
+           (apply <proc> (map (lambda (g) (g)) generators))
+           (loop (collect:add1 counter))
+          )
+          (else 'unspecific)  ; done
+    )  )
+) )
+
+(define (collect:do-keys <proc> . <collections>)
+  (let ( (max+1 (yasos:size (car <collections>)))
+         (generators (map collect:gen-keys <collections>))
+       )
+    (let loop ( (counter 0) )
+       (cond
+          ((< counter max+1)
+           (apply <proc> (map (lambda (g) (g)) generators))
+           (loop (collect:add1 counter))
+          )
+          (else 'unspecific)  ; done
+    )  )
+) )
+
+(define (collect:map-elts <proc> . <collections>)
+  (let ( (max+1 (yasos:size (car <collections>)))
+         (generators (map collect:gen-elts <collections>))
+         (vec (make-vector (yasos:size (car <collections>))))
+       )
+    (let loop ( (index 0) )
+       (cond
+          ((< index max+1)
+           (vector-set! vec index (apply <proc> (map (lambda (g) (g)) generators)))
+           (loop (collect:add1 index))
+          )
+          (else vec)  ; done
+    )  )
+) )
+
+(define (collect:map-keys <proc> . <collections>)
+  (let ( (max+1 (yasos:size (car <collections>)))
+         (generators (map collect:gen-keys <collections>))
+	 (vec (make-vector (yasos:size (car <collections>))))
+       )
+    (let loop ( (index 0) )
+       (cond
+          ((< index max+1)
+           (vector-set! vec index (apply <proc> (map (lambda (g) (g)) generators)))
+           (loop (collect:add1 index))
+          )
+          (else vec)  ; done
+    )  )
+) )
+
+(define-operation (collect:for-each-key <collection> <proc>)
+   ;; default
+   (collect:do-keys <proc> <collection>)  ;; talk about lazy!
+)
+
+(define-operation (collect:for-each-elt <collection> <proc>)
+   (collect:do-elts <proc> <collection>)
+)
+
+(define (collect:reduce <proc> <seed> . <collections>)
+   (let ( (max+1 (yasos:size (car <collections>)))
+          (generators (map collect:gen-elts <collections>))
+        )
+     (let loop ( (count 0) )
+       (cond
+          ((< count max+1)
+           (set! <seed> 
+                 (apply <proc> <seed> (map (lambda (g) (g)) generators)))
+           (loop (collect:add1 count))
+          )
+          (else <seed>)
+     ) )
+)  )
+
+
+
+;; pred true for every elt?
+(define (collect:every? <pred?> . <collections>)
+   (let ( (max+1 (yasos:size (car <collections>)))
+          (generators (map collect:gen-elts <collections>))
+        )
+     (let loop ( (count 0) )
+       (cond
+          ((< count max+1)
+           (if (apply <pred?> (map (lambda (g) (g)) generators))
+               (loop (collect:add1 count))
+               #f)
+          )
+          (else #t)
+     ) )
+)  )
+
+;; pred true for any elt?
+(define (collect:any? <pred?> . <collections>)
+   (let ( (max+1 (yasos:size (car <collections>)))
+          (generators (map collect:gen-elts <collections>))
+        )
+     (let loop ( (count 0) )
+       (cond
+          ((< count max+1)
+           (if (apply <pred?> (map (lambda (g) (g)) generators))
+               #t
+               (loop (collect:add1 count))
+          ))
+          (else #f)
+     ) )
+)  )
+
+
+;; MISC UTILITIES
+
+(define (collect:add1 obj)  (+ obj 1))
+(define (collect:sub1 obj)  (- obj 1))
+
+;; Nota Bene:  list-set! is bogus for element 0
+
+(define (collect:list-set! <list> <index> <value>)
+
+  (define (set-loop last this idx)
+     (cond
+        ((zero? idx) 
+         (set-cdr! last (cons <value> (cdr this)))
+         <list>
+        )
+        (else (set-loop (cdr last) (cdr this) (collect:sub1 idx)))
+  )  )
+
+  ;; main
+  (if (zero? <index>)
+      (cons <value> (cdr <list>))  ;; return value
+      (set-loop <list> (cdr <list>) (collect:sub1 <index>)))
+)
+
+(add-setter list-ref collect:list-set!)  ; for (setter list-ref)
+
+
+;; generator for list elements
+(define (collect:list-gen-elts <list>)
+  (lambda ()
+     (if (null? <list>)
+         (slib:error "No more list elements in generator")
+         (let ( (elt (car <list>)) )
+           (set! <list> (cdr <list>))
+           elt))
+) )
+
+;; generator for vector elements
+(define (collect:make-vec-gen-elts <accessor>)
+  (lambda (vec)
+    (let ( (max+1 (yasos:size vec))
+           (index 0)
+         )
+      (lambda () 
+         (cond ((< index max+1)
+                (set! index (collect:add1 index))
+                (<accessor> vec (collect:sub1 index))
+               )
+               (else #f)
+      )  )
+  ) )
+)
+
+(define collect:vector-gen-elts (collect:make-vec-gen-elts vector-ref))
+
+(define collect:string-gen-elts (collect:make-vec-gen-elts string-ref))
+
+;;; exports:
+
+(define collection? collect:collection?)
+(define empty? collect:empty?)
+(define gen-keys collect:gen-keys)
+(define gen-elts collect:gen-elts)
+(define do-elts collect:do-elts)
+(define do-keys collect:do-keys)
+(define map-elts collect:map-elts)
+(define map-keys collect:map-keys)
+(define for-each-key collect:for-each-key)
+(define for-each-elt collect:for-each-elt)
+(define reduce collect:reduce)		; reduce is also in comlist.scm
+(define every? collect:every?)
+(define any? collect:any?)
+
+;;                        --- E O F "collect.oo" ---                    ;;
diff --git a/comlist.scm b/comlist.scm
new file mode 100644
index 0000000..2c243fe
--- /dev/null
+++ b/comlist.scm
@@ -0,0 +1,326 @@
+;;"comlist.scm" Implementation of COMMON LISP list functions for Scheme
+; Copyright (C) 1991, 1993, 1995 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; Some of these functions may be already defined in your Scheme.
+;;; Comment out those definitions for functions which are already defined.
+
+;;;; LIST FUNCTIONS FROM COMMON LISP
+
+;;;From: hugh@ear.mit.edu (Hugh Secker-Walker)
+(define (comlist:make-list k . init)
+  (set! init (if (pair? init) (car init)))
+  (do ((k k (+ -1 k))
+       (result '() (cons init result)))
+      ((<= k 0) result)))
+
+(define (comlist:copy-list lst) (append lst '()))
+
+(define (comlist:adjoin e l) (if (memq e l) l (cons e l)))
+
+(define (comlist:union l1 l2)
+  (cond ((null? l1) l2)
+	((null? l2) l1)
+	(else (comlist:union (cdr l1) (comlist:adjoin (car l1) l2)))))
+
+(define (comlist:intersection l1 l2)
+  (cond ((null? l1) l1)
+	((null? l2) l2)
+	((memv (car l1) l2) (cons (car l1) (comlist:intersection (cdr l1) l2)))
+	(else (comlist:intersection (cdr l1) l2))))
+
+(define (comlist:set-difference l1 l2)
+  (cond ((null? l1) l1)
+	((memv (car l1) l2) (comlist:set-difference (cdr l1) l2))
+	(else (cons (car l1) (comlist:set-difference (cdr l1) l2)))))
+
+(define (comlist:position obj lst)
+  (letrec ((pos (lambda (n lst)
+		  (cond ((null? lst) #f)
+			((eqv? obj (car lst)) n)
+			(else (pos (+ 1 n) (cdr lst)))))))
+    (pos 0 lst)))
+
+(define (comlist:reduce-init p init l)
+  (if (null? l)
+      init
+      (comlist:reduce-init p (p init (car l)) (cdr l))))
+
+(define (comlist:reduce p l)
+  (cond ((null? l) l)
+	((null? (cdr l)) (car l))
+	(else (comlist:reduce-init p (car l) (cdr l)))))
+
+(define (comlist:some pred l . rest)
+  (cond ((null? rest)
+	 (let mapf ((l l))
+	   (and (not (null? l))
+		(or (pred (car l)) (mapf (cdr l))))))
+	(else (let mapf ((l l) (rest rest))
+		(and (not (null? l))
+		     (or (apply pred (car l) (map car rest))
+			 (mapf (cdr l) (map cdr rest))))))))
+
+(define (comlist:every pred l . rest)
+  (cond ((null? rest)
+	 (let mapf ((l l))
+	   (or (null? l)
+	       (and (pred (car l)) (mapf (cdr l))))))
+	(else (let mapf ((l l) (rest rest))
+		(or (null? l)
+		    (and (apply pred (car l) (map car rest))
+			 (mapf (cdr l) (map cdr rest))))))))
+
+(define (comlist:notany pred . ls) (not (apply comlist:some pred ls)))
+
+(define (comlist:notevery pred . ls) (not (apply comlist:every pred ls)))
+
+(define (comlist:find-if t l)
+  (cond ((null? l) #f)
+	((t (car l)) (car l))
+	(else (comlist:find-if t (cdr l)))))
+
+(define (comlist:member-if t l)
+  (cond ((null? l) #f)
+	((t (car l)) l)
+	(else (comlist:member-if t (cdr l)))))
+
+(define (comlist:remove p l)
+  (cond ((null? l) l)
+	((eqv? p (car l)) (comlist:remove p (cdr l)))
+	(else (cons (car l) (comlist:remove p (cdr l))))))
+
+(define (comlist:remove-if p l)
+  (cond ((null? l) l)
+	((p (car l)) (comlist:remove-if p (cdr l)))
+	(else (cons (car l) (comlist:remove-if p (cdr l))))))
+
+(define (comlist:remove-if-not p l)
+  (cond ((null? l) l)
+	((p (car l)) (cons (car l) (comlist:remove-if-not p (cdr l))))
+	(else (comlist:remove-if-not p (cdr l)))))
+
+(define comlist:nconc
+  (if (provided? 'rev2-procedures) append!
+      (lambda args
+	(cond ((null? args) '())
+	      ((null? (cdr args)) (car args))
+	      ((null? (car args)) (apply comlist:nconc (cdr args)))
+	      (else
+	       (set-cdr! (last-pair (car args))
+			 (apply comlist:nconc (cdr args)))
+	       (car args))))))
+
+;;;From: hugh@ear.mit.edu (Hugh Secker-Walker)
+(define (comlist:nreverse rev-it)
+;;; Reverse order of elements of LIST by mutating cdrs.
+  (cond ((null? rev-it) rev-it)
+	((not (list? rev-it))
+	 (slib:error "nreverse: Not a list in arg1" rev-it))
+	(else (do ((reved '() rev-it)
+		   (rev-cdr (cdr rev-it) (cdr rev-cdr))
+		   (rev-it rev-it rev-cdr))
+		  ((begin (set-cdr! rev-it reved) (null? rev-cdr)) rev-it)))))
+
+(define (comlist:butlast lst n)
+  (letrec ((l (- (length lst) n))
+	   (bl (lambda (lst n)
+		 (cond ((null? lst) lst)
+		       ((positive? n)
+			(cons (car lst) (bl (cdr lst) (+ -1 n))))
+		       (else '())))))
+    (bl lst (if (negative? n)
+		(slib:error "negative argument to butlast" n)
+		l))))
+
+(define (comlist:nthcdr n lst)
+  (if (zero? n) lst (comlist:nthcdr (+ -1 n) (cdr lst))))
+
+(define (comlist:last lst n)
+  (comlist:nthcdr (- (length lst) n) lst))
+
+;;;; CONDITIONALS
+
+(define (comlist:and? . args)
+  (cond ((null? args) #t)
+	((car args) (apply comlist:and? (cdr args)))
+	(else #f)))
+
+(define (comlist:or? . args)
+  (cond ((null? args) #f)
+	((car args) #t)
+	(else (apply comlist:or? (cdr args)))))
+
+; Checks to see if a list has any duplicates.
+(define (comlist:has-duplicates? lst)
+  (cond ((null? lst) #f)
+	((member (car lst) (cdr lst)) #t)
+	(else (comlist:has-duplicates? (cdr lst)))))
+
+(define (comlist:list* x . y)	
+  (define (list*1 x)
+    (if (null? (cdr x))
+	(car x)
+	(cons (car x) (list*1 (cdr x)))))
+  (if (null? y)
+      x
+      (cons x (list*1 y))))
+
+(define (comlist:atom? a)
+  (not (pair? a)))
+
+(define (type-of obj)
+  (cond
+   ((null? obj)		'null)
+   ((boolean? obj)	'boolean)
+   ((char? obj)		'char)
+   ((number? obj)	'number)
+   ((string? obj)	'string)
+   ((symbol? obj)	'symbol)
+   ((input-port? obj)	'port)
+   ((output-port? obj)	'port)
+   ((procedure? obj)	'procedure)
+   ((eof-object? obj)	'eof-object)
+   ((list? obj)		'list)
+   ((pair? obj)		'pair)
+   ((and (provided? 'array) (array? obj))	'array)
+   ((and (provided? 'record) (record? obj))	'record)
+   ((vector? obj)	'vector)
+   (else		'?)))
+
+(define (coerce obj result-type)
+  (define (err) (slib:error 'coerce "couldn't" obj '-> result-type))
+  (define obj-type (type-of obj))
+  (cond
+   ((eq? obj-type result-type) obj)
+   (else
+    (case obj-type
+      ((char)   (case result-type
+		  ((number) (char->integer obj))
+		  ((string) (string obj))
+		  ((symbol) (string->symbol (string obj)))
+		  ((list)   (list obj))
+		  ((vector) (vector obj))
+		  (else     (err))))
+      ((number) (case result-type
+		  ((char)   (integer->char obj))
+		  ((atom)   obj)
+		  ((string) (number->string obj))
+		  ((symbol) (string->symbol (number->string obj)))
+		  ((list)   (string->list (number->string obj)))
+		  ((vector) (list->vector (string->list (number->string obj))))
+		  (else     (err))))
+      ((string) (case result-type
+		  ((char)   (if (= 1 (string-length obj)) (string-ref obj 0)
+				(err)))
+		  ((atom)   (or (string->number obj) (string->symbol obj)))
+		  ((number) (or (string->number obj) (err)))
+		  ((symbol) (string->symbol obj))
+		  ((list)   (string->list obj))
+		  ((vector) (list->vector (string->list obj)))
+		  (else     (err))))
+      ((symbol) (case result-type
+		  ((char)   (coerce (symbol->string obj) 'char))
+		  ((number) (coerce (symbol->string obj) 'number))
+		  ((string) (symbol->string obj))
+		  ((atom)   obj)
+		  ((list)   (string->list (symbol->string obj)))
+		  ((vector) (list->vector (string->list (symbol->string obj))))
+		  (else     (err))))
+      ((list)   (case result-type
+		  ((char)   (if (and (= 1 (length obj))
+				     (char? (car obj)))
+				(car obj)
+				(err)))
+		  ((number) (or (string->number (list->string obj)) (err)))
+		  ((string) (list->string obj))
+		  ((symbol) (string->symbol (list->string obj)))
+		  ((vector) (list->vector obj))
+		  (else     (err))))
+      ((vector) (case result-type
+		  ((char)   (if (and (= 1 (vector-length obj))
+				     (char? (vector-ref obj 0)))
+				(vector-ref obj 0)
+				(err)))
+		  ((number) (or (string->number (coerce obj string)) (err)))
+		  ((string) (list->string (vector->list obj)))
+		  ((symbol) (string->symbol (coerce obj string)))
+		  ((list)   (list->vector obj))
+		  (else     (err))))
+      (else (err))))))
+
+(define (comlist:delete obj list)
+  (let delete ((list list))
+    (cond ((null? list) '())
+	  ((equal? obj (car list)) (delete (cdr list)))
+	  (else
+	   (set-cdr! list (delete (cdr list)))
+	   list)))) 
+
+(define (comlist:delete-if pred list)
+  (let delete-if ((list list))
+    (cond ((null? list) '())
+	  ((pred (car list)) (delete-if (cdr list)))
+	  (else
+	   (set-cdr! list (delete-if (cdr list)))
+	   list)))) 
+
+(define (comlist:delete-if-not pred list)
+  (let delete-if ((list list))
+    (cond ((null? list) '())
+	  ((not (pred (car list))) (delete-if (cdr list)))
+	  (else
+	   (set-cdr! list (delete-if (cdr list)))
+	   list)))) 
+
+;;; exports
+
+(define make-list comlist:make-list)
+(define copy-list comlist:copy-list)
+(define adjoin comlist:adjoin)
+(define union comlist:union)
+(define intersection comlist:intersection)
+(define set-difference comlist:set-difference)
+(define position comlist:position)
+(define reduce-init comlist:reduce-init)
+(define reduce comlist:reduce) ; reduce is also in collect.scm
+(define some comlist:some)
+(define every comlist:every)
+(define notevery comlist:notevery)
+(define notany comlist:notany)
+(define find-if comlist:find-if)
+(define member-if comlist:member-if)
+(define remove comlist:remove)
+(define remove-if comlist:remove-if)
+(define remove-if-not comlist:remove-if-not)
+(define nconc comlist:nconc)
+(define nreverse comlist:nreverse)
+(define butlast comlist:butlast)
+(define nthcdr comlist:nthcdr)
+(define last comlist:last)
+(define and? comlist:and?)
+(define or? comlist:or?)
+(define has-duplicates? comlist:has-duplicates?)
+
+(define delete-if-not comlist:delete-if-not)
+(define delete-if comlist:delete-if)
+(define delete comlist:delete)
+(define comlist:atom comlist:atom?)
+(define atom comlist:atom?)
+(define atom? comlist:atom?)
+(define list* comlist:list*)
diff --git a/comparse.scm b/comparse.scm
new file mode 100644
index 0000000..add47c8
--- /dev/null
+++ b/comparse.scm
@@ -0,0 +1,92 @@
+;;; "comparse.scm" Break command line into arguments.
+;Copyright (C) 1995 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;;; This is a simple command-line reader.  It could be made fancier
+;;; to handle lots of `shell' syntaxes.
+
+(require 'string-port)
+(define (read-command . port)
+  (define argv '())
+  (define obj "")
+  (define chars '())
+  (define eof #f)
+  (define readc (lambda () (read-char port)))
+  (define peekc (lambda () (peek-char port)))
+  (define s-expression
+    (lambda ()
+      (splice-arg (call-with-output-string
+		   (lambda (p) (display (slib:eval (read port)) p))))))
+  (define (backslash goto)
+    (readc)
+    (cond ((char=? #\newline (peekc)) (readc) (goto (peekc)))
+	  (else (set! chars (cons (readc) chars))
+		(build-token (peekc)))))
+  (define loop
+    (lambda (c)
+      (case c
+	((#\\) (backslash loop))
+	((#\") (splice-arg (read port)))
+	((#\( #\') (s-expression))
+	((#\#)
+	 (do ((c (readc) (readc)))
+	     ((or (eof-object? c) (char=? #\newline c) c))))
+	((#\; #\newline) (readc))
+	(else
+	 (cond ((eof-object? c) c)
+	       ((char-whitespace? c) (readc) (loop (peekc)))
+	       (else (build-token c)))))))
+  (define splice-arg
+    (lambda (arg)
+      (set! obj (string-append obj (list->string (reverse chars)) arg))
+      (set! chars '())
+      (build-token (peekc))))
+  (define build-token
+    (lambda (c)
+      (case c
+	((#\") (splice-arg (read port)))
+	((#\() (s-expression))
+	((#\\) (backslash build-token))
+	((#\newline #\;)
+	 (readc)
+	 (set! argv (cons (string-append
+			   obj (list->string (reverse chars)))
+			  argv)))
+	(else
+	 (cond ((or (eof-object? c)
+		    (char-whitespace? c))
+		(readc)
+		(set! argv (cons (string-append
+				  obj (list->string (reverse chars)))
+				 argv))
+		(set! obj "")
+		(set! chars '())
+		(loop (peekc)))
+	       (else (set! chars (cons (readc) chars))
+		     (build-token (peekc))))))))
+  (set! port
+	(cond ((null? port) (current-input-port))
+	      ((= 1 (length port)) (car port))
+	      (else
+	       (slib:error
+		'read-command-line
+		"Wrong Number of ARGs:"
+		port))))
+  (let ((c (loop (peekc))))
+    (cond ((and (null? argv) (eof-object? c)) c)
+	  (else (reverse argv)))))
diff --git a/dbrowse.scm b/dbrowse.scm
new file mode 100644
index 0000000..aaa4635
--- /dev/null
+++ b/dbrowse.scm
@@ -0,0 +1,98 @@
+;;; "dbrowse.scm" relational-database-browser
+; Copyright 1996 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'database-utilities)
+(require 'printf)
+
+(define browse:db #f)
+
+(define (browse . args)
+  (define table-name '*catalog-data*)
+  (cond ((null? args))
+	((procedure? (car args))
+	 (set! browse:db (car args))
+	 (set! args (cdr args)))
+	((string? (car args))
+	 (set! browse:db (open-database (car args)))
+	 (set! args (cdr args))))
+  (cond ((null? args))
+	(else (set! table-name (car args))))
+  (let* ((open-table (browse:db 'open-table))
+	 (catalog (and open-table (open-table '*catalog-data* #f))))
+    (cond ((not catalog)
+	   (slib:error 'browse "could not open catalog"))
+	  ((eq? table-name '*catalog-data*)
+	   (browse:display-dir '*catalog-data* catalog))
+	  (else
+	   (let ((table (open-table table-name #f)))
+	     (cond (table (browse:display-table table-name table)
+			  (table 'close-table))
+		   (else (slib:error 'browse "could not open table"
+				     table-name))))))))
+
+(define (browse:display-dir table-name table)
+  (printf "%s Tables:
+" table-name)
+  ((table 'for-each-row)
+   (lambda (row)
+     (printf "	%s
+"
+	     (car row)))))
+
+(define (browse:display-table table-name table)
+  (let* ((width 18)
+	 (dw (string-append "%-" (number->string width)))
+	 (dwp (string-append "%-" (number->string width) "."
+			     (number->string (+ -1 width))))
+	 (dwp-string (string-append dwp "s"))
+	 (dwp-any (string-append dwp "a"))
+	 (dw-integer (string-append dw "d"))
+	 (underline (string-append (make-string (+ -1 width) #\=) " "))
+	 (form ""))
+    (printf "Table: %s
+" table-name)
+    (for-each (lambda (name) (printf dwp-string name))
+	      (table 'column-names))
+    (newline)
+    (for-each (lambda (foreign) (printf dwp-any foreign))
+	      (table 'column-foreigns))
+    (newline)
+    (for-each (lambda (domain) (printf dwp-string domain))
+	      (table 'column-domains))
+    (newline)
+    (for-each (lambda (type)
+		(case type
+		  ((integer number uint base-id)
+		   (set! form (string-append form dw-integer)))
+		  ((boolean domain expression atom)
+		   (set! form (string-append form dwp-any)))
+		  ((string symbol)
+		   (set! form (string-append form dwp-string)))
+		  (else (slib:error 'browse:display-table "unknown type" type)))
+		(printf dwp-string type))
+	      (table 'column-types))
+    (newline)
+    (set! form (string-append form "
+"))
+    (for-each (lambda (domain) (printf underline))
+	      (table 'column-domains))
+    (newline)
+    ((table 'for-each-row)
+     (lambda (row)
+       (apply printf form row)))))
diff --git a/dbutil.scm b/dbutil.scm
new file mode 100644
index 0000000..ffaaf9d
--- /dev/null
+++ b/dbutil.scm
@@ -0,0 +1,222 @@
+;;; "dbutil.scm" relational-database-utilities
+; Copyright 1994, 1995 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'relational-database)
+
+(define (db:base-type path)
+  'alist-table)				; currently the only one.
+
+(define (dbutil:wrap-command-interface rdb)
+  (and rdb
+       (let* ((rdms:commands ((rdb 'open-table) '*commands* #f))
+	      (command:get
+	       (and rdms:commands (rdms:commands 'get 'procedure))))
+	 (and command:get
+	      (letrec ((wdb (lambda (command)
+			      (let ((com (command:get command)))
+				(cond (com ((slib:eval com) wdb))
+				      (else (rdb command)))))))
+		(let ((init (wdb '*initialize*)))
+		  (if (procedure? init) init wdb)))))))
+
+(define (dbutil:open-database! path . arg)
+  (let ((type (if (null? arg) (db:base-type path) (car arg))))
+    (require type)
+    (dbutil:wrap-command-interface
+     (((make-relational-system (slib:eval type)) 'open-database)
+      path #t))))
+
+(define (dbutil:open-database path . arg)
+  (let ((type (if (null? arg) (db:base-type path) (car arg))))
+    (require type)
+    (dbutil:wrap-command-interface
+     (((make-relational-system (slib:eval type)) 'open-database)
+      path #f))))
+
+(define (dbutil:create-database path type)
+  (require type)
+  (let ((rdb (((make-relational-system (slib:eval type)) 'create-database)
+	      path)))
+    (dbutil:define-tables
+     rdb
+     '(parameter-arity
+       ((name symbol))
+       ((predicate? expression)
+	(procedure expression))
+       ((single (lambda (a) (and (pair? a) (null? (cdr a)))) car)
+	(optional
+	 (lambda (lambda (a) (or (null? a) (and (pair? a) (null? (cdr a))))))
+	 identity)
+	(boolean
+	 (lambda (a) (or (null? a)
+			 (and (pair? a) (null? (cdr a)) (boolean? (car a)))))
+	 (lambda (a) (if (null? a) #f (car a))))
+	(nary (lambda (a) #t) identity)
+	(nary1 (lambda (a) (not (null? a))) identity))))
+    (for-each (((rdb 'open-table) '*domains-data* #t) 'row:insert)
+	      '((parameter-list *catalog-data* #f symbol #f)
+		(parameter-name-translation *catalog-data* #f symbol #f)
+		(parameter-arity parameter-arity #f symbol #f)))
+    (dbutil:define-tables
+     rdb
+     '(*parameter-columns*
+       *columns*
+       *columns*
+       ((1 #t index #f uint)
+	(2 #f name #f symbol)
+	(3 #f arity #f parameter-arity)
+	(4 #f domain #f domain)
+	(5 #f default #f expression)
+	(6 #f expander #f expression)
+	(7 #f documentation #f string)))
+     '(no-parameters
+       *parameter-columns*
+       *parameter-columns*
+       ())
+     '(no-parameter-names
+       ((name string))
+       ((parameter-index uint))
+       ())
+     '(*commands*
+       ((name symbol))
+       ((parameters parameter-list)
+	(parameter-names parameter-name-translation)
+	(procedure expression)
+	(documentation string))
+       ((domain-checker
+	 no-parameters
+	 no-parameter-names
+	 (lambda (rdb)
+	   (let* ((ro:domains ((rdb 'open-table) '*domains-data* #f))
+		  (ro:get-dir (ro:domains 'get 'domain-integrity-rule))
+		  (ro:for-tab (ro:domains 'get 'foreign-table)))
+	     (lambda (domain)
+	       (let ((fkname (ro:for-tab domain))
+		     (dir (slib:eval (ro:get-dir domain))))
+		 (cond (fkname (let* ((fktab ((rdb 'open-table) fkname #f))
+				      (p? (fktab 'get 1)))
+				 (cond (dir (lambda (e) (and (dir e) (p? e))))
+				       (else p?))))
+		       (else dir))))))
+	 "return procedure to check given domain name")
+
+	(add-domain
+	 no-parameters
+	 no-parameter-names
+	 (lambda (rdb)
+	   (((rdb 'open-table) '*domains-data* #t) 'row:insert))
+	 "given the row describing it, add a domain")
+
+	(delete-domain
+	 no-parameters
+	 no-parameter-names
+	 (lambda (rdb)
+	   (((rdb 'open-table) '*domains-data* #t) 'row:remove))
+	 "given its name, delete a domain"))))
+    (dbutil:wrap-command-interface rdb)))
+
+(define (make-command-server rdb command-table)
+  (let* ((comtab ((rdb 'open-table) command-table #f))
+	 (names (comtab 'column-names))
+	 (row-ref (lambda (row name) (list-ref row (position name names))))
+	 (comgetrow (comtab 'row:retrieve)))
+    (lambda (comname command-callback)
+      (let* ((command:row (comgetrow comname))
+	     (parameter-table ((rdb 'open-table)
+			       (row-ref command:row 'parameters) #f))
+	     (parameter-names
+	      ((rdb 'open-table) (row-ref command:row 'parameter-names) #f))
+	     (comval ((slib:eval (row-ref command:row 'procedure)) rdb))
+	     (options ((parameter-table 'get* 'name)))
+	     (positions ((parameter-table 'get* 'index)))
+	     (arities ((parameter-table 'get* 'arity)))
+	     (defaults (map slib:eval ((parameter-table 'get* 'default))))
+	     (domains ((parameter-table 'get* 'domain)))
+	     (types (map (((rdb 'open-table) '*domains-data* #f) 'get 'type-id)
+			 domains))
+	     (dirs (map (rdb 'domain-checker) domains))
+	     (aliases
+	      (map list ((parameter-names 'get* 'name))
+		   (map (parameter-table 'get 'name)
+			((parameter-names 'get* 'parameter-index))))))
+	(command-callback comname comval options positions
+			  arities types defaults dirs aliases)))))
+
+(define (dbutil:define-tables rdb . spec-list)
+  (define new-tables '())
+  (define dom:typ (((rdb 'open-table) '*domains-data* #f) 'get 4))
+  (define create-table (rdb 'create-table))
+  (define open-table (rdb 'open-table))
+  (define table-exists? (rdb 'table-exists?))
+  (define (check-domain dname)
+    (cond ((dom:typ dname))
+	  ((member dname new-tables)
+	   (let* ((ftab (open-table
+			 (string->symbol
+			  (string-append "desc:" (symbol->string dname)))
+			 #f)))
+	     ((((rdb 'open-table) '*domains-data* #t) 'row:insert)
+	      (list dname dname #f
+		    (dom:typ ((ftab 'get 'domain-name) 1)) #f))))))
+  (define (define-table name prikeys slots data)
+    (cond
+     ((table-exists? name)
+      (let* ((tab (open-table name #t))
+	     (row:update (tab 'row:update)))
+	(for-each row:update data)))
+     ((and (symbol? prikeys) (eq? prikeys slots))
+      (cond ((not (table-exists? slots))
+	     (slib:error "Table doesn't exist:" slots)))
+      (set! new-tables (cons name new-tables))
+      (let* ((tab (create-table name slots))
+	     (row:insert (tab 'row:insert)))
+	(for-each row:insert data)
+	((tab 'close-table))))
+     (else
+      (let* ((descname
+	      (string->symbol (string-append "desc:" (symbol->string name))))
+	     (tab (create-table descname))
+	     (row:insert (tab 'row:insert))
+	     (j 0))
+	(set! new-tables (cons name new-tables))
+	(for-each (lambda (des)
+		    (set! j (+ 1 j))
+		    (check-domain (cadr des))
+		    (row:insert (list j #t (car des)
+				      (if (null? (cddr des)) #f (caddr des))
+				      (cadr des))))
+		  prikeys)
+	(for-each (lambda (des)
+		    (set! j (+ 1 j))
+		    (check-domain (cadr des))
+		    (row:insert (list j #f (car des)
+				      (if (null? (cddr des)) #f (caddr des))
+				      (cadr des))))
+		  slots)
+	((tab 'close-table))
+	(set! tab (create-table name descname))
+	(set! row:insert (tab 'row:insert))
+	(for-each row:insert data)
+	((tab 'close-table))))))
+  (for-each (lambda (spec) (apply define-table spec)) spec-list))
+
+(define create-database dbutil:create-database)
+(define open-database! dbutil:open-database!)
+(define open-database dbutil:open-database)
+(define define-tables dbutil:define-tables)
diff --git a/debug.scm b/debug.scm
new file mode 100644
index 0000000..08406a9
--- /dev/null
+++ b/debug.scm
@@ -0,0 +1,78 @@
+;;;; "debug.scm" Utility functions for debugging in Scheme.
+;;; Copyright (C) 1991, 1992, 1993, 1995 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'trace)
+(require 'break)
+
+(define (for-each-top-level-definition-in-file file proc)
+  (call-with-input-file
+      file
+    (lambda
+	(port)
+      (letrec
+	  ((walk
+	    (lambda (exp)
+	      (cond
+	       ((not (and (pair? exp) (list? exp))))
+	       ((not (symbol? (car exp))))
+	       (else
+		(case (car exp)
+		  ((begin) (for-each walk (cdr exp)))
+		  ((cond)  (for-each
+			    (lambda (exp)
+			      (for-each walk
+					(if (list? (car exp)) exp (cdr exp))))
+			    (cdr exp)))
+		  ((if)    (for-each
+			    walk
+			    (if (list? (cadr exp)) (cdr exp) (cddr exp))))
+		  ((defmacro define-syntax) "should do something clever here")
+		  ((define)
+		   (proc exp))))))))
+	(do ((form (read port) (read port)))
+	    ((eof-object? form))
+	  (walk form))))))
+
+(define (for-each-top-level-defined-procedure-symbol-in-file file proc)
+  (letrec ((get-defined-symbol
+	    (lambda (form)
+	      (if (pair? form)
+		  (get-defined-symbol (car form))
+		  form))))
+    (for-each-top-level-definition-in-file
+     file
+     (lambda (form) (let ((sym (get-defined-symbol (cadr form))))
+		      (cond ((procedure? (slib:eval sym))
+			     (proc sym))))))))
+
+(define (debug:trace-all file)
+  (for-each-top-level-defined-procedure-symbol-in-file
+   file
+   (lambda (sym)
+     (slib:eval `(set! ,sym (trace:tracef ,sym ',sym))))))
+
+(define trace-all debug:trace-all)
+
+(define (debug:break-all file)
+  (for-each-top-level-defined-procedure-symbol-in-file
+   file
+   (lambda (sym)
+     (slib:eval `(set! ,sym (break:breakf ,sym ',sym))))))
+
+(define break-all debug:break-all)
diff --git a/defmacex.scm b/defmacex.scm
new file mode 100644
index 0000000..bdaf020
--- /dev/null
+++ b/defmacex.scm
@@ -0,0 +1,96 @@
+;;;"defmacex.scm" defmacro:expand* for any Scheme dialect.
+;;;Copyright 1993-1994 Dorai Sitaram and Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;;expand thoroughly, not just topmost expression.  While expanding
+;;;subexpressions, the primitive forms quote, lambda, set!, let/*/rec,
+;;;cond, case, do, quasiquote: need to be destructured properly.  (if,
+;;;and, or, begin: don't need special treatment.)
+
+(define (defmacro:iqq e depth)
+  (letrec
+      ((map1 (lambda (f x)
+	       (if (pair? x) (cons (f (car x)) (map1 f (cdr x)))
+		   x)))
+       (iqq (lambda (e depth)
+	      (if (pair? e)
+		  (case (car e)
+		    ((quasiquote) (list (car e) (iqq (cadr e) (+ 1 depth))))
+		    ((unquote unquote-splicing)
+		     (list (car e) (if (= 1 depth)
+				       (defmacro:expand* (cadr e))
+				       (iqq (cadr e) (+ -1 depth)))))
+		    (else (map1 (lambda (e) (iqq e depth)) e)))
+		  e))))
+    (iqq e depth)))
+
+(define (defmacro:expand* e)
+  (if (pair? e)
+      (let* ((c (macroexpand-1 e)))
+	(if (not (eq? e c))
+	    (defmacro:expand* c)
+	    (case (car e)
+	      ((quote) e)
+	      ((quasiquote) (defmacro:iqq e 0))
+	      ((lambda define set!)
+	       (cons (car e) (cons (cadr e) (map defmacro:expand* (cddr e)))))
+	      ((let)
+	       (let ((b (cadr e)))
+		 (if (symbol? b)	;named let
+		     `(let ,b
+			,(map (lambda (vv)
+				`(,(car vv)
+				  ,(defmacro:expand* (cadr vv))))
+			      (caddr e))
+			,@(map defmacro:expand*
+			       (cdddr e)))
+		     `(let
+			  ,(map (lambda (vv)
+				  `(,(car vv)
+				    ,(defmacro:expand* (cadr vv))))
+				b)
+			,@(map defmacro:expand*
+			       (cddr e))))))
+	      ((let* letrec)
+	       `(,(car e) ,(map (lambda (vv)
+				  `(,(car vv)
+				    ,(defmacro:expand* (cadr vv))))
+				(cadr e))
+			  ,@(map defmacro:expand* (cddr e))))
+	      ((cond)
+	       `(cond
+		 ,@(map (lambda (c)
+			  (map defmacro:expand* c))
+			(cdr e))))
+	      ((case)
+	       `(case ,(defmacro:expand* (cadr e))
+		  ,@(map (lambda (c)
+			   `(,(car c)
+			     ,@(map defmacro:expand* (cdr c))))
+			 (cddr e))))
+	      ((do)
+	       `(do ,(map
+		      (lambda (initsteps)
+			`(,(car initsteps)
+			  ,@(map defmacro:expand*
+				 (cdr initsteps))))
+		      (cadr e))
+		    ,(map defmacro:expand* (caddr e))
+		  ,@(map defmacro:expand* (cdddr e))))
+	      (else (map defmacro:expand* e)))))
+      e))
diff --git a/dwindtst.scm b/dwindtst.scm
new file mode 100644
index 0000000..8d64800
--- /dev/null
+++ b/dwindtst.scm
@@ -0,0 +1,80 @@
+;;;; "dwindtst.scm", routines for characterizing dynamic-wind.
+;Copyright (C) 1992 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'dynamic-wind)
+
+(define (dwtest n)
+  (define cont #f)
+  (display "testing escape from thunk") (display n) (newline)
+  (display "visiting:") (newline)
+  (call-with-current-continuation
+   (lambda (x) (set! cont x)))
+  (if n
+      (dynamic-wind
+       (lambda ()
+	 (display "thunk1") (newline)
+	 (if (eqv? n 1) (let ((ntmp n))
+			  (set! n #f)
+			  (cont ntmp))))
+       (lambda ()
+	 (display "thunk2") (newline)
+	 (if (eqv? n 2) (let ((ntmp n))
+			  (set! n #f)
+			  (cont ntmp))))
+       (lambda ()
+	 (display "thunk3") (newline)
+	 (if (eqv? n 3) (let ((ntmp n))
+			  (set! n #f)
+			  (cont ntmp)))))))
+(define (dwctest n)
+  (define cont #f)
+  (define ccont #f)
+  (display "creating continuation thunk") (newline)
+  (display "visiting:") (newline)
+  (call-with-current-continuation
+   (lambda (x) (set! cont x)))
+  (if n (set! n (- n)))
+  (if n
+      (dynamic-wind
+       (lambda ()
+	 (display "thunk1") (newline)
+	 (if (eqv? n 1) (let ((ntmp n))
+			  (set! n #f)
+			  (cont ntmp))))
+       (lambda ()
+	 (call-with-current-continuation
+	  (lambda (x) (set! ccont x)))
+	 (display "thunk2") (newline)
+	 (if (eqv? n 2) (let ((ntmp n))
+			  (set! n #f)
+			  (cont ntmp))))
+       (lambda ()
+	 (display "thunk3") (newline)
+	 (if (eqv? n 3) (let ((ntmp n))
+			  (set! n #f)
+			  (cont ntmp))))))
+  (cond
+   (n
+    (set! n (- n))
+    (display "testing escape from continuation thunk") (display n) (newline)
+    (display "visiting:") (newline)
+    (ccont #f))))
+
+(dwtest 1) (dwtest 2) (dwtest 3)
+(dwctest 1) (dwctest 2) (dwctest 3)
diff --git a/dynamic.scm b/dynamic.scm
new file mode 100644
index 0000000..937f93e
--- /dev/null
+++ b/dynamic.scm
@@ -0,0 +1,75 @@
+; "dynamic.scm", DYNAMIC data type for Scheme
+; Copyright 1992 Andrew Wilcox.
+;
+; You may freely copy, redistribute and modify this package.
+
+(require 'record)
+(require 'dynamic-wind)
+
+(define dynamic-environment-rtd
+  (make-record-type "dynamic environment" '(dynamic value parent)))
+(define make-dynamic-environment
+  (record-constructor dynamic-environment-rtd))
+(define dynamic-environment:dynamic
+  (record-accessor dynamic-environment-rtd 'dynamic))
+(define dynamic-environment:value
+  (record-accessor dynamic-environment-rtd 'value))
+(define dynamic-environment:set-value!
+  (record-modifier dynamic-environment-rtd 'value))
+(define dynamic-environment:parent
+  (record-accessor dynamic-environment-rtd 'parent))
+
+(define *current-dynamic-environment* #f)
+(define (extend-current-dynamic-environment dynamic obj)
+  (set! *current-dynamic-environment*
+	(make-dynamic-environment dynamic obj
+				  *current-dynamic-environment*)))
+
+(define dynamic-rtd (make-record-type "dynamic" '()))
+(define make-dynamic
+  (let ((dynamic-constructor (record-constructor dynamic-rtd)))
+    (lambda (obj)
+      (let ((dynamic (dynamic-constructor)))
+	(extend-current-dynamic-environment dynamic obj)
+	dynamic))))
+
+(define dynamic? (record-predicate dynamic-rtd))
+(define (guarantee-dynamic dynamic)
+  (or (dynamic? dynamic)
+      (slib:error "Not a dynamic" dynamic)))
+
+(define dynamic:errmsg
+  "No value defined for this dynamic in the current dynamic environment")
+
+(define (dynamic-ref dynamic)
+  (guarantee-dynamic dynamic)
+  (let loop ((env *current-dynamic-environment*))
+    (cond ((not env)
+	   (slib:error dynamic:errmsg dynamic))
+	  ((eq? (dynamic-environment:dynamic env) dynamic)
+	   (dynamic-environment:value env))
+	  (else
+	   (loop (dynamic-environment:parent env))))))
+
+(define (dynamic-set! dynamic obj)
+  (guarantee-dynamic dynamic)
+  (let loop ((env *current-dynamic-environment*))
+    (cond ((not env)
+	   (slib:error dynamic:errmsg dynamic))
+	  ((eq? (dynamic-environment:dynamic env) dynamic)
+	   (dynamic-environment:set-value! env obj))
+	  (else
+	   (loop (dynamic-environment:parent env))))))
+
+(define (call-with-dynamic-binding dynamic obj thunk)
+  (let ((out-thunk-env #f)
+	(in-thunk-env (make-dynamic-environment
+		       dynamic obj
+		       *current-dynamic-environment*)))
+    (dynamic-wind (lambda ()
+		    (set! out-thunk-env *current-dynamic-environment*)
+		    (set! *current-dynamic-environment* in-thunk-env))
+		  thunk
+		  (lambda ()
+		    (set! in-thunk-env *current-dynamic-environment*)
+		    (set! *current-dynamic-environment* out-thunk-env)))))
diff --git a/dynwind.scm b/dynwind.scm
new file mode 100644
index 0000000..9212422
--- /dev/null
+++ b/dynwind.scm
@@ -0,0 +1,74 @@
+; "dynwind.scm", wind-unwind-protect for Scheme
+; Copyright (c) 1992, 1993 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;This facility is a generalization of Common Lisp `unwind-protect',
+;designed to take into account the fact that continuations produced by
+;CALL-WITH-CURRENT-CONTINUATION may be reentered.
+
+;  (dynamic-wind <thunk1> <thunk2> <thunk3>)		procedure
+
+;The arguments <thunk1>, <thunk2>, and <thunk3> must all be procedures
+;of no arguments (thunks).
+
+;DYNAMIC-WIND calls <thunk1>, <thunk2>, and then <thunk3>.  The value
+;returned by <thunk2> is returned as the result of DYNAMIC-WIND.
+;<thunk3> is also called just before control leaves the dynamic
+;context of <thunk2> by calling a continuation created outside that
+;context.  Furthermore, <thunk1> is called before reentering the
+;dynamic context of <thunk2> by calling a continuation created inside
+;that context.  (Control is inside the context of <thunk2> if <thunk2>
+;is on the current return stack).
+
+;;;WARNING: This code has no provision for dealing with errors or
+;;;interrupts.  If an error or interrupt occurs while using
+;;;dynamic-wind, the dynamic environment will be that in effect at the
+;;;time of the error or interrupt.
+
+(define dynamic:winds '())
+
+(define (dynamic-wind <thunk1> <thunk2> <thunk3>)
+  (<thunk1>)
+  (set! dynamic:winds (cons (cons <thunk1> <thunk3>) dynamic:winds))
+  (let ((ans (<thunk2>)))
+    (set! dynamic:winds (cdr dynamic:winds))
+    (<thunk3>)
+    ans))
+
+(define call-with-current-continuation
+  (let ((oldcc call-with-current-continuation))
+    (lambda (proc)
+      (let ((winds dynamic:winds))
+	(oldcc
+	 (lambda (cont)
+	   (proc (lambda (c2)
+		   (dynamic:do-winds winds (- (length dynamic:winds)
+					      (length winds)))
+		   (cont c2)))))))))
+
+(define (dynamic:do-winds to delta)
+  (cond ((eq? dynamic:winds to))
+	((negative? delta)
+	 (dynamic:do-winds (cdr to) (+ 1 delta))
+	 ((caar to))
+	 (set! dynamic:winds to))
+	(else
+	 (let ((from (cdar dynamic:winds)))
+	   (set! dynamic:winds (cdr dynamic:winds))
+	   (from)
+	   (dynamic:do-winds to (+ -1 delta))))))
diff --git a/elk.init b/elk.init
new file mode 100644
index 0000000..f6dded0
--- /dev/null
+++ b/elk.init
@@ -0,0 +1,281 @@
+;;;"elk.init" Initialisation file for SLIB for ELK 2.1	-*- Scheme -*-
+;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+; No guarantees are given about the correctness of any of the
+; choices made below.  Only enough work was done to get the require
+; mechanism to work correctly.
+;
+; Stephen J. Bevan <bevan@cs.man.ac.uk> 19920912 modified by Mike
+; Sperber to work correctly with statically-linked Elk and slib1d.  Be
+; sure to change the library vicinities according to your local
+; configuration.  If you're running MS-DOS (which is possible since
+; 2.1), you probably have to change this file to make everything work
+; correctly.
+
+;;; (software-type) should be set to the generic operating system type.
+;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
+
+(define (software-type) 'UNIX)
+
+;;; (scheme-implementation-type) should return the name of the scheme
+;;; implementation loading this file.
+
+(define (scheme-implementation-type) 'Elk)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "?2.1")
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxillary files to your Scheme
+;;; implementation reside.
+
+(define (implementation-vicinity)
+  (case (software-type)
+    ((UNIX)	 "/usr/local/lib/elk-2.1/scm/")
+    ((VMS)	"scheme$src:")
+    ((MS-DOS)	"C:\\scheme\\")))
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+(define library-vicinity
+  (let ((library-path
+	 (or (getenv "SCHEME_LIBRARY_PATH")
+	     ;; Uses this path if SCHEME_LIBRARY_PATH is not defined.
+	     (case (software-type)
+	       ((UNIX) "/usr/local/lib/slib/")
+	       ((VMS) "lib$scheme:")
+	       ((MS-DOS) "C:\\SLIB\\")
+	       (else "")))))
+    (lambda () library-path)))
+
+;;; *features* should be set to a list of symbols describing features
+;;; of this implementation.  Suggestions for features are:
+
+(define *features*
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+	rev4-report
+	ieee-p1178
+	sicp
+	rev4-optional-procedures
+	rev3-procedures
+	rev2-procedures
+	multiarg/and-
+	multiarg-apply
+	delay
+	transcript
+	full-continuation
+	sort
+	format
+	system
+	getenv
+	program-arguments
+	string-port
+	))
+
+;------------
+
+(define program-arguments
+  (lambda ()
+    (cons "undefined-program-name" (command-line-args))))
+
+; EXACT? appears to always return #f which isn't very useful.
+; Approximating it with INTEGER? at least means that some
+; of the code in the library will work correctly
+
+(define exact? integer?)  ; WARNING: redefining EXACT?
+
+(define (inexact? arg)
+  (not (exact? arg)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam
+  (let ((cntr 100))
+    (lambda () (set! cntr (+ 1 cntr))
+	    (let ((tmp (string-append "slib_" (number->string cntr))))
+	      (if (file-exists? tmp) (tmpnam) tmp)))))
+
+(require 'unix)
+
+; Pull in GENTENV and SYSTEM
+
+;;; (FILE-EXISTS? <string>) already here.
+
+;;; (DELETE-FILE <string>)
+(define (delete-file f) (system (string-append "rm " f)))
+
+;------------
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define (output-port-width . arg) 79)
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+;;; is already defined in Elk 2.1
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;; use this definition if your system doesn't have such a procedure.
+(define force-output flush-output-port)
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+(define (call-with-output-string f)
+  (let ((outsp (open-output-string)))
+    (f outsp)
+    (let ((s (get-output-string outsp)))
+      (close-output-port outsp)
+      s)))
+
+(define (call-with-input-string s f)
+  (let* ((insp (open-input-string s))
+	 (res (f insp)))
+    (close-input-port insp)
+    res))
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.
+(define char-code-limit 256)
+
+;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum 8388608)  ; 23 bit integers ?
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+(define slib:eval eval)
+
+(define *macros* '())
+(define (defmacro? m) (and (assq m *macros*) #t))
+
+(define-macro (defmacro key pattern . body)
+  `(begin
+     (define-macro ,(cons key pattern) ,@body)
+     (set! *macros* (cons (cons ',key (lambda ,pattern ,@body)) *macros*))))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a) (set! a (assq a *macros*))
+				     (if a (apply (cdr a) (cdr e)) e))
+			(else e)))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a)
+			 (set! a (assq a *macros*))
+			 (if a (macroexpand (apply (cdr a) (cdr e))) e))
+			(else e)))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define defmacro:eval slib:eval)
+(define defmacro:load load)
+;;; If your implementation provides R4RS macros:
+;(define macro:eval slib:eval)
+;(define macro:load load)
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;;; define an error procedure for the library
+(define slib:error error)
+
+;;; define these as appropriate for your system.
+(define slib:tab #\tab)
+(define slib:form-feed #\formfeed)
+
+;;; Define these if your implementation's syntax can support it and if
+;;; they are not already defined.
+
+;(define (1+ n) (+ n 1))
+;(define (-1+ n) (+ n -1))
+;(define 1- -1+)
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:exit
+  (lambda args
+    (exit (cond ((null? args) 0)
+		((eqv? #t (car args)) 0)
+		((and (number? (car args)) (integer? (car args))) (car args))
+		(else 1)))))
+
+;;; Here for backward compatability
+(define scheme-file-suffix
+  (let ((suffix (case (software-type)
+		  ((NOSVE) "_scm")
+		  (else ".scm"))))
+    (lambda () suffix)))
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+; Modify the already modified _load_ so that it copes with
+; environments correctly.  The change involves using
+; _(global-environment)_ if none is explicitly specified.
+; If this is not done, definitions in files loaded by other files will
+; not be loaded in the correct environment.
+
+(define slib:load-source
+  (let ((primitive-load load))
+    (lambda (<pathname> . rest)
+      (let ((env (if (null? rest) (list (global-environment)) rest)))
+	(apply primitive-load <pathname> env)))))
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled
+  (let ((primitive-load load))
+    (lambda (<pathname> . rest)
+      (apply primitive-load (string->symbol (string-append name ".o")) rest))))
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)	;WARNING: redefining LOAD
+
+(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/factor.scm b/factor.scm
new file mode 100644
index 0000000..a5d3e8c
--- /dev/null
+++ b/factor.scm
@@ -0,0 +1,149 @@
+;;;; "factor.scm", prime test and factorization for Scheme
+;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'random)
+(require 'modular)
+
+;;; (modulo p 16) is because we care only about the low order bits.
+;;; The odd? tests are inline of (expt -1 ...)
+
+(define (prime:jacobi-symbol p q)
+  (cond ((zero? p) 0)
+	((= 1 p) 1)
+	((odd? p)
+	 (if (odd? (quotient (* (- (modulo p 16) 1) (- q 1)) 4))
+	     (- (prime:jacobi-symbol (modulo q p) p))
+	     (prime:jacobi-symbol (modulo q p) p)))
+	(else
+	 (let ((qq (modulo q 16)))
+	   (if (odd? (quotient (- (* qq qq) 1) 8))
+	       (- (prime:jacobi-symbol (quotient p 2) q))
+	       (prime:jacobi-symbol (quotient p 2) q))))))
+
+;;;; Solovay-Strassen Prime Test
+;;;   if n is prime, then J(a,n) is congruent mod n to a**((n-1)/2)
+
+;;; See:
+;;;   Robert Solovay and Volker Strassen,
+;;;     "A Fast Monte-Carlo Test for Primality,"
+;;;     SIAM Journal on Computing, 1977, pp 84-85.
+
+;;; checks if n is prime.  Returns #f if not prime. #t if (probably) prime.
+;;;   probability of a mistake = (expt 2 (- prime:trials))
+;;;     choosing prime:trials=30 should be enough
+(define prime:trials 30)
+;;; prime:product is a product of small primes.
+(define prime:product
+  (let ((p 210))
+    (for-each (lambda (s) (set! p (or (string->number s) p)))
+      '("2310" "30030" "510510" "9699690" "223092870"
+	       "6469693230" "200560490130"))
+    p))
+
+(define (prime:prime? n)
+  (set! n (abs n))
+  (cond ((<= n 36) (and (memv n '(2 3 5 7 11 13 17 19 23 29 31)) #t))
+	((= 1 (gcd n prime:product))
+	 (do ((i prime:trials (- i 1))
+	      (a (+ 1 (random (- n 1))) (+ 1 (random (- n 1)))))
+	     ((not (and (positive? i)
+			(= (gcd a n) 1)
+			(= (modulo (prime:jacobi-symbol a n) n)
+			   (modular:expt n a (quotient (- n 1) 2)))))
+	      (if (positive? i) #f #t))))
+	(else #f)))
+
+;;;;Lankinen's recursive factoring algorithm:
+;From: ld231782@longs.LANCE.ColoState.EDU (L. Detweiler)
+
+;                  |  undefined if n<0,
+;                  |  (u,v) if n=0,
+;Let f(u,v,b,n) := | [otherwise]
+;                  |  f(u+b,v,2b,(n-v)/2) or f(u,v+b,2b,(n-u)/2) if n odd
+;                  |  f(u,v,2b,n/2) or f(u+b,v+b,2b,(n-u-v-b)/2) if n even
+
+;Thm: f(1,1,2,(m-1)/2) = (p,q) iff pq=m for odd m.
+ 
+;It may be illuminating to consider the relation of the Lankinen function in
+;a `computational hierarchy' of other factoring functions.*  Assumptions are
+;made herein on the basis of conventional digital (binary) computers.  Also,
+;complexity orders are given for the worst case scenarios (when the number to
+;be factored is prime).  However, all algorithms would probably perform to
+;the same constant multiple of the given orders for complete composite
+;factorizations.
+ 
+;Thm: Eratosthenes' Sieve is very roughtly O(ln(n)/n) in time and
+;     O(n*log2(n)) in space.
+;Pf: It works with all prime factors less than n (about ln(n)/n by the prime
+;    number thm), requiring an array of size proportional to n with log2(n)
+;    space for each entry.
+
+;Thm: `Odd factors' is O((sqrt(n)/2)*log2(n)) in time and O(log2(n)) in
+;     space.
+;Pf: It tests all odd factors less than the square root of n (about
+;    sqrt(n)/2), with log2(n) time for each division.  It requires only
+;    log2(n) space for the number and divisors.
+ 
+;Thm: Lankinen's algorithm is O(sqrt(n)/2) in time and O((sqrt(n)/2)*log2(n))
+;     in space.
+;Pf: The algorithm is easily modified to seach only for factors p<q for all
+;    pq=m.  Then the recursive call tree forms a geometric progression
+;    starting at one, and doubling until reaching sqrt(n)/2, or a length of
+;    log2(sqrt(n)/2).  From the formula for a geometric progression, there is
+;    a total of about 2^log2(sqrt(n)/2) = sqrt(n)/2 calls.  Assuming that
+;    addition, subtraction, comparison, and multiplication/division by two
+;    occur in constant time, this implies O(sqrt(n)/2) time and a
+;    O((sqrt(n)/2)*log2(n)) requirement of stack space.
+
+(define (prime:f u v b n)
+  (if (<= n 0)
+      (cond ((negative? n) #f)
+	    ((= u 1) #f)
+	    ((= v 1) #f)
+	    ; Do both of these factors need to be factored?
+	    (else (append (or (prime:f 1 1 2 (quotient (- u 1) 2))
+			      (list u))
+			  (or (prime:f 1 1 2 (quotient (- v 1) 2))
+			      (list v)))))
+      (if (even? n)
+	  (or (prime:f u v (+ b b) (quotient n 2))
+	      (prime:f (+ u b) (+ v b) (+ b b) (quotient (- n (+ u v b)) 2)))
+	  (or (prime:f (+ u b) v (+ b b) (quotient (- n v) 2))
+	      (prime:f u (+ v b) (+ b b) (quotient (- n u) 2))))))
+
+(define (prime:factor m)
+  (if
+   (negative? m) (cons -1 (prime:factor (- m)))
+   (let* ((s (gcd m prime:product))
+	  (r (quotient m s)))
+     (if (even? s)
+	 (append
+	  (if (= 1 r) '() (prime:factor r))
+	  (cons 2 (let ((s/2 (quotient s 2)))
+		    (if (= s/2 1) '()
+			(or (prime:f 1 1 2 (quotient (- s/2 1) 2))
+			    (list s/2))))))
+	 (if (= 1 s) (or (prime:f 1 1 2 (quotient (- m 1) 2)) (list m))
+	     (append (if (= 1 r) '()
+			 (or (prime:f 1 1 2 (quotient (- r 1) 2)) (list r)))
+		     (or (prime:f 1 1 2 (quotient (- s 1) 2)) (list s))))))))
+
+(define jacobi-symbol prime:jacobi-symbol)
+(define prime? prime:prime?)
+(define factor prime:factor)
diff --git a/fluidlet.scm b/fluidlet.scm
new file mode 100644
index 0000000..c93b288
--- /dev/null
+++ b/fluidlet.scm
@@ -0,0 +1,45 @@
+; "fluidlet.scm", FLUID-LET for Scheme
+; Copyright (c) 1992, Dorai Sitaram (dorai@cs.rice.edu)
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'rev4-optional-procedures)
+(require 'common-list-functions)
+(require 'dynamic-wind)
+(require 'macro)
+
+(define list-set! (lambda (s i v) (set-car! (list-tail s i) v)))
+
+(define-syntax fluid-let
+  (syntax-rules ()
+    ((fluid-let ((x v) ...) . body)
+     (let ((%x-names (list 'x ...))
+	   (%x-values (list x ...))
+	   (%fluid-x-values (list v ...)))
+       (dynamic-wind
+	 (lambda ()
+           (set! x (list-ref %fluid-x-values
+		       (comlist:position 'x %x-names)))
+           ...)
+	 (lambda () . body)
+	 (lambda ()
+           (let ((%x-position (comlist:position 'x %x-names)))
+             (list-set! %fluid-x-values %x-position x)
+	     (set! x (list-ref %x-values %x-position)))
+	   ...))))))
+
+;--- end of file
diff --git a/format.scm b/format.scm
new file mode 100644
index 0000000..1650e72
--- /dev/null
+++ b/format.scm
@@ -0,0 +1,1678 @@
+;;; "format.scm" Common LISP text output formatter for SLIB
+; Written 1992-1994 by Dirk Lutzebaeck (lutzeb@cs.tu-berlin.de)
+;
+; This code is in the public domain.
+
+; Authors of the original version (< 1.4) were Ken Dickey and Aubrey Jaffer.
+; Please send error reports to the email address above.
+; For documentation see slib.texi and format.doc.
+; For testing load formatst.scm.
+;
+; Version 3.0
+
+(provide 'format)
+(require 'string-case)
+(require 'string-port)
+(require 'rev4-optional-procedures)
+
+;;; Configuration ------------------------------------------------------------
+
+(define format:symbol-case-conv #f)
+;; Symbols are converted by symbol->string so the case of the printed
+;; symbols is implementation dependent. format:symbol-case-conv is a
+;; one arg closure which is either #f (no conversion), string-upcase!,
+;; string-downcase! or string-capitalize!.
+
+(define format:iobj-case-conv #f)
+;; As format:symbol-case-conv but applies for the representation of
+;; implementation internal objects.
+
+(define format:expch #\E)
+;; The character prefixing the exponent value in ~e printing.
+
+(define format:floats (provided? 'inexact))
+;; Detects if the scheme system implements flonums (see at eof).
+
+(define format:complex-numbers (provided? 'complex))
+;; Detects if the scheme system implements complex numbers.
+
+(define format:radix-pref (char=? #\# (string-ref (number->string 8 8) 0)))
+;; Detects if number->string adds a radix prefix.
+
+(define format:ascii-non-printable-charnames
+  '#("nul" "soh" "stx" "etx" "eot" "enq" "ack" "bel"
+     "bs"  "ht"  "nl"  "vt"  "np"  "cr"  "so"  "si"
+     "dle" "dc1" "dc2" "dc3" "dc4" "nak" "syn" "etb"
+     "can" "em"  "sub" "esc" "fs"  "gs"  "rs"  "us" "space"))
+
+;;; End of configuration ----------------------------------------------------
+
+(define format:version "3.0")
+(define format:port #f)			; curr. format output port
+(define format:output-col 0)		; curr. format output tty column
+(define format:flush-output #f)		; flush output at end of formatting
+(define format:case-conversion #f)
+(define format:error-continuation #f)
+(define format:args #f)
+(define format:pos 0)			; curr. format string parsing position
+(define format:arg-pos 0)		; curr. format argument position
+					; this is global for error presentation
+
+; format string and char output routines on format:port
+
+(define (format:out-str str)
+  (if format:case-conversion
+      (display (format:case-conversion str) format:port)
+      (display str format:port))
+  (set! format:output-col
+	(+ format:output-col (string-length str))))
+
+(define (format:out-char ch)
+  (if format:case-conversion
+      (display (format:case-conversion (string ch)) format:port)
+      (write-char ch format:port))
+  (set! format:output-col
+	(if (char=? ch #\newline)
+	    0
+	    (+ format:output-col 1))))
+
+;(define (format:out-substr str i n)  ; this allocates a new string
+;  (display (substring str i n) format:port)
+;  (set! format:output-col (+ format:output-col n)))
+
+(define (format:out-substr str i n)
+  (do ((k i (+ k 1)))
+      ((= k n))
+    (write-char (string-ref str k) format:port))
+  (set! format:output-col (+ format:output-col n)))
+
+;(define (format:out-fill n ch)       ; this allocates a new string
+;  (format:out-str (make-string n ch)))
+
+(define (format:out-fill n ch)
+  (do ((i 0 (+ i 1)))
+      ((= i n))
+    (write-char ch format:port))
+  (set! format:output-col (+ format:output-col n)))
+
+; format's user error handler
+
+(define (format:error . args)		; never returns!
+  (let ((error-continuation format:error-continuation)
+	(format-args format:args)
+	(port (current-error-port)))
+    (set! format:error format:intern-error)
+    (if (and (>= (length format:args) 2)
+	     (string? (cadr format:args)))
+	(let ((format-string (cadr format-args)))
+	  (if (not (zero? format:arg-pos))
+	      (set! format:arg-pos (- format:arg-pos 1)))
+	  (format port "~%FORMAT: error with call: (format ~a \"~a<===~a\" ~
+                                  ~{~a ~}===>~{~a ~})~%        "
+		  (car format:args)
+		  (substring format-string 0 format:pos)
+		  (substring format-string format:pos
+			     (string-length format-string))
+		  (list-head (cddr format:args) format:arg-pos)
+		  (list-tail (cddr format:args) format:arg-pos)))
+	(format port 
+		"~%FORMAT: error with call: (format~{ ~a~})~%        "
+		format:args))
+    (apply format port args)
+    (newline port)
+    (set! format:error format:error-save)
+    (set! format:error-continuation error-continuation)
+    (format:abort)
+    (format:intern-error "format:abort does not jump to toplevel!")))
+
+(define format:error-save format:error)
+
+(define (format:intern-error . args)   ;if something goes wrong in format:error
+  (display "FORMAT: INTERNAL ERROR IN FORMAT:ERROR!") (newline)
+  (display "        format args: ") (write format:args) (newline)
+  (display "        error args:  ") (write args) (newline)
+  (set! format:error format:error-save)
+  (format:abort))
+
+(define (format:format . args)		; the formatter entry
+  (set! format:args args)
+  (set! format:arg-pos 0)
+  (set! format:pos 0)
+  (if (< (length args) 1)
+      (format:error "not enough arguments"))
+  (let ((destination (car args))
+	(arglist (cdr args)))
+    (cond
+     ((or (and (boolean? destination)	; port output
+	       destination)
+	  (output-port? destination)
+	  (number? destination))
+      (format:out (cond
+		   ((boolean? destination) (current-output-port))
+		   ((output-port? destination) destination)
+		   ((number? destination) (current-error-port)))
+		  (car arglist) (cdr arglist)))
+     ((and (boolean? destination)	; string output
+	   (not destination))
+      (call-with-output-string
+       (lambda (port) (format:out port (car arglist) (cdr arglist)))))
+     ((string? destination)		; dest. is format string (Scheme->C)
+      (call-with-output-string
+       (lambda (port)
+	 (format:out port destination arglist))))
+     (else
+      (format:error "illegal destination `~a'" destination)))))
+
+(define (format:out port fmt args)	; the output handler for a port
+  (set! format:port port)		; global port for output routines
+  (set! format:case-conversion #f)	; modifier case conversion procedure
+  (set! format:flush-output #f)		; ~! reset
+  (let ((arg-pos (format:format-work fmt args))
+	(arg-len (length args)))
+    (cond
+     ((< arg-pos arg-len)
+      (set! format:arg-pos (+ arg-pos 1))
+      (set! format:pos (string-length fmt))
+      (format:error "~a superfluous argument~:p" (- arg-len arg-pos)))
+     ((> arg-pos arg-len)
+      (set! format:arg-pos (+ arg-len 1))
+      (display format:arg-pos)
+      (format:error "~a missing argument~:p" (- arg-pos arg-len)))
+     (else
+      (if format:flush-output (force-output port))
+      #t))))
+
+(define format:parameter-characters
+  '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+ #\v #\# #\'))
+
+(define (format:format-work format-string arglist) ; does the formatting work
+  (letrec
+      ((format-string-len (string-length format-string))
+       (arg-pos 0)			; argument position in arglist
+       (arg-len (length arglist))	; number of arguments
+       (modifier #f)			; 'colon | 'at | 'colon-at | #f
+       (params '())			; directive parameter list
+       (param-value-found #f)		; a directive parameter value found
+       (conditional-nest 0)		; conditional nesting level
+       (clause-pos 0)			; last cond. clause beginning char pos
+       (clause-default #f)		; conditional default clause string
+       (clauses '())			; conditional clause string list
+       (conditional-type #f)		; reflects the contional modifiers
+       (conditional-arg #f)		; argument to apply the conditional
+       (iteration-nest 0)		; iteration nesting level
+       (iteration-pos 0)		; iteration string beginning char pos
+       (iteration-type #f)		; reflects the iteration modifiers
+       (max-iterations #f)		; maximum number of iterations
+       (recursive-pos-save format:pos)
+
+       (next-char			; gets the next char from format-string
+	(lambda ()
+	  (let ((ch (peek-next-char)))
+	    (set! format:pos (+ 1 format:pos))
+	    ch)))
+
+       (peek-next-char
+	(lambda ()
+	  (if (>= format:pos format-string-len)
+	      (format:error "illegal format string")
+	      (string-ref format-string format:pos))))
+
+       (one-positive-integer?
+	(lambda (params)
+	  (cond
+	   ((null? params) #f)
+	   ((and (integer? (car params))
+		 (>= (car params) 0)
+		 (= (length params) 1)) #t)
+	   (else (format:error "one positive integer parameter expected")))))
+
+       (next-arg
+	(lambda ()
+	  (if (>= arg-pos arg-len)
+	      (begin
+		(set! format:arg-pos (+ arg-len 1))
+		(format:error "missing argument(s)")))
+	  (add-arg-pos 1)
+	  (list-ref arglist (- arg-pos 1))))
+
+       (prev-arg
+	(lambda ()
+	  (add-arg-pos -1)
+	  (if (negative? arg-pos)
+	      (format:error "missing backward argument(s)"))
+	  (list-ref arglist arg-pos)))
+
+       (rest-args
+	(lambda ()
+	  (let loop ((l arglist) (k arg-pos)) ; list-tail definition
+	    (if (= k 0) l (loop (cdr l) (- k 1))))))
+
+       (add-arg-pos
+	(lambda (n) 
+	  (set! arg-pos (+ n arg-pos))
+	  (set! format:arg-pos arg-pos)))
+
+       (anychar-dispatch		; dispatches the format-string
+	(lambda ()
+	  (if (>= format:pos format-string-len)
+	      arg-pos			; used for ~? continuance
+	      (let ((char (next-char)))
+		(cond
+		 ((char=? char #\~)
+		  (set! modifier #f)
+		  (set! params '())
+		  (set! param-value-found #f)
+		  (tilde-dispatch))
+		 (else
+		  (if (and (zero? conditional-nest)
+			   (zero? iteration-nest))
+		      (format:out-char char))
+		  (anychar-dispatch)))))))
+
+       (tilde-dispatch
+	(lambda ()
+	  (cond
+	   ((>= format:pos format-string-len)
+	    (format:out-str "~")	; tilde at end of string is just output
+	    arg-pos)			; used for ~? continuance
+	   ((and (or (zero? conditional-nest)
+		     (memv (peek-next-char) ; find conditional directives
+			   (append '(#\[ #\] #\; #\: #\@ #\^)
+				   format:parameter-characters)))
+		 (or (zero? iteration-nest)
+		     (memv (peek-next-char) ; find iteration directives
+			   (append '(#\{ #\} #\: #\@ #\^)
+				   format:parameter-characters))))
+	    (case (char-upcase (next-char))
+
+	      ;; format directives
+
+	      ((#\A)			; Any -- for humans
+	       (set! format:read-proof (memq modifier '(colon colon-at)))
+	       (format:out-obj-padded (memq modifier '(at colon-at))
+				      (next-arg) #f params)
+	       (anychar-dispatch))
+	      ((#\S)			; Slashified -- for parsers
+	       (set! format:read-proof (memq modifier '(colon colon-at)))
+	       (format:out-obj-padded (memq modifier '(at colon-at))
+				      (next-arg) #t params)
+	       (anychar-dispatch))
+	      ((#\D)			; Decimal
+	       (format:out-num-padded modifier (next-arg) params 10)
+	       (anychar-dispatch))
+	      ((#\X)			; Hexadecimal
+	       (format:out-num-padded modifier (next-arg) params 16)
+	       (anychar-dispatch))
+	      ((#\O)			; Octal
+	       (format:out-num-padded modifier (next-arg) params 8)
+	       (anychar-dispatch))
+	      ((#\B)			; Binary
+	       (format:out-num-padded modifier (next-arg) params 2)
+	       (anychar-dispatch))
+	      ((#\R)
+	       (if (null? params)
+		   (format:out-obj-padded ; Roman, cardinal, ordinal numerals
+		    #f
+		    ((case modifier
+		       ((at) format:num->roman)
+		       ((colon-at) format:num->old-roman)
+		       ((colon) format:num->ordinal)
+		       (else format:num->cardinal))
+		     (next-arg))
+		    #f params)
+		   (format:out-num-padded ; any Radix
+		    modifier (next-arg) (cdr params) (car params)))
+	       (anychar-dispatch))
+	      ((#\F)			; Fixed-format floating-point
+	       (if format:floats
+		   (format:out-fixed modifier (next-arg) params)
+		   (format:out-str (number->string (next-arg))))
+	       (anychar-dispatch))
+	      ((#\E)			; Exponential floating-point
+	       (if format:floats
+		   (format:out-expon modifier (next-arg) params)
+		   (format:out-str (number->string (next-arg))))
+	       (anychar-dispatch))
+	      ((#\G)			; General floating-point
+	       (if format:floats
+		   (format:out-general modifier (next-arg) params)
+		   (format:out-str (number->string (next-arg))))
+	       (anychar-dispatch))
+	      ((#\$)			; Dollars floating-point
+	       (if format:floats
+		   (format:out-dollar modifier (next-arg) params)
+		   (format:out-str (number->string (next-arg))))
+	       (anychar-dispatch))
+	      ((#\I)			; Complex numbers
+	       (if (not format:complex-numbers)
+		   (format:error
+		    "complex numbers not supported by this scheme system"))
+	       (let ((z (next-arg)))
+		 (if (not (complex? z))
+		     (format:error "argument not a complex number"))
+		 (format:out-fixed modifier (real-part z) params)
+		 (format:out-fixed 'at (imag-part z) params)
+		 (format:out-char #\i))
+	       (anychar-dispatch))
+	      ((#\C)			; Character
+	       (let ((ch (if (one-positive-integer? params)
+			     (integer->char (car params))
+			     (next-arg))))
+		 (if (not (char? ch)) (format:error "~~c expects a character"))
+		 (case modifier
+		   ((at)
+		    (format:out-str (format:char->str ch)))
+		   ((colon)
+		    (let ((c (char->integer ch)))
+		      (if (< c 0)
+			  (set! c (+ c 256))) ; compensate complement impl.
+		      (cond
+		       ((< c #x20)	; assumes that control chars are < #x20
+			(format:out-char #\^)
+			(format:out-char
+			 (integer->char (+ c #x40))))
+		       ((>= c #x7f)
+			(format:out-str "#\\")
+			(format:out-str
+			 (if format:radix-pref
+			     (let ((s (number->string c 8)))
+			       (substring s 2 (string-length s)))
+			     (number->string c 8))))
+		       (else
+			(format:out-char ch)))))
+		   (else (format:out-char ch))))
+	       (anychar-dispatch))
+	      ((#\P)			; Plural
+	       (if (memq modifier '(colon colon-at))
+		   (prev-arg))
+	       (let ((arg (next-arg)))
+		 (if (not (number? arg))
+		     (format:error "~~p expects a number argument"))
+		 (if (= arg 1)
+		     (if (memq modifier '(at colon-at))
+			 (format:out-char #\y))
+		     (if (memq modifier '(at colon-at))
+			 (format:out-str "ies")
+			 (format:out-char #\s))))
+	       (anychar-dispatch))
+	      ((#\~)			; Tilde
+	       (if (one-positive-integer? params)
+		   (format:out-fill (car params) #\~)
+		   (format:out-char #\~))
+	       (anychar-dispatch))
+	      ((#\%)			; Newline
+	       (if (one-positive-integer? params)
+		   (format:out-fill (car params) #\newline)
+		   (format:out-char #\newline))
+	       (set! format:output-col 0)
+	       (anychar-dispatch))
+	      ((#\&)			; Fresh line
+	       (if (one-positive-integer? params)
+		   (begin
+		     (if (> (car params) 0)
+			 (format:out-fill (- (car params)
+					     (if (> format:output-col 0) 0 1))
+					  #\newline))
+		     (set! format:output-col 0))
+		   (if (> format:output-col 0)
+		       (format:out-char #\newline)))
+	       (anychar-dispatch))
+	      ((#\_)			; Space character
+	       (if (one-positive-integer? params)
+		   (format:out-fill (car params) #\space)
+		   (format:out-char #\space))
+	       (anychar-dispatch))
+	      ((#\/)			; Tabulator character
+	       (if (one-positive-integer? params)
+		   (format:out-fill (car params) slib:tab)
+		   (format:out-char slib:tab))
+	       (anychar-dispatch))
+	      ((#\|)			; Page seperator
+	       (if (one-positive-integer? params)
+		   (format:out-str (car params) slib:form-feed)
+		   (format:out-char slib:form-feed))
+	       (set! format:output-col 0)
+	       (anychar-dispatch))
+	      ((#\T)			; Tabulate
+	       (format:tabulate modifier params)
+	       (anychar-dispatch))
+	      ((#\Y)			; Pretty-print
+	       (require 'pretty-print)
+	       (pretty-print (next-arg) format:port)
+	       (set! format:output-col 0)
+	       (anychar-dispatch))
+	      ((#\? #\K)		; Indirection (is "~K" in T-Scheme)
+	       (cond
+		((memq modifier '(colon colon-at))
+		 (format:error "illegal modifier in ~~?"))
+		((eq? modifier 'at)
+		 (let* ((frmt (next-arg))
+			(args (rest-args)))
+		   (add-arg-pos (format:format-work frmt args))))
+		(else
+		 (let* ((frmt (next-arg))
+			(args (next-arg)))
+		   (format:format-work frmt args))))
+	       (anychar-dispatch))
+	      ((#\!)			; Flush output
+	       (set! format:flush-output #t)
+	       (anychar-dispatch))
+	      ((#\newline)		; Continuation lines
+	       (if (eq? modifier 'at)
+		   (format:out-char #\newline))
+	       (if (< format:pos format-string-len)
+		   (do ((ch (peek-next-char) (peek-next-char)))
+		       ((or (not (char-whitespace? ch))
+			    (= format:pos (- format-string-len 1))))
+		     (if (eq? modifier 'colon)
+			 (format:out-char (next-char))
+			 (next-char))))
+	       (anychar-dispatch))
+	      ((#\*)			; Argument jumping
+	       (case modifier
+		 ((colon)		; jump backwards
+		  (if (one-positive-integer? params)
+		      (do ((i 0 (+ i 1)))
+			  ((= i (car params)))
+			(prev-arg))
+		      (prev-arg)))
+		 ((at)			; jump absolute
+		  (set! arg-pos (if (one-positive-integer? params)
+				    (car params) 0)))
+		 ((colon-at)
+		  (format:error "illegal modifier `:@' in ~~* directive"))
+		 (else			; jump forward
+		  (if (one-positive-integer? params)
+		      (do ((i 0 (+ i 1)))
+			  ((= i (car params)))
+			(next-arg))
+		      (next-arg))))
+	       (anychar-dispatch))
+	      ((#\()			; Case conversion begin
+	       (set! format:case-conversion
+		     (case modifier
+		       ((at) string-capitalize-first)
+		       ((colon) string-capitalize)
+		       ((colon-at) string-upcase)
+		       (else string-downcase)))
+	       (anychar-dispatch))
+	      ((#\))			; Case conversion end
+	       (if (not format:case-conversion)
+		   (format:error "missing ~~("))
+	       (set! format:case-conversion #f)
+	       (anychar-dispatch))
+	      ((#\[)			; Conditional begin
+	       (set! conditional-nest (+ conditional-nest 1))
+	       (cond
+		((= conditional-nest 1)
+		 (set! clause-pos format:pos)
+		 (set! clause-default #f)
+		 (set! clauses '())
+		 (set! conditional-type
+		       (case modifier
+			 ((at) 'if-then)
+			 ((colon) 'if-else-then)
+			 ((colon-at) (format:error "illegal modifier in ~~["))
+			 (else 'num-case)))
+		 (set! conditional-arg
+		       (if (one-positive-integer? params)
+			   (car params)
+			   (next-arg)))))
+	       (anychar-dispatch))
+	      ((#\;)                    ; Conditional separator
+	       (if (zero? conditional-nest)
+		   (format:error "~~; not in ~~[~~] conditional"))
+	       (if (not (null? params))
+		   (format:error "no parameter allowed in ~~;"))
+	       (if (= conditional-nest 1)
+		   (let ((clause-str
+			  (cond
+			   ((eq? modifier 'colon)
+			    (set! clause-default #t)
+			    (substring format-string clause-pos 
+				       (- format:pos 3)))
+			   ((memq modifier '(at colon-at))
+			    (format:error "illegal modifier in ~~;"))
+			   (else
+			    (substring format-string clause-pos
+				       (- format:pos 2))))))
+		     (set! clauses (append clauses (list clause-str)))
+		     (set! clause-pos format:pos)))
+	       (anychar-dispatch))
+	      ((#\])			; Conditional end
+	       (if (zero? conditional-nest) (format:error "missing ~~["))
+	       (set! conditional-nest (- conditional-nest 1))
+	       (if modifier
+		   (format:error "no modifier allowed in ~~]"))
+	       (if (not (null? params))
+		   (format:error "no parameter allowed in ~~]"))
+	       (cond
+		((zero? conditional-nest)
+		 (let ((clause-str (substring format-string clause-pos
+					      (- format:pos 2))))
+		   (if clause-default
+		       (set! clause-default clause-str)
+		       (set! clauses (append clauses (list clause-str)))))
+		 (case conditional-type
+		   ((if-then)
+		    (if conditional-arg
+			(format:format-work (car clauses)
+					    (list conditional-arg))))
+		   ((if-else-then)
+		    (add-arg-pos
+		     (format:format-work (if conditional-arg
+					     (cadr clauses)
+					     (car clauses))
+					 (rest-args))))
+		   ((num-case)
+		    (if (or (not (integer? conditional-arg))
+			    (< conditional-arg 0))
+			(format:error "argument not a positive integer"))
+		    (if (not (and (>= conditional-arg (length clauses))
+				  (not clause-default)))
+			(add-arg-pos
+			 (format:format-work
+			  (if (>= conditional-arg (length clauses))
+			      clause-default
+			      (list-ref clauses conditional-arg))
+			  (rest-args))))))))
+	       (anychar-dispatch))
+	      ((#\{)			; Iteration begin
+	       (set! iteration-nest (+ iteration-nest 1))
+	       (cond
+		((= iteration-nest 1)
+		 (set! iteration-pos format:pos)
+		 (set! iteration-type
+		       (case modifier
+			 ((at) 'rest-args)
+			 ((colon) 'sublists)
+			 ((colon-at) 'rest-sublists)
+			 (else 'list)))
+		 (set! max-iterations (if (one-positive-integer? params)
+					 (car params) #f))))
+	       (anychar-dispatch))
+	      ((#\})			; Iteration end
+	       (if (zero? iteration-nest) (format:error "missing ~~{"))
+	       (set! iteration-nest (- iteration-nest 1))
+	       (case modifier
+		 ((colon)
+		  (if (not max-iterations) (set! max-iterations 1)))
+		 ((colon-at at) (format:error "illegal modifier"))
+		 (else (if (not max-iterations) (set! max-iterations 100))))
+	       (if (not (null? params))
+		   (format:error "no parameters allowed in ~~}"))
+	       (if (zero? iteration-nest)
+		 (let ((iteration-str
+			(substring format-string iteration-pos
+				   (- format:pos (if modifier 3 2)))))
+		   (if (string=? iteration-str "")
+		       (set! iteration-str (next-arg)))
+		   (case iteration-type
+		     ((list)
+		      (let ((args (next-arg))
+			    (args-len 0))
+			(if (not (list? args))
+			    (format:error "expected a list argument"))
+			(set! args-len (length args))
+			(do ((arg-pos 0 (+ arg-pos
+					   (format:format-work
+					    iteration-str
+					    (list-tail args arg-pos))))
+			     (i 0 (+ i 1)))
+			    ((or (>= arg-pos args-len)
+				 (>= i max-iterations))))))
+		     ((sublists)
+		      (let ((args (next-arg))
+			    (args-len 0))
+			(if (not (list? args))
+			    (format:error "expected a list argument"))
+			(set! args-len (length args))
+			(do ((arg-pos 0 (+ arg-pos 1)))
+			    ((or (>= arg-pos args-len)
+				 (>= arg-pos max-iterations)))
+			  (let ((sublist (list-ref args arg-pos)))
+			    (if (not (list? sublist))
+				(format:error
+				 "expected a list of lists argument"))
+			    (format:format-work iteration-str sublist)))))
+		     ((rest-args)
+		      (let* ((args (rest-args))
+			     (args-len (length args))
+			     (usedup-args
+			      (do ((arg-pos 0 (+ arg-pos
+						 (format:format-work
+						  iteration-str
+						  (list-tail
+						   args arg-pos))))
+				   (i 0 (+ i 1)))
+				  ((or (>= arg-pos args-len)
+				       (>= i max-iterations))
+				   arg-pos))))
+			(add-arg-pos usedup-args)))
+		     ((rest-sublists)
+		      (let* ((args (rest-args))
+			     (args-len (length args))
+			     (usedup-args
+			      (do ((arg-pos 0 (+ arg-pos 1)))
+				  ((or (>= arg-pos args-len)
+				       (>= arg-pos max-iterations))
+				   arg-pos)
+				(let ((sublist (list-ref args arg-pos)))
+				  (if (not (list? sublist))
+				      (format:error "expected list arguments"))
+				  (format:format-work iteration-str sublist)))))
+			(add-arg-pos usedup-args)))
+		     (else (format:error "internal error in ~~}")))))
+	       (anychar-dispatch))
+	      ((#\^)			; Up and out
+	       (let* ((continue
+		       (cond
+			((not (null? params))
+			 (not
+			  (case (length params)
+			   ((1) (zero? (car params)))
+			   ((2) (= (list-ref params 0) (list-ref params 1)))
+			   ((3) (<= (list-ref params 0)
+				    (list-ref params 1)
+				    (list-ref params 2)))
+			   (else (format:error "too much parameters")))))
+			(format:case-conversion ; if conversion stop conversion
+			 (set! format:case-conversion string-copy) #t)
+			((= iteration-nest 1) #t)
+			((= conditional-nest 1) #t)
+			((>= arg-pos arg-len)
+			 (set! format:pos format-string-len) #f)
+			(else #t))))
+		 (if continue
+		     (anychar-dispatch))))
+
+	      ;; format directive modifiers and parameters
+
+	      ((#\@)			; `@' modifier
+	       (if (eq? modifier 'colon-at)
+		   (format:error "double `@' modifier"))
+	       (set! modifier (if (eq? modifier 'colon) 'colon-at 'at))
+	       (tilde-dispatch))
+	      ((#\:)			; `:' modifier
+	       (if modifier (format:error "illegal `:' modifier position"))
+	       (set! modifier 'colon)
+	       (tilde-dispatch))
+	      ((#\')			; Character parameter
+	       (if modifier (format:error "misplaced modifier"))
+	       (set! params (append params (list (char->integer (next-char)))))
+	       (set! param-value-found #t)
+	       (tilde-dispatch))
+	      ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+) ; num. paramtr
+	       (if modifier (format:error "misplaced modifier"))
+	       (let ((num-str-beg (- format:pos 1))
+		     (num-str-end format:pos))
+		 (do ((ch (peek-next-char) (peek-next-char)))
+		     ((not (char-numeric? ch)))
+		   (next-char)
+		   (set! num-str-end (+ 1 num-str-end)))
+		 (set! params
+		       (append params
+			       (list (string->number
+				      (substring format-string
+						 num-str-beg
+						 num-str-end))))))
+	       (set! param-value-found #t)
+	       (tilde-dispatch))
+	      ((#\V)			; Variable parameter from next argum.
+	       (if modifier (format:error "misplaced modifier"))
+	       (set! params (append params (list (next-arg))))
+	       (set! param-value-found #t)
+	       (tilde-dispatch))
+	      ((#\#)			; Parameter is number of remaining args
+	       (if modifier (format:error "misplaced modifier"))
+	       (set! params (append params (list (length (rest-args)))))
+	       (set! param-value-found #t)
+	       (tilde-dispatch))
+	      ((#\,)			; Parameter separators
+	       (if modifier (format:error "misplaced modifier"))
+	       (if (not param-value-found)
+		   (set! params (append params '(#f)))) ; append empty paramtr
+	       (set! param-value-found #f)
+	       (tilde-dispatch))
+	      ((#\Q)			; Inquiry messages
+	       (if (eq? modifier 'colon)
+		   (format:out-str format:version)
+		   (let ((nl (string #\newline)))
+		     (format:out-str
+		      (string-append
+		       "SLIB Common LISP format version " format:version nl
+		       "  (C) copyright 1992-1994 by Dirk Lutzebaeck" nl
+		       "  please send bug reports to `lutzeb@cs.tu-berlin.de'"
+		       nl))))
+	       (anychar-dispatch))
+	      (else			; Unknown tilde directive
+	       (format:error "unknown control character `~c'"
+		      (string-ref format-string (- format:pos 1))))))
+	   (else (anychar-dispatch)))))) ; in case of conditional
+
+    (set! format:pos 0)
+    (set! format:arg-pos 0)
+    (anychar-dispatch)			; start the formatting
+    (set! format:pos recursive-pos-save)
+    arg-pos))				; return the position in the arg. list
+
+;; format:obj->str returns a R4RS representation as a string of an arbitrary
+;; scheme object.
+;; First parameter is the object, second parameter is a boolean if the
+;; representation should be slashified as `write' does.
+;; It uses format:char->str which converts a character into
+;; a slashified string as `write' does and which is implementation dependent.
+;; It uses format:iobj->str to print out internal objects as
+;; quoted strings so that the output can always be processed by (read)
+
+(define (format:obj->str obj slashify)
+  (cond
+   ((string? obj)
+    (if slashify
+	(let ((obj-len (string-length obj)))
+	  (string-append
+	   "\""
+	   (let loop ((i 0) (j 0))	; taken from Marc Feeley's pp.scm
+	     (if (= j obj-len)
+		 (string-append (substring obj i j) "\"")
+		 (let ((c (string-ref obj j)))
+		   (if (or (char=? c #\\)
+			   (char=? c #\"))
+		       (string-append (substring obj i j) "\\"
+				      (loop j (+ j 1)))
+		       (loop i (+ j 1))))))))
+	obj))
+   
+   ((boolean? obj) (if obj "#t" "#f"))
+   
+   ((number? obj) (number->string obj))
+
+   ((symbol? obj) 
+    (if format:symbol-case-conv
+	(format:symbol-case-conv (symbol->string obj))
+	(symbol->string obj)))
+   
+   ((char? obj)
+    (if slashify
+	(format:char->str obj)
+	(string obj)))
+   
+   ((null? obj) "()")
+
+   ((input-port? obj)
+    (format:iobj->str obj))
+   
+   ((output-port? obj)
+    (format:iobj->str obj))
+     
+   ((list? obj)
+    (string-append "("
+		   (let loop ((obj-list obj))
+		     (if (null? (cdr obj-list))
+			 (format:obj->str (car obj-list) #t)
+			 (string-append
+			  (format:obj->str (car obj-list) #t)
+			  " "
+			  (loop (cdr obj-list)))))
+		   ")"))
+
+   ((pair? obj)
+    (string-append "("
+		   (format:obj->str (car obj) #t)
+		   " . "
+		   (format:obj->str (cdr obj) #t)
+		   ")"))
+   
+   ((vector? obj)
+    (string-append "#" (format:obj->str (vector->list obj) #t)))
+
+   (else				; only objects with an #<...> 
+    (format:iobj->str obj))))		; representation should fall in here
+
+;; format:iobj->str reveals the implementation dependent representation of 
+;; #<...> objects with the use of display and call-with-output-string.
+;; If format:read-proof is set to #t the resulting string is additionally 
+;; set into string quotes.
+
+(define format:read-proof #f)
+
+(define (format:iobj->str iobj)
+  (if (or format:read-proof
+	  format:iobj-case-conv)
+      (string-append 
+       (if format:read-proof "\"" "")
+       (if format:iobj-case-conv
+	   (format:iobj-case-conv
+	    (call-with-output-string (lambda (p) (display iobj p))))
+	   (call-with-output-string (lambda (p) (display iobj p))))
+       (if format:read-proof "\"" ""))
+      (call-with-output-string (lambda (p) (display iobj p)))))
+
+
+;; format:char->str converts a character into a slashified string as
+;; done by `write'. The procedure is dependent on the integer
+;; representation of characters and assumes a character number according to
+;; the ASCII character set.
+
+(define (format:char->str ch)
+  (let ((int-rep (char->integer ch)))
+    (if (< int-rep 0)			; if chars are [-128...+127]
+	(set! int-rep (+ int-rep 256)))
+    (string-append
+     "#\\"
+     (cond
+      ((char=? ch #\newline) "newline")
+      ((and (>= int-rep 0) (<= int-rep 32))
+       (vector-ref format:ascii-non-printable-charnames int-rep))
+      ((= int-rep 127) "del")
+      ((>= int-rep 128)		; octal representation
+       (if format:radix-pref
+	   (let ((s (number->string int-rep 8)))
+	     (substring s 2 (string-length s)))
+	   (number->string int-rep 8)))
+      (else (string ch))))))
+
+(define format:space-ch (char->integer #\space))
+(define format:zero-ch (char->integer #\0))
+
+(define (format:par pars length index default name)
+  (if (> length index)
+      (let ((par (list-ref pars index)))
+	(if par
+	    (if name
+		(if (< par 0)
+		    (format:error 
+		     "~s parameter must be a positive integer" name)
+		    par)
+		par)
+	    default))
+      default))
+
+(define (format:out-obj-padded pad-left obj slashify pars)
+  (if (null? pars)
+      (format:out-str (format:obj->str obj slashify))
+      (let ((l (length pars)))
+	(let ((mincol (format:par pars l 0 0 "mincol"))
+	      (colinc (format:par pars l 1 1 "colinc"))
+	      (minpad (format:par pars l 2 0 "minpad"))
+	      (padchar (integer->char
+			(format:par pars l 3 format:space-ch #f)))
+	      (objstr (format:obj->str obj slashify)))
+	  (if (not pad-left)
+	      (format:out-str objstr))
+	  (do ((objstr-len (string-length objstr))
+	       (i minpad (+ i colinc)))
+	      ((>= (+ objstr-len i) mincol)
+	       (format:out-fill i padchar)))
+	  (if pad-left
+	      (format:out-str objstr))))))
+
+(define (format:out-num-padded modifier number pars radix)
+  (if (not (integer? number)) (format:error "argument not an integer"))
+  (let ((numstr (number->string number radix)))
+    (if (and format:radix-pref (not (= radix 10)))
+	(set! numstr (substring numstr 2 (string-length numstr))))
+    (if (and (null? pars) (not modifier))
+	(format:out-str numstr)
+	(let ((l (length pars))
+	      (numstr-len (string-length numstr)))
+	  (let ((mincol (format:par pars l 0 #f "mincol"))
+		(padchar (integer->char
+			  (format:par pars l 1 format:space-ch #f)))
+		(commachar (integer->char
+			    (format:par pars l 2 (char->integer #\,) #f)))
+		(commawidth (format:par pars l 3 3 "commawidth")))
+	    (if mincol
+		(let ((numlen numstr-len)) ; calc. the output len of number
+		  (if (and (memq modifier '(at colon-at)) (> number 0))
+		      (set! numlen (+ numlen 1)))
+		  (if (memq modifier '(colon colon-at))
+		      (set! numlen (+ (quotient (- numstr-len 
+						   (if (< number 0) 2 1))
+						commawidth)
+				      numlen)))
+		  (if (> mincol numlen)
+		      (format:out-fill (- mincol numlen) padchar))))
+	    (if (and (memq modifier '(at colon-at))
+		     (> number 0))
+		(format:out-char #\+))
+	    (if (memq modifier '(colon colon-at)) ; insert comma character
+		(let ((start (remainder numstr-len commawidth))
+		      (ns (if (< number 0) 1 0)))
+		  (format:out-substr numstr 0 start)
+		  (do ((i start (+ i commawidth)))
+		      ((>= i numstr-len))
+		    (if (> i ns)
+			(format:out-char commachar))
+		    (format:out-substr numstr i (+ i commawidth))))
+		(format:out-str numstr)))))))
+
+(define (format:tabulate modifier pars)
+  (let ((l (length pars)))
+    (let ((colnum (format:par pars l 0 1 "colnum"))
+	  (colinc (format:par pars l 1 1 "colinc"))
+	  (padch (integer->char (format:par pars l 2 format:space-ch #f))))
+      (case modifier
+	((colon colon-at)
+	 (format:error "unsupported modifier for ~~t"))
+	((at)				; relative tabulation
+	 (format:out-fill
+	  (if (= colinc 0)
+	      colnum			; colnum = colrel
+	      (do ((c 0 (+ c colinc))
+		   (col (+ format:output-col colnum)))
+		  ((>= c col)
+		   (- c format:output-col))))
+	  padch))
+	(else				; absolute tabulation
+	 (format:out-fill
+	  (cond
+	   ((< format:output-col colnum)
+	    (- colnum format:output-col))
+	   ((= colinc 0)
+	    0)
+	   (else
+	    (do ((c colnum (+ c colinc)))
+		((>= c format:output-col)
+		 (- c format:output-col)))))
+	  padch))))))
+
+
+;; roman numerals (from dorai@cs.rice.edu).
+
+(define format:roman-alist
+  '((1000 #\M) (500 #\D) (100 #\C) (50 #\L)
+    (10 #\X) (5 #\V) (1 #\I)))
+
+(define format:roman-boundary-values
+  '(100 100 10 10 1 1 #f))
+
+(define format:num->old-roman
+  (lambda (n)
+    (if (and (integer? n) (>= n 1))
+	(let loop ((n n)
+		   (romans format:roman-alist)
+		   (s '()))
+	  (if (null? romans) (list->string (reverse s))
+	      (let ((roman-val (caar romans))
+		    (roman-dgt (cadar romans)))
+		(do ((q (quotient n roman-val) (- q 1))
+		     (s s (cons roman-dgt s)))
+		    ((= q 0)
+		     (loop (remainder n roman-val)
+		       (cdr romans) s))))))
+	(format:error "only positive integers can be romanized"))))
+
+(define format:num->roman
+  (lambda (n)
+    (if (and (integer? n) (> n 0))
+	(let loop ((n n)
+		   (romans format:roman-alist)
+		   (boundaries format:roman-boundary-values)
+		   (s '()))
+	  (if (null? romans)
+	      (list->string (reverse s))
+	      (let ((roman-val (caar romans))
+		    (roman-dgt (cadar romans))
+		    (bdry (car boundaries)))
+		(let loop2 ((q (quotient n roman-val))
+			    (r (remainder n roman-val))
+			    (s s))
+		  (if (= q 0)
+		      (if (and bdry (>= r (- roman-val bdry)))
+			  (loop (remainder r bdry) (cdr romans)
+			    (cdr boundaries)
+			    (cons roman-dgt
+			      (append
+				(cdr (assv bdry romans))
+				s)))
+			  (loop r (cdr romans) (cdr boundaries) s))
+		      (loop2 (- q 1) r (cons roman-dgt s)))))))
+	(format:error "only positive integers can be romanized"))))
+
+;; cardinals & ordinals (from dorai@cs.rice.edu)
+
+(define format:cardinal-ones-list
+  '(#f "one" "two" "three" "four" "five"
+     "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen"
+     "fourteen" "fifteen" "sixteen" "seventeen" "eighteen"
+     "nineteen"))
+
+(define format:cardinal-tens-list
+  '(#f #f "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty"
+     "ninety"))
+
+(define format:num->cardinal999
+  (lambda (n)
+    ;this procedure is inspired by the Bruno Haible's CLisp
+    ;function format-small-cardinal, which converts numbers
+    ;in the range 1 to 999, and is used for converting each
+    ;thousand-block in a larger number
+    (let* ((hundreds (quotient n 100))
+	   (tens+ones (remainder n 100))
+	   (tens (quotient tens+ones 10))
+	   (ones (remainder tens+ones 10)))
+      (append
+	(if (> hundreds 0)
+	    (append
+	      (string->list
+		(list-ref format:cardinal-ones-list hundreds))
+	      (string->list" hundred")
+	      (if (> tens+ones 0) '(#\space) '()))
+	    '())
+	(if (< tens+ones 20)
+	    (if (> tens+ones 0)
+		(string->list
+		  (list-ref format:cardinal-ones-list tens+ones))
+		'())
+	    (append
+	      (string->list
+		(list-ref format:cardinal-tens-list tens))
+	      (if (> ones 0)
+		  (cons #\-
+		    (string->list
+		      (list-ref format:cardinal-ones-list ones))))))))))
+
+(define format:cardinal-thousand-block-list
+  '("" " thousand" " million" " billion" " trillion" " quadrillion"
+     " quintillion" " sextillion" " septillion" " octillion" " nonillion"
+     " decillion" " undecillion" " duodecillion" " tredecillion"
+     " quattuordecillion" " quindecillion" " sexdecillion" " septendecillion"
+     " octodecillion" " novemdecillion" " vigintillion"))
+
+(define format:num->cardinal
+  (lambda (n)
+    (cond ((not (integer? n))
+	   (format:error
+	     "only integers can be converted to English cardinals"))
+	  ((= n 0) "zero")
+	  ((< n 0) (string-append "minus " (format:num->cardinal (- n))))
+	  (else
+	    (let ((power3-word-limit
+		    (length format:cardinal-thousand-block-list)))
+	      (let loop ((n n)
+			 (power3 0)
+			 (s '()))
+		(if (= n 0)
+		    (list->string s)
+		    (let ((n-before-block (quotient n 1000))
+			  (n-after-block (remainder n 1000)))
+		      (loop n-before-block
+			(+ power3 1)
+			(if (> n-after-block 0)
+			    (append
+			      (if (> n-before-block 0)
+				  (string->list ", ") '())
+			      (format:num->cardinal999 n-after-block)
+			      (if (< power3 power3-word-limit)
+				  (string->list
+				    (list-ref
+				     format:cardinal-thousand-block-list
+				     power3))
+				  (append
+				    (string->list " times ten to the ")
+				    (string->list
+				      (format:num->ordinal
+					(* power3 3)))
+				    (string->list " power")))
+			      s)
+			    s))))))))))
+
+(define format:ordinal-ones-list
+  '(#f "first" "second" "third" "fourth" "fifth"
+     "sixth" "seventh" "eighth" "ninth" "tenth" "eleventh" "twelfth"
+     "thirteenth" "fourteenth" "fifteenth" "sixteenth" "seventeenth"
+     "eighteenth" "nineteenth"))
+
+(define format:ordinal-tens-list
+  '(#f #f "twentieth" "thirtieth" "fortieth" "fiftieth" "sixtieth"
+     "seventieth" "eightieth" "ninetieth"))
+
+(define format:num->ordinal
+  (lambda (n)
+    (cond ((not (integer? n))
+	   (format:error
+	     "only integers can be converted to English ordinals"))
+	  ((= n 0) "zeroth")
+	  ((< n 0) (string-append "minus " (format:num->ordinal (- n))))
+	  (else
+	    (let ((hundreds (quotient n 100))
+		  (tens+ones (remainder n 100)))
+	      (string-append
+		(if (> hundreds 0)
+		    (string-append
+		      (format:num->cardinal (* hundreds 100))
+		      (if (= tens+ones 0) "th" " "))
+		    "")
+		(if (= tens+ones 0) ""
+		    (if (< tens+ones 20)
+			(list-ref format:ordinal-ones-list tens+ones)
+			(let ((tens (quotient tens+ones 10))
+			      (ones (remainder tens+ones 10)))
+			  (if (= ones 0)
+			      (list-ref format:ordinal-tens-list tens)
+			      (string-append
+				(list-ref format:cardinal-tens-list tens)
+				"-"
+				(list-ref format:ordinal-ones-list ones))))
+			))))))))
+
+;; format fixed flonums (~F)
+
+(define (format:out-fixed modifier number pars)
+  (if (not (or (number? number) (string? number)))
+      (format:error "argument is not a number or a number string"))
+
+  (let ((l (length pars)))
+    (let ((width (format:par pars l 0 #f "width"))
+	  (digits (format:par pars l 1 #f "digits"))
+	  (scale (format:par pars l 2 0 #f))
+	  (overch (format:par pars l 3 #f #f))
+	  (padch (format:par pars l 4 format:space-ch #f)))
+
+    (if digits
+
+	(begin				; fixed precision
+	  (format:parse-float 
+	   (if (string? number) number (number->string number)) #t scale)
+	  (if (<= (- format:fn-len format:fn-dot) digits)
+	      (format:fn-zfill #f (- digits (- format:fn-len format:fn-dot)))
+	      (format:fn-round digits))
+	  (if width
+	      (let ((numlen (+ format:fn-len 1)))
+		(if (or (not format:fn-pos?) (eq? modifier 'at))
+		    (set! numlen (+ numlen 1)))
+		(if (and (= format:fn-dot 0) (> width (+ digits 1)))
+		    (set! numlen (+ numlen 1)))
+		(if (< numlen width)
+		    (format:out-fill (- width numlen) (integer->char padch)))
+		(if (and overch (> numlen width))
+		    (format:out-fill width (integer->char overch))
+		    (format:fn-out modifier (> width (+ digits 1)))))
+	      (format:fn-out modifier #t)))
+
+	(begin				; free precision
+	  (format:parse-float
+	   (if (string? number) number (number->string number)) #t scale)
+	  (format:fn-strip)
+	  (if width
+	      (let ((numlen (+ format:fn-len 1)))
+		(if (or (not format:fn-pos?) (eq? modifier 'at))
+		    (set! numlen (+ numlen 1)))
+		(if (= format:fn-dot 0)
+		    (set! numlen (+ numlen 1)))
+		(if (< numlen width)
+		    (format:out-fill (- width numlen) (integer->char padch)))
+		(if (> numlen width)	; adjust precision if possible
+		    (let ((dot-index (- numlen
+					(- format:fn-len format:fn-dot))))
+		      (if (> dot-index width)
+			  (if overch	; numstr too big for required width
+			      (format:out-fill width (integer->char overch))
+			      (format:fn-out modifier #t))
+			  (begin
+			    (format:fn-round (- width dot-index))
+			    (format:fn-out modifier #t))))
+		    (format:fn-out modifier #t)))
+	      (format:fn-out modifier #t)))))))
+
+;; format exponential flonums (~E)
+
+(define (format:out-expon modifier number pars)
+  (if (not (or (number? number) (string? number)))
+      (format:error "argument is not a number"))
+
+  (let ((l (length pars)))
+    (let ((width (format:par pars l 0 #f "width"))
+	  (digits (format:par pars l 1 #f "digits"))
+	  (edigits (format:par pars l 2 #f "exponent digits"))
+	  (scale (format:par pars l 3 1 #f))
+	  (overch (format:par pars l 4 #f #f))
+	  (padch (format:par pars l 5 format:space-ch #f))
+	  (expch (format:par pars l 6 #f #f)))
+	 
+    (if digits				; fixed precision
+
+	(let ((digits (if (> scale 0)
+			  (if (< scale (+ digits 2))
+			      (+ (- digits scale) 1)
+			      0)
+			  digits)))
+	  (format:parse-float 
+	   (if (string? number) number (number->string number)) #f scale)
+	  (if (<= (- format:fn-len format:fn-dot) digits)
+	      (format:fn-zfill #f (- digits (- format:fn-len format:fn-dot)))
+	      (format:fn-round digits))
+	  (if width
+	      (if (and edigits overch (> format:en-len edigits))
+		  (format:out-fill width (integer->char overch))
+		  (let ((numlen (+ format:fn-len 3))) ; .E+
+		    (if (or (not format:fn-pos?) (eq? modifier 'at))
+			(set! numlen (+ numlen 1)))
+		    (if (and (= format:fn-dot 0) (> width (+ digits 1)))
+			(set! numlen (+ numlen 1)))	
+		    (set! numlen
+			  (+ numlen 
+			     (if (and edigits (>= edigits format:en-len))
+				 edigits 
+				 format:en-len)))
+		    (if (< numlen width)
+			(format:out-fill (- width numlen)
+					 (integer->char padch)))
+		    (if (and overch (> numlen width))
+			(format:out-fill width (integer->char overch))
+			(begin
+			  (format:fn-out modifier (> width (- numlen 1)))
+			  (format:en-out edigits expch)))))
+	      (begin
+		(format:fn-out modifier #t)
+		(format:en-out edigits expch))))
+
+	(begin				; free precision
+	  (format:parse-float
+	   (if (string? number) number (number->string number)) #f scale)
+	  (format:fn-strip)
+	  (if width
+	      (if (and edigits overch (> format:en-len edigits))
+		  (format:out-fill width (integer->char overch))
+		  (let ((numlen (+ format:fn-len 3))) ; .E+
+		    (if (or (not format:fn-pos?) (eq? modifier 'at))
+			(set! numlen (+ numlen 1)))
+		    (if (= format:fn-dot 0)
+			(set! numlen (+ numlen 1)))
+		    (set! numlen
+			  (+ numlen
+			     (if (and edigits (>= edigits format:en-len))
+				 edigits 
+				 format:en-len)))
+		    (if (< numlen width)
+			(format:out-fill (- width numlen)
+					 (integer->char padch)))
+		    (if (> numlen width) ; adjust precision if possible
+			(let ((f (- format:fn-len format:fn-dot))) ; fract len
+			  (if (> (- numlen f) width)
+			      (if overch ; numstr too big for required width
+				  (format:out-fill width 
+						   (integer->char overch))
+				  (begin
+				    (format:fn-out modifier #t)
+				    (format:en-out edigits expch)))
+			      (begin
+				(format:fn-round (+ (- f numlen) width))
+				(format:fn-out modifier #t)
+				(format:en-out edigits expch))))
+			(begin
+			  (format:fn-out modifier #t)
+			  (format:en-out edigits expch)))))
+	      (begin
+		(format:fn-out modifier #t)
+		(format:en-out edigits expch))))))))
+	
+;; format general flonums (~G)
+
+(define (format:out-general modifier number pars)
+  (if (not (or (number? number) (string? number)))
+      (format:error "argument is not a number or a number string"))
+
+  (let ((l (length pars)))
+    (let ((width (if (> l 0) (list-ref pars 0) #f))
+	  (digits (if (> l 1) (list-ref pars 1) #f))
+	  (edigits (if (> l 2) (list-ref pars 2) #f))
+	  (overch (if (> l 4) (list-ref pars 4) #f))
+	  (padch (if (> l 5) (list-ref pars 5) #f)))
+    (format:parse-float
+     (if (string? number) number (number->string number)) #t 0)
+    (format:fn-strip)
+    (let* ((ee (if edigits (+ edigits 2) 4)) ; for the following algorithm
+	   (ww (if width (- width ee) #f))   ; see Steele's CL book p.395
+	   (n (if (= format:fn-dot 0)	; number less than (abs 1.0) ?
+		  (- (format:fn-zlead))
+		  format:fn-dot))
+	   (d (if digits
+		  digits
+		  (max format:fn-len (min n 7)))) ; q = format:fn-len
+	   (dd (- d n)))
+      (if (<= 0 dd d)
+	  (begin
+	    (format:out-fixed modifier number (list ww dd #f overch padch))
+	    (format:out-fill ee #\space)) ;~@T not implemented yet
+	  (format:out-expon modifier number pars))))))
+
+;; format dollar flonums (~$)
+
+(define (format:out-dollar modifier number pars)
+  (if (not (or (number? number) (string? number)))
+      (format:error "argument is not a number or a number string"))
+
+  (let ((l (length pars)))
+    (let ((digits (format:par pars l 0 2 "digits"))
+	  (mindig (format:par pars l 1 1 "mindig"))
+	  (width (format:par pars l 2 0 "width"))
+	  (padch (format:par pars l 3 format:space-ch #f)))
+
+    (format:parse-float
+     (if (string? number) number (number->string number)) #t 0)
+    (if (<= (- format:fn-len format:fn-dot) digits)
+	(format:fn-zfill #f (- digits (- format:fn-len format:fn-dot)))
+	(format:fn-round digits))
+    (let ((numlen (+ format:fn-len 1)))
+      (if (or (not format:fn-pos?) (memq modifier '(at colon-at)))
+	  (set! numlen (+ numlen 1)))
+      (if (and mindig (> mindig format:fn-dot))
+	  (set! numlen (+ numlen (- mindig format:fn-dot))))
+      (if (and (= format:fn-dot 0) (not mindig))
+	  (set! numlen (+ numlen 1)))
+      (if (< numlen width)
+	  (case modifier
+	    ((colon)
+	     (if (not format:fn-pos?)
+		 (format:out-char #\-))
+	     (format:out-fill (- width numlen) (integer->char padch)))
+	    ((at)
+	     (format:out-fill (- width numlen) (integer->char padch))
+	     (format:out-char (if format:fn-pos? #\+ #\-)))
+	    ((colon-at)
+	     (format:out-char (if format:fn-pos? #\+ #\-))
+	     (format:out-fill (- width numlen) (integer->char padch)))
+	    (else
+	     (format:out-fill (- width numlen) (integer->char padch))
+	     (if (not format:fn-pos?)
+		 (format:out-char #\-))))
+	  (if format:fn-pos?
+	      (if (memq modifier '(at colon-at)) (format:out-char #\+))
+	      (format:out-char #\-))))
+    (if (and mindig (> mindig format:fn-dot))
+	(format:out-fill (- mindig format:fn-dot) #\0))
+    (if (and (= format:fn-dot 0) (not mindig))
+	(format:out-char #\0))
+    (format:out-substr format:fn-str 0 format:fn-dot)
+    (format:out-char #\.)
+    (format:out-substr format:fn-str format:fn-dot format:fn-len))))
+
+; the flonum buffers
+
+(define format:fn-max 200)		; max. number of number digits
+(define format:fn-str (make-string format:fn-max)) ; number buffer
+(define format:fn-len 0)		; digit length of number
+(define format:fn-dot #f)		; dot position of number
+(define format:fn-pos? #t)		; number positive?
+(define format:en-max 10)		; max. number of exponent digits
+(define format:en-str (make-string format:en-max)) ; exponent buffer
+(define format:en-len 0)		; digit length of exponent
+(define format:en-pos? #t)		; exponent positive?
+
+(define (format:parse-float num-str fixed? scale)
+  (set! format:fn-pos? #t)
+  (set! format:fn-len 0)
+  (set! format:fn-dot #f)
+  (set! format:en-pos? #t)
+  (set! format:en-len 0)
+  (do ((i 0 (+ i 1))
+       (left-zeros 0)
+       (mantissa? #t)
+       (all-zeros? #t)
+       (num-len (string-length num-str))
+       (c #f))			; current exam. character in num-str
+      ((= i num-len)
+       (if (not format:fn-dot)
+	   (set! format:fn-dot format:fn-len))
+
+       (if all-zeros?
+	   (begin
+	     (set! left-zeros 0)
+	     (set! format:fn-dot 0)
+	     (set! format:fn-len 1)))
+
+       ;; now format the parsed values according to format's need
+
+       (if fixed?
+
+	   (begin			; fixed format m.nnn or .nnn
+	     (if (and (> left-zeros 0) (> format:fn-dot 0))
+		 (if (> format:fn-dot left-zeros) 
+		     (begin		; norm 0{0}nn.mm to nn.mm
+		       (format:fn-shiftleft left-zeros)
+		       (set! left-zeros 0)
+		       (set! format:fn-dot (- format:fn-dot left-zeros)))
+		     (begin		; normalize 0{0}.nnn to .nnn
+		       (format:fn-shiftleft format:fn-dot)
+		       (set! left-zeros (- left-zeros format:fn-dot))
+		       (set! format:fn-dot 0))))
+	     (if (or (not (= scale 0)) (> format:en-len 0))
+		 (let ((shift (+ scale (format:en-int))))
+		   (cond
+		    (all-zeros? #t)
+		    ((> (+ format:fn-dot shift) format:fn-len)
+		     (format:fn-zfill
+		      #f (- shift (- format:fn-len format:fn-dot)))
+		     (set! format:fn-dot format:fn-len))
+		    ((< (+ format:fn-dot shift) 0)
+		     (format:fn-zfill #t (- (- shift) format:fn-dot))
+		     (set! format:fn-dot 0))
+		    (else
+		     (if (> left-zeros 0)
+			 (if (<= left-zeros shift) ; shift always > 0 here
+			     (format:fn-shiftleft shift) ; shift out 0s
+			     (begin
+			       (format:fn-shiftleft left-zeros)
+			       (set! format:fn-dot (- shift left-zeros))))
+			 (set! format:fn-dot (+ format:fn-dot shift))))))))
+
+	   (let ((negexp		; expon format m.nnnEee
+		  (if (> left-zeros 0)
+		      (- left-zeros format:fn-dot -1)
+		      (if (= format:fn-dot 0) 1 0))))
+	     (if (> left-zeros 0)
+		 (begin			; normalize 0{0}.nnn to n.nn
+		   (format:fn-shiftleft left-zeros)
+		   (set! format:fn-dot 1))
+		 (if (= format:fn-dot 0)
+		     (set! format:fn-dot 1)))
+	     (format:en-set (- (+ (- format:fn-dot scale) (format:en-int))
+			       negexp))
+	     (cond 
+	      (all-zeros?
+	       (format:en-set 0)
+	       (set! format:fn-dot 1))
+	      ((< scale 0)		; leading zero
+	       (format:fn-zfill #t (- scale))
+	       (set! format:fn-dot 0))
+	      ((> scale format:fn-dot)
+	       (format:fn-zfill #f (- scale format:fn-dot))
+	       (set! format:fn-dot scale))
+	      (else
+	       (set! format:fn-dot scale)))))
+       #t)
+
+    ;; do body      
+    (set! c (string-ref num-str i))	; parse the output of number->string
+    (cond				; which can be any valid number
+     ((char-numeric? c)			; representation of R4RS except 
+      (if mantissa?			; complex numbers
+	  (begin
+	    (if (char=? c #\0)
+		(if all-zeros?
+		    (set! left-zeros (+ left-zeros 1)))
+		(begin
+		  (set! all-zeros? #f)))
+	    (string-set! format:fn-str format:fn-len c)
+	    (set! format:fn-len (+ format:fn-len 1)))
+	  (begin
+	    (string-set! format:en-str format:en-len c)
+	    (set! format:en-len (+ format:en-len 1)))))
+     ((or (char=? c #\-) (char=? c #\+))
+      (if mantissa?
+	  (set! format:fn-pos? (char=? c #\+))
+	  (set! format:en-pos? (char=? c #\+))))
+     ((char=? c #\.)
+      (set! format:fn-dot format:fn-len))
+     ((char=? c #\e)
+      (set! mantissa? #f))
+     ((char=? c #\E)
+      (set! mantissa? #f))
+     ((char-whitespace? c) #t)
+     ((char=? c #\d) #t)		; decimal radix prefix
+     ((char=? c #\#) #t)
+     (else
+      (format:error "illegal character `~c' in number->string" c)))))
+
+(define (format:en-int)			; convert exponent string to integer
+  (if (= format:en-len 0)
+      0
+      (do ((i 0 (+ i 1))
+	   (n 0))
+	  ((= i format:en-len) 
+	   (if format:en-pos?
+	       n
+	       (- n)))
+	(set! n (+ (* n 10) (- (char->integer (string-ref format:en-str i))
+			       format:zero-ch))))))
+
+(define (format:en-set en)		; set exponent string number
+  (set! format:en-len 0)
+  (set! format:en-pos? (>= en 0))
+  (let ((en-str (number->string en)))
+    (do ((i 0 (+ i 1))
+	 (en-len (string-length en-str))
+	 (c #f))
+	((= i en-len))
+      (set! c (string-ref en-str i))
+      (if (char-numeric? c)
+	  (begin
+	    (string-set! format:en-str format:en-len c)
+	    (set! format:en-len (+ format:en-len 1)))))))
+
+(define (format:fn-zfill left? n)	; fill current number string with 0s
+  (if (> (+ n format:fn-len) format:fn-max) ; from the left or right
+      (format:error "number is too long to format (enlarge format:fn-max)"))
+  (set! format:fn-len (+ format:fn-len n))
+  (if left?
+      (do ((i format:fn-len (- i 1)))	; fill n 0s to left
+	  ((< i 0))
+	(string-set! format:fn-str i
+		     (if (< i n)
+			 #\0
+			 (string-ref format:fn-str (- i n)))))
+      (do ((i (- format:fn-len n) (+ i 1))) ; fill n 0s to the right
+	  ((= i format:fn-len))
+	(string-set! format:fn-str i #\0))))
+
+(define (format:fn-shiftleft n)		; shift left current number n positions
+  (if (> n format:fn-len)
+      (format:error "internal error in format:fn-shiftleft (~d,~d)"
+		    n format:fn-len))
+  (do ((i n (+ i 1)))
+      ((= i format:fn-len)
+       (set! format:fn-len (- format:fn-len n)))
+    (string-set! format:fn-str (- i n) (string-ref format:fn-str i))))
+
+(define (format:fn-round digits)	; round format:fn-str
+  (set! digits (+ digits format:fn-dot))
+  (do ((i digits (- i 1))		; "099",2 -> "10"
+       (c 5))				; "023",2 -> "02"
+      ((or (= c 0) (< i 0))		; "999",2 -> "100"
+       (if (= c 1)			; "005",2 -> "01"
+	   (begin			; carry overflow
+	     (set! format:fn-len digits)
+	     (format:fn-zfill #t 1)	; add a 1 before fn-str
+	     (string-set! format:fn-str 0 #\1)
+	     (set! format:fn-dot (+ format:fn-dot 1)))
+	   (set! format:fn-len digits)))
+    (set! c (+ (- (char->integer (string-ref format:fn-str i))
+		  format:zero-ch) c))
+    (string-set! format:fn-str i (integer->char
+				  (if (< c 10) 
+				      (+ c format:zero-ch)
+				      (+ (- c 10) format:zero-ch))))
+    (set! c (if (< c 10) 0 1))))
+
+(define (format:fn-out modifier add-leading-zero?)
+  (if format:fn-pos?
+      (if (eq? modifier 'at) 
+	  (format:out-char #\+))
+      (format:out-char #\-))
+  (if (= format:fn-dot 0)
+      (if add-leading-zero?
+	  (format:out-char #\0))
+      (format:out-substr format:fn-str 0 format:fn-dot))
+  (format:out-char #\.)
+  (format:out-substr format:fn-str format:fn-dot format:fn-len))
+
+(define (format:en-out edigits expch)
+  (format:out-char (if expch (integer->char expch) format:expch))
+  (format:out-char (if format:en-pos? #\+ #\-))
+  (if edigits 
+      (if (< format:en-len edigits)
+	  (format:out-fill (- edigits format:en-len) #\0)))
+  (format:out-substr format:en-str 0 format:en-len))
+
+(define (format:fn-strip)		; strip trailing zeros but one
+  (string-set! format:fn-str format:fn-len #\0)
+  (do ((i format:fn-len (- i 1)))
+      ((or (not (char=? (string-ref format:fn-str i) #\0))
+	   (<= i format:fn-dot))
+       (set! format:fn-len (+ i 1)))))
+
+(define (format:fn-zlead)		; count leading zeros
+  (do ((i 0 (+ i 1)))
+      ((or (= i format:fn-len)
+	   (not (char=? (string-ref format:fn-str i) #\0)))
+       (if (= i format:fn-len)		; found a real zero
+	   0
+	   i))))
+
+
+;;; some global functions not found in SLIB
+
+;; string-index finds the index of the first occurence of the character `c'
+;; in the string `s'; it returns #f if there is no such character in `s'.
+
+(define (string-index s c)
+  (let ((slen-1 (- (string-length s) 1)))
+    (let loop ((i 0))
+      (cond
+       ((char=? c (string-ref s i)) i)
+       ((= i slen-1) #f)
+       (else (loop (+ i 1)))))))
+
+(define (string-capitalize-first str)	; "hello" -> "Hello"
+  (let ((cap-str (string-copy str))	; "hELLO" -> "Hello"
+	(non-first-alpha #f)		; "*hello" -> "*Hello"
+	(str-len (string-length str)))	; "hello you" -> "Hello you"
+    (do ((i 0 (+ i 1)))
+	((= i str-len) cap-str)
+      (let ((c (string-ref str i)))
+	(if (char-alphabetic? c)
+	    (if non-first-alpha
+		(string-set! cap-str i (char-downcase c))
+		(begin
+		  (set! non-first-alpha #t)
+		  (string-set! cap-str i (char-upcase c)))))))))
+
+(define (list-head l k)
+  (if (= k 0)
+      '()
+      (cons (car l) (list-head (cdr l) (- k 1)))))
+
+
+;; Aborts the program when a formatting error occures. This is a null
+;; argument closure to jump to the interpreters toplevel continuation.
+
+(define format:abort (lambda () (slib:error "error in format")))
+
+(define format format:format)
+
+;; If this is not possible then a continuation is used to recover
+;; properly from a format error. In this case format returns #f.
+
+;(define format:abort
+;  (lambda () (format:error-continuation #f)))
+
+;(define format
+;  (lambda args				; wraps format:format with an error
+;    (call-with-current-continuation	; continuation
+;     (lambda (cont)
+;       (set! format:error-continuation cont)
+;       (apply format:format args)))))
+
+;eof
diff --git a/formatst.scm b/formatst.scm
new file mode 100644
index 0000000..7a2173e
--- /dev/null
+++ b/formatst.scm
@@ -0,0 +1,647 @@
+;; "formatst.scm" SLIB FORMAT Version 3.0 conformance test
+; Written by Dirk Lutzebaeck (lutzeb@cs.tu-berlin.de)
+;
+; This code is in the public domain.
+
+;; Test run: (slib:load "formatst")
+
+; Failure reports for various scheme interpreters:
+;
+; SCM4d 
+;   None.
+; Elk 2.2:
+;   None.
+; MIT C-Scheme 7.1:
+;   The empty list is always evaluated as a boolean and consequently
+;   represented as `#f'.
+; Scheme->C 01nov91:
+;   None, if format:symbol-case-conv and format:iobj-case-conv are set
+;   to string-downcase. 
+
+(require 'format)
+(if (not (string=? format:version "3.0"))
+    (begin
+      (display "You have format version ")
+      (display format:version)
+      (display ". This test is for format version 3.0!")
+      (newline)
+      (format:abort)))
+
+(define fails 0)
+(define total 0)
+(define test-verbose #f)		; shows each test performed
+
+(define (test format-args out-str)
+  (set! total (+ total 1))
+  (if (not test-verbose)
+      (if (zero? (modulo total 10))
+          (begin
+            (display total)
+            (display ",")
+	    (force-output (current-output-port)))))
+  (let ((format-out (apply format `(#f ,@format-args))))
+    (if (string=? out-str format-out)
+	(if test-verbose
+	    (begin
+	      (display "Verified ")
+	      (write format-args)
+	      (display " returns ")
+	      (write out-str)
+	      (newline)))
+	(begin
+	  (set! fails (+ fails 1))
+	  (if (not test-verbose) (newline))
+	  (display "*Failed* ")
+	  (write format-args)
+	  (newline)
+	  (display " returns  ")
+	  (write format-out)
+	  (newline)
+	  (display " expected ")
+	  (write out-str)
+	  (newline)))))
+
+; ensure format default configuration
+
+(set! format:symbol-case-conv #f)
+(set! format:iobj-case-conv #f)
+(set! format:read-proof #f)
+
+(format #t "~q")
+
+(format #t "This implementation has~@[ no~] flonums ~
+            ~:[but no~;and~] complex numbers~%"
+	(not format:floats) format:complex-numbers)
+
+; any object test
+
+(test '("abc") "abc")
+(test '("~a" 10) "10")
+(test '("~a" -1.2) "-1.2")
+(test '("~a" a) "a")
+(test '("~a" #t) "#t")
+(test '("~a" #f) "#f")
+(test '("~a" "abc") "abc")
+(test '("~a" #(1 2 3)) "#(1 2 3)")
+(test '("~a" ()) "()")
+(test '("~a" (a)) "(a)")
+(test '("~a" (a b)) "(a b)")
+(test '("~a" (a (b c) d)) "(a (b c) d)")
+(test '("~a" (a . b)) "(a . b)")
+(test '("~a" (a (b c . d))) "(a (b . (c . d)))") ; this is ugly
+(test `("~a" ,display) (format:iobj->str display))
+(test `("~a" ,(current-input-port)) (format:iobj->str (current-input-port)))
+(test `("~a" ,(current-output-port)) (format:iobj->str (current-output-port)))
+
+; # argument test
+
+(test '("~a ~a" 10 20) "10 20")
+(test '("~a abc ~a def" 10 20) "10 abc 20 def")
+
+; numerical test
+
+(test '("~d" 100) "100")
+(test '("~x" 100) "64")
+(test '("~o" 100) "144")
+(test '("~b" 100) "1100100")
+(test '("~@d" 100) "+100")
+(test '("~@d" -100) "-100")
+(test '("~@x" 100) "+64")
+(test '("~@o" 100) "+144")
+(test '("~@b" 100) "+1100100")
+(test '("~10d" 100) "       100")
+(test '("~:d" 123) "123")
+(test '("~:d" 1234) "1,234")
+(test '("~:d" 12345) "12,345")
+(test '("~:d" 123456) "123,456")
+(test '("~:d" 12345678) "12,345,678")
+(test '("~:d" -123) "-123")
+(test '("~:d" -1234) "-1,234")
+(test '("~:d" -12345) "-12,345")
+(test '("~:d" -123456) "-123,456")
+(test '("~:d" -12345678) "-12,345,678")
+(test '("~10:d" 1234) "     1,234")
+(test '("~10:d" -1234) "    -1,234")
+(test '("~10,'*d" 100) "*******100")
+(test '("~10,,'|:d" 12345678) "12|345|678")
+(test '("~10,,,2:d" 12345678) "12,34,56,78")
+(test '("~14,'*,'|,4:@d" 12345678) "****+1234|5678")
+(test '("~10r" 100) "100")
+(test '("~2r" 100) "1100100")
+(test '("~8r" 100) "144")
+(test '("~16r" 100) "64")
+(test '("~16,10,'*r" 100) "********64")
+
+; roman numeral test
+
+(test '("~@r" 4) "IV")
+(test '("~@r" 19) "XIX")
+(test '("~@r" 50) "L")
+(test '("~@r" 100) "C")
+(test '("~@r" 1000) "M")
+(test '("~@r" 99) "XCIX")
+(test '("~@r" 1994) "MCMXCIV")
+
+; old roman numeral test
+
+(test '("~:@r" 4) "IIII")
+(test '("~:@r" 5) "V")
+(test '("~:@r" 10) "X")
+(test '("~:@r" 9) "VIIII")
+
+; cardinal/ordinal English number test
+
+(test '("~r" 4) "four")
+(test '("~r" 10) "ten")
+(test '("~r" 19) "nineteen")
+(test '("~r" 1984) "one thousand, nine hundred eighty-four")
+(test '("~:r" -1984) "minus one thousand, nine hundred eighty-fourth")
+
+; character test
+
+(test '("~c" #\a) "a")
+(test '("~@c" #\a) "#\\a")
+(test `("~@c" ,(integer->char 32)) "#\\space")
+(test `("~@c" ,(integer->char 0)) "#\\nul")
+(test `("~@c" ,(integer->char 27)) "#\\esc")
+(test `("~@c" ,(integer->char 127)) "#\\del")
+(test `("~@c" ,(integer->char 128)) "#\\200")
+(test `("~@c" ,(integer->char 255)) "#\\377")
+(test '("~65c") "A")
+(test '("~7@c") "#\\bel")
+(test '("~:c" #\a) "a")
+(test `("~:c" ,(integer->char 1)) "^A")
+(test `("~:c" ,(integer->char 27)) "^[")
+(test '("~7:c") "^G")
+(test `("~:c" ,(integer->char 128)) "#\\200")
+(test `("~:c" ,(integer->char 127)) "#\\177")
+(test `("~:c" ,(integer->char 255)) "#\\377")
+
+
+; plural test
+
+(test '("test~p" 1) "test")
+(test '("test~p" 2) "tests")
+(test '("test~p" 0) "tests")
+(test '("tr~@p" 1) "try")
+(test '("tr~@p" 2) "tries")
+(test '("tr~@p" 0) "tries")
+(test '("~a test~:p" 10) "10 tests")
+(test '("~a test~:p" 1) "1 test")
+
+; tilde test
+
+(test '("~~~~") "~~")
+(test '("~3~") "~~~")
+
+; whitespace character test
+
+(test '("~%") "
+")
+(test '("~3%") "
+
+
+")
+(test '("~&") "")
+(test '("abc~&") "abc
+")
+(test '("abc~&def") "abc
+def")
+(test '("~&") "
+")
+(test '("~3&") "
+
+")
+(test '("abc~3&") "abc
+
+
+")
+(test '("~|") (string slib:form-feed))
+(test '("~_~_~_") "   ")
+(test '("~3_") "   ")
+(test '("~/") (string slib:tab))
+(test '("~3/") (make-string 3 slib:tab))
+
+; tabulate test
+
+(test '("~0&~3t") "   ")
+(test '("~0&~10t") "          ")
+(test '("~10t") "")
+(test '("~0&1234567890~,8tABC")  "1234567890       ABC")
+(test '("~0&1234567890~0,8tABC") "1234567890      ABC")
+(test '("~0&1234567890~1,8tABC") "1234567890       ABC")
+(test '("~0&1234567890~2,8tABC") "1234567890ABC")
+(test '("~0&1234567890~3,8tABC") "1234567890 ABC")
+(test '("~0&1234567890~4,8tABC") "1234567890  ABC")
+(test '("~0&1234567890~5,8tABC") "1234567890   ABC")
+(test '("~0&1234567890~6,8tABC") "1234567890    ABC")
+(test '("~0&1234567890~7,8tABC") "1234567890     ABC")
+(test '("~0&1234567890~8,8tABC") "1234567890      ABC")
+(test '("~0&1234567890~9,8tABC") "1234567890       ABC")
+(test '("~0&1234567890~10,8tABC") "1234567890ABC")
+(test '("~0&1234567890~11,8tABC") "1234567890 ABC")
+(test '("~0&12345~,8tABCDE~,8tXYZ") "12345    ABCDE   XYZ")
+(test '("~,8t+++~,8t===") "     +++     ===")
+(test '("~0&ABC~,8,'.tDEF") "ABC......DEF")
+(test '("~0&~3,8@tABC") "        ABC")
+(test '("~0&1234~3,8@tABC") "1234    ABC")
+(test '("~0&12~3,8@tABC~3,8@tDEF") "12      ABC     DEF")
+
+; indirection test
+
+(test '("~a ~? ~a" 10 "~a ~a" (20 30) 40) "10 20 30 40")
+(test '("~a ~@? ~a" 10 "~a ~a" 20 30 40) "10 20 30 40")
+
+; field test
+
+(test '("~10a" "abc") "abc       ")
+(test '("~10@a" "abc") "       abc")
+(test '("~10a" "0123456789abc") "0123456789abc")
+(test '("~10@a" "0123456789abc") "0123456789abc")
+
+; pad character test
+
+(test '("~10,,,'*a" "abc") "abc*******")
+(test '("~10,,,'Xa" "abc") "abcXXXXXXX")
+(test '("~10,,,42a" "abc") "abc*******")
+(test '("~10,,,'*@a" "abc") "*******abc")
+(test '("~10,,3,'*a" "abc") "abc*******")
+(test '("~10,,3,'*a" "0123456789abc") "0123456789abc***") ; min. padchar length
+(test '("~10,,3,'*@a" "0123456789abc") "***0123456789abc")
+
+; colinc, minpad padding test
+
+(test '("~10,8,0,'*a" 123)  "123********")
+(test '("~10,9,0,'*a" 123)  "123*********")
+(test '("~10,10,0,'*a" 123) "123**********")
+(test '("~10,11,0,'*a" 123) "123***********")
+(test '("~8,1,0,'*a" 123) "123*****")
+(test '("~8,2,0,'*a" 123) "123******")
+(test '("~8,3,0,'*a" 123) "123******")
+(test '("~8,4,0,'*a" 123) "123********")
+(test '("~8,5,0,'*a" 123) "123*****")
+(test '("~8,1,3,'*a" 123) "123*****")
+(test '("~8,1,5,'*a" 123) "123*****")
+(test '("~8,1,6,'*a" 123) "123******")
+(test '("~8,1,9,'*a" 123) "123*********")
+
+; slashify test
+
+(test '("~s" "abc") "\"abc\"")
+(test '("~s" "abc \\ abc") "\"abc \\\\ abc\"")
+(test '("~a" "abc \\ abc") "abc \\ abc")
+(test '("~s" "abc \" abc") "\"abc \\\" abc\"")
+(test '("~a" "abc \" abc") "abc \" abc")
+(test '("~s" #\space) "#\\space")
+(test '("~s" #\newline) "#\\newline")
+(test '("~s" #\tab) "#\\ht")
+(test '("~s" #\a) "#\\a")
+(test '("~a" (a "b" c)) "(a \"b\" c)")
+
+; symbol case force test
+
+(define format:old-scc format:symbol-case-conv)
+(set! format:symbol-case-conv string-upcase)
+(test '("~a" abc) "ABC")
+(set! format:symbol-case-conv string-downcase)
+(test '("~s" abc) "abc")
+(set! format:symbol-case-conv string-capitalize)
+(test '("~s" abc) "Abc")
+(set! format:symbol-case-conv format:old-scc)
+
+; read proof test
+
+(test `("~:s" ,display)
+      (begin
+	(set! format:read-proof #t)
+	(format:iobj->str display)))
+(test `("~:a" ,display)
+      (begin
+	(set! format:read-proof #t)
+	(format:iobj->str display)))
+(test `("~:a" (1 2 ,display))
+      (begin
+	(set! format:read-proof #t)
+	(string-append "(1 2 " (format:iobj->str display) ")")))
+(test '("~:a" "abc") "abc")
+(set! format:read-proof #f)
+
+; internal object case type force test
+
+(set! format:iobj-case-conv string-upcase)
+(test `("~a" ,display) (string-upcase (format:iobj->str display)))
+(set! format:iobj-case-conv string-downcase)
+(test `("~s" ,display) (string-downcase (format:iobj->str display)))
+(set! format:iobj-case-conv string-capitalize)
+(test `("~s" ,display) (string-capitalize (format:iobj->str display)))
+(set! format:iobj-case-conv #f)
+
+; continuation line test
+
+(test '("abc~
+         123") "abc123")
+(test '("abc~
+123") "abc123")
+(test '("abc~
+") "abc")
+(test '("abc~:
+         def") "abc         def")
+(test '("abc~@
+         def")
+"abc
+def")
+
+; flush output (can't test it here really)
+
+(test '("abc ~! xyz") "abc  xyz")
+
+; string case conversion
+
+(test '("~a ~(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc hello world xyz")
+(test '("~a ~:(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc Hello World xyz")
+(test '("~a ~@(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc Hello world xyz")
+(test '("~a ~:@(~a~) ~a" "abc" "hello world" "xyz") "abc HELLO WORLD xyz")
+(test '("~:@(~a~)" (a b c)) "(A B C)")
+(test '("~:@(~x~)" 255) "FF")
+(test '("~:@(~p~)" 2) "S")
+(test `("~:@(~a~)" ,display) (string-upcase (format:iobj->str display)))
+(test '("~:(~a ~a ~a~) ~a" "abc" "xyz" "123" "world") "Abc Xyz 123 world")
+
+; variable parameter
+
+(test '("~va" 10 "abc") "abc       ")
+(test '("~v,,,va" 10 42 "abc") "abc*******")
+
+; number of remaining arguments as parameter
+
+(test '("~#,,,'*@a ~a ~a ~a" 1 1 1 1) "***1 1 1 1")
+
+; argument jumping
+
+(test '("~a ~* ~a" 10 20 30) "10  30")
+(test '("~a ~2* ~a" 10 20 30 40) "10  40")
+(test '("~a ~:* ~a" 10) "10  10")
+(test '("~a ~a ~2:* ~a ~a" 10 20) "10 20  10 20")
+(test '("~a ~a ~@* ~a ~a" 10 20) "10 20  10 20")
+(test '("~a ~a ~4@* ~a ~a" 10 20 30 40 50 60) "10 20  50 60")
+
+; conditionals
+
+(test '("~[abc~;xyz~]" 0) "abc")
+(test '("~[abc~;xyz~]" 1) "xyz")
+(test '("~[abc~;xyz~:;456~]" 99) "456")
+(test '("~0[abc~;xyz~:;456~]") "abc")
+(test '("~1[abc~;xyz~:;456~] ~a" 100) "xyz 100")
+(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]") "no arg")
+(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10) "10")
+(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10 20) "10 and 20")
+(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10 20 30) "10, 20 and 30")
+(test '("~:[hello~;world~] ~a" #t 10) "world 10")
+(test '("~:[hello~;world~] ~a" #f 10) "hello 10")
+(test '("~@[~a tests~]" #f) "")
+(test '("~@[~a tests~]" 10) "10 tests")
+(test '("~@[~a test~:p~] ~a" 10 done) "10 tests done")
+(test '("~@[~a test~:p~] ~a" 1 done) "1 test done")
+(test '("~@[~a test~:p~] ~a" 0 done) "0 tests done")
+(test '("~@[~a test~:p~] ~a" #f done) " done")
+(test '("~@[ level = ~d~]~@[ length = ~d~]" #f 5) " length = 5")
+(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 0) "abc")   ; nested conditionals (irrghh)
+(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 2) "xyz")
+(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 1 2) "6")
+
+; iteration
+
+(test '("~{ ~a ~}" (a b c)) " a  b  c ")
+(test '("~{ ~a ~}" ()) "")
+(test '("~{ ~a ~5,,,'*a~}" (a b c d)) " a b**** c d****")
+(test '("~{ ~a,~a ~}" (a 1 b 2 c 3)) " a,1  b,2  c,3 ")
+(test '("~2{ ~a,~a ~}" (a 1 b 2 c 3)) " a,1  b,2 ")
+(test '("~3{~a ~} ~a" (a b c d e) 100) "a b c  100")
+(test '("~0{~a ~} ~a" (a b c d e) 100) " 100")
+(test '("~:{ ~a,~a ~}" ((a b) (c d e f) (g h))) " a,b  c,d  g,h ")
+(test '("~2:{ ~a,~a ~}" ((a b) (c d e f) (g h))) " a,b  c,d ")
+(test '("~@{ ~a,~a ~}" a 1 b 2 c 3) " a,1  b,2  c,3 ")
+(test '("~2@{ ~a,~a ~} <~a|~a>" a 1 b 2 c 3) " a,1  b,2  <c|3>")
+(test '("~:@{ ~a,~a ~}" (a 1) (b 2) (c 3)) " a,1  b,2  c,3 ")
+(test '("~2:@{ ~a,~a ~} ~a" (a 1) (b 2) (c 3)) " a,1  b,2  (c 3)")
+(test '("~{~}" "<~a,~a>" (a 1 b 2 c 3)) "<a,1><b,2><c,3>")
+(test '("~{ ~a ~{<~a>~}~} ~a" (a (1 2) b (3 4)) 10) " a <1><2> b <3><4> 10")
+
+; up and out
+
+(test '("abc ~^ xyz") "abc ")
+(test '("~@(abc ~^ xyz~) ~a" 10) "ABC  xyz 10")
+(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p.") "done. ")
+(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p." 10) "done.  10 warnings. ")
+(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p." 10 1)
+      "done.  10 warnings.  1 error.")
+(test '("~{ ~a ~^<~a>~} ~a" (a b c d e f) 10) " a <b> c <d> e <f> 10")
+(test '("~{ ~a ~^<~a>~} ~a" (a b c d e) 10) " a <b> c <d> e  10")
+(test '("abc~0^ xyz") "abc")
+(test '("abc~9^ xyz") "abc xyz")
+(test '("abc~7,4^ xyz") "abc xyz")
+(test '("abc~7,7^ xyz") "abc")
+(test '("abc~3,7,9^ xyz") "abc")
+(test '("abc~8,7,9^ xyz") "abc xyz")
+(test '("abc~3,7,5^ xyz") "abc xyz")
+
+; complexity tests (oh my god, I hardly understand them myself (see CL std))
+
+(define fmt "Items:~#[ none~; ~a~; ~a and ~a~:;~@{~#[~; and~] ~a~^,~}~].")
+
+(test `(,fmt ) "Items: none.")
+(test `(,fmt foo) "Items: foo.")
+(test `(,fmt foo bar) "Items: foo and bar.")
+(test `(,fmt foo bar baz) "Items: foo, bar, and baz.")
+(test `(,fmt foo bar baz zok) "Items: foo, bar, baz, and zok.")
+
+; fixed floating points
+
+(cond
+ (format:floats
+  (test '("~6,2f" 3.14159) "  3.14")
+  (test '("~6,1f" 3.14159) "   3.1")
+  (test '("~6,0f" 3.14159) "    3.")
+  (test '("~5,1f" 0) "  0.0")
+  (test '("~10,7f" 3.14159) " 3.1415900")
+  (test '("~10,7f" -3.14159) "-3.1415900")
+  (test '("~10,7@f" 3.14159) "+3.1415900")
+  (test '("~6,3f" 0.0) " 0.000")
+  (test '("~6,4f" 0.007) "0.0070")
+  (test '("~6,3f" 0.007) " 0.007")
+  (test '("~6,2f" 0.007) "  0.01")
+  (test '("~3,2f" 0.007) ".01")
+  (test '("~3,2f" -0.007) "-.01")
+  (test '("~6,2,,,'*f" 3.14159) "**3.14")
+  (test '("~6,3,,'?f" 12345.56789) "??????")
+  (test '("~6,3f" 12345.6789) "12345.679")
+  (test '("~,3f" 12345.6789) "12345.679")
+  (test '("~,3f" 9.9999) "10.000")
+  (test '("~6f" 23.4) "  23.4")
+  (test '("~6f" 1234.5) "1234.5")
+  (test '("~6f" 12345678) "12345678.0")
+  (test '("~6,,,'?f" 12345678) "??????")
+  (test '("~6f" 123.56789) "123.57")
+  (test '("~6f" 123.0) " 123.0")
+  (test '("~6f" -123.0) "-123.0")
+  (test '("~6f" 0.0) "   0.0")
+  (test '("~3f" 3.141) "3.1")
+  (test '("~2f" 3.141) "3.")
+  (test '("~1f" 3.141) "3.141")
+  (test '("~f" 123.56789) "123.56789")
+  (test '("~f" -314.0) "-314.0")
+  (test '("~f" 1e4) "10000.0")
+  (test '("~f" -1.23e10) "-12300000000.0")
+  (test '("~f" 1e-4) "0.0001")
+  (test '("~f" -1.23e-10) "-0.000000000123")
+  (test '("~@f" 314.0) "+314.0")
+  (test '("~,,3f" 0.123456) "123.456")
+  (test '("~,,-3f" -123.456) "-0.123456")
+  (test '("~5,,3f" 0.123456) "123.5")
+))
+
+; exponent floating points
+
+(cond
+ (format:floats
+  (test '("~e" 3.14159) "3.14159E+0")
+  (test '("~e" 0.00001234) "1.234E-5")
+  (test '("~,,,0e" 0.00001234) "0.1234E-4")
+  (test '("~,3e" 3.14159) "3.142E+0")
+  (test '("~,3@e" 3.14159) "+3.142E+0")
+  (test '("~,3@e" 0.0) "+0.000E+0")
+  (test '("~,0e" 3.141) "3.E+0")
+  (test '("~,3,,0e" 3.14159) "0.314E+1")
+  (test '("~,5,3,-2e" 3.14159) "0.00314E+003")
+  (test '("~,5,3,-5e" -3.14159) "-0.00000E+006")
+  (test '("~,5,2,2e" 3.14159) "31.4159E-01")
+  (test '("~,5,2,,,,'ee" 0.0) "0.00000e+00")
+  (test '("~12,3e" -3.141) "   -3.141E+0")
+  (test '("~12,3,,,,'#e" -3.141) "###-3.141E+0")
+  (test '("~10,2e" -1.236e-4) "  -1.24E-4")
+  (test '("~5,3e" -3.141) "-3.141E+0")
+  (test '("~5,3,,,'*e" -3.141) "*****")
+  (test '("~3e" 3.14159) "3.14159E+0")
+  (test '("~4e" 3.14159) "3.14159E+0")
+  (test '("~5e" 3.14159) "3.E+0")
+  (test '("~5,,,,'*e" 3.14159) "3.E+0")
+  (test '("~6e" 3.14159) "3.1E+0")
+  (test '("~7e" 3.14159) "3.14E+0")
+  (test '("~7e" -3.14159) "-3.1E+0")
+  (test '("~8e" 3.14159) "3.142E+0")
+  (test '("~9e" 3.14159) "3.1416E+0")
+  (test '("~9,,,,,,'ee" 3.14159) "3.1416e+0")
+  (test '("~10e" 3.14159) "3.14159E+0")
+  (test '("~11e" 3.14159) " 3.14159E+0")
+  (test '("~12e" 3.14159) "  3.14159E+0")
+  (test '("~13,6,2,-5e" 3.14159) " 0.000003E+06")
+  (test '("~13,6,2,-4e" 3.14159) " 0.000031E+05")
+  (test '("~13,6,2,-3e" 3.14159) " 0.000314E+04")
+  (test '("~13,6,2,-2e" 3.14159) " 0.003142E+03")
+  (test '("~13,6,2,-1e" 3.14159) " 0.031416E+02")
+  (test '("~13,6,2,0e" 3.14159)  " 0.314159E+01")
+  (test '("~13,6,2,1e" 3.14159)  " 3.141590E+00")
+  (test '("~13,6,2,2e" 3.14159)  " 31.41590E-01")
+  (test '("~13,6,2,3e" 3.14159)  " 314.1590E-02")
+  (test '("~13,6,2,4e" 3.14159)  " 3141.590E-03")
+  (test '("~13,6,2,5e" 3.14159)  " 31415.90E-04")
+  (test '("~13,6,2,6e" 3.14159)  " 314159.0E-05")
+  (test '("~13,6,2,7e" 3.14159)  " 3141590.E-06")
+  (test '("~13,6,2,8e" 3.14159)  "31415900.E-07")
+  (test '("~7,3,,-2e" 0.001) ".001E+0")
+  (test '("~8,3,,-2@e" 0.001) "+.001E+0")
+  (test '("~8,3,,-2@e" -0.001) "-.001E+0")
+  (test '("~8,3,,-2e" 0.001) "0.001E+0")
+  (test '("~7,,,-2e" 0.001) "0.00E+0")
+  (test '("~12,3,1e" 3.14159e12) "   3.142E+12")
+  (test '("~12,3,1,,'*e" 3.14159e12) "************")
+  (test '("~5,3,1e" 3.14159e12) "3.142E+12")
+))
+
+; general floating point (this test is from Steele's CL book)
+
+(cond
+ (format:floats
+  (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
+	  0.0314159 0.0314159 0.0314159 0.0314159)
+	"  3.14E-2|314.2$-04|0.314E-01|  3.14E-2")
+  (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
+	  0.314159 0.314159 0.314159 0.314159)
+	"  0.31   |0.314    |0.314    | 0.31    ")
+  (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
+	  3.14159 3.14159 3.14159 3.14159)
+	"   3.1   | 3.14    | 3.14    |  3.1    ")
+  (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
+	  31.4159 31.4159 31.4159 31.4159)
+	"   31.   | 31.4    | 31.4    |  31.    ")
+  (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
+	  314.159 314.159 314.159 314.159)
+	"  3.14E+2| 314.    | 314.    |  3.14E+2") 
+  (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
+	  3141.59 3141.59 3141.59 3141.59)
+	"  3.14E+3|314.2$+01|0.314E+04|  3.14E+3")
+  (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
+	  3.14E12 3.14E12 3.14E12 3.14E12)
+	"*********|314.0$+10|0.314E+13| 3.14E+12")
+  (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
+	  3.14E120 3.14E120 3.14E120 3.14E120)
+	"*********|?????????|%%%%%%%%%|3.14E+120")
+  
+  (test '("~g" 0.0) "0.0    ")		; further ~g tests 
+  (test '("~g" 0.1) "0.1    ")
+  (test '("~g" 0.01) "1.0E-2")
+  (test '("~g" 123.456) "123.456    ")
+  (test '("~g" 123456.7) "123456.7    ")
+  (test '("~g" 123456.78) "123456.78    ")
+  (test '("~g" 0.9282) "0.9282    ")
+  (test '("~g" 0.09282) "9.282E-2")
+  (test '("~g" 1) "1.0    ")
+  (test '("~g" 12) "12.0    ")
+  ))
+
+; dollar floating point
+
+(cond
+ (format:floats
+  (test '("~$" 1.23) "1.23")
+  (test '("~$" 1.2) "1.20")
+  (test '("~$" 0.0) "0.00")
+  (test '("~$" 9.999) "10.00")
+  (test '("~3$" 9.9999) "10.000")
+  (test '("~,4$" 3.2) "0003.20")
+  (test '("~,4$" 10000.2) "10000.20")
+  (test '("~,4,10$" 3.2) "   0003.20")
+  (test '("~,4,10@$" 3.2) "  +0003.20")
+  (test '("~,4,10:@$" 3.2) "+  0003.20")
+  (test '("~,4,10:$" -3.2) "-  0003.20")
+  (test '("~,4,10$" -3.2) "  -0003.20")
+  (test '("~,,10@$" 3.2) "     +3.20")
+  (test '("~,,10:@$" 3.2) "+     3.20")
+  (test '("~,,10:@$" -3.2) "-     3.20")
+  (test '("~,,10,'_@$" 3.2) "_____+3.20")
+  (test '("~,,4$" 1234.4) "1234.40")
+))
+
+; complex numbers
+
+(cond 
+ (format:complex-numbers
+  (test '("~i" 3.0) "3.0+0.0i")
+  (test '("~,3i" 3.0) "3.000+0.000i")
+  (test `("~7,2i" ,(string->number "3.0+5.0i")) "   3.00  +5.00i")
+  (test `("~7,2,1i" ,(string->number "3.0+5.0i")) "  30.00 +50.00i")
+  (test `("~7,2@i" ,(string->number "3.0+5.0i")) "  +3.00  +5.00i")
+  (test `("~7,2,,,'*@i" ,(string->number "3.0+5.0i")) "**+3.00**+5.00i")
+  )) ; note: some parsers choke syntactically on reading a complex
+     ; number though format:complex is #f; this is why we put them in
+     ; strings 
+
+; inquiry test
+
+(test '("~:q") format:version)
+
+(if (not test-verbose) (display "done."))
+
+(format #t "~%~a Test~:p completed. (~a failure~:p)~2%" total fails)
+
+; eof
diff --git a/gambit.init b/gambit.init
new file mode 100644
index 0000000..47717dc
--- /dev/null
+++ b/gambit.init
@@ -0,0 +1,219 @@
+;;;"gambit.init" Initialisation for SLIB for Gambit	-*-scheme-*-
+;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; Updated 1992 February 1 for Gambit v1.71 -- by Ken Dickey
+;;; Date: Wed, 12 Jan 1994 15:03:12 -0500
+;;; From: barnett@armadillo.urich.edu (Lewis Barnett)
+;;; Relative pathnames for Slib in MacGambit
+
+(define (SOFTWARE-TYPE) 'UNIX)		; 'MACOS for MacGambit.
+
+(define (scheme-implementation-type) 'gambit)
+
+(define (scheme-implementation-version) "?")
+
+(define SYSTEM ##unix-system)		; Comment out for 'MACOS
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxillary files to your Scheme
+;;; implementation reside.
+
+(define implementation-vicinity
+  (let ((arg0 (vector-ref ##argv 0)))
+    (let loop ((i (- (string-length arg0) 1)))
+      (cond ((negative? i) "")
+	    ((char=? #\: (string-ref arg0 i))
+	     (lambda ()
+	       (substring arg0 0 (+ i 1))))
+	    (else (loop (- i 1)))))))
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+;;; This assumes that the slib files are in a folder
+;;; called slib in the same directory as the MacGambit Interpreter.
+
+(define library-vicinity
+  (let ((library-path
+	 (case (software-type)
+	   ((UNIX) "/usr/local/lib/slib/")
+	   ((MACOS) (string-append (implementation-vicinity) ":slib:"))
+	   ((AMIGA)	"dh0:scm/Library/")
+	   ((VMS) "lib$scheme:")
+	   ((MS-DOS) "C:\\SLIB\\")
+	   (else ""))))
+    (lambda () library-path)))
+
+;;; *features* should be set to a list of symbols describing features
+;;; of this implementation.  See Template.scm for the list of feature
+;;; names.
+
+(define *features*
+     ((lambda (l)
+	(if (eq? (SOFTWARE-TYPE) 'MACOS) l (cons 'system l)))
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+	rev4-report
+	ieee-p1178
+	sicp
+	rev4-optional-procedures
+	rev3-procedures
+	rev2-procedures
+	multiarg/and-
+	multiarg-apply
+	object-hash
+	rationalize
+	delay
+	with-file
+	transcript
+	char-ready?
+	ieee-floating-point
+	full-continuation
+	)))
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define (output-port-width . arg) 79)
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (let ((port (current-output-port)))
+    (lambda () port)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam
+  (let ((cntr 100))
+    (lambda () (set! cntr (+ 1 cntr))
+	    (let ((tmp (string-append "slib_" (number->string cntr))))
+	      (if (file-exists? tmp) (tmpnam) tmp)))))
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;; use this definition if your system doesn't have such a procedure.
+(define (force-output . arg) #t)
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.
+(define char-code-limit 256)
+
+;; MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum #x1FFFFFFF)  ;; 3-bit tag for 68K
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval, SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+(define SLIB:EVAL ##eval-global);; Gambit v1.71
+
+;;; If your implementation provides R4RS macros:
+;(define macro:eval slib:eval)
+;(define macro:load load)
+
+(define *defmacros*
+  (list (cons 'defmacro
+	      (lambda (name parms . body)
+		`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
+				      *defmacros*))))))
+(define (defmacro? m) (and (assq m *defmacros*) #t))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a) (set! a (assq a *defmacros*))
+				     (if a (apply (cdr a) (cdr e)) e))
+			(else e)))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a)
+			 (set! a (assq a *defmacros*))
+			 (if a (macroexpand (apply (cdr a) (cdr e))) e))
+			(else e)))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define base:eval slib:eval)
+(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+(define (defmacro:expand* x)
+  (require 'defmacroexpand) (apply defmacro:expand* x '()))
+
+(define (defmacro:load <pathname>)
+  (slib:eval-load <pathname> defmacro:eval))
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;; define an error procedure for the library
+(define SLIB:ERROR error)
+
+;; define these as appropriate for your system.
+(define slib:tab (integer->char 9))
+(define slib:form-feed (integer->char 12))
+
+(define (1+ n) (+ n 1))
+(define (-1+ n) (- n 1))
+(define 1- -1+)
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:exit (lambda args (exit)))
+
+;;; Here for backward compatability
+
+(define (scheme-file-suffix) ".scm")
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+(define slib:load-source load)
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
+;;;			--- E O F ---
diff --git a/genwrite.scm b/genwrite.scm
new file mode 100644
index 0000000..0bb4e56
--- /dev/null
+++ b/genwrite.scm
@@ -0,0 +1,264 @@
+;;"genwrite.scm" generic write used by pretty-print and truncated-print.
+;; Copyright (c) 1991, Marc Feeley
+;; Author: Marc Feeley (feeley@iro.umontreal.ca)
+;; Distribution restrictions: none
+
+(define (generic-write obj display? width output)
+
+  (define (read-macro? l)
+    (define (length1? l) (and (pair? l) (null? (cdr l))))
+    (let ((head (car l)) (tail (cdr l)))
+      (case head
+        ((QUOTE QUASIQUOTE UNQUOTE UNQUOTE-SPLICING) (length1? tail))
+        (else                                        #f))))
+
+  (define (read-macro-body l)
+    (cadr l))
+
+  (define (read-macro-prefix l)
+    (let ((head (car l)) (tail (cdr l)))
+      (case head
+        ((QUOTE)            "'")
+        ((QUASIQUOTE)       "`")
+        ((UNQUOTE)          ",")
+        ((UNQUOTE-SPLICING) ",@"))))
+
+  (define (out str col)
+    (and col (output str) (+ col (string-length str))))
+
+  (define (wr obj col)
+
+    (define (wr-expr expr col)
+      (if (read-macro? expr)
+        (wr (read-macro-body expr) (out (read-macro-prefix expr) col))
+        (wr-lst expr col)))
+
+    (define (wr-lst l col)
+      (if (pair? l)
+	  (let loop ((l (cdr l))
+		     (col (and col (wr (car l) (out "(" col)))))
+	    (cond ((not col) col)
+		  ((pair? l)
+		   (loop (cdr l) (wr (car l) (out " " col))))
+		  ((null? l) (out ")" col))
+		  (else      (out ")" (wr l (out " . " col))))))
+	  (out "()" col)))
+
+    (cond ((pair? obj)        (wr-expr obj col))
+          ((null? obj)        (wr-lst obj col))
+          ((vector? obj)      (wr-lst (vector->list obj) (out "#" col)))
+          ((boolean? obj)     (out (if obj "#t" "#f") col))
+          ((number? obj)      (out (number->string obj) col))
+          ((symbol? obj)      (out (symbol->string obj) col))
+          ((procedure? obj)   (out "#[procedure]" col))
+          ((string? obj)      (if display?
+                                (out obj col)
+                                (let loop ((i 0) (j 0) (col (out "\"" col)))
+                                  (if (and col (< j (string-length obj)))
+                                    (let ((c (string-ref obj j)))
+                                      (if (or (char=? c #\\)
+                                              (char=? c #\"))
+                                        (loop j
+                                              (+ j 1)
+                                              (out "\\"
+                                                   (out (substring obj i j)
+                                                        col)))
+                                        (loop i (+ j 1) col)))
+                                    (out "\""
+                                         (out (substring obj i j) col))))))
+          ((char? obj)        (if display?
+                                (out (make-string 1 obj) col)
+                                (out (case obj
+                                       ((#\space)   "space")
+                                       ((#\newline) "newline")
+                                       (else        (make-string 1 obj)))
+                                     (out "#\\" col))))
+          ((input-port? obj)  (out "#[input-port]" col))
+          ((output-port? obj) (out "#[output-port]" col))
+          ((eof-object? obj)  (out "#[eof-object]" col))
+          (else               (out "#[unknown]" col))))
+
+  (define (pp obj col)
+
+    (define (spaces n col)
+      (if (> n 0)
+        (if (> n 7)
+          (spaces (- n 8) (out "        " col))
+          (out (substring "        " 0 n) col))
+        col))
+
+    (define (indent to col)
+      (and col
+           (if (< to col)
+             (and (out (make-string 1 #\newline) col) (spaces to 0))
+             (spaces (- to col) col))))
+
+    (define (pr obj col extra pp-pair)
+      (if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines
+        (let ((result '())
+              (left (min (+ (- (- width col) extra) 1) max-expr-width)))
+          (generic-write obj display? #f
+            (lambda (str)
+              (set! result (cons str result))
+              (set! left (- left (string-length str)))
+              (> left 0)))
+          (if (> left 0) ; all can be printed on one line
+            (out (reverse-string-append result) col)
+            (if (pair? obj)
+              (pp-pair obj col extra)
+              (pp-list (vector->list obj) (out "#" col) extra pp-expr))))
+        (wr obj col)))
+
+    (define (pp-expr expr col extra)
+      (if (read-macro? expr)
+        (pr (read-macro-body expr)
+            (out (read-macro-prefix expr) col)
+            extra
+            pp-expr)
+        (let ((head (car expr)))
+          (if (symbol? head)
+            (let ((proc (style head)))
+              (if proc
+                (proc expr col extra)
+                (if (> (string-length (symbol->string head))
+                       max-call-head-width)
+                  (pp-general expr col extra #f #f #f pp-expr)
+                  (pp-call expr col extra pp-expr))))
+            (pp-list expr col extra pp-expr)))))
+
+    ; (head item1
+    ;       item2
+    ;       item3)
+    (define (pp-call expr col extra pp-item)
+      (let ((col* (wr (car expr) (out "(" col))))
+        (and col
+             (pp-down (cdr expr) col* (+ col* 1) extra pp-item))))
+
+    ; (item1
+    ;  item2
+    ;  item3)
+    (define (pp-list l col extra pp-item)
+      (let ((col (out "(" col)))
+        (pp-down l col col extra pp-item)))
+
+    (define (pp-down l col1 col2 extra pp-item)
+      (let loop ((l l) (col col1))
+        (and col
+             (cond ((pair? l)
+                    (let ((rest (cdr l)))
+                      (let ((extra (if (null? rest) (+ extra 1) 0)))
+                        (loop rest
+                              (pr (car l) (indent col2 col) extra pp-item)))))
+                   ((null? l)
+                    (out ")" col))
+                   (else
+                    (out ")"
+                         (pr l
+                             (indent col2 (out "." (indent col2 col)))
+                             (+ extra 1)
+                             pp-item)))))))
+
+    (define (pp-general expr col extra named? pp-1 pp-2 pp-3)
+
+      (define (tail1 rest col1 col2 col3)
+        (if (and pp-1 (pair? rest))
+          (let* ((val1 (car rest))
+                 (rest (cdr rest))
+                 (extra (if (null? rest) (+ extra 1) 0)))
+            (tail2 rest col1 (pr val1 (indent col3 col2) extra pp-1) col3))
+          (tail2 rest col1 col2 col3)))
+
+      (define (tail2 rest col1 col2 col3)
+        (if (and pp-2 (pair? rest))
+          (let* ((val1 (car rest))
+                 (rest (cdr rest))
+                 (extra (if (null? rest) (+ extra 1) 0)))
+            (tail3 rest col1 (pr val1 (indent col3 col2) extra pp-2)))
+          (tail3 rest col1 col2)))
+
+      (define (tail3 rest col1 col2)
+        (pp-down rest col2 col1 extra pp-3))
+
+      (let* ((head (car expr))
+             (rest (cdr expr))
+             (col* (wr head (out "(" col))))
+        (if (and named? (pair? rest))
+          (let* ((name (car rest))
+                 (rest (cdr rest))
+                 (col** (wr name (out " " col*))))
+            (tail1 rest (+ col indent-general) col** (+ col** 1)))
+          (tail1 rest (+ col indent-general) col* (+ col* 1)))))
+
+    (define (pp-expr-list l col extra)
+      (pp-list l col extra pp-expr))
+
+    (define (pp-LAMBDA expr col extra)
+      (pp-general expr col extra #f pp-expr-list #f pp-expr))
+
+    (define (pp-IF expr col extra)
+      (pp-general expr col extra #f pp-expr #f pp-expr))
+
+    (define (pp-COND expr col extra)
+      (pp-call expr col extra pp-expr-list))
+
+    (define (pp-CASE expr col extra)
+      (pp-general expr col extra #f pp-expr #f pp-expr-list))
+
+    (define (pp-AND expr col extra)
+      (pp-call expr col extra pp-expr))
+
+    (define (pp-LET expr col extra)
+      (let* ((rest (cdr expr))
+             (named? (and (pair? rest) (symbol? (car rest)))))
+        (pp-general expr col extra named? pp-expr-list #f pp-expr)))
+
+    (define (pp-BEGIN expr col extra)
+      (pp-general expr col extra #f #f #f pp-expr))
+
+    (define (pp-DO expr col extra)
+      (pp-general expr col extra #f pp-expr-list pp-expr-list pp-expr))
+
+    ; define formatting style (change these to suit your style)
+
+    (define indent-general 2)
+
+    (define max-call-head-width 5)
+
+    (define max-expr-width 50)
+
+    (define (style head)
+      (case head
+        ((LAMBDA LET* LETREC DEFINE) pp-LAMBDA)
+        ((IF SET!)                   pp-IF)
+        ((COND)                      pp-COND)
+        ((CASE)                      pp-CASE)
+        ((AND OR)                    pp-AND)
+        ((LET)                       pp-LET)
+        ((BEGIN)                     pp-BEGIN)
+        ((DO)                        pp-DO)
+        (else                        #f)))
+
+    (pr obj col 0 pp-expr))
+
+  (if width
+    (out (make-string 1 #\newline) (pp obj 0))
+    (wr obj 0)))
+
+; (reverse-string-append l) = (apply string-append (reverse l))
+
+(define (reverse-string-append l)
+
+  (define (rev-string-append l i)
+    (if (pair? l)
+      (let* ((str (car l))
+             (len (string-length str))
+             (result (rev-string-append (cdr l) (+ i len))))
+        (let loop ((j 0) (k (- (- (string-length result) i) len)))
+          (if (< j len)
+            (begin
+              (string-set! result k (string-ref str j))
+              (loop (+ j 1) (+ k 1)))
+            result)))
+      (make-string i)))
+
+  (rev-string-append l 0))
diff --git a/getopt.scm b/getopt.scm
new file mode 100644
index 0000000..c2962db
--- /dev/null
+++ b/getopt.scm
@@ -0,0 +1,80 @@
+;;; "getopt.scm" POSIX command argument processing
+;Copyright (C) 1993, 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define getopt:scan #f)
+(define getopt:char #\-)
+(define getopt:opt #f)
+(define *optind* 1)
+(define *optarg* 0)
+
+(define (getopt argc argv optstring)
+  (let ((opts (string->list optstring))
+	(place #f)
+	(arg #f)
+	(argref (lambda () ((if (vector? argv) vector-ref list-ref)
+			    argv *optind*))))
+    (and
+     (cond ((and getopt:scan (not (string=? "" getopt:scan))) #t)
+	   ((>= *optind* argc) #f)
+	   (else
+	    (set! arg (argref))
+	    (cond ((or (<= (string-length arg) 1)
+		       (not (char=? (string-ref arg 0) getopt:char)))
+		   #f)
+		  ((and (= (string-length arg) 2)
+			(char=? (string-ref arg 1) getopt:char))
+		   (set! *optind* (+ *optind* 1))
+		   #f)
+		  (else
+		   (set! getopt:scan
+			 (substring arg 1 (string-length arg)))
+		   #t))))
+     (begin
+       (set! getopt:opt (string-ref getopt:scan 0))
+       (set! getopt:scan
+	     (substring getopt:scan 1 (string-length getopt:scan)))
+       (if (string=? "" getopt:scan) (set! *optind* (+ *optind* 1)))
+       (set! place (member getopt:opt opts))
+       (cond ((not place) #\?)
+	     ((or (null? (cdr place)) (not (char=? #\: (cadr place))))
+	      getopt:opt)
+	     ((not (string=? "" getopt:scan))
+	      (set! *optarg* getopt:scan)
+	      (set! *optind* (+ *optind* 1))
+	      (set! getopt:scan #f)
+	      getopt:opt)
+	     ((< *optind* argc)
+	      (set! *optarg* (argref))
+	      (set! *optind* (+ *optind* 1))
+	      getopt:opt)
+	     ((and (not (null? opts)) (char=? #\: (car opts))) #\:)
+	     (else #\?))))))
+
+(define (getopt-- argc argv optstring)
+  (let* ((opt (getopt argc argv (string-append optstring "-:")))
+	 (optarg *optarg*))
+    (cond ((eqv? #\- opt)		;long option
+	   (do ((l (string-length *optarg*))
+		(i 0 (+ 1 i)))
+	       ((or (>= i l) (char=? #\= (string-ref optarg i)))
+		(cond
+		 ((>= i l) (set! *optarg* #f) optarg)
+		 (else (set! *optarg* (substring optarg (+ 1 i) l))
+		       (substring optarg 0 i))))))
+	  (else opt))))
diff --git a/hash.scm b/hash.scm
new file mode 100644
index 0000000..ab02138
--- /dev/null
+++ b/hash.scm
@@ -0,0 +1,153 @@
+; "hash.scm", hashing functions for Scheme.
+; Copyright (c) 1992, 1993, 1995 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define (hash:hash-char-ci char n)
+  (modulo (char->integer (char-downcase char)) n))
+
+(define hash:hash-char hash:hash-char-ci)
+
+(define (hash:hash-symbol sym n)
+  (hash:hash-string (symbol->string sym) n))
+
+;;; This can overflow on implemenatations where inexacts have a larger
+;;; range than exact integers.
+(define hash:hash-number
+  (if (provided? 'inexact)
+      (lambda (num n)
+	(if (integer? num)
+	    (modulo (if (exact? num) num (inexact->exact num)) n)
+	    (hash:hash-string-ci
+	     (number->string (if (exact? num) (exact->inexact num) num))
+	     n)))
+      (lambda (num n)
+	(if (integer? num)
+	    (modulo num n)
+	    (hash:hash-string-ci (number->string num) n)))))
+
+(define (hash:hash-string-ci str n)
+  (let ((len (string-length str)))
+    (if (> len 5)
+	(let loop ((h (modulo 264 n)) (i 5))
+	  (if (positive? i)
+	      (loop (modulo (+ (* h 256)
+			       (char->integer
+				(char-downcase
+				 (string-ref str (modulo h len)))))
+			    n)
+		    (- i 1))
+	      h))
+	(let loop ((h 0) (i (- len 1)))
+	  (if (>= i 0)
+	      (loop (modulo (+ (* h 256)
+			       (char->integer
+				(char-downcase (string-ref str i))))
+			    n)
+		    (- i 1))
+	      h)))))
+
+(define hash:hash-string hash:hash-string-ci)
+
+(define (hash:hash obj n)
+  (let hs ((d 10) (obj obj))
+    (cond
+     ((number? obj)      (hash:hash-number obj n))
+     ((char? obj)        (modulo (char->integer (char-downcase obj)) n))
+     ((symbol? obj)      (hash:hash-symbol obj n))
+     ((string? obj)      (hash:hash-string obj n))
+     ((vector? obj)
+      (let ((len (vector-length obj)))
+	(if (> len 5)
+	    (let lp ((h 1) (i (quotient d 2)))
+	      (if (positive? i)
+		  (lp (modulo (+ (* h 256)
+				 (hs 2 (vector-ref obj (modulo h len))))
+			      n)
+		      (- i 1))
+		  h))
+	    (let loop ((h (- n 1)) (i (- len 1)))
+	      (if (>= i 0)
+		  (loop (modulo (+ (* h 256) (hs (quotient d len)
+						 (vector-ref obj i)))
+				n)
+			(- i 1))
+		  h)))))
+     ((pair? obj)
+      (if (positive? d) (modulo (+ (hs (quotient d 2) (car obj))
+				   (hs (quotient d 2) (cdr obj)))
+				n)
+	  1))
+     (else
+      (modulo
+       (cond
+	((null? obj)        256)
+	((boolean? obj)     (if obj 257 258))
+	((eof-object? obj)  259)
+	((input-port? obj)  260)
+	((output-port? obj) 261)
+	((procedure? obj)   262)
+	((and (provided? 'RECORD) (record? obj))
+	 (let* ((rtd (record-type-descriptor obj))
+		(fns (record-type-field-names rtd))
+		(len (length fns)))
+	   (if (> len 5)
+	       (let lp ((h (modulo 266 n)) (i (quotient d 2)))
+		 (if (positive? i)
+		     (lp (modulo
+			  (+ (* h 256)
+			     (hs 2 ((record-accessor
+				     rtd (list-ref fns (modulo h len)))
+				    obj)))
+			  n)
+			 (- i 1))
+		     h))
+	       (let loop ((h (- n 1)) (i (- len 1)))
+		 (if (>= i 0)
+		     (loop (modulo
+			    (+ (* h 256)
+			       (hs (quotient d len)
+				   ((record-accessor
+				     rtd (list-ref fns (modulo h len)))
+				    obj)))
+			    n)
+			   (- i 1))
+		     h)))))
+	(else               263))
+       n)))))
+
+(define hash hash:hash)
+(define hashv hash:hash)
+
+;;; Object-hash is somewhat expensive on copying GC systems (like
+;;; PC-Scheme and MITScheme).  We use it only on strings, pairs,
+;;; vectors, and records.  This also allows us to use it for both
+;;; hashq and hashv.
+
+(if (provided? 'object-hash)
+    (set! hashv
+	  (if (provided? 'record)
+	      (lambda (obj k)
+		(if (or (string? obj) (pair? obj) (vector? obj) (record? obj))
+		    (modulo (object-hash obj) k)
+		    (hash:hash obj k)))
+	      (lambda (obj k)
+		(if (or (string? obj) (pair? obj) (vector? obj))
+		    (modulo (object-hash obj) k)
+		    (hash:hash obj k))))))
+
+(define hashq hashv)
diff --git a/hashtab.scm b/hashtab.scm
new file mode 100644
index 0000000..317efe2
--- /dev/null
+++ b/hashtab.scm
@@ -0,0 +1,79 @@
+; "hashtab.scm", hash tables for Scheme.
+; Copyright (c) 1992, 1993 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'hash)
+(require 'alist)
+
+(define (predicate->hash pred)
+  (cond ((eq? pred eq?) hashq)
+	((eq? pred eqv?) hashv)
+	((eq? pred equal?) hash)
+	((eq? pred =) hashv)
+	((eq? pred char=?) hashv)
+	((eq? pred char-ci=?) hashv)
+	((eq? pred string=?) hash)
+	((eq? pred string-ci=?) hash)
+	(else (slib:error "unknown predicate for hash" pred))))
+
+(define (make-hash-table k) (make-vector k '()))
+
+(define (predicate->hash-asso pred)
+  (let ((hashfun (predicate->hash pred))
+	(asso (predicate->asso pred)))
+    (lambda (key hashtab)
+      (asso key
+	    (vector-ref hashtab (hashfun key (vector-length hashtab)))))))
+
+(define (hash-inquirer pred)
+  (let ((hashfun (predicate->hash pred))
+	(ainq (alist-inquirer pred)))
+    (lambda (hashtab key)
+      (ainq (vector-ref hashtab (hashfun key (vector-length hashtab)))
+	    key))))
+
+(define (hash-associator pred)
+  (let ((hashfun (predicate->hash pred))
+	(asso (alist-associator pred)))
+    (lambda (hashtab key val)
+      (let* ((num (hashfun key (vector-length hashtab))))
+	(vector-set! hashtab num
+		     (asso (vector-ref hashtab num) key val)))
+      hashtab)))
+
+(define (hash-remover pred)
+  (let ((hashfun (predicate->hash pred))
+	(arem (alist-remover pred)))
+    (lambda (hashtab key)
+      (let* ((num (hashfun key (vector-length hashtab))))
+	(vector-set! hashtab num
+		     (arem (vector-ref hashtab num) key)))
+      hashtab)))
+
+(define (hash-map proc ht)
+  (define nht (make-vector (vector-length ht)))
+  (do ((i (+ -1 (vector-length ht)) (+ -1 i)))
+      ((negative? i) nht)
+    (vector-set!
+     nht i
+     (alist-map proc (vector-ref ht i)))))
+
+(define (hash-for-each proc ht)
+  (do ((i (+ -1 (vector-length ht)) (+ -1 i)))
+      ((negative? i))
+    (alist-for-each proc (vector-ref ht i))))
diff --git a/lineio.scm b/lineio.scm
new file mode 100644
index 0000000..ad8320b
--- /dev/null
+++ b/lineio.scm
@@ -0,0 +1,50 @@
+; "lineio.scm", line oriented input/output functions for Scheme.
+; Copyright (c) 1992, 1993 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define (read-line . arg)
+  (let* ((char (apply read-char arg)))
+    (if (eof-object? char)
+	char
+	(do ((char char (apply read-char arg))
+	     (clist '() (cons char clist)))
+	    ((or (eof-object? char) (char=? #\newline char))
+	     (list->string (reverse clist)))))))
+
+(define (read-line! str . arg)
+  (let* ((char (apply read-char arg))
+	 (len (+ -1 (string-length str))))
+    (if (eof-object? char)
+	char
+	(do ((char char (apply read-char arg))
+	     (i 0 (+ 1 i)))
+	    ((or (eof-object? char)
+		 (char=? #\newline char)
+		 (>= i len))
+	     (cond ((or (eof-object? char) (char=? #\newline char))
+		    i)
+		   (else
+		    (string-set! str i char)
+		    (set! char (apply peek-char arg))
+		    (if (or (eof-object? char) (char=? #\newline char))
+			(+ 1 i) #f))))
+	  (string-set! str i char)))))
+
+(define (write-line str . arg)
+  (apply display str arg)
+  (apply newline arg))
diff --git a/logical.scm b/logical.scm
new file mode 100644
index 0000000..1cc0726
--- /dev/null
+++ b/logical.scm
@@ -0,0 +1,150 @@
+;;;; "logical.scm", bit access and operations for integers for Scheme
+;;; Copyright (C) 1991, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define logical:integer-expt
+  (if (provided? 'inexact)
+      expt
+      (lambda (n k)
+	(logical:ipow-by-squaring n k 1 *))))
+
+(define (logical:ipow-by-squaring x k acc proc)
+  (cond ((zero? k) acc)
+	((= 1 k) (proc acc x))
+	(else (logical:ipow-by-squaring (proc x x)
+					(quotient k 2)
+					(if (even? k) acc (proc acc x))
+					proc))))
+
+(define (logical:logand n1 n2)
+  (cond ((= n1 n2) n1)
+	((zero? n1) 0)
+	((zero? n2) 0)
+	(else
+	 (+ (* (logical:logand (logical:ash-4 n1) (logical:ash-4 n2)) 16)
+	    (vector-ref (vector-ref logical:boole-and (modulo n1 16))
+			(modulo n2 16))))))
+
+(define (logical:logior n1 n2)
+  (cond ((= n1 n2) n1)
+	((zero? n1) n2)
+	((zero? n2) n1)
+	(else
+	 (+ (* (logical:logior (logical:ash-4 n1) (logical:ash-4 n2)) 16)
+	    (- 15 (vector-ref (vector-ref logical:boole-and
+					  (- 15 (modulo n1 16)))
+			      (- 15 (modulo n2 16))))))))
+
+(define (logical:logxor n1 n2)
+  (cond ((= n1 n2) 0)
+	((zero? n1) n2)
+	((zero? n2) n1)
+	(else
+	 (+ (* (logical:logxor (logical:ash-4 n1) (logical:ash-4 n2)) 16)
+	    (vector-ref (vector-ref logical:boole-xor (modulo n1 16))
+			(modulo n2 16))))))
+
+(define (logical:lognot n) (- -1 n))
+
+(define (logical:logtest int1 int2)
+  (not (zero? (logical:logand int1 int2))))
+
+(define (logical:logbit? index int)
+  (logical:logtest (logical:integer-expt 2 index) int))
+
+(define (logical:bit-extract n start end)
+  (logical:logand (- (logical:integer-expt 2 (- end start)) 1)
+		  (logical:ash n (- start))))
+
+(define (logical:ash int cnt)
+  (if (negative? cnt)
+      (let ((n (logical:integer-expt 2 (- cnt))))
+	(if (negative? int)
+	    (+ -1 (quotient (+ 1 int) n))
+	    (quotient int n)))
+      (* (logical:integer-expt 2 cnt) int)))
+
+(define (logical:ash-4 x)
+  (if (negative? x)
+      (+ -1 (quotient (+ 1 x) 16))
+      (quotient x 16)))
+
+(define (logical:logcount n)
+  (cond ((zero? n) 0)
+	((negative? n) (logical:logcount (logical:lognot n)))
+	(else
+	 (+ (logical:logcount (logical:ash-4 n))
+	    (vector-ref '#(0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4)
+			(modulo n 16))))))
+
+(define (logical:integer-length n)
+  (case n
+    ((0 -1) 0)
+    ((1 -2) 1)
+    ((2 3 -3 -4) 2)
+    ((4 5 6 7 -5 -6 -7 -8) 3)
+    (else (+ 4 (logical:integer-length (logical:ash-4 n))))))
+
+(define logical:boole-xor
+ '#(#(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)
+    #(1 0 3 2 5 4 7 6 9 8 11 10 13 12 15 14)
+    #(2 3 0 1 6 7 4 5 10 11 8 9 14 15 12 13)
+    #(3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12)
+    #(4 5 6 7 0 1 2 3 12 13 14 15 8 9 10 11)
+    #(5 4 7 6 1 0 3 2 13 12 15 14 9 8 11 10)
+    #(6 7 4 5 2 3 0 1 14 15 12 13 10 11 8 9)
+    #(7 6 5 4 3 2 1 0 15 14 13 12 11 10 9 8)
+    #(8 9 10 11 12 13 14 15 0 1 2 3 4 5 6 7)
+    #(9 8 11 10 13 12 15 14 1 0 3 2 5 4 7 6)
+    #(10 11 8 9 14 15 12 13 2 3 0 1 6 7 4 5)
+    #(11 10 9 8 15 14 13 12 3 2 1 0 7 6 5 4)
+    #(12 13 14 15 8 9 10 11 4 5 6 7 0 1 2 3)
+    #(13 12 15 14 9 8 11 10 5 4 7 6 1 0 3 2)
+    #(14 15 12 13 10 11 8 9 6 7 4 5 2 3 0 1)
+    #(15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0)))
+
+(define logical:boole-and
+ '#(#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
+    #(0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1)
+    #(0 0 2 2 0 0 2 2 0 0 2 2 0 0 2 2)
+    #(0 1 2 3 0 1 2 3 0 1 2 3 0 1 2 3)
+    #(0 0 0 0 4 4 4 4 0 0 0 0 4 4 4 4)
+    #(0 1 0 1 4 5 4 5 0 1 0 1 4 5 4 5)
+    #(0 0 2 2 4 4 6 6 0 0 2 2 4 4 6 6)
+    #(0 1 2 3 4 5 6 7 0 1 2 3 4 5 6 7)
+    #(0 0 0 0 0 0 0 0 8 8 8 8 8 8 8 8)
+    #(0 1 0 1 0 1 0 1 8 9 8 9 8 9 8 9)
+    #(0 0 2 2 0 0 2 2 8 8 10 10 8 8 10 10)
+    #(0 1 2 3 0 1 2 3 8 9 10 11 8 9 10 11)
+    #(0 0 0 0 4 4 4 4 8 8 8 8 12 12 12 12)
+    #(0 1 0 1 4 5 4 5 8 9 8 9 12 13 12 13)
+    #(0 0 2 2 4 4 6 6 8 8 10 10 12 12 14 14)
+    #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
+
+(define logand logical:logand)
+(define logior logical:logior)
+(define logxor logical:logxor)
+(define lognot logical:lognot)
+(define logtest logical:logtest)
+(define logbit? logical:logbit?)
+(define ash logical:ash)
+(define logcount logical:logcount)
+(define integer-length logical:integer-length)
+(define bit-extract logical:bit-extract)
+(define ipow-by-squaring logical:ipow-by-squaring)
+(define integer-expt logical:integer-expt)
diff --git a/macrotst.scm b/macrotst.scm
new file mode 100644
index 0000000..b5b5046
--- /dev/null
+++ b/macrotst.scm
@@ -0,0 +1,54 @@
+;;;"macrotst.scm" Test for R4RS Macros
+;;; From Revised^4 Report on the Algorithmic Language Scheme
+;;; Editors: William Clinger and Jonathon Rees
+;
+; We intend this report to belong to the entire Scheme community, and so
+; we grant permission to copy it in whole or in part without fee.  In
+; particular, we encourage implementors of Scheme to use this report as
+; a starting point for manuals and other documentation, modifying it as
+; necessary.
+
+;;; To run this code type
+;;; (require 'macro)
+;;; (macro:load "macrotst.scm")
+
+(write "this code should print now, outer, and 7") (newline)
+
+(write
+ (let-syntax ((when (syntax-rules ()
+				  ((when test stmt1 stmt2 ...)
+				   (if test
+				       (begin stmt1
+					      stmt2 ...))))))
+   (let ((if #t))
+     (when if (set! if 'now))
+     if)))
+(newline)
+;;;			==> now
+
+(write
+ (let ((x 'outer))
+   (let-syntax ((m (syntax-rules () ((m) x))))
+     (let ((x 'inner))
+       (m)))))
+(newline)
+;;;			==> outer
+(write
+ (letrec-syntax
+  ((or (syntax-rules ()
+	 ((or) #f)
+	 ((or e) e)
+	 ((or e1 e2 ...)
+	  (let ((temp e1))
+	    (if temp temp (or e2 ...)))))))
+  (let ((x #f)
+	(y 7)
+	(temp 8)
+	(let odd?)
+	(if even?))
+    (or x
+	(let temp)
+	(if y)
+	y))))
+(newline)
+;;;			==> 7
diff --git a/macscheme.init b/macscheme.init
new file mode 100644
index 0000000..56c53a2
--- /dev/null
+++ b/macscheme.init
@@ -0,0 +1,265 @@
+;;;"macscheme.init" Configuration of *features* for MacScheme	-*-scheme-*-
+;Copyright (C) 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; From: jjb@isye.gatech.edu (John Bartholdi)
+
+;;; (software-type) should be set to the generic operating system type.
+;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
+
+(define (software-type) 'MACOS)
+
+;;; (scheme-implementation-type) should return the name of the scheme
+;;; implementation loading this file.
+
+(define (scheme-implementation-type) 'MacScheme)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "4.2")
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxillary files to your Scheme
+;;; implementation reside.
+
+(define (implementation-vicinity) "Macintosh.HD:MacScheme 4.2:")
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+(define (library-vicinity) "Macintosh.HD:MacScheme 4.2:slib:")
+
+;;; *FEATURES* should be set to a list of symbols describing features
+;;; of this implementation.  Suggestions for features are:
+
+(define *features*
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+;	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+	rev4-report			;conforms to
+	rev3-report			;conforms to
+	ieee-p1178			;conforms to
+;	sicp				;runs code from Structure and
+					;Interpretation of Computer
+					;Programs by Abelson and Sussman.
+	rev4-optional-procedures	;LIST-TAIL, STRING->LIST,
+					;LIST->STRING, STRING-COPY,
+					;STRING-FILL!, LIST->VECTOR,
+					;VECTOR->LIST, and VECTOR-FILL!
+	rev3-procedures			;LAST-PAIR, T, and NIL
+;	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
+					;SUBSTRING-MOVE-RIGHT!,
+					;SUBSTRING-FILL!,
+					;STRING-NULL?, APPEND!, 1+,
+					;-1+, <?, <=?, =?, >?, >=?
+	multiarg/and-			;/ and - can take more than 2 args.
+	multiarg-apply			;APPLY can take more than 2 args.
+	rationalize
+	delay				;has DELAY and FORCE
+	with-file			;has WITH-INPUT-FROM-FILE and
+					;WITH-OUTPUT-FROM-FILE
+	string-port			;has CALL-WITH-INPUT-STRING and
+					;CALL-WITH-OUTPUT-STRING
+;	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
+;	char-ready?
+;	macro				;has R4RS high level macros
+;	defmacro			;has Common Lisp DEFMACRO
+	eval				;SLIB:EVAL is single argument eval
+;	record				;has user defined data structures
+;	values				;proposed multiple values
+;	dynamic-wind			;proposed dynamic-wind
+	ieee-floating-point		;conforms to
+	full-continuation		;can return multiple times
+;	object-hash			;has OBJECT-HASH
+
+;	sort
+;	queue				;queues
+	pretty-print
+;	object->string
+;	format
+;	trace				;has macros: TRACE and UNTRACE
+	compiler			;has (COMPILER)
+;	ed				;(ED) is editor
+;	system				;posix (system <string>)
+;	getenv				;posix (getenv <string>)
+;	program-arguments		;returns list of strings (argv)
+;	Xwindows			;X support
+;	curses				;screen management package
+;	termcap				;terminal description package
+;	terminfo			;sysV terminal description
+	))
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define (output-port-width . arg) 79)
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (let ((port (current-output-port)))
+    (lambda () port)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam (let ((cntr 100))
+		 (lambda () (set! cntr (+ 1 cntr))
+			 (string-append "slib_" (number->string cntr)))))
+
+;;; (FILE-EXISTS? <string>)
+(define (file-exists? f) #f)
+
+;;; (DELETE-FILE <string>)
+(define (delete-file f) #f)
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;; use this definition if your system doesn't have such a procedure.
+(define (force-output . arg) #t)
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+(define (call-with-output-string f)
+  (let ((outsp (open-output-string)))
+    (f outsp)
+    (let ((s (get-output-string outsp)))
+      (close-output-port outsp)
+      s)))
+
+(define (call-with-input-string s f)
+  (let* ((insp (open-input-string s))
+	 (res (f insp)))
+    (close-input-port insp)
+    res))
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.
+(define char-code-limit 256)
+
+;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum 536870911)
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+(define slib:eval eval)
+
+;;; If your implementation provides R4RS macros:
+;(define macro:eval slib:eval)
+;(define macro:load load)
+
+(define *defmacros*
+  (list (cons 'defmacro
+	      (lambda (name parms . body)
+		`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
+				      *defmacros*))))))
+(define (defmacro? m) (and (assq m *defmacros*) #t))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a) (set! a (assq a *defmacros*))
+				     (if a (apply (cdr a) (cdr e)) e))
+			(else e)))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a)
+			 (set! a (assq a *defmacros*))
+			 (if a (macroexpand (apply (cdr a) (cdr e))) e))
+			(else e)))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define base:eval slib:eval)
+(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+(define (defmacro:expand* x)
+  (require 'defmacroexpand) (apply defmacro:expand* x '()))
+
+(define (defmacro:load <pathname>)
+  (slib:eval-load <pathname> defmacro:eval))
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;;; define an error procedure for the library
+(define slib:error
+  (lambda args
+    (cerror "Error: " args)))
+
+;;; define these as appropriate for your system.
+(define slib:tab #\tab)
+(define slib:form-feed #\page)
+
+;;; Define these if your implementation's syntax can support it and if
+;;; they are not already defined.
+
+;(define (1+ n) (+ n 1))
+;(define (-1+ n) (+ n -1))
+;(define 1- -1+)
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+; MacScheme does not return a value when it exits,
+; so simply invoke system procedure exit with 0 args.
+(define slib:exit (lambda args (exit)))
+
+;;; Here for backward compatability
+(define scheme-file-suffix
+  (let ((suffix (case (software-type)
+		  ((NOSVE) "_scm")
+		  (else ".scm"))))
+    (lambda () suffix)))
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+;(define slib:load-source load)
+(define (slib:load-source f) (load (string-append f (scheme-file-suffix))))
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/macwork.scm b/macwork.scm
new file mode 100644
index 0000000..6336ae5
--- /dev/null
+++ b/macwork.scm
@@ -0,0 +1,126 @@
+;;;; "macwork.scm": Will Clinger's macros that work.	-*- Scheme -*-
+;Copyright 1992 William Clinger
+;
+; Permission to copy this software, in whole or in part, to use this
+; software for any lawful purpose, and to redistribute this software
+; is granted subject to the restriction that all copies made of this
+; software must include this copyright notice in full.
+;
+; I also request that you send me a copy of any improvements that you
+; make to this software so that they may be incorporated within it to
+; the benefit of the Scheme community.
+
+(slib:load (in-vicinity (program-vicinity) "mwexpand"))
+
+;;;; Miscellaneous routines.
+
+(define (mw:warn msg . more)
+  (display "WARNING from macro expander:")
+  (newline)
+  (display msg)
+  (newline)
+  (for-each (lambda (x) (write x) (newline))
+	    more))
+
+(define (mw:error msg . more)
+  (display "ERROR detected during macro expansion:")
+  (newline)
+  (display msg)
+  (newline)
+  (for-each (lambda (x) (write x) (newline))
+	    more)
+  (mw:quit #f))
+
+(define (mw:bug msg . more)
+  (display "BUG in macro expander: ")
+  (newline)
+  (display msg)
+  (newline)
+  (for-each (lambda (x) (write x) (newline))
+	    more)
+  (mw:quit #f))
+
+; Given a <formals>, returns a list of bound variables.
+
+(define (mw:make-null-terminated x)
+  (cond ((null? x) '())
+	((pair? x)
+	 (cons (car x) (mw:make-null-terminated (cdr x))))
+	(else (list x))))
+
+; Returns the length of the given list, or -1 if the argument
+; is not a list.  Does not check for circular lists.
+
+(define (mw:safe-length x)
+  (define (loop x n)
+    (cond ((null? x) n)
+	  ((pair? x) (loop (cdr x) (+ n 1)))
+	  (else -1)))
+  (loop x 0))
+
+(require 'common-list-functions)
+
+; Given an association list, copies the association pairs.
+
+(define (mw:syntax-copy alist)
+  (map (lambda (x) (cons (car x) (cdr x)))
+       alist))
+
+;;;; Implementation-dependent parameters and preferences that determine
+; how identifiers are represented in the output of the macro expander.
+;
+; The basic problem is that there are no reserved words, so the
+; syntactic keywords of core Scheme that are used to express the
+; output need to be represented by data that cannot appear in the
+; input.  This file defines those data.
+
+; The following definitions assume that identifiers of mixed case
+; cannot appear in the input.
+
+;(define mw:begin1  (string->symbol "Begin"))
+;(define mw:define1 (string->symbol "Define"))
+;(define mw:quote1  (string->symbol "Quote"))
+;(define mw:lambda1 (string->symbol "Lambda"))
+;(define mw:if1     (string->symbol "If"))
+;(define mw:set!1   (string->symbol "Set!"))
+
+(define mw:begin1  'begin)
+(define mw:define1 'define)
+(define mw:quote1  'quote)
+(define mw:lambda1 'lambda)
+(define mw:if1     'if)
+(define mw:set!1   'set!)
+
+; The following defines an implementation-dependent expression
+; that evaluates to an undefined (not unspecified!) value, for
+; use in expanding the (define x) syntax.
+
+(define mw:undefined (list (string->symbol "Undefined")))
+
+; A variable is renamed by suffixing a vertical bar followed by a unique
+; integer.  In IEEE and R4RS Scheme, a vertical bar cannot appear as part
+; of an identifier, but presumably this is enforced by the reader and not
+; by the compiler.  Any other character that cannot appear as part of an
+; identifier may be used instead of the vertical bar.
+
+(define mw:suffix-character #\|)
+
+(slib:load (in-vicinity (program-vicinity) "mwdenote"))
+(slib:load (in-vicinity (program-vicinity) "mwsynrul"))
+
+(define macro:expand macwork:expand)
+
+;;; Here are EVAL, EVAL! and LOAD which expand macros.  You can replace the
+;;; implementation's eval and load with them if you like.
+(define base:eval slib:eval)
+(define base:load load)
+
+(define (macwork:eval x) (base:eval (macwork:expand x)))
+(define macro:eval macwork:eval)
+
+(define (macwork:load <pathname>)
+  (slib:eval-load <pathname> macwork:eval))
+(define macro:load macwork:load)
+
+(provide 'macros-that-work)
+(provide 'macro)
diff --git a/makcrc.scm b/makcrc.scm
new file mode 100644
index 0000000..b11f80e
--- /dev/null
+++ b/makcrc.scm
@@ -0,0 +1,86 @@
+;;;; "makcrc.scm" Compute Cyclic Checksums
+;;; Copyright (C) 1995, 1996 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;;(define crc (eval (make-port-crc 16 #o010013)))
+;;;(define crc (eval (make-port-crc 08 #o053)))
+
+(define (file-check-sum file) (call-with-input-file file crc32))
+
+(define (make-port-crc . margs)
+  (define (make-mask hibit)
+    (+ (ash (+ -1 (ash 1 (+ 1 (- hibit 2)))) 1) 1))
+  (define accum-bits 32)
+  (define chunk-bits (integer-length (+ -1 char-code-limit)))
+  (define generator #f)
+  (cond ((pair? margs)
+	 (set! accum-bits (car margs))
+	 (cond ((pair? (cdr margs))
+		(set! generator (cadr margs))))))
+  (cond ((not generator)
+	 (case accum-bits
+	   ((32) (set! generator #b00000100110000010001110110110111))
+	   (else (slib:error 'make-port-crc "no default polynomial for"
+			     accum-bits "bits")))))
+  (let* ((chunk-mask (make-mask chunk-bits))
+	 (crctab (make-vector (+ 1 chunk-mask))))
+    (define (accum src)
+      `(set!
+	crc
+	(logxor (ash (logand ,(make-mask (- accum-bits chunk-bits)) crc)
+		     ,chunk-bits)
+		(vector-ref crctab
+			    (logand ,chunk-mask
+				    (logxor
+				     (ash crc ,(- chunk-bits accum-bits))
+				     ,src))))))
+    (define (make-crc-table)
+      (letrec ((r (make-vector chunk-bits))
+	       (remd (lambda (m)
+		       (define rem 0)
+		       (do ((i 0 (+ 1 i)))
+			   ((>= i chunk-bits) rem)
+			 (if (logbit? i m)
+			     (set! rem (logxor rem (vector-ref r i))))))))
+	(vector-set! r 0 generator)
+	(do ((i 1 (+ 1 i)))
+	    ((>= i chunk-bits))
+	  (let ((r-1 (vector-ref r (+ -1 i)))
+		(m-1 (make-mask (+ -1 accum-bits))))
+	    (vector-set! r i (if (logbit? (+ -1 accum-bits) r-1)
+				 (logxor (ash (logand m-1 r-1) 1) generator)
+				 (ash (logand m-1 r-1) 1)))))
+	(do ((i 0 (+ 1 i)))
+	    ((> i chunk-mask))
+	  (vector-set! crctab i (remd i)))))
+    (cond ((>= (integer-length generator) accum-bits)
+	   (slib:error 'make-port-crc
+		       "generator longer than" accum-bits "bits")))
+    (make-crc-table)
+    `(lambda (port)
+       (define crc 0)
+       (define byte-count 0)
+       (define crctab ,crctab)
+       (do ((ci (read-char port) (read-char port)))
+	   ((eof-object? ci))
+	 ,(accum '(char->integer ci))
+	 (set! byte-count (+ 1 byte-count)))
+       (do ((byte-count byte-count (ash byte-count ,(- chunk-bits))))
+	   ((zero? byte-count))
+	 ,(accum 'byte-count))
+       (logxor ,(make-mask accum-bits) crc))))
diff --git a/mbe.scm b/mbe.scm
new file mode 100644
index 0000000..e48e1f1
--- /dev/null
+++ b/mbe.scm
@@ -0,0 +1,362 @@
+;;;; "mbe.scm" "Macro by Example" (Eugene Kohlbecker, r4rs)
+;;; From: Dorai Sitaram, dorai@cs.rice.edu, 1991, revised Sept. 3, 1992,
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; revised Dec. 6, 1993 to r4rs syntax (if not semantics).
+;;; revised Mar. 2 1994 for SLIB (jaffer@ai.mit.edu).
+
+;;; A vanilla implementation of Macro-by-Example (Eugene
+;;; Kohlbecker, r4rs).  This file requires defmacro.
+
+(require 'common-list-functions)	;nconc, some, every
+;(require 'rev2-procedures)		;append! alternate for nconc
+(require 'rev4-optional-procedures)	;list-tail
+(require 'defmacroexpand)
+
+;;; A vanilla implementation of a hygiene filter for define-syntax
+
+;(define hyg:tag-generic
+;  (lambda (e kk tmps) e))
+
+;;; if you don't want the hygiene filter, comment out the following
+;;; s-exp and uncomment the previous one.
+
+(define hyg:tag-generic
+  (lambda (e kk tmps)
+    (if (pair? e)
+	(let ((a (car e)))
+	  (case a
+	    ((quote) `(quote ,(hyg:tag-vanilla (cadr e) kk tmps)))
+	    ((if begin)
+	     `(,a ,@(map (lambda (e1) (hyg:tag-generic e1 kk tmps))
+			 (cdr e))))
+	    ((set! define)
+	     `(,a ,(hyg:tag-vanilla (cadr e) kk tmps)
+		  ,@(map (lambda (e1) (hyg:tag-generic e1 kk tmps))
+			 (cddr e))))
+	    ((lambda) (hyg:tag-lambda (cdr e) kk tmps))
+	    ((letrec) (hyg:tag-letrec (cdr e) kk tmps))
+	    ((let) (hyg:tag-let (cdr e) kk tmps))
+	    ((let*) (hyg:tag-let-star (cdr e) kk tmps))
+	    ((do) (hyg:tag-do (cdr e) kk tmps))
+	    ((case)
+	     `(case ,(hyg:tag-generic (cadr e) kk tmps)
+		,@(map
+		   (lambda (cl)
+		     `(,(hyg:tag-vanilla (car cl) kk tmps)
+		       ,@(map
+			  (lambda (e1)
+			    (hyg:tag-generic e1 kk tmps))
+			  (cdr cl))))
+		   (cddr e))))
+	    ((cond)
+	     `(cond ,@(map
+		       (lambda (cl)
+			 (map (lambda (e1)
+				(hyg:tag-generic e1 kk tmps))
+			      cl))
+		       (cdr e))))
+	    (else (map (lambda (e1)
+			 (hyg:tag-generic e1 kk tmps))
+		       e))))
+	(hyg:tag-vanilla e kk tmps))))
+
+(define hyg:tag-vanilla
+  (lambda (e kk tmps)
+    (cond ((symbol? e)
+	   (cond ((memq e kk) e)
+		 ((assq e tmps) => cdr)
+		 (else e)))
+	  ((pair? e)
+	   (cons (hyg:tag-vanilla (car e) kk tmps)
+		 (hyg:tag-vanilla (cdr e) kk tmps)))
+	  (else e))))
+
+(define hyg:tag-lambda
+  (lambda (e kk tmps)
+    (let* ((bvv (car e))
+	   (tmps2 (append
+		   (map (lambda (v) (cons v (gentemp)))
+			(hyg:flatten bvv))
+		   tmps)))
+      `(lambda
+	   ,(hyg:tag-vanilla bvv kk tmps2)
+	 ,@(map
+	    (lambda (e1)
+	      (hyg:tag-generic e1 kk tmps2))
+	    (cdr e))))))
+
+(define hyg:flatten
+  (lambda (e)
+    (let loop ((e e) (r '()))
+      (cond ((pair? e) (loop (car e)
+			     (loop (cdr e) r)))
+	    ((null? e) r)
+	    (else (cons e r))))))
+
+(define hyg:tag-letrec
+  (lambda (e kk tmps)
+    (let* ((varvals (car e))
+	   (tmps2 (append
+		   (map (lambda (v) (cons v (gentemp)))
+			(map car varvals))
+		   tmps)))
+      `(letrec ,(map
+		 (lambda (varval)
+		   `(,(hyg:tag-vanilla (car varval)
+				       kk tmps2)
+		     ,(hyg:tag-generic (cadr varval)
+				       kk tmps2)))
+		 varvals)
+	 ,@(map (lambda (e1)
+		  (hyg:tag-generic e1 kk tmps2))
+		(cdr e))))))
+
+(define hyg:tag-let
+  (lambda (e kk tmps)
+    (let* ((tt (if (symbol? (car e)) (cons (car e) (gentemp)) '()))
+	   (e (if (null? tt) e (cdr e)))
+	   (tmps (if (null? tt) tmps (append (list tt) tmps))))
+      (let* ((varvals (car e))
+	     (tmps2 (append (map (lambda (v) (cons v (gentemp)))
+				 (map car varvals))
+			    tmps)))
+	`(let
+	   ,@(if (null? tt) '() `(,(hyg:tag-vanilla (car tt) 
+						    kk
+						    tmps)))
+	   ,(let loop ((varvals varvals)
+		       (i (length varvals)))
+	      (if (null? varvals) '()
+		  (let ((varval (car varvals))
+			(tmps3 (list-tail tmps2 i)))
+		    (cons `(,(hyg:tag-vanilla (car varval)
+					      kk tmps2)
+			    ,(hyg:tag-generic (cadr varval)
+					      kk tmps3))
+			  (loop (cdr varvals) (- i 1))))))
+	   ,@(map
+	      (lambda (e1)
+		(hyg:tag-generic e1 kk tmps2))
+	      (cdr e)))))))
+
+(define hyg:tag-do
+  (lambda (e kk tmps)
+    (let* ((varinistps (car e))
+	   (tmps2 (append (map (lambda (v) (cons v (gentemp)))
+			       (map car varinistps))
+			  tmps)))
+      `(do
+	   ,(let loop ((varinistps varinistps)
+		       (i (length varinistps)))
+	      (if (null? varinistps) '()
+		  (let ((varinistp (car varinistps))
+			(tmps3 (list-tail tmps2 i)))
+		    (cons `(,(hyg:tag-vanilla (car varinistp)
+					      kk tmps2)
+			    ,(hyg:tag-generic (cadr varinistp)
+					      kk tmps3)
+			    ,@(hyg:tag-generic (cddr varinistp)
+					       kk tmps2))
+			  (loop (cdr varinistps) (- i 1))))))
+	   ,(map (lambda (e1)
+		   (hyg:tag-generic e1 kk tmps2)) (cadr e))
+	 ,@(map
+	    (lambda (e1)
+	      (hyg:tag-generic e1 kk tmps2))
+	    (cddr e))))))
+
+(define hyg:tag-let-star
+  (lambda (e kk tmps)
+    (let* ((varvals (car e))
+	   (tmps2 (append (reverse (map (lambda (v) (cons v (gentemp)))
+					(map car varvals)))
+			  tmps)))
+      `(let*
+	   ,(let loop ((varvals varvals)
+		       (i (- (length varvals) 1)))
+	      (if (null? varvals) '()
+		  (let ((varval (car varvals))
+			(tmps3 (list-tail tmps2 i)))
+		    (cons `(,(hyg:tag-vanilla (car varval)
+					      kk tmps3)
+			    ,(hyg:tag-generic (cadr varval)
+					      kk (cdr tmps3)))
+			  (loop (cdr varvals) (- i 1))))))
+	 ,@(map
+	    (lambda (e1)
+	      (hyg:tag-generic e1 kk tmps2))
+	    (cdr e))))))
+
+;;;; End of hygiene filter.
+
+;;; finds the leftmost index of list l where something equal to x
+;;; occurs
+(define mbe:position
+  (lambda (x l)
+    (let loop ((l l) (i 0))
+      (cond ((not (pair? l)) #f)
+	    ((equal? (car l) x) i)
+	    (else (loop (cdr l) (+ i 1)))))))
+
+;;; tests if expression e matches pattern p where k is the list of
+;;; keywords
+(define mbe:matches-pattern?
+  (lambda (p e k)
+    (cond ((mbe:ellipsis? p)
+	   (and (or (null? e) (pair? e))
+		(let* ((p-head (car p))
+		       (p-tail (cddr p))
+		       (e-head=e-tail (mbe:split-at-ellipsis e p-tail)))
+		  (and e-head=e-tail
+		       (let ((e-head (car e-head=e-tail))
+			     (e-tail (cdr e-head=e-tail)))
+			 (and (comlist:every
+			       (lambda (x) (mbe:matches-pattern? p-head x k))
+			       e-head)
+			      (mbe:matches-pattern? p-tail e-tail k)))))))
+	  ((pair? p)
+	   (and (pair? e)
+		(mbe:matches-pattern? (car p) (car e) k)
+		(mbe:matches-pattern? (cdr p) (cdr e) k)))
+	  ((symbol? p) (if (memq p k) (eq? p e) #t))
+	  (else (equal? p e)))))
+
+;;; gets the bindings of pattern variables of pattern p for
+;;; expression e;
+;;; k is the list of keywords
+(define mbe:get-bindings
+  (lambda (p e k)
+    (cond ((mbe:ellipsis? p)
+	   (let* ((p-head (car p))
+		  (p-tail (cddr p))
+		  (e-head=e-tail (mbe:split-at-ellipsis e p-tail))
+		  (e-head (car e-head=e-tail))
+		  (e-tail (cdr e-head=e-tail)))
+	     (cons (cons (mbe:get-ellipsis-nestings p-head k)
+		     (map (lambda (x) (mbe:get-bindings p-head x k))
+			  e-head))
+	       (mbe:get-bindings p-tail e-tail k))))
+	  ((pair? p)
+	   (append (mbe:get-bindings (car p) (car e) k)
+	     (mbe:get-bindings (cdr p) (cdr e) k)))
+	  ((symbol? p)
+	   (if (memq p k) '() (list (cons p e))))
+	  (else '()))))
+
+;;; expands pattern p using environment r;
+;;; k is the list of keywords
+(define mbe:expand-pattern
+  (lambda (p r k)
+    (cond ((mbe:ellipsis? p)
+	   (append (let* ((p-head (car p))
+			  (nestings (mbe:get-ellipsis-nestings p-head k))
+			  (rr (mbe:ellipsis-sub-envs nestings r)))
+		     (map (lambda (r1)
+			    (mbe:expand-pattern p-head (append r1 r) k))
+			  rr))
+	     (mbe:expand-pattern (cddr p) r k)))
+	  ((pair? p)
+	   (cons (mbe:expand-pattern (car p) r k)
+	     (mbe:expand-pattern (cdr p) r k)))
+	  ((symbol? p)
+	   (if (memq p k) p
+	     (let ((x (assq p r)))
+	       (if x (cdr x) p))))
+	  (else p))))
+
+;;; returns a list that nests a pattern variable as deeply as it
+;;; is ellipsed
+(define mbe:get-ellipsis-nestings
+  (lambda (p k)
+    (let sub ((p p))
+      (cond ((mbe:ellipsis? p) (cons (sub (car p)) (sub (cddr p))))
+	    ((pair? p) (append (sub (car p)) (sub (cdr p))))
+	    ((symbol? p) (if (memq p k) '() (list p)))
+	    (else '())))))
+
+;;; finds the subenvironments in r corresponding to the ellipsed
+;;; variables in nestings
+(define mbe:ellipsis-sub-envs
+  (lambda (nestings r)
+    (comlist:some (lambda (c)
+		    (if (mbe:contained-in? nestings (car c)) (cdr c) #f))
+		  r)))
+
+;;; checks if nestings v and y have an intersection
+(define mbe:contained-in?
+  (lambda (v y)
+    (if (or (symbol? v) (symbol? y)) (eq? v y)
+	(comlist:some (lambda (v_i)
+			(comlist:some (lambda (y_j)
+					(mbe:contained-in? v_i y_j))
+				      y))
+		      v))))
+
+;;; split expression e so that its second half matches with
+;;; pattern p-tail
+(define mbe:split-at-ellipsis
+  (lambda (e p-tail)
+    (if (null? p-tail) (cons e '())
+      (let ((i (mbe:position (car p-tail) e)))
+	(if i (cons (butlast e (- (length e) i))
+		    (list-tail e i))
+	    (slib:error 'mbe:split-at-ellipsis 'bad-arg))))))
+
+;;; tests if x is an ellipsing pattern, i.e., of the form
+;;; (blah ... . blah2)
+(define mbe:ellipsis?
+  (lambda (x)
+    (and (pair? x) (pair? (cdr x)) (eq? (cadr x) '...))))
+
+;define-syntax
+
+(defmacro define-syntax (macro-name syn-rules)
+  (if (or (not (pair? syn-rules))
+	  (not (eq? (car syn-rules) 'syntax-rules)))
+      (slib:error 'define-syntax 'not-an-r4rs-high-level-macro
+	     macro-name syn-rules)
+      (let ((keywords (cons macro-name (cadr syn-rules)))
+	    (clauses (cddr syn-rules)))
+	`(defmacro ,macro-name macro-arg
+	   (let ((macro-arg (cons ',macro-name macro-arg))
+		 (keywords ',keywords))
+	     (cond ,@(map
+		      (lambda (clause)
+			(let ((in-pattern (car clause))
+			      (out-pattern (cadr clause)))
+			  `((mbe:matches-pattern? ',in-pattern macro-arg
+						  keywords)
+			    (hyg:tag-generic
+			     (mbe:expand-pattern
+			      ',out-pattern
+			      (mbe:get-bindings ',in-pattern macro-arg
+						keywords)
+			      keywords)
+			     (nconc
+			      (hyg:flatten ',in-pattern)
+			      keywords)
+			     '()))))
+		      clauses)
+		   (else (slib:error ',macro-name 'no-matching-clause
+				',clauses))))))))
+
+(define macro:eval slib:eval)
+(define macro:load slib:load)
+(provide 'macro)
+;eof
diff --git a/mitcomp.pat b/mitcomp.pat
new file mode 100644
index 0000000..78cb9b9
--- /dev/null
+++ b/mitcomp.pat
@@ -0,0 +1,1466 @@
+;"mitcomp.pat", patch file of definitions for compiling SLIB with MitScheme.
+;;; Copyright (C) 1993 Matthew McDonald.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+From: mafm@cs.uwa.edu.au (Matthew MCDONALD)
+
+	Added declarations to files providing these:
+dynamic alist hash hash-table logical random random-inexact modular
+prime charplot common-list-functions format generic-write pprint-file
+pretty-print-to-string object->string string-case printf line-i/o
+synchk priority-queue process red-black-tree sort
+
+(for-each cf
+ '("dynamic.scm" "alist.scm" "hash.scm" "hashtab.scm" "logical.scm"
+   "random.scm" "randinex.scm" "modular.scm" "prime.scm" "charplot.scm"
+   "comlist.scm" "format.scm" "genwrite.scm" "ppfile.scm" "pp2str.scm"
+   "obj2str.scm" "strcase.scm" "printf.scm" "lineio.scm" "synchk.scm"
+   "priorque.scm" "process.scm" "rbtree.scm" "sort.scm))
+
+while in the SLIB directory will compile all of these.
+
+	They all appear to still be working... They should be
+everything CScheme currently uses (except [1] below.)
+
+NOTES:
+
+[1] Not altered:
+	debug		   Not worth optimising
+	test		   "   "     "
+	fluid-let          compiler chokes over
+				(lambda () . body)
+	scmacro		   Fails when compiled, not immediately obvious why
+	synclo             " " "
+	r4rsyn		   " " "
+	yasos              requires the macros
+	collect		   "        "   "
+
+[2] removed 'sort from list of MIT features. The library version is
+more complete (and needed for charplot.)
+
+[3] Remember that mitscheme.init gets the .bin put in the wrong place
+by the compiler and thus doesn't get recognised by LOAD.
+======================================================================
+diff -c slib/alist.scm nlib/alist.scm
+*** slib/alist.scm	Thu Jan 21 00:01:34 1993
+--- nlib/alist.scm	Tue Feb  9 00:21:07 1993
+***************
+*** 44,50 ****
+  ;(define rem (alist-remover string-ci=?))
+  ;(set! alist (rem alist "fOO"))
+  
+! (define (predicate->asso pred)
+    (cond ((eq? eq? pred) assq)
+  	((eq? = pred) assv)
+  	((eq? eqv? pred) assv)
+--- 44,53 ----
+  ;(define rem (alist-remover string-ci=?))
+  ;(set! alist (rem alist "fOO"))
+  
+! ;;; Declarations for CScheme
+! (declare (usual-integrations))
+! 
+! (define-integrable (predicate->asso pred)
+    (cond ((eq? eq? pred) assq)
+  	((eq? = pred) assv)
+  	((eq? eqv? pred) assv)
+***************
+*** 57,69 ****
+  			((pred key (caar al)) (car al))
+  			(else (l (cdr al)))))))))
+  
+! (define (alist-inquirer pred)
+    (let ((assofun (predicate->asso pred)))
+      (lambda (alist key)
+        (let ((pair (assofun key alist)))
+  	(and pair (cdr pair))))))
+  
+! (define (alist-associator pred)
+    (let ((assofun (predicate->asso pred)))
+      (lambda (alist key val)
+        (let* ((pair (assofun key alist)))
+--- 60,72 ----
+  			((pred key (caar al)) (car al))
+  			(else (l (cdr al)))))))))
+  
+! (define-integrable (alist-inquirer pred)
+    (let ((assofun (predicate->asso pred)))
+      (lambda (alist key)
+        (let ((pair (assofun key alist)))
+  	(and pair (cdr pair))))))
+  
+! (define-integrable (alist-associator pred)
+    (let ((assofun (predicate->asso pred)))
+      (lambda (alist key val)
+        (let* ((pair (assofun key alist)))
+***************
+*** 71,77 ****
+  		    alist)
+  	      (else (cons (cons key val) alist)))))))
+  
+! (define (alist-remover pred)
+    (lambda (alist key)
+      (cond ((null? alist) alist)
+  	  ((pred key (caar alist)) (cdr alist))
+--- 74,80 ----
+  		    alist)
+  	      (else (cons (cons key val) alist)))))))
+  
+! (define-integrable (alist-remover pred)
+    (lambda (alist key)
+      (cond ((null? alist) alist)
+  	  ((pred key (caar alist)) (cdr alist))
+diff -c slib/charplot.scm nlib/charplot.scm
+*** slib/charplot.scm	Sat Nov 14 21:50:54 1992
+--- nlib/charplot.scm	Tue Feb  9 00:21:07 1993
+***************
+*** 7,12 ****
+--- 7,24 ----
+  ;are strings with names to label the x and y axii with.
+  
+  ;;;;---------------------------------------------------------------
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "sort"))
++ (declare (integrate
++ 	  rows
++ 	  columns
++ 	  charplot:height
++ 	  charplot:width
++ 	  charplot:plot
++ 	  plot!))
++ 
+  (require 'sort)
+  
+  (define rows 24)
+***************
+*** 27,39 ****
+  	 (write-char char)
+  	 (charplot:printn! (+ n -1) char))))
+  
+! (define (charplot:center-print! str width)
+    (let ((lpad (quotient (- width (string-length str)) 2)))
+      (charplot:printn! lpad #\ )
+      (display str)
+      (charplot:printn! (- width (+ (string-length  str) lpad)) #\ )))
+  
+! (define (scale-it z scale)
+    (if (and (exact? z) (integer? z))
+        (quotient (* z (car scale)) (cadr scale))
+        (inexact->exact (round (/ (* z (car scale)) (cadr scale))))))
+--- 39,51 ----
+  	 (write-char char)
+  	 (charplot:printn! (+ n -1) char))))
+  
+! (define-integrable (charplot:center-print! str width)
+    (let ((lpad (quotient (- width (string-length str)) 2)))
+      (charplot:printn! lpad #\ )
+      (display str)
+      (charplot:printn! (- width (+ (string-length  str) lpad)) #\ )))
+  
+! (define-integrable (scale-it z scale)
+    (if (and (exact? z) (integer? z))
+        (quotient (* z (car scale)) (cadr scale))
+        (inexact->exact (round (/ (* z (car scale)) (cadr scale))))))
+diff -c slib/comlist.scm nlib/comlist.scm
+*** slib/comlist.scm	Wed Jan 27 11:08:44 1993
+--- nlib/comlist.scm	Tue Feb  9 00:21:08 1993
+***************
+*** 6,11 ****
+--- 6,14 ----
+  
+  ;;;; LIST FUNCTIONS FROM COMMON LISP
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
+  ;;;From: hugh@ear.mit.edu (Hugh Secker-Walker)
+  (define (make-list k . init)
+    (set! init (if (pair? init) (car init)))
+***************
+*** 13,21 ****
+         (result '() (cons init result)))
+        ((<= k 0) result)))
+  
+! (define (copy-list lst) (append lst '()))
+  
+! (define (adjoin e l) (if (memq e l) l (cons e l)))
+  
+  (define (union l1 l2)
+    (cond ((null? l1) l2)
+--- 16,24 ----
+         (result '() (cons init result)))
+        ((<= k 0) result)))
+  
+! (define-integrable (copy-list lst) (append lst '()))
+  
+! (define-integrable (adjoin e l) (if (memq e l) l (cons e l)))
+  
+  (define (union l1 l2)
+    (cond ((null? l1) l2)
+***************
+*** 33,39 ****
+  	((memv (car l1) l2) (set-difference (cdr l1) l2))
+  	(else (cons (car l1) (set-difference (cdr l1) l2)))))
+  
+! (define (position obj lst)
+    (letrec ((pos (lambda (n lst)
+  		  (cond ((null? lst) #f)
+  			((eqv? obj (car lst)) n)
+--- 36,42 ----
+  	((memv (car l1) l2) (set-difference (cdr l1) l2))
+  	(else (cons (car l1) (set-difference (cdr l1) l2)))))
+  
+! (define-integrable (position obj lst)
+    (letrec ((pos (lambda (n lst)
+  		  (cond ((null? lst) #f)
+  			((eqv? obj (car lst)) n)
+***************
+*** 45,51 ****
+        init
+        (reduce-init p (p init (car l)) (cdr l))))
+  
+! (define (reduce p l)
+    (cond ((null? l) l)
+  	((null? (cdr l)) (car l))
+  	(else (reduce-init p (car l) (cdr l)))))
+--- 48,54 ----
+        init
+        (reduce-init p (p init (car l)) (cdr l))))
+  
+! (define-integrable (reduce p l)
+    (cond ((null? l) l)
+  	((null? (cdr l)) (car l))
+  	(else (reduce-init p (car l) (cdr l)))))
+***************
+*** 58,64 ****
+    (or (null? l)
+        (and (pred (car l)) (every pred (cdr l)))))
+  
+! (define (notevery pred l) (not (every pred l)))
+  
+  (define (find-if t l)
+    (cond ((null? l) #f)
+--- 61,67 ----
+    (or (null? l)
+        (and (pred (car l)) (every pred (cdr l)))))
+  
+! (define-integrable (notevery pred l) (not (every pred l)))
+  
+  (define (find-if t l)
+    (cond ((null? l) #f)
+***************
+*** 121,141 ****
+  (define (nthcdr n lst)
+    (if (zero? n) lst (nthcdr (+ -1 n) (cdr lst))))
+  
+! (define (last lst n)
+    (nthcdr (- (length lst) n) lst))
+  
+  ;;;; CONDITIONALS
+  
+! (define (and? . args)
+    (cond ((null? args) #t)
+  	((car args) (apply and? (cdr args)))
+  	(else #f)))
+  
+! (define (or? . args)
+    (cond ((null? args) #f)
+  	((car args) #t)
+  	(else (apply or? (cdr args)))))
+  
+! (define (identity x) x)
+  
+  (require 'rev3-procedures)
+--- 124,144 ----
+  (define (nthcdr n lst)
+    (if (zero? n) lst (nthcdr (+ -1 n) (cdr lst))))
+  
+! (define-integrable (last lst n)
+    (nthcdr (- (length lst) n) lst))
+  
+  ;;;; CONDITIONALS
+  
+! (define-integrable (and? . args)
+    (cond ((null? args) #t)
+  	((car args) (apply and? (cdr args)))
+  	(else #f)))
+  
+! (define-integrable (or? . args)
+    (cond ((null? args) #f)
+  	((car args) #t)
+  	(else (apply or? (cdr args)))))
+  
+! (define-integrable (identity x) x)
+  
+  (require 'rev3-procedures)
+diff -c slib/dynamic.scm nlib/dynamic.scm
+*** slib/dynamic.scm	Thu Sep 17 23:35:46 1992
+--- nlib/dynamic.scm	Tue Feb  9 00:21:08 1993
+***************
+*** 31,36 ****
+--- 31,43 ----
+  ;
+  ;There was also a DYNAMIC-BIND macro which I haven't implemented.
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate-external "record"))
++ (declare (integrate-external "dynwind"))
++ (declare (integrate dynamic:errmsg))
++ 
+  (require 'record)
+  (require 'dynamic-wind)
+  
+***************
+*** 48,60 ****
+    (record-accessor dynamic-environment-rtd 'parent))
+  
+  (define *current-dynamic-environment* #f)
+! (define (extend-current-dynamic-environment dynamic obj)
+    (set! *current-dynamic-environment*
+  	(make-dynamic-environment dynamic obj
+  				  *current-dynamic-environment*)))
+  
+  (define dynamic-rtd (make-record-type "dynamic" '()))
+! (define make-dynamic
+    (let ((dynamic-constructor (record-constructor dynamic-rtd)))
+      (lambda (obj)
+        (let ((dynamic (dynamic-constructor)))
+--- 55,69 ----
+    (record-accessor dynamic-environment-rtd 'parent))
+  
+  (define *current-dynamic-environment* #f)
+! 
+! (define-integrable (extend-current-dynamic-environment dynamic obj)
+    (set! *current-dynamic-environment*
+  	(make-dynamic-environment dynamic obj
+  				  *current-dynamic-environment*)))
+  
+  (define dynamic-rtd (make-record-type "dynamic" '()))
+! 
+! (define-integrable make-dynamic
+    (let ((dynamic-constructor (record-constructor dynamic-rtd)))
+      (lambda (obj)
+        (let ((dynamic (dynamic-constructor)))
+***************
+*** 61,68 ****
+  	(extend-current-dynamic-environment dynamic obj)
+  	dynamic))))
+  
+! (define dynamic? (record-predicate dynamic-rtd))
+! (define (guarantee-dynamic dynamic)
+    (or (dynamic? dynamic)
+        (slib:error "Not a dynamic" dynamic)))
+  
+--- 70,78 ----
+  	(extend-current-dynamic-environment dynamic obj)
+  	dynamic))))
+  
+! (define-integrable dynamic? (record-predicate dynamic-rtd))
+! 
+! (define-integrable (guarantee-dynamic dynamic)
+    (or (dynamic? dynamic)
+        (slib:error "Not a dynamic" dynamic)))
+  
+***************
+*** 69,75 ****
+  (define dynamic:errmsg
+    "No value defined for this dynamic in the current dynamic environment")
+  
+! (define (dynamic-ref dynamic)
+    (guarantee-dynamic dynamic)
+    (let loop ((env *current-dynamic-environment*))
+      (cond ((not env)
+--- 79,85 ----
+  (define dynamic:errmsg
+    "No value defined for this dynamic in the current dynamic environment")
+  
+! (define-integrable (dynamic-ref dynamic)
+    (guarantee-dynamic dynamic)
+    (let loop ((env *current-dynamic-environment*))
+      (cond ((not env)
+***************
+*** 79,85 ****
+  	  (else
+  	   (loop (dynamic-environment:parent env))))))
+  
+! (define (dynamic-set! dynamic obj)
+    (guarantee-dynamic dynamic)
+    (let loop ((env *current-dynamic-environment*))
+      (cond ((not env)
+--- 89,95 ----
+  	  (else
+  	   (loop (dynamic-environment:parent env))))))
+  
+! (define-integrable (dynamic-set! dynamic obj)
+    (guarantee-dynamic dynamic)
+    (let loop ((env *current-dynamic-environment*))
+      (cond ((not env)
+diff -c slib/format.scm nlib/format.scm
+*** slib/format.scm	Tue Jan  5 14:56:48 1993
+--- nlib/format.scm	Tue Feb  9 00:21:09 1993
+***************
+*** 78,84 ****
+  ;   * removed C-style padding support
+  ;
+  
+! ;;; SCHEME IMPLEMENTATION DEPENDENCIES ---------------------------------------
+  
+  ;; To configure the format module for your scheme system, set the variable
+  ;; format:scheme-system to one of the symbols of (slib elk any). You may add
+--- 78,88 ----
+  ;   * removed C-style padding support
+  ;
+  
+! ;;; SCHEME IMPLEMENTATION DEPENDENCIES
+! ;;; ---------------------------------------
+! 
+! ;;; (minimal) Declarations for CScheme
+! (declare (usual-integrations))
+  
+  ;; To configure the format module for your scheme system, set the variable
+  ;; format:scheme-system to one of the symbols of (slib elk any). You may add
+diff -c slib/genwrite.scm nlib/genwrite.scm
+*** slib/genwrite.scm	Mon Oct 19 14:49:06 1992
+--- nlib/genwrite.scm	Tue Feb  9 00:21:10 1993
+***************
+*** 26,31 ****
+--- 26,34 ----
+  ;
+  ; where display-string = (lambda (s) (for-each write-char (string->list s)) #t)
+  
++ ;;; (minimal) Declarations for CScheme
++ (declare (usual-integrations))
++ 
+  (define (generic-write obj display? width output)
+  
+    (define (read-macro? l)
+diff -c slib/hash.scm nlib/hash.scm
+*** slib/hash.scm	Thu Sep 10 00:05:52 1992
+--- nlib/hash.scm	Tue Feb  9 00:21:10 1993
+***************
+*** 23,35 ****
+  ;the equality predicate pred.  Pred should be EQ?, EQV?, EQUAL?, =,
+  ;CHAR=?, CHAR-CI=?, STRING=?, or STRING-CI=?.
+   
+! (define (hash:hash-char char n)
+    (modulo (char->integer char) n))
+  
+! (define (hash:hash-char-ci char n)
+    (modulo (char->integer (char-downcase char)) n))
+  
+! (define (hash:hash-symbol sym n)
+    (hash:hash-string (symbol->string sym) n))
+  
+  ;;; I am trying to be careful about overflow and underflow here.
+--- 23,40 ----
+  ;the equality predicate pred.  Pred should be EQ?, EQV?, EQUAL?, =,
+  ;CHAR=?, CHAR-CI=?, STRING=?, or STRING-CI=?.
+   
+! 
+! ;;; Declarations for CScheme
+! (declare (usual-integrations))
+! (declare (integrate hash))
+! 
+! (define-integrable (hash:hash-char char n)
+    (modulo (char->integer char) n))
+  
+! (define-integrable (hash:hash-char-ci char n)
+    (modulo (char->integer (char-downcase char)) n))
+  
+! (define-integrable (hash:hash-symbol sym n)
+    (hash:hash-string (symbol->string sym) n))
+  
+  ;;; I am trying to be careful about overflow and underflow here.
+***************
+*** 173,179 ****
+  
+  (define hashq hashv)
+  
+! (define (predicate->hash pred)
+    (cond ((eq? pred eq?) hashq)
+  	((eq? pred eqv?) hashv)
+  	((eq? pred equal?) hash)
+--- 178,184 ----
+  
+  (define hashq hashv)
+  
+! (define-integrable (predicate->hash pred)
+    (cond ((eq? pred eq?) hashq)
+  	((eq? pred eqv?) hashv)
+  	((eq? pred equal?) hash)
+diff -c slib/hashtab.scm nlib/hashtab.scm
+*** slib/hashtab.scm	Mon Oct 19 14:49:44 1992
+--- nlib/hashtab.scm	Tue Feb  9 00:21:11 1993
+***************
+*** 36,47 ****
+  ;Returns a procedure of 2 arguments, hashtab and key, which modifies
+  ;hashtab so that the association whose key is key removed.
+  
+  (require 'hash)
+  (require 'alist)
+  
+! (define (make-hash-table k) (make-vector k '()))
+  
+! (define (predicate->hash-asso pred)
+    (let ((hashfun (predicate->hash pred))
+  	(asso (predicate->asso pred)))
+      (lambda (key hashtab)
+--- 36,53 ----
+  ;Returns a procedure of 2 arguments, hashtab and key, which modifies
+  ;hashtab so that the association whose key is key removed.
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate-external "hash"))
++ (declare (integrate-external "alist"))
++ 
+  (require 'hash)
+  (require 'alist)
+  
+! (define-integrable (make-hash-table k) (make-vector k '()))
+  
+! (define-integrable (predicate->hash-asso pred)
+    (let ((hashfun (predicate->hash pred))
+  	(asso (predicate->asso pred)))
+      (lambda (key hashtab)
+***************
+*** 48,54 ****
+        (asso key
+  	    (vector-ref hashtab (hashfun key (vector-length hashtab)))))))
+  
+! (define (hash-inquirer pred)
+    (let ((hashfun (predicate->hash pred))
+  	(ainq (alist-inquirer pred)))
+      (lambda (hashtab key)
+--- 54,60 ----
+        (asso key
+  	    (vector-ref hashtab (hashfun key (vector-length hashtab)))))))
+  
+! (define-integrable (hash-inquirer pred)
+    (let ((hashfun (predicate->hash pred))
+  	(ainq (alist-inquirer pred)))
+      (lambda (hashtab key)
+***************
+*** 55,61 ****
+        (ainq (vector-ref hashtab (hashfun key (vector-length hashtab)))
+  	    key))))
+  
+! (define (hash-associator pred)
+    (let ((hashfun (predicate->hash pred))
+  	(asso (alist-associator pred)))
+      (lambda (hashtab key val)
+--- 61,67 ----
+        (ainq (vector-ref hashtab (hashfun key (vector-length hashtab)))
+  	    key))))
+  
+! (define-integrable (hash-associator pred)
+    (let ((hashfun (predicate->hash pred))
+  	(asso (alist-associator pred)))
+      (lambda (hashtab key val)
+***************
+*** 64,70 ****
+  		     (asso (vector-ref hashtab num) key val)))
+        hashtab)))
+  
+! (define (hash-remover pred)
+    (let ((hashfun (predicate->hash pred))
+  	(arem (alist-remover pred)))
+      (lambda (hashtab key)
+--- 70,76 ----
+  		     (asso (vector-ref hashtab num) key val)))
+        hashtab)))
+  
+! (define-integrable (hash-remover pred)
+    (let ((hashfun (predicate->hash pred))
+  	(arem (alist-remover pred)))
+      (lambda (hashtab key)
+diff -c slib/lineio.scm nlib/lineio.scm
+*** slib/lineio.scm	Sun Oct 25 01:40:38 1992
+--- nlib/lineio.scm	Tue Feb  9 00:21:11 1993
+***************
+*** 28,33 ****
+--- 28,36 ----
+  ;unspecified value.  Port may be ommited, in which case it defaults to
+  ;the value returned by current-input-port.
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
+  (define (read-line . arg)
+    (let* ((char (apply read-char arg)))
+      (if (eof-object? char)
+***************
+*** 56,61 ****
+  			(+ 1 i) #f))))
+  	  (string-set! str i char)))))
+  
+! (define (write-line str . arg)
+    (apply display str arg)
+    (apply newline arg))
+--- 59,64 ----
+  			(+ 1 i) #f))))
+  	  (string-set! str i char)))))
+  
+! (define-integrable (write-line str . arg)
+    (apply display str arg)
+    (apply newline arg))
+diff -c slib/logical.scm nlib/logical.scm
+*** slib/logical.scm	Mon Feb  1 22:22:04 1993
+--- nlib/logical.scm	Tue Feb  9 00:21:11 1993
+***************
+*** 48,53 ****
+--- 48,66 ----
+  ;
+  ;;;;------------------------------------------------------------------
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate logand		; Exported functions
++ 		    logor
++ 		    logxor
++ 		    lognot
++ 		    ash
++ 		    logcount
++ 		    integer-length
++ 		    bit-extract
++ 		    ipow-by-squaring
++ 		    integer-expt))
++ 
+  (define logical:integer-expt
+    (if (provided? 'inexact)
+        expt
+***************
+*** 61,67 ****
+  					(quotient k 2)
+  					(if (even? k) acc (proc acc x))
+  					proc))))
+- 
+  (define (logical:logand n1 n2)
+    (cond ((= n1 n2) n1)
+  	((zero? n1) 0)
+--- 74,79 ----
+***************
+*** 90,102 ****
+  	    (vector-ref (vector-ref logical:boole-xor (modulo n1 16))
+  			(modulo n2 16))))))
+  
+! (define (logical:lognot n) (- -1 n))
+  
+! (define (logical:bit-extract n start end)
+    (logical:logand (- (logical:integer-expt 2 (- end start)) 1)
+  		  (logical:ash n (- start))))
+  
+! (define (logical:ash int cnt)
+    (if (negative? cnt)
+        (let ((n (logical:integer-expt 2 (- cnt))))
+  	(if (negative? int)
+--- 102,114 ----
+  	    (vector-ref (vector-ref logical:boole-xor (modulo n1 16))
+  			(modulo n2 16))))))
+  
+! (define-integrable (logical:lognot n) (- -1 n))
+  
+! (define-integrable (logical:bit-extract n start end)
+    (logical:logand (- (logical:integer-expt 2 (- end start)) 1)
+  		  (logical:ash n (- start))))
+  
+! (define-integrable (logical:ash int cnt)
+    (if (negative? cnt)
+        (let ((n (logical:integer-expt 2 (- cnt))))
+  	(if (negative? int)
+***************
+*** 104,110 ****
+  	    (quotient int n)))
+        (* (logical:integer-expt 2 cnt) int)))
+  
+! (define (logical:ash-4 x)
+    (if (negative? x)
+        (+ -1 (quotient (+ 1 x) 16))
+        (quotient x 16)))
+--- 116,122 ----
+  	    (quotient int n)))
+        (* (logical:integer-expt 2 cnt) int)))
+  
+! (define-integrable (logical:ash-4 x)
+    (if (negative? x)
+        (+ -1 (quotient (+ 1 x) 16))
+        (quotient x 16)))
+diff -c slib/mitscheme.init nlib/mitscheme.init
+*** slib/mitscheme.init	Fri Jan 22 00:52:04 1993
+--- nlib/mitscheme.init	Tue Feb  9 00:21:12 1993
+***************
+*** 48,55 ****
+  
+  ;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+  ;;; use this definition if your system doesn't have such a procedure.
+! ;(define (force-output . arg) #t)
+! (define force-output flush-output)
+  
+  ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+  ;;; be returned by CHAR->INTEGER.  It is defined by MITScheme.
+--- 47,54 ----
+  
+  ;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+  ;;; use this definition if your system doesn't have such a procedure.
+! (define (force-output . arg) #t)
+! ;(define force-output flush-output)
+  
+  ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+  ;;; be returned by CHAR->INTEGER.  It is defined by MITScheme.
+diff -c slib/modular.scm nlib/modular.scm
+*** slib/modular.scm	Sun Feb  2 12:53:26 1992
+--- nlib/modular.scm	Tue Feb  9 00:21:13 1993
+***************
+*** 36,41 ****
+--- 36,48 ----
+  ;Returns (k2 ^ k3) mod k1.
+  ;
+  ;;;;--------------------------------------------------------------
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate-external "logical"))
++ (declare (integrate modular:negate  extended-euclid))
++ 
+  (require 'logical)
+  
+  ;;; from:
+***************
+*** 51,57 ****
+  	      (caddr res)
+  	      (- (cadr res) (* (quotient a b) (caddr res)))))))
+  
+! (define (modular:invert m a)
+    (let ((d (modular:extended-euclid a m)))
+      (if (= 1 (car d))
+  	(modulo (cadr d) m)
+--- 58,64 ----
+  	      (caddr res)
+  	      (- (cadr res) (* (quotient a b) (caddr res)))))))
+  
+! (define-integrable (modular:invert m a)
+    (let ((d (modular:extended-euclid a m)))
+      (if (= 1 (car d))
+  	(modulo (cadr d) m)
+***************
+*** 59,67 ****
+  
+  (define modular:negate -)
+  
+! (define (modular:+ m a b) (modulo (+ (- a m) b) m))
+  
+! (define (modular:- m a b) (modulo (- a b) m))
+  
+  ;;; See: L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
+  ;;; with Splitting Facilities." ACM Transactions on Mathematical
+--- 66,74 ----
+  
+  (define modular:negate -)
+  
+! (define-integrable (modular:+ m a b) (modulo (+ (- a m) b) m))
+  
+! (define-integrable (modular:- m a b) (modulo (- a b) m))
+  
+  ;;; See: L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
+  ;;; with Splitting Facilities." ACM Transactions on Mathematical
+***************
+*** 98,104 ****
+  	  (modulo (+ (if (positive? p) (- p m) p)
+  		     (* a0 (modulo b q))) m)))))
+  
+! (define (modular:expt m a b)
+    (cond ((= a 1) 1)
+  	((= a (- m 1)) (if (odd? b) a 1))
+  	((zero? a) 0)
+--- 105,111 ----
+  	  (modulo (+ (if (positive? p) (- p m) p)
+  		     (* a0 (modulo b q))) m)))))
+  
+! (define-integrable (modular:expt m a b)
+    (cond ((= a 1) 1)
+  	((= a (- m 1)) (if (odd? b) a 1))
+  	((zero? a) 0)
+diff -c slib/obj2str.scm nlib/obj2str.scm
+*** slib/obj2str.scm	Mon Oct 19 14:49:08 1992
+--- nlib/obj2str.scm	Tue Feb  9 00:21:13 1993
+***************
+*** 2,13 ****
+  
+  (require 'generic-write)
+  
+  ; (object->string obj) returns the textual representation of 'obj' as a
+  ; string.
+  ;
+  ; Note: (write obj) = (display (object->string obj))
+  
+! (define (object->string obj)
+    (let ((result '()))
+      (generic-write obj #f #f (lambda (str) (set! result (cons str result)) #t))
+      (reverse-string-append result)))
+--- 2,17 ----
+  
+  (require 'generic-write)
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "genwrite"))
++ 
+  ; (object->string obj) returns the textual representation of 'obj' as a
+  ; string.
+  ;
+  ; Note: (write obj) = (display (object->string obj))
+  
+! (define-integrable (object->string obj)
+    (let ((result '()))
+      (generic-write obj #f #f (lambda (str) (set! result (cons str result)) #t))
+      (reverse-string-append result)))
+diff -c slib/pp2str.scm nlib/pp2str.scm
+*** slib/pp2str.scm	Mon Oct 19 14:49:08 1992
+--- nlib/pp2str.scm	Tue Feb  9 00:21:13 1993
+***************
+*** 2,11 ****
+  
+  (require 'generic-write)
+  
+  ; (pretty-print-to-string obj) returns a string with the pretty-printed
+  ; textual representation of 'obj'.
+  
+! (define (pp:pretty-print-to-string obj)
+    (let ((result '()))
+      (generic-write obj #f 79 (lambda (str) (set! result (cons str result)) #t))
+      (reverse-string-append result)))
+--- 2,16 ----
+  
+  (require 'generic-write)
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "genwrite"))
++ (declare (integrate pretty-print-to-string))
++ 
+  ; (pretty-print-to-string obj) returns a string with the pretty-printed
+  ; textual representation of 'obj'.
+  
+! (define-integrable (pp:pretty-print-to-string obj)
+    (let ((result '()))
+      (generic-write obj #f 79 (lambda (str) (set! result (cons str result)) #t))
+      (reverse-string-append result)))
+diff -c slib/ppfile.scm nlib/ppfile.scm
+*** slib/ppfile.scm	Mon Oct 19 14:49:08 1992
+--- nlib/ppfile.scm	Tue Feb  9 00:21:14 1993
+***************
+*** 10,15 ****
+--- 10,19 ----
+  ;
+  (require 'pretty-print)
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "pp"))
++ 
+  (define (pprint-file ifile . optarg)
+    (let ((lst (call-with-input-file ifile
+  	       (lambda (iport)
+diff -c slib/prime.scm nlib/prime.scm
+*** slib/prime.scm	Mon Feb  8 20:49:46 1993
+--- nlib/prime.scm	Tue Feb  9 00:24:16 1993
+***************
+*** 24,29 ****
+--- 24,39 ----
+  ;(sort! (factor k) <)
+  
+  ;;;;--------------------------------------------------------------
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "random"))
++ (declare (integrate-external "modular"))
++ (declare (integrate
++ 	  jacobi-symbol 
++ 	  prime?
++ 	  factor))
++ 
++ 
+  (require 'random)
+  (require 'modular)
+  
+***************
+*** 56,62 ****
+  ;;;     choosing prime:trials=30 should be enough
+  (define prime:trials 30)
+  ;;; prime:product is a product of small primes.
+! (define prime:product
+    (let ((p 210))
+      (for-each (lambda (s) (set! p (or (string->number s) p)))
+        '("2310" "30030" "510510" "9699690" "223092870"
+--- 66,72 ----
+  ;;;     choosing prime:trials=30 should be enough
+  (define prime:trials 30)
+  ;;; prime:product is a product of small primes.
+! (define-integrable prime:product
+    (let ((p 210))
+      (for-each (lambda (s) (set! p (or (string->number s) p)))
+        '("2310" "30030" "510510" "9699690" "223092870"
+***************
+*** 86,92 ****
+  ;                  |  f(u,v,2b,n/2) or f(u+b,v+b,2b,(n-u-v-b)/2) if n even
+  
+  ;Thm: f(1,1,2,(m-1)/2) = (p,q) iff pq=m for odd m.
+!  
+  ;It may be illuminating to consider the relation of the Lankinen function in
+  ;a `computational hierarchy' of other factoring functions.*  Assumptions are
+  ;made herein on the basis of conventional digital (binary) computers.  Also,
+--- 96,102 ----
+  ;                  |  f(u,v,2b,n/2) or f(u+b,v+b,2b,(n-u-v-b)/2) if n even
+  
+  ;Thm: f(1,1,2,(m-1)/2) = (p,q) iff pq=m for odd m.
+! 
+  ;It may be illuminating to consider the relation of the Lankinen function in
+  ;a `computational hierarchy' of other factoring functions.*  Assumptions are
+  ;made herein on the basis of conventional digital (binary) computers.  Also,
+***************
+*** 94,100 ****
+  ;be factored is prime).  However, all algorithms would probably perform to
+  ;the same constant multiple of the given orders for complete composite
+  ;factorizations.
+!  
+  ;Thm: Eratosthenes' Sieve is very roughtly O(ln(n)/n) in time and
+  ;     O(n*log2(n)) in space.
+  ;Pf: It works with all prime factors less than n (about ln(n)/n by the prime
+--- 104,110 ----
+  ;be factored is prime).  However, all algorithms would probably perform to
+  ;the same constant multiple of the given orders for complete composite
+  ;factorizations.
+! 
+  ;Thm: Eratosthenes' Sieve is very roughtly O(ln(n)/n) in time and
+  ;     O(n*log2(n)) in space.
+  ;Pf: It works with all prime factors less than n (about ln(n)/n by the prime
+diff -c slib/priorque.scm nlib/priorque.scm
+*** slib/priorque.scm	Mon Oct 19 14:49:42 1992
+--- nlib/priorque.scm	Tue Feb  9 00:21:15 1993
+***************
+*** 22,41 ****
+  ;;; 1989 MIT Press.
+  
+  (require 'record)
+  (define heap-rtd (make-record-type "heap" '(array size heap<?)))
+! (define make-heap
+    (let ((cstr (record-constructor heap-rtd)))
+      (lambda (pred<?)
+        (cstr (make-vector 4) 0 pred<?))))
+! (define heap-ref
+    (let ((ra (record-accessor heap-rtd 'array)))
+      (lambda (a i)
+        (vector-ref (ra a) (+ -1 i)))))
+! (define heap-set!
+    (let ((ra (record-accessor heap-rtd 'array)))
+      (lambda (a i v)
+        (vector-set! (ra a) (+ -1 i) v))))
+! (define heap-exchange
+    (let ((aa (record-accessor heap-rtd 'array)))
+      (lambda (a i j)
+        (set! i (+ -1 i))
+--- 22,53 ----
+  ;;; 1989 MIT Press.
+  
+  (require 'record)
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate
++ 	  heap-size
++ 	  heap<?))
++ 
+  (define heap-rtd (make-record-type "heap" '(array size heap<?)))
+! 
+! (define-integrable make-heap
+    (let ((cstr (record-constructor heap-rtd)))
+      (lambda (pred<?)
+        (cstr (make-vector 4) 0 pred<?))))
+! 
+! (define-integrable heap-ref
+    (let ((ra (record-accessor heap-rtd 'array)))
+      (lambda (a i)
+        (vector-ref (ra a) (+ -1 i)))))
+! 
+! (define-integrable heap-set!
+    (let ((ra (record-accessor heap-rtd 'array)))
+      (lambda (a i v)
+        (vector-set! (ra a) (+ -1 i) v))))
+! 
+! (define-integrable heap-exchange
+    (let ((aa (record-accessor heap-rtd 'array)))
+      (lambda (a i j)
+        (set! i (+ -1 i))
+***************
+*** 44,51 ****
+--- 56,66 ----
+  	     (tmp (vector-ref ra i)))
+  	(vector-set! ra i (vector-ref ra j))
+  	(vector-set! ra j tmp)))))
++ 
+  (define heap-size (record-accessor heap-rtd 'size))
++ 
+  (define heap<? (record-accessor heap-rtd 'heap<?))
++ 
+  (define heap-set-size
+    (let ((aa (record-accessor heap-rtd 'array))
+  	(am (record-modifier heap-rtd 'array))
+***************
+*** 59,68 ****
+  		(vector-set! nra i (vector-ref ra i)))))
+  	(sm a s)))))
+  
+! (define (heap-parent i) (quotient i 2))
+! (define (heap-left i) (* 2 i))
+! (define (heap-right i) (+ 1 (* 2 i)))
+  
+  (define (heapify a i)
+    (define l (heap-left i))
+    (define r (heap-right i))
+--- 74,85 ----
+  		(vector-set! nra i (vector-ref ra i)))))
+  	(sm a s)))))
+  
+! (define-integrable (heap-parent i) (quotient i 2))
+  
++ (define-integrable (heap-left i) (* 2 i))
++ 
++ (define-integrable (heap-right i) (+ 1 (* 2 i)))
++ 
+  (define (heapify a i)
+    (define l (heap-left i))
+    (define r (heap-right i))
+***************
+*** 99,104 ****
+--- 116,122 ----
+      max))
+  
+  (define heap #f)
++ 
+  (define (heap-test)
+    (set! heap (make-heap char>?))
+    (heap-insert! heap #\A)
+diff -c slib/process.scm nlib/process.scm
+*** slib/process.scm	Wed Nov  4 12:26:50 1992
+--- nlib/process.scm	Tue Feb  9 00:21:15 1993
+***************
+*** 21,30 ****
+  ;
+  ;;;;----------------------------------------------------------------------
+  
+  (require 'full-continuation)
+  (require 'queue)
+  
+! (define (add-process! thunk1)
+    (cond ((procedure? thunk1)
+  	 (defer-ints)
+  	 (enqueue! process:queue thunk1)
+--- 21,33 ----
+  ;
+  ;;;;----------------------------------------------------------------------
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
+  (require 'full-continuation)
+  (require 'queue)
+  
+! (define-integrable (add-process! thunk1)
+    (cond ((procedure? thunk1)
+  	 (defer-ints)
+  	 (enqueue! process:queue thunk1)
+***************
+*** 55,63 ****
+  (define ints-disabled #f)
+  (define alarm-deferred #f)
+  
+! (define (defer-ints) (set! ints-disabled #t))
+  
+! (define (allow-ints)
+    (set! ints-disabled #f)
+    (cond (alarm-deferred
+  	  (set! alarm-deferred #f)
+--- 58,66 ----
+  (define ints-disabled #f)
+  (define alarm-deferred #f)
+  
+! (define-integrable (defer-ints) (set! ints-disabled #t))
+  
+! (define-integrable (allow-ints)
+    (set! ints-disabled #f)
+    (cond (alarm-deferred
+  	  (set! alarm-deferred #f)
+***************
+*** 66,72 ****
+  ;;; Make THE process queue.
+  (define process:queue (make-queue))
+  
+! (define (alarm-interrupt)
+    (alarm 1)
+    (if ints-disabled (set! alarm-deferred #t)
+        (process:schedule!)))
+--- 69,75 ----
+  ;;; Make THE process queue.
+  (define process:queue (make-queue))
+  
+! (define-integrable (alarm-interrupt)
+    (alarm 1)
+    (if ints-disabled (set! alarm-deferred #t)
+        (process:schedule!)))
+diff -c slib/randinex.scm nlib/randinex.scm
+*** slib/randinex.scm	Wed Nov 18 22:59:20 1992
+--- nlib/randinex.scm	Tue Feb  9 00:21:16 1993
+***************
+*** 47,52 ****
+--- 47,59 ----
+  ;For an exponential distribution with mean U use (* U (random:exp)).
+  ;;;;-----------------------------------------------------------------
+  
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "random"))
++ (declare (integrate
++ 	  random:float-radix))
++ 
+  (define random:float-radix
+    (+ 1 (exact->inexact random:MASK)))
+  
+***************
+*** 56,61 ****
+--- 63,69 ----
+    (if (= 1.0 (+ 1 x))
+        l
+        (random:size-float (+ l 1) (/ x random:float-radix))))
++ 
+  (define random:chunks/float (random:size-float 1 1.0))
+  
+  (define (random:uniform-chunk n state)
+***************
+*** 67,73 ****
+  	 random:float-radix)))
+  
+  ;;; Generate an inexact real between 0 and 1.
+! (define (random:uniform state)
+    (random:uniform-chunk random:chunks/float state))
+  
+  ;;; If x and y are independent standard normal variables, then with
+--- 75,81 ----
+  	 random:float-radix)))
+  
+  ;;; Generate an inexact real between 0 and 1.
+! (define-integrable (random:uniform state)
+    (random:uniform-chunk random:chunks/float state))
+  
+  ;;; If x and y are independent standard normal variables, then with
+***************
+*** 89,95 ****
+  	  (do! n (* r (cos t)))
+  	  (if (positive? n) (do! (- n 1) (* r (sin t)))))))))
+  
+! (define random:normal
+    (let ((vect (make-vector 1)))
+      (lambda args 
+        (apply random:normal-vector! vect args)
+--- 97,103 ----
+  	  (do! n (* r (cos t)))
+  	  (if (positive? n) (do! (- n 1) (* r (sin t)))))))))
+  
+! (define-integrable random:normal
+    (let ((vect (make-vector 1)))
+      (lambda args 
+        (apply random:normal-vector! vect args)
+***************
+*** 98,104 ****
+  ;;; For the uniform distibution on the hollow sphere, pick a normal
+  ;;; family and scale.
+  
+! (define (random:hollow-sphere! vect . args)
+    (let ((ms (sqrt (apply random:normal-vector! vect args))))
+      (do ((n (- (vector-length vect) 1) (- n 1)))
+  	((negative? n))
+--- 106,112 ----
+  ;;; For the uniform distibution on the hollow sphere, pick a normal
+  ;;; family and scale.
+  
+! (define-integrable (random:hollow-sphere! vect . args)
+    (let ((ms (sqrt (apply random:normal-vector! vect args))))
+      (do ((n (- (vector-length vect) 1) (- n 1)))
+  	((negative? n))
+***************
+*** 117,123 ****
+  	((negative? n))
+        (vector-set! vect n (* r (vector-ref vect n))))))
+  
+! (define (random:exp . args)
+    (let ((state (if (null? args) *random-state* (car args))))
+      (- (log (random:uniform state)))))
+  
+--- 125,131 ----
+  	((negative? n))
+        (vector-set! vect n (* r (vector-ref vect n))))))
+  
+! (define-integrable (random:exp . args)
+    (let ((state (if (null? args) *random-state* (car args))))
+      (- (log (random:uniform state)))))
+  
+diff -c slib/random.scm nlib/random.scm
+*** slib/random.scm	Tue Feb  2 00:02:58 1993
+--- nlib/random.scm	Tue Feb  9 00:21:18 1993
+***************
+*** 35,40 ****
+--- 35,50 ----
+  ;procedures for generating inexact distributions.
+  ;;;;------------------------------------------------------------------
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate-external "logical"))
++ (declare (integrateb
++ 	  random:tap-1
++ 	  random:size
++ 	  random:chunk-size
++ 	  random:MASK
++ 	  random))
++ 
+  (require 'logical)
+  
+  (define random:tap 24)
+***************
+*** 45,50 ****
+--- 55,61 ----
+    (if (and (exact? trial) (>= most-positive-fixnum trial))
+        l
+        (random:size-int (- l 1)))))
++ 
+  (define random:chunk-size (* 4 (random:size-int 8)))
+  
+  (define random:MASK
+***************
+*** 107,113 ****
+  ;;;random:uniform is in randinex.scm.  It is needed only if inexact is
+  ;;;supported.
+  
+! (define (random:make-random-state . args)
+    (let ((state (if (null? args) *random-state* (car args))))
+      (list->vector (vector->list state))))
+  
+--- 118,124 ----
+  ;;;random:uniform is in randinex.scm.  It is needed only if inexact is
+  ;;;supported.
+  
+! (define-integrable (random:make-random-state . args)
+    (let ((state (if (null? args) *random-state* (car args))))
+      (list->vector (vector->list state))))
+  
+diff -c slib/rbtree.scm nlib/rbtree.scm
+*** slib/rbtree.scm	Sat Jan  9 13:40:56 1993
+--- nlib/rbtree.scm	Tue Feb  9 00:21:18 1993
+***************
+*** 5,11 ****
+--- 5,24 ----
+  ;;;; PGS, 6 Jul 1990
+  ;;; jaffer@ai.mit.edu Ported to SLIB, 1/6/93
+  
++ 
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ (declare (integrate 
++ 	  rb-tree-root
++ 	  set-rb-tree-root!
++ 	  rb-tree-left-rotation-field-maintainer
++ 	  rb-tree-right-rotation-field-maintainer
++ 	  rb-tree-insertion-field-maintainer
++ 	  rb-tree-deletion-field-maintainer
++ 	  rb-tree-prior?))
++ 
+  (require 'record)
++ 
+  (define rb-tree
+    (make-record-type
+     "rb-tree"
+***************
+*** 227,233 ****
+  	   y)
+  	(set! x y)
+  	(set! y (rb-node-parent y)))))
+- 
+  
+  ;;;; Deletion.  We do not entirely follow Cormen, Leiserson and Rivest's lead
+  ;;;; here, because their use of sentinels is in rather obscenely poor taste.
+--- 240,245 ----
+diff -c slib/sort.scm nlib/sort.scm
+*** slib/sort.scm	Wed Nov  6 00:50:38 1991
+--- nlib/sort.scm	Tue Feb  9 00:22:03 1993
+***************
+*** 118,123 ****
+--- 118,125 ----
+  ;   in Scheme.
+  ;;; --------------------------------------------------------------------
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))		; Honestly, nothing defined here clashes!
+  
+  ;;; (sorted? sequence less?)
+  ;;; is true when sequence is a list (x0 x1 ... xm) or a vector #(x0 ... xm)
+diff -c slib/printf.scm nlib/printf.scm
+*** slib/printf.scm	Mon Oct 19 14:48:58 1992
+--- nlib/printf.scm	Tue Feb  9 00:22:03 1993
+***************
+*** 3,8 ****
+--- 3,19 ----
+  
+  ;;; Floating point is not handled yet.  It should not be hard to do.
+  
++ ;;; Declarations for CScheme
++ (declare (usual-integrations))
++ 
++ (declare (integrate 
++ 	  printf
++ 	  fprintf
++ 	  sprintf
++ 	  stdin
++ 	  stdout
++ 	  stderr))
++ 
+  (define (stdio:iprintf out format . args)
+    (let loop ((pos 0) (args args))
+      (if (< pos (string-length format))
+***************
+*** 96,105 ****
+  	  (else (out (string-ref format pos))
+  		(loop (+ pos 1) args))))))
+  
+! (define (stdio:printf format . args)
+    (apply stdio:iprintf display format args))
+  
+! (define (stdio:fprintf port format . args)
+    (if (equal? port (current-output-port))
+        (apply stdio:iprintf display format args)
+        (apply stdio:iprintf (lambda (x) (display x port)) format args)))
+--- 107,116 ----
+  	  (else (out (string-ref format pos))
+  		(loop (+ pos 1) args))))))
+  
+! (define-integrable (stdio:printf format . args)
+    (apply stdio:iprintf display format args))
+  
+! (define-integrable (stdio:fprintf port format . args)
+    (if (equal? port (current-output-port))
+        (apply stdio:iprintf display format args)
+        (apply stdio:iprintf (lambda (x) (display x port)) format args)))
+diff -c slib/strcase.scm nlib/strcase.scm
+*** slib/strcase.scm	Wed Nov 18 14:15:18 1992
+--- nlib/strcase.scm	Tue Feb  9 00:22:03 1993
+***************
+*** 8,27 ****
+  ;string-upcase!, string-downcase!, string-capitalize!
+  ; are destructive versions.
+  
+! (define (string-upcase! str)
+    (do ((i (- (string-length str) 1) (- i 1)))
+        ((< i 0) str)
+      (string-set! str i (char-upcase (string-ref str i)))))
+  
+! (define (string-upcase str)
+    (string-upcase! (string-copy str)))
+    
+! (define (string-downcase! str)
+    (do ((i (- (string-length str) 1) (- i 1)))
+        ((< i 0) str)
+      (string-set! str i (char-downcase (string-ref str i)))))
+  
+! (define (string-downcase str)
+    (string-downcase! (string-copy str)))
+  
+  (define (string-capitalize! str)	; "hello" -> "Hello"
+--- 8,30 ----
+  ;string-upcase!, string-downcase!, string-capitalize!
+  ; are destructive versions.
+  
+! ;;; Declarations for CScheme
+! (declare (usual-integrations))
+! 
+! (define-integrable (string-upcase! str)
+    (do ((i (- (string-length str) 1) (- i 1)))
+        ((< i 0) str)
+      (string-set! str i (char-upcase (string-ref str i)))))
+  
+! (define-integrable (string-upcase str)
+    (string-upcase! (string-copy str)))
+    
+! (define-integrable (string-downcase! str)
+    (do ((i (- (string-length str) 1) (- i 1)))
+        ((< i 0) str)
+      (string-set! str i (char-downcase (string-ref str i)))))
+  
+! (define-integrable (string-downcase str)
+    (string-downcase! (string-copy str)))
+  
+  (define (string-capitalize! str)	; "hello" -> "Hello"
+***************
+*** 38,42 ****
+  		  (string-set! str i (char-upcase c))))
+  	    (set! non-first-alpha #f))))))
+  
+! (define (string-capitalize str)
+    (string-capitalize! (string-copy str)))
+--- 41,45 ----
+  		  (string-set! str i (char-upcase c))))
+  	    (set! non-first-alpha #f))))))
+  
+! (define-integrable (string-capitalize str)
+    (string-capitalize! (string-copy str)))
+diff -c slib/synchk.scm nlib/synchk.scm
+*** slib/synchk.scm	Mon Jan 27 09:28:48 1992
+--- nlib/synchk.scm	Tue Feb  9 00:22:03 1993
+***************
+*** 35,45 ****
+  ;;; written by Alan Bawden
+  ;;; modified by Chris Hanson
+  
+! (define (syntax-check pattern form)
+    (if (not (syntax-match? (cdr pattern) (cdr form)))
+        (syntax-error "ill-formed special form" form)))
+  
+! (define (ill-formed-syntax form)
+    (syntax-error "ill-formed special form" form))
+  
+  (define (syntax-match? pattern object)
+--- 35,48 ----
+  ;;; written by Alan Bawden
+  ;;; modified by Chris Hanson
+  
+! ;;; Declarations for CScheme
+! (declare (usual-integrations))
+! 
+! (define-integrable (syntax-check pattern form)
+    (if (not (syntax-match? (cdr pattern) (cdr form)))
+        (syntax-error "ill-formed special form" form)))
+  
+! (define-integrable (ill-formed-syntax form)
+    (syntax-error "ill-formed special form" form))
+  
+  (define (syntax-match? pattern object)
diff --git a/mitscheme.init b/mitscheme.init
new file mode 100644
index 0000000..a6f1c0e
--- /dev/null
+++ b/mitscheme.init
@@ -0,0 +1,254 @@
+;;;"mitscheme.init" Initialization for SLIB for MITScheme        -*-scheme-*-
+;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; Make this part of your ~/.scheme.init file.
+
+;;; (software-type) should be set to the generic operating system type.
+(define (software-type) 'UNIX)
+
+;;; (scheme-implementation-type) should return the name of the scheme
+;;; implementation loading this file.
+
+(define (scheme-implementation-type) 'MITScheme)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "7.3.0")
+
+;;; *features* should be set to a list of symbols describing features
+;;; of this implementation.  See Template.scm for the list of feature
+;;; names.
+
+;the following may not be the Right Thing for this application, since
+;it causes an error (rather than just returning nil) when the environment
+;variable is not defined.
+(define getenv get-environment-variable)
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxillary files to your Scheme
+;;; implementation reside.
+
+(define (implementation-vicinity)
+  (case (software-type)
+    ((UNIX)	 "/usr/local/src/scheme/")
+    ((VMS)	"scheme$src:")))
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+(define library-vicinity
+  (let ((library-path
+	 (or (getenv "SCHEME_LIBRARY_PATH")
+	     ;; Use this path if your scheme does not support GETENV.
+	     (case (software-type)
+	       ((UNIX) "/usr/local/lib/slib/")
+	       ((VMS) "lib$scheme:")
+	       ((MS-DOS) "C:\\SLIB\\")
+	       (else "")))))
+    (lambda () library-path)))
+
+(define *features*
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+	rev4-report
+	ieee-p1178
+	sicp
+	rev4-optional-procedures
+	rev3-procedures
+	rev2-procedures
+	multiarg/and-
+	multiarg-apply
+	rationalize
+	object-hash
+	delay
+	with-file
+	string-port
+	transcript
+	char-ready?
+	record
+	values
+	dynamic-wind
+	ieee-floating-point
+	full-continuation
+;	sort
+	queue
+	pretty-print
+	object->string
+	trace				;has macros: TRACE and UNTRACE
+	compiler
+	getenv
+	Xwindows
+	))
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define output-port-width output-port/x-size)
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (let ((port console-output-port))
+    (lambda () port)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam
+  (let ((cntr 100))
+    (lambda () (set! cntr (+ 1 cntr))
+	    (let ((tmp (string-append "slib_" (number->string cntr))))
+	      (if (file-exists? tmp) (tmpnam) tmp)))))
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port.
+(define force-output flush-output)
+;;; MITScheme 7.2 is missing flush-output.  Use this instead
+;(define (force-output . arg) #t)
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+(define (call-with-output-string proc)
+  (let ((co (current-output-port)))
+    (with-output-to-string
+      (lambda ()
+	(let ((port (current-output-port)))
+	  (with-output-to-port co
+	    (lambda () (proc port))))))))
+
+(define (call-with-input-string string proc)
+  (let ((ci (current-input-port)))
+    (with-input-from-string string
+      (lambda ()
+	(let ((port (current-input-port)))
+	  (with-input-from-port ci
+	    (lambda () (proc port))))))))
+
+(define object->string write-to-string)
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.  It is defined by MITScheme.
+
+;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum #x03FFFFFF)
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval, SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+;(define (slib:eval form) (eval form (repl/environment (nearest-repl))))
+(define (slib:eval form) (eval form user-initial-environment))
+
+(define *macros* '(defmacro))
+(define (defmacro? m) (and (memq m *macros*) #t))
+
+(syntax-table-define system-global-syntax-table 'defmacro
+  (macro defmacargs
+    (let ((macname (car defmacargs)) (macargs (cadr defmacargs))
+				     (macbdy (cddr defmacargs)))
+      `(begin
+	 (set! *macros* (cons ',macname *macros*))
+	 (syntax-table-define system-global-syntax-table ',macname
+	   (macro ,macargs ,@macbdy))))))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (if (and (symbol? a) (defmacro? a))
+		      (apply (syntax-table-ref system-global-syntax-table a)
+			     (cdr e))
+		      e))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (if (and (symbol? a) (defmacro? a))
+		      (macroexpand
+		       (apply (syntax-table-ref system-global-syntax-table a)
+			      (cdr e)))
+		      e))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define defmacro:eval slib:eval)
+(define defmacro:load load)
+;;; If your implementation provides R4RS macros:
+;(define macro:eval slib:eval)
+;(define macro:load load)
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+(define record-modifier record-updater)	;some versions need this?
+
+;; define an error procedure for the library
+(define (slib:error . args)
+  (apply error-procedure (append args (list (the-environment)))))
+
+;; define these as appropriate for your system.
+(define slib:tab (integer->char 9))
+(define slib:form-feed (integer->char 12))
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:exit
+  (lambda args
+    (cond ((null? args) (exit))
+	  ((eqv? #t (car args)) (exit))
+	  ((and (number? (car args)) (integer? (car args))) (exit (car args)))
+	  (else (exit 1)))))
+
+;;; Here for backward compatability
+
+(define (scheme-file-suffix) "")
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+(define slib:load-source load)
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/modular.scm b/modular.scm
new file mode 100644
index 0000000..357ce77
--- /dev/null
+++ b/modular.scm
@@ -0,0 +1,158 @@
+;;;; "modular.scm", modular fixnum arithmetic for Scheme
+;;; Copyright (C) 1991, 1993, 1995 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define (symmetric:modulus n)
+  (cond ((or (not (number? n)) (not (positive? n)) (even? n))
+	 (slib:error 'symmetric:modulus n))
+	(else (quotient (+ -1 n) -2))))
+
+(define (modulus->integer m)
+  (cond ((negative? m) (- 1 m m))
+	((zero? m) #f)
+	(else m)))
+
+(define (modular:normalize m k)
+  (cond ((positive? m) (modulo k m))
+	((zero? m) k)
+	((<= m k (- m)) k)
+	((or (provided? 'bignum)
+	     (<= m (quotient (+ -1 most-positive-fixnum) 2)))
+	 (let* ((pm (+ 1 (* -2 m)))
+		(s (modulo k pm)))
+	   (if (<= s (- m)) s (- s pm))))
+	((positive? k) (+ (+ (+ k -1) m) m))
+	(else  (- (- (+ k 1) m) m))))
+
+;;;; NOTE: The rest of these functions assume normalized arguments!
+
+(require 'logical)
+
+(define (modular:extended-euclid x y)
+  (define q 0)
+  (do ((r0 x r1) (r1 y (remainder r0 r1))
+       (u0 1 u1) (u1 0 (- u0 (* q u1)))
+       (v0 0 v1) (v1 1 (- v0 (* q v1))))
+      ;; (assert (= r0 (+ (* u0 x) (* v0 y))))
+      ;; (assert (= r1 (+ (* u1 x) (* v1 y))))
+      ((zero? r1) (list r0 u0 v0))
+    (set! q (quotient r0 r1))))
+
+(define (modular:invertable? m a)
+  (eqv? 1 (gcd (or (modulus->integer m) 0) a)))
+
+(define (modular:invert m a)
+  (cond ((eqv? 1 (abs a)) a)		; unit
+	(else
+	 (let ((pm (modulus->integer m)))
+	   (cond
+	    (pm
+	     (let ((d (modular:extended-euclid (modular:normalize pm a) pm)))
+	       (if (= 1 (car d))
+		   (modular:normalize m (cadr d))
+		   (slib:error 'modular:invert "can't invert" m a))))
+	    (else (slib:error 'modular:invert "can't invert" m a)))))))
+
+(define (modular:negate m a)
+  (if (zero? a) 0
+      (if (negative? m) (- a)
+	  (- m a))))
+
+;;; Being careful about overflow here
+(define (modular:+ m a b)
+  (cond ((positive? m)
+	 (modulo (+ (- a m) b) m))
+	((zero? m) (+ a b))
+	((negative? a)
+	 (if (negative? b)
+	     (let ((s (+ (- a m) b)))
+	       (if (negative? s)
+		   (- s -1 m)
+		   (+ s m)))
+	     (+ a b)))
+	((negative? b) (+ a b))
+	(else (let ((s (+ (+ a m) b)))
+		(if (positive? s)
+		    (+ s -1 m)
+		    (- s m))))))
+
+(define (modular:- m a b)
+  (cond ((positive? m) (modulo (- a b) m))
+	((zero? m) (- a b))
+	(else (modular:+ m a (- b)))))
+
+;;; See: L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package
+;;; with Splitting Facilities." ACM Transactions on Mathematical
+;;; Software, 17:98-111 (1991)
+
+;;; modular:r = 2**((nb-2)/2) where nb = number of bits in a word.
+(define modular:r
+  (ash 1 (quotient (integer-length most-positive-fixnum) 2)))
+(define modular:*
+  (if (provided? 'bignum)
+      (lambda (m a b)
+	(cond ((zero? m) (* a b))
+	      ((positive? m) (modulo (* a b) m))
+	      (else (modular:normalize m (* a b)))))
+      (lambda (m a b)
+	(let ((a0 a)
+	      (p 0))
+	  (cond
+	   ((zero? m) (* a b))
+	   ((negative? m)
+	    "This doesn't work for the full range of modulus M;"
+	    "Someone please create or convert the following"
+	    "algorighm to work with symmetric representation"
+	    (modular:normalize m (* a b)))
+	   (else
+	    (cond
+	     ((< a modular:r))
+	     ((< b modular:r) (set! a b) (set! b a0) (set! a0 a))
+	     (else
+	      (set! a0 (modulo a modular:r))
+	      (let ((a1 (quotient a modular:r))
+		    (qh (quotient m modular:r))
+		    (rh (modulo m modular:r)))
+		(cond ((>= a1 modular:r)
+		       (set! a1 (- a1 modular:r))
+		       (set! p (modulo (- (* modular:r (modulo b qh))
+					  (* (quotient b qh) rh)) m))))
+		(cond ((not (zero? a1))
+		       (let ((q (quotient m a1)))
+			 (set! p (- p (* (quotient b q) (modulo m a1))))
+			 (set! p (modulo (+ (if (positive? p) (- p m) p)
+					    (* a1 (modulo b q))) m)))))
+		(set! p (modulo (- (* modular:r (modulo p qh))
+				   (* (quotient p qh) rh)) m)))))
+	    (if (zero? a0)
+		p
+		(let ((q (quotient m a0)))
+		  (set! p (- p (* (quotient b q) (modulo m a0))))
+		  (modulo (+ (if (positive? p) (- p m) p)
+			     (* a0 (modulo b q))) m)))))))))
+
+(define (modular:expt m a b)
+  (cond ((= a 1) 1)
+	((= a (- m 1)) (if (odd? b) a 1))
+	((zero? a) 0)
+	((zero? m) (integer-expt a b))
+	(else
+	 (logical:ipow-by-squaring a b 1
+				   (lambda (c d) (modular:* m c d))))))
+
+(define extended-euclid modular:extended-euclid)
diff --git a/mulapply.scm b/mulapply.scm
new file mode 100644
index 0000000..d696ee2
--- /dev/null
+++ b/mulapply.scm
@@ -0,0 +1,28 @@
+; "mulapply.scm" Redefine APPLY take more than 2 arguments.
+;Copyright (C) 1991 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define two-arg:apply apply)
+(define apply
+  (lambda args
+    (two-arg:apply (car args) (apply:append-to-last (cdr args)))))
+
+(define (apply:append-to-last lst)
+  (if (null? (cdr lst))
+      (car lst)
+      (cons (car lst) (apply:append-to-last (cdr lst)))))
diff --git a/mularg.scm b/mularg.scm
new file mode 100644
index 0000000..3d62cf4
--- /dev/null
+++ b/mularg.scm
@@ -0,0 +1,10 @@
+;;; "mularg.scm" Redefine - and / to take more than 2 arguments.
+
+(let ((maker
+       (lambda (op)
+	 (lambda (d1 . ds)
+	   (cond ((null? ds) (op d1))
+		 ((null? (cdr ds)) (op d1 (car ds)))
+		 (else (for-each (lambda (d) (set! d1 (op d1 d))) ds) d1))))))
+  (set! / (maker /))
+  (set! - (maker -)))
diff --git a/mwdenote.scm b/mwdenote.scm
new file mode 100644
index 0000000..c3fe5f3
--- /dev/null
+++ b/mwdenote.scm
@@ -0,0 +1,273 @@
+;"mwdenote.scm" Syntactic Environments
+; Copyright 1992 William Clinger
+;
+; Permission to copy this software, in whole or in part, to use this
+; software for any lawful purpose, and to redistribute this software
+; is granted subject to the restriction that all copies made of this
+; software must include this copyright notice in full.
+;
+; I also request that you send me a copy of any improvements that you
+; make to this software so that they may be incorporated within it to
+; the benefit of the Scheme community.
+
+;;;; Syntactic environments.
+
+; A syntactic environment maps identifiers to denotations,
+; where a denotation is one of
+;
+;    (special <special>)
+;    (macro <rules> <env>)
+;    (identifier <id>)
+;
+; and where <special> is one of
+;
+;    quote
+;    lambda
+;    if
+;    set!
+;    begin
+;    define
+;    define-syntax
+;    let-syntax
+;    letrec-syntax
+;    syntax-rules
+;
+; and where <rules> is a compiled <transformer spec> (see R4RS),
+; <env> is a syntactic environment, and <id> is an identifier.
+
+(define mw:standard-syntax-environment
+  '((quote         . (special quote))
+    (lambda        . (special lambda))
+    (if            . (special if))
+    (set!          . (special set!))
+    (begin         . (special begin))
+    (define        . (special define))
+    (let           . (special let))                ;; @@ added KAD
+    (let*          . (special let*))               ;; @@    "
+    (letrec        . (special letrec))             ;; @@    "
+    (quasiquote    . (special quasiquote))         ;; @@    "
+    (unquote       . (special unquote))            ;; @@    "
+    (unquote-splicing . (special unquote-splicing)) ; @@    "
+    (do            . (special do))                 ;; @@    "
+    (define-syntax . (special define-syntax))
+    (let-syntax    . (special let-syntax))
+    (letrec-syntax . (special letrec-syntax))
+    (syntax-rules  . (special syntax-rules))
+    (...           . (identifier ...))
+    (:::           . (identifier :::))))
+
+; An unforgeable synonym for lambda, used to expand definitions.
+
+(define mw:lambda0 (string->symbol " lambda "))
+
+; The mw:global-syntax-environment will always be a nonempty
+; association list since there is no way to remove the entry
+; for mw:lambda0.  That entry is used as a header by destructive
+; operations.
+
+(define mw:global-syntax-environment
+  (cons (cons mw:lambda0
+	      (cdr (assq 'lambda mw:standard-syntax-environment)))
+	(mw:syntax-copy mw:standard-syntax-environment)))
+
+(define (mw:global-syntax-environment-set! env)
+  (set-cdr! mw:global-syntax-environment env))
+
+(define (mw:syntax-bind-globally! id denotation)
+  (if (and (mw:identifier? denotation)
+	   (eq? id (mw:identifier-name denotation)))
+      (letrec ((remove-bindings-for-id
+		(lambda (bindings)
+		  (cond ((null? bindings) '())
+			((eq? (caar bindings) id)
+			 (remove-bindings-for-id (cdr bindings)))
+			(else (cons (car bindings)
+				    (remove-bindings-for-id (cdr bindings))))))))
+	(mw:global-syntax-environment-set!
+	 (remove-bindings-for-id (cdr mw:global-syntax-environment))))
+      (let ((x (assq id mw:global-syntax-environment)))
+	(if x
+	    (set-cdr! x denotation)
+	    (mw:global-syntax-environment-set!
+	     (cons (cons id denotation)
+		   (cdr mw:global-syntax-environment)))))))
+
+(define (mw:syntax-divert env1 env2)
+  (append env2 env1))
+
+(define (mw:syntax-extend env ids denotations)
+  (mw:syntax-divert env (map cons ids denotations)))
+
+(define (mw:syntax-lookup-raw env id)
+  (let ((entry (assq id env)))
+    (if entry
+	(cdr entry)
+	#f)))
+
+(define (mw:syntax-lookup env id)
+  (or (mw:syntax-lookup-raw env id)
+      (mw:make-identifier-denotation id)))
+
+(define (mw:syntax-assign! env id denotation)
+  (let ((entry (assq id env)))
+    (if entry
+	(set-cdr! entry denotation)
+	(mw:bug "Bug detected in mw:syntax-assign!" env id denotation))))
+
+(define mw:denote-of-quote
+  (mw:syntax-lookup mw:standard-syntax-environment 'quote))
+
+(define mw:denote-of-lambda
+  (mw:syntax-lookup mw:standard-syntax-environment 'lambda))
+
+(define mw:denote-of-if
+  (mw:syntax-lookup mw:standard-syntax-environment 'if))
+
+(define mw:denote-of-set!
+  (mw:syntax-lookup mw:standard-syntax-environment 'set!))
+
+(define mw:denote-of-begin
+  (mw:syntax-lookup mw:standard-syntax-environment 'begin))
+
+(define mw:denote-of-define
+  (mw:syntax-lookup mw:standard-syntax-environment 'define))
+
+(define mw:denote-of-define-syntax
+  (mw:syntax-lookup mw:standard-syntax-environment 'define-syntax))
+
+(define mw:denote-of-let-syntax
+  (mw:syntax-lookup mw:standard-syntax-environment 'let-syntax))
+
+(define mw:denote-of-letrec-syntax
+  (mw:syntax-lookup mw:standard-syntax-environment 'letrec-syntax))
+
+(define mw:denote-of-syntax-rules
+  (mw:syntax-lookup mw:standard-syntax-environment 'syntax-rules))
+
+(define mw:denote-of-...
+  (mw:syntax-lookup mw:standard-syntax-environment '...))
+
+(define mw:denote-of-:::
+  (mw:syntax-lookup mw:standard-syntax-environment ':::))
+
+(define mw:denote-of-let
+  (mw:syntax-lookup mw:standard-syntax-environment 'let))        ;; @@ KenD
+
+(define mw:denote-of-let*
+  (mw:syntax-lookup mw:standard-syntax-environment 'let*))       ;; @@ KenD
+
+(define mw:denote-of-letrec
+  (mw:syntax-lookup mw:standard-syntax-environment 'letrec))     ;; @@ KenD
+
+(define mw:denote-of-quasiquote
+  (mw:syntax-lookup mw:standard-syntax-environment 'quasiquote)) ;; @@ KenD
+
+(define mw:denote-of-unquote
+  (mw:syntax-lookup mw:standard-syntax-environment 'unquote))    ;; @@ KenD
+
+(define mw:denote-of-unquote-splicing
+  (mw:syntax-lookup mw:standard-syntax-environment 'unquote-splicing)) ;@@ KenD
+
+(define mw:denote-of-do
+  (mw:syntax-lookup mw:standard-syntax-environment 'do))        ;; @@ KenD
+
+(define mw:denote-class car)
+
+;(define (mw:special? denotation)
+;  (eq? (mw:denote-class denotation) 'special))
+
+;(define (mw:macro? denotation)
+;  (eq? (mw:denote-class denotation) 'macro))
+
+(define (mw:identifier? denotation)
+  (eq? (mw:denote-class denotation) 'identifier))
+
+(define (mw:make-identifier-denotation id)
+  (list 'identifier id))
+
+(define macwork:rules cadr)
+(define macwork:env caddr)
+(define mw:identifier-name cadr)
+
+(define (mw:same-denotation? d1 d2)
+  (or (eq? d1 d2)
+      (and (mw:identifier? d1)
+	   (mw:identifier? d2)
+	   (eq? (mw:identifier-name d1)
+		(mw:identifier-name d2)))))
+
+; Renaming of variables.
+
+; Given a datum, strips the suffixes from any symbols that appear within
+; the datum, trying not to copy any more of the datum than necessary.
+; Well, right now I'm just copying the datum, but I need to fix that!
+
+(define (mw:strip x)
+  (cond ((symbol? x)
+	 (let ((chars (memv mw:suffix-character
+			    (reverse (string->list
+				      (symbol->string x))))))
+	   (if chars
+	       (string->symbol
+		(list->string (reverse (cdr chars))))
+	       x)))
+	((pair? x)
+	 (cons (mw:strip (car x))
+	       (mw:strip (cdr x))))
+	((vector? x)
+	 (list->vector (map mw:strip (vector->list x))))
+	(else x)))
+
+; Given a list of identifiers, returns an alist that associates each
+; identifier with a fresh identifier.
+
+(define (mw:rename-vars vars)
+  (set! mw:renaming-counter (+ mw:renaming-counter 1))
+  (let ((suffix (string-append (string mw:suffix-character)
+			       (number->string mw:renaming-counter))))
+    (map (lambda (var)
+	   (if (symbol? var)
+	       (cons var
+		     (string->symbol
+		      (string-append (symbol->string var) suffix)))
+	       (slib:error "Illegal variable" var)))
+	 vars)))
+
+; Given a syntactic environment env to be extended, an alist returned
+; by mw:rename-vars, and a syntactic environment env2, extends env by
+; binding the fresh identifiers to the denotations of the original
+; identifiers in env2.
+
+(define (mw:syntax-alias env alist env2)
+  (mw:syntax-divert
+   env
+   (map (lambda (name-pair)
+	  (let ((old-name (car name-pair))
+		(new-name (cdr name-pair)))
+	    (cons new-name
+		  (mw:syntax-lookup env2 old-name))))
+	alist)))
+
+; Given a syntactic environment and an alist returned by mw:rename-vars,
+; extends the environment by binding the old identifiers to the fresh
+; identifiers.
+
+(define (mw:syntax-rename env alist)
+  (mw:syntax-divert env
+		    (map (lambda (old new)
+			   (cons old (mw:make-identifier-denotation new)))
+			 (map car alist)
+			 (map cdr alist))))
+
+; Given a <formals> and an alist returned by mw:rename-vars that contains
+; a new name for each formal identifier in <formals>, renames the
+; formal identifiers.
+
+(define (mw:rename-formals formals alist)
+  (cond ((null? formals) '())
+	((pair? formals)
+	 (cons (cdr (assq (car formals) alist))
+	       (mw:rename-formals (cdr formals) alist)))
+	(else (cdr (assq formals alist)))))
+
+(define mw:renaming-counter 0)
diff --git a/mwexpand.scm b/mwexpand.scm
new file mode 100644
index 0000000..10083a3
--- /dev/null
+++ b/mwexpand.scm
@@ -0,0 +1,548 @@
+;"mwexpand.scm" macro expander
+; Copyright 1992 William Clinger
+;
+; Permission to copy this software, in whole or in part, to use this
+; software for any lawful purpose, and to redistribute this software
+; is granted subject to the restriction that all copies made of this
+; software must include this copyright notice in full.
+;
+; I also request that you send me a copy of any improvements that you
+; make to this software so that they may be incorporated within it to
+; the benefit of the Scheme community.
+
+; The external entry points and kernel of the macro expander.
+;
+; Part of this code is snarfed from the Twobit macro expander.
+
+(define mw:define-syntax-scope
+  (let ((flag 'letrec))
+    (lambda args
+      (cond ((null? args) flag)
+	    ((not (null? (cdr args)))
+	     (apply mw:warn
+		    "Too many arguments passed to define-syntax-scope"
+		    args))
+	    ((memq (car args) '(letrec letrec* let*))
+	     (set! flag (car args)))
+	    (else (mw:warn "Unrecognized argument to define-syntax-scope"
+			  (car args)))))))
+
+(define mw:quit             ; assigned by macwork:expand
+  (lambda (v) v))
+
+(define (macwork:expand def-or-exp)
+  (call-with-current-continuation
+   (lambda (k)
+     (set! mw:quit k)
+     (set! mw:renaming-counter 0)
+     (mw:desugar-definitions def-or-exp mw:global-syntax-environment))))
+
+(define (mw:desugar-definitions exp env)
+  (letrec 
+    ((define-loop 
+       (lambda (exp rest first)
+	 (cond ((and (pair? exp)
+		     (eq? (mw:syntax-lookup env (car exp))
+			  mw:denote-of-begin)
+		     (pair? (cdr exp)))
+		(define-loop (cadr exp) (append (cddr exp) rest) first))
+	       ((and (pair? exp)
+		     (eq? (mw:syntax-lookup env (car exp))
+			  mw:denote-of-define))
+		(let ((exp (desugar-define exp env)))
+		  (cond ((and (null? first) (null? rest))
+			 exp)
+			((null? rest)
+			 (cons mw:begin1 (reverse (cons exp first))))
+			(else (define-loop (car rest)
+					   (cdr rest)
+					   (cons exp first))))))
+	       ((and (pair? exp)
+		     (eq? (mw:syntax-lookup env (car exp))
+			  mw:denote-of-define-syntax)
+		     (null? first))
+		(define-syntax-loop exp rest))
+	       ((and (null? first) (null? rest))
+		(mw:expand exp env))
+	       ((null? rest)
+		(cons mw:begin1 (reverse (cons (mw:expand exp env) first))))
+	       (else (cons mw:begin1
+			   (append (reverse first)
+				   (map (lambda (exp) (mw:expand exp env))
+					(cons exp rest))))))))
+     
+     (desugar-define
+      (lambda (exp env)
+	(cond 
+	 ((null? (cdr exp)) (mw:error "Malformed definition" exp))
+	 ; (define foo) syntax is transformed into (define foo (undefined)).
+	 ((null? (cddr exp))
+	  (let ((id (cadr exp)))
+	    (redefinition id)
+	    (mw:syntax-bind-globally! id (mw:make-identifier-denotation id))
+	    (list mw:define1 id mw:undefined)))
+	 ((pair? (cadr exp))
+	  ; mw:lambda0 is an unforgeable lambda, needed here because the
+	  ; lambda expression will undergo further expansion.
+	  (desugar-define `(,mw:define1 ,(car (cadr exp))
+				     (,mw:lambda0 ,(cdr (cadr exp))
+					       ,@(cddr exp)))
+			  env))
+	 ((> (length exp) 3) (mw:error "Malformed definition" exp))
+	 (else (let ((id (cadr exp)))
+		 (redefinition id)
+		 (mw:syntax-bind-globally! id (mw:make-identifier-denotation id))
+		 `(,mw:define1 ,id ,(mw:expand (caddr exp) env)))))))
+     
+     (define-syntax-loop 
+       (lambda (exp rest)
+	 (cond ((and (pair? exp)
+		     (eq? (mw:syntax-lookup env (car exp))
+			  mw:denote-of-begin)
+		     (pair? (cdr exp)))
+		(define-syntax-loop (cadr exp) (append (cddr exp) rest)))
+	       ((and (pair? exp)
+		     (eq? (mw:syntax-lookup env (car exp))
+			  mw:denote-of-define-syntax))
+		(if (pair? (cdr exp))
+		    (redefinition (cadr exp)))
+		(if (null? rest)
+		    (mw:define-syntax exp env)
+		    (begin (mw:define-syntax exp env)
+			   (define-syntax-loop (car rest) (cdr rest)))))
+	       ((null? rest)
+		(mw:expand exp env))
+	       (else (cons mw:begin1
+			   (map (lambda (exp) (mw:expand exp env))
+					(cons exp rest)))))))
+     
+     (redefinition
+      (lambda (id)
+	(if (symbol? id)
+	    (if (not (mw:identifier?
+		      (mw:syntax-lookup mw:global-syntax-environment id)))
+		(mw:warn "Redefining keyword" id))
+	    (mw:error "Malformed variable or keyword" id)))))
+    
+    ; body of letrec
+    
+    (define-loop exp '() '())))
+
+; Given an expression and a syntactic environment,
+; returns an expression in core Scheme.
+
+(define (mw:expand exp env)
+  (if (not (pair? exp))
+      (mw:atom exp env)
+      (let ((keyword (mw:syntax-lookup env (car exp))))
+	(case (mw:denote-class keyword)
+	  ((special)
+	   (cond
+	    ((eq? keyword mw:denote-of-quote)         (mw:quote exp))
+	    ((eq? keyword mw:denote-of-lambda)        (mw:lambda exp env))
+	    ((eq? keyword mw:denote-of-if)            (mw:if exp env))
+	    ((eq? keyword mw:denote-of-set!)          (mw:set exp env))
+	    ((eq? keyword mw:denote-of-begin)         (mw:begin exp env))
+	    ((eq? keyword mw:denote-of-let-syntax)    (mw:let-syntax exp env))
+	    ((eq? keyword mw:denote-of-letrec-syntax)
+	     (mw:letrec-syntax exp env))
+	    ; @@ let, let*, letrec, paint within quasiquotation -- kend
+	    ((eq? keyword mw:denote-of-let)           (mw:let    exp env))
+	    ((eq? keyword mw:denote-of-let*)          (mw:let*   exp env))
+	    ((eq? keyword mw:denote-of-letrec)        (mw:letrec exp env))
+	    ((eq? keyword mw:denote-of-quasiquote)    (mw:quasiquote exp env))
+	    ((eq? keyword mw:denote-of-do)            (mw:do     exp env))
+	    ((or (eq? keyword mw:denote-of-define)
+		 (eq? keyword mw:denote-of-define-syntax))
+	     ;; slight hack to allow expansion into defines -KenD
+	     (if mw:in-define? 
+	       (mw:error "Definition out of context" exp)
+	       (begin
+		 (set! mw:in-define? #t)
+		 (let ( (result (mw:desugar-definitions exp env)) )
+		   (set! mw:in-define? #f)
+		   result))
+	    ))
+	    (else (mw:bug "Bug detected in mw:expand" exp env))))
+	  ((macro) (mw:macro exp env))
+	  ((identifier) (mw:application exp env))
+	  (else (mw:bug "Bug detected in mw:expand" exp env))
+      ) )
+) )
+
+(define mw:in-define? #f)  ; should be fluid
+
+(define (mw:atom exp env)
+  (cond ((not (symbol? exp))
+	 ; Here exp ought to be a boolean, number, character, or string,
+	 ; but I'll allow for non-standard extensions by passing exp
+	 ; to the underlying Scheme system without further checking.
+	 exp)
+	(else (let ((denotation (mw:syntax-lookup env exp)))
+		(case (mw:denote-class denotation)
+		  ((special macro)
+		   (mw:error "Syntactic keyword used as a variable" exp env))
+		  ((identifier) (mw:identifier-name denotation))
+		  (else (mw:bug "Bug detected by mw:atom" exp env)))))))
+
+(define (mw:quote exp)
+  (if (= (mw:safe-length exp) 2)
+      (list mw:quote1 (mw:strip (cadr exp)))
+      (mw:error "Malformed quoted constant" exp)))
+
+(define (mw:lambda exp env)
+  (if (> (mw:safe-length exp) 2)
+      (let* ((formals (cadr exp))
+	     (alist (mw:rename-vars (mw:make-null-terminated formals)))
+	     (env (mw:syntax-rename env alist))
+	     (body (cddr exp)))
+	(list mw:lambda1
+	      (mw:rename-formals formals alist)
+	      (mw:body body env)))
+      (mw:error "Malformed lambda expression" exp)))
+
+(define (mw:body body env)
+  (define (loop body env defs)
+    (if (null? body)
+	(mw:error "Empty body"))
+    (let ((exp (car body)))
+      (if (and (pair? exp)
+	       (symbol? (car exp)))
+	  (let ((denotation (mw:syntax-lookup env (car exp))))
+	    (case (mw:denote-class denotation)
+	      ((special)
+	       (cond ((eq? denotation mw:denote-of-begin)
+		      (loop (append (cdr exp) (cdr body)) env defs))
+		     ((eq? denotation mw:denote-of-define)
+		      (loop (cdr body) env (cons exp defs)))
+		     (else (mw:finalize-body body env defs))))
+	      ((macro)
+	       (mw:transcribe exp
+			     env
+			     (lambda (exp env)
+			       (loop (cons exp (cdr body))
+				     env
+				     defs))))
+	      ((identifier)
+	       (mw:finalize-body body env defs))
+	      (else (mw:bug "Bug detected in mw:body" body env))))
+	  (mw:finalize-body body env defs))))
+  (loop body env '()))
+
+(define (mw:finalize-body body env defs)
+  (if (null? defs)
+      (let ((body (map (lambda (exp) (mw:expand exp env))
+		       body)))
+	(if (null? (cdr body))
+	    (car body)
+	    (cons mw:begin1 body)))
+      (let* ((alist (mw:rename-vars '(quote lambda set!)))
+	     (env (mw:syntax-alias env alist mw:standard-syntax-environment))
+	     (new-quote  (cdr (assq 'quote alist)))
+	     (new-lambda (cdr (assq 'lambda alist)))
+	     (new-set!   (cdr (assq 'set!   alist))))
+	(define (desugar-definition def)
+	  (if (> (mw:safe-length def) 2)
+	      (cond ((pair? (cadr def))
+		     (desugar-definition
+		      `(,(car def)
+			,(car (cadr def))
+			(,new-lambda
+			  ,(cdr (cadr def))
+			  ,@(cddr def)))))
+		    ((= (length def) 3)
+		     (cdr def))
+		    (else (mw:error "Malformed definition" def env)))
+	      (mw:error "Malformed definition" def env)))
+	(mw:letrec
+	 `(letrec ,(map desugar-definition (reverse defs)) ,@body)
+	  env)))
+  )
+
+(define (mw:if exp env)
+  (let ((n (mw:safe-length exp)))
+    (if (or (= n 3) (= n 4))
+	(cons mw:if1 (map (lambda (exp) (mw:expand exp env)) (cdr exp)))
+	(mw:error "Malformed if expression" exp env))))
+
+(define (mw:set exp env)
+  (if (= (mw:safe-length exp) 3)
+      `(,mw:set!1 ,(mw:expand (cadr exp) env) ,(mw:expand (caddr exp) env))
+      (mw:error "Malformed assignment" exp env)))
+
+(define (mw:begin exp env)
+  (if (positive? (mw:safe-length exp))
+      `(,mw:begin1 ,@(map (lambda (exp) (mw:expand exp env)) (cdr exp)))
+      (mw:error "Malformed begin expression" exp env)))
+
+(define (mw:application exp env)
+  (if (> (mw:safe-length exp) 0)
+      (map (lambda (exp) (mw:expand exp env))
+	   exp)
+      (mw:error "Malformed application")))
+
+; I think the environment argument should always be global here.
+
+(define (mw:define-syntax exp env)
+  (cond ((and (= (mw:safe-length exp) 3)
+	      (symbol? (cadr exp)))
+	 (mw:define-syntax1 (cadr exp)
+			   (caddr exp)
+			   env
+			   (mw:define-syntax-scope)))
+	((and (= (mw:safe-length exp) 4)
+	      (symbol? (cadr exp))
+	      (memq (caddr exp) '(letrec letrec* let*)))
+	 (mw:define-syntax1 (cadr exp)
+			   (cadddr exp)
+			   env
+			   (caddr exp)))
+	(else (mw:error "Malformed define-syntax" exp env))))
+
+(define (mw:define-syntax1 keyword spec env scope)
+  (case scope
+    ((letrec)  (mw:define-syntax-letrec keyword spec env))
+    ((letrec*) (mw:define-syntax-letrec* keyword spec env))
+    ((let*)    (mw:define-syntax-let* keyword spec env))
+    (else      (mw:bug "Weird scope" scope)))
+  (list mw:quote1 keyword))
+
+(define (mw:define-syntax-letrec keyword spec env)
+  (mw:syntax-bind-globally!
+   keyword
+   (mw:compile-transformer-spec spec env)))
+
+(define (mw:define-syntax-letrec* keyword spec env)
+  (let* ((env (mw:syntax-extend (mw:syntax-copy env)
+				(list keyword)
+				'((fake denotation))))
+	 (transformer (mw:compile-transformer-spec spec env)))
+    (mw:syntax-assign! env keyword transformer)
+    (mw:syntax-bind-globally! keyword transformer)))
+
+(define (mw:define-syntax-let* keyword spec env)
+  (mw:syntax-bind-globally!
+   keyword
+   (mw:compile-transformer-spec spec (mw:syntax-copy env))))
+
+(define (mw:let-syntax exp env)
+  (if (and (> (mw:safe-length exp) 2)
+	   (comlist:every (lambda (binding)
+		    (and (pair? binding)
+			 (symbol? (car binding))
+			 (pair? (cdr binding))
+			 (null? (cddr binding))))
+		    (cadr exp)))
+      (mw:body (cddr exp)
+	      (mw:syntax-extend env
+				(map car (cadr exp))
+				(map (lambda (spec)
+				       (mw:compile-transformer-spec
+					spec
+					env))
+				     (map cadr (cadr exp)))))
+      (mw:error "Malformed let-syntax" exp env)))
+
+(define (mw:letrec-syntax exp env)
+  (if (and (> (mw:safe-length exp) 2)
+	   (comlist:every (lambda (binding)
+		    (and (pair? binding)
+			 (symbol? (car binding))
+			 (pair? (cdr binding))
+			 (null? (cddr binding))))
+		    (cadr exp)))
+      (let ((env (mw:syntax-extend env
+				   (map car (cadr exp))
+				   (map (lambda (id)
+					  '(fake denotation))
+					(cadr exp)))))
+	(for-each (lambda (id spec)
+		    (mw:syntax-assign!
+		     env
+		     id
+		     (mw:compile-transformer-spec spec env)))
+		  (map car (cadr exp))
+		  (map cadr (cadr exp)))
+	(mw:body (cddr exp) env))
+      (mw:error "Malformed let-syntax" exp env)))
+
+(define (mw:macro exp env)
+  (mw:transcribe exp
+		env
+		(lambda (exp env)
+		  (mw:expand exp env))))
+
+; To do:
+; Clean up alist hacking et cetera.
+
+;;-----------------------------------------------------------------
+;; The following was added to allow expansion without flattening 
+;; LETs to LAMBDAs so that the origianl structure of the program 
+;; is preserved by macro expansion.  I.e. so that usual.scm is not 
+;; required. -- added KenD 
+
+(define (mw:process-let-bindings alist binding-list env)  ;; helper proc
+  (map (lambda (bind)
+	 (list (cdr (assq (car bind) alist)) ; renamed name
+	       (mw:body (cdr bind) env)))     ; alpha renamed value expression
+       binding-list)
+)
+
+(define (mw:strip-begin exp) ;; helper proc: mw:body sometimes puts one in
+  (if (and (pair? exp) (eq? (car exp) 'begin))
+    (cdr exp)
+    exp)
+)
+
+; LET
+(define (mw:let exp env)
+  (let* ( (name (if (or (pair? (cadr exp)) (null? (cadr exp)))
+		    #f 
+		    (cadr exp)))  ; named let?
+	  (binds (if name (caddr exp) (cadr exp)))
+	  (body  (if name (cdddr exp) (cddr exp)))
+	  (vars  (if (null? binds) #f (map car binds)))
+	  (alist (if vars (mw:rename-vars vars) #f))
+	  (newenv (if alist (mw:syntax-rename env alist) env))
+	)
+    (if name  ;; extend env with new name
+	(let ( (rename (mw:rename-vars (list name))) )
+	  (set! alist (append rename alist))
+	  (set! newenv (mw:syntax-rename newenv rename))
+    )   )
+    `(let
+	 ,@(if name (list (cdr (assq name alist))) '())
+	 ,(mw:process-let-bindings alist binds env)
+	 ,(mw:body body newenv))
+) )
+
+
+; LETREC differs from LET in that the binding values are processed in the
+; new rather than the original environment.
+
+(define (mw:letrec exp env)
+  (let* ( (binds (cadr exp))
+	  (body  (cddr exp))
+	  (vars  (if (null? binds) #f (map car binds)))
+	  (alist (if vars (mw:rename-vars vars) #f))
+	  (newenv (if alist (mw:syntax-rename env alist) env))
+	)
+    `(letrec
+	  ,(mw:process-let-bindings alist binds newenv)
+	  ,(mw:body body newenv))
+) )
+
+
+; LET* adds to ENV for each new binding.
+
+(define (mw:let* exp env)
+  (let ( (binds (cadr exp))
+	 (body  (cddr exp))
+       )
+    (let bind-loop ( (bindings binds) (newbinds '()) (newenv env) )
+       (if (null? bindings)
+	  `(let* ,(reverse newbinds) ,(mw:body body newenv))
+	   (let* ( (bind (car bindings))
+		   (var    (car bind)) 
+		   (valexp (cdr bind))
+		   (rename (mw:rename-vars (list var)))
+		   (next-newenv (mw:syntax-rename newenv rename))
+		 )
+	     (bind-loop (cdr bindings) 
+			(cons (list (cdr (assq var rename))
+				    (mw:body valexp newenv))
+			      newbinds)
+			next-newenv))
+) ) ) )
+
+
+; DO
+
+(define (mw:process-do-bindings var-init-steps alist oldenv newenv)  ;; helper proc
+  (map (lambda (vis)
+	 (let ( (v (car vis))
+		(i (cadr vis))
+		(s (if (null? (cddr vis)) (car vis) (caddr vis))))
+	   `( ,(cdr (assq v alist)) ; renamed name
+	      ,(mw:body (list i) oldenv)     ; init in outer/old env
+	      ,(mw:body (list s) newenv) ))) ; step in letrec/inner/new env
+       var-init-steps)
+)
+
+(define (mw:do exp env)
+  (let* ( (vis  (cadr exp))  ; (Var Init Step ...)
+	  (ts   (caddr exp)) ; (Test Sequence ...)
+	  (com  (cdddr exp)) ; (COMmand ...)
+	  (vars (if (null? vis) #f (map car vis)))
+	  (rename (if vars (mw:rename-vars vars) #f))
+	  (newenv (if vars (mw:syntax-rename env rename) env))
+	)
+    `(do ,(if vars (mw:process-do-bindings vis rename env newenv) '())
+	 ,(if  (null? ts)  '() (mw:strip-begin (mw:body (list ts) newenv)))
+	 ,@(if (null? com) '() (list (mw:body com newenv))))
+) )
+
+;
+; Quasiquotation (backquote)           
+;
+; At level 0, unquoted forms are left painted (not mw:strip'ed).
+; At higher levels, forms which are unquoted to level 0 are painted.
+; This includes forms within quotes.  E.g.:
+;   (lambda (a) 
+;     (quasiquote 
+;       (a (unquote a) b (quasiquote (a (unquote (unquote a)) b)))))
+;or equivalently:
+;  (lambda (a) `(a ,a b `(a ,,a b)))
+;=>
+;  (lambda (a|1) `(a ,a|1 b `(a ,,a|1 b)))
+
+(define (mw:quasiquote exp env)
+
+  (define (mw:atom exp env)
+    (if (not (symbol? exp))
+	exp
+	(let ((denotation (mw:syntax-lookup env exp)))
+	  (case (mw:denote-class denotation)
+	    ((special macro identifier) (mw:identifier-name denotation))
+	    (else (mw:bug "Bug detected by mw:atom" exp env))))
+  ) )
+
+  (define (quasi subexp level)
+     (cond
+	((null? subexp) subexp)
+	((not (or (pair? subexp) (vector? subexp)))
+	 (if (zero? level) (mw:atom subexp env) subexp) ; the work is here
+	)
+	((vector? subexp)
+	 (let* ((l (vector-length subexp))
+		(v (make-vector l)))
+	   (do ((i 0 (+ i 1)))
+	       ((= i l) v)
+	     (vector-set! v i (quasi (vector-ref subexp i) level))
+	     )
+	   )
+	 )
+	(else
+	  (let ( (keyword (mw:syntax-lookup env (car subexp))) )
+	    (cond
+	      ((eq? keyword mw:denote-of-unquote)
+	       (cons 'unquote (quasi (cdr subexp) (- level 1)))
+	      )
+	      ((eq? keyword mw:denote-of-unquote-splicing)
+	       (cons 'unquote-splicing (quasi (cdr subexp) (- level 1)))
+	      )
+	      ((eq? keyword mw:denote-of-quasiquote)
+	       (cons 'quasiquote (quasi (cdr subexp) (+ level 1)))
+	      )
+	      (else 
+	       (cons (quasi (car subexp) level) (quasi (cdr subexp) level)) 
+	      )
+	    )
+	) ) ; end else, let
+     ) ; end cond 
+  )
+
+  (quasi exp 0) ; need to unquote to level 0 to paint
+)
+
+;;                                      --- E O F ---
diff --git a/mwsynrul.scm b/mwsynrul.scm
new file mode 100644
index 0000000..1784441
--- /dev/null
+++ b/mwsynrul.scm
@@ -0,0 +1,343 @@
+; "mwsynrul.scm" Compiler for a <transformer spec>.
+; Copyright 1992 William Clinger
+;
+; Permission to copy this software, in whole or in part, to use this
+; software for any lawful purpose, and to redistribute this software
+; is granted subject to the restriction that all copies made of this
+; software must include this copyright notice in full.
+;
+; I also request that you send me a copy of any improvements that you
+; make to this software so that they may be incorporated within it to
+; the benefit of the Scheme community.
+
+;;;; Compiler for a <transformer spec>.
+
+;;; The input is a <transformer spec> and a syntactic environment.
+;;; Syntactic environments are described in another file.
+
+;;; Transormer specs are in slib.texi.
+
+(define mw:pattern-variable-flag (list 'v))
+(define mw:ellipsis-pattern-flag (list 'e))
+(define mw:ellipsis-template-flag mw:ellipsis-pattern-flag)
+
+(define (mw:make-patternvar v rank)
+  (vector mw:pattern-variable-flag v rank))
+(define (mw:make-ellipsis-pattern P vars)
+  (vector mw:ellipsis-pattern-flag P vars))
+(define (mw:make-ellipsis-template T vars)
+  (vector mw:ellipsis-template-flag T vars))
+
+(define (mw:patternvar? x)
+  (and (vector? x)
+       (= (vector-length x) 3)
+       (eq? (vector-ref x 0) mw:pattern-variable-flag)))
+
+(define (mw:ellipsis-pattern? x)
+  (and (vector? x)
+       (= (vector-length x) 3)
+       (eq? (vector-ref x 0) mw:ellipsis-pattern-flag)))
+
+(define (mw:ellipsis-template? x)
+  (and (vector? x)
+       (= (vector-length x) 3)
+       (eq? (vector-ref x 0) mw:ellipsis-template-flag)))
+
+(define (mw:patternvar-name V) (vector-ref V 1))
+(define (mw:patternvar-rank V) (vector-ref V 2))
+(define (mw:ellipsis-pattern P) (vector-ref P 1))
+(define (mw:ellipsis-pattern-vars P) (vector-ref P 2))
+(define (mw:ellipsis-template T) (vector-ref T 1))
+(define (mw:ellipsis-template-vars T) (vector-ref T 2))
+
+(define (mw:pattern-variable v vars)
+  (cond ((null? vars) #f)
+	((eq? v (mw:patternvar-name (car vars)))
+	 (car vars))
+	(else (mw:pattern-variable v (cdr vars)))))
+
+; Given a <transformer spec> and a syntactic environment,
+; returns a macro denotation.
+;
+; A macro denotation is of the form
+;
+;    (macro (<rule> ...) env)
+;
+; where each <rule> has been compiled as described above.
+
+(define (mw:compile-transformer-spec spec env)
+  (if (and (> (mw:safe-length spec) 1)
+	   (eq? (mw:syntax-lookup env (car spec))
+		mw:denote-of-syntax-rules))
+      (let ((literals (cadr spec))
+	    (rules (cddr spec)))
+	(if (or (not (list? literals))
+		(not (comlist:every (lambda (rule)
+			      (and (= (mw:safe-length rule) 2)
+				   (pair? (car rule))))
+			      rules)))
+	    (mw:error "Malformed syntax-rules" spec))
+	(list 'macro
+	      (map (lambda (rule)
+		     (mw:compile-rule rule literals env))
+		   rules)
+	      env))
+      (mw:error "Malformed syntax-rules" spec)))
+
+(define (mw:compile-rule rule literals env)
+  (mw:compile-pattern (cdr (car rule))
+		     literals
+		     env
+		     (lambda (compiled-rule patternvars)
+		       ; should check uniqueness of pattern variables here!!!!!
+		       (cons compiled-rule
+			     (mw:compile-template
+			      (cadr rule)
+			      patternvars
+			      env)))))
+
+(define (mw:compile-pattern P literals env k)
+  (define (loop P vars rank k)
+    (cond ((symbol? P)
+	   (if (memq P literals)
+	       (k P vars)
+	       (let ((var (mw:make-patternvar P rank)))
+		 (k var (cons var vars)))))
+	  ((null? P) (k '() vars))
+	  ((pair? P)
+	   (if (and (pair? (cdr P))
+		    (symbol? (cadr P))
+		    (eq? (mw:syntax-lookup env (cadr P))
+			 mw:denote-of-...))
+	       (if (null? (cddr P))
+		   (loop (car P)
+			 '()
+			 (+ rank 1)
+			 (lambda (P vars1)
+			   (k (mw:make-ellipsis-pattern P vars1)
+			      (comlist:union vars1 vars))))
+		   (mw:error "Malformed pattern" P))
+	       (loop (car P)
+		     vars
+		     rank
+		     (lambda (P1 vars)
+		       (loop (cdr P)
+			     vars
+			     rank
+			     (lambda (P2 vars)
+			       (k (cons P1 P2) vars)))))))
+	  ((vector? P)
+	   (loop (vector->list P)
+		 vars
+		 rank
+		 (lambda (P vars)
+		   (k (vector P) vars))))
+	  (else (k P vars))))
+  (loop P '() 0 k))
+
+(define (mw:compile-template T vars env)
+  
+  (define (loop T inserted referenced rank escaped? k)
+    (cond ((symbol? T)
+	   (let ((x (mw:pattern-variable T vars)))
+	     (if x
+		 (if (>= rank (mw:patternvar-rank x))
+		     (k x inserted (cons x referenced))
+		     (mw:error
+		      "Too few ellipses follow pattern variable in template"
+		      (mw:patternvar-name x)))
+		 (k T (cons T inserted) referenced))))
+	  ((null? T) (k '() inserted referenced))
+	  ((pair? T)
+	   (cond ((and (not escaped?)
+		       (symbol? (car T))
+		       (eq? (mw:syntax-lookup env (car T))
+			    mw:denote-of-:::)
+		       (pair? (cdr T))
+		       (null? (cddr T)))
+		  (loop (cadr T) inserted referenced rank #t k))
+		 ((and (not escaped?)
+		       (pair? (cdr T))
+		       (symbol? (cadr T))
+		       (eq? (mw:syntax-lookup env (cadr T))
+			    mw:denote-of-...))
+		  (loop1 T inserted referenced rank escaped? k))
+		 (else
+		  (loop (car T)
+			inserted
+			referenced
+			rank
+			escaped?
+			(lambda (T1 inserted referenced)
+			  (loop (cdr T)
+				inserted
+				referenced
+				rank
+				escaped?
+				(lambda (T2 inserted referenced)
+				  (k (cons T1 T2) inserted referenced))))))))
+	  ((vector? T)
+	   (loop (vector->list T)
+		 inserted
+		 referenced
+		 rank
+		 escaped?
+		 (lambda (T inserted referenced)
+		   (k (vector T) inserted referenced))))
+	  (else (k T inserted referenced))))
+  
+  (define (loop1 T inserted referenced rank escaped? k)
+    (loop (car T)
+	  inserted
+	  '()
+	  (+ rank 1)
+	  escaped?
+	  (lambda (T1 inserted referenced1)
+	    (loop (cddr T)
+		  inserted
+		  (append referenced1 referenced)
+		  rank
+		  escaped?
+		  (lambda (T2 inserted referenced)
+		    (k (cons (mw:make-ellipsis-template
+			      T1
+			      (comlist:remove-if-not
+			       (lambda (var) (> (mw:patternvar-rank var)
+						rank))
+			       referenced1))
+			     T2)
+		       inserted
+		       referenced))))))
+  
+  (loop T
+	'()
+	'()
+	0
+	#f
+	(lambda (T inserted referenced)
+	  (list T inserted))))
+
+; The pattern matcher.
+;
+; Given an input, a pattern, and two syntactic environments,
+; returns a pattern variable environment (represented as an alist)
+; if the input matches the pattern, otherwise returns #f.
+
+(define mw:empty-pattern-variable-environment
+  (list (mw:make-patternvar (string->symbol "") 0)))
+
+(define (mw:match F P env-def env-use)
+  
+  (define (match F P answer rank)
+    (cond ((null? P)
+	   (and (null? F) answer))
+	  ((pair? P)
+	   (and (pair? F)
+		(let ((answer (match (car F) (car P) answer rank)))
+		  (and answer (match (cdr F) (cdr P) answer rank)))))
+	  ((symbol? P)
+	   (and (symbol? F)
+		(mw:same-denotation? (mw:syntax-lookup env-def P)
+				     (mw:syntax-lookup env-use F))
+		answer))
+	  ((mw:patternvar? P)
+	   (cons (cons P F) answer))
+	  ((mw:ellipsis-pattern? P)
+	   (match1 F P answer (+ rank 1)))
+	  ((vector? P)
+	   (and (vector? F)
+		(match (vector->list F) (vector-ref P 0) answer rank)))
+	  (else (and (equal? F P) answer))))
+  
+  (define (match1 F P answer rank)
+    (cond ((not (list? F)) #f)
+	  ((null? F)
+	   (append (map (lambda (var) (cons var '()))
+			(mw:ellipsis-pattern-vars P))
+		   answer))
+	  (else
+	   (let* ((P1 (mw:ellipsis-pattern P))
+		  (answers (map (lambda (F) (match F P1 answer rank))
+				F)))
+	     (if (comlist:every identity answers)
+		 (append (map (lambda (var)
+				(cons var
+				      (map (lambda (answer)
+					     (cdr (assq var answer)))
+					   answers)))
+			      (mw:ellipsis-pattern-vars P))
+			 answer)
+		 #f)))))
+  
+  (match F P mw:empty-pattern-variable-environment 0))
+
+(define (mw:rewrite T alist)
+  
+  (define (rewrite T alist rank)
+    (cond ((null? T) '())
+	  ((pair? T)
+	   ((if (mw:ellipsis-pattern? (car T))
+		append
+		cons)
+	    (rewrite (car T) alist rank)
+	    (rewrite (cdr T) alist rank)))
+	  ((symbol? T) (cdr (assq T alist)))
+	  ((mw:patternvar? T) (cdr (assq T alist)))
+	  ((mw:ellipsis-template? T)
+	   (rewrite1 T alist (+ rank 1)))
+	  ((vector? T)
+	   (list->vector (rewrite (vector-ref T 0) alist rank)))
+	  (else T)))
+  
+  (define (rewrite1 T alist rank)
+    (let* ((T1 (mw:ellipsis-template T))
+	   (vars (mw:ellipsis-template-vars T))
+	   (rows (map (lambda (var) (cdr (assq var alist)))
+		      vars)))
+      (map (lambda (alist) (rewrite T1 alist rank))
+	   (make-columns vars rows alist))))
+  
+  (define (make-columns vars rows alist)
+    (define (loop rows)
+      (if (null? (car rows))
+	  '()
+	  (cons (append (map (lambda (var row)
+			       (cons var (car row)))
+			     vars
+			     rows)
+			alist)
+		(loop (map cdr rows)))))
+    (if (or (null? (cdr rows))
+	    (apply = (map length rows)))
+	(loop rows)
+	(mw:error "Use of macro is not consistent with definition"
+		 vars
+		 rows)))
+  
+  (rewrite T alist 0))
+
+; Given a use of a macro, the syntactic environment of the use,
+; and a continuation that expects a transcribed expression and
+; a new environment in which to continue expansion,
+; does the right thing.
+
+(define (mw:transcribe exp env-use k)
+  (let* ((m (mw:syntax-lookup env-use (car exp)))
+	 (rules (macwork:rules m))
+	 (env-def (macwork:env m))
+	 (F (cdr exp)))
+    (define (loop rules)
+      (if (null? rules)
+	  (mw:error "Use of macro does not match definition" exp)
+	  (let* ((rule (car rules))
+		 (pattern (car rule))
+		 (alist (mw:match F pattern env-def env-use)))
+	    (if alist
+		(let* ((template (cadr rule))
+		       (inserted (caddr rule))
+		       (alist2 (mw:rename-vars inserted))
+		       (newexp (mw:rewrite template (append alist2 alist))))
+		  (k newexp
+		     (mw:syntax-alias env-use alist2 env-def)))
+		(loop (cdr rules))))))
+    (loop rules)))
diff --git a/obj2str.scm b/obj2str.scm
new file mode 100644
index 0000000..19d8464
--- /dev/null
+++ b/obj2str.scm
@@ -0,0 +1,61 @@
+;;; "obj2str.scm", write objects to a string.
+;Copyright (C) 1993, 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'string-port)
+
+(define (object->string obj)
+  (cond ((symbol? obj) (symbol->string obj))
+	((number? obj) (number->string obj))
+	(else
+	 (call-with-output-string
+	  (lambda (port) (write obj port))))))
+
+; File: "obj2str.scm"   (c) 1991, Marc Feeley
+
+;(require 'generic-write)
+
+; (object->string obj) returns the textual representation of 'obj' as a
+; string.
+;
+; Note: (write obj) = (display (object->string obj))
+
+;(define (object->string obj)
+;  (let ((result '()))
+;    (generic-write obj #f #f (lambda (str) (set! result (cons str result)) #t))
+;    (reverse-string-append result)))
+
+; (object->limited-string obj limit) returns a string containing the first
+; 'limit' characters of the textual representation of 'obj'.
+
+(define (object->limited-string obj limit)
+  (require 'generic-write)
+  (let ((result '()) (left limit))
+    (generic-write obj #f #f
+		   (lambda (str)
+		     (let ((len (string-length str)))
+		       (if (> len left)
+			   (begin
+			     (set! result (cons (substring str 0 left) result))
+			     (set! left 0)
+			     #f)
+			   (begin
+			     (set! result (cons str result))
+			     (set! left (- left len))
+			     #t)))))
+    (reverse-string-append result)))
diff --git a/object.scm b/object.scm
new file mode 100644
index 0000000..4ba28fb
--- /dev/null
+++ b/object.scm
@@ -0,0 +1,97 @@
+;;; "object.scm" Macroless Object System
+;;;From: whumeniu@datap.ca (Wade Humeniuk)
+
+;;;Date:  February 15, 1994
+
+;; Object Construction:
+;;       0           1          2             3              4
+;; #(object-tag get-method make-method! unmake-method! get-all-methods)
+
+(define object:tag "object")
+
+;;; This might be better done using COMLIST:DELETE-IF.
+(define (object:removeq obj alist)
+  (if (null? alist)
+      alist
+      (if (eq? (caar alist) obj)
+	  (cdr alist)
+	  (cons (car alist) (object:removeq obj (cdr alist))))))
+
+(define (get-all-methods obj)
+  (if (object? obj)
+      ((vector-ref obj 4))
+      (slib:error "Cannot get methods on non-object: " obj)))
+
+(define (object? obj)
+  (and (vector? obj)
+       (eq? object:tag (vector-ref obj 0))))
+
+(define (make-method! obj generic-method method)
+  (if (object? obj)
+      (if (procedure? method)
+	  (begin
+	    ((vector-ref obj 2) generic-method method)
+	    method)
+	  (slib:error "Method must be a procedure: " method))
+      (slib:error "Cannot make method on non-object: " obj)))
+  
+(define (get-method obj generic-method)
+  (if (object? obj)
+      ((vector-ref obj 1) generic-method)
+      (slib:error "Cannot get method on non-object: " obj)))
+  
+(define (unmake-method! obj generic-method)
+  (if (object? obj)
+      ((vector-ref obj 3) generic-method)
+      (slib:error "Cannot unmake method on non-object: " obj)))
+  
+(define (make-predicate! obj generic-predicate)
+  (if (object? obj)
+      ((vector-ref obj 2) generic-predicate (lambda (self) #t))
+      (slib:error "Cannot make predicate on non-object: " obj)))
+
+(define (make-generic-method . exception-procedure)
+  (define generic-method
+    (lambda (obj . operands)
+      (if (object? obj)
+	  (let ((object-method ((vector-ref obj 1) generic-method)))
+	    (if object-method
+		(apply object-method (cons obj operands))
+		(slib:error "Method not supported: " obj)))
+	  (apply exception-procedure (cons obj operands)))))
+  
+  (if (not (null? exception-procedure))
+      (if (procedure? (car exception-procedure))
+	  (set! exception-procedure (car exception-procedure))
+	  (slib:error "Exception Handler Not Procedure:"))
+      (set! exception-procedure
+	    (lambda (obj . params) 
+	      (slib:error "Operation not supported: " obj))))
+  generic-method)
+  
+(define (make-generic-predicate)
+  (define generic-predicate 
+    (lambda (obj)
+      (if (object? obj)
+	  (if ((vector-ref obj 1) generic-predicate)
+	      #t 
+	      #f)
+	  #f)))
+  generic-predicate)
+  
+(define (make-object . ancestors)
+  (define method-list 
+    (apply append (map (lambda (obj) (get-all-methods obj)) ancestors)))
+  (define (make-method! generic-method method)
+    (set! method-list (cons (cons generic-method method) method-list))
+    method)
+  (define (unmake-method! generic-method) 
+    (set! method-list (object:removeq generic-method method-list))
+    #t)
+  (define (all-methods) method-list)
+  (define (get-method generic-method)
+    (let ((method-def (assq generic-method method-list)))
+      (if method-def (cdr method-def) #f)))
+  (vector object:tag get-method make-method! unmake-method! all-methods))
+
+
diff --git a/paramlst.scm b/paramlst.scm
new file mode 100644
index 0000000..f01788b
--- /dev/null
+++ b/paramlst.scm
@@ -0,0 +1,215 @@
+;;; "paramlst.scm" passing parameters by name.
+; Copyright 1995 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; Format of arity-spec: (name predicate conversion)
+
+(require 'common-list-functions)
+
+(define arity->arity-spec
+  (let ((table
+	 `((nary
+	    ,(lambda (a) #t)
+	    ,identity)
+	   (nary1
+	    ,(lambda (a) (not (null? a)))
+	    ,identity)
+	   (single
+	    ,(lambda (a) (and (pair? a) (null? (cdr a))))
+	    ,car)
+	   (optional
+	    ,(lambda (a) (or (null? a) (and (pair? a) (null? (cdr a)))))
+	    ,identity)
+	   (boolean
+	    ,(lambda (a)
+	       (or (null? a)
+		   (and (pair? a) (null? (cdr a)) (boolean? (car a)))))
+	    ,(lambda (a) (if (null? a) #f (car a)))))))
+    (lambda (arity)
+      (assq arity table))))
+
+(define (fill-empty-parameters defaults parameter-list)
+  (map (lambda (default parameter)
+	 (cond ((null? (cdr parameter))
+		(cons (car parameter)
+		      (if default (default parameter-list) '())))
+	       (else parameter)))
+       defaults parameter-list))
+
+(define (check-parameters checks parameter-list)
+  (for-each (lambda (check parameter)
+	      (for-each
+	       (lambda (p)
+		 (cond ((and check (not (check p)))
+			(slib:error (car parameter)
+				    "parameter is wrong type: " p))))
+	       (cdr parameter)))
+	    checks parameter-list)
+  parameter-list)
+
+(define (check-arities arity-specs parameter-list)
+  (and (every identity arity-specs)
+       (every
+	(lambda (arity-spec param)
+	  ((cadr arity-spec) (cdr param)))
+	arity-specs parameter-list)))
+
+(define (parameter-list->arglist positions arities parameter-list)
+  (and (= (length arities) (length positions) (length parameter-list))
+       (let ((arity-specs (map arity->arity-spec arities))
+	     (ans (make-vector (length positions) #f)))
+	 (and (check-arities arity-specs parameter-list)
+	      (for-each
+	       (lambda (pos arity-spec param)
+		 (vector-set! ans (+ -1 pos)
+			      ((caddr arity-spec) (cdr param))))
+	       positions arity-specs parameter-list)
+	      (vector->list ans)))))
+
+(define (make-parameter-list parameter-names)
+  (map list parameter-names))
+
+(define (parameter-list-ref parameter-list i)
+  (let ((ans (assoc i parameter-list)))
+    (and ans (cdr ans))))
+
+(define (parameter-list-expand expanders parms)
+  (do ((lens (map length parms) (map length parms))
+       (olens '() lens))
+      ((equal? lens olens))
+    (for-each (lambda (expander parm)
+		(cond
+		 (expander
+		  (for-each
+		   (lambda (news)
+		     (cond ((adjoin-parameters! parms news))
+			   (else (slib:error
+				  "expanded feature unknown: " news))))
+		   (apply append
+			  (map (lambda (p)
+				 (cond ((expander p))
+				       ((not '()) '())
+				       (else (slib:error
+					      "couldn't expand feature: " p))))
+			       (cdr parm)))))))
+	      expanders
+	      parms)))
+
+(define (adjoin-parameters! parameter-list . parameters)
+  (let ((apairs (map (lambda (param)
+		       (cond ((pair? param)
+			      (assoc (car param) parameter-list))
+			     (else (assoc param parameter-list))))
+		     parameters)))
+    (and (every identity apairs)	;same as APPLY AND?
+	 (for-each
+	  (lambda (apair param)
+	    (cond ((pair? param)
+		   (for-each (lambda (o)
+			       (if (not (member o (cdr apair)))
+				   (set-cdr! apair (cons o (cdr apair)))))
+			     (cdr param)))
+		  (else (if (not (memv #t (cdr apair)))
+			    (set-cdr! apair (cons #t (cdr apair)))))))
+	  apairs parameters)
+	 parameter-list)))
+
+(define (getopt->parameter-list argc argv optnames arities types aliases)
+  (define (can-take-arg? opt)
+    (not (eq? (list-ref arities (position opt optnames))
+	      'boolean)))
+  (define (coerce-val val curopt)
+    (define ntyp (list-ref types (position curopt optnames)))
+    (case ntyp
+      ((expression) val)
+      (else (coerce val ntyp))))
+  (require 'getopt)
+  (let ((optlist '())
+	(long-opt-list '())
+	(optstring #f)
+	(parameter-list (make-parameter-list optnames))
+	(curopt '*unclaimed-argument*))
+    (set! aliases (map (lambda (alias)
+			 (define str (string-copy (car alias)))
+			 (do ((i (+ -1 (string-length str)) (+ -1 i)))
+			     ((negative? i) (cons str (cdr alias)))
+			   (cond ((char=? #\ (string-ref str i))
+				  (string-set! str i #\-)))))
+		       aliases))
+    (for-each
+     (lambda (alias)
+       (define opt (car alias))
+       (cond ((not (string? opt)))
+	     ((< 1 (string-length opt))
+	      (set! long-opt-list (cons opt long-opt-list)))
+	     ((not (= 1 (string-length opt))))
+	     ((can-take-arg? (cadr alias))
+	      (set! optlist (cons (string-ref opt 0)
+				  (cons #\: optlist))))
+	     (else (set! optlist (cons (string-ref opt 0) optlist)))))
+     aliases)
+    (set! optstring (list->string (cons #\: optlist)))
+    (let loop ()
+      (let ((opt (getopt-- argc argv optstring)))
+	(case opt
+	  ((#\: #\?)
+	   (slib:error
+	    'getopt->parameter-list "unrecognized option"
+	    getopt:opt))
+	  ((#f)
+	   (cond ((and (< *optind* argc)
+		       (string=? "-" (list-ref argv *optind*)))
+		  (set! *optind* (+ 1 *optind*)))
+		 ((< *optind* argc)
+		  (cond ((and (member curopt optnames)
+			      (adjoin-parameters!
+			       parameter-list
+			       (list curopt
+				     (coerce-val (list-ref argv *optind*)
+						 curopt))))
+			 (set! *optind* (+ 1 *optind*))
+			 (loop))
+			(else (slib:error 'getopt->parameter-list curopt
+					  (list-ref argv *optind*)
+					  "not supported"))))))
+	  (else
+	   (cond ((char? opt) (set! opt (string opt))))
+	   (let ((topt (assoc opt aliases)))
+	     (cond (topt (set! topt (cadr topt)))
+		   (else (slib:error "Option not recognized -" opt)))
+	     (cond
+	      ((not (can-take-arg? topt))
+	       (adjoin-parameters! parameter-list (list topt #t)))
+	      (*optarg*
+	       (set! curopt topt)
+	       (adjoin-parameters! parameter-list
+				   (list topt (coerce-val *optarg* curopt))))
+	      (else
+	       (set! curopt topt)
+	       (rdms:warn
+		'getopt->parameter-list "argument missing for option--" opt))))
+	   (loop)))))
+    parameter-list))
+
+(define (getopt->arglist argc argv optnames positions
+			 arities types defaults checks aliases)
+  (let* ((params (getopt->parameter-list
+		  argc argv optnames arities types aliases))
+	 (fparams (fill-empty-parameters defaults params)))
+    (and (list? params) (check-parameters checks fparams))
+    (and (list? params) (parameter-list->arglist positions arities fparams))))
diff --git a/plottest.scm b/plottest.scm
new file mode 100644
index 0000000..20734f4
--- /dev/null
+++ b/plottest.scm
@@ -0,0 +1,47 @@
+;"plottest.scm" test charplot.scm
+;Copyright (C) 1992 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'charplot)
+(require 'random)
+
+(define strophoid
+  (let ((l '()))
+    (do ((x -1.0 (+ x 0.05)))
+	((> x 4.0))
+      (let* ((a (/ (- 2 x) (+ 2 x))))
+	(if (>= a 0.0)
+	    (let* ((y (* x (sqrt a))))
+	      (set! l (cons (cons x y) l))
+	      (set! l (cons (cons x (- y)) l))))))
+    l))
+
+(plot! strophoid "x" "y") (newline)
+
+(define unif
+  (let* ((l 6)
+	 (v (make-vector l)))
+    (do ((i (- l 1) (- i 1)))
+	((negative? i))
+      (vector-set! v i (cons i 0)))
+    (do ((i 24 (- i 1))
+	 (r (random l) (random l)))
+	((zero? i) (vector->list v))
+      (set-cdr! (vector-ref v r) (+ 1 (cdr (vector-ref v r)))))))
+
+(plot! unif "n" "occur")
diff --git a/pp.scm b/pp.scm
new file mode 100644
index 0000000..1dbada0
--- /dev/null
+++ b/pp.scm
@@ -0,0 +1,12 @@
+;"pp.scm" Pretty-print
+
+(require 'generic-write)
+
+; (pretty-print obj port) pretty prints 'obj' on 'port'.  The current
+; output port is used if 'port' is not specified.
+
+(define (pp:pretty-print obj . opt)
+  (let ((port (if (pair? opt) (car opt) (current-output-port))))
+    (generic-write obj #f 79 (lambda (s) (display s port) #t))))
+
+(define pretty-print pp:pretty-print)
diff --git a/ppfile.scm b/ppfile.scm
new file mode 100644
index 0000000..4b21b6e
--- /dev/null
+++ b/ppfile.scm
@@ -0,0 +1,70 @@
+;;;; "ppfile.scm".  Pretty print a Scheme file.
+;Copyright (C) 1993, 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'pretty-print)
+
+(define (pprint-filter-file inport filter . optarg)
+  ((lambda (fun)
+     (if (input-port? inport)
+	 (fun inport)
+	 (call-with-input-file inport fun)))
+   (lambda (port)
+     ((lambda (fun)
+	(let ((outport
+	       (if (null? optarg) (current-output-port) (car optarg))))
+	  (if (output-port? outport)
+	      (fun outport)
+	      (call-with-output-file outport fun))))
+      (lambda (export)
+	(let ((old-load-pathname *load-pathname*))
+	  (set! *load-pathname* inport)
+	  (letrec ((lp (lambda (c)
+			 (cond ((eof-object? c))
+			       ((char-whitespace? c)
+				(display (read-char port) export)
+				(lp (peek-char port)))
+			       ((char=? #\; c)
+				(cmt c))
+			       (else (sx)))))
+		   (cmt (lambda (c)
+			  (cond ((eof-object? c))
+				((char=? #\newline c)
+				 (display (read-char port) export)
+				 (lp (peek-char port)))
+				(else
+				 (display (read-char port) export)
+				 (cmt (peek-char port))))))
+		   (sx (lambda ()
+			 (let ((o (read port)))
+			   (cond ((eof-object? o))
+				 (else
+				  (pretty-print (filter o) export)
+				  ;; pretty-print seems to have extra newline
+				  (let ((c (peek-char port)))
+				    (cond ((eqv? #\newline c)
+					   (read-char port)
+					   (set! c (peek-char port))))
+				    (lp c))))))))
+	    (lp (peek-char port)))
+	  (set! *load-pathname* old-load-pathname)))))))
+
+(define (pprint-file ifile . optarg)
+  (pprint-filter-file ifile
+		      (lambda (x) x)
+		      (if (null? optarg) (current-output-port) (car optarg))))
diff --git a/primes.scm b/primes.scm
new file mode 100644
index 0000000..a27b240
--- /dev/null
+++ b/primes.scm
@@ -0,0 +1,181 @@
+;; "primes.scm", test and generate prime numbers.
+; Written by Michael H Coffin (mhc@edsdrd.eds.com)
+;
+; This code is in the public domain.
+
+;Date: Thu, 23 Feb 1995 07:47:49 +0500
+;From: mhc@edsdrd.eds.com (Michael H Coffin)
+;;
+;; Test numbers for primality using Rabin-Miller Monte-Carlo
+;; primality test.
+;;
+;; Public functions:
+;;
+;;    (primes start count . iter)
+;;
+;;    (probably-prime? p . iter)
+;;
+;;
+;; Please contact the author if you have problems or suggestions:
+;;
+;;      Mike Coffin
+;;      1196 Whispering Knoll
+;;      Rochester Hills, Mi. 48306
+;;
+;;      mhc@edsdrd.eds.com
+;;
+
+(require 'random)
+
+;; The default number of times to perform the Rabin-Miller test.  The
+;; probability of a composite number passing the Rabin-Miller test for
+;; primality with this many random numbers is at most
+;; 1/(4^primes:iterations).  The default yields about 1e-9.
+;;
+(define primes:iter 15)
+
+;; Is n probably prime?
+;;
+(define (primes:probably-prime? n . iter)
+  (let ((iter (if (null? iter) primes:iter (car iter))))
+    (primes:prob-pr? n iter)))
+
+
+;; Return a list of the first `number' odd probable primes less
+;; than `start'.
+
+(define (primes:primes< start number . iter)
+  (let ((iter (if (null? iter) primes:iter (car iter))))
+    (do ((candidate (if (odd? start) start (- start 1))
+		    (- candidate 2))
+	 (count 0)
+	 (result '())
+	 )
+	((or (< candidate 3) (>= count number)) result)
+      (if (primes:prob-pr? candidate iter)
+	  (begin
+	    (set! count (1+ count))
+	    (set! result (cons candidate result)))
+	  ))))
+
+(define (primes:primes> start number . iter)
+  (let ((iter (if (null? iter) primes:iter (car iter))))
+    (do ((candidate (if (odd? start) start (+ 1 start))
+                    (+ 2 candidate))
+         (count 0)
+         (result '())
+         )
+        ((= count number) (reverse result))
+      (if (primes:prob-pr? candidate iter)
+          (begin
+            (set! count (1+ count))
+            (set! result (cons candidate result)))
+          ))))
+
+
+;; Is n probably prime?  First we check for divisibility by small
+;; primes; if it passes that, and it's less than the maximum small
+;; prime squared, we try Rabin-Miller.
+;;
+(define (primes:prob-pr? n count)
+  (and (not (primes:dbsp? n))
+       (or (< n (* primes:max-small-prime primes:max-small-prime))
+	   (primes:rm-prime? n count))))
+
+
+;; Is `n' Divisible By a Small Prime?
+;;
+(define (primes:dbsp? n)
+  (let ((limit (min (sqrt n) primes:max-small-prime))
+	(divisible #f)
+	)
+    (do ((i 0 (1+ i)))
+	((let* ((divisor (array-ref primes:small-primes i)))
+	   (set! divisible (= (modulo n divisor) 0))
+	   (or divisible (>= divisor limit)))
+	 divisible)
+      )))
+
+
+;; Does `n' pass the R.-M. primality test for `m' random numbers?
+;;
+(define (primes:rm-prime? n m)
+  (do ((i 0 (1+ i))
+       (x (+ 2 (random (- n 2)))))
+      ((or (= i m) (primes:rm-composite? n x))
+       (= i m))))
+
+
+;; Does `x' prove `n' composite using Rabin-Miller?
+;;
+(define (primes:rm-composite? n x)
+  (let ((f (primes:extract2s (- n 1))))
+    (primes:rm-comp? n (cdr f) (car f) x)))
+
+
+;; Is `n' (where n-1 = 2^k * q) proven composite by `x'?
+;;
+(define (primes:rm-comp? n q k x)
+  (let ((y (primes:expt-mod x q n)))
+    (if (= y 1)
+	#f
+	(let loop ((j 0) (y y))
+	  (cond ((= j k) #t)
+		((= y (- n 1)) #f)
+		((= y 1) #t)
+		(else (loop (1+ j) (primes:expt-mod y 2 n)))
+		)))))
+
+
+;; Extract factors of 2; that is, factor x as 2^k * q
+;; and return (k . q)
+;;
+(define (primes:extract2s x)
+  (do ((k 0 (1+ k))
+       (q x (quotient q 2)))
+      ((odd? q) (cons k q))
+    ))
+
+
+;; Raise `base' to the power `exp' modulo `modulus' Could use the
+;; modulo package, but we only need this function (and besides, this
+;; implementation is quite a bit faster).
+;;
+(define (primes:expt-mod base exp modulus)
+  (do ((y 1)
+       (k exp (quotient k 2))
+       (z base (modulo (* z z) modulus)))
+      ((= k 0) y)
+    (if (odd? k)
+	(set! y (modulo (* y z) modulus)))
+    ))
+
+;; This table seems big enough so that making it larger really
+;; doesn't have much effect.
+;;
+(define primes:max-small-prime 997)
+
+(define primes:small-primes
+  #(  2   3   5   7  11  13  17  19  23  29
+     31  37  41  43  47  53  59  61  67  71
+     73  79  83  89  97 101 103 107 109 113
+    127 131 137 139 149 151 157 163 167 173
+    179 181 191 193 197 199 211 223 227 229
+    233 239 241 251 257 263 269 271 277 281
+    283 293 307 311 313 317 331 337 347 349
+    353 359 367 373 379 383 389 397 401 409
+    419 421 431 433 439 443 449 457 461 463
+    467 479 487 491 499 503 509 521 523 541
+    547 557 563 569 571 577 587 593 599 601
+    607 613 617 619 631 641 643 647 653 659
+    661 673 677 683 691 701 709 719 727 733
+    739 743 751 757 761 769 773 787 797 809
+    811 821 823 827 829 839 853 857 859 863
+    877 881 883 887 907 911 919 929 937 941
+    947 953 967 971 977 983 991 997 ))
+
+(define primes< primes:primes<)
+(define primes> primes:primes>)
+(define probably-prime? primes:probably-prime?)
+
+(provide 'primes)
diff --git a/printf.scm b/printf.scm
new file mode 100644
index 0000000..dffe90d
--- /dev/null
+++ b/printf.scm
@@ -0,0 +1,278 @@
+;;;; "printf.scm" Implementation of standard C functions for Scheme
+;;; Copyright (C) 1991-1993, 1996 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'string-case)
+
+;;; Floating point is not handled yet.
+
+(define (stdio:iprintf out-proc format-string . args)
+  (define char-count 0)
+  (define (out c)
+    (cond ((char? c) (set! char-count (+ 1 char-count)))
+	  (else (set! char-count (+ (string-length c) char-count))))
+    (out-proc c) #t)
+  (cond
+   ((not (equal? "" format-string))
+    (let ((pos -1)
+	  (fl (string-length format-string))
+	  (fc (string-ref format-string 0)))
+
+      (define (advance)
+	(set! pos (+ 1 pos))
+	(cond ((>= pos fl) (set! fc #f))
+	      (else (set! fc (string-ref format-string pos)))))
+      (define (must-advance)
+	(set! pos (+ 1 pos))
+	(cond ((>= pos fl) (incomplete))
+	      (else (set! fc (string-ref format-string pos)))))
+      (define (end-of-format?)
+	(>= pos fl))
+      (define (incomplete)
+	(slib:error 'printf "conversion specification incomplete"
+		    format-string))
+
+      (let loop ((args args))
+	(advance)
+	(cond
+	 ((end-of-format?))
+	 ((eqv? #\\ fc);;Emulating C strings may not be a good idea.
+	  (must-advance)
+	  (case fc
+	    ((#\n #\N) (out #\newline))
+	    ((#\t #\T) (out slib:tab))
+	    ((#\r #\R) (out #\return))
+	    ((#\f #\F) (out slib:form-feed))
+	    ((#\newline) #f)
+	    (else (out fc)))
+	  (loop args))
+	 ((eqv? #\% fc)
+	  (must-advance)
+	  (let ((left-adjust #f)	;-
+		(signed #f)		;+
+		(blank #f)
+		(alternate-form #f)	;#
+		(leading-0s #f)		;0
+		(width 0)
+		(precision -1)
+		(type-modifier #f)
+		(read-format-number
+		 (lambda ()
+		   (cond
+		    ((eqv? #\* fc)	; GNU extension
+		     (must-advance)
+		     (let ((ans (car args)))
+		       (set! args (cdr args))
+		       ans))
+		    (else
+		     (do ((c fc fc)
+			  (accum 0 (+ (* accum 10)
+				      (string->number (string c)))))
+			 ((not (char-numeric? fc)) accum)
+		       (must-advance)))))))
+	    (define integer-pad
+	      (lambda (s radix)
+		(cond ((not (negative? precision))
+		       (set! leading-0s #f)))
+		(let* ((pre
+			(cond ((equal? "" s) "")
+			      ((eqv? #\- (string-ref s 0))
+			       (set! s (substring s 1 (string-length s)))
+			       "-")
+			      (signed "+")
+			      (blank " ")
+			      ((equal? "" s) "")
+			      (alternate-form
+			       (case radix
+				 ((8) "0")
+				 ((16) "0x")
+				 (else "")))
+			      (else "")))
+		       (length-so-far (+ (string-length pre)
+					 (string-length s))))
+		  (cond ((<= width length-so-far)
+			 (string-append pre s))
+			(left-adjust
+			 (string-append
+			  pre s
+			  (make-string (- width length-so-far) #\ )))
+			(leading-0s
+			 (string-append
+			  pre (make-string (- width length-so-far) #\0)
+			  s))
+			(else
+			 (string-append
+			  (make-string (- width length-so-far) #\ )
+			  pre s))))))
+
+	    (do ()
+		((case fc
+		   ((#\-) (set! left-adjust #t) #f)
+		   ((#\+) (set! signed #t) #f)
+		   ((#\ ) (set! blank #t) #f)
+		   ((#\#) (set! alternate-form #t) #f)
+		   ((#\0) (set! leading-0s #t) #f)
+		   (else #t)))
+	      (must-advance))
+	    (cond (left-adjust (set! leading-0s #f)))
+	    (cond (signed (set! blank #f)))
+
+	    (set! width (read-format-number))
+	    (cond ((negative? width)
+		   (set! left-adjust #t)
+		   (set! width (- width))))
+	    (cond ((eqv? #\. fc)
+		   (must-advance)
+		   (set! precision (read-format-number))))
+	    (case fc			;Ignore these specifiers
+	      ((#\l #\L #\h)
+	       (set! type-modifier fc)
+	       (must-advance)))
+
+	    (case fc
+	      ;; only - is allowed between % and c
+	      ((#\c #\C)		; C is enhancement
+	       (out (string (car args)))
+	       (loop (cdr args)))
+
+	      ;; only - flag, no type-modifiers
+	      ((#\s #\S)		; S is enhancement
+	       (let ((s (cond
+			 ((symbol? (car args)) (symbol->string (car args)))
+			 ((not (car args)) "(NULL)")
+			 (else (car args)))))
+		 (cond ((not (or (negative? precision)
+				 (>= precision (string-length s))))
+			(set! s (substring s 0 precision))))
+		 (out
+		  (cond
+		   ((<= width (string-length s)) s)
+		   (left-adjust
+		    (string-append
+		     s (make-string (- width (string-length s)) #\ )))
+		   (else
+		    (string-append (make-string (- width (string-length s))
+						(if leading-0s #\0 #\ )) s))))
+		 (loop (cdr args))))
+
+	      ;; SLIB extension
+	      ((#\a #\A)		;#\y #\Y are pretty-print
+	       (require 'generic-write)
+	       (let ((os "") (pr precision))
+		 (generic-write
+		  (car args) (not alternate-form) #f
+		  (cond ((and left-adjust (negative? pr))
+			 out)
+			(left-adjust
+			 (lambda (s)
+			   (define sl (- pr (string-length s)))
+			   (set! pr (cond ((negative? sl)
+					   (out (substring s 0 pr)) 0)
+					  (else (out s) sl)))
+			   (positive? sl)))
+			((negative? pr)
+			 (set! pr width)
+			 (lambda (s)
+			   (set! pr (- pr (string-length s)))
+			   (cond ((not os) (out s))
+				 ((negative? pr)
+				  (out os)
+				  (set! os #f)
+				  (out s))
+				 (else (set! os (string-append os s))))
+			   #t))
+			(else
+			 (lambda (s)
+			   (define sl (- pr (string-length s)))
+			   (cond ((negative? sl)
+				  (set! os (string-append
+					    os (substring s 0 pr))))
+				 (else (set! os (string-append os s))))
+			   (set! pr sl)
+			   (positive? sl)))))
+		 (cond (left-adjust
+			(cond
+			 ((> width (- precision pr))
+			  (out (make-string (- width (- precision pr))
+					    #\ )))))
+		       ((not os))
+		       ((<= width (string-length os)) (out os))
+		       (else
+			(out (make-string (- width (string-length os)) #\ ))
+			(out os))))
+	       (loop (cdr args)))
+
+	      ((#\d #\D #\i #\I #\u #\U)
+	       (out (integer-pad
+		     (cond ((symbol? (car args))
+			    (symbol->string (car args)))
+			   ((number? (car args))
+			    (number->string (car args)))
+			   ((not (car args)) "0")
+			   (else "1"))
+		     10))
+	       (loop (cdr args)))
+	      ((#\o #\O)
+	       (out (integer-pad (number->string (car args) 8) 8))
+	       (loop (cdr args)))
+	      ((#\x #\X)
+	       (out
+		((if (char-upper-case? fc) string-upcase string-downcase)
+		 (integer-pad (number->string (car args) 16) 16)))
+	       (loop (cdr args)))
+	      ((#\%) (out #\%)
+		     (loop args))
+	      (else
+	       (cond ((end-of-format?) (incomplete))
+		     (else (out #\%) (out fc) (out #\?)
+			   (loop args)))))))
+	 (else (out fc)
+	       (loop args)))))))
+  char-count)				; return number of characters output.
+
+(define (stdio:printf format . args)
+  (apply stdio:iprintf display format args))
+
+(define (stdio:fprintf port format . args)
+  (if (equal? port (current-output-port))
+      (apply stdio:iprintf display format args)
+      (apply stdio:iprintf (lambda (x) (display x port)) format args)))
+
+(define (stdio:sprintf s format . args)
+  (let ((p 0) (end (string-length s)))
+    (apply stdio:iprintf
+	   (lambda (x)
+	     (cond ((string? x)
+		    (do ((i 0 (+ i 1)))
+			((>= i (min (string-length x) end)))
+		      (string-set! s p (string-ref x i))
+		      (set! p (+ p 1))))
+		   ((>= p end))
+		   ((char? x)
+		    (string-set! s p x)
+		    (set! p (+ p 1)))
+		   (else
+		    (string-set! s p #\?)
+		    (set! p (+ p 1)))))
+	   format
+	   args)
+    p))
+
+(define printf stdio:printf)
+(define fprintf stdio:fprintf)
+(define sprintf stdio:sprintf)
diff --git a/priorque.scm b/priorque.scm
new file mode 100644
index 0000000..927ffbe
--- /dev/null
+++ b/priorque.scm
@@ -0,0 +1,141 @@
+;;;; "priorque.scm" priority queues for Scheme.
+;;; Copyright (C) 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; Algorithm from:
+;;; Introduction to Algorithms by T. Cormen, C. Leiserson, R. Rivest.
+;;; 1989 MIT Press.
+
+(require 'record)
+
+;; Record type.
+(define heap:rtd (make-record-type "heap" '(array size heap<?)))
+
+;; Constructor.
+(define heap:make-heap
+  (let ((cstr (record-constructor heap:rtd)))
+    (lambda (pred<?)
+      (cstr (make-vector 4) 0 pred<?))))
+
+;; Reference an element.
+(define heap:ref
+  (let ((ra (record-accessor heap:rtd 'array)))
+    (lambda (a i)
+      (vector-ref (ra a) (+ -1 i)))))
+
+;; Set an element.
+(define heap:set!
+  (let ((ra (record-accessor heap:rtd 'array)))
+    (lambda (a i v)
+      (vector-set! (ra a) (+ -1 i) v))))
+
+;; Exchange two elements.
+(define heap:exchange
+  (let ((aa (record-accessor heap:rtd 'array)))
+    (lambda (a i j)
+      (set! i (+ -1 i))
+      (set! j (+ -1 j))
+      (let* ((ra (aa a))
+	     (tmp (vector-ref ra i)))
+	(vector-set! ra i (vector-ref ra j))
+	(vector-set! ra j tmp)))))
+
+
+;; Get length.
+(define heap:length (record-accessor heap:rtd 'size))
+
+(define heap:heap<? (record-accessor heap:rtd 'heap<?))
+
+(define heap:set-size!
+  (let ((aa (record-accessor heap:rtd 'array))
+	(am (record-modifier heap:rtd 'array))
+	(sm (record-modifier heap:rtd 'size)))
+    (lambda (a s)
+      (let ((ra (aa a)))
+	(if (> s (vector-length ra))
+	    (let ((nra (make-vector (+ s (quotient s 2)))))
+	      (do ((i (+ -1 (vector-length ra)) (+ -1 i)))
+		  ((negative? i) (am a nra))
+		(vector-set! nra i (vector-ref ra i)))))
+	(sm a s)))))
+
+(define (heap:parent i) (quotient i 2))
+(define (heap:left i) (* 2 i))
+(define (heap:right i) (+ 1 (* 2 i)))
+
+(define (heap:heapify a i)
+  (let* ((l (heap:left i))
+	 (r (heap:right i))
+	 (largest (if (and (<= l (heap:length a))
+			   ((heap:heap<? a) (heap:ref a i) (heap:ref a l)))
+		      l
+		      i)))
+    (cond ((and (<= r (heap:length a))
+		((heap:heap<? a) (heap:ref a largest) (heap:ref a r)))
+	   (set! largest r)))
+    (cond ((not (= largest i))
+	   (heap:exchange a i largest)
+	   (heap:heapify a largest)))))
+
+(define (heap:insert! a key)
+  (define i (+ 1 (heap:length a)))
+  (heap:set-size! a i)
+  (do ()
+      ((not (and (> i 1)
+		 ((heap:heap<? a) (heap:ref a (heap:parent i)) key))))
+    (heap:set! a i (heap:ref a (heap:parent i)))
+    (set! i (heap:parent i)))
+  (heap:set! a i key))
+
+(define (heap:extract-max! a)
+  (if (< (heap:length a) 1)
+      (slib:error "heap underflow" a))
+  (let ((max (heap:ref a 1)))
+    (heap:set! a 1 (heap:ref a (heap:length a)))
+    (heap:set-size! a (+ -1 (heap:length a)))
+    (heap:heapify a 1)
+    max))
+
+;;
+;; Externals.
+;;
+(define make-heap heap:make-heap)
+(define heap-insert! heap:insert!)
+(define heap-extract-max! heap:extract-max!)
+(define heap-length heap:length)
+
+(define (heap:test)
+  (require 'debug)
+  (let ((heap #f))
+    (set! heap (make-heap char>?))
+    (heap-insert! heap #\A)
+    (heap-insert! heap #\Z)
+    (heap-insert! heap #\G)
+    (heap-insert! heap #\B)
+    (heap-insert! heap #\G)
+    (heap-insert! heap #\Q)
+    (heap-insert! heap #\S)
+    (heap-insert! heap #\R)
+    (print (heap-extract-max! heap))
+    (print (heap-extract-max! heap))
+    (print (heap-extract-max! heap))
+    (print (heap-extract-max! heap))
+    (print (heap-extract-max! heap))
+    (print (heap-extract-max! heap))
+    (print (heap-extract-max! heap))
+    (print (heap-extract-max! heap))))
diff --git a/process.scm b/process.scm
new file mode 100644
index 0000000..6b0acc3
--- /dev/null
+++ b/process.scm
@@ -0,0 +1,68 @@
+;;;; "process.scm",  Multi-Processing for Scheme
+;;; Copyright (C) 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'full-continuation)
+(require 'queue)
+
+(define (add-process! thunk1)
+  (cond ((procedure? thunk1)
+	 (defer-ints)
+	 (enqueue! process:queue thunk1)
+	 (allow-ints))
+	(else (slib:error "add-process!: wrong type argument " thunk1))))
+
+(define (process:schedule!)
+  (defer-ints)
+  (cond ((queue-empty? process:queue) (allow-ints)
+				      'still-running)
+	(else (call-with-current-continuation
+	       (lambda (cont)
+		 (enqueue! process:queue cont)
+		 (let ((proc (dequeue! process:queue)))
+		   (allow-ints)
+		   (proc 'run))
+		 (kill-process!))))))
+
+(define (kill-process!)
+  (defer-ints)
+  (cond ((queue-empty? process:queue) (allow-ints)
+				      (slib:exit))
+	(else (let ((proc (dequeue! process:queue)))
+		(allow-ints)
+		(proc 'run))
+	      (kill-process!))))
+
+(define ints-disabled #f)
+(define alarm-deferred #f)
+
+(define (defer-ints) (set! ints-disabled #t))
+
+(define (allow-ints)
+  (set! ints-disabled #f)
+  (cond (alarm-deferred
+	  (set! alarm-deferred #f)
+	  (alarm-interrupt))))
+
+;;; Make THE process queue.
+(define process:queue (make-queue))
+
+(define (alarm-interrupt)
+  (alarm 1)
+  (if ints-disabled (set! alarm-deferred #t)
+      (process:schedule!)))
diff --git a/promise.scm b/promise.scm
new file mode 100644
index 0000000..f38aebf
--- /dev/null
+++ b/promise.scm
@@ -0,0 +1,29 @@
+;;;"promise.scm" promise for force and delay
+;;; From Revised^4 Report on the Algorithmic Language Scheme
+;;; Editors: William Clinger and Jonathon Rees
+;
+; We intend this report to belong to the entire Scheme community, and so
+; we grant permission to copy it in whole or in part without fee.  In
+; particular, we encourage implementors of Scheme to use this report as
+; a starting point for manuals and other documentation, modifying it as
+; necessary.
+
+(define promise:force (lambda (object) (object)))
+
+(define make-promise
+  (lambda (proc)
+    (let ((result-ready? #f)
+	  (result #f))
+      (lambda ()
+	(if result-ready?
+	    result
+	    (let ((x (proc)))
+	      (if result-ready?
+		  result
+		  (begin (set! result-ready? #t)
+			 (set! result x)
+			 result))))))))
+
+;;; change occurences of (DELAY <expression>) to
+;;; (MAKE-PROMISE (LAMBDA () <expression>))
+;;; and (define force promise:force)
diff --git a/qp.scm b/qp.scm
new file mode 100644
index 0000000..3eed54d
--- /dev/null
+++ b/qp.scm
@@ -0,0 +1,149 @@
+;;;; "qp.scm" Print finite length representation for any Scheme object.
+;;; Copyright (C) 1991, 1992, 1993, 1995 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define *qp-width* (output-port-width (current-output-port)))
+
+(define qp:qpn
+  (let ((newline newline) (apply apply))
+    (lambda objs (apply qp:qp objs) (newline))))
+
+(define qp:qpr
+  (let ((- -) (apply apply) (length length) (list-ref list-ref))
+    (lambda objs (apply qp:qpn objs)
+	    (list-ref objs (- (length objs) 1)))))
+
+(define qp:qp
+  (let
+      ((+ +) (- -) (< <) (= =) (>= >=) (apply apply) (boolean? boolean?)
+       (car car) (cdr cdr) (char? char?) (display display) (eq? eq?)
+       (for-each for-each) (input-port? input-port?)
+       (not not) (null? null?) (number->string number->string)
+       (number? number?) (output-port? output-port?) (eof-object? eof-object?)
+       (procedure? procedure?) (string-length string-length)
+       (string? string?) (substring substring)
+       (symbol->string symbol->string) (symbol? symbol?)
+       (vector-length vector-length) (vector-ref vector-ref)
+       (vector? vector?) (write write) (quotient quotient))
+    (letrec
+	((num-cdrs
+	  (lambda (pairs max-cdrs)
+	    (cond
+	     ((null? pairs) 0)
+	     ((< max-cdrs 1) 1)
+	     ((pair? pairs) (+ 1 (num-cdrs (cdr pairs) (- max-cdrs 1))))
+	     (else 1))))
+
+	 (l-elt-room
+	  (lambda (room pairs)
+	    (quotient room (num-cdrs pairs (quotient room 8)))))
+
+	 (qp-pairs
+	  (lambda (cdrs room)
+	    (cond
+	     ((null? cdrs) 0)
+	     ((not (pair? cdrs))
+	      (display " . ")
+	      (+ 3 (qp-obj cdrs (l-elt-room (- room 3) cdrs))))
+	     ((< 11 room)
+	      (display #\ )
+	      ((lambda (used)
+		 (+ (qp-pairs (cdr cdrs) (- room used)) used))
+	       (+ 1 (qp-obj (car cdrs) (l-elt-room (- room 1) cdrs)))))
+	     (else
+	      (display " ...") 4))))
+
+	 (v-elt-room
+	  (lambda (room vleft)
+	    (quotient room (min vleft (quotient room 8)))))
+
+	 (qp-vect
+	  (lambda (vect i room)
+	    (cond
+	     ((= (vector-length vect) i) 0)
+	     ((< 11 room)
+	      (display #\ )
+	      ((lambda (used)
+		 (+ (qp-vect vect (+ i 1) (- room used)) used))
+	       (+ 1 (qp-obj (vector-ref vect i)
+			    (v-elt-room (- room 1)
+					(- (vector-length vect) i))))))
+	     (else
+	      (display " ...") 4))))
+
+	 (qp-string
+	  (lambda (str room)
+	    (cond
+	     ((>= (string-length str) room 3)
+	      (display (substring str 0 (- room 3)))
+	      (display "...")
+	      room)
+	     (else
+	      (display str)
+	      (string-length str)))))
+
+	 (qp-obj
+	  (lambda (obj room)
+	    (cond
+	     ((null? obj) (write obj) 2)
+	     ((boolean? obj) (write obj) 2)
+	     ((char? obj) (write obj) 8)
+	     ((number? obj) (qp-string (number->string obj) room))
+	     ((string? obj)
+	      (display #\")
+	      ((lambda (ans) (display #\") ans)
+	       (+ 2 (qp-string obj (- room 2)))))
+	     ((symbol? obj) (qp-string (symbol->string obj) room))
+	     ((input-port? obj) (display "#[input]") 8)
+	     ((output-port? obj) (display "#[output]") 9)
+	     ((procedure? obj) (display "#[proc]") 7)
+	     ((eof-object? obj) (display "#[eof]") 6)
+	     ((vector? obj)
+	      (set! room (- room 3))
+	      (display "#(")
+	      ((lambda (used) (display #\)) (+ used 3))
+	       (cond
+		((= 0 (vector-length obj)) 0)
+		((< room 8) (display "...") 3)
+		(else
+		 ((lambda (used) (+ (qp-vect obj 1 (- room used)) used))
+		  (qp-obj (vector-ref obj 0)
+			  (v-elt-room room (vector-length obj))))))))
+	     ((pair? obj)
+	      (set! room (- room 2))
+	      (display #\()
+	      ((lambda (used) (display #\)) (+ 2 used))
+	       (if (< room 8) (begin (display "...") 3)
+		   ((lambda (used)
+		      (+ (qp-pairs (cdr obj) (- room used)) used))
+		    (qp-obj (car obj) (l-elt-room room obj))))))
+	     (else (display "#[unknown]") 10)))))
+
+      (lambda objs
+	(cond
+	 ((= 0 *qp-width*)
+	  (for-each (lambda (x) (write x) (display #\ )) objs)
+	  (newline))
+	 (else
+	  (qp-pairs (cdr objs)
+		    (- *qp-width*
+		       (qp-obj (car objs) (l-elt-room *qp-width* objs))))))))))
+
+(define qp qp:qp)
+(define qpn qp:qpn)
+(define qpr qp:qpr)
diff --git a/queue.scm b/queue.scm
new file mode 100644
index 0000000..4557746
--- /dev/null
+++ b/queue.scm
@@ -0,0 +1,72 @@
+; "queue.scm"  Queues/Stacks for Scheme
+; Written by Andrew Wilcox (awilcox@astro.psu.edu) on April 1, 1992.
+;
+; This code is in the public domain.
+
+(require 'record)
+
+; Elements in a queue are stored in a list.  The last pair in the list
+; is stored in the queue type so that datums can be added in constant
+; time.
+
+(define queue:record-type
+  (make-record-type "queue" '(first-pair last-pair)))
+(define make-queue
+  (let ((construct-queue (record-constructor queue:record-type)))
+    (lambda ()
+      (construct-queue '() '()))))
+
+(define queue? (record-predicate queue:record-type))
+
+(define queue:first-pair (record-accessor queue:record-type
+					  'first-pair))
+(define queue:set-first-pair! (record-modifier queue:record-type
+					       'first-pair))
+(define queue:last-pair (record-accessor queue:record-type
+					 'last-pair))
+(define queue:set-last-pair! (record-modifier queue:record-type
+					      'last-pair))
+
+(define (queue-empty? q)
+  (null? (queue:first-pair q)))
+
+(define (queue-front q)
+  (let ((first-pair (queue:first-pair q)))
+    (if (null? first-pair)
+	(slib:error "queue is empty" q))
+    (car first-pair)))
+
+(define (queue-rear q)
+  (let ((last-pair (queue:last-pair q)))
+    (if (null? last-pair)
+	(slib:error "queue is empty" q))
+    (car last-pair)))
+
+(define (queue-push! q datum)
+  (let* ((old-first-pair (queue:first-pair q))
+	 (new-first-pair (cons datum old-first-pair)))
+    (queue:set-first-pair! q new-first-pair)
+    (if (null? old-first-pair)
+	(queue:set-last-pair! q new-first-pair)))
+  q)
+    
+(define (enqueue! q datum)
+  (let ((new-pair (cons datum '())))
+    (cond ((null? (queue:first-pair q))
+	   (queue:set-first-pair! q new-pair))
+	  (else
+	   (set-cdr! (queue:last-pair q) new-pair)))
+    (queue:set-last-pair! q new-pair))
+  q)
+
+(define (dequeue! q)
+  (let ((first-pair (queue:first-pair q)))
+    (if (null? first-pair)
+	(slib:error "queue is empty" q))
+    (let ((first-cdr (cdr first-pair)))
+      (queue:set-first-pair! q first-cdr)
+      (if (null? first-cdr)
+	  (queue:set-last-pair! q '()))
+      (car first-pair))))
+
+(define queue-pop! dequeue!)
diff --git a/r4rsyn.scm b/r4rsyn.scm
new file mode 100644
index 0000000..500d68c
--- /dev/null
+++ b/r4rsyn.scm
@@ -0,0 +1,542 @@
+;;; "r4rsyn.scm" R4RS syntax		-*-Scheme-*-
+;;; Copyright (c) 1989-91 Massachusetts Institute of Technology
+;;;
+;;; This material was developed by the Scheme project at the
+;;; Massachusetts Institute of Technology, Department of Electrical
+;;; Engineering and Computer Science.  Permission to copy this
+;;; software, to redistribute it, and to use it for any purpose is
+;;; granted, subject to the following restrictions and understandings.
+;;;
+;;; 1. Any copy made of this software must include this copyright
+;;; notice in full.
+;;;
+;;; 2. Users of this software agree to make their best efforts (a) to
+;;; return to the MIT Scheme project any improvements or extensions
+;;; that they make, so that these may be included in future releases;
+;;; and (b) to inform MIT of noteworthy uses of this software.
+;;;
+;;; 3. All materials developed as a consequence of the use of this
+;;; software shall duly acknowledge such use, in accordance with the
+;;; usual standards of acknowledging credit in academic research.
+;;;
+;;; 4. MIT has made no warrantee or representation that the operation
+;;; of this software will be error-free, and MIT is under no
+;;; obligation to provide any services, by way of maintenance, update,
+;;; or otherwise.
+;;;
+;;; 5. In conjunction with products arising from the use of this
+;;; material, there shall be no use of the name of the Massachusetts
+;;; Institute of Technology nor of any adaptation thereof in any
+;;; advertising, promotional, or sales literature without prior
+;;; written consent from MIT in each case.
+
+;;;; R4RS Syntax
+
+(define scheme-syntactic-environment #f)
+
+(define (initialize-scheme-syntactic-environment!)
+  (set! scheme-syntactic-environment
+	((compose-macrologies
+	  (make-core-primitive-macrology)
+	  (make-binding-macrology syntactic-binding-theory
+				  'LET-SYNTAX 'LETREC-SYNTAX 'DEFINE-SYNTAX)
+	  (make-binding-macrology variable-binding-theory
+				  'LET 'LETREC 'DEFINE)
+	  (make-r4rs-primitive-macrology)
+	  (make-core-expander-macrology)
+	  (make-syntax-rules-macrology))
+	 root-syntactic-environment)))
+
+;;;; Core Primitives
+
+(define (make-core-primitive-macrology)
+  (make-primitive-macrology
+   (lambda (define-classifier define-compiler)
+
+     (define-classifier 'BEGIN
+       (lambda (form environment definition-environment)
+	 (syntax-check '(KEYWORD * FORM) form)
+	 (make-body-item (classify/subforms (cdr form)
+					    environment
+					    definition-environment))))
+
+     (define-compiler 'DELAY
+       (lambda (form environment)
+	 (syntax-check '(KEYWORD EXPRESSION) form)
+	 (output/delay
+	  (compile/subexpression (cadr form)
+				 environment))))
+
+     (define-compiler 'IF
+       (lambda (form environment)
+	 (syntax-check '(KEYWORD EXPRESSION EXPRESSION ? EXPRESSION) form)
+	 (output/conditional
+	  (compile/subexpression (cadr form) environment)
+	  (compile/subexpression (caddr form) environment)
+	  (if (null? (cdddr form))
+	      (output/unspecific)
+	      (compile/subexpression (cadddr form)
+				     environment)))))
+
+     (define-compiler 'QUOTE
+       (lambda (form environment)
+	 environment			;ignore
+	 (syntax-check '(KEYWORD DATUM) form)
+	 (output/literal-quoted (strip-syntactic-closures (cadr form))))))))
+
+;;;; Bindings
+
+(define (make-binding-macrology binding-theory
+				let-keyword letrec-keyword define-keyword)
+  (make-primitive-macrology
+   (lambda (define-classifier define-compiler)
+
+     (let ((pattern/let-like
+	    '(KEYWORD (* (IDENTIFIER EXPRESSION)) + FORM))
+	   (compile/let-like
+	    (lambda (form environment body-environment output/let)
+	      ;; Force evaluation order.
+	      (let ((bindings
+		     (let loop
+			 ((bindings
+			   (map (lambda (binding)
+				  (cons (car binding)
+					(classify/subexpression
+					 (cadr binding)
+					 environment)))
+				(cadr form))))
+		       (if (null? bindings)
+			   '()
+			   (let ((binding
+				  (binding-theory body-environment
+						  (caar bindings)
+						  (cdar bindings))))
+			     (if binding
+				 (cons binding (loop (cdr bindings)))
+				 (loop (cdr bindings))))))))
+		(output/let (map car bindings)
+			    (map (lambda (binding)
+				   (compile-item/expression (cdr binding)))
+				 bindings)
+			    (compile-item/expression
+			     (classify/body (cddr form)
+					    body-environment)))))))
+
+       (define-compiler let-keyword
+	 (lambda (form environment)
+	   (syntax-check pattern/let-like form)
+	   (compile/let-like form
+			     environment
+			     (internal-syntactic-environment environment)
+			     output/let)))
+
+       (define-compiler letrec-keyword
+	 (lambda (form environment)
+	   (syntax-check pattern/let-like form)
+	   (let ((environment (internal-syntactic-environment environment)))
+	     (reserve-names! (map car (cadr form)) environment)
+	     (compile/let-like form
+			       environment
+			       environment
+			       output/letrec)))))
+
+     (define-classifier define-keyword
+       (lambda (form environment definition-environment)
+	 (syntax-check '(KEYWORD IDENTIFIER EXPRESSION) form)
+	 (syntactic-environment/define! definition-environment
+					(cadr form)
+					(make-reserved-name-item))
+	 (make-definition-item binding-theory
+			       (cadr form)
+			       (make-promise
+				(lambda ()
+				  (classify/subexpression
+				   (caddr form)
+				   environment)))))))))
+
+;;;; Bodies
+
+(define (classify/body forms environment)
+  (let ((environment (internal-syntactic-environment environment)))
+    (let forms-loop
+	((forms forms)
+	 (bindings '()))
+      (if (null? forms)
+	  (syntax-error "no expressions in body"
+			"")
+	  (let items-loop
+	      ((items
+		(item->list
+		 (classify/subform (car forms)
+				   environment
+				   environment)))
+	       (bindings bindings))
+	    (cond ((null? items)
+		   (forms-loop (cdr forms)
+			       bindings))
+		  ((definition-item? (car items))
+		   (items-loop (cdr items)
+			       (let ((binding
+				      (bind-definition-item! environment
+							     (car items))))
+				 (if binding
+				     (cons binding bindings)
+				     bindings))))
+		  (else
+		   (let ((body
+			  (make-body-item
+			   (append items
+				   (flatten-body-items
+				    (classify/subforms
+				     (cdr forms)
+				     environment
+				     environment))))))
+		     (make-expression-item
+		      (lambda ()
+			(output/letrec
+			 (map car bindings)
+			 (map (lambda (binding)
+				(compile-item/expression (cdr binding)))
+			      bindings)
+			 (compile-item/expression body))) forms)))))))))
+
+;;;; R4RS Primitives
+
+(define (make-r4rs-primitive-macrology)
+  (make-primitive-macrology
+   (lambda (define-classifier define-compiler)
+
+     (define (transformer-keyword expander->classifier)
+       (lambda (form environment definition-environment)
+	 definition-environment		;ignore
+	 (syntax-check '(KEYWORD EXPRESSION) form)
+	 (let ((item
+		(classify/subexpression (cadr form)
+					scheme-syntactic-environment)))
+	   (let ((transformer (base:eval (compile-item/expression item))))
+	     (if (procedure? transformer)
+		 (make-keyword-item
+		  (expander->classifier transformer environment) item)
+		 (syntax-error "transformer not a procedure"
+			       transformer))))))
+
+     (define-classifier 'TRANSFORMER
+       ;; "Syntactic Closures" transformer
+       (transformer-keyword sc-expander->classifier))
+
+     (define-classifier 'ER-TRANSFORMER
+       ;; "Explicit Renaming" transformer
+       (transformer-keyword er-expander->classifier))
+
+     (define-compiler 'LAMBDA
+       (lambda (form environment)
+	 (syntax-check '(KEYWORD R4RS-BVL + FORM) form)
+	 (let ((environment (internal-syntactic-environment environment)))
+	   ;; Force order -- bind names before classifying body.
+	   (let ((bvl-description
+		  (let ((rename
+			 (lambda (identifier)
+			   (bind-variable! environment identifier))))
+		    (let loop ((bvl (cadr form)))
+		      (cond ((null? bvl)
+			     '())
+			    ((pair? bvl)
+			     (cons (rename (car bvl)) (loop (cdr bvl))))
+			    (else
+			     (rename bvl)))))))
+	     (output/lambda bvl-description
+			    (compile-item/expression
+			     (classify/body (cddr form)
+					    environment)))))))
+
+     (define-compiler 'SET!
+       (lambda (form environment)
+	 (syntax-check '(KEYWORD FORM EXPRESSION) form)
+	 (output/assignment
+	  (let loop
+	      ((form (cadr form))
+	       (environment environment))
+	    (cond ((identifier? form)
+		   (let ((item
+			  (syntactic-environment/lookup environment form)))
+		     (if (variable-item? item)
+			 (variable-item/name item)
+			 (slib:error "target of assignment not a variable"
+				       form))))
+		  ((syntactic-closure? form)
+		   (let ((form (syntactic-closure/form form))
+			 (environment
+			  (filter-syntactic-environment
+			   (syntactic-closure/free-names form)
+			   environment
+			   (syntactic-closure/environment form))))
+		     (loop form
+			   environment)))
+		  (else
+		   (slib:error "target of assignment not an identifier"
+				 form))))
+	  (compile/subexpression (caddr form)
+				 environment))))
+
+     ;; end MAKE-R4RS-PRIMITIVE-MACROLOGY
+     )))
+
+;;;; Core Expanders
+
+(define (make-core-expander-macrology)
+  (make-er-expander-macrology
+   (lambda (define-expander base-environment)
+
+     (let ((keyword (make-syntactic-closure base-environment '() 'DEFINE)))
+       (define-expander 'DEFINE
+	 (lambda (form rename compare)
+	   compare			;ignore
+	   (if (syntax-match? '((IDENTIFIER . R4RS-BVL) + FORM) (cdr form))
+	       `(,keyword ,(caadr form)
+			  (,(rename 'LAMBDA) ,(cdadr form) ,@(cddr form)))
+	       `(,keyword ,@(cdr form))))))
+
+     (let ((keyword (make-syntactic-closure base-environment '() 'LET)))
+       (define-expander 'LET
+	 (lambda (form rename compare)
+	   compare			;ignore
+	   (if (syntax-match? '(IDENTIFIER (* (IDENTIFIER EXPRESSION)) + FORM)
+			      (cdr form))
+	       (let ((name (cadr form))
+		     (bindings (caddr form)))
+		 `((,(rename 'LETREC)
+		    ((,name (,(rename 'LAMBDA) ,(map car bindings) ,@(cdddr form))))
+		    ,name)
+		   ,@(map cadr bindings)))
+	       `(,keyword ,@(cdr form))))))
+
+     (define-expander 'LET*
+       (lambda (form rename compare)
+	 compare			;ignore
+	 (if (syntax-match? '((* (IDENTIFIER EXPRESSION)) + FORM) (cdr form))
+	     (let ((bindings (cadr form))
+		   (body (cddr form))
+		   (keyword (rename 'LET)))
+	       (if (null? bindings)
+		   `(,keyword ,bindings ,@body)
+		   (let loop ((bindings bindings))
+		     (if (null? (cdr bindings))
+			 `(,keyword ,bindings ,@body)
+			 `(,keyword (,(car bindings))
+				    ,(loop (cdr bindings)))))))
+	     (ill-formed-syntax form))))
+
+     (define-expander 'AND
+       (lambda (form rename compare)
+	 compare			;ignore
+	 (if (syntax-match? '(* EXPRESSION) (cdr form))
+	     (let ((operands (cdr form)))
+	       (if (null? operands)
+		   `#T
+		   (let ((if-keyword (rename 'IF)))
+		     (let loop ((operands operands))
+		       (if (null? (cdr operands))
+			   (car operands)
+			   `(,if-keyword ,(car operands)
+					 ,(loop (cdr operands))
+					 #F))))))
+	     (ill-formed-syntax form))))
+
+     (define-expander 'OR
+       (lambda (form rename compare)
+	 compare			;ignore
+	 (if (syntax-match? '(* EXPRESSION) (cdr form))
+	     (let ((operands (cdr form)))
+	       (if (null? operands)
+		   `#F
+		   (let ((let-keyword (rename 'LET))
+			 (if-keyword (rename 'IF))
+			 (temp (rename 'TEMP)))
+		     (let loop ((operands operands))
+		       (if (null? (cdr operands))
+			   (car operands)
+			   `(,let-keyword ((,temp ,(car operands)))
+					  (,if-keyword ,temp
+						       ,temp
+						       ,(loop (cdr operands)))))))))
+	     (ill-formed-syntax form))))
+
+     (define-expander 'CASE
+       (lambda (form rename compare)
+	 (if (syntax-match? '(EXPRESSION + (DATUM + EXPRESSION)) (cdr form))
+	     (letrec
+		 ((process-clause
+		   (lambda (clause rest)
+		     (cond ((null? (car clause))
+			    (process-rest rest))
+			   ((and (identifier? (car clause))
+				 (compare (rename 'ELSE) (car clause))
+				 (null? rest))
+			    `(,(rename 'BEGIN) ,@(cdr clause)))
+			   ((list? (car clause))
+			    `(,(rename 'IF) (,(rename 'MEMV) ,(rename 'TEMP)
+							     ',(car clause))
+					    (,(rename 'BEGIN) ,@(cdr clause))
+					    ,(process-rest rest)))
+			   (else
+			    (syntax-error "ill-formed clause" clause)))))
+		  (process-rest
+		   (lambda (rest)
+		     (if (null? rest)
+			 (unspecific-expression)
+			 (process-clause (car rest) (cdr rest))))))
+	       `(,(rename 'LET) ((,(rename 'TEMP) ,(cadr form)))
+				,(process-clause (caddr form) (cdddr form))))
+	     (ill-formed-syntax form))))
+
+     (define-expander 'COND
+       (lambda (form rename compare)
+	 (letrec
+	     ((process-clause
+	       (lambda (clause rest)
+		 (cond
+		  ((or (not (list? clause))
+		       (null? clause))
+		   (syntax-error "ill-formed clause" clause))
+		  ((and (identifier? (car clause))
+			(compare (rename 'ELSE) (car clause)))
+		   (cond
+		    ((or (null? (cdr clause))
+			 (and (identifier? (cadr clause))
+			      (compare (rename '=>) (cadr clause))))
+		     (syntax-error "ill-formed ELSE clause" clause))
+		    ((not (null? rest))
+		     (syntax-error "misplaced ELSE clause" clause))
+		    (else
+		     `(,(rename 'BEGIN) ,@(cdr clause)))))
+		  ((null? (cdr clause))
+		   `(,(rename 'OR) ,(car clause) ,(process-rest rest)))
+		  ((and (identifier? (cadr clause))
+			(compare (rename '=>) (cadr clause)))
+		   (if (and (pair? (cddr clause))
+			    (null? (cdddr clause)))
+		       `(,(rename 'LET)
+			 ((,(rename 'TEMP) ,(car clause)))
+			 (,(rename 'IF) ,(rename 'TEMP)
+					(,(caddr clause) ,(rename 'TEMP))
+					,(process-rest rest)))
+		       (syntax-error "ill-formed => clause" clause)))
+		  (else
+		   `(,(rename 'IF) ,(car clause)
+				   (,(rename 'BEGIN) ,@(cdr clause))
+				   ,(process-rest rest))))))
+	      (process-rest
+	       (lambda (rest)
+		 (if (null? rest)
+		     (unspecific-expression)
+		     (process-clause (car rest) (cdr rest))))))
+	   (let ((clauses (cdr form)))
+	     (if (null? clauses)
+		 (syntax-error "no clauses" form)
+		 (process-clause (car clauses) (cdr clauses)))))))
+
+     (define-expander 'DO
+       (lambda (form rename compare)
+	 compare			;ignore
+	 (if (syntax-match? '((* (IDENTIFIER EXPRESSION ? EXPRESSION))
+			      (+ EXPRESSION)
+			      * FORM)
+			    (cdr form))
+	     (let ((bindings (cadr form)))
+	       `(,(rename 'LETREC)
+		 ((,(rename 'DO-LOOP)
+		   (,(rename 'LAMBDA)
+		    ,(map car bindings)
+		    (,(rename 'IF) ,(caaddr form)
+				   ,(if (null? (cdaddr form))
+					(unspecific-expression)
+					`(,(rename 'BEGIN) ,@(cdaddr form)))
+				   (,(rename 'BEGIN)
+				    ,@(cdddr form)
+				    (,(rename 'DO-LOOP)
+				     ,@(map (lambda (binding)
+					      (if (null? (cddr binding))
+						  (car binding)
+						  (caddr binding)))
+					    bindings)))))))
+		 (,(rename 'DO-LOOP) ,@(map cadr bindings))))
+	     (ill-formed-syntax form))))
+
+     (define-expander 'QUASIQUOTE
+       (lambda (form rename compare)
+	 (define (descend-quasiquote x level return)
+	   (cond ((pair? x) (descend-quasiquote-pair x level return))
+		 ((vector? x) (descend-quasiquote-vector x level return))
+		 (else (return 'QUOTE x))))
+	 (define (descend-quasiquote-pair x level return)
+	   (cond ((not (and (pair? x)
+			    (identifier? (car x))
+			    (pair? (cdr x))
+			    (null? (cddr x))))
+		  (descend-quasiquote-pair* x level return))
+		 ((compare (rename 'QUASIQUOTE) (car x))
+		  (descend-quasiquote-pair* x (+ level 1) return))
+		 ((compare (rename 'UNQUOTE) (car x))
+		  (if (zero? level)
+		      (return 'UNQUOTE (cadr x))
+		      (descend-quasiquote-pair* x (- level 1) return)))
+		 ((compare (rename 'UNQUOTE-SPLICING) (car x))
+		  (if (zero? level)
+		      (return 'UNQUOTE-SPLICING (cadr x))
+		      (descend-quasiquote-pair* x (- level 1) return)))
+		 (else
+		  (descend-quasiquote-pair* x level return))))
+	 (define (descend-quasiquote-pair* x level return)
+	   (descend-quasiquote
+	    (car x) level
+	    (lambda (car-mode car-arg)
+	      (descend-quasiquote
+	       (cdr x) level
+	       (lambda (cdr-mode cdr-arg)
+		 (cond ((and (eq? car-mode 'QUOTE) (eq? cdr-mode 'QUOTE))
+			(return 'QUOTE x))
+		       ((eq? car-mode 'UNQUOTE-SPLICING)
+			(if (and (eq? cdr-mode 'QUOTE) (null? cdr-arg))
+			    (return 'UNQUOTE car-arg)
+			    (return 'APPEND
+				    (list car-arg
+					  (finalize-quasiquote cdr-mode
+							       cdr-arg)))))
+		       ((and (eq? cdr-mode 'QUOTE) (list? cdr-arg))
+			(return 'LIST
+				(cons (finalize-quasiquote car-mode car-arg)
+				      (map (lambda (element)
+					     (finalize-quasiquote 'QUOTE
+								  element))
+					   cdr-arg))))
+		       ((eq? cdr-mode 'LIST)
+			(return 'LIST
+				(cons (finalize-quasiquote car-mode car-arg)
+				      cdr-arg)))
+		       (else
+			(return
+			 'CONS
+			 (list (finalize-quasiquote car-mode car-arg)
+			       (finalize-quasiquote cdr-mode cdr-arg))))))))))
+	 (define (descend-quasiquote-vector x level return)
+	   (descend-quasiquote
+	    (vector->list x) level
+	    (lambda (mode arg)
+	      (case mode
+		((QUOTE) (return 'QUOTE x))
+		((LIST) (return 'VECTOR arg))
+		(else
+		 (return 'LIST->VECTOR
+			 (list (finalize-quasiquote mode arg))))))))
+	 (define (finalize-quasiquote mode arg)
+	   (case mode
+	     ((QUOTE) `(,(rename 'QUOTE) ,arg))
+	     ((UNQUOTE) arg)
+	     ((UNQUOTE-SPLICING) (syntax-error ",@ in illegal context" arg))
+	     (else `(,(rename mode) ,@arg))))
+	 (if (syntax-match? '(EXPRESSION) (cdr form))
+	     (descend-quasiquote (cadr form) 0 finalize-quasiquote)
+	     (ill-formed-syntax form))))
+
+;;; end MAKE-CORE-EXPANDER-MACROLOGY
+     )))
diff --git a/randinex.scm b/randinex.scm
new file mode 100644
index 0000000..1c2b702
--- /dev/null
+++ b/randinex.scm
@@ -0,0 +1,99 @@
+;;;"randinex.scm" Pseudo-Random inexact real numbers for scheme.
+;;; Copyright (C) 1991, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;This file is loaded by random.scm if inexact numbers are supported by
+;the implementation.
+
+;;; Fixed sphere and normal functions from: Harald Hanche-Olsen
+
+(define random:float-radix
+  (+ 1 (exact->inexact random:MASK)))
+
+;;; This determines how many chunks will be neccessary to completely
+;;; fill up an inexact real.
+(define (random:size-float l x)
+  (cond ((= 1.0 (+ 1 x)) l)
+	((= 4 l) l)
+	(else (random:size-float (+ l 1) (/ x random:float-radix)))))
+(define random:chunks/float (random:size-float 0 1.0))
+
+(define (random:uniform-chunk n state)
+  (if (= 1 n)
+      (/ (exact->inexact (random:chunk state))
+	 random:float-radix)
+      (/ (+ (random:uniform-chunk (- n 1) state)
+	    (exact->inexact (random:chunk state)))
+	 random:float-radix)))
+
+;;; Generate an inexact real between 0 and 1.
+(define (random:uniform state)
+  (random:uniform-chunk random:chunks/float state))
+
+;;; If x and y are independent standard normal variables, then with
+;;; x=r*cos(t), y=r*sin(t), we find that t is uniformly distributed
+;;; over [0,2*pi] and the cumulative distribution of r is
+;;; 1-exp(-r^2/2).  This latter means that u=exp(-r^2/2) is uniformly
+;;; distributed on [0,1], so r=sqrt(-2 log u) can be used to generate r.
+
+(define (random:normal-vector! vect . args)
+  (let ((state (if (null? args) *random-state* (car args)))
+	(sum2 0))
+    (let ((do! (lambda (k x)
+		 (vector-set! vect k x)
+		 (set! sum2 (+ sum2 (* x x))))))
+      (do ((n (- (vector-length vect) 1) (- n 2)))
+	  ((negative? n) sum2)
+	(let ((t (* 6.28318530717958 (random:uniform state)))
+	      (r (sqrt (* -2 (log (random:uniform state))))))
+	  (do! n (* r (cos t)))
+	  (if (positive? n) (do! (- n 1) (* r (sin t)))))))))
+
+(define random:normal
+  (let ((vect (make-vector 1)))
+    (lambda args 
+      (apply random:normal-vector! vect args)
+      (vector-ref vect 0))))
+
+;;; For the uniform distibution on the hollow sphere, pick a normal
+;;; family and scale.
+
+(define (random:hollow-sphere! vect . args)
+  (let ((ms (sqrt (apply random:normal-vector! vect args))))
+    (do ((n (- (vector-length vect) 1) (- n 1)))
+	((negative? n))
+      (vector-set! vect n (/ (vector-ref vect n) ms)))))
+
+;;; For the uniform distribution on the solid sphere, note that in
+;;; this distribution the length r of the vector has cumulative
+;;; distribution r^n; i.e., u=r^n is uniform [0,1], so r kan be
+;;; generated as r=u^(1/n).
+
+(define (random:solid-sphere! vect . args)
+  (apply random:hollow-sphere! vect args)
+  (let ((r (expt (random:uniform (if (null? args) *random-state* (car args)))
+		 (/ (vector-length vect)))))
+    (do ((n (- (vector-length vect) 1) (- n 1)))
+	((negative? n))
+      (vector-set! vect n (* r (vector-ref vect n))))))
+
+(define (random:exp . args)
+  (let ((state (if (null? args) *random-state* (car args))))
+    (- (log (random:uniform state)))))
+
+(require 'random)
diff --git a/random.scm b/random.scm
new file mode 100644
index 0000000..4f5a11d
--- /dev/null
+++ b/random.scm
@@ -0,0 +1,101 @@
+;;;; "random.scm" Pseudo-Random number generator for scheme.
+;;; Copyright (C) 1991, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'logical)
+
+(define random:tap 24)
+(define random:size 55)
+
+(define (random:size-int l)
+  (let ((trial (string->number (make-string l #\f) 16)))
+  (if (and (exact? trial) (>= most-positive-fixnum trial))
+      l
+      (random:size-int (- l 1)))))
+(define random:chunk-size (* 4 (random:size-int 8)))
+
+(define random:MASK
+  (string->number (make-string (quotient random:chunk-size 4) #\f) 16))
+
+(define *random-state*
+  '#(
+ "d909ef3e" "fd330ab3" "e33f7843" "76783fbd" "f3675fb3"
+ "b54ef879" "0be45590" "a6794679" "0bcd56d3" "fabcdef8"
+ "9cbd3efd" "3fd3efcd" "e064ef27" "dddecc08" "34444292"
+ "85444454" "4c519210" "c0366273" "54734567" "70abcddc"
+ "1bbdac53" "616c5a86" "a982efa9" "105996a0" "5f0cccba"
+ "1ea055e1" "fe2acd8d" "1891c1d4" "e6690270" "6912bccc"
+ "2678e141" "61222224" "907abcbb" "4ad6829b" "9cdd1404"
+ "57798841" "5b892496" "871c9cd1" "d1e67bda" "8b0a3233"
+ "578ef23f" "28274ef6" "823ef5ef" "845678c5" "e67890a5"
+ "5890abcb" "851fa9ab" "13efa13a" "b12278d6" "daf805ab"
+ "a0befc36" "0068a7b5" "e024fd90" "a7b690e2" "27f3571a"
+ 0))
+
+(let ((random-strings *random-state*))
+  (set! *random-state* (make-vector (+ random:size 1) 0))
+  (let ((nibbles (quotient random:chunk-size 4)))
+    (do ((i 0 (+ i 1)))
+	((= i random:size))
+      (vector-set!
+       *random-state* i
+       (string->number (substring (vector-ref random-strings i)
+				  0 nibbles)
+		       16)))))
+
+;;; random:chunk returns an integer in the range of
+;;; 0 to (- (expt 2 random:chunk-size) 1)
+(define (random:chunk v)
+  (let* ((p (vector-ref v random:size))
+	 (ans (logical:logxor
+	       (vector-ref v (modulo (- p random:tap) random:size))
+	       (vector-ref v p))))
+    (vector-set! v p ans)
+    (vector-set! v random:size (modulo (- p 1) random:size))
+    ans))
+
+(define (random:random modu . args)
+  (let ((state (if (null? args) *random-state* (car args))))
+    (if (exact? modu)
+	(do ((ilen 0 (+ 1 ilen))
+	     (s random:MASK
+		(+ random:MASK (* (+ 1 random:MASK) s))))
+	    ((>= s (- modu 1))
+	     (let ((slop (modulo (+ s (- 1 modu)) modu)))
+	       (let loop ((n ilen)
+			  (r (random:chunk state)))
+		 (cond ((not (zero? n))
+			(loop (+ -1 n)
+			      (+ (* r (+ 1 random:MASK))
+				 (random:chunk state))))
+		       ((>= r slop) (modulo r modu))
+		       (else (loop ilen (random:chunk state))))))))
+
+	(* (random:uniform state) modu))))
+;;;random:uniform is in randinex.scm.  It is needed only if inexact is
+;;;supported.
+
+(define (random:make-random-state . args)
+  (let ((state (if (null? args) *random-state* (car args))))
+    (list->vector (vector->list state))))
+
+(define random random:random)
+(define make-random-state random:make-random-state)
+
+(provide 'random)			;to prevent loops
+(if (provided? 'inexact) (require 'random-inexact))
diff --git a/ratize.scm b/ratize.scm
new file mode 100644
index 0000000..d8cad11
--- /dev/null
+++ b/ratize.scm
@@ -0,0 +1,13 @@
+;;;; "ratize.scm" Convert number to rational number
+
+(define (rational:simplest x y)
+  (define (sr x y) (let ((fx (floor x)) (fy (floor y)))
+		    (cond ((not (< fx x)) fx)
+			  ((= fx fy) (+ fx (/ (sr (/ (- y fy)) (/ (- x fx))))))
+			  (else (+ 1 fx)))))
+  (cond ((< y x) (rational:simplest y x))
+	((not (< x y)) (if (rational? x) x (slib:error)))
+	((positive? x) (sr x y))
+	((negative? y) (- (sr (- y) (- x))))
+	(else (if (and (exact? x) (exact? y)) 0 0.0))))
+(define (rationalize x e) (rational:simplest (- x e) (+ x e)))
diff --git a/rdms.scm b/rdms.scm
new file mode 100644
index 0000000..0fd4a2c
--- /dev/null
+++ b/rdms.scm
@@ -0,0 +1,598 @@
+;;; "rdms.scm" rewrite 6 - the saga continues
+; Copyright 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define rdms:catalog-name '*catalog-data*)
+(define rdms:domains-name '*domains-data*)
+(define rdms:columns-name '*columns*)
+
+(define catalog:init-cols
+  '((1 #t table-name		#f atom)
+    (2 #f column-limit		#f uint)
+    (3 #f coltab-name		#f atom)
+    (4 #f bastab-id		#f base-id)
+    (5 #f user-integrity-rule	#f expression)
+    (6 #f view-procedure	#f expression)))
+
+(define catalog:column-limit-pos 2)
+(define catalog:coltab-name-pos 3)
+(define catalog:bastab-id-pos 4)
+(define catalog:integrity-rule-pos 5)
+(define catalog:view-proc-pos 6)
+
+(define columns:init-cols
+  '((1 #t column-number		#f uint)
+    (2 #f primary-key?		#f boolean)
+    (3 #f column-name		#f symbol)
+    (4 #f column-integrity-rule	#f expression)
+    (5 #f domain-name		#f domain)))
+
+(define columns:primary?-pos 2)
+(define columns:name-pos 3)
+(define columns:integrity-rule-pos 4)
+(define columns:domain-name-pos 5)
+
+(define domains:init-cols
+  '((1 #t domain-name		#f atom)
+    (2 #f foreign-table		#f atom)
+    (3 #f domain-integrity-rule	#f expression)
+    (4 #f type-id		#f type)
+    (5 #f type-param		#f expression)))
+
+(define domains:foreign-pos 2)
+(define domains:integrity-rule-pos 3)
+(define domains:type-id-pos 4)
+(define domains:type-param-pos 5)
+
+(define domains:init-data
+  `((atom #f
+          (lambda (x) (or (not x) (symbol? x) (number? x)))
+          atom
+          #f)
+    (type #f
+	  #f				;type checked when openning
+	  symbol
+	  #f)
+    (base-id #f
+	     (lambda (x) (or (symbol? x) (number? x)))
+	     base-id
+	     #f)
+    (uint #f
+          (lambda (x)
+            (and (number? x)
+                 (integer? x)
+                 (not (negative? x))))
+          integer
+          #f)
+    (expression #f #f expression #f)
+    (boolean #f boolean? boolean #f)
+    (symbol #f symbol? symbol #f)
+    (string #f string? string #f)
+    (domain ,rdms:domains-name #f atom #f)))
+
+(define (rdms:warn identifier msg obj)
+  (display identifier) (display #\ ) (display msg) (write obj) (newline))
+(define rdms:error slib:error)
+
+(define (make-relational-system base)
+  (define basic
+    (lambda (name)
+      (let ((meth (base name)))
+	(cond ((not meth) (rdms:error 'make-relational-system
+				      "essential method missing for:" name)))
+	meth)))
+
+  (define (desc-row-type row)
+    (let ((domain (assq (car (cddddr row)) domains:init-data)))
+      (and domain (cadddr domain))))
+
+  (let ((make-base (base 'make-base))
+	(open-base (basic 'open-base))
+	(write-base (base 'write-base))
+	(sync-base (base 'sync-base))
+	(close-base (basic 'close-base))
+	(base:supported-type? (basic 'supported-type?))
+	(base:supported-key-type? (basic 'supported-key-type?))
+	(base:make-table (base 'make-table))
+	(base:open-table (basic 'open-table))
+	(base:kill-table (base 'kill-table))
+	(present? (basic 'present?))
+	(base:ordered-for-each-key (basic 'ordered-for-each-key))
+	(base:for-each-primary-key (basic 'for-each-key))
+	(base:map-primary-key (basic 'map-key))
+	(base:catalog-id (basic 'catalog-id))
+	(cat:keyify-1 ((basic 'make-keyifier-1)
+		       (desc-row-type (assv 1 catalog:init-cols))))
+	(itypes
+	 (lambda (rows)
+	   (map (lambda (row)
+		  (let ((domrow (assq (car (cddddr row)) domains:init-data)))
+		    (cond (domrow (cadddr domrow))
+			  (else (rdms:error 'itypes "type not found for:"
+					    (car (cddddr row)))))))
+		rows))))
+
+    (define (init-tab lldb id descriptor rows)
+      (let ((han (base:open-table lldb id 1 (itypes descriptor)))
+	    (keyify-1
+	     ((base 'make-keyifier-1) (desc-row-type (assv 1 descriptor))))
+	    (putter ((basic 'make-putter) 1 (itypes descriptor))))
+	(for-each (lambda (row) (putter han (keyify-1 (car row)) (cdr row)))
+		  rows)))
+
+    (define cat:get-row
+      (let ((cat:getter ((basic 'make-getter) 1 (itypes catalog:init-cols))))
+	(lambda (bastab key)
+	  (cat:getter bastab (cat:keyify-1 key)))))
+
+    (define dom:get-row
+      (let ((dom:getter ((basic 'make-getter) 1 (itypes domains:init-cols)))
+	    (dom:keyify-1 ((basic 'make-keyifier-1)
+			   (desc-row-type (assv 1 domains:init-cols)))))
+	(lambda (bastab key)
+	  (dom:getter bastab (dom:keyify-1 key)))))
+
+    (define des:get-row
+      (let ((des:getter ((basic 'make-getter) 1 (itypes columns:init-cols)))
+	    (des:keyify-1 ((basic 'make-keyifier-1)
+			   (desc-row-type (assv 1 columns:init-cols)))))
+	(lambda (bastab key)
+	  (des:getter bastab (des:keyify-1 key)))))
+
+    (define (create-database filename)
+      (cond ((and filename (file-exists? filename))
+	     (rdms:warn 'create-database "file exists:" filename)))
+      (let* ((lldb (make-base filename 1 (itypes catalog:init-cols)))
+	     (cattab (and lldb (base:open-table lldb base:catalog-id 1
+						(itypes catalog:init-cols)))))
+	(cond
+	 ((not lldb) (rdms:error 'make-base "failed.") #f)
+	 ((not cattab) (rdms:error 'make-base "catalog missing.")
+		       (close-base lldb)
+		       #f)
+	 (else
+	  (let ((desdes-id (base:make-table lldb 1 (itypes columns:init-cols)))
+		(domdes-id (base:make-table lldb 1 (itypes columns:init-cols)))
+		(catdes-id (base:make-table lldb 1 (itypes columns:init-cols)))
+		(domtab-id (base:make-table lldb 1 (itypes domains:init-cols)))
+		)
+	    (cond
+	     ((not (and catdes-id domdes-id domtab-id desdes-id))
+	      (rdms:error 'create-database "make-table failed.")
+	      (close-base lldb)
+	      #f)
+	     (else
+	      (init-tab lldb desdes-id columns:init-cols columns:init-cols)
+	      (init-tab lldb domdes-id columns:init-cols domains:init-cols)
+	      (init-tab lldb catdes-id columns:init-cols catalog:init-cols)
+	      (init-tab lldb domtab-id domains:init-cols domains:init-data)
+	      (init-tab
+	       lldb base:catalog-id catalog:init-cols
+	       `((*catalog-desc* 5 ,rdms:columns-name ,catdes-id #f #f)
+		 (*domains-desc* 5 ,rdms:columns-name ,domdes-id #f #f)
+		 (,rdms:catalog-name 6 *catalog-desc* ,base:catalog-id #f #f)
+		 (,rdms:domains-name 5 *domains-desc* ,domtab-id #f #f)
+		 (,rdms:columns-name 5 ,rdms:columns-name ,desdes-id #f #f)))
+	      (init-database
+	       filename #t lldb cattab
+	       (base:open-table lldb domtab-id 1 (itypes domains:init-cols))
+	       #f))))))))
+
+    (define (base:catalog->domains lldb base:catalog)
+      (let ((cat:row (cat:get-row base:catalog rdms:domains-name)))
+	(and cat:row
+	     (base:open-table lldb
+			      (list-ref cat:row (+ -2 catalog:bastab-id-pos))
+			      1 (itypes domains:init-cols)))))
+
+    (define (open-database filename mutable)
+      (let* ((lldb (open-base filename mutable))
+	     (base:catalog
+	      (and lldb (base:open-table lldb base:catalog-id
+					 1 (itypes catalog:init-cols))))
+	     (base:domains
+	      (and base:catalog (base:catalog->domains lldb base:catalog))))
+	(cond
+	 ((not lldb) #f)
+	 ((not base:domains) (close-base lldb) #f)
+	 (else (init-database
+		filename mutable lldb base:catalog base:domains #f)))))
+
+    (define (init-database rdms:filename mutable lldb
+			   base:catalog base:domains rdms:catalog)
+
+      (define (write-database filename)
+	(write-base lldb filename)
+	(set! rdms:filename filename))
+
+      (define (close-database)
+	(close-base lldb)
+	(set! rdms:filename #f)
+	(set! base:catalog #f)
+	(set! base:domains #f)
+	(set! rdms:catalog #f))
+
+      (define row-ref (lambda (row pos) (list-ref row (+ -2 pos))))
+      (define row-eval (lambda (row pos)
+			 (let ((ans (list-ref row (+ -2 pos))))
+			   (and ans (slib:eval ans)))))
+
+      (define (open-table table-name writable)
+	(define cat:row (cat:get-row base:catalog table-name))
+	(cond ((and writable (not mutable))
+	       (rdms:error "can't open-table for writing:" table-name)))
+	(let ((column-limit (row-ref cat:row catalog:column-limit-pos))
+	      (desc-table
+	       (base:open-table
+		lldb
+		(row-ref (cat:get-row
+			  base:catalog
+			  (row-ref cat:row catalog:coltab-name-pos))
+			 catalog:bastab-id-pos)
+		1 (itypes columns:init-cols)))
+	      (base-table #f)
+	      (base:get #f)
+	      (primary-limit 1)
+	      (column-name-alist '())
+	      (column-foreign-list '())
+	      (column-domain-list '())
+	      (column-type-list '())
+	      (export-alist '())
+	      (cirs '())
+	      (dirs '())
+	      (list->key #f)
+	      (key->list #f))
+
+	  (if (not desc-table)
+	      (rdms:error "descriptor table doesn't exist for:" table-name))
+	  (do ((ci column-limit (+ -1 ci)))
+	      ((zero? ci))
+	    (let* ((des:row (des:get-row desc-table ci))
+		   (column-name (row-ref des:row columns:name-pos))
+		   (column-domain (row-ref des:row columns:domain-name-pos)))
+	      (set! cirs
+		    (cons (row-eval des:row columns:integrity-rule-pos) cirs))
+	      (set! column-name-alist
+		    (cons (cons column-name ci) column-name-alist))
+	      (cond
+	       (column-domain
+		(let ((dom:row (dom:get-row base:domains column-domain)))
+		  (set! dirs
+			(cons (row-eval dom:row domains:integrity-rule-pos)
+			      dirs))
+		  (set! column-type-list
+			(cons (row-ref dom:row domains:type-id-pos)
+			      column-type-list))
+		  (set! column-domain-list
+			(cons column-domain column-domain-list))
+		  (set! column-foreign-list
+			(cons 
+			 (let ((foreign-name
+				(row-ref dom:row domains:foreign-pos)))
+			   (cond
+			    ((or (not foreign-name)
+				 (eq? foreign-name table-name)) #f)
+			    (else
+			     (let* ((tab (open-table foreign-name #f))
+				    (p? (and tab (tab 'get 1))))
+			       (cond
+				((not tab)
+				 (rdms:error "foreign key table missing for:"
+					     foreign-name))
+				((not (= (tab 'primary-limit) 1))
+				 (rdms:error "foreign key table wrong type:"
+					     foreign-name))
+				(else p?))))))
+			 column-foreign-list))))
+	       (else
+		(rdms:error "missing domain for column:" ci column-name)))
+	      (cond
+	       ((row-ref des:row columns:primary?-pos)
+		(set! primary-limit (max primary-limit ci))
+		(cond
+		 ((base:supported-key-type? (car column-type-list)))
+		 (else (rdms:error "key type not supported by base tables:"
+				   (car column-type-list)))))
+	       ((base:supported-type? (car column-type-list)))
+	       (else (rdms:error "type not supported by base tables:"
+				 (car column-type-list))))))
+	  (set! base-table
+		(base:open-table lldb (row-ref cat:row catalog:bastab-id-pos)
+				 primary-limit column-type-list))
+	  (set! base:get ((basic 'make-getter) primary-limit column-type-list))
+	  (set! list->key
+		((basic 'make-list-keyifier) primary-limit column-type-list))
+	  (set! key->list
+		((basic 'make-key->list) primary-limit column-type-list))
+	  (let ((export-method
+		 (lambda (name proc)
+		   (set! export-alist
+			 (cons (cons name proc) export-alist))))
+		(generalize-to-table
+		 (lambda (operation)
+		   (lambda ()
+		     (base:for-each-primary-key base-table operation))))
+		(accumulate-over-table
+		 (lambda (operation)
+		   (lambda () (base:map-primary-key base-table operation))))
+		(ckey:retrieve		;ckey gets whole row (assumes exists)
+		 (if (= primary-limit column-limit) key->list
+		     (lambda (ckey) (append (key->list ckey)
+					    (base:get base-table ckey))))))
+	    (export-method
+	     'row:retrieve
+	     (if (= primary-limit column-limit)
+		 (lambda keys
+		   (let ((ckey (list->key keys)))
+		     (and (present? base-table ckey) keys)))
+		 (lambda keys
+		   (let ((vals (base:get base-table (list->key keys))))
+		     (and vals (append keys vals))))))
+	    (export-method 'row:retrieve*
+			   (accumulate-over-table
+			    (if (= primary-limit column-limit) key->list
+				ckey:retrieve)))
+	    (export-method
+	     'for-each-row
+	     (let ((r (if (= primary-limit column-limit) key->list
+			  ckey:retrieve)))
+	       (lambda (proc) (base:ordered-for-each-key
+			       base-table (lambda (ckey) (proc (r ckey)))))))
+	    (cond
+	     ((and mutable writable)
+	      (letrec
+		  ((combine-primary-keys
+		    (cond
+		     ((and (= primary-limit column-limit)
+			   (> primary-limit 0))
+		      list->key)
+		     ((eq? list->key car) list->key)
+		     (else
+		      (case primary-limit
+			((1) (let ((keyify-1 ((base 'make-keyifier-1)
+					      (car column-type-list))))
+			       (lambda (row) (keyify-1 (car row)))))
+			((2) (lambda (row)
+			       (list->key (list (car row) (cadr row)))))
+			((3) (lambda (row)
+			       (list->key (list (car row) (cadr row)
+						(caddr row)))))
+			((4) (lambda (row)
+			       (list->key
+				(list (car row) (cadr row)
+				      (caddr row) (cadddr row)))))
+			(else (rdms:error 'combine-primary-keys
+					  "bad number of primary keys"
+					  primary-limit))))))
+		   (uir (row-eval cat:row catalog:integrity-rule-pos))
+		   (check-rules
+		    (lambda (row)
+		      (if (= column-limit (length row)) #t
+			  (rdms:error "bad row length:" row))
+		      (for-each
+		       (lambda (cir dir value column-name column-domain
+				    foreign)
+			 (cond
+			  ((and dir (not (dir value)))
+			   (rdms:error "violated domain integrity rule:"
+				       table-name column-name
+				       column-domain value))
+			  ((and cir (not (cir value)))
+			   (rdms:error "violated column integrity rule:"
+				       table-name column-name value))
+			  ((and foreign (not (foreign value)))
+			   (rdms:error "foreign key missing:"
+				       table-name column-name value))))
+		       cirs dirs row column-name-alist column-domain-list
+		       column-foreign-list)
+		      (cond ((and uir (not (uir row)))
+			     (rdms:error "violated user integrity rule:"
+					 row)))))
+		   (putter
+		    ((basic 'make-putter) primary-limit column-type-list))
+		   (row:insert
+		    (lambda (row)
+		      (check-rules row)
+		      (let ((ckey (combine-primary-keys row)))
+			(if (present? base-table ckey)
+			    (rdms:error 'row:insert "row present:" row))
+			(putter base-table ckey
+				(list-tail row primary-limit)))))
+		   (row:update
+		    (lambda (row)
+		      (check-rules row)
+		      (putter base-table (combine-primary-keys row)
+			      (list-tail row primary-limit)))))
+
+		(export-method 'row:insert row:insert)
+		(export-method 'row:insert*
+			       (lambda (rows) (for-each row:insert rows)))
+		(export-method 'row:update row:update)
+		(export-method 'row:update*
+			       (lambda (rows) (for-each row:update rows))))
+
+	      (letrec ((base:delete (basic 'delete))
+		       (ckey:remove (lambda (ckey)
+				      (let ((r (ckey:retrieve ckey)))
+					(and r (base:delete base-table ckey))
+					r))))
+		(export-method 'row:remove
+			       (lambda keys
+				 (let ((ckey (list->key keys)))
+				   (and (present? base-table ckey)
+					(ckey:remove ckey)))))
+		(export-method 'row:delete
+			       (lambda keys
+				 (base:delete base-table (list->key keys))))
+		(export-method 'row:remove*
+			       (accumulate-over-table ckey:remove))
+		(export-method 'row:delete*
+			       (generalize-to-table
+				(lambda (ckey) (base:delete base-table ckey))))
+		(export-method 'close-table
+			       (lambda () (set! base-table #f)
+				       (set! desc-table #f)
+				       (set! export-alist #f))))))
+
+	    (export-method 'column-names (map car column-name-alist))
+	    (export-method 'column-foreigns column-foreign-list)
+	    (export-method 'column-domains column-domain-list)
+	    (export-method 'column-types column-type-list)
+	    (export-method 'primary-limit primary-limit)
+
+	    (let ((translate-column
+		   (lambda (column)
+		     ;;(print 'translate-column column column-name-alist)
+		     (let ((colp (assq column column-name-alist)))
+		       (cond (colp (cdr colp))
+			     ((and (number? column)
+				   (integer? column)
+				   (<= 1 column column-limit))
+			      column)
+			     (else (rdms:error "column not in table:"
+					       column table-name)))))))
+	      (lambda args
+		(cond
+		 ((null? args) #f)
+		 ((null? (cdr args))
+		  (let ((pp (assq (car args) export-alist)))
+		    (and pp (cdr pp))))
+		 ((not (null? (cddr args)))
+		  (rdms:error "too many arguments to methods:" args))
+		 (else
+		  (let ((ci (translate-column (cadr args))))
+		    (cond
+		     ((<= ci primary-limit) ;primary-key?
+		      (let ((key-extractor
+			     ((base 'make-key-extractor)
+			      primary-limit column-type-list ci)))
+			(case (car args)
+			  ((get) (lambda keys
+				   (and (present? base-table (list->key keys))
+					(list-ref keys (+ -1 ci)))))
+			  ((get*) (lambda ()
+				    (base:map-primary-key
+				     base-table
+				     (lambda (ckey) (key-extractor ckey)))))
+			  (else #f))))
+		     (else
+		      (let ((index (- ci (+ 1 primary-limit))))
+			(case (car args)
+			  ((get) (lambda keys
+				   (let ((row (base:get base-table
+							(list->key keys))))
+				     (and row (list-ref row index)))))
+			  ((get*) (lambda ()
+				    (base:map-primary-key
+				     base-table
+				     (lambda (ckey)
+				       (list-ref (base:get base-table ckey)
+						 index)))))
+			  (else #f)))))))))))))
+
+      (define create-table
+	(and
+	 mutable
+	 (lambda (table-name . desc)
+	   (if (not rdms:catalog)
+	       (set! rdms:catalog (open-table rdms:catalog-name #t)) #f)
+	   (cond
+	    ((table-exists? table-name)
+	     (rdms:error "table already exists:" table-name) #f)
+	    ((null? desc)
+	     (let ((colt-id
+		    (base:make-table lldb 1 (itypes columns:init-cols))))
+	       ((rdms:catalog 'row:insert)
+		(list table-name
+		      (length columns:init-cols)
+		      ((rdms:catalog 'get 'coltab-name)
+		       rdms:columns-name)
+		      colt-id
+		      #f
+		      #f)))
+	     (open-table table-name #t))
+	    ((null? (cdr desc))
+	     (set! desc (car desc))
+	     (let ((colt-id ((rdms:catalog 'get 'bastab-id) desc)))
+	       (cond
+		(colt-id
+		 (let ((coltable (open-table desc #f))
+		       (types '())
+		       (prilimit 0)
+		       (colimit 0)
+		       (colerr #f))
+		   (for-each (lambda (n p d)
+			       (if (number? n) (set! colimit (max colimit n))
+				   (set! colerr #t))
+			       (if p (set! prilimit (+ 1 prilimit)) #f)
+			       (set! types
+				     (cons (dom:get-row base:domains d)
+					   types)))
+			     ((coltable 'get* 'column-number))
+			     ((coltable 'get* 'primary-key?))
+			     ((coltable 'get* 'domain-name)))
+		   (cond (colerr (rdms:error "some column lacks a number.") #f)
+			 ((or (< prilimit 1)
+			      (and (> prilimit 4)
+				   (not (= prilimit colimit))))
+			  (rdms:error "unreasonable number of primary keys:"
+				      prilimit))
+			 (else
+			  ((rdms:catalog 'row:insert)
+			   (list table-name colimit desc
+				 (base:make-table lldb prilimit types) #f #f))
+			  (open-table table-name #t)))))
+		(else
+		 (rdms:error "table descriptor not found for:" desc) #f))))
+	    (else (rdms:error 'create-table "too many args:"
+			      (cons table-name desc))
+		  #f)))))
+
+      (define (table-exists? table-name)
+	(present? base:catalog (cat:keyify-1 table-name)))
+
+      (define delete-table
+	(and mutable
+	     (lambda (table-name)
+	       (if (not rdms:catalog)
+		   (set! rdms:catalog (open-table rdms:catalog-name #t)) #f)
+	       (let ((table (open-table table-name #t))
+		     (row ((rdms:catalog 'row:remove) table-name)))
+		 (and row (base:kill-table
+			   lldb
+			   (list-ref row (+ -1 catalog:bastab-id-pos))
+			   (table 'primary-limit)
+			   (table 'column-type-list))
+		      row)))))
+
+      (lambda (operation-name)
+	(case operation-name
+	  ((close-database) close-database)
+	  ((write-database) write-database)
+	  ((open-table) open-table)
+	  ((delete-table) delete-table)
+	  ((create-table) create-table)
+	  ((table-exists?) table-exists?)
+	  (else #f)))
+      )
+    (lambda (operation-name)
+      (case operation-name
+	((create-database) create-database)
+	((open-database) open-database)
+	(else #f)))
+    ))
diff --git a/recobj.scm b/recobj.scm
new file mode 100644
index 0000000..caf55a6
--- /dev/null
+++ b/recobj.scm
@@ -0,0 +1,54 @@
+;;; "recobj.scm" Records implemented as objects.
+;;;From: whumeniu@datap.ca (Wade Humeniuk)
+
+(require 'object)
+
+(define record-type-name (make-generic-method))
+(define record-accessor (make-generic-method))
+(define record-modifier (make-generic-method))
+(define record? (make-generic-predicate))
+(define record-constructor (make-generic-method))
+
+(define (make-record-type type-name field-names)
+  (define self (make-object))
+
+  (make-method! self record-type-name
+		(lambda (self)
+		  type-name))
+  (make-method! self record-accessor
+		(lambda (self field-name)
+		  (let ((index (comlist:position field-name field-names)))
+		    (if (not index)
+			(slib:error "record-accessor: invalid field-name argument."
+				    field-name))
+		    (lambda (obj)
+		      (record-accessor obj index)))))
+
+  (make-method! self record-modifier
+		(lambda (self field)
+		  (let ((index (comlist:position field field-names)))
+		    (if (not index)
+			(slib:error "record-accessor: invalid field-name argument."
+				    field-name))
+		    (lambda (obj newval)
+		      (record-modifier obj index newval)))))
+  
+  (make-method! self record? (lambda (self) #t))
+
+  (make-method! self record-constructor
+		  (lambda (class . field-values)
+		    (let ((values (apply vector field-values)))
+		      (define self (make-object))
+		      (make-method! self record-accessor
+				    (lambda (self index)
+				      (vector-ref values index)))
+		      (make-method! self record-modifier
+				    (lambda (self index newval)
+				      (vector-set! values index newval)))
+		      (make-method! self record-type-name
+				    (lambda (self) (record-type-name class)))
+		      self)))
+  self)
+
+(provide 'record-object)
+(provide 'record)
\ No newline at end of file
diff --git a/record.scm b/record.scm
new file mode 100644
index 0000000..555d3ea
--- /dev/null
+++ b/record.scm
@@ -0,0 +1,211 @@
+; "record.scm" record data types
+; Written by David Carlton, carlton@husc.harvard.edu.
+; Re-Written by Aubrey Jaffer, jaffer@ai.mit.edu
+;
+; This code is in the public domain.
+
+; Implements `record' data structures for Scheme.  Using only the
+; opacity of procedures, makes record datatypes and
+; record-type-descriptors disjoint from R4RS types and each other, and
+; prevents forgery and corruption (modification without using
+; RECORD-MODIFIER) of records.
+
+(require 'common-list-functions)
+
+(define vector? vector?)
+(define vector-ref vector-ref)
+(define vector-set! vector-set!)
+(define vector-fill! vector-fill!)
+(define vector->list vector->list)
+
+(define record-modifier #f)
+(define record-accessor #f)
+(define record-constructor #f)
+(define record-predicate #f)
+(define make-record-type #f)
+
+(let (;; Need to close these to keep magic-cookie hidden.
+      (make-vector make-vector)
+      (vector vector)
+
+      ;; We have to wrap these to keep magic-cookie hidden.
+      (vect? vector?)
+      (vect-ref vector-ref)
+      (vect->list vector->list)
+
+      ;; Need to wrap these to protect record data from being corrupted.
+      (vect-set! vector-set!)
+      (vect-fill! vector-fill!)
+
+      (nvt "of non-vector type")
+      )
+  (letrec
+      (;; Tag to identify rtd's.  (A record is identified by the rtd
+       ;; that begins it.)
+       (magic-cookie (cons 'rtd '()))
+       (rtd? (lambda (object)
+	       (and (vect? object)
+		    (not (= (vector-length object) 0))
+		    (eq? (rtd-tag object) magic-cookie))))
+       (rec? (lambda (obj)
+	       (and (vect? obj)
+		    (>= (vector-length obj) 1)
+		    (or (eq? magic-cookie (rec-rtd obj))
+			(rtd? (rec-rtd obj))))))
+
+       (vec:error
+	(lambda (proc-name msg obj)
+	  (slib:error proc-name msg
+		      (cond ((rtd? obj) 'rtd)
+			    ((rec? obj) (rtd-name (rec-rtd obj)))
+			    (else obj)))))
+
+       ;; Internal accessor functions.  No error checking.
+       (rtd-tag (lambda (x) (vect-ref x 0)))
+       (rtd-name (lambda (rtd) (vect-ref rtd 1)))
+       (rtd-fields (lambda (rtd) (vect-ref rtd 3)))
+       ;; rtd-vfields is padded out to the length of the vector, which is 1
+       ;; more than the number of fields
+       (rtd-vfields (lambda (rtd) (cons #f (rtd-fields rtd))))
+       ;; rtd-length is the length of the vector.
+       (rtd-length (lambda (rtd) (vect-ref rtd 4)))
+
+       (rec-rtd (lambda (x) (vect-ref x 0)))
+
+       (make-rec-type
+	(lambda (type-name field-names)
+	  (if (not (string? type-name))
+	      (slib:error 'make-record-type "non-string type-name argument."
+			  type-name))
+	  (if (or (and (list? field-names) (comlist:has-duplicates? field-names))
+		  (comlist:notevery symbol? field-names))
+	      (slib:error 'make-record-type "illegal field-names argument."
+			  field-names))
+	  (let* ((augmented-length (+ 1 (length field-names)))
+		 (rtd (vector magic-cookie
+			      type-name
+			      '()
+			      field-names
+			      augmented-length
+			      #f
+			      #f)))
+	    (vect-set! rtd 5
+		       (lambda (x)
+			 (and (vect? x)
+			      (= (vector-length x) augmented-length)
+			      (eq? (rec-rtd x) rtd))))
+	    (vect-set! rtd 6
+		       (lambda (x)
+			 (and (vect? x)
+			      (>= (vector-length x) augmented-length)
+			      (eq? (rec-rtd x) rtd)
+			      #t)))
+	    rtd)))
+
+       (rec-predicate
+	(lambda (rtd)
+	  (if (not (rtd? rtd))
+	      (slib:error 'record-predicate "invalid argument." rtd))
+	  (vect-ref rtd 5)))
+
+       (rec-constructor
+	(lambda (rtd . field-names)
+	  (if (not (rtd? rtd))
+	      (slib:error 'record-constructor "illegal rtd argument." rtd))
+	  (if (or (null? field-names)
+		  (equal? field-names (rtd-fields rtd)))
+	      (let ((rec-length (- (rtd-length rtd) 1)))
+		(lambda elts
+		  (if (= (length elts) rec-length) #t
+		      (slib:error 'record-constructor
+				  (rtd-name rtd)
+				  "wrong number of arguments."))
+		  (apply vector rtd elts)))
+	      (let ((rec-vfields (rtd-vfields rtd))
+		    (corrected-rec-length (rtd-length rtd))
+		    (field-names (car field-names)))
+		(if (or (and (list? field-names) (comlist:has-duplicates? field-names))
+			(comlist:notevery (lambda (x) (memq x rec-vfields))
+					  field-names))
+		    (slib:error
+		     'record-constructor "invalid field-names argument."
+		     (cdr rec-vfields)))
+		(let ((field-length (length field-names))
+		      (offsets
+		       (map (lambda (field) (comlist:position field rec-vfields))
+			    field-names)))
+		  (lambda elts
+		    (if (= (length elts) field-length) #t
+			(slib:error 'record-constructor
+				    (rtd-name rtd)
+				    "wrong number of arguments."))
+		    (let ((result (make-vector corrected-rec-length)))
+		      (vect-set! result 0 rtd)
+		      (for-each (lambda (offset elt)
+				  (vect-set! result offset elt))
+				offsets
+				elts)
+		      result)))))))
+
+       (rec-accessor
+	(lambda (rtd field-name)
+	  (if (not (rtd? rtd))
+	      (slib:error 'record-accessor "invalid rtd argument." rtd))
+	  (let ((index (comlist:position field-name (rtd-vfields rtd)))
+		(augmented-length (rtd-length rtd)))
+	    (if (not index)
+		(slib:error 'record-accessor "invalid field-name argument."
+			    field-name))
+	    (lambda (x)
+	      (if (and (vect? x)
+		       (>= (vector-length x) augmented-length)
+		       (eq? rtd (rec-rtd x)))
+		  #t
+		  (slib:error 'record-accessor "wrong record type." x "not" rtd))
+	      (vect-ref x index)))))
+
+       (rec-modifier
+	(lambda (rtd field-name)
+	  (if (not (rtd? rtd))
+	      (slib:error 'record-modifier "invalid rtd argument." rtd))
+	  (let ((index (comlist:position field-name (rtd-vfields rtd)))
+		(augmented-length (rtd-length rtd)))
+	    (if (not index)
+		(slib:error 'record-modifier "invalid field-name argument."
+			    field-name))
+	    (lambda (x y)
+	      (if (and (vect? x)
+		       (>= (vector-length x) augmented-length)
+		       (eq? rtd (rec-rtd x)))
+		  #t
+		  (slib:error 'record-modifier "wrong record type." x "not" rtd))
+	      (vect-set! x index y)))))
+       )
+
+    (set! vector? (lambda (obj) (and (not (rec? obj)) (vector? obj))))
+    (set! vector-ref
+	  (lambda (vector k)
+	    (cond ((rec? vector)
+		   (vec:error 'vector-ref nvt vector))
+		  (else (vect-ref vector k)))))
+    (set! vector->list
+	  (lambda (vector k)
+	    (cond ((rec? vector)
+		   (vec:error 'vector->list nvt vector))
+		  (else (vect->list vector k)))))
+    (set! vector-set!
+	  (lambda (vector k obj)
+	    (cond ((rec? vector)
+		   (vec:error 'vector-set! nvt vector))
+		  (else (vect-set! vector k obj)))))
+    (set! vector-fill!
+	  (lambda (vector fill)
+	    (cond ((rec? vector)
+		   (vec:error 'vector-fill! nvt vector))
+		  (else (vect-fill! vector fill)))))
+    (set! record-modifier rec-modifier)
+    (set! record-accessor rec-accessor)
+    (set! record-constructor rec-constructor)
+    (set! record-predicate rec-predicate)
+    (set! make-record-type make-rec-type)
+    ))
diff --git a/repl.scm b/repl.scm
new file mode 100644
index 0000000..f51f493
--- /dev/null
+++ b/repl.scm
@@ -0,0 +1,92 @@
+; "repl.scm", read-eval-print-loop for Scheme
+; Copyright (c) 1993, Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'dynamic-wind)
+(define (repl:quit) (slib:error "not in repl:repl"))
+
+(define (repl:top-level repl:eval)
+  (repl:repl (lambda () (display "> ")
+		     (force-output (current-output-port))
+		     (read))
+	     repl:eval
+	     (lambda objs
+	       (cond ((null? objs))
+		     (else
+		      (write (car objs))
+		      (for-each (lambda (obj)
+				  (display " ;") (newline) (write obj))
+				(cdr objs))))
+	       (newline))))
+
+(define (repl:repl repl:read repl:eval repl:print)
+  (let* ((old-quit repl:quit)
+	 (old-error slib:error)
+	 (old-eval slib:eval)
+	 (old-load load)
+	 (repl:load (lambda (<pathname>)
+		      (call-with-input-file <pathname>
+			(lambda (port)
+			  (let ((old-load-pathname *load-pathname*))
+			    (set! *load-pathname* <pathname>)
+			    (do ((o (read port) (read port)))
+				((eof-object? o))
+			      (repl:eval o))
+			    (set! *load-pathname* old-load-pathname))))))
+	 (repl:restart #f)
+	 (values? (provided? 'values))
+	 (has-char-ready? (provided? 'char-ready?))
+	 (repl:error (lambda args (require 'debug) (apply qpn args)
+			     (repl:restart #f))))
+    (dynamic-wind
+     (lambda ()
+       (set! load repl:load)
+       (set! slib:eval repl:eval)
+       (set! slib:error repl:error)
+       (set! repl:quit
+	     (lambda () (let ((cont repl:restart))
+			  (set! repl:restart #f)
+			  (cont #t)))))
+     (lambda ()
+       (do () ((call-with-current-continuation
+		(lambda (cont)
+		  (set! repl:restart cont)
+		  (do ((obj (repl:read) (repl:read)))
+		      ((eof-object? obj) (repl:quit))
+		    (cond
+		     (has-char-ready?
+		      (let loop ()
+			(cond ((char-ready?)
+			       (let ((c (peek-char)))
+				 (cond
+				  ((eof-object? c))
+				  ((char=? #\newline c) (read-char))
+				  ((char-whitespace? c)
+				   (read-char) (loop))
+				  (else (newline)))))))))
+		    (if values?
+			(call-with-values (lambda () (repl:eval obj))
+					  repl:print)
+			(repl:print (repl:eval obj)))))))))
+     (lambda () (cond (repl:restart
+		       (display ">>ERROR<<") (newline)
+		       (repl:restart #f)))
+	     (set! load old-load)
+	     (set! slib:eval old-eval)
+	     (set! slib:error old-error)
+	     (set! repl:quit old-quit)))))
diff --git a/report.scm b/report.scm
new file mode 100644
index 0000000..64f4d46
--- /dev/null
+++ b/report.scm
@@ -0,0 +1,116 @@
+;;; "report.scm" relational-database-utility
+; Copyright 1995 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;;; Considerations for report generation:
+; * columnar vs. fixed-multi-line vs. variable-multi-line
+; * overflow lines within column boundaries.
+; * break overflow across page?
+; * Page headers and footers (need to know current/previous record-number
+;   and next record-number).
+; * Force page break on general expression (needs next row as arg).
+; * Hierachical reports.
+
+;================================================================
+
+(require 'format)
+(require 'database-utilities)
+
+(define (dbutil:database arg)
+  (cond ((procedure? arg) arg)
+	((string? arg) (dbutil:open-database arg))
+	((symbol? arg) (slib:eval arg))
+	(else (slib:error "can't coerce to database: " arg))))
+
+(define (dbutil:table arg)
+  (cond ((procedure? arg) arg)
+	((and (list? arg) (= 2 (length arg)))
+	 (((dbutil:database (car arg)) 'open-table) (cadr arg) #f))))
+
+(define (dbutil:print-report table header reporter footer . args)
+  (define output-port (and (pair? args) (car args)))
+  (define page-height (and (pair? args) (pair? (cdr args)) (cadr args)))
+  (define minimum-break
+    (and (pair? args) (pair? (cdr args)) (pair? (cddr args)) (caddr args)))
+  (set! table (dbutil:table table))
+  ((lambda (fun)
+     (cond ((output-port? output-port)
+	    (fun output-port))
+	   ((string? output-port)
+	    (call-with-output-file output-port fun))
+	   ((or (boolean? output-port) (null? output-port))
+	    (fun (current-output-port)))
+	   (else (slib:error "can't coerce to output-port: " arg))))
+   (lambda (output-port)
+     (set! page-height (or page-height (output-port-height output-port)))
+     (set! minimum-break (or minimum-break 0))
+     (let ((output-page 0)
+	   (output-line 0)
+	   (nth-newline-index
+	    (lambda (str n)
+	      (define len (string-length str))
+	      (do ((i 0 (+ i 1)))
+		  ((or (zero? n) (> i len)) (+ -1 i))
+		(cond ((char=? #\newline (string-ref str i))
+		       (set! n (+ -1 n)))))))
+	   (count-newlines
+	    (lambda (str)
+	      (define cnt 0)
+	      (do ((i (+ -1 (string-length str)) (+ -1 i)))
+		  ((negative? i) cnt)
+		(cond ((char=? #\newline (string-ref str i))
+		       (set! cnt (+ 1 cnt)))))))
+	   (format (let ((oformat format))
+		     (lambda (dest fmt arg)
+		       (cond ((not (procedure? fmt)) (oformat dest fmt arg))
+			     ((output-port? dest) (fmt dest arg))
+			     ((eq? #t dest) (fmt (current-output-port) arg))
+			     ((eq? #f dest) (call-with-output-string
+					     (lambda (port) (fmt port arg))))
+			     (else (oformat dest fmt arg)))))))
+       (define column-names (table 'column-names))
+       (define (do-header)
+	 (let ((str (format #f header column-names)))
+	   (display str output-port)
+	   (set! output-line (count-newlines str))))
+       (define (do-lines str inc)
+	 (cond
+	  ((< (+ output-line inc) page-height)
+	   (display str output-port)
+	   (set! output-line (+ output-line inc)))
+	  (else				;outputting footer
+	   (cond ((and (not (zero? minimum-break))
+		       (> cnt (* 2 minimum-break))
+		       (> (- page-height output-line) minimum-break))
+		  (let ((break (nth-newline-index
+				str (- page-height output-line))))
+		    (display (substring str 0 (+ 1 break) output-port))
+		    (set! str (substring str (+ 1 break) (string-length str)))
+		    (set! inc (- inc (- page-height output-line))))))
+	   (format output-port footer column-names)
+	   (display slib:form-feed output-port)
+	   (set! output-page (+ 1 output-page))
+	   (do-header)
+	   (do-lines str inc))))
+
+       (do-header)
+       ((table 'for-each-row)
+	(lambda (row)
+	  (let ((str (format #f reporter row)))
+	    (do-lines str (count-newlines str)))))
+       output-page))))
diff --git a/require.scm b/require.scm
new file mode 100644
index 0000000..d1ebe9a
--- /dev/null
+++ b/require.scm
@@ -0,0 +1,348 @@
+;;;; Implementation of VICINITY and MODULES for Scheme
+;Copyright (C) 1991, 1992, 1993, 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define *SLIB-VERSION* "2a6")
+
+;;; Standardize msdos -> ms-dos.
+(define software-type
+  (cond ((eq? 'msdos (software-type))
+	 (lambda () 'ms-dos))
+	(else software-type)))
+
+(define (user-vicinity)
+  (case (software-type)
+    ((VMS)	"[.]")
+    (else	"")))
+
+(define program-vicinity
+  (let ((*vicinity-suffix*
+	 (case (software-type)
+	   ((AMIGA)	'(#\: #\/))
+	   ((MS-DOS WINDOWS ATARIST OS/2)	'(#\\ #\/))
+	   ((MACOS THINKC)	'(#\:))
+	   ((NOSVE)	'(#\: #\.))
+	   ((UNIX COHERENT)	'(#\/))
+	   ((VMS)	'(#\: #\])))))
+    (lambda ()
+      (let loop ((i (- (string-length *load-pathname*) 1)))
+	(cond ((negative? i) "")
+	      ((memv (string-ref *load-pathname* i) *vicinity-suffix*)
+	       (substring *load-pathname* 0 (+ i 1)))
+	      (else (loop (- i 1))))))))
+
+(define sub-vicinity
+  (case (software-type)
+    ((VMS)
+     (lambda
+      (vic name)
+      (let ((l (string-length vic)))
+	(if (or (zero? (string-length vic))
+		(not (char=? #\] (string-ref vic (- l 1)))))
+	    (string-append vic "[" name "]")
+	    (string-append (substring vic 0 (- l 1))
+			   "." name "]")))))
+    (else
+     (let ((*vicinity-suffix*
+	    (case (software-type)
+	      ((NOSVE) ".")
+	      ((UNIX COHERENT AMIGA) "/")
+	      ((MACOS THINKC) ":")
+	      ((MS-DOS WINDOWS ATARIST OS/2) "\\"))))
+       (lambda (vic name)
+	 (string-append vic name *vicinity-suffix*))))))
+
+(define (make-vicinity <pathname>) <pathname>)
+
+(define *catalog*
+  (map
+   (lambda (p)
+     (if (symbol? (cdr p)) p
+	 (cons
+	  (car p)
+	  (if (pair? (cdr p))
+	      (cons 
+	       (cadr p)
+	       (in-vicinity (library-vicinity) (cddr p)))
+	      (in-vicinity (library-vicinity) (cdr p))))))
+   '(
+     (rev4-optional-procedures	.	"sc4opt")
+     (rev2-procedures		.	"sc2")
+     (multiarg/and-		.	"mularg")
+     (multiarg-apply		.	"mulapply")
+     (rationalize		.	"ratize")
+     (transcript		.	"trnscrpt")
+     (with-file			.	"withfile")
+     (dynamic-wind		.	"dynwind")
+     (dynamic			.	"dynamic")
+     (fluid-let		macro	.	"fluidlet")
+     (alist			.	"alist")
+     (hash			.	"hash")
+     (sierpinski		.	"sierpinski")
+     (soundex			.	"soundex")
+     (hash-table		.	"hashtab")
+     (logical			.	"logical")
+     (random			.	"random")
+     (random-inexact		.	"randinex")
+     (modular			.	"modular")
+     (primes			.	"primes")
+     (factor			.	"factor")
+     (charplot			.	"charplot")
+     (sort			.	"sort")
+     (tsort			.	topological-sort)
+     (topological-sort		.	"tsort")
+     (common-list-functions	.	"comlist")
+     (tree			.	"tree")
+     (format			.	"format")
+     (format-inexact		.	"formatfl")
+     (generic-write		.	"genwrite")
+     (pretty-print		.	"pp")
+     (pprint-file		.	"ppfile")
+     (object->string		.	"obj2str")
+     (string-case		.	"strcase")
+     (stdio			.	"stdio")
+     (printf			.	"printf")
+     (scanf			.	"scanf")
+     (line-i/o			.	"lineio")
+     (string-port		.	"strport")
+     (getopt			.	"getopt")
+     (debug			.	"debug")
+     (qp			.	"qp")
+     (break	defmacro	.	"break")
+     (trace	defmacro	.	"trace")
+;     (eval			.	"eval")
+     (record			.	"record")
+     (promise			.	"promise")
+     (synchk			.	"synchk")
+     (defmacroexpand		.	"defmacex")
+     (macro-by-example	defmacro	.	"mbe")
+     (syntax-case		.	"scainit")
+     (syntactic-closures	.	"scmacro")
+     (macros-that-work		.	"macwork")
+     (macro			.	macros-that-work)
+     (object			.	"object")
+     (record-object		.	"recobj")
+     (yasos		macro	.	"yasyn")
+     (oop			.	yasos)
+     (collect		macro	.	"collect")
+     (struct	defmacro	.	"struct")
+     (structure	syntax-case	.	"structure")
+     (values			.	"values")
+     (queue			.	"queue")
+     (priority-queue		.	"priorque")
+     (array			.	"array")
+     (array-for-each		.	"arraymap")
+     (repl			.	"repl")
+     (process			.	"process")
+     (chapter-order		.	"chap")
+     (posix-time		.	"time")
+     (common-lisp-time		.	"cltime")
+     (relational-database	.	"rdms")
+     (database-utilities	.	"dbutil")
+     (database-browse		.	"dbrowse")
+     (alist-table		.	"alistab")
+     (parameters		.	"paramlst")
+     (read-command		.	"comparse")
+     (batch			.	"batch")
+     (make-crc			.	"makcrc")
+     (wt-tree			.	"wttree")
+     (string-search		.	"strsrch")
+     (root			.	"root")
+     )))
+
+(set! *catalog*
+      (append (list
+	       (cons 'schelog
+		     (in-vicinity (sub-vicinity (library-vicinity) "schelog")
+				  "schelog"))
+	       (cons 'portable-scheme-debugger
+		     (in-vicinity (sub-vicinity (library-vicinity) "psd")
+				  "psd-slib")))
+	      *catalog*))
+
+(define *load-pathname* #f)
+
+(define (slib:pathnameize-load *old-load*)
+  (lambda (<pathname> . extra)
+    (let ((old-load-pathname *load-pathname*))
+      (set! *load-pathname* <pathname>)
+      (apply *old-load* (cons <pathname> extra))
+      (require:provide <pathname>)
+      (set! *load-pathname* old-load-pathname))))
+
+(set! slib:load-source
+      (slib:pathnameize-load slib:load-source))
+(set! slib:load
+      (slib:pathnameize-load slib:load))
+
+;;;; MODULES
+
+(define *modules* '())
+
+(define (require:provided? feature)
+  (if (symbol? feature)
+      (if (memq feature *features*) #t
+	  (let ((path (cdr (or (assq feature *catalog*) '(#f . #f)))))
+	    (cond ((symbol? path) (provided? path))
+		  ((member (if (pair? path) (cdr path) path) *modules*)
+		   #t)
+		  (else #f))))
+      (and (member feature *modules*) #t)))
+
+(define (require:feature->path feature)
+  (if (symbol? feature)
+      (let ((path (cdr (or (assq feature *catalog*) '(#f . #f)))))
+	(if (symbol? path) (require:feature->path path) path))
+      feature))
+
+(define (require:require feature)
+  (or (require:provided? feature)
+      (let ((path (require:feature->path feature)))
+	(cond ((and (not path) (string? feature) (file-exists? feature))
+	       (set! path feature)))
+	(cond ((not path)
+	       ;;(newline) (display ";required feature not supported: ")
+	       ;;(display feature) (newline)
+	       (slib:error ";required feature not supported: " feature))
+	      ((not (pair? path))	;simple name
+	       (slib:load path)
+	       (require:provide feature))
+	      (else			;special loads
+	       (require (car path))
+	       (apply (case (car path)
+			((macro) macro:load)
+			((syntactic-closures) synclo:load)
+			((syntax-case) syncase:load)
+			((macros-that-work) macwork:load)
+			((macro-by-example) defmacro:load)
+			((defmacro) defmacro:load)
+			((source) slib:load-source)
+			((compiled) slib:load-compiled))
+		      (if (list? path) (cdr path) (list (cdr path))))
+	       (require:provide feature))))))
+
+(define (require:provide feature)
+  (if (symbol? feature)
+      (if (not (memq feature *features*))
+	  (set! *features* (cons feature *features*)))
+      (if (not (member feature *modules*))
+	  (set! *modules* (cons feature *modules*)))))
+
+(require:provide 'vicinity)
+
+(define provide require:provide)
+(define provided? require:provided?)
+(define require require:require)
+
+;;; Supported by all implementations
+(provide 'eval)
+(provide 'defmacro)
+
+(if (and (string->number "0.0") (inexact? (string->number "0.0")))
+    (provide 'inexact))
+(if (rational? (string->number "1/19")) (provide 'rational))
+(if (real? (string->number "0.0")) (provide 'real))
+(if (complex? (string->number "1+i")) (provide 'complex))
+(let ((n (string->number "9999999999999999999999999999999")))
+  (if (and n (exact? n)) (provide 'bignum)))
+
+(define current-time
+  (if (provided? 'current-time) current-time
+      (let ((c 0))
+	(lambda () (set! c (+ c 1)) c))))
+(define difftime (if (provided? 'current-time) difftime -))
+(define offset-time (if (provided? 'current-time) offset-time +))
+
+(define report:print
+  (lambda args
+    (for-each (lambda (x) (write x) (display #\ )) args)
+    (newline)))
+
+(define slib:report
+  (let ((slib:report (lambda () (slib:report-version) (slib:report-locations))))
+    (lambda args
+      (cond ((null? args) (slib:report))
+	    ((not (string? (car args)))
+	     (slib:report-version) (slib:report-locations #t))
+	    ((require:provided? 'transcript)
+	     (transcript-on (car args))
+	     (slib:report)
+	     (transcript-off))
+	    ((require:provided? 'with-file)
+	     (with-output-to-file (car args) slib:report))
+	    (else (slib:report))))))
+
+(define slib:report-version
+  (lambda ()
+    (report:print
+     'SLIB *SLIB-VERSION* 'on (scheme-implementation-type)
+     (scheme-implementation-version) 'on (software-type))))
+
+(define slib:report-locations
+  (let ((features *features*) (catalog *catalog*))
+    (lambda args
+      (report:print '(IMPLEMENTATION-VICINITY) 'is (implementation-vicinity))
+      (report:print '(LIBRARY-VICINITY) 'is (library-vicinity))
+      (report:print '(SCHEME-FILE-SUFFIX) 'is (scheme-file-suffix))
+      (cond (*load-pathname*
+	     (report:print '*LOAD-PATHNAME* 'is *load-pathname*)))
+      (cond ((not (null? *modules*))
+	     (report:print 'Loaded '*MODULES* 'are: *modules*)))
+      (let* ((i (+ -1 5)))
+	(cond ((eq? (car features) (car *features*)))
+	      (else (report:print 'loaded '*FEATURES* ':) (display slib:tab)))
+	(for-each
+	 (lambda (x)
+	   (cond ((eq? (car features) x)
+		  (if (not (eq? (car features) (car *features*))) (newline))
+		  (report:print 'Implementation '*FEATURES* ':)
+		  (display slib:tab) (set! i (+ -1 5)))
+		 ((zero? i) (newline) (display slib:tab) (set! i (+ -1 5)))
+		 ((not (= (+ -1 5) i)) (display #\ )))
+	   (write x) (set! i (+ -1 i)))
+	 *features*))
+      (newline)
+      (let* ((i #t))
+	(cond ((not (eq? (car catalog) (car *catalog*)))
+	       (report:print 'Additional '*CATALOG* ':)))
+	(cond ((or (pair? args) (not (eq? (car catalog) (car *catalog*))))
+	       (for-each
+		(lambda (x)
+		  (cond ((eq? (car catalog) x)
+			 (report:print 'Implementation '*CATALOG* ':)
+			 (set! i (pair? args))
+			 (cond (i)
+			       (else (display slib:tab) (report:print x)
+				     (display slib:tab) (report:print '...)))))
+		  (cond (i (display slib:tab) (report:print x))))
+		*catalog*))
+	      (else (report:print 'Implementation '*CATALOG* ':)
+		    (display slib:tab) (report:print (car *catalog*))
+		    (display slib:tab) (report:print '...))))
+      (newline))))
+
+(let ((sit (scheme-implementation-version)))
+  (cond ((zero? (string-length sit)))
+	((or (not (string? sit)) (char=? #\? (string-ref sit 0)))
+	 (newline)
+	 (slib:report-version)
+	 (report:print 'edit (scheme-implementation-type) ".init"
+		       'to 'set '(scheme-implementation-version) 'string)
+	 (report:print '(IMPLEMENTATION-VICINITY) 'is (implementation-vicinity))
+	 (report:print 'type '(slib:report) 'for 'configuration)
+	 (newline))))
diff --git a/root.scm b/root.scm
new file mode 100644
index 0000000..5ba78c1
--- /dev/null
+++ b/root.scm
@@ -0,0 +1,149 @@
+;;;"root.scm" Newton's and Laguerre's methods for finding roots.
+;Copyright (C) 1996 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;;; Newton's Method explained in:
+;;; D. E. Knuth, "The Art of Computer Programming", Vol 2 /
+;;; Seminumerical Algorithms, Reading Massachusetts, Addison-Wesley
+;;; Publishing Company, 2nd Edition, p. 510
+
+(define (newton:find-integer-root f df/dx x_0)
+  (let loop ((x x_0) (fx (f x_0)))
+    (cond
+     ((zero? fx) x)
+     (else
+      (let ((df (df/dx x)))
+	(cond
+	 ((zero? df) #f)		; stuck at local min/max
+	 (else
+	  (let* ((delta (quotient (+ fx (quotient df 2)) df))
+		 (next-x (cond ((not (zero? delta)) (- x delta))
+			       ((positive? fx) (- x 1))
+			       (else (- x -1))))
+		 (next-fx (f next-x)))
+	    (cond ((>= (abs next-fx) (abs fx)) x)
+		  (else (loop next-x next-fx)))))))))))
+
+(define (integer-sqrt y)
+  (newton:find-integer-root (lambda (x) (- (* x x) y))
+			    (lambda (x) (* 2 x))
+			    (ash 1 (quotient (integer-length y) 2))))
+
+(define (newton:find-root f df/dx x_0 prec)
+  (if (and (negative? prec) (integer? prec))
+      (let loop ((x x_0) (fx (f x_0)) (count prec))
+	(cond ((zero? count) x)
+	      (else (let ((df (df/dx x)))
+		      (cond ((zero? df) #f) ; stuck at local min/max
+			    (else (let* ((next-x (- x (/ fx df)))
+					 (next-fx (f next-x)))
+				    (cond ((= next-x x) x)
+					  ((> (abs next-fx) (abs fx)) #f)
+					  (else (loop next-x next-fx
+						      (+ 1 count)))))))))))
+      (let loop ((x x_0) (fx (f x_0)))
+	(cond ((< (abs fx) prec) x)
+	      (else (let ((df (df/dx x)))
+		      (cond ((zero? df) #f) ; stuck at local min/max
+			    (else (let* ((next-x (- x (/ fx df)))
+					 (next-fx (f next-x)))
+				    (cond ((= next-x x) x)
+					  ((> (abs next-fx) (abs fx)) #f)
+					  (else (loop next-x next-fx))))))))))))
+
+;;; H. J. Orchard, "The Laguerre Method for Finding the Zeros of
+;;; Polynomials", IEEE Transactions on Circuits and Systems, Vol. 36,
+;;; No. 11, November 1989, pp 1377-1381.
+
+(define (laguerre:find-root f df/dz ddf/dz^2 z_0 prec)
+  (if (and (negative? prec) (integer? prec))
+      (let loop ((z z_0) (fz (f z_0)) (count prec))
+	(cond ((zero? count) z)
+	      (else
+	       (let* ((df (df/dz z))
+		      (ddf (ddf/dz^2 z))
+		      (disc (sqrt (- (* df df) (* fz ddf)))))
+		 (if (zero? disc)
+		     #f
+		     (let* ((next-z
+			     (- z (/ fz (if (negative? (+ (* (real-part df)
+							     (real-part disc))
+							  (* (imag-part df)
+							     (imag-part disc))))
+					    (- disc) disc))))
+			    (next-fz (f next-z)))
+		       (cond ((>= (magnitude next-fz) (magnitude fz)) z)
+			     (else (loop next-z next-fz (+ 1 count))))))))))
+      (let loop ((z z_0) (fz (f z_0)) (delta-z #f))
+	(cond ((< (magnitude fz) prec) z)
+	      (else
+	       (let* ((df (df/dz z))
+		      (ddf (ddf/dz^2 z))
+		      (disc (sqrt (- (* df df) (* fz ddf)))))
+		 (print 'disc disc)
+		 (if (zero? disc)
+		     #f
+		     (let* ((next-z
+			     (- z (/ fz (if (negative? (+ (* (real-part df)
+							     (real-part disc))
+							  (* (imag-part df)
+							     (imag-part disc))))
+					    (- disc) disc))))
+			    (next-delta-z (magnitude (- next-z z))))
+		       (print 'next-z next-z )
+		       (print '(f next-z) (f next-z))
+		       (print 'delta-z delta-z 'next-delta-z next-delta-z)
+		       (cond ((zero? next-delta-z) z)
+			     ((and delta-z (>= next-delta-z delta-z)) z)
+			     (else
+			      (loop next-z (f next-z) next-delta-z)))))))))))
+
+(define (laguerre:find-polynomial-root deg f df/dz ddf/dz^2 z_0 prec)
+  (if (and (negative? prec) (integer? prec))
+      (let loop ((z z_0) (fz (f z_0)) (count prec))
+	(cond ((zero? count) z)
+	      (else
+	       (let* ((df (df/dz z))
+		      (ddf (ddf/dz^2 z))
+		      (tmp (* (+ deg -1) df))
+		      (sqrt-H (sqrt (- (* tmp tmp) (* deg (+ deg -1) fz ddf))))
+		      (df+sqrt-H (+ df sqrt-H))
+		      (df-sqrt-H (- df sqrt-H))
+		      (next-z
+		       (- z (/ (* deg fz)
+			       (if (>= (magnitude df+sqrt-H)
+				       (magnitude df-sqrt-H))
+				   df+sqrt-H
+				   df-sqrt-H)))))
+		 (loop next-z (f next-z) (+ 1 count))))))
+      (let loop ((z z_0) (fz (f z_0)))
+	(cond ((< (magnitude fz) prec) z)
+	      (else
+	       (let* ((df (df/dz z))
+		      (ddf (ddf/dz^2 z))
+		      (tmp (* (+ deg -1) df))
+		      (sqrt-H (sqrt (- (* tmp tmp) (* deg (+ deg -1) fz ddf))))
+		      (df+sqrt-H (+ df sqrt-H))
+		      (df-sqrt-H (- df sqrt-H))
+		      (next-z
+		       (- z (/ (* deg fz)
+			       (if (>= (magnitude df+sqrt-H)
+				       (magnitude df-sqrt-H))
+				   df+sqrt-H
+				   df-sqrt-H)))))
+		 (loop next-z (f next-z))))))))
diff --git a/sc2.scm b/sc2.scm
new file mode 100644
index 0000000..5a10f84
--- /dev/null
+++ b/sc2.scm
@@ -0,0 +1,66 @@
+;"sc2.scm" Implementation of rev2 procedures eliminated in subsequent versions.
+; Copyright (C) 1991, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define (substring-move-left! string1 start1 end1 string2 start2)
+  (do ((i start1 (+ i 1))
+       (j start2 (+ j 1))
+       (l (- end1 start1) (- l 1)))
+      ((<= l 0))
+    (string-set! string2 j (string-ref string1 i))))
+
+(define (substring-move-right! string1 start1 end1 string2 start2)
+  (do ((i (+ start1 (- end1 start1) -1) (- i 1))
+       (j (+ start2 (- end1 start1) -1) (- j 1))
+       (l (- end1 start1) (- l 1)))
+      ((<= l 0))
+    (string-set! string2 j (string-ref string1 i))))
+
+(define (substring-fill! string start end char)
+  (do ((i start (+ i 1))
+       (l (- end start) (- l 1)))
+      ((<= l 0))
+    (string-set! string i char)))
+
+(define (string-null? str)
+  (= 0 (string-length str)))
+
+(define append!
+  (lambda args
+    (cond ((null? args) '())
+	  ((null? (cdr args)) (car args))
+	  ((null? (car args)) (apply append! (cdr args)))
+	  (else
+	   (set-cdr! (last-pair (car args))
+		     (apply append! (cdr args)))
+	   (car args)))))
+
+;;;; need to add code for OBJECT-HASH and OBJECT-UNHASH
+
+(define 1+
+  (let ((+ +))
+    (lambda (n) (+ n 1))))
+(define -1+
+  (let ((+ +))
+    (lambda (n) (+ n -1))))
+
+(define <? <)
+(define <=? <=)
+(define =? =)
+(define >? >)
+(define >=? >=)
diff --git a/sc4opt.scm b/sc4opt.scm
new file mode 100644
index 0000000..176d7f1
--- /dev/null
+++ b/sc4opt.scm
@@ -0,0 +1,53 @@
+;"sc4opt.scm" Implementation of optional Scheme^4 functions for IEEE Scheme
+;Copyright (C) 1991, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; Some of these functions may be already defined in your Scheme.
+;;; Comment out those definitions for functions which are already defined.
+
+;;; This code conforms to: William Clinger and Jonathan Rees, editors.
+;;; Revised^4 Report on the Algorithmic Language Scheme.
+
+(define (list-tail l p)
+  (if (< p 1) l (list-tail (cdr l) (- p 1))))
+
+(define (string->list s)
+  (do ((i (- (string-length s) 1) (- i 1))
+       (l '() (cons (string-ref s i) l)))
+      ((< i 0) l)))
+
+(define (list->string l) (apply string l))
+
+(define string-copy string-append)
+
+(define (string-fill! s obj)
+  (do ((i (- (string-length s) 1) (- i 1)))
+      ((< i 0))
+      (string-set! s i obj)))
+
+(define (list->vector l) (apply vector l))
+
+(define (vector->list s)
+  (do ((i (- (vector-length s) 1) (- i 1))
+       (l '() (cons (vector-ref s i) l)))
+      ((< i 0) l)))
+
+(define (vector-fill! s obj)
+  (do ((i (- (vector-length s) 1) (- i 1)))
+      ((< i 0))
+      (vector-set! s i obj)))
diff --git a/sc4sc3.scm b/sc4sc3.scm
new file mode 100644
index 0000000..a120c5d
--- /dev/null
+++ b/sc4sc3.scm
@@ -0,0 +1,35 @@
+;"sc4sc3.scm" Implementation of rev4 procedures for rev3.
+;Copyright (C) 1991 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;;; peek-char, number->string, and string->number need to be written here.
+
+;;; APPEND, +, *, -, /, =, <, >, <=, >=, MAP, and FOR-EACH need to
+;;; accept more general number or arguments.
+
+(define (list? x)
+  (let loop ((fast x) (slow x))
+    (or (null? fast)
+	(and (pair? fast)
+	     (let ((fast (cdr fast)))
+	       (or (null? fast)
+		   (and (pair? fast) 
+			(let ((fast (cdr fast))
+			      (slow (cdr slow)))
+			  (and (not (eq? fast slow))
+			       (loop fast slow))))))))))
diff --git a/scaexpp.scm b/scaexpp.scm
new file mode 100644
index 0000000..aa058a6
--- /dev/null
+++ b/scaexpp.scm
@@ -0,0 +1,2956 @@
+;;; "scaexpp.scm" syntax-case macros
+;;; Copyright (C) 1992 R. Kent Dybvig
+;;;
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full.  This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; Written by Robert Hieb & Kent Dybvig
+
+;;; This file was munged by a simple minded sed script since it left
+;;; its original authors' hands.  See syncase.sh for the horrid details.
+
+(begin ((lambda ()
+(letrec ((lambda-var-list (lambda (vars)
+((letrec ((lvl (lambda (vars ls)
+(if (pair? vars)
+(lvl (cdr vars)
+(cons (car vars)
+ls))
+(if (id? vars)
+(cons vars
+ls)
+(if (null?
+vars)
+ls
+(if (syntax-object?
+vars)
+(lvl (unwrap
+vars)
+ls)
+(cons vars
+ls))))))))
+lvl)
+vars
+'())))
+(gen-var (lambda (id) (gen-sym (id-sym-name id))))
+(gen-sym (lambda (sym)
+(syncase:new-symbol-hook (symbol->string sym))))
+(strip (lambda (x)
+(if (syntax-object? x)
+(strip (syntax-object-expression x))
+(if (pair? x)
+((lambda (a d)
+(if (if (eq? a (car x))
+(eq? d (cdr x))
+#f)
+x
+(cons a d)))
+(strip (car x))
+(strip (cdr x)))
+(if (vector? x)
+((lambda (old)
+((lambda (new)
+(if (syncase:andmap eq? old new)
+x
+(list->vector new)))
+(map strip old)))
+(vector->list x))
+x)))))
+(regen (lambda (x)
+((lambda (g000139)
+(if (memv g000139 '(ref))
+(syncase:build-lexical-reference (cadr x))
+(if (memv g000139 '(primitive))
+(syncase:build-global-reference (cadr x))
+(if (memv g000139 '(id))
+(syncase:build-identifier (cadr x))
+(if (memv g000139 '(quote))
+(syncase:build-data (cadr x))
+(if (memv
+g000139
+'(lambda))
+(syncase:build-lambda
+(cadr x)
+(regen (caddr x)))
+(begin g000139
+(syncase:build-application
+(syncase:build-global-reference
+(car x))
+(map regen
+(cdr x))))))))))
+(car x))))
+(gen-vector (lambda (x)
+(if (eq? (car x) 'list)
+(syncase:list* 'vector (cdr x))
+(if (eq? (car x) 'quote)
+(list
+'quote
+(list->vector (cadr x)))
+(list 'list->vector x)))))
+(gen-append (lambda (x y)
+(if (equal? y ''())
+x
+(list 'append x y))))
+(gen-cons (lambda (x y)
+(if (eq? (car y) 'list)
+(syncase:list* 'list x (cdr y))
+(if (if (eq? (car x) 'quote)
+(eq? (car y) 'quote)
+#f)
+(list
+'quote
+(cons (cadr x) (cadr y)))
+(if (equal? y ''())
+(list 'list x)
+(list 'cons x y))))))
+(gen-map (lambda (e map-env)
+((lambda (formals actuals)
+(if (eq? (car e) 'ref)
+(car actuals)
+(if (syncase:andmap
+(lambda (x)
+(if (eq? (car x) 'ref)
+(memq (cadr x)
+formals)
+#f))
+(cdr e))
+(syncase:list*
+'map
+(list 'primitive (car e))
+(map ((lambda (r)
+(lambda (x)
+(cdr (assq (cadr x)
+r))))
+(map cons
+formals
+actuals))
+(cdr e)))
+(syncase:list*
+'map
+(list 'lambda formals e)
+actuals))))
+(map cdr map-env)
+(map (lambda (x) (list 'ref (car x)))
+map-env))))
+(gen-ref (lambda (var level maps k)
+(if (= level 0)
+(k var maps)
+(gen-ref
+var
+(- level 1)
+(cdr maps)
+(lambda (outer-var outer-maps)
+((lambda (b)
+(if b
+(k (cdr b) maps)
+((lambda (inner-var)
+(k inner-var
+(cons (cons (cons outer-var
+inner-var)
+(car maps))
+outer-maps)))
+(gen-sym var))))
+(assq outer-var (car maps))))))))
+(chi-syntax (lambda (src exp r w)
+((letrec ((gen (lambda (e maps k)
+(if (id? e)
+((lambda (n)
+((lambda (b)
+(if (eq? (binding-type
+b)
+'syntax)
+((lambda (level)
+(if (< (length
+maps)
+level)
+(syntax-error
+src
+"missing ellipsis in")
+(gen-ref
+n
+level
+maps
+(lambda (x
+maps)
+(k (list
+'ref
+x)
+maps)))))
+(binding-value
+b))
+(if (ellipsis?
+(wrap e
+w))
+(syntax-error
+src
+"invalid context for ... in")
+(k (list
+'id
+(wrap e
+w))
+maps))))
+(lookup
+n
+e
+r)))
+(id-var-name
+e
+w))
+((lambda (g000141)
+((lambda (g000142)
+((lambda (g000140)
+(if (not (eq? g000140
+'no))
+((lambda (_dots1
+_dots2)
+(if (if (ellipsis?
+(wrap _dots1
+w))
+(ellipsis?
+(wrap _dots2
+w))
+#f)
+(k (list
+'id
+(wrap _dots1
+w))
+maps)
+(g000142)))
+(car g000140)
+(cadr g000140))
+(g000142)))
+(syntax-dispatch
+g000141
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(lambda ()
+((lambda (g000144)
+((lambda (g000145)
+((lambda (g000143)
+(if (not (eq? g000143
+'no))
+((lambda (_x
+_dots
+_y)
+(if (ellipsis?
+(wrap _dots
+w))
+(gen _y
+maps
+(lambda (y
+maps)
+(gen _x
+(cons '()
+maps)
+(lambda (x
+maps)
+(if (null?
+(car maps))
+(syntax-error
+src
+"extra ellipsis in")
+(k (gen-append
+(gen-map
+x
+(car maps))
+y)
+(cdr maps)))))))
+(g000145)))
+(car g000143)
+(cadr g000143)
+(caddr
+g000143))
+(g000145)))
+(syntax-dispatch
+g000144
+'(pair (any)
+pair
+(any)
+any)
+(vector))))
+(lambda ()
+((lambda (g000147)
+((lambda (g000146)
+(if (not (eq? g000146
+'no))
+((lambda (_x
+_y)
+(gen _x
+maps
+(lambda (x
+maps)
+(gen _y
+maps
+(lambda (y
+maps)
+(k (gen-cons
+x
+y)
+maps))))))
+(car g000146)
+(cadr g000146))
+((lambda (g000149)
+((lambda (g000148)
+(if (not (eq? g000148
+'no))
+((lambda (_e1
+_e2)
+(gen (cons _e1
+_e2)
+maps
+(lambda (e
+maps)
+(k (gen-vector
+e)
+maps))))
+(car g000148)
+(cadr g000148))
+((lambda (g000151)
+((lambda (g000150)
+(if (not (eq? g000150
+'no))
+((lambda (__)
+(k (list
+'quote
+(wrap e
+w))
+maps))
+(car g000150))
+(syntax-error
+g000151)))
+(syntax-dispatch
+g000151
+'(any)
+(vector))))
+g000149)))
+(syntax-dispatch
+g000149
+'(vector
+pair
+(any)
+each
+any)
+(vector))))
+g000147)))
+(syntax-dispatch
+g000147
+'(pair (any)
+any)
+(vector))))
+g000144))))
+g000141))))
+e)))))
+gen)
+exp
+'()
+(lambda (e maps) (regen e)))))
+(ellipsis? (lambda (x)
+;; I dont know what this is supposed to do, and removing it seemed harmless.
+;; (if (if (top-level-bound? 'dp) dp #f)
+;; (break)
+;; (syncase:void))
+(if (identifier? x)
+(free-id=? x '...)
+#f)))
+(chi-syntax-definition (lambda (e w)
+((lambda (g000153)
+((lambda (g000154)
+((lambda (g000152)
+(if (not (eq? g000152
+'no))
+((lambda (__
+_name
+_val)
+(if (id? _name)
+(list _name
+_val)
+(g000154)))
+(car g000152)
+(cadr g000152)
+(caddr
+g000152))
+(g000154)))
+(syntax-dispatch
+g000153
+'(pair (any)
+pair
+(any)
+pair
+(any)
+atom)
+(vector))))
+(lambda ()
+(syntax-error
+g000153))))
+(wrap e w))))
+(chi-definition (lambda (e w)
+((lambda (g000156)
+((lambda (g000157)
+((lambda (g000155)
+(if (not (eq? g000155
+'no))
+(apply
+(lambda (__
+_name
+_args
+_e1
+_e2)
+(if (if (id? _name)
+(valid-bound-ids?
+(lambda-var-list
+_args))
+#f)
+(list _name
+(cons '#(syntax-object
+lambda
+(top))
+(cons _args
+(cons _e1
+_e2))))
+(g000157)))
+g000155)
+(g000157)))
+(syntax-dispatch
+g000156
+'(pair (any)
+pair
+(pair (any) any)
+pair
+(any)
+each
+any)
+(vector))))
+(lambda ()
+((lambda (g000159)
+((lambda (g000158)
+(if (not (eq? g000158
+'no))
+((lambda (__
+_name
+_val)
+(list _name
+_val))
+(car g000158)
+(cadr g000158)
+(caddr
+g000158))
+((lambda (g000161)
+((lambda (g000162)
+((lambda (g000160)
+(if (not (eq? g000160
+'no))
+((lambda (__
+_name)
+(if (id? _name)
+(list _name
+(list '#(syntax-object
+syncase:void
+(top))))
+(g000162)))
+(car g000160)
+(cadr g000160))
+(g000162)))
+(syntax-dispatch
+g000161
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(lambda ()
+(syntax-error
+g000161))))
+g000159)))
+(syntax-dispatch
+g000159
+'(pair (any)
+pair
+(any)
+pair
+(any)
+atom)
+(vector))))
+g000156))))
+(wrap e w))))
+(chi-sequence (lambda (e w)
+((lambda (g000164)
+((lambda (g000163)
+(if (not (eq? g000163 'no))
+((lambda (__ _e) _e)
+(car g000163)
+(cadr g000163))
+(syntax-error g000164)))
+(syntax-dispatch
+g000164
+'(pair (any) each any)
+(vector))))
+(wrap e w))))
+(chi-macro-def (lambda (def r w)
+(syncase:eval-hook (chi def null-env w))))
+(chi-local-syntax (lambda (e r w)
+((lambda (g000166)
+((lambda (g000167)
+((lambda (g000165)
+(if (not (eq? g000165
+'no))
+(apply
+(lambda (_who
+_var
+_val
+_e1
+_e2)
+(if (valid-bound-ids?
+_var)
+((lambda (new-vars)
+((lambda (new-w)
+(chi-body
+(cons _e1
+_e2)
+e
+(extend-macro-env
+new-vars
+((lambda (w)
+(map (lambda (x)
+(chi-macro-def
+x
+r
+w))
+_val))
+(if (free-id=?
+_who
+'#(syntax-object
+letrec-syntax
+(top)))
+new-w
+w))
+r)
+new-w))
+(make-binding-wrap
+_var
+new-vars
+w)))
+(map gen-var
+_var))
+(g000167)))
+g000165)
+(g000167)))
+(syntax-dispatch
+g000166
+'(pair (any)
+pair
+(each pair
+(any)
+pair
+(any)
+atom)
+pair
+(any)
+each
+any)
+(vector))))
+(lambda ()
+((lambda (g000169)
+((lambda (g000168)
+(if (not (eq? g000168
+'no))
+((lambda (__)
+(syntax-error
+(wrap e
+w)))
+(car g000168))
+(syntax-error
+g000169)))
+(syntax-dispatch
+g000169
+'(any)
+(vector))))
+g000166))))
+e)))
+(chi-body (lambda (body source r w)
+(if (null? (cdr body))
+(chi (car body) r w)
+((letrec ((parse1 (lambda (body
+var-ids
+var-vals
+macro-ids
+macro-vals)
+(if (null? body)
+(syntax-error
+(wrap source
+w)
+"no expressions in body")
+((letrec ((parse2 (lambda (e)
+((lambda (b)
+((lambda (g000170)
+(if (memv
+g000170
+'(macro))
+(parse2
+(chi-macro
+(binding-value
+b)
+e
+r
+empty-wrap
+(lambda (e
+r
+w)
+(wrap e
+w))))
+(if (memv
+g000170
+'(definition))
+(parse1
+(cdr body)
+(cons (cadr b)
+var-ids)
+(cons (caddr
+b)
+var-vals)
+macro-ids
+macro-vals)
+(if (memv
+g000170
+'(syntax-definition))
+(parse1
+(cdr body)
+var-ids
+var-vals
+(cons (cadr b)
+macro-ids)
+(cons (caddr
+b)
+macro-vals))
+(if (memv
+g000170
+'(sequence))
+(parse1
+(append
+(cdr b)
+(cdr body))
+var-ids
+var-vals
+macro-ids
+macro-vals)
+(begin g000170
+(if (valid-bound-ids?
+(append
+var-ids
+macro-ids))
+((lambda (new-var-names
+new-macro-names)
+((lambda (w)
+((lambda (r)
+(syncase:build-letrec
+new-var-names
+(map (lambda (x)
+(chi x
+r
+w))
+var-vals)
+(syncase:build-sequence
+(map (lambda (x)
+(chi x
+r
+w))
+body))))
+(extend-macro-env
+new-macro-names
+(map (lambda (x)
+(chi-macro-def
+x
+r
+w))
+macro-vals)
+(extend-var-env
+new-var-names
+r))))
+(make-binding-wrap
+(append
+macro-ids
+var-ids)
+(append
+new-macro-names
+new-var-names)
+empty-wrap)))
+(map gen-var
+var-ids)
+(map gen-var
+macro-ids))
+(syntax-error
+(wrap source
+w)
+"invalid identifier"))))))))
+(car b)))
+(syntax-type
+e
+r
+empty-wrap)))))
+parse2)
+(car body))))))
+parse1)
+(map (lambda (x) (wrap x w)) body)
+'()
+'()
+'()
+'()))))
+(syntax-type (lambda (e r w)
+(if (syntax-object? e)
+(syntax-type
+(syntax-object-expression e)
+r
+(join-wraps
+(syntax-object-wrap e)
+w))
+(if (if (pair? e)
+(identifier? (car e))
+#f)
+((lambda (n)
+((lambda (b)
+((lambda (g000171)
+(if (memv
+g000171
+'(special))
+(if (memv
+n
+'(define))
+(cons 'definition
+(chi-definition
+e
+w))
+(if (memv
+n
+'(define-syntax))
+(cons 'syntax-definition
+(chi-syntax-definition
+e
+w))
+(if (memv
+n
+'(begin))
+(cons 'sequence
+(chi-sequence
+e
+w))
+(begin n
+(syncase:void)))))
+(begin g000171
+b)))
+(binding-type b)))
+(lookup n (car e) r)))
+(id-var-name (car e) w))
+'(other)))))
+(chi-args (lambda (args r w source source-w)
+(if (pair? args)
+(cons (chi (car args) r w)
+(chi-args
+(cdr args)
+r
+w
+source
+source-w))
+(if (null? args)
+'()
+(if (syntax-object? args)
+(chi-args
+(syntax-object-expression
+args)
+r
+(join-wraps
+w
+(syntax-object-wrap
+args))
+source
+source-w)
+(syntax-error
+(wrap source source-w)))))))
+(chi-ref (lambda (e name binding w)
+((lambda (g000172)
+(if (memv g000172 '(lexical))
+(syncase:build-lexical-reference name)
+(if (memv
+g000172
+'(global global-unbound))
+(syncase:build-global-reference name)
+(begin g000172
+(id-error
+(wrap e w))))))
+(binding-type binding))))
+(chi-macro (letrec ((check-macro-output (lambda (x)
+(if (pair?
+x)
+(begin (check-macro-output
+(car x))
+(check-macro-output
+(cdr x)))
+((lambda (g000173)
+(if g000173
+g000173
+(if (vector?
+x)
+((lambda (n)
+((letrec ((g000174 (lambda (i)
+(if (= i
+n)
+(syncase:void)
+(begin (check-macro-output
+(vector-ref
+x
+i))
+(g000174
+(+ i
+1)))))))
+g000174)
+0))
+(vector-length
+x))
+(if (symbol?
+x)
+(syntax-error
+x
+"encountered raw symbol")
+(syncase:void)))))
+(syntax-object?
+x))))))
+(lambda (p e r w k)
+((lambda (mw)
+((lambda (x)
+(check-macro-output x)
+(k x r mw))
+(p (wrap e (join-wraps mw w)))))
+(new-mark-wrap)))))
+(chi-pair (lambda (e r w k)
+((lambda (first rest)
+(if (id? first)
+((lambda (n)
+((lambda (b)
+((lambda (g000175)
+(if (memv
+g000175
+'(core))
+((binding-value b)
+e
+r
+w)
+(if (memv
+g000175
+'(macro))
+(chi-macro
+(binding-value
+b)
+e
+r
+w
+k)
+(if (memv
+g000175
+'(special))
+((binding-value
+b)
+e
+r
+w
+k)
+(begin g000175
+(syncase:build-application
+(chi-ref
+first
+n
+b
+w)
+(chi-args
+rest
+r
+w
+e
+w)))))))
+(binding-type b)))
+(lookup n first r)))
+(id-var-name first w))
+(syncase:build-application
+(chi first r w)
+(chi-args rest r w e w))))
+(car e)
+(cdr e))))
+(chi (lambda (e r w)
+(if (symbol? e)
+((lambda (n)
+(chi-ref e n (lookup n e r) w))
+(id-var-name e w))
+(if (pair? e)
+(chi-pair e r w chi)
+(if (syntax-object? e)
+(chi (syntax-object-expression e)
+r
+(join-wraps
+w
+(syntax-object-wrap e)))
+(if ((lambda (g000176)
+(if g000176
+g000176
+((lambda (g000177)
+(if g000177
+g000177
+((lambda (g000178)
+(if g000178
+g000178
+(char?
+e)))
+(string? e))))
+(number? e))))
+(boolean? e))
+(syncase:build-data e)
+(syntax-error (wrap e w))))))))
+(chi-top (lambda (e r w)
+(if (pair? e)
+(chi-pair e r w chi-top)
+(if (syntax-object? e)
+(chi-top
+(syntax-object-expression e)
+r
+(join-wraps
+w
+(syntax-object-wrap e)))
+(chi e r w)))))
+(wrap (lambda (x w)
+(if (null? w)
+x
+(if (syntax-object? x)
+(make-syntax-object
+(syntax-object-expression x)
+(join-wraps
+w
+(syntax-object-wrap x)))
+(if (null? x)
+x
+(make-syntax-object x w))))))
+(unwrap (lambda (x)
+(if (syntax-object? x)
+((lambda (e w)
+(if (pair? e)
+(cons (wrap (car e) w)
+(wrap (cdr e) w))
+(if (vector? e)
+(list->vector
+(map (lambda (x)
+(wrap x w))
+(vector->list e)))
+e)))
+(syntax-object-expression x)
+(syntax-object-wrap x))
+x)))
+(bound-id-member? (lambda (x list)
+(if (not (null? list))
+((lambda (g000179)
+(if g000179
+g000179
+(bound-id-member?
+x
+(cdr list))))
+(bound-id=? x (car list)))
+#f)))
+(valid-bound-ids? (lambda (ids)
+(if ((letrec ((all-ids? (lambda (ids)
+((lambda (g000181)
+(if g000181
+g000181
+(if (id? (car ids))
+(all-ids?
+(cdr ids))
+#f)))
+(null?
+ids)))))
+all-ids?)
+ids)
+((letrec ((unique? (lambda (ids)
+((lambda (g000180)
+(if g000180
+g000180
+(if (not (bound-id-member?
+(car ids)
+(cdr ids)))
+(unique?
+(cdr ids))
+#f)))
+(null?
+ids)))))
+unique?)
+ids)
+#f)))
+(bound-id=? (lambda (i j)
+(if (eq? (id-sym-name i)
+(id-sym-name j))
+((lambda (i j)
+(if (eq? (car i) (car j))
+(same-marks?
+(cdr i)
+(cdr j))
+#f))
+(id-var-name&marks i empty-wrap)
+(id-var-name&marks j empty-wrap))
+#f)))
+(free-id=? (lambda (i j)
+(if (eq? (id-sym-name i) (id-sym-name j))
+(eq? (id-var-name i empty-wrap)
+(id-var-name j empty-wrap))
+#f)))
+(id-var-name&marks (lambda (id w)
+(if (null? w)
+(if (symbol? id)
+(list id)
+(id-var-name&marks
+(syntax-object-expression
+id)
+(syntax-object-wrap
+id)))
+((lambda (n&m first)
+(if (pair? first)
+((lambda (n)
+((letrec ((search (lambda (rib)
+(if (null?
+rib)
+n&m
+(if (if (eq? (caar rib)
+n)
+(same-marks?
+(cdr n&m)
+(cddar
+rib))
+#f)
+(cdar rib)
+(search
+(cdr rib)))))))
+search)
+first))
+(car n&m))
+(cons (car n&m)
+(if ((lambda (g000182)
+(if g000182
+g000182
+(not (eqv? first
+(cadr n&m)))))
+(null?
+(cdr n&m)))
+(cons first
+(cdr n&m))
+(cddr n&m)))))
+(id-var-name&marks
+id
+(cdr w))
+(car w)))))
+(id-var-name (lambda (id w)
+(if (null? w)
+(if (symbol? id)
+id
+(id-var-name
+(syntax-object-expression
+id)
+(syntax-object-wrap id)))
+(if (pair? (car w))
+(car (id-var-name&marks id w))
+(id-var-name id (cdr w))))))
+(same-marks? (lambda (x y)
+(if (null? x)
+(null? y)
+(if (not (null? y))
+(if (eqv? (car x) (car y))
+(same-marks?
+(cdr x)
+(cdr y))
+#f)
+#f))))
+(join-wraps2 (lambda (w1 w2)
+((lambda (x w1)
+(if (null? w1)
+(if (if (not (pair? x))
+(eqv? x (car w2))
+#f)
+(cdr w2)
+(cons x w2))
+(cons x (join-wraps2 w1 w2))))
+(car w1)
+(cdr w1))))
+(join-wraps1 (lambda (w1 w2)
+(if (null? w1)
+w2
+(cons (car w1)
+(join-wraps1 (cdr w1) w2)))))
+(join-wraps (lambda (w1 w2)
+(if (null? w2)
+w1
+(if (null? w1)
+w2
+(if (pair? (car w2))
+(join-wraps1 w1 w2)
+(join-wraps2 w1 w2))))))
+(make-wrap-rib (lambda (ids new-names w)
+(if (null? ids)
+'()
+(cons ((lambda (n&m)
+(cons (car n&m)
+(cons (car new-names)
+(cdr n&m))))
+(id-var-name&marks
+(car ids)
+w))
+(make-wrap-rib
+(cdr ids)
+(cdr new-names)
+w)))))
+(make-binding-wrap (lambda (ids new-names w)
+(if (null? ids)
+w
+(cons (make-wrap-rib
+ids
+new-names
+w)
+w))))
+(new-mark-wrap (lambda ()
+(set! current-mark
+(+ current-mark 1))
+(list current-mark)))
+(current-mark 0)
+(top-wrap '(top))
+(empty-wrap '())
+(id-sym-name (lambda (x)
+(if (symbol? x)
+x
+(syntax-object-expression x))))
+(id? (lambda (x)
+((lambda (g000183)
+(if g000183
+g000183
+(if (syntax-object? x)
+(symbol?
+(syntax-object-expression x))
+#f)))
+(symbol? x))))
+(global-extend (lambda (type sym val)
+(extend-global-env
+sym
+(cons type val))))
+(lookup (lambda (name id r)
+(if (eq? name (id-sym-name id))
+(global-lookup name)
+((letrec ((search (lambda (r name)
+(if (null? r)
+'(displaced-lexical)
+(if (pair?
+(car r))
+(if (eq? (caar r)
+name)
+(cdar r)
+(search
+(cdr r)
+name))
+(if (eq? (car r)
+name)
+'(lexical)
+(search
+(cdr r)
+name)))))))
+search)
+r
+name))))
+(extend-syntax-env (lambda (vars vals r)
+(if (null? vars)
+r
+(cons (cons (car vars)
+(cons 'syntax
+(car vals)))
+(extend-syntax-env
+(cdr vars)
+(cdr vals)
+r)))))
+(extend-var-env append)
+(extend-macro-env (lambda (vars vals r)
+(if (null? vars)
+r
+(cons (cons (car vars)
+(cons 'macro
+(car vals)))
+(extend-macro-env
+(cdr vars)
+(cdr vals)
+r)))))
+(null-env '())
+(global-lookup (lambda (sym)
+((lambda (g000184)
+(if g000184
+g000184
+'(global-unbound)))
+(syncase:get-global-definition-hook sym))))
+(extend-global-env (lambda (sym binding)
+(syncase:put-global-definition-hook
+sym
+binding)))
+(binding-value cdr)
+(binding-type car)
+(arg-check (lambda (pred? x who)
+(if (not (pred? x))
+(syncase:error-hook who "invalid argument" x)
+(syncase:void))))
+(id-error (lambda (x)
+(syntax-error
+x
+"invalid context for identifier")))
+(scope-error (lambda (id)
+(syntax-error
+id
+"invalid context for bound identifier")))
+(syntax-object-wrap (lambda (x) (vector-ref x 2)))
+(syntax-object-expression (lambda (x) (vector-ref x 1)))
+(make-syntax-object (lambda (expression wrap)
+(vector
+'syntax-object
+expression
+wrap)))
+(syntax-object? (lambda (x)
+(if (vector? x)
+(if (= (vector-length x) 3)
+(eq? (vector-ref x 0)
+'syntax-object)
+#f)
+#f))))
+(global-extend 'core 'letrec-syntax chi-local-syntax)
+(global-extend 'core 'let-syntax chi-local-syntax)
+(global-extend
+'core
+'quote
+(lambda (e r w)
+((lambda (g000136)
+((lambda (g000135)
+(if (not (eq? g000135 'no))
+((lambda (__ _e) (syncase:build-data (strip _e)))
+(car g000135)
+(cadr g000135))
+((lambda (g000138)
+((lambda (g000137)
+(if (not (eq? g000137 'no))
+((lambda (__)
+(syntax-error (wrap e w)))
+(car g000137))
+(syntax-error g000138)))
+(syntax-dispatch
+g000138
+'(any)
+(vector))))
+g000136)))
+(syntax-dispatch
+g000136
+'(pair (any) pair (any) atom)
+(vector))))
+e)))
+(global-extend
+'core
+'syntax
+(lambda (e r w)
+((lambda (g000132)
+((lambda (g000131)
+(if (not (eq? g000131 'no))
+((lambda (__ _x) (chi-syntax e _x r w))
+(car g000131)
+(cadr g000131))
+((lambda (g000134)
+((lambda (g000133)
+(if (not (eq? g000133 'no))
+((lambda (__)
+(syntax-error (wrap e w)))
+(car g000133))
+(syntax-error g000134)))
+(syntax-dispatch
+g000134
+'(any)
+(vector))))
+g000132)))
+(syntax-dispatch
+g000132
+'(pair (any) pair (any) atom)
+(vector))))
+e)))
+(global-extend
+'core
+'syntax-lambda
+(lambda (e r w)
+((lambda (g000127)
+((lambda (g000128)
+((lambda (g000126)
+(if (not (eq? g000126 'no))
+((lambda (__ _id _level _exp)
+(if (if (valid-bound-ids? _id)
+(map (lambda (x)
+(if (integer? x)
+(if (exact? x)
+(not (negative?
+x))
+#f)
+#f))
+(map unwrap _level))
+#f)
+((lambda (new-vars)
+(syncase:build-lambda
+new-vars
+(chi _exp
+(extend-syntax-env
+new-vars
+(map unwrap
+_level)
+r)
+(make-binding-wrap
+_id
+new-vars
+w))))
+(map gen-var _id))
+(g000128)))
+(car g000126)
+(cadr g000126)
+(caddr g000126)
+(cadddr g000126))
+(g000128)))
+(syntax-dispatch
+g000127
+'(pair (any)
+pair
+(each pair (any) pair (any) atom)
+pair
+(any)
+atom)
+(vector))))
+(lambda ()
+((lambda (g000130)
+((lambda (g000129)
+(if (not (eq? g000129 'no))
+((lambda (__)
+(syntax-error (wrap e w)))
+(car g000129))
+(syntax-error g000130)))
+(syntax-dispatch
+g000130
+'(any)
+(vector))))
+g000127))))
+e)))
+(global-extend
+'core
+'lambda
+(lambda (e r w)
+((lambda (g000121)
+((lambda (g000120)
+(if (not (eq? g000120 'no))
+((lambda (__ _id _e1 _e2)
+(if (not (valid-bound-ids? _id))
+(syntax-error
+(wrap e w)
+"invalid parameter list")
+((lambda (new-vars)
+(syncase:build-lambda
+new-vars
+(chi-body
+(cons _e1 _e2)
+e
+(extend-var-env
+new-vars
+r)
+(make-binding-wrap
+_id
+new-vars
+w))))
+(map gen-var _id))))
+(car g000120)
+(cadr g000120)
+(caddr g000120)
+(cadddr g000120))
+((lambda (g000123)
+((lambda (g000122)
+(if (not (eq? g000122 'no))
+((lambda (__ _ids _e1 _e2)
+((lambda (old-ids)
+(if (not (valid-bound-ids?
+(lambda-var-list
+_ids)))
+(syntax-error
+(wrap e w)
+"invalid parameter list")
+((lambda (new-vars)
+(syncase:build-improper-lambda
+(reverse
+(cdr new-vars))
+(car new-vars)
+(chi-body
+(cons _e1
+_e2)
+e
+(extend-var-env
+new-vars
+r)
+(make-binding-wrap
+old-ids
+new-vars
+w))))
+(map gen-var
+old-ids))))
+(lambda-var-list _ids)))
+(car g000122)
+(cadr g000122)
+(caddr g000122)
+(cadddr g000122))
+((lambda (g000125)
+((lambda (g000124)
+(if (not (eq? g000124
+'no))
+((lambda (__)
+(syntax-error
+(wrap e w)))
+(car g000124))
+(syntax-error
+g000125)))
+(syntax-dispatch
+g000125
+'(any)
+(vector))))
+g000123)))
+(syntax-dispatch
+g000123
+'(pair (any)
+pair
+(any)
+pair
+(any)
+each
+any)
+(vector))))
+g000121)))
+(syntax-dispatch
+g000121
+'(pair (any)
+pair
+(each any)
+pair
+(any)
+each
+any)
+(vector))))
+e)))
+(global-extend
+'core
+'letrec
+(lambda (e r w)
+((lambda (g000116)
+((lambda (g000117)
+((lambda (g000115)
+(if (not (eq? g000115 'no))
+(apply
+(lambda (__ _id _val _e1 _e2)
+(if (valid-bound-ids? _id)
+((lambda (new-vars)
+((lambda (w r)
+(syncase:build-letrec
+new-vars
+(map (lambda (x)
+(chi x
+r
+w))
+_val)
+(chi-body
+(cons _e1 _e2)
+e
+r
+w)))
+(make-binding-wrap
+_id
+new-vars
+w)
+(extend-var-env
+new-vars
+r)))
+(map gen-var _id))
+(g000117)))
+g000115)
+(g000117)))
+(syntax-dispatch
+g000116
+'(pair (any)
+pair
+(each pair (any) pair (any) atom)
+pair
+(any)
+each
+any)
+(vector))))
+(lambda ()
+((lambda (g000119)
+((lambda (g000118)
+(if (not (eq? g000118 'no))
+((lambda (__)
+(syntax-error (wrap e w)))
+(car g000118))
+(syntax-error g000119)))
+(syntax-dispatch
+g000119
+'(any)
+(vector))))
+g000116))))
+e)))
+(global-extend
+'core
+'if
+(lambda (e r w)
+((lambda (g000110)
+((lambda (g000109)
+(if (not (eq? g000109 'no))
+((lambda (__ _test _then)
+(syncase:build-conditional
+(chi _test r w)
+(chi _then r w)
+(chi (list '#(syntax-object
+syncase:void
+(top)))
+r
+empty-wrap)))
+(car g000109)
+(cadr g000109)
+(caddr g000109))
+((lambda (g000112)
+((lambda (g000111)
+(if (not (eq? g000111 'no))
+((lambda (__ _test _then _else)
+(syncase:build-conditional
+(chi _test r w)
+(chi _then r w)
+(chi _else r w)))
+(car g000111)
+(cadr g000111)
+(caddr g000111)
+(cadddr g000111))
+((lambda (g000114)
+((lambda (g000113)
+(if (not (eq? g000113
+'no))
+((lambda (__)
+(syntax-error
+(wrap e w)))
+(car g000113))
+(syntax-error
+g000114)))
+(syntax-dispatch
+g000114
+'(any)
+(vector))))
+g000112)))
+(syntax-dispatch
+g000112
+'(pair (any)
+pair
+(any)
+pair
+(any)
+pair
+(any)
+atom)
+(vector))))
+g000110)))
+(syntax-dispatch
+g000110
+'(pair (any) pair (any) pair (any) atom)
+(vector))))
+e)))
+(global-extend
+'core
+'set!
+(lambda (e r w)
+((lambda (g000104)
+((lambda (g000105)
+((lambda (g000103)
+(if (not (eq? g000103 'no))
+((lambda (__ _id _val)
+(if (id? _id)
+((lambda (val n)
+((lambda (g000108)
+(if (memv
+g000108
+'(lexical))
+(syncase:build-lexical-assignment
+n
+val)
+(if (memv
+g000108
+'(global
+global-unbound))
+(syncase:build-global-assignment
+n
+val)
+(begin g000108
+(id-error
+(wrap _id
+w))))))
+(binding-type
+(lookup n _id r))))
+(chi _val r w)
+(id-var-name _id w))
+(g000105)))
+(car g000103)
+(cadr g000103)
+(caddr g000103))
+(g000105)))
+(syntax-dispatch
+g000104
+'(pair (any) pair (any) pair (any) atom)
+(vector))))
+(lambda ()
+((lambda (g000107)
+((lambda (g000106)
+(if (not (eq? g000106 'no))
+((lambda (__)
+(syntax-error (wrap e w)))
+(car g000106))
+(syntax-error g000107)))
+(syntax-dispatch
+g000107
+'(any)
+(vector))))
+g000104))))
+e)))
+(global-extend
+'special
+'begin
+(lambda (e r w k)
+((lambda (body)
+(if (null? body)
+(if (eqv? k chi-top)
+(chi (list '#(syntax-object syncase:void (top)))
+r
+empty-wrap)
+(syntax-error
+(wrap e w)
+"no expressions in body of"))
+(syncase:build-sequence
+((letrec ((dobody (lambda (body)
+(if (null? body)
+'()
+((lambda (first)
+(cons first
+(dobody
+(cdr body))))
+(k (car body)
+r
+empty-wrap))))))
+dobody)
+body))))
+(chi-sequence e w))))
+(global-extend
+'special
+'define
+(lambda (e r w k)
+(if (eqv? k chi-top)
+((lambda (n&v)
+((lambda (n)
+(global-extend 'global n '())
+(syncase:build-global-definition
+n
+(chi (cadr n&v) r empty-wrap)))
+(id-var-name (car n&v) empty-wrap)))
+(chi-definition e w))
+(syntax-error
+(wrap e w)
+"invalid context for definition"))))
+(global-extend
+'special
+'define-syntax
+(lambda (e r w k)
+(if (eqv? k chi-top)
+((lambda (n&v)
+(global-extend
+'macro
+(id-var-name (car n&v) empty-wrap)
+(chi-macro-def (cadr n&v) r empty-wrap))
+(chi (list '#(syntax-object syncase:void (top)))
+r
+empty-wrap))
+(chi-syntax-definition e w))
+(syntax-error
+(wrap e w)
+"invalid context for definition"))))
+(set! expand-syntax
+(lambda (x) (chi-top x null-env top-wrap)))
+(set! implicit-identifier
+(lambda (id sym)
+(arg-check id? id 'implicit-identifier)
+(arg-check symbol? sym 'implicit-identifier)
+(if (syntax-object? id)
+(wrap sym (syntax-object-wrap id))
+sym)))
+(set! syntax-object->datum (lambda (x) (strip x)))
+(set! generate-temporaries
+(lambda (ls)
+(arg-check list? ls 'generate-temporaries)
+(map (lambda (x) (wrap (syncase:new-symbol-hook "g") top-wrap)) ls)))
+(set! free-identifier=?
+(lambda (x y)
+(arg-check id? x 'free-identifier=?)
+(arg-check id? y 'free-identifier=?)
+(free-id=? x y)))
+(set! bound-identifier=?
+(lambda (x y)
+(arg-check id? x 'bound-identifier=?)
+(arg-check id? y 'bound-identifier=?)
+(bound-id=? x y)))
+(set! identifier? (lambda (x) (id? x)))
+(set! syntax-error
+(lambda (object . messages)
+(for-each
+(lambda (x) (arg-check string? x 'syntax-error))
+messages)
+((lambda (message)
+(syncase:error-hook 'expand-syntax message (strip object)))
+(if (null? messages)
+"invalid syntax"
+(apply string-append messages)))))
+(set! syncase:install-global-transformer
+(lambda (sym p) (global-extend 'macro sym p)))
+((lambda ()
+(letrec ((match (lambda (e p k w r)
+(if (eq? r 'no)
+r
+((lambda (g000100)
+(if (memv g000100 '(any))
+(cons (wrap e w) r)
+(if (memv
+g000100
+'(free-id))
+(if (if (identifier?
+e)
+(free-id=?
+(wrap e w)
+(vector-ref
+k
+(cdr p)))
+#f)
+r
+'no)
+(begin g000100
+(if (syntax-object?
+e)
+(match*
+(syntax-object-expression
+e)
+p
+k
+(join-wraps
+w
+(syntax-object-wrap
+e))
+r)
+(match*
+e
+p
+k
+w
+r))))))
+(car p)))))
+(match* (lambda (e p k w r)
+((lambda (g000101)
+(if (memv g000101 '(pair))
+(if (pair? e)
+(match
+(car e)
+(cadr p)
+k
+w
+(match
+(cdr e)
+(cddr p)
+k
+w
+r))
+'no)
+(if (memv g000101 '(each))
+(if (eq? (cadr p) 'any)
+((lambda (l)
+(if (eq? l 'no)
+l
+(cons l r)))
+(match-each-any
+e
+w))
+(if (null? e)
+(match-empty
+(cdr p)
+r)
+((lambda (l)
+(if (eq? l
+'no)
+l
+((letrec ((collect (lambda (l)
+(if (null?
+(car l))
+r
+(cons (map car
+l)
+(collect
+(map cdr
+l)))))))
+collect)
+l)))
+(match-each
+e
+(cdr p)
+k
+w))))
+(if (memv
+g000101
+'(atom))
+(if (equal?
+(cdr p)
+e)
+r
+'no)
+(if (memv
+g000101
+'(vector))
+(if (vector? e)
+(match
+(vector->list
+e)
+(cdr p)
+k
+w
+r)
+'no)
+(begin g000101
+(syncase:void)))))))
+(car p))))
+(match-empty (lambda (p r)
+((lambda (g000102)
+(if (memv g000102 '(any))
+(cons '() r)
+(if (memv
+g000102
+'(each))
+(match-empty
+(cdr p)
+r)
+(if (memv
+g000102
+'(pair))
+(match-empty
+(cadr p)
+(match-empty
+(cddr p)
+r))
+(if (memv
+g000102
+'(free-id
+atom))
+r
+(if (memv
+g000102
+'(vector))
+(match-empty
+(cdr p)
+r)
+(begin g000102
+(syncase:void))))))))
+(car p))))
+(match-each-any (lambda (e w)
+(if (pair? e)
+((lambda (l)
+(if (eq? l 'no)
+l
+(cons (wrap (car e)
+w)
+l)))
+(match-each-any
+(cdr e)
+w))
+(if (null? e)
+'()
+(if (syntax-object?
+e)
+(match-each-any
+(syntax-object-expression
+e)
+(join-wraps
+w
+(syntax-object-wrap
+e)))
+'no)))))
+(match-each (lambda (e p k w)
+(if (pair? e)
+((lambda (first)
+(if (eq? first 'no)
+first
+((lambda (rest)
+(if (eq? rest
+'no)
+rest
+(cons first
+rest)))
+(match-each
+(cdr e)
+p
+k
+w))))
+(match (car e) p k w '()))
+(if (null? e)
+'()
+(if (syntax-object? e)
+(match-each
+(syntax-object-expression
+e)
+p
+k
+(join-wraps
+w
+(syntax-object-wrap
+e)))
+'no))))))
+(set! syntax-dispatch
+(lambda (expression pattern keys)
+(match
+expression
+pattern
+keys
+empty-wrap
+'())))))))))
+(syncase:install-global-transformer
+'let
+(lambda (x)
+((lambda (g00095)
+((lambda (g00096)
+((lambda (g00094)
+(if (not (eq? g00094 'no))
+(apply
+(lambda (__ _x _v _e1 _e2)
+(if (syncase:andmap identifier? _x)
+(cons (cons '#(syntax-object
+lambda
+(top))
+(cons _x
+(cons _e1 _e2)))
+_v)
+(g00096)))
+g00094)
+(g00096)))
+(syntax-dispatch
+g00095
+'(pair (any)
+pair
+(each pair (any) pair (any) atom)
+pair
+(any)
+each
+any)
+(vector))))
+(lambda ()
+((lambda (g00098)
+((lambda (g00099)
+((lambda (g00097)
+(if (not (eq? g00097 'no))
+(apply
+(lambda (__ _f _x _v _e1 _e2)
+(if (syncase:andmap
+identifier?
+(cons _f _x))
+(cons (list '#(syntax-object
+letrec
+(top))
+(list (list _f
+(cons '#(syntax-object
+lambda
+(top))
+(cons _x
+(cons _e1
+_e2)))))
+_f)
+_v)
+(g00099)))
+g00097)
+(g00099)))
+(syntax-dispatch
+g00098
+'(pair (any)
+pair
+(any)
+pair
+(each pair (any) pair (any) atom)
+pair
+(any)
+each
+any)
+(vector))))
+(lambda () (syntax-error g00098))))
+g00095))))
+x)))
+(syncase:install-global-transformer
+'syntax-case
+((lambda ()
+(letrec ((syncase:build-dispatch-call (lambda (args body val)
+((lambda (g00046)
+((lambda (g00045)
+(if (not (eq? g00045
+'no))
+body
+((lambda (g00048)
+((lambda (g00047)
+(if (not (eq? g00047
+'no))
+((lambda (_arg1)
+((lambda (g00066)
+((lambda (g00065)
+(if (not (eq? g00065
+'no))
+((lambda (_body
+_val)
+(list (list '#(syntax-object
+syntax-lambda
+(top))
+(list _arg1)
+_body)
+(list '#(syntax-object
+car
+(top))
+_val)))
+(car g00065)
+(cadr g00065))
+(syntax-error
+g00066)))
+(syntax-dispatch
+g00066
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(list body
+val)))
+(car g00047))
+((lambda (g00050)
+((lambda (g00049)
+(if (not (eq? g00049
+'no))
+((lambda (_arg1
+_arg2)
+((lambda (g00064)
+((lambda (g00063)
+(if (not (eq? g00063
+'no))
+((lambda (_body
+_val)
+(list (list '#(syntax-object
+syntax-lambda
+(top))
+(list _arg1
+_arg2)
+_body)
+(list '#(syntax-object
+car
+(top))
+_val)
+(list '#(syntax-object
+cadr
+(top))
+_val)))
+(car g00063)
+(cadr g00063))
+(syntax-error
+g00064)))
+(syntax-dispatch
+g00064
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(list body
+val)))
+(car g00049)
+(cadr g00049))
+((lambda (g00052)
+((lambda (g00051)
+(if (not (eq? g00051
+'no))
+((lambda (_arg1
+_arg2
+_arg3)
+((lambda (g00062)
+((lambda (g00061)
+(if (not (eq? g00061
+'no))
+((lambda (_body
+_val)
+(list (list '#(syntax-object
+syntax-lambda
+(top))
+(list _arg1
+_arg2
+_arg3)
+_body)
+(list '#(syntax-object
+car
+(top))
+_val)
+(list '#(syntax-object
+cadr
+(top))
+_val)
+(list '#(syntax-object
+caddr
+(top))
+_val)))
+(car g00061)
+(cadr g00061))
+(syntax-error
+g00062)))
+(syntax-dispatch
+g00062
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(list body
+val)))
+(car g00051)
+(cadr g00051)
+(caddr
+g00051))
+((lambda (g00054)
+((lambda (g00053)
+(if (not (eq? g00053
+'no))
+((lambda (_arg1
+_arg2
+_arg3
+_arg4)
+((lambda (g00060)
+((lambda (g00059)
+(if (not (eq? g00059
+'no))
+((lambda (_body
+_val)
+(list (list '#(syntax-object
+syntax-lambda
+(top))
+(list _arg1
+_arg2
+_arg3
+_arg4)
+_body)
+(list '#(syntax-object
+car
+(top))
+_val)
+(list '#(syntax-object
+cadr
+(top))
+_val)
+(list '#(syntax-object
+caddr
+(top))
+_val)
+(list '#(syntax-object
+cadddr
+(top))
+_val)))
+(car g00059)
+(cadr g00059))
+(syntax-error
+g00060)))
+(syntax-dispatch
+g00060
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(list body
+val)))
+(car g00053)
+(cadr g00053)
+(caddr
+g00053)
+(cadddr
+g00053))
+((lambda (g00056)
+((lambda (g00055)
+(if (not (eq? g00055
+'no))
+((lambda (_arg)
+((lambda (g00058)
+((lambda (g00057)
+(if (not (eq? g00057
+'no))
+((lambda (_body
+_val)
+(list '#(syntax-object
+apply
+(top))
+(list '#(syntax-object
+syntax-lambda
+(top))
+_arg
+_body)
+_val))
+(car g00057)
+(cadr g00057))
+(syntax-error
+g00058)))
+(syntax-dispatch
+g00058
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(list body
+val)))
+(car g00055))
+(syntax-error
+g00056)))
+(syntax-dispatch
+g00056
+'(each any)
+(vector))))
+g00054)))
+(syntax-dispatch
+g00054
+'(pair (any)
+pair
+(any)
+pair
+(any)
+pair
+(any)
+atom)
+(vector))))
+g00052)))
+(syntax-dispatch
+g00052
+'(pair (any)
+pair
+(any)
+pair
+(any)
+atom)
+(vector))))
+g00050)))
+(syntax-dispatch
+g00050
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+g00048)))
+(syntax-dispatch
+g00048
+'(pair (any)
+atom)
+(vector))))
+g00046)))
+(syntax-dispatch
+g00046
+'(atom)
+(vector))))
+args)))
+(extract-bound-syntax-ids (lambda (pattern keys)
+((letrec ((gen (lambda (p
+n
+ids)
+(if (identifier?
+p)
+(if (key? p
+keys)
+ids
+(cons (list p
+n)
+ids))
+((lambda (g00068)
+((lambda (g00069)
+((lambda (g00067)
+(if (not (eq? g00067
+'no))
+((lambda (_x
+_dots)
+(if (ellipsis?
+_dots)
+(gen _x
+(+ n
+1)
+ids)
+(g00069)))
+(car g00067)
+(cadr g00067))
+(g00069)))
+(syntax-dispatch
+g00068
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(lambda ()
+((lambda (g00071)
+((lambda (g00070)
+(if (not (eq? g00070
+'no))
+((lambda (_x
+_y)
+(gen _x
+n
+(gen _y
+n
+ids)))
+(car g00070)
+(cadr g00070))
+((lambda (g00073)
+((lambda (g00072)
+(if (not (eq? g00072
+'no))
+((lambda (_x)
+(gen _x
+n
+ids))
+(car g00072))
+((lambda (g00075)
+((lambda (g00074)
+(if (not (eq? g00074
+'no))
+((lambda (_x)
+ids)
+(car g00074))
+(syntax-error
+g00075)))
+(syntax-dispatch
+g00075
+'(any)
+(vector))))
+g00073)))
+(syntax-dispatch
+g00073
+'(vector
+each
+any)
+(vector))))
+g00071)))
+(syntax-dispatch
+g00071
+'(pair (any)
+any)
+(vector))))
+g00068))))
+p)))))
+gen)
+pattern
+0
+'())))
+(valid-syntax-pattern? (lambda (pattern keys)
+(letrec ((check? (lambda (p
+ids)
+(if (identifier?
+p)
+(if (eq? ids
+'no)
+ids
+(if (key? p
+keys)
+ids
+(if (if (not (ellipsis?
+p))
+(not (memid
+p
+ids))
+#f)
+(cons p
+ids)
+'no)))
+((lambda (g00077)
+((lambda (g00078)
+((lambda (g00076)
+(if (not (eq? g00076
+'no))
+((lambda (_x
+_dots)
+(if (ellipsis?
+_dots)
+(check?
+_x
+ids)
+(g00078)))
+(car g00076)
+(cadr g00076))
+(g00078)))
+(syntax-dispatch
+g00077
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(lambda ()
+((lambda (g00080)
+((lambda (g00079)
+(if (not (eq? g00079
+'no))
+((lambda (_x
+_y)
+(check?
+_x
+(check?
+_y
+ids)))
+(car g00079)
+(cadr g00079))
+((lambda (g00082)
+((lambda (g00081)
+(if (not (eq? g00081
+'no))
+((lambda (_x)
+(check?
+_x
+ids))
+(car g00081))
+((lambda (g00084)
+((lambda (g00083)
+(if (not (eq? g00083
+'no))
+((lambda (_x)
+ids)
+(car g00083))
+(syntax-error
+g00084)))
+(syntax-dispatch
+g00084
+'(any)
+(vector))))
+g00082)))
+(syntax-dispatch
+g00082
+'(vector
+each
+any)
+(vector))))
+g00080)))
+(syntax-dispatch
+g00080
+'(pair (any)
+any)
+(vector))))
+g00077))))
+p)))))
+(not (eq? (check?
+pattern
+'())
+'no)))))
+(valid-keyword? (lambda (k)
+(if (identifier? k)
+(not (free-identifier=?
+k
+'...))
+#f)))
+(convert-syntax-dispatch-pattern (lambda (pattern
+keys)
+((letrec ((gen (lambda (p)
+(if (identifier?
+p)
+(if (key? p
+keys)
+(cons '#(syntax-object
+free-id
+(top))
+(key-index
+p
+keys))
+(list '#(syntax-object
+any
+(top))))
+((lambda (g00086)
+((lambda (g00087)
+((lambda (g00085)
+(if (not (eq? g00085
+'no))
+((lambda (_x
+_dots)
+(if (ellipsis?
+_dots)
+(cons '#(syntax-object
+each
+(top))
+(gen _x))
+(g00087)))
+(car g00085)
+(cadr g00085))
+(g00087)))
+(syntax-dispatch
+g00086
+'(pair (any)
+pair
+(any)
+atom)
+(vector))))
+(lambda ()
+((lambda (g00089)
+((lambda (g00088)
+(if (not (eq? g00088
+'no))
+((lambda (_x
+_y)
+(cons '#(syntax-object
+pair
+(top))
+(cons (gen _x)
+(gen _y))))
+(car g00088)
+(cadr g00088))
+((lambda (g00091)
+((lambda (g00090)
+(if (not (eq? g00090
+'no))
+((lambda (_x)
+(cons '#(syntax-object
+vector
+(top))
+(gen _x)))
+(car g00090))
+((lambda (g00093)
+((lambda (g00092)
+(if (not (eq? g00092
+'no))
+((lambda (_x)
+(cons '#(syntax-object
+atom
+(top))
+p))
+(car g00092))
+(syntax-error
+g00093)))
+(syntax-dispatch
+g00093
+'(any)
+(vector))))
+g00091)))
+(syntax-dispatch
+g00091
+'(vector
+each
+any)
+(vector))))
+g00089)))
+(syntax-dispatch
+g00089
+'(pair (any)
+any)
+(vector))))
+g00086))))
+p)))))
+gen)
+pattern)))
+(key-index (lambda (p keys)
+(- (length keys)
+(length (memid p keys)))))
+(key? (lambda (p keys)
+(if (identifier? p) (memid p keys) #f)))
+(memid (lambda (i ids)
+(if (not (null? ids))
+(if (bound-identifier=? i (car ids))
+ids
+(memid i (cdr ids)))
+#f)))
+(ellipsis? (lambda (x)
+(if (identifier? x)
+(free-identifier=? x '...)
+#f))))
+(lambda (x)
+((lambda (g00030)
+((lambda (g00031)
+((lambda (g00029)
+(if (not (eq? g00029 'no))
+((lambda (__ _val _key)
+(if (syncase:andmap valid-keyword? _key)
+(list '#(syntax-object
+syntax-error
+(top))
+_val)
+(g00031)))
+(car g00029)
+(cadr g00029)
+(caddr g00029))
+(g00031)))
+(syntax-dispatch
+g00030
+'(pair (any)
+pair
+(any)
+pair
+(each any)
+atom)
+(vector))))
+(lambda ()
+((lambda (g00033)
+((lambda (g00034)
+((lambda (g00032)
+(if (not (eq? g00032 'no))
+(apply
+(lambda (__
+_val
+_key
+_pat
+_exp)
+(if (if (identifier?
+_pat)
+(if (syncase:andmap
+valid-keyword?
+_key)
+(syncase:andmap
+(lambda (x)
+(not (free-identifier=?
+_pat
+x)))
+(cons '...
+_key))
+#f)
+#f)
+(list (list '#(syntax-object
+syntax-lambda
+(top))
+(list (list _pat
+0))
+_exp)
+_val)
+(g00034)))
+g00032)
+(g00034)))
+(syntax-dispatch
+g00033
+'(pair (any)
+pair
+(any)
+pair
+(each any)
+pair
+(pair (any) pair (any) atom)
+atom)
+(vector))))
+(lambda ()
+((lambda (g00036)
+((lambda (g00037)
+((lambda (g00035)
+(if (not (eq? g00035 'no))
+(apply
+(lambda (__
+_val
+_key
+_pat
+_exp
+_e1
+_e2
+_e3)
+(if (if (syncase:andmap
+valid-keyword?
+_key)
+(valid-syntax-pattern?
+_pat
+_key)
+#f)
+((lambda (g00044)
+((lambda (g00043)
+(if (not (eq? g00043
+'no))
+((lambda (_pattern
+_y
+_call)
+(list '#(syntax-object
+let
+(top))
+(list (list '#(syntax-object
+x
+(top))
+_val))
+(list '#(syntax-object
+let
+(top))
+(list (list _y
+(list '#(syntax-object
+syntax-dispatch
+(top))
+'#(syntax-object
+x
+(top))
+(list '#(syntax-object
+quote
+(top))
+_pattern)
+(list '#(syntax-object
+syntax
+(top))
+(list->vector
+_key)))))
+(list '#(syntax-object
+if
+(top))
+(list '#(syntax-object
+not
+(top))
+(list '#(syntax-object
+eq?
+(top))
+_y
+(list '#(syntax-object
+quote
+(top))
+'#(syntax-object
+no
+(top)))))
+_call
+(cons '#(syntax-object
+syntax-case
+(top))
+(cons '#(syntax-object
+x
+(top))
+(cons _key
+(map (lambda (__e1
+__e2
+__e3)
+(cons __e1
+(cons __e2
+__e3)))
+_e1
+_e2
+_e3))))))))
+(car g00043)
+(cadr g00043)
+(caddr
+g00043))
+(syntax-error
+g00044)))
+(syntax-dispatch
+g00044
+'(pair (any)
+pair
+(any)
+pair
+(any)
+atom)
+(vector))))
+(list (convert-syntax-dispatch-pattern
+_pat
+_key)
+'#(syntax-object
+y
+(top))
+(syncase:build-dispatch-call
+(extract-bound-syntax-ids
+_pat
+_key)
+_exp
+'#(syntax-object
+y
+(top)))))
+(g00037)))
+g00035)
+(g00037)))
+(syntax-dispatch
+g00036
+'(pair (any)
+pair
+(any)
+pair
+(each any)
+pair
+(pair (any)
+pair
+(any)
+atom)
+each
+pair
+(any)
+pair
+(any)
+each
+any)
+(vector))))
+(lambda ()
+((lambda (g00039)
+((lambda (g00040)
+((lambda (g00038)
+(if (not (eq? g00038
+'no))
+(apply
+(lambda (__
+_val
+_key
+_pat
+_fender
+_exp
+_e1
+_e2
+_e3)
+(if (if (syncase:andmap
+valid-keyword?
+_key)
+(valid-syntax-pattern?
+_pat
+_key)
+#f)
+((lambda (g00042)
+((lambda (g00041)
+(if (not (eq? g00041
+'no))
+((lambda (_pattern
+_y
+_dorest
+_call)
+(list '#(syntax-object
+let
+(top))
+(list (list '#(syntax-object
+x
+(top))
+_val))
+(list '#(syntax-object
+let
+(top))
+(list (list _dorest
+(list '#(syntax-object
+lambda
+(top))
+'()
+(cons '#(syntax-object
+syntax-case
+(top))
+(cons '#(syntax-object
+x
+(top))
+(cons _key
+(map (lambda (__e1
+__e2
+__e3)
+(cons __e1
+(cons __e2
+__e3)))
+_e1
+_e2
+_e3)))))))
+(list '#(syntax-object
+let
+(top))
+(list (list _y
+(list '#(syntax-object
+syntax-dispatch
+(top))
+'#(syntax-object
+x
+(top))
+(list '#(syntax-object
+quote
+(top))
+_pattern)
+(list '#(syntax-object
+syntax
+(top))
+(list->vector
+_key)))))
+(list '#(syntax-object
+if
+(top))
+(list '#(syntax-object
+not
+(top))
+(list '#(syntax-object
+eq?
+(top))
+_y
+(list '#(syntax-object
+quote
+(top))
+'#(syntax-object
+no
+(top)))))
+_call
+(list _dorest))))))
+(car g00041)
+(cadr g00041)
+(caddr
+g00041)
+(cadddr
+g00041))
+(syntax-error
+g00042)))
+(syntax-dispatch
+g00042
+'(pair (any)
+pair
+(any)
+pair
+(any)
+pair
+(any)
+atom)
+(vector))))
+(list (convert-syntax-dispatch-pattern
+_pat
+_key)
+'#(syntax-object
+y
+(top))
+'#(syntax-object
+dorest
+(top))
+(syncase:build-dispatch-call
+(extract-bound-syntax-ids
+_pat
+_key)
+(list '#(syntax-object
+if
+(top))
+_fender
+_exp
+(list '#(syntax-object
+dorest
+(top))))
+'#(syntax-object
+y
+(top)))))
+(g00040)))
+g00038)
+(g00040)))
+(syntax-dispatch
+g00039
+'(pair (any)
+pair
+(any)
+pair
+(each any)
+pair
+(pair (any)
+pair
+(any)
+pair
+(any)
+atom)
+each
+pair
+(any)
+pair
+(any)
+each
+any)
+(vector))))
+(lambda ()
+(syntax-error
+g00039))))
+g00036))))
+g00033))))
+g00030))))
+x)))))))
diff --git a/scaglob.scm b/scaglob.scm
new file mode 100644
index 0000000..32a027c
--- /dev/null
+++ b/scaglob.scm
@@ -0,0 +1,32 @@
+;;; "scaglob.scm" syntax-case initializations
+;;; Copyright (C) 1992 R. Kent Dybvig
+;;;
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full.  This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; From: Harald Hanche-Olsen <hanche@imf.unit.no>
+
+;;; init.ss
+;;; Robert Hieb & Kent Dybvig
+;;; 92/06/18
+
+; These initializations are done here rather than "expand.ss" so that
+; "expand.ss" can be loaded twice (for bootstrapping purposes).
+
+(define expand-syntax #f)
+(define syntax-dispatch #f)
+(define generate-temporaries #f)
+(define identifier? #f)
+(define syntax-error #f)
+(define syntax-object->datum #f)
+(define bound-identifier=? #f)
+(define free-identifier=? #f)
+(define syncase:install-global-transformer #f)
+(define implicit-identifier #f)
diff --git a/scainit.scm b/scainit.scm
new file mode 100644
index 0000000..1103bc6
--- /dev/null
+++ b/scainit.scm
@@ -0,0 +1,103 @@
+;;; "scainit.scm" Syntax-case macros port to SLIB	-*- Scheme -*-
+;;; Copyright (C) 1992 R. Kent Dybvig
+;;;
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full.  This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; From: Harald Hanche-Olsen <hanche@imf.unit.no>
+
+;;; compat.ss
+;;; Robert Hieb & Kent Dybvig
+;;; 92/06/18
+
+(require 'common-list-functions)	;to pick up EVERY
+(define syncase:andmap comlist:every)
+
+; In Chez Scheme "(syncase:void)" returns an object that is ignored by the
+; REP loop.  It is returned whenever a "nonspecified" value is specified
+; by the standard.  The following should pick up an appropriate value.
+
+(define syncase:void
+   (let ((syncase:void-object (if #f #f)))
+      (lambda () syncase:void-object)))
+
+(define syncase:eval-hook slib:eval)
+
+(define syncase:error-hook slib:error)
+
+(define syncase:new-symbol-hook
+  (let ((c 0))
+    (lambda (string)
+      (set! c (+ c 1))
+      (string->symbol
+       (string-append string ":Sca" (number->string c))))))
+
+(define syncase:put-global-definition-hook #f)
+(define syncase:get-global-definition-hook #f)
+(let ((*macros* '()))
+  (set! syncase:put-global-definition-hook
+	(lambda (symbol binding)
+	  (let ((pair (assq symbol *macros*)))
+	    (if pair
+		(set-cdr! pair binding)
+		(set! *macros* (cons (cons symbol binding) *macros*))))))
+  (set! syncase:get-global-definition-hook
+	(lambda (symbol)
+	  (let ((pair (assq symbol *macros*)))
+	    (and pair (cdr pair))))))
+
+
+;;;! expand.pp requires list*
+(define (syncase:list* . args)
+  (if (null? args)
+      '()
+      (let ((r (reverse args)))
+	(append (reverse (cdr r))
+		(car r)			; Last arg
+		'()))))			; Make sure the last arg is copied
+
+(define syntax-error syncase:error-hook)
+(define impl-error slib:error)
+
+(define base:eval slib:eval)
+(define syncase:eval base:eval)
+(define macro:eval base:eval)
+(define syncase:expand #f)
+(define macro:expand #f)
+(define (syncase:expand-install-hook expand)
+  (set! syncase:eval (lambda (x) (base:eval (expand x))))
+  (set! macro:eval syncase:eval)
+  (set! syncase:expand expand)
+  (set! macro:expand syncase:expand))
+;;; We Need This for bootstrapping purposes:
+(define (syncase:load <pathname>)
+  (slib:eval-load <pathname> syncase:eval))
+(define macro:load syncase:load)
+
+(define syncase:sanity-check #f)
+;;; LOADING THE SYSTEM ITSELF:
+(let ((here (lambda (file)
+	      (in-vicinity (library-vicinity) file)))
+      (scmhere (lambda (file)
+		 (in-vicinity (library-vicinity) file (scheme-file-suffix)))))
+  (for-each (lambda (file) (slib:load (here file)))
+	    '("scaoutp"
+	      "scaglob"
+	      "scaexpp"))
+  (syncase:expand-install-hook expand-syntax)
+  (syncase:load (here "scamacr"))
+  (set! syncase:sanity-check
+	(lambda ()
+	  (syncase:load (scmhere "sca-exp"))
+	  (syncase:expand-install-hook expand-syntax)
+	  (syncase:load (scmhere "sca-macr")))))
+
+(provide 'syntax-case)
+(provide 'macro)
diff --git a/scamacr.scm b/scamacr.scm
new file mode 100644
index 0000000..016d7fb
--- /dev/null
+++ b/scamacr.scm
@@ -0,0 +1,181 @@
+;;; "scamacr.scm" syntax-case macros for Scheme constructs
+;;; Copyright (C) 1992 R. Kent Dybvig
+;;;
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full.  This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; Written by Robert Hieb & Kent Dybvig
+
+;;; This file was munged by a simple minded sed script since it left
+;;; its original authors' hands.  See syncase.sh for the horrid details.
+
+;;; macro-defs.ss
+;;; Robert Hieb & Kent Dybvig
+;;; 92/06/18
+
+(define-syntax with-syntax
+   (lambda (x)
+      (syntax-case x ()
+         ((_ () e1 e2 ...)
+          (syntax (begin e1 e2 ...)))
+         ((_ ((out in)) e1 e2 ...)
+          (syntax (syntax-case in () (out (begin e1 e2 ...)))))
+         ((_ ((out in) ...) e1 e2 ...)
+          (syntax (syntax-case (list in ...) ()
+                     ((out ...) (begin e1 e2 ...))))))))
+
+(define-syntax syntax-rules
+   (lambda (x)
+      (syntax-case x ()
+         ((_ (k ...) ((keyword . pattern) template) ...)
+          (with-syntax (((dummy ...)
+                         (generate-temporaries (syntax (keyword ...)))))
+             (syntax (lambda (x)
+                        (syntax-case x (k ...)
+                           ((dummy . pattern) (syntax template))
+                           ...))))))))
+
+(define-syntax or
+   (lambda (x)
+      (syntax-case x ()
+         ((_) (syntax #f))
+         ((_ e) (syntax e))
+         ((_ e1 e2 e3 ...)
+          (syntax (let ((t e1)) (if t t (or e2 e3 ...))))))))
+
+(define-syntax and
+   (lambda (x)
+      (syntax-case x ()
+         ((_ e1 e2 e3 ...) (syntax (if e1 (and e2 e3 ...) #f)))
+         ((_ e) (syntax e))
+         ((_) (syntax #t)))))
+
+(define-syntax cond
+   (lambda (x)
+      (syntax-case x (else =>)
+         ((_ (else e1 e2 ...))
+          (syntax (begin e1 e2 ...)))
+         ((_ (e0))
+          (syntax (let ((t e0)) (if t t))))
+         ((_ (e0) c1 c2 ...)
+          (syntax (let ((t e0)) (if t t (cond c1 c2 ...)))))
+         ((_ (e0 => e1)) (syntax (let ((t e0)) (if t (e1 t)))))
+         ((_ (e0 => e1) c1 c2 ...)
+          (syntax (let ((t e0)) (if t (e1 t) (cond c1 c2 ...)))))
+         ((_ (e0 e1 e2 ...)) (syntax (if e0 (begin e1 e2 ...))))
+         ((_ (e0 e1 e2 ...) c1 c2 ...)
+          (syntax (if e0 (begin e1 e2 ...) (cond c1 c2 ...)))))))
+
+(define-syntax let*
+   (lambda (x)
+      (syntax-case x ()
+         ((let* () e1 e2 ...)
+          (syntax (let () e1 e2 ...)))
+         ((let* ((x1 v1) (x2 v2) ...) e1 e2 ...)
+          (comlist:every identifier? (syntax (x1 x2 ...)))
+          (syntax (let ((x1 v1)) (let* ((x2 v2) ...) e1 e2 ...)))))))
+
+(define-syntax case
+   (lambda (x)
+      (syntax-case x (else)
+         ((_ v (else e1 e2 ...))
+          (syntax (begin v e1 e2 ...)))
+         ((_ v ((k ...) e1 e2 ...))
+          (syntax (if (memv v '(k ...)) (begin e1 e2 ...))))
+         ((_ v ((k ...) e1 e2 ...) c1 c2 ...)
+          (syntax (let ((x v))
+                     (if (memv x '(k ...))
+                         (begin e1 e2 ...)
+                         (case x c1 c2 ...))))))))
+
+(define-syntax do
+   (lambda (orig-x)
+      (syntax-case orig-x ()
+         ((_ ((var init . step) ...) (e0 e1 ...) c ...)
+          (with-syntax (((step ...)
+                         (map (lambda (v s)
+                                 (syntax-case s ()
+                                    (() v)
+                                    ((e) (syntax e))
+                                    (_ (syntax-error orig-x))))
+                              (syntax (var ...))
+                              (syntax (step ...)))))
+             (syntax-case (syntax (e1 ...)) ()
+                (() (syntax (let doloop ((var init) ...)
+                               (if (not e0)
+                                   (begin c ... (doloop step ...))))))
+                ((e1 e2 ...)
+                 (syntax (let doloop ((var init) ...)
+                            (if e0
+                                (begin e1 e2 ...)
+                                (begin c ... (doloop step ...))))))))))))
+
+(define-syntax quasiquote
+   (letrec
+      ((gen-cons
+        (lambda (x y)
+           (syntax-case x (quote)
+              ((quote x)
+               (syntax-case y (quote list)
+                  ((quote y) (syntax (quote (x . y))))
+                  ((list y ...) (syntax (list (quote x) y ...)))
+                  (y (syntax (cons (quote x) y)))))
+              (x (syntax-case y (quote list)
+                   ((quote ()) (syntax (list x)))
+                   ((list y ...) (syntax (list x y ...)))
+                   (y (syntax (cons x y))))))))
+
+       (gen-append
+        (lambda (x y)
+           (syntax-case x (quote list cons)
+              ((quote (x1 x2 ...))
+               (syntax-case y (quote)
+                  ((quote y) (syntax (quote (x1 x2 ... . y))))
+                  (y (syntax (append (quote (x1 x2 ...) y))))))
+              ((quote ()) y)
+              ((list x1 x2 ...)
+               (gen-cons (syntax x1) (gen-append (syntax (list x2 ...)) y)))
+              (x (syntax-case y (quote list)
+                   ((quote ()) (syntax x))
+                   (y (syntax (append x y))))))))
+
+       (gen-vector
+        (lambda (x)
+           (syntax-case x (quote list)
+              ((quote (x ...)) (syntax (quote #(x ...))))
+              ((list x ...) (syntax (vector x ...)))
+              (x (syntax (list->vector x))))))
+
+       (gen
+        (lambda (p lev)
+           (syntax-case p (unquote unquote-splicing quasiquote)
+              ((unquote p)
+               (if (= lev 0)
+                   (syntax p)
+                   (gen-cons (syntax (quote unquote))
+                             (gen (syntax (p)) (- lev 1)))))
+              (((unquote-splicing p) . q)
+               (if (= lev 0)
+                   (gen-append (syntax p) (gen (syntax q) lev))
+                   (gen-cons (gen-cons (syntax (quote unquote-splicing))
+                                       (gen (syntax p) (- lev 1)))
+                             (gen (syntax q) lev))))
+              ((quasiquote p)
+               (gen-cons (syntax (quote quasiquote))
+                         (gen (syntax (p)) (+ lev 1))))
+              ((p . q)
+               (gen-cons (gen (syntax p) lev) (gen (syntax q) lev)))
+              (#(x ...) (gen-vector (gen (syntax (x ...)) lev)))
+              (p (syntax (quote p)))))))
+
+    (lambda (x)
+       (syntax-case x ()
+          ((- e) (gen (syntax e) 0))))))
+
diff --git a/scanf.scm b/scanf.scm
new file mode 100644
index 0000000..b1ae30a
--- /dev/null
+++ b/scanf.scm
@@ -0,0 +1,351 @@
+;;;;"scanf.scm" implemenation of formated input
+;Copyright (C) 1996 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; Originally jjb@isye.gatech.edu (John Bartholdi) wrote some public
+;;; domain code for a subset of scanf, but it was too difficult to
+;;; extend to POSIX pattern compliance.  Jan 96, I rewrote the scanf
+;;; functions starting from the POSIX man pages.
+
+(require 'string-port)
+
+(define (stdio:scan-and-set format-string input-port . args)
+  (define setters args)
+  (if (equal? '(#f) args) (set! args #f))
+  (cond
+   ((not (equal? "" format-string))
+    (call-with-input-string
+     format-string
+     (lambda (format-port)
+
+       (define items '())
+       (define chars-scanned 0)
+       (define assigned-count 0)
+
+       (define (char-non-numeric? c) (not (char-numeric? c)))
+
+       (define (flush-whitespace port)
+	 (do ((c (peek-char port) (peek-char port))
+	      (i 0 (+ 1 i)))
+	     ((or (eof-object? c) (not (char-whitespace? c))) i)
+	   (read-char port)))
+
+       (define (flush-whitespace-input)
+	 (set! chars-scanned (+ (flush-whitespace input-port) chars-scanned)))
+
+       (define (read-input-char)
+	 (set! chars-scanned (+ 1 chars-scanned))
+	 (read-char input-port))
+
+       (define (add-item report-field? next-item)
+	 (cond (args
+		(cond ((null? setters)
+		       (slib:error 'scanf "not enough variables for format"
+				   format-string))
+		      ((not next-item) (return))
+		      ((not report-field?) (loop1))
+		      (else
+		       (let ((suc ((car setters) next-item)))
+			 (cond ((not (boolean? suc))
+				(slib:warn 'scanf "setter returned non-boolean"
+					   suc)))
+			 (set! setters (cdr setters))
+			 (cond ((not suc) (return))
+			       ((eqv? -1 report-field?) (loop1))
+			       (else
+				(set! assigned-count (+ 1 assigned-count))
+				(loop1)))))))
+	       ((not next-item) (return))
+	       (report-field? (set! items (cons next-item items))
+			      (loop1))
+	       (else (loop1))))
+
+       (define (return)
+	 (cond ((and (zero? chars-scanned)
+		     (eof-object? (peek-char input-port)))
+		(peek-char input-port))
+	       (args assigned-count)
+	       (else (reverse items))))
+
+       (define (read-string width separator?)
+	 (cond (width
+		(let ((str (make-string width)))
+		  (do ((i 0 (+ 1 i)))
+		      ((>= i width)
+		       str)
+		    (let ((c (peek-char input-port)))
+		      (cond ((eof-object? c)
+			     (set! str (substring str 0 i))
+			     (set! i width))
+			    ((separator? c)
+			     (set! str (if (zero? i) "" (substring str 0 i)))
+			     (set! i width))
+			    (else
+			     (string-set! str i (read-input-char))))))))
+	       (else
+		(do ((c (peek-char input-port) (peek-char input-port))
+		     (l '() (cons c l)))
+		    ((or (eof-object? c) (separator? c))
+		     (list->string (reverse l)))
+		  (read-input-char)))))
+
+       (define (read-word width separator?)
+	 (let ((l (read-string width separator?)))
+	   (if (zero? (string-length l)) #f l)))
+
+       (define (loop1)
+	 (define fc (read-char format-port))
+	 (cond
+	  ((eof-object? fc)
+	   (return))
+	  ((char-whitespace? fc)
+	   (flush-whitespace format-port)
+	   (flush-whitespace-input)
+	   (loop1))
+	  ((eqv? #\% fc)		; interpret next format
+	   (set! fc (read-char format-port))
+	   (let ((report-field? (not (eqv? #\* fc)))
+		 (width #f))
+
+	     (define (width--) (if width (set! width (+ -1 width))))
+
+	     (define (read-u)
+	       (string->number (read-string width char-non-numeric?)))
+
+	     (define (read-o)
+	       (string->number
+		(read-string
+		 width
+		 (lambda (c) (not (memv c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)))))
+		8))
+
+	     (define (read-x)
+	       (string->number
+		(read-string
+		 width
+		 (lambda (c) (not (memv (char-downcase c)
+					'(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8
+					      #\9 #\a #\b #\c #\d #\e #\f)))))
+		16))
+
+	     (define (read-radixed-unsigned)
+	       (let ((c (peek-char input-port)))
+		 (case c
+		   ((#\0) (read-input-char)
+			  (width--)
+			  (set! c (peek-char input-port))
+			  (case c
+			    ((#\x #\X) (read-input-char)
+				       (width--)
+				       (read-x))
+			    (else (read-o))))
+		   (else (read-u)))))
+
+	     (define (read-ui)
+	       (let* ((dot? #f)
+		      (mantissa (read-word
+				 width
+				 (lambda (c) 
+				   (not (or (char-numeric? c)
+					    (cond (dot? #f)
+						  ((eqv? #\. c)
+						   (set! dot? #t)
+						   #t)
+						  (else #f)))))))
+		      (exponent (cond
+				 ((not mantissa) #f)
+				 ((and (or (not width) (> width 1))
+				       (memv (peek-char input-port) '(#\E #\e)))
+				  (read-input-char)
+				  (width--)
+				  (let ((expsign
+					 (case (peek-char input-port)
+					   ((#\-) (read-input-char)
+						  (width--)
+						  "-")
+					   ((#\+) (read-input-char)
+						  (width--)
+						  "+")
+					   (else "")))
+					(expint
+					 (and
+					  (or (not width) (positive? width))
+					  (read-word width char-non-numeric?))))
+				    (and expint (string-append
+						 "e" expsign expint))))
+				 (else #f))))
+		 (and mantissa
+		      (string->number
+		       (string-append
+			"#i" (or mantissa "") (or exponent ""))))))
+
+	     (define (read-signed proc)
+	       (case (peek-char input-port)
+		 ((#\-) (read-input-char)
+			(width--)
+			(let ((ret (proc)))
+			  (and ret (- ret))))
+		 ((#\+) (read-input-char)
+			(width--)
+			(proc))
+		 (else (proc))))
+
+	     ;;(trace read-word read-signed read-ui read-radixed-unsigned read-x read-o read-u)
+
+	     (cond ((not report-field?) (set! fc (read-char format-port))))
+	     (if (char-numeric? fc) (set! width 0))
+	     (do () ((or (eof-object? fc) (char-non-numeric? fc)))
+	       (set! width (+ (* 10 width) (string->number (string fc))))
+	       (set! fc (read-char format-port)))
+	     (case fc			;ignore h,l,L modifiers.
+	       ((#\h #\l #\L) (set! fc (read-char format-port))))
+	     (case fc
+	       ((#\n) (if (not report-field?)
+			  (slib:error 'scanf "not saving %n??"))
+		      (add-item -1 chars-scanned)) ;-1 is special flag.
+	       ((#\c #\C)
+		(if (not width) (set! width 1))
+		(let ((str (make-string width)))
+		  (do ((i 0 (+ 1 i)))
+		      ((>= i width)
+		       (add-item report-field? str))
+		    (let ((c (read-char input-port)))
+		      (cond ((eof-object? c)
+			     (set! str c)
+			     (set! i width))
+			    (else (string-set! str i c)))))))
+	       ((#\s #\S)
+		;;(flush-whitespace-input)
+		(add-item report-field? (read-word width char-whitespace?)))
+	       ((#\[)
+		(set! fc (read-char format-port))
+		(let ((allbut #f))
+		  (case fc
+		    ((#\^) (set! allbut #t)
+			   (set! fc (read-char format-port))))
+
+		  (let scanloop ((scanset (list fc)))
+		    (set! fc (read-char format-port))
+		    (case fc
+		      ((#\-)
+		       (set! fc (peek-char format-port))
+		       (cond
+			((and (char<? (car scanset) fc)
+			      (not (eqv? #\] fc)))
+			 (set! fc (char->integer fc))
+			 (do ((i (char->integer (car scanset)) (+ 1 i)))
+			     ((> i fc) (scanloop scanset))
+			   (set! scanset (cons (integer->char i) scanset))))
+			(else (scanloop (cons #\- scanset)))))
+		      ((#\])
+		       (add-item report-field?
+				 (read-word
+				  width
+				  (if allbut (lambda (c) (memv c scanset))
+				      (lambda (c) (not (memv c scanset)))))))
+		      (else (cond
+			     ((eof-object? fc)
+			      (slib:error 'scanf "unmatched [ in format"))
+			     (else (scanloop (cons fc scanset)))))))))
+	       ((#\o #\O)
+		;;(flush-whitespace-input)
+		(add-item report-field? (read-o)))
+	       ((#\u #\U)
+		;;(flush-whitespace-input)
+		(add-item report-field? (read-u)))
+	       ((#\d #\D)
+		;;(flush-whitespace-input)
+		(add-item report-field? (read-signed read-u)))
+	       ((#\x #\X)
+		;;(flush-whitespace-input)
+		(add-item report-field? (read-x)))
+	       ((#\e #\E #\f #\F #\g #\G)
+		;;(flush-whitespace-input)
+		(add-item report-field? (read-signed read-ui)))
+	       ((#\i)
+		;;(flush-whitespace-input)
+		(add-item report-field? (read-signed read-radixed-unsigned)))
+	       ((#\%)
+		(cond ((or width (not report-field?))
+		       (slib:error 'SCANF "%% has modifiers?"))
+		      ((eqv? #\% (read-input-char))
+		       (loop1))
+		      (else (return))))
+	       (else (slib:error 'SCANF
+				 "Unknown format directive:" fc)))))
+	  ((eqv? (peek-char input-port) fc)
+	   (read-input-char)
+	   (loop1))
+	  (else (return))))
+
+       (loop1))))
+   (args 0)
+   (else '())))
+
+;;;This implements a Scheme-oriented version of SCANF: returns a list of
+;;;objects read (rather than set!-ing values).
+
+(define (scanf-read-list format-string . optarg)
+  (define input-port
+    (cond ((null? optarg) (current-input-port))
+	  ((not (null? (cdr optarg)))
+	   (slib:error 'scanf-read-list 'wrong-number-of-args optarg))
+	  (else (car optarg))))
+  (cond ((input-port? input-port)
+	 (stdio:scan-and-set format-string input-port #f))
+	((string? input-port)
+	 (call-with-input-string
+	  input-port (lambda (input-port)
+		       (stdio:scan-and-set format-string input-port #f))))
+	(else (slib:error 'scanf-read-list "argument not port" input-port))))
+
+(define (stdio:setter-procedure sexp)
+  (let ((v (gentemp)))
+    (cond ((symbol? sexp) `(lambda (,v) (set! ,sexp ,v) #t))
+	  ((not (and (pair? sexp) (list? sexp)))
+	   (slib:error 'scanf "setter expression not understood" sexp))
+	  (else
+	   (case (car sexp)
+	     ((vector-ref) `(lambda (,v) (vector-set! ,@(cdr sexp) ,v) #t))
+	     ((substring)
+	      (require 'rev2-procedures)
+	      `(lambda (,v) (substring-move-left!
+			     ,v 0 (min (string-length ,v)
+				       (- ,(cadddr sexp) ,(caddr sexp)))
+			     ,(cadr sexp) ,(caddr sexp))
+		       #t))
+	     ((list-ref)
+	      (require 'rev4-optional-procedures)
+	      `(lambda (,v) (set-car! (list-tail ,@(cdr sexp)) ,v) #t))
+	     ((car) `(lambda (,v) (set-car! ,@(cdr sexp) ,v) #t))
+	     ((cdr) `(lambda (,v) (set-cdr! ,@(cdr sexp) ,v) #t))
+	     (else (slib:error 'scanf "setter not known" sexp)))))))
+
+(defmacro scanf (format-string . args)
+  `(stdio:scan-and-set ,format-string (current-input-port)
+		       ,@(map stdio:setter-procedure args)))
+
+(defmacro sscanf (str format-string . args)
+  `(call-with-input-string
+    ,str (lambda (input-port)
+	   (stdio:scan-and-set ,format-string input-port
+			       ,@(map stdio:setter-procedure args)))))
+
+(defmacro fscanf (input-port format-string . args)
+  `(stdio:scan-and-set ,format-string ,input-port
+		       ,@(map stdio:setter-procedure args)))
diff --git a/scaoutp.scm b/scaoutp.scm
new file mode 100644
index 0000000..b9730ca
--- /dev/null
+++ b/scaoutp.scm
@@ -0,0 +1,93 @@
+;;; "scaoutp.scm" syntax-case output
+;;; Copyright (C) 1992 R. Kent Dybvig
+;;;
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full.  This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; Written by Robert Hieb & Kent Dybvig
+
+;;; This file was munged by a simple minded sed script since it left
+;;; its original authors' hands.  See syncase.sh for the horrid details.
+
+;;; output.ss
+;;; Robert Hieb & Kent Dybvig
+;;; 92/06/18
+
+; The output routines can be tailored to feed a specific system or compiler.
+; They are set up here to generate the following subset of standard Scheme:
+
+;  <expression> :== <application>
+;                |  <variable>
+;                |  (set! <variable> <expression>)
+;                |  (define <variable> <expression>)
+;                |  (lambda (<variable>*) <expression>)
+;                |  (lambda <variable> <expression>)
+;                |  (lambda (<variable>+ . <variable>) <expression>)
+;                |  (letrec (<binding>+) <expression>)
+;                |  (if <expression> <expression> <expression>)
+;                |  (begin <expression> <expression>)
+;                |  (quote <datum>)
+; <application> :== (<expression>+)
+;     <binding> :== (<variable> <expression>)
+;    <variable> :== <symbol>
+
+; Definitions are generated only at top level.
+
+(define syncase:build-application
+   (lambda (fun-exp arg-exps)
+      `(,fun-exp ,@arg-exps)))
+
+(define syncase:build-conditional
+   (lambda (test-exp then-exp else-exp)
+      `(if ,test-exp ,then-exp ,else-exp)))
+
+(define syncase:build-lexical-reference (lambda (var) var))
+
+(define syncase:build-lexical-assignment
+   (lambda (var exp)
+      `(set! ,var ,exp)))
+
+(define syncase:build-global-reference (lambda (var) var))
+
+(define syncase:build-global-assignment
+   (lambda (var exp)
+      `(set! ,var ,exp)))
+
+(define syncase:build-lambda
+   (lambda (vars exp)
+      `(lambda ,vars ,exp)))
+
+(define syncase:build-improper-lambda
+   (lambda (vars var exp)
+      `(lambda (,@vars . ,var) ,exp)))
+
+(define syncase:build-data
+   (lambda (exp)
+      `(quote ,exp)))
+
+(define syncase:build-identifier
+   (lambda (id)
+      `(quote ,id)))
+
+(define syncase:build-sequence
+   (lambda (exps)
+      (if (null? (cdr exps))
+          (car exps)
+          `(begin ,(car exps) ,(syncase:build-sequence (cdr exps))))))
+
+(define syncase:build-letrec
+   (lambda (vars val-exps body-exp)
+      (if (null? vars)
+          body-exp
+          `(letrec ,(map list vars val-exps) ,body-exp))))
+
+(define syncase:build-global-definition
+   (lambda (var val)
+      `(define ,var ,val)))
diff --git a/scheme2c.init b/scheme2c.init
new file mode 100644
index 0000000..cace8c0
--- /dev/null
+++ b/scheme2c.init
@@ -0,0 +1,291 @@
+;"scheme2c.init" Initialisation for SLIB for Scheme->C on Sun	-*-scheme-*-
+;Copyright 1991, 1992, 1993 Aubrey Jaffer
+;Copyright 1991 David Love
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;Modified by David Love (d.love@daresbury.ac.uk) 10/12/91
+;; NB this is for the 01nov91 (and, presumably, later ones,
+;; although those may not need the bug fixes done at the end).
+;; Earlier versions definitely aren't rev4 conformant.  Check
+;; `ieee-floating-point' and `system' in *features* for non-Sun un*x
+;; versions and `system' and the vicinity stuff (at least) for
+;; non-un*x versions.
+
+;; Of course, if you make serious use of library functions you'll want
+;; to compile them and  use Scheme->C modules.
+
+(define (software-type) 'UNIX)
+
+;;; (scheme-implementation-type) should return the name of the scheme
+;;; implementation loading this file.
+
+(define (scheme-implementation-type) 'Scheme->C)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "?01nov91")
+
+(define (implementation-vicinity)
+  (case (software-type)
+    ((UNIX)	"/usr/local/lib/scheme/")
+    ((VMS)	"scheme$src:")
+    ((MS-DOS)	"C:\\scheme\\")))
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+(define library-vicinity
+  (let ((library-path
+	 (case (software-type)
+	   ((UNIX) "/usr/local/lib/slib/")
+	   ((VMS) "lib$scheme:")
+	   ((MS-DOS) "C:\\SLIB\\")
+	   (else ""))))
+    (lambda () library-path)))
+
+;;; *FEATURES* should be set to a list of symbols describing features
+;;; of this implementation.  See Template.scm for the list of feature
+;;; names.
+
+(define *features*
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+;	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+	rev4-report
+	;; Follows rev4 as far as I can tell, modulo '() being false,
+	;; number syntax (see doc), incomplete tail recursion (see
+	;; docs) and a couple of bugs in some versions -- see below.
+	rev3-report			;conforms to
+;	ieee-p1178			;conforms to
+	;; ieee conformance is ruled out by '() being false, if
+	;; nothing else.
+	rev4-optional-procedures
+	rev3-procedures
+;	rev2-procedures
+	multiarg/and-
+	multiarg-apply
+	rationalize
+	object-hash
+	delay
+	promise
+	with-file
+	transcript
+	char-ready?
+	ieee-floating-point
+	full-continuation
+	pretty-print
+	format
+	trace				;has macros: TRACE and UNTRACE
+	string-port
+	system
+	;; next two could be added easily to the interpreter
+;	getenv
+;	program-arguments
+	))
+
+(define pretty-print pp)
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define (output-port-width . arg) 79)
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (let ((port (current-output-port)))
+    (lambda () port)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam
+  (let ((cntr 100))
+    (lambda () (set! cntr (+ 1 cntr))
+	    (let ((tmp (string-append "slib_" (number->string cntr))))
+	      (if (file-exists? tmp) (tmpnam) tmp)))))
+
+;;; (FILE-EXISTS? <string>)
+(define (file-exists? f)
+  (case (software-type)
+    ((UNIX) (zero? (system (string-append "test -f " f))))
+    (else (slib:error "FILE-EXISTS? not defined for " software-type))))
+
+;;; (DELETE-FILE <string>)
+(define (delete-file f)
+  (case (software-type)
+    ((UNIX) (zero? (system (string-append "rm " f))))
+    (else (slib:error "DELETE-FILE not defined for " software-type))))
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;; use this definition if your system doesn't have such a procedure.
+(define force-output flush-buffer)
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+(define (call-with-output-string f)
+  (let ((outsp (open-output-string)))
+    (f outsp)
+    (let ((s (get-output-string outsp)))
+;;;   (close-output-port outsp)		;doesn't work
+      s)))
+
+(define (call-with-input-string s f)
+  (let* ((insp (open-input-string s))
+	 (res (f insp)))
+    (close-input-port insp)
+    res))
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.
+(define char-code-limit 256)
+
+;; MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum 536870911)
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval, SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+(define slib:eval eval)
+
+(define-macro defmacro
+  (lambda (f e)
+    (let ((key (cadr f)) (pattern (caddr f)) (body (cdddr f)))
+      (e `(define-macro ,key 
+	    (let ((%transformer (lambda ,pattern ,@body)))
+	      (lambda (%form %expr)
+		(%expr (apply %transformer (cdr %form)) %expr))))
+	 e))))
+
+(define (defmacro? m) (and (getprop m '*expander*) #t))
+
+(define macroexpand-1 expand-once)
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (if (and (symbol? a) (getprop a '*expander*))
+		      (macroexpand (expand-once e))
+		      e))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define defmacro:eval slib:eval)
+(define defmacro:load load)
+;;; If your implementation provides R4RS macros:
+;(define macro:eval slib:eval)
+;(define macro:load load)
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;; define an error procedure for the library
+(define (slib:error . args)
+  (error 'slib-error: "~a"
+	 (apply string-append
+		(map
+		 (lambda (a)
+		   (format " ~a" a))
+		 args))))
+
+;; define these as appropriate for your system.
+(define slib:tab (integer->char 9))
+(define slib:form-feed (integer->char 12))
+
+;;; bug fixes for Scheme->C (versions 28sep90, 23feb90, 01nov91):
+
+(let ((vers (substring (cadr (implementation-information)) 0 7)))
+  (if (or (string=? vers "28sep90") (string=? vers "23feb90")
+	  (string=? vers "01nov91"))
+      (begin
+	;; GCD fails with 0 as argument
+	(define old-gcd gcd)
+	(set! gcd (lambda args
+		    (apply old-gcd (remv! 0 args))))
+	
+	;; STRING->SYMBOL doesn't allocate a new string
+	(set! string->symbol
+	      (let ((fred string->symbol))
+		(lambda (a) (fred (string-append a)))))
+	
+	;; NUMBER->STRING can generate a leading #?
+	(set! number->string
+	      (let ((fred number->string))
+		(lambda (num . radix)
+		  (let ((joe (apply fred num radix)))
+		    (if (char=? #\# (string-ref joe 0))
+			(substring joe 2 (string-length joe))
+			joe)))))
+	
+	;; Another bug is bad expansion of LETREC when the body starts with a
+	;; DEFINE as shown by test.scm -- not fixed here.
+	)))
+
+(define promise:force force)
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxillary files to your Scheme
+;;; implementation reside.
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:exit (lambda args (exit)))
+
+;;; Here for backward compatability
+(define scheme-file-suffix
+  (let ((suffix (case (software-type)
+		  ((NOSVE) "_scm")
+		  (else ".scm"))))
+    (lambda () suffix)))
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+(define (slib:load-source f) (load (string-append f (scheme-file-suffix))))
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
+; eof
diff --git a/scheme48.init b/scheme48.init
new file mode 100644
index 0000000..6e6b423
--- /dev/null
+++ b/scheme48.init
@@ -0,0 +1,239 @@
+;;;"scheme48.init" Initialisation for SLIB for Scheme48	-*-scheme-*-
+;;; Copyright (C) 1992, 1993, 1994, 1995 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; If you know the magic incantation to make a "," command available
+;;; as a scheme procedure, you can make a nifty slib function to do
+;;; this (like `slib:dump' in "vscm.init").  But for now, type:
+;;;	make slib48
+
+;;; (software-type) should be set to the generic operating system type.
+;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
+
+(define (software-type) 'UNIX)
+
+;;; (scheme-implementation-type) should return the name of the scheme
+;;; implementation loading this file.
+
+(define (scheme-implementation-type) 'Scheme48)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "0.36")
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxiliary files to your Scheme
+;;; implementation reside.
+; For scheme48, perhaps something like /usr/local/src/scheme48/misc/ ?
+
+(define (implementation-vicinity)
+  (case (software-type)
+    ((UNIX)      "=scheme48/")    ; Translated
+    (else (slib:error "unrecognized software-type" software-type))))
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+(define (library-vicinity) "/usr/local/lib/slib/")
+
+;;; *FEATURES* should be set to a list of symbols describing features
+;;; of this implementation.  See Template.scm for the list of feature
+;;; names.
+
+(define *features*
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+;	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+	rev4-report			;conforms to
+	ieee-p1178			;conforms to
+	rev4-optional-procedures
+	multiarg/and-
+	multiarg-apply
+	rationalize
+	delay				;has delay and force
+	with-file
+	char-ready?			;has
+	values				;proposed multiple values
+	eval				;slib:eval is single argument eval.
+	dynamic-wind			;proposed dynamic-wind
+	full-continuation		;can return multiple times
+	macro				;R4RS appendix's DEFINE-SYNTAX
+	))
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define (output-port-width . arg) 79)
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (access-scheme-48 'error-output-port))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam
+  (let ((cntr 100))
+    (lambda () (set! cntr (+ 1 cntr))
+	    (let ((tmp (string-append "slib_" (number->string cntr))))
+	      (if (file-exists? tmp) (tmpnam) tmp)))))
+
+;;; (FILE-EXISTS? <string>)
+(define (file-exists? f) #f)
+
+;;; (DELETE-FILE <string>)
+(define (delete-file f) #f)
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;; use this definition if your system doesn't have such a procedure.
+(define (force-output . arg)
+  ((access-scheme-48 'force-output)
+   (if (null? arg) (current-output-port) (car arg))))
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.
+(define integer->char (access-scheme-48 'ascii->char))
+(define char->integer
+  (let ((char->integer char->integer)
+	(code0 (char->integer (integer->char 0))))
+    (lambda (char) (- (char->integer char) code0))))
+(define char-code-limit 256)
+
+;;; Workaround MODULO bug
+(define modulo
+  (let ((modulo modulo))
+    (lambda (n1 n2)
+      (let ((ans (modulo n1 n2)))
+	(if (= ans n2) (- ans ans) ans)))))
+
+;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum #x1FFFFFFF)
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval, SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+(define slib:eval
+  (let ((eval eval)
+	(interaction-environment interaction-environment))
+    (lambda (form)
+      (eval form (interaction-environment)))))
+
+;;; If your implementation provides R4RS macros:
+(define macro:eval slib:eval)
+(define macro:load load)
+
+(define *defmacros*
+  (list (cons 'defmacro
+	      (lambda (name parms . body)
+		`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
+				      *defmacros*))))))
+(define (defmacro? m) (and (assq m *defmacros*) #t))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a) (set! a (assq a *defmacros*))
+				     (if a (apply (cdr a) (cdr e)) e))
+			(else e)))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a)
+			 (set! a (assq a *defmacros*))
+			 (if a (macroexpand (apply (cdr a) (cdr e))) e))
+			(else e)))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define base:eval slib:eval)
+(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+(define (defmacro:expand* x)
+  (require 'defmacroexpand) (apply defmacro:expand* x '()))
+
+(define (defmacro:load <pathname>)
+  (slib:eval-load <pathname> defmacro:eval))
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;;; define an error procedure for the library
+(define slib:error (access-scheme-48 'error))
+
+;;; define these as appropriate for your system.
+(define slib:tab (integer->char 9))
+(define slib:form-feed (integer->char 12))
+
+;;; Support for older versions of Scheme.  Not enough code for its own file.
+(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l))
+(define t #t)
+(define nil #f)
+
+;;; Define these if your implementation's syntax can support them and if
+;;; they are not already defined.
+
+(define (1+ n) (+ n 1))
+(define (-1+ n) (+ n -1))
+;(define 1- -1+)
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:exit (lambda args #f))
+
+;;; Here for backward compatability
+(define scheme-file-suffix
+  (case (software-type)
+    ((NOSVE) (lambda () "_scm"))
+    (else (lambda () ".scm"))))
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+(define (slib:load-source f) (load (string-append f (scheme-file-suffix))))
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/scmacro.scm b/scmacro.scm
new file mode 100644
index 0000000..47bafca
--- /dev/null
+++ b/scmacro.scm
@@ -0,0 +1,119 @@
+;"scmacro.scm", port for Syntactic Closures macro implementation -*- Scheme -*-
+;Copyright (C) 1992, 1993, 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;;; Syntaxer Output Interface
+
+(define syntax-error slib:error)
+
+(define impl-error slib:error)
+
+(define (append-map procedure . lists)
+  (apply append (apply map (cons procedure lists))))
+
+(define *counter* 0)
+
+(define (make-name-generator)
+  (let ((suffix-promise
+	 (make-promise
+	  (lambda ()
+	    (string-append "."
+			   (number->string (begin
+					     (set! *counter* (+ *counter* 1))
+					     *counter*)))))))
+    (lambda (identifier)
+      (string->symbol
+       (string-append "."
+		      (symbol->string (identifier->symbol identifier))
+		      (promise:force suffix-promise))))))
+
+(define (output/variable name)
+  name)
+
+(define (output/literal-unquoted datum)
+  datum)
+
+(define (output/literal-quoted datum);was output/constant (inefficient)
+  `(QUOTE ,datum))
+
+(define (output/assignment name value)
+  `(SET! ,name ,value))
+
+(define (output/top-level-definition name value)
+  `(DEFINE ,name ,value))
+
+(define (output/conditional predicate consequent alternative)
+  `(IF ,predicate ,consequent ,alternative))
+
+(define (output/sequence expressions)
+  (if (null? (cdr expressions))
+      (car expressions)
+      `(BEGIN ,@expressions)))
+
+(define (output/combination operator operands)
+  `(,operator ,@operands))
+
+(define (output/lambda pattern body)
+  `(LAMBDA ,pattern ,body))
+
+(define (output/delay expression)
+  `(DELAY ,expression))
+
+(define (output/unassigned)
+  `'*UNASSIGNED*)
+
+(define (output/unspecific)
+  `'*UNSPECIFIC*)
+
+(require 'promise)			; Portable support for force and delay.
+(require 'record)
+(require 'synchk)			; Syntax checker.
+
+;;; This file is the macro expander proper.
+(slib:load (in-vicinity (library-vicinity) "synclo"))
+
+;;; These files define the R4RS syntactic environment.
+(slib:load (in-vicinity (library-vicinity) "r4rsyn"))
+(slib:load (in-vicinity (library-vicinity) "synrul"))
+
+;;; OK, time to build the databases.
+(initialize-scheme-syntactic-environment!)
+
+;;; MACRO:EXPAND is for you to use.  It takes an R4RS expression, macro-expands
+;;; it, and returns the result of the macro expansion.
+(define (synclo:expand expression)
+  (set! *counter* 0)
+  (compile/top-level (list expression) scheme-syntactic-environment))
+(define macro:expand synclo:expand)
+
+;;; Here are EVAL, EVAL! and LOAD which expand macros.  You can replace the
+;;; implementation's eval and load with them if you like.
+(define base:eval slib:eval)
+(define base:load load)
+
+(define (synclo:eval x) (base:eval (macro:expand x)))
+(define macro:eval synclo:eval)
+
+(define (synclo:load <pathname>)
+  (slib:eval-load <pathname> synclo:eval))
+
+(define macro:load synclo:load)
+
+(provide 'syntactic-closures)
+(provide 'macro)			;Here because we may have
+					;(require 'sc-macro)
diff --git a/scmactst.scm b/scmactst.scm
new file mode 100644
index 0000000..3b71341
--- /dev/null
+++ b/scmactst.scm
@@ -0,0 +1,160 @@
+;;;"scmactst.scm" test syntactic closures macros
+;;; From "sc-macro.doc", A Syntactic Closures Macro Facility by Chris Hanson
+
+(define errs '())
+(define test
+  (lambda (expect fun . args)
+    (write (cons fun args))
+    (display "  ==> ")
+    ((lambda (res)
+       (write res)
+       (newline)
+       (cond ((not (equal? expect res))
+	      (set! errs (cons (list res expect (cons fun args)) errs))
+	      (display " BUT EXPECTED ")
+	      (write expect)
+	      (newline)
+	      #f)
+	     (else #t)))
+     (if (procedure? fun) (apply fun args) (car args)))))
+
+(require 'syntactic-closures)
+
+(macro:expand
+ '(define-syntax push
+    (syntax-rules ()
+		  ((push item list)
+		   (set! list (cons item list))))))
+
+(test '(set! foo (cons bar foo)) 'push (macro:expand '(push bar foo)))
+
+(macro:expand
+ '(define-syntax push1
+    (transformer
+     (lambda (exp env)
+       (let ((item
+	      (make-syntactic-closure env '() (cadr exp)))
+	     (list
+	      (make-syntactic-closure env '() (caddr exp))))
+	 `(set! ,list (cons ,item ,list)))))))
+
+(test '(set! foo (cons bar foo)) 'push1 (macro:expand '(push1 bar foo)))
+
+(macro:expand
+ '(define-syntax loop
+    (transformer
+     (lambda (exp env)
+       (let ((body (cdr exp)))
+	 `(call-with-current-continuation
+	   (lambda (exit)
+	     (let f ()
+	       ,@(map (lambda  (exp)
+			(make-syntactic-closure env '(exit)
+						exp))
+		      body)
+	       (f)))))))))
+
+(macro:expand
+ '(define-syntax let1
+    (transformer
+     (lambda (exp env)
+       (let ((id (cadr exp))
+	     (init (caddr exp))
+	     (exp (cadddr exp)))
+	 `((lambda (,id)
+	     ,(make-syntactic-closure env (list id) exp))
+	   ,(make-syntactic-closure env '() init)))))))
+
+(test 93 'let1 (macro:eval '(let1 a 90 (+ a 3))))
+
+(macro:expand
+ '(define-syntax loop-until
+    (syntax-rules
+     ()
+     ((loop-until id init test return step)
+      (letrec ((loop
+		(lambda (id)
+		  (if test return (loop step)))))
+	(loop init))))))
+
+(test (macro:expand '(letrec ((loop (lambda (foo) (if #t 12 (loop 33)))))
+		       (loop 3)))
+      'loop
+      (macro:expand '(loop-until foo 3 #t 12 33)))
+
+(macro:expand
+ '(define-syntax loop-until1
+    (transformer
+     (lambda (exp env)
+       (let ((id (cadr exp))
+	     (init (caddr exp))
+	     (test (cadddr exp))
+	     (return (cadddr (cdr exp)))
+	     (step (cadddr (cddr exp)))
+	     (close
+	      (lambda (exp free)
+		(make-syntactic-closure env free exp))))
+	 `(letrec ((loop
+		    ,(capture-syntactic-environment
+		      (lambda (env)
+			`(lambda (,id)
+			   (,(make-syntactic-closure env '() `if)
+			    ,(close test (list id))
+			    ,(close return (list id))
+			    (,(make-syntactic-closure env '()
+						      `loop)
+			     ,(close step (list id)))))))))
+	    (loop ,(close init '()))))))))
+
+(test (macro:expand '(letrec ((loop (lambda (foo) (if #t 12 (loop 33)))))
+			      (loop 3)))
+      'loop1
+      (macro:expand '(loop-until1 foo 3 #t 12 33)))
+
+(test '#t 'identifier (identifier? 'a))
+;;; this needs to setup ENV.
+;;;(test '#t 'identifier
+;;;      (identifier? (macro:expand (make-syntactic-closure env '() 'a))))
+(test #f 'identifier (identifier? "a"))
+(test #f 'identifier (identifier? #\a))
+(test #f 'identifier (identifier? 97))
+(test #f 'identifier (identifier? #f))
+(test #f 'identifier (identifier? '(a)))
+(test #f 'identifier (identifier? '#(a)))
+
+(test '(#t #f)
+      'syntax
+      (macro:eval
+       '(let-syntax
+	    ((foo
+	      (transformer
+	       (lambda (form env)
+		 (capture-syntactic-environment
+		  (lambda (transformer-env)
+		    (identifier=? transformer-env 'x env 'x)))))))
+	  (list (foo)
+		(let ((x 3))
+		  (foo))))))
+
+
+(test '(#f #t)
+      'syntax
+      (macro:eval
+       '(let-syntax ((bar foo))
+	  (let-syntax
+	      ((foo
+		(transformer
+		 (lambda (form env)
+		   (capture-syntactic-environment
+		    (lambda (transformer-env)
+		      (identifier=? transformer-env 'foo
+				    env (cadr form))))))))
+	    (list (foo foo)
+		  (foo bar))))))
+
+(newline)
+(cond ((null? errs) (display "Passed all tests"))
+      (else (display "errors were:") (newline)
+	    (display "(got expected (call))") (newline)
+	    (for-each (lambda (l) (write l) (newline)) errs)))
+(newline)
diff --git a/sierpinski.scm b/sierpinski.scm
new file mode 100644
index 0000000..a4de2d6
--- /dev/null
+++ b/sierpinski.scm
@@ -0,0 +1,71 @@
+;"sierpinski.scm" Hash function for 2d data which preserves nearness.
+;From: jjb@isye.gatech.edu (John Bartholdi)
+;
+; This code is in the public domain.
+
+;Date: Fri, 6 May 94 13:22:34 -0500
+
+(define MAKE-SIERPINSKI-INDEXER
+  (lambda (max-coordinate)
+    (lambda (x y)
+      (if (not (and (<= 0 x max-coordinate)
+		    (<= 0 y max-coordinate)))
+	  (slib:error 'sierpinski-index 
+		 "Coordinate exceeds specified maximum.")
+	  ;
+	  ; The following two mutually recursive procedures
+	  ; correspond to to partitioning successive triangles
+	  ; into two sub-triangles, adjusting the index according
+	  ; to which sub-triangle (x,y) lies in, then rescaling
+	  ; and possibly rotating to continue the recursive
+	  ; decomposition:
+	  ;
+	  (letrec ((loopA
+		    (lambda (resolution x y index)
+		      (cond ((zero? resolution) index)
+			    (else
+			     (let ((finer-index (+ index index)))
+			       (if (> (+ x y) max-coordinate)
+				   ;
+				   ; In the upper sub-triangle:
+				   (loopB resolution
+					  (- max-coordinate y)
+					  x
+					  (+ 1 finer-index))
+				   ;
+				   ; In the lower sub-triangle:
+				   (loopB resolution
+					  x
+					  y
+					  finer-index)))))))
+		   (loopB
+		    (lambda (resolution x y index)
+		      (let ((new-x (+ x x))
+			    (new-y (+ y y))
+			    (finer-index (+ index index)))
+			(if (> new-y max-coordinate)
+			    ;
+			    ; In the upper sub-triangle:
+			    (loopA (quotient resolution 2)
+				   (- new-y max-coordinate)
+				   (- max-coordinate new-x)
+				   (+ finer-index 1))
+			    ;
+			    ; In the lower sub-triangle:
+			    (loopA (quotient resolution 2)
+				   new-x
+				   new-y
+				   finer-index))))))
+	    (if (<= x y)
+		;
+		; Point in NW triangle of initial square:
+		(loopA max-coordinate
+		       x
+		       y
+		       0)
+		;
+		; Else point in SE triangle of initial square
+		; so translate point and increase index:
+		(loopA max-coordinate
+		       (- max-coordinate x)
+		       (- max-coordinate y) 1)))))))
diff --git a/slib.info b/slib.info
new file mode 100644
index 0000000..d8ec637
--- /dev/null
+++ b/slib.info
@@ -0,0 +1,153 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+Indirect:
+slib.info-1: 885
+slib.info-2: 49910
+slib.info-3: 99287
+slib.info-4: 133361
+slib.info-5: 181826
+slib.info-6: 230781
+slib.info-7: 279927
+slib.info-8: 302856
+
+Tag Table:
+(Indirect)
+Node: Top885
+Node: Overview1831
+Node: Installation2916
+Node: Porting4528
+Node: Coding Standards5779
+Node: Copyrights8112
+Node: Manual Conventions11415
+Node: Data Structures12091
+Node: Arrays12951
+Node: Array Mapping15895
+Node: Association Lists17170
+Node: Collections19428
+Node: Dynamic Data Type25543
+Node: Hash Tables26804
+Node: Hashing28921
+Node: Chapter Ordering33708
+Node: Object35324
+Node: Parameter lists43550
+Node: Priority Queues47932
+Node: Queues48784
+Node: Records49910
+Node: Base Table54316
+Node: Relational Database63453
+Node: Motivations64165
+Node: Creating and Opening Relational Databases69210
+Node: Relational Database Operations71642
+Node: Table Operations74439
+Node: Catalog Representation78947
+Node: Unresolved Issues81845
+Node: Database Utilities84776
+Node: Weight-Balanced Trees99287
+Node: Construction of Weight-Balanced Trees103174
+Node: Basic Operations on Weight-Balanced Trees106624
+Node: Advanced Operations on Weight-Balanced Trees109589
+Node: Indexing Operations on Weight-Balanced Trees115611
+Node: Structures119455
+Node: Macros120767
+Node: Defmacro121352
+Node: R4RS Macros123250
+Node: Macro by Example124479
+Node: Macros That Work127329
+Node: Syntactic Closures133361
+Node: Syntax-Case Macros150768
+Node: Fluid-Let154868
+Node: Yasos155783
+Node: Yasos terms156550
+Node: Yasos interface157574
+Node: Setters159657
+Node: Yasos examples162298
+Node: Numerics165226
+Node: Bit-Twiddling165640
+Node: Modular Arithmetic168832
+Node: Prime Testing and Generation170968
+Node: The Miller-Rabin Test173141
+Node: Prime Factorization177335
+Node: Random Numbers178615
+Node: Cyclic Checksum181826
+Node: Plotting183523
+Node: Root Finding186085
+Node: Procedures188902
+Node: Batch189767
+Node: Common List Functions197328
+Node: List construction197738
+Node: Lists as sets199401
+Node: Lists as sequences204394
+Node: Destructive list operations209056
+Node: Non-List functions211719
+Node: Format213067
+Node: Format Interface213264
+Node: Format Specification215001
+Node: Generic-Write224985
+Node: Line I/O226366
+Node: Multi-Processing227717
+Node: Object-To-String228558
+Node: Pretty-Print228824
+Node: Sorting230781
+Node: Topological Sort236554
+Node: Standard Formatted I/O238252
+Node: Standard Formatted Output238780
+Node: Standard Formatted Input247511
+Node: String-Case254170
+Node: String Ports254664
+Node: String Search255428
+Node: Tektronix Graphics Support256994
+Node: Tree Operations258385
+Node: Standards Support259911
+Node: With-File260605
+Node: Transcripts260881
+Node: Rev2 Procedures261202
+Node: Rev4 Optional Procedures262909
+Node: Multi-argument / and -263479
+Node: Multi-argument Apply264130
+Node: Rationalize264616
+Node: Promises265279
+Node: Dynamic-Wind265696
+Node: Values266952
+Node: Time267760
+Node: CLTime270664
+Node: Session Support272162
+Node: Repl273307
+Node: Quick Print274590
+Node: Debug275703
+Node: Breakpoints276345
+Node: Trace278563
+Node: Getopt279927
+Node: Command Line285745
+Node: System Interface288433
+Node: Require288933
+Node: Vicinity290924
+Node: Configuration293562
+Node: Input/Output295844
+Node: Legacy297444
+Node: System298163
+Node: Optional SLIB Packages300496
+Node: Procedure and Macro Index302856
+Node: Variable Index331571
+
+End Tag Table
diff --git a/slib.info-1 b/slib.info-1
new file mode 100644
index 0000000..89c4fce
--- /dev/null
+++ b/slib.info-1
@@ -0,0 +1,1306 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+File: slib.info,  Node: Top,  Next: Overview,  Prev: (dir),  Up: (dir)
+
+  This file documents SLIB, the portable Scheme library.
+
+Good Engineering is 1% inspiration and 99% documentation.
+=========================================================
+
+  Herein lies the good part.  Many thanks to Todd Eigenschink
+<eigenstr@CS.Rose-Hulman.Edu> (who thanks Dave Love <D.Love@dl.ac.uk>)
+for creating `slib.texi'.  I have learned much from their example.
+
+  Aubrey Jaffer jaffer@ai.mit.edu
+
+* Menu:
+
+* Overview::                    What is SLIB?
+
+* Data Structures::             Various data structures.
+* Macros::                      Extensions to Scheme syntax.
+* Numerics::
+* Procedures::                  Miscellaneous utility procedures.
+* Standards Support::           Support for Scheme Standards.
+* Session Support::             Debugging, Pathnames, Require, etc.
+
+* Optional SLIB Packages::
+* Procedure and Macro Index::
+* Variable Index::
+
+
+File: slib.info,  Node: Overview,  Next: Data Structures,  Prev: Top,  Up: Top
+
+Overview
+********
+
+  SLIB is a portable Scheme library meant to provide compatibility and
+utility functions for all standard Scheme implementations, and fixes
+several implementations which are non-conforming.  SLIB conforms to
+`Revised^4 Report on the Algorithmic Language Scheme' and the IEEE
+P1178 specification.  SLIB supports Unix and similar systems, VMS, and
+MS-DOS.
+
+  For a summary of what each file contains, see the file `README'.  For
+a list of the features that have changed since the last SLIB release,
+see the file `ANNOUNCE'.  For a list of the features that have changed
+over time, see the file `ChangeLog'.
+
+  The maintainer can be reached as `jaffer@ai.mit.edu'.
+
+* Menu:
+
+* Installation::                How to install SLIB on your system.
+* Porting::                     SLIB to new platforms
+* Coding Standards::            How to write modules for SLIB.
+* Copyrights::                  Intellectual propery issues.
+* Manual Conventions::          Conventions used in this manual.
+
+
+File: slib.info,  Node: Installation,  Next: Porting,  Prev: Overview,  Up: Overview
+
+Installation
+============
+
+  Check the manifest in `README' to find a configuration file for your
+Scheme implementation.  Initialization files for most IEEE P1178
+compliant Scheme Implementations are included with this distribution.
+
+  If the Scheme implementation supports `getenv', then the value of the
+shell environment variable SCHEME_LIBRARY_PATH will be used for
+`(library-vicinity)' if it is defined.  Currently, Chez, Elk,
+MITScheme, scheme->c, VSCM, and SCM support `getenv'.
+
+  You should check the definitions of `software-type',
+`scheme-implementation-version', `implementation-vicinity', and
+`library-vicinity' in the initialization file.  There are comments in
+the file for how to configure it.
+
+  Once this is done you can modify the startup file for your Scheme
+implementation to `load' this initialization file.  SLIB is then
+installed.
+
+  Multiple implementations of Scheme can all use the same SLIB
+directory.  Simply configure each implementation's initialization file
+as outlined above.
+
+  The SCM implementation does not require any initialization file as
+SLIB support is already built in to SCM.  See the documentation with
+SCM for installation instructions.
+
+  SLIB includes methods to create heap images for the VSCM and Scheme48
+implementations.  The instructions for creating a VSCM image are in
+comments in `vscm.init'.  To make a Scheme48 image, `cd' to the SLIB
+directory and type `make slib48'.  This will also create a shell script
+with the name `slib48' which will invoke the saved image.
+
+
+File: slib.info,  Node: Porting,  Next: Coding Standards,  Prev: Installation,  Up: Overview
+
+Porting
+=======
+
+  If there is no initialization file for your Scheme implementation, you
+will have to create one.  Your Scheme implementation must be largely
+compliant with `IEEE Std 1178-1990' or `Revised^4 Report on the
+Algorithmic Language Scheme' to support SLIB.
+
+  `Template.scm' is an example configuration file.  The comments inside
+will direct you on how to customize it to reflect your system.  Give
+your new initialization file the implementation's name with `.init'
+appended.  For instance, if you were porting `foo-scheme' then the
+initialization file might be called `foo.init'.
+
+  Your customized version should then be loaded as part of your scheme
+implementation's initialization.  It will load `require.scm' (*Note
+Require::) from the library; this will allow the use of `provide',
+`provided?', and `require' along with the "vicinity" functions
+(`vicinity' functions are documented in the section on Require.  *Note
+Require::).  The rest of the library will then be accessible in a
+system independent fashion.
+
+  Please mail new working configuration files to `jaffer@ai.mit.edu' so
+that they can be included in the SLIB distribution.
+
+
+File: slib.info,  Node: Coding Standards,  Next: Copyrights,  Prev: Porting,  Up: Overview
+
+Coding Standards
+================
+
+  All library packages are written in IEEE P1178 Scheme and assume that
+a configuration file and `require.scm' package have already been
+loaded.  Other versions of Scheme can be supported in library packages
+as well by using, for example, `(provided? 'rev3-report)' or `(require
+'rev3-report)' (*Note Require::).
+
+  `require.scm' defines `*catalog*', an association list of module
+names and filenames.  When a new package is added to the library, an
+entry should be added to `require.scm'.  Local packages can also be
+added to `*catalog*' and even shadow entries already in the table.
+
+  The module name and `:' should prefix each symbol defined in the
+package.  Definitions for external use should then be exported by having
+`(define foo module-name:foo)'.
+
+  Submitted code should not duplicate routines which are already in SLIB
+files.  Use `require' to force those features to be supported in your
+package.  Care should be taken that there are no circularities in the
+`require's and `load's between the library packages.
+
+  Documentation should be provided in Emacs Texinfo format if possible,
+But documentation must be provided.
+
+  Your package will be released sooner with SLIB if you send me a file
+which tests your code.  Please run this test *before* you send me the
+code!
+
+Modifications
+-------------
+
+  Please document your changes.  A line or two for `ChangeLog' is
+sufficient for simple fixes or extensions.  Look at the format of
+`ChangeLog' to see what information is desired.  Please send me `diff'
+files from the latest SLIB distribution (remember to send `diff's of
+`slib.texi' and `ChangeLog').  This makes for less email traffic and
+makes it easier for me to integrate when more than one person is
+changing a file (this happens a lot with `slib.texi' and `*.init'
+files).
+
+  If someone else wrote a package you want to significantly modify,
+please try to contact the author, who may be working on a new version.
+This will insure against wasting effort on obsolete versions.
+
+  Please *do not* reformat the source code with your favorite
+beautifier, make 10 fixes, and send me the resulting source code.  I do
+not have the time to fish through 10000 diffs to find your 10 real
+fixes.
+
+
+File: slib.info,  Node: Copyrights,  Next: Manual Conventions,  Prev: Coding Standards,  Up: Overview
+
+Copyrights
+==========
+
+  This section has instructions for SLIB authors regarding copyrights.
+
+  Each package in SLIB must either be in the public domain, or come
+with a statement of terms permitting users to copy, redistribute and
+modify it.  The comments at the beginning of `require.scm' and
+`macwork.scm' illustrate copyright and appropriate terms.
+
+  If your code or changes amount to less than about 10 lines, you do not
+need to add your copyright or send a disclaimer.
+
+Putting code into the Public Domain
+-----------------------------------
+
+  In order to put code in the public domain you should sign a copyright
+disclaimer and send it to the SLIB maintainer.  Contact
+jaffer@ai.mit.edu for the address to mail the disclaimer to.
+
+     I, NAME, hereby affirm that I have placed the software package
+     NAME in the public domain.
+
+     I affirm that I am the sole author and sole copyright holder for
+     the software package, that I have the right to place this software
+     package in the public domain, and that I will do nothing to
+     undermine this status in the future.
+
+                                                     SIGNATURE AND DATE
+
+  This wording assumes that you are the sole author.  If you are not the
+sole author, the wording needs to be different.  If you don't want to be
+bothered with sending a letter every time you release or modify a
+module, make your letter say that it also applies to your future
+revisions of that module.
+
+  Make sure no employer has any claim to the copyright on the work you
+are submitting.  If there is any doubt, create a copyright disclaimer
+and have your employer sign it.  Mail the signed disclaimer to the SLIB
+maintainer.  Contact jaffer@ai.mit.edu for the address to mail the
+disclaimer to.  An example disclaimer follows.
+
+Explicit copying terms
+----------------------
+
+If you submit more than about 10 lines of code which you are not placing
+into the Public Domain (by sending me a disclaimer) you need to:
+
+   * Arrange that your name appears in a copyright line for the
+     appropriate year.   Multiple copyright lines are acceptable.
+
+   * With your copyright line, specify any terms you require to be
+     different from those already in the file.
+
+   * Make sure no employer has any claim to the copyright on the work
+     you are submitting.  If there is any doubt, create a copyright
+     disclaimer and have your employer sign it.  Mail the signed
+     disclaim to the SLIB maintainer.  Contact jaffer@ai.mit.edu for
+     the address to mail the disclaimer to.
+
+Example: Company Copyright Disclaimer
+-------------------------------------
+
+  This disclaimer should be signed by a vice president or general
+manager of the company.  If you can't get at them, anyone else
+authorized to license out software produced there will do.  Here is a
+sample wording:
+
+     EMPLOYER Corporation hereby disclaims all copyright interest in
+     the program PROGRAM written by NAME.
+
+     EMPLOYER Corporation affirms that it has no other intellectual
+     property interest that would undermine this release, and will do
+     nothing to undermine it in the future.
+
+     SIGNATURE AND DATE,
+     NAME, TITLE, EMPLOYER Corporation
+
+
+File: slib.info,  Node: Manual Conventions,  Prev: Copyrights,  Up: Overview
+
+Manual Conventions
+==================
+
+  Things that are labeled as Functions are called for their return
+values.  Things that are labeled as Procedures are called primarily for
+their side effects.
+
+  All examples throughout this text were produced using the `scm'
+Scheme implementation.
+
+  At the beginning of each section, there is a line that looks something
+like
+
+  `(require 'feature)'.
+
+This means that, in order to use `feature', you must include the line
+`(require 'feature)' somewhere in your code prior to the use of that
+feature.  `require' will make sure that the feature is loaded.
+
+
+File: slib.info,  Node: Data Structures,  Next: Macros,  Prev: Overview,  Up: Top
+
+Data Structures
+***************
+
+* Menu:
+
+* Arrays::                      'array
+* Array Mapping::               'array-for-each
+* Association Lists::           'alist
+* Collections::                 'collect
+* Dynamic Data Type::           'dynamic
+* Hash Tables::                 'hash-table
+* Hashing::                     'hash, 'sierpinski, 'soundex
+* Chapter Ordering::            'chapter-order
+* Object::                      'object
+* Parameter lists::             'parameters
+* Priority Queues::             'priority-queue
+* Queues::                      'queue
+* Records::                     'record
+* Base Table::
+* Relational Database::         'relational-database
+* Weight-Balanced Trees::       'wt-tree
+* Structures::                  'struct, 'structure
+
+
+File: slib.info,  Node: Arrays,  Next: Array Mapping,  Prev: Data Structures,  Up: Data Structures
+
+Arrays
+======
+
+  `(require 'array)'
+
+ - Function: array? OBJ
+     Returns `#t' if the OBJ is an array, and `#f' if not.
+
+ - Function: make-array INITIAL-VALUE BOUND1 BOUND2 ...
+     Creates and returns an array that has as many dimensins as there
+     are BOUNDs and fills it with INITIAL-VALUE.
+
+  When constructing an array, BOUND is either an inclusive range of
+indices expressed as a two element list, or an upper bound expressed as
+a single integer.  So
+     (make-array 'foo 3 3) == (make-array 'foo '(0 2) '(0 2))
+
+ - Function: make-shared-array ARRAY MAPPER BOUND1 BOUND2 ...
+     `make-shared-array' can be used to create shared subarrays of other
+     arrays.  The MAPPER is a function that translates coordinates in
+     the new array into coordinates in the old array.  A MAPPER must be
+     linear, and its range must stay within the bounds of the old
+     array, but it can be otherwise arbitrary.  A simple example:
+          (define fred (make-array #f 8 8))
+          (define freds-diagonal
+            (make-shared-array fred (lambda (i) (list i i)) 8))
+          (array-set! freds-diagonal 'foo 3)
+          (array-ref fred 3 3)
+             => FOO
+          (define freds-center
+            (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j)))
+                               2 2))
+          (array-ref freds-center 0 0)
+             => FOO
+
+ - Function: array-rank OBJ
+     Returns the number of dimensions of OBJ.  If OBJ is not an array,
+     0 is returned.
+
+ - Function: array-shape ARRAY
+     `array-shape' returns a list of inclusive bounds.  So:
+          (array-shape (make-array 'foo 3 5))
+             => ((0 2) (0 4))
+
+ - Function: array-dimensions ARRAY
+     `array-dimensions' is similar to `array-shape' but replaces
+     elements with a 0 minimum with one greater than the maximum. So:
+          (array-dimensions (make-array 'foo 3 5))
+             => (3 5)
+
+ - Procedure: array-in-bounds? ARRAY INDEX1 INDEX2 ...
+     Returns `#t' if its arguments would be acceptable to `array-ref'.
+
+ - Function: array-ref ARRAY INDEX1 INDEX2 ...
+     Returns the element at the `(INDEX1, INDEX2)' element in ARRAY.
+
+ - Procedure: array-set! ARRAY NEW-VALUE INDEX1 INDEX2 ...
+
+ - Function: array-1d-ref ARRAY INDEX
+ - Function: array-2d-ref ARRAY INDEX INDEX
+ - Function: array-3d-ref ARRAY INDEX INDEX INDEX
+
+ - Procedure: array-1d-set! ARRAY NEW-VALUE INDEX
+ - Procedure: array-2d-set! ARRAY NEW-VALUE INDEX INDEX
+ - Procedure: array-3d-set! ARRAY NEW-VALUE INDEX INDEX INDEX
+
+  The functions are just fast versions of `array-ref' and `array-set!'
+that take a fixed number of arguments, and perform no bounds checking.
+
+  If you comment out the bounds checking code, this is about as
+efficient as you could ask for without help from the compiler.
+
+  An exercise left to the reader: implement the rest of APL.
+
+
+File: slib.info,  Node: Array Mapping,  Next: Association Lists,  Prev: Arrays,  Up: Data Structures
+
+Array Mapping
+=============
+
+  `(require 'array-for-each)'
+
+ - Function: array-map! ARRAY0 PROC ARRAY1 ...
+     ARRAY1, ... must have the same number of dimensions as ARRAY0 and
+     have a range for each index which includes the range for the
+     corresponding index in ARRAY0.  PROC is applied to each tuple of
+     elements of ARRAY1 ... and the result is stored as the
+     corresponding element in ARRAY0.  The value returned is
+     unspecified.  The order of application is unspecified.
+
+ - Function: array-for-each PROC ARRAY0 ...
+     PROC is applied to each tuple of elements of ARRAY0 ...  in
+     row-major order.  The value returned is unspecified.
+
+ - Function: array-indexes ARRAY
+     Returns an array of lists of indexes for ARRAY such that, if LI is
+     a list of indexes for which ARRAY is defined, (equal?  LI (apply
+     array-ref (array-indexes ARRAY) LI)).
+
+ - Function: array-copy! SOURCE DESTINATION
+     Copies every element from vector or array SOURCE to the
+     corresponding element of DESTINATION.  DESTINATION must have the
+     same rank as SOURCE, and be at least as large in each dimension.
+     The order of copying is unspecified.
+
+
+File: slib.info,  Node: Association Lists,  Next: Collections,  Prev: Array Mapping,  Up: Data Structures
+
+Association Lists
+=================
+
+  `(require 'alist)'
+
+  Alist functions provide utilities for treating a list of key-value
+pairs as an associative database.  These functions take an equality
+predicate, PRED, as an argument.  This predicate should be repeatable,
+symmetric, and transitive.
+
+  Alist functions can be used with a secondary index method such as hash
+tables for improved performance.
+
+ - Function: predicate->asso PRED
+     Returns an "association function" (like `assq', `assv', or
+     `assoc') corresponding to PRED.  The returned function returns a
+     key-value pair whose key is `pred'-equal to its first argument or
+     `#f' if no key in the alist is PRED-equal to the first argument.
+
+ - Function: alist-inquirer PRED
+     Returns a procedure of 2 arguments, ALIST and KEY, which returns
+     the value associated with KEY in ALIST or `#f' if KEY does not
+     appear in ALIST.
+
+ - Function: alist-associator PRED
+     Returns a procedure of 3 arguments, ALIST, KEY, and VALUE, which
+     returns an alist with KEY and VALUE associated.  Any previous
+     value associated with KEY will be lost.  This returned procedure
+     may or may not have side effects on its ALIST argument.  An
+     example of correct usage is:
+          (define put (alist-associator string-ci=?))
+          (define alist '())
+          (set! alist (put alist "Foo" 9))
+
+ - Function: alist-remover PRED
+     Returns a procedure of 2 arguments, ALIST and KEY, which returns
+     an alist with an association whose KEY is key removed.  This
+     returned procedure may or may not have side effects on its ALIST
+     argument.  An example of correct usage is:
+          (define rem (alist-remover string-ci=?))
+          (set! alist (rem alist "foo"))
+
+ - Function: alist-map PROC ALIST
+     Returns a new association list formed by mapping PROC over the
+     keys and values of ALIST.   PROC must be a function of 2 arguments
+     which returns the new value part.
+
+ - Function: alist-for-each PROC ALIST
+     Applies PROC to each pair of keys and values of ALIST.  PROC must
+     be a function of 2 arguments.  The returned value is unspecified.
+
+
+File: slib.info,  Node: Collections,  Next: Dynamic Data Type,  Prev: Association Lists,  Up: Data Structures
+
+Collections
+===========
+
+  `(require 'collect)'
+
+  Routines for managing collections.  Collections are aggregate data
+structures supporting iteration over their elements, similar to the
+Dylan(TM) language, but with a different interface.  They have
+"elements" indexed by corresponding "keys", although the keys may be
+implicit (as with lists).
+
+  New types of collections may be defined as YASOS objects (*Note
+Yasos::).  They must support the following operations:
+   * `(collection? SELF)' (always returns `#t');
+
+   * `(size SELF)' returns the number of elements in the collection;
+
+   * `(print SELF PORT)' is a specialized print operation for the
+     collection which prints a suitable representation on the given
+     PORT or returns it as a string if PORT is `#t';
+
+   * `(gen-elts SELF)' returns a thunk which on successive invocations
+     yields elements of SELF in order or gives an error if it is
+     invoked more than `(size SELF)' times;
+
+   * `(gen-keys SELF)' is like `gen-elts', but yields the collection's
+     keys in order.
+
+  They might support specialized `for-each-key' and `for-each-elt'
+operations.
+
+ - Function: collection? OBJ
+     A predicate, true initially of lists, vectors and strings.  New
+     sorts of collections must answer `#t' to `collection?'.
+
+ - Procedure: map-elts PROC . COLLECTIONS
+ - Procedure: do-elts PROC . COLLECTIONS
+     PROC is a procedure taking as many arguments as there are
+     COLLECTIONS (at least one).  The COLLECTIONS are iterated over in
+     their natural order and PROC is applied to the elements yielded by
+     each iteration in turn.  The order in which the arguments are
+     supplied corresponds to te order in which the COLLECTIONS appear.
+     `do-elts' is used when only side-effects of PROC are of interest
+     and its return value is unspecified.  `map-elts' returns a
+     collection (actually a vector) of the results of the applications
+     of PROC.
+
+     Example:
+          (map-elts + (list 1 2 3) (vector 1 2 3))
+             => #(2 4 6)
+
+ - Procedure: map-keys PROC . COLLECTIONS
+ - Procedure: do-keys PROC . COLLECTIONS
+     These are analogous to `map-elts' and `do-elts', but each
+     iteration is over the COLLECTIONS' *keys* rather than their
+     elements.
+
+     Example:
+          (map-keys + (list 1 2 3) (vector 1 2 3))
+             => #(0 2 4)
+
+ - Procedure: for-each-key COLLECTION PROC
+ - Procedure: for-each-elt COLLECTION PROC
+     These are like `do-keys' and `do-elts' but only for a single
+     collection; they are potentially more efficient.
+
+ - Function: reduce PROC SEED . COLLECTIONS
+     A generalization of the list-based `comlist:reduce-init' (*Note
+     Lists as sequences::) to collections which will shadow the
+     list-based version if `(require 'collect)' follows `(require
+     'common-list-functions)' (*Note Common List Functions::).
+
+     Examples:
+          (reduce + 0 (vector 1 2 3))
+             => 6
+          (reduce union '() '((a b c) (b c d) (d a)))
+             => (c b d a).
+
+ - Function: any? PRED . COLLECTIONS
+     A generalization of the list-based `some' (*Note Lists as
+     sequences::) to collections.
+
+     Example:
+          (any? odd? (list 2 3 4 5))
+             => #t
+
+ - Function: every? PRED . COLLECTIONS
+     A generalization of the list-based `every' (*Note Lists as
+     sequences::) to collections.
+
+     Example:
+          (every? collection? '((1 2) #(1 2)))
+             => #t
+
+ - Function: empty? COLLECTION
+     Returns `#t' iff there are no elements in COLLECTION.
+
+     `(empty? COLLECTION) == (zero? (size COLLECTION))'
+
+ - Function: size COLLECTION
+     Returns the number of elements in COLLECTION.
+
+ - Function: Setter LIST-REF
+     See *Note Setters:: for a definition of "setter".  N.B.  `(setter
+     list-ref)' doesn't work properly for element 0 of a list.
+
+  Here is a sample collection: `simple-table' which is also a `table'.
+     (define-predicate TABLE?)
+     (define-operation (LOOKUP table key failure-object))
+     (define-operation (ASSOCIATE! table key value)) ;; returns key
+     (define-operation (REMOVE! table key))          ;; returns value
+     
+     (define (MAKE-SIMPLE-TABLE)
+       (let ( (table (list)) )
+         (object
+          ;; table behaviors
+          ((TABLE? self) #t)
+          ((SIZE self) (size table))
+          ((PRINT self port) (format port "#<SIMPLE-TABLE>"))
+          ((LOOKUP self key failure-object)
+           (cond
+            ((assq key table) => cdr)
+            (else failure-object)
+            ))
+          ((ASSOCIATE! self key value)
+           (cond
+            ((assq key table)
+             => (lambda (bucket) (set-cdr! bucket value) key))
+            (else
+             (set! table (cons (cons key value) table))
+             key)
+            ))
+          ((REMOVE! self key);; returns old value
+           (cond
+            ((null? table) (slib:error "TABLE:REMOVE! Key not found: " key))
+            ((eq? key (caar table))
+             (let ( (value (cdar table)) )
+               (set! table (cdr table))
+               value)
+             )
+            (else
+             (let loop ( (last table) (this (cdr table)) )
+               (cond
+                ((null? this)
+                 (slib:error "TABLE:REMOVE! Key not found: " key))
+                ((eq? key (caar this))
+                 (let ( (value (cdar this)) )
+                   (set-cdr! last (cdr this))
+                   value)
+                 )
+                (else
+                 (loop (cdr last) (cdr this)))
+                ) ) )
+            ))
+          ;; collection behaviors
+          ((COLLECTION? self) #t)
+          ((GEN-KEYS self) (collect:list-gen-elts (map car table)))
+          ((GEN-ELTS self) (collect:list-gen-elts (map cdr table)))
+          ((FOR-EACH-KEY self proc)
+           (for-each (lambda (bucket) (proc (car bucket))) table)
+           )
+          ((FOR-EACH-ELT self proc)
+           (for-each (lambda (bucket) (proc (cdr bucket))) table)
+           )
+          ) ) )
+
+
+File: slib.info,  Node: Dynamic Data Type,  Next: Hash Tables,  Prev: Collections,  Up: Data Structures
+
+Dynamic Data Type
+=================
+
+  `(require 'dynamic)'
+
+ - Function: make-dynamic OBJ
+     Create and returns a new "dynamic" whose global value is OBJ.
+
+ - Function: dynamic? OBJ
+     Returns true if and only if OBJ is a dynamic.  No object
+     satisfying `dynamic?' satisfies any of the other standard type
+     predicates.
+
+ - Function: dynamic-ref DYN
+     Return the value of the given dynamic in the current dynamic
+     environment.
+
+ - Procedure: dynamic-set! DYN OBJ
+     Change the value of the given dynamic to OBJ in the current
+     dynamic environment.  The returned value is unspecified.
+
+ - Function: call-with-dynamic-binding DYN OBJ THUNK
+     Invoke and return the value of the given thunk in a new, nested
+     dynamic environment in which the given dynamic has been bound to a
+     new location whose initial contents are the value OBJ.  This
+     dynamic environment has precisely the same extent as the
+     invocation of the thunk and is thus captured by continuations
+     created within that invocation and re-established by those
+     continuations when they are invoked.
+
+  The `dynamic-bind' macro is not implemented.
+
+
+File: slib.info,  Node: Hash Tables,  Next: Hashing,  Prev: Dynamic Data Type,  Up: Data Structures
+
+Hash Tables
+===========
+
+  `(require 'hash-table)'
+
+ - Function: predicate->hash PRED
+     Returns a hash function (like `hashq', `hashv', or `hash')
+     corresponding to the equality predicate PRED.  PRED should be
+     `eq?', `eqv?', `equal?', `=', `char=?', `char-ci=?', `string=?', or
+     `string-ci=?'.
+
+  A hash table is a vector of association lists.
+
+ - Function: make-hash-table K
+     Returns a vector of K empty (association) lists.
+
+  Hash table functions provide utilities for an associative database.
+These functions take an equality predicate, PRED, as an argument.  PRED
+should be `eq?', `eqv?', `equal?', `=', `char=?', `char-ci=?',
+`string=?', or `string-ci=?'.
+
+ - Function: predicate->hash-asso PRED
+     Returns a hash association function of 2 arguments, KEY and
+     HASHTAB, corresponding to PRED.  The returned function returns a
+     key-value pair whose key is PRED-equal to its first argument or
+     `#f' if no key in HASHTAB is PRED-equal to the first argument.
+
+ - Function: hash-inquirer PRED
+     Returns a procedure of 3 arguments, `hashtab' and `key', which
+     returns the value associated with `key' in `hashtab' or `#f' if
+     key does not appear in `hashtab'.
+
+ - Function: hash-associator PRED
+     Returns a procedure of 3 arguments, HASHTAB, KEY, and VALUE, which
+     modifies HASHTAB so that KEY and VALUE associated.  Any previous
+     value associated with KEY will be lost.
+
+ - Function: hash-remover PRED
+     Returns a procedure of 2 arguments, HASHTAB and KEY, which
+     modifies HASHTAB so that the association whose key is KEY is
+     removed.
+
+ - Function: hash-map PROC HASH-TABLE
+     Returns a new hash table formed by mapping PROC over the keys and
+     values of HASH-TABLE.  PROC must be a function of 2 arguments
+     which returns the new value part.
+
+ - Function: hash-for-each PROC HASH-TABLE
+     Applies PROC to each pair of keys and values of HASH-TABLE.  PROC
+     must be a function of 2 arguments.  The returned value is
+     unspecified.
+
+
+File: slib.info,  Node: Hashing,  Next: Chapter Ordering,  Prev: Hash Tables,  Up: Data Structures
+
+Hashing
+=======
+
+  `(require 'hash)'
+
+  These hashing functions are for use in quickly classifying objects.
+Hash tables use these functions.
+
+ - Function: hashq OBJ K
+ - Function: hashv OBJ K
+ - Function: hash OBJ K
+     Returns an exact non-negative integer less than K.  For each
+     non-negative integer less than K there are arguments OBJ for which
+     the hashing functions applied to OBJ and K returns that integer.
+
+     For `hashq', `(eq? obj1 obj2)' implies `(= (hashq obj1 k) (hashq
+     obj2))'.
+
+     For `hashv', `(eqv? obj1 obj2)' implies `(= (hashv obj1 k) (hashv
+     obj2))'.
+
+     For `hash', `(equal? obj1 obj2)' implies `(= (hash obj1 k) (hash
+     obj2))'.
+
+     `hash', `hashv', and `hashq' return in time bounded by a constant.
+     Notice that items having the same `hash' implies the items have
+     the same `hashv' implies the items have the same `hashq'.
+
+  `(require 'sierpinski)'
+
+ - Function: make-sierpinski-indexer MAX-COORDINATE
+     Returns a procedure (eg hash-function) of 2 numeric arguments which
+     preserves *nearness* in its mapping from NxN to N.
+
+     MAX-COORDINATE is the maximum coordinate (a positive integer) of a
+     population of points.  The returned procedures is a function that
+     takes the x and y coordinates of a point, (non-negative integers)
+     and returns an integer corresponding to the relative position of
+     that point along a Sierpinski curve.  (You can think of this as
+     computing a (pseudo-) inverse of the Sierpinski spacefilling
+     curve.)
+
+     Example use: Make an indexer (hash-function) for integer points
+     lying in square of integer grid points [0,99]x[0,99]:
+          (define space-key (make-sierpinski-indexer 100))
+     Now let's compute the index of some points:
+          (space-key 24 78)               => 9206
+          (space-key 23 80)               => 9172
+
+     Note that locations (24, 78) and (23, 80) are near in index and
+     therefore, because the Sierpinski spacefilling curve is
+     continuous, we know they must also be near in the plane.  Nearness
+     in the plane does not, however, necessarily correspond to nearness
+     in index, although it *tends* to be so.
+
+     Example applications:
+
+          Sort points by Sierpinski index to get heuristic solution to
+          *travelling salesman problem*.  For details of performance,
+          see L. Platzman and J. Bartholdi, "Spacefilling curves and the
+          Euclidean travelling salesman problem", JACM 36(4):719-737
+          (October 1989) and references therein.
+
+
+          Use Sierpinski index as key by which to store 2-dimensional
+          data in a 1-dimensional data structure (such as a table).
+          Then locations that are near each other in 2-d space will
+          tend to be near each other in 1-d data structure; and
+          locations that are near in 1-d data structure will be near in
+          2-d space.  This can significantly speed retrieval from
+          secondary storage because contiguous regions in the plane
+          will tend to correspond to contiguous regions in secondary
+          storage.  (This is a standard technique for managing CAD/CAM
+          or geographic data.)
+
+
+  `(require 'soundex)'
+
+ - Function: soundex NAME
+     Computes the *soundex* hash of NAME.  Returns a string of an
+     initial letter and up to three digits between 0 and 6.  Soundex
+     supposedly has the property that names that sound similar in normal
+     English pronunciation tend to map to the same key.
+
+     Soundex was a classic algorithm used for manual filing of personal
+     records before the advent of computers.  It performs adequately for
+     English names but has trouble with other nationalities.
+
+     See Knuth, Vol. 3 `Sorting and searching', pp 391-2
+
+     To manage unusual inputs, `soundex' omits all non-alphabetic
+     characters.  Consequently, in this implementation:
+
+          (soundex <string of blanks>)    => ""
+          (soundex "")                    => ""
+
+     Examples from Knuth:
+
+          (map soundex '("Euler" "Gauss" "Hilbert" "Knuth"
+                                 "Lloyd" "Lukasiewicz"))
+                  => ("E460" "G200" "H416" "K530" "L300" "L222")
+          
+          (map soundex '("Ellery" "Ghosh" "Heilbronn" "Kant"
+                                  "Ladd" "Lissajous"))
+                  => ("E460" "G200" "H416" "K530" "L300" "L222")
+
+     Some cases in which the algorithm fails (Knuth):
+
+          (map soundex '("Rogers" "Rodgers"))     => ("R262" "R326")
+          
+          (map soundex '("Sinclair" "St. Clair")) => ("S524" "S324")
+          
+          (map soundex '("Tchebysheff" "Chebyshev")) => ("T212" "C121")
+
+
+File: slib.info,  Node: Chapter Ordering,  Next: Object,  Prev: Hashing,  Up: Data Structures
+
+Chapter Ordering
+================
+
+  `(require 'chapter-order)'
+
+  The `chap:' functions deal with strings which are ordered like
+chapter numbers (or letters) in a book.  Each section of the string
+consists of consecutive numeric or consecutive aphabetic characters of
+like case.
+
+ - Function: chap:string<? STRING1 STRING2
+     Returns #t if the first non-matching run of alphabetic upper-case
+     or the first non-matching run of alphabetic lower-case or the first
+     non-matching run of numeric characters of STRING1 is `string<?'
+     than the corresponding non-matching run of characters of STRING2.
+
+          (chap:string<? "a.9" "a.10")                    => #t
+          (chap:string<? "4c" "4aa")                      => #t
+          (chap:string<? "Revised^{3.99}" "Revised^{4}")  => #t
+
+ - Function: chap:string>? STRING1 STRING2
+ - Function: chap:string<=? STRING1 STRING2
+ - Function: chap:string>=? STRING1 STRING2
+     Implement the corresponding chapter-order predicates.
+
+ - Function: chap:next-string STRING
+     Returns the next string in the *chapter order*.  If STRING has no
+     alphabetic or numeric characters, `(string-append STRING "0")' is
+     returnd.  The argument to chap:next-string will always be
+     `chap:string<?' than the result.
+
+          (chap:next-string "a.9")                => "a.10"
+          (chap:next-string "4c")                 => "4d"
+          (chap:next-string "4z")                 => "4aa"
+          (chap:next-string "Revised^{4}")        => "Revised^{5}"
+
+
+File: slib.info,  Node: Object,  Next: Parameter lists,  Prev: Chapter Ordering,  Up: Data Structures
+
+Macroless Object System
+=======================
+
+  `(require 'object)'
+
+  This is the Macroless Object System written by Wade Humeniuk
+(whumeniu@datap.ca).  Conceptual Tributes: *Note Yasos::, MacScheme's
+%object, CLOS, Lack of R4RS macros.
+
+Concepts
+--------
+
+OBJECT
+     An object is an ordered association-list (by `eq?') of methods
+     (procedures).  Methods can be added (`make-method!'), deleted
+     (`unmake-method!') and retrieved (`get-method').  Objects may
+     inherit methods from other objects.  The object binds to the
+     environment it was created in, allowing closures to be used to
+     hide private procedures and data.
+
+GENERIC-METHOD
+     A generic-method associates (in terms of `eq?') object's method.
+     This allows scheme function style to be used for objects.  The
+     calling scheme for using a generic method is `(generic-method
+     object param1 param2 ...)'.
+
+METHOD
+     A method is a procedure that exists in the object.  To use a method
+     get-method must be called to look-up the method.  Generic methods
+     implement the get-method functionality.  Methods may be added to an
+     object associated with any scheme obj in terms of eq?
+
+GENERIC-PREDICATE
+     A generic method that returns a boolean value for any scheme obj.
+
+PREDICATE
+     A object's method asscociated with a generic-predicate. Returns
+     `#t'.
+
+Procedures
+----------
+
+ - Function: make-object ANCESTOR ...
+     Returns an object.  Current object implementation is a tagged
+     vector.  ANCESTORs are optional and must be objects in terms of
+     object?.  ANCESTORs methods are included in the object.  Multiple
+     ANCESTORs might associate the same generic-method with a method.
+     In this case the method of the ANCESTOR first appearing in the
+     list is the one returned by `get-method'.
+
+ - Function: object? OBJ
+     Returns boolean value whether OBJ was created by make-object.
+
+ - Function: make-generic-method EXCEPTION-PROCEDURE
+     Returns a procedure which be associated with an object's methods.
+     If EXCEPTION-PROCEDURE is specified then it is used to process
+     non-objects.
+
+ - Function: make-generic-predicate
+     Returns a boolean procedure for any scheme object.
+
+ - Function: make-method! OBJECT GENERIC-METHOD METHOD
+     Associates METHOD to the GENERIC-METHOD in the object.  The METHOD
+     overrides any previous association with the GENERIC-METHOD within
+     the object.  Using `unmake-method!' will restore the object's
+     previous association with the GENERIC-METHOD.  METHOD must be a
+     procedure.
+
+ - Function: make-predicate! OBJECT GENERIC-PRECIATE
+     Makes a predicate method associated with the GENERIC-PREDICATE.
+
+ - Function: unmake-method! OBJECT GENERIC-METHOD
+     Removes an object's association with a GENERIC-METHOD .
+
+ - Function: get-method OBJECT GENERIC-METHOD
+     Returns the object's method associated (if any) with the
+     GENERIC-METHOD.  If no associated method exists an error is
+     flagged.
+
+Examples
+--------
+
+     (require 'object)
+     
+     (define instantiate (make-generic-method))
+     
+     (define (make-instance-object . ancestors)
+       (define self (apply make-object
+                           (map (lambda (obj) (instantiate obj)) ancestors)))
+       (make-method! self instantiate (lambda (self) self))
+       self)
+     
+     (define who (make-generic-method))
+     (define imigrate! (make-generic-method))
+     (define emigrate! (make-generic-method))
+     (define describe (make-generic-method))
+     (define name (make-generic-method))
+     (define address (make-generic-method))
+     (define members (make-generic-method))
+     
+     (define society
+       (let ()
+         (define self (make-instance-object))
+         (define population '())
+         (make-method! self imigrate!
+                       (lambda (new-person)
+                         (if (not (eq? new-person self))
+                             (set! population (cons new-person population)))))
+         (make-method! self emigrate!
+                       (lambda (person)
+                         (if (not (eq? person self))
+                             (set! population
+                                   (comlist:remove-if (lambda (member)
+                                                        (eq? member person))
+                                                      population)))))
+         (make-method! self describe
+                       (lambda (self)
+                         (map (lambda (person) (describe person)) population)))
+         (make-method! self who
+                       (lambda (self) (map (lambda (person) (name person))
+                                           population)))
+         (make-method! self members (lambda (self) population))
+         self))
+     
+     (define (make-person %name %address)
+       (define self (make-instance-object society))
+       (make-method! self name (lambda (self) %name))
+       (make-method! self address (lambda (self) %address))
+       (make-method! self who (lambda (self) (name self)))
+       (make-method! self instantiate
+                     (lambda (self)
+                       (make-person (string-append (name self) "-son-of")
+                                    %address)))
+       (make-method! self describe
+                     (lambda (self) (list (name self) (address self))))
+       (imigrate! self)
+       self)
+
+Inverter Documentation
+......................
+
+  Inheritance:
+             <inverter>::(<number> <description>)
+  Generic-methods
+             <inverter>::value      => <number>::value
+             <inverter>::set-value! => <number>::set-value!
+             <inverter>::describe   => <description>::describe
+             <inverter>::help
+             <inverter>::invert
+             <inverter>::inverter?
+
+Number Documention
+..................
+
+  Inheritance
+             <number>::()
+  Slots
+             <number>::<x>
+  Generic Methods
+             <number>::value
+             <number>::set-value!
+
+Inverter code
+.............
+
+     (require 'object)
+     
+     (define value (make-generic-method (lambda (val) val)))
+     (define set-value! (make-generic-method))
+     (define invert (make-generic-method
+                     (lambda (val)
+                       (if (number? val)
+                           (/ 1 val)
+                           (error "Method not supported:" val)))))
+     (define noop (make-generic-method))
+     (define inverter? (make-generic-predicate))
+     (define describe (make-generic-method))
+     (define help (make-generic-method))
+     
+     (define (make-number x)
+       (define self (make-object))
+       (make-method! self value (lambda (this) x))
+       (make-method! self set-value!
+                     (lambda (this new-value) (set! x new-value)))
+       self)
+     
+     (define (make-description str)
+       (define self (make-object))
+       (make-method! self describe (lambda (this) str))
+       (make-method! self help (lambda (this) "Help not available"))
+       self)
+     
+     (define (make-inverter)
+       (define self (make-object
+                     (make-number 1)
+                     (make-description "A number which can be inverted")))
+       (define <value> (get-method self value))
+       (make-method! self invert (lambda (self) (/ 1 (<value> self))))
+       (make-predicate! self inverter?)
+       (unmake-method! self help)
+       (make-method! self help
+                     (lambda (self)
+                       (display "Inverter Methods:") (newline)
+                       (display "  (value inverter) ==> n") (newline)))
+       self)
+     
+     ;;;; Try it out
+     
+     (define invert! (make-generic-method))
+     
+     (define x (make-inverter))
+     
+     (make-method! x invert! (lambda () (set-value! x (/ 1 (value x)))))
+     
+     (value x)                       => 1
+     (set-value! x 33)               => undefined
+     (invert! x)                     => undefined
+     (value x)                       => 1/33
+     
+     (unmake-method! x invert!)      => undefined
+     
+     (invert! x)                     error-->  ERROR: Method not supported: x
+
+
+File: slib.info,  Node: Parameter lists,  Next: Priority Queues,  Prev: Object,  Up: Data Structures
+
+Parameter lists
+===============
+
+  `(require 'parameters)'
+
+Arguments to procedures in scheme are distinguished from each other by
+their position in the procedure call.  This can be confusing when a
+procedure takes many arguments, many of which are not often used.
+
+A "parameter-list" is a way of passing named information to a
+procedure.  Procedures are also defined to set unused parameters to
+default values, check parameters, and combine parameter lists.
+
+A PARAMETER has the form `(parameter-name value1 ...)'.  This format
+allows for more than one value per parameter-name.
+
+A PARAMETER-LIST is a list of PARAMETERs, each with a different
+PARAMETER-NAME.
+
+ - Function: make-parameter-list PARAMETER-NAMES
+     Returns an empty parameter-list with slots for PARAMETER-NAMES.
+
+ - Function: parameter-list-ref PARAMETER-LIST PARAMETER-NAME
+     PARAMETER-NAME must name a valid slot of PARAMETER-LIST.
+     `parameter-list-ref' returns the value of parameter PARAMETER-NAME
+     of PARAMETER-LIST.
+
+ - Procedure: adjoin-parameters! PARAMETER-LIST PARAMETER1 ...
+     Returns PARAMETER-LIST with PARAMETER1 ... merged in.
+
+ - Procedure: parameter-list-expand EXPANDERS PARAMETER-LIST
+     EXPANDERS is a list of procedures whose order matches the order of
+     the PARAMETER-NAMEs in the call to `make-parameter-list' which
+     created PARAMETER-LIST.  For each non-false element of EXPANDERS
+     that procedure is mapped over the corresponding parameter value
+     and the returned parameter lists are merged into PARAMETER-LIST.
+
+     This process is repeated until PARAMETER-LIST stops growing.  The
+     value returned from `parameter-list-expand' is unspecified.
+
+ - Function: fill-empty-parameters DEFAULTS PARAMETER-LIST
+     DEFAULTS is a list of lists whose order matches the order of the
+     PARAMETER-NAMEs in the call to `make-parameter-list' which created
+     PARAMETER-LIST.  `fill-empty-parameters' returns a new
+     parameter-list with each empty parameter filled with the
+     corresponding DEFAULT.
+
+ - Function: check-parameters CHECKS PARAMETER-LIST
+     CHECKS is a list of procedures whose order matches the order of
+     the PARAMETER-NAMEs in the call to `make-parameter-list' which
+     created PARAMETER-LIST.
+
+     `check-parameters' returns PARAMETER-LIST if each CHECK of the
+     corresponding PARAMETER-LIST returns non-false.  If some CHECK
+     returns `#f' an error is signaled.
+
+In the following procedures ARITIES is a list of symbols.  The elements
+of `arities' can be:
+
+`single'
+     Requires a single parameter.
+
+`optional'
+     A single parameter or no parameter is acceptable.
+
+`boolean'
+     A single boolean parameter or zero parameters is acceptable.
+
+`nary'
+     Any number of parameters are acceptable.
+
+`nary1'
+     One or more of parameters are acceptable.
+
+ - Function: parameter-list->arglist POSITIONS ARITIES TYPES
+          PARAMETER-LIST
+     Returns PARAMETER-LIST converted to an argument list.  Parameters
+     of ARITY type `single' and `boolean' are converted to the single
+     value associated with them.  The other ARITY types are converted
+     to lists of the value(s) of type TYPES.
+
+     POSITIONS is a list of positive integers whose order matches the
+     order of the PARAMETER-NAMEs in the call to `make-parameter-list'
+     which created PARAMETER-LIST.  The integers specify in which
+     argument position the corresponding parameter should appear.
+
+ - Function: getopt->parameter-list ARGC ARGV OPTNAMES ARITIES TYPES
+          ALIASES
+     Returns ARGV converted to a parameter-list.  OPTNAMES are the
+     parameter-names.  ALIASES is a list of lists of strings and
+     elements of OPTNAMES.  Each of these strings which have length of
+     1 will be treated as a single - option by `getopt'.  Longer
+     strings will be treated as long-named options (*note getopt-:
+     Getopt.).
+
+ - Function: getopt->arglist ARGC ARGV OPTNAMES POSITIONS ARITIES TYPES
+          DEFAULTS CHECKS ALIASES
+     Like `getopt->parameter-list', but converts ARGV to an
+     argument-list as specified by OPTNAMES, POSITIONS, ARITIES, TYPES,
+     DEFAULTS, CHECKS, and ALIASES.
+
+  These `getopt' functions can be used with SLIB relational databases.
+For an example, *Note make-command-server: Database Utilities.
+
+
+File: slib.info,  Node: Priority Queues,  Next: Queues,  Prev: Parameter lists,  Up: Data Structures
+
+Priority Queues
+===============
+
+  `(require 'priority-queue)'
+
+ - Function: make-heap PRED<?
+     Returns a binary heap suitable which can be used for priority queue
+     operations.
+
+ - Function: heap-length HEAP
+     Returns the number of elements in HEAP.
+
+ - Procedure: heap-insert! HEAP ITEM
+     Inserts ITEM into HEAP.  ITEM can be inserted multiple times.  The
+     value returned is unspecified.
+
+ - Function: heap-extract-max! HEAP
+     Returns the item which is larger than all others according to the
+     PRED<? argument to `make-heap'.  If there are no items in HEAP, an
+     error is signaled.
+
+  The algorithm for priority queues was taken from `Introduction to
+Algorithms' by T. Cormen, C. Leiserson, R. Rivest.  1989 MIT Press.
+
+
+File: slib.info,  Node: Queues,  Next: Records,  Prev: Priority Queues,  Up: Data Structures
+
+Queues
+======
+
+  `(require 'queue)'
+
+  A "queue" is a list where elements can be added to both the front and
+rear, and removed from the front (i.e., they are what are often called
+"dequeues").  A queue may also be used like a stack.
+
+ - Function: make-queue
+     Returns a new, empty queue.
+
+ - Function: queue? OBJ
+     Returns `#t' if OBJ is a queue.
+
+ - Function: queue-empty? Q
+     Returns `#t' if the queue Q is empty.
+
+ - Procedure: queue-push! Q DATUM
+     Adds DATUM to the front of queue Q.
+
+ - Procedure: enquque! Q DATUM
+     Adds DATUM to the rear of queue Q.
+
+  All of the following functions raise an error if the queue Q is empty.
+
+ - Function: queue-front Q
+     Returns the datum at the front of the queue Q.
+
+ - Function: queue-rear Q
+     Returns the datum at the rear of the queue Q.
+
+ - Prcoedure: queue-pop! Q
+ - Procedure: dequeue! Q
+     Both of these procedures remove and return the datum at the front
+     of the queue.  `queue-pop!' is used to suggest that the queue is
+     being used like a stack.
+
diff --git a/slib.info-2 b/slib.info-2
new file mode 100644
index 0000000..f1c31c5
--- /dev/null
+++ b/slib.info-2
@@ -0,0 +1,1193 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+File: slib.info,  Node: Records,  Next: Base Table,  Prev: Queues,  Up: Data Structures
+
+Records
+=======
+
+  `(require 'record)'
+
+  The Record package provides a facility for user to define their own
+record data types.
+
+ - Function: make-record-type TYPE-NAME FIELD-NAMES
+     Returns a "record-type descriptor", a value representing a new data
+     type disjoint from all others.  The TYPE-NAME argument must be a
+     string, but is only used for debugging purposes (such as the
+     printed representation of a record of the new type).  The
+     FIELD-NAMES argument is a list of symbols naming the "fields" of a
+     record of the new type.  It is an error if the list contains any
+     duplicates.  It is unspecified how record-type descriptors are
+     represented.
+
+ - Function: record-constructor RTD [FIELD-NAMES]
+     Returns a procedure for constructing new members of the type
+     represented by RTD.  The returned procedure accepts exactly as
+     many arguments as there are symbols in the given list,
+     FIELD-NAMES; these are used, in order, as the initial values of
+     those fields in a new record, which is returned by the constructor
+     procedure.  The values of any fields not named in that list are
+     unspecified.  The FIELD-NAMES argument defaults to the list of
+     field names in the call to `make-record-type' that created the
+     type represented by RTD; if the FIELD-NAMES argument is provided,
+     it is an error if it contains any duplicates or any symbols not in
+     the default list.
+
+ - Function: record-predicate RTD
+     Returns a procedure for testing membership in the type represented
+     by RTD.  The returned procedure accepts exactly one argument and
+     returns a true value if the argument is a member of the indicated
+     record type; it returns a false value otherwise.
+
+ - Function: record-accessor RTD FIELD-NAME
+     Returns a procedure for reading the value of a particular field of
+     a member of the type represented by RTD.  The returned procedure
+     accepts exactly one argument which must be a record of the
+     appropriate type; it returns the current value of the field named
+     by the symbol FIELD-NAME in that record.  The symbol FIELD-NAME
+     must be a member of the list of field-names in the call to
+     `make-record-type' that created the type represented by RTD.
+
+ - Function: record-modifier RTD FIELD-NAME
+     Returns a procedure for writing the value of a particular field of
+     a member of the type represented by RTD.  The returned procedure
+     accepts exactly two arguments: first, a record of the appropriate
+     type, and second, an arbitrary Scheme value; it modifies the field
+     named by the symbol FIELD-NAME in that record to contain the given
+     value.  The returned value of the modifier procedure is
+     unspecified.  The symbol FIELD-NAME must be a member of the list
+     of field-names in the call to `make-record-type' that created the
+     type represented by RTD.
+
+ - Function: record? OBJ
+     Returns a true value if OBJ is a record of any type and a false
+     value otherwise.  Note that `record?' may be true of any Scheme
+     value; of course, if it returns true for some particular value,
+     then `record-type-descriptor' is applicable to that value and
+     returns an appropriate descriptor.
+
+ - Function: record-type-descriptor RECORD
+     Returns a record-type descriptor representing the type of the given
+     record.  That is, for example, if the returned descriptor were
+     passed to `record-predicate', the resulting predicate would return
+     a true value when passed the given record.  Note that it is not
+     necessarily the case that the returned descriptor is the one that
+     was passed to `record-constructor' in the call that created the
+     constructor procedure that created the given record.
+
+ - Function: record-type-name RTD
+     Returns the type-name associated with the type represented by rtd.
+     The returned value is `eqv?' to the TYPE-NAME argument given in
+     the call to `make-record-type' that created the type represented by
+     RTD.
+
+ - Function: record-type-field-names RTD
+     Returns a list of the symbols naming the fields in members of the
+     type represented by RTD.  The returned value is `equal?' to the
+     field-names argument given in the call to `make-record-type' that
+     created the type represented by RTD.
+
+
+File: slib.info,  Node: Base Table,  Next: Relational Database,  Prev: Records,  Up: Data Structures
+
+Base Table
+==========
+
+  A base table implementation using Scheme association lists is
+available as the value of the identifier `alist-table' after doing:
+
+     (require 'alist-table)
+
+  Association list base tables are suitable for small databases and
+support all Scheme types when temporary and readable/writeable Scheme
+types when saved.  I hope support for other base table implementations
+will be added in the future.
+
+  This rest of this section documents the interface for a base table
+implementation from which the *Note Relational Database:: package
+constructs a Relational system.  It will be of interest primarily to
+those wishing to port or write new base-table implementations.
+
+  All of these functions are accessed through a single procedure by
+calling that procedure with the symbol name of the operation.  A
+procedure will be returned if that operation is supported and `#f'
+otherwise.  For example:
+
+     (require 'alist-table)
+     (define open-base (alist-table 'make-base))
+     make-base       => *a procedure*
+     (define foo (alist-table 'foo))
+     foo             => #f
+
+ - Function: make-base FILENAME KEY-DIMENSION COLUMN-TYPES
+     Returns a new, open, low-level database (collection of tables)
+     associated with FILENAME.  This returned database has an empty
+     table associated with CATALOG-ID.  The positive integer
+     KEY-DIMENSION is the number of keys composed to make a PRIMARY-KEY
+     for the catalog table.  The list of symbols COLUMN-TYPES describes
+     the types of each column for that table.  If the database cannot
+     be created as specified, `#f' is returned.
+
+     Calling the `close-base' method on this database and possibly other
+     operations will cause FILENAME to be written to.  If FILENAME is
+     `#f' a temporary, non-disk based database will be created if such
+     can be supported by the base table implelentation.
+
+ - Function: open-base FILENAME MUTABLE
+     Returns an open low-level database associated with FILENAME.  If
+     MUTABLE? is `#t', this database will have methods capable of
+     effecting change to the database.  If MUTABLE? is `#f', only
+     methods for inquiring the database will be available.  If the
+     database cannot be opened as specified `#f' is returned.
+
+     Calling the `close-base' (and possibly other) method on a MUTABLE?
+     database will cause FILENAME to be written to.
+
+ - Function: write-base LLDB FILENAME
+     Causes the low-level database LLDB to be written to FILENAME.  If
+     the write is successful, also causes LLDB to henceforth be
+     associated with FILENAME.  Calling the `close-database' (and
+     possibly other) method on LLDB may cause FILENAME to be written
+     to.  If FILENAME is `#f' this database will be changed to a
+     temporary, non-disk based database if such can be supported by the
+     underlying base table implelentation.  If the operations completed
+     successfully, `#t' is returned.  Otherwise, `#f' is returned.
+
+ - Function: sync-base LLDB
+     Causes the file associated with the low-level database LLDB to be
+     updated to reflect its current state.  If the associated filename
+     is `#f', no action is taken and `#f' is returned.  If this
+     operation completes successfully, `#t' is returned.  Otherwise,
+     `#f' is returned.
+
+ - Function: close-base LLDB
+     Causes the low-level database LLDB to be written to its associated
+     file (if any).  If the write is successful, subsequent operations
+     to LLDB will signal an error.  If the operations complete
+     successfully, `#t' is returned.  Otherwise, `#f' is returned.
+
+ - Function: make-table LLDB KEY-DIMENSION COLUMN-TYPES
+     Returns the BASE-ID for a new base table, otherwise returns `#f'.
+     The base table can then be opened using `(open-table LLDB
+     BASE-ID)'.  The positive integer KEY-DIMENSION is the number of
+     keys composed to make a PRIMARY-KEY for this table.  The list of
+     symbols COLUMN-TYPES describes the types of each column.
+
+ - Constant: catalog-id
+     A constant BASE-ID suitable for passing as a parameter to
+     `open-table'.  CATALOG-ID will be used as the base table for the
+     system catalog.
+
+ - Function: open-table LLDB BASE-ID KEY-DIMENSION COLUMN-TYPES
+     Returns a HANDLE for an existing base table in the low-level
+     database LLDB if that table exists and can be opened in the mode
+     indicated by MUTABLE?, otherwise returns `#f'.
+
+     As with `make-table', the positive integer KEY-DIMENSION is the
+     number of keys composed to make a PRIMARY-KEY for this table.  The
+     list of symbols COLUMN-TYPES describes the types of each column.
+
+ - Function: kill-table LLDB BASE-ID KEY-DIMENSION COLUMN-TYPES
+     Returns `#t' if the base table associated with BASE-ID was removed
+     from the low level database LLDB, and `#f' otherwise.
+
+ - Function: make-keyifier-1 TYPE
+     Returns a procedure which accepts a single argument which must be
+     of type TYPE.  This returned procedure returns an object suitable
+     for being a KEY argument in the functions whose descriptions
+     follow.
+
+     Any 2 arguments of the supported type passed to the returned
+     function which are not `equal?' must result in returned values
+     which are not `equal?'.
+
+ - Function: make-list-keyifier KEY-DIMENSION TYPES
+     The list of symbols TYPES must have at least KEY-DIMENSION
+     elements.  Returns a procedure which accepts a list of length
+     KEY-DIMENSION and whose types must corresopond to the types named
+     by TYPES.  This returned procedure combines the elements of its
+     list argument into an object suitable for being a KEY argument in
+     the functions whose descriptions follow.
+
+     Any 2 lists of supported types (which must at least include
+     symbols and non-negative integers) passed to the returned function
+     which are not `equal?' must result in returned values which are not
+     `equal?'.
+
+ - Function: make-key-extractor KEY-DIMENSION TYPES COLUMN-NUMBER
+     Returns a procedure which accepts objects produced by application
+     of the result of `(make-list-keyifier KEY-DIMENSION TYPES)'.  This
+     procedure returns a KEY which is `equal?' to the COLUMN-NUMBERth
+     element of the list which was passed to create COMBINED-KEY.  The
+     list TYPES must have at least KEY-DIMENSION elements.
+
+ - Function: make-key->list KEY-DIMENSION TYPES
+     Returns a procedure which accepts objects produced by application
+     of the result of `(make-list-keyifier KEY-DIMENSION TYPES)'.  This
+     procedure returns a list of KEYs which are elementwise `equal?' to
+     the list which was passed to create COMBINED-KEY.
+
+In the following functions, the KEY argument can always be assumed to
+be the value returned by a call to a *keyify* routine.
+
+ - Function: for-each-key HANDLE PROCEDURE
+     Calls PROCEDURE once with each KEY in the table opened in HANDLE
+     in an unspecified order.  An unspecified value is returned.
+
+ - Function: map-key HANDLE PROCEDURE
+     Returns a list of the values returned by calling PROCEDURE once
+     with each KEY in the table opened in HANDLE in an unspecified
+     order.
+
+ - Function: ordered-for-each-key HANDLE PROCEDURE
+     Calls PROCEDURE once with each KEY in the table opened in HANDLE
+     in the natural order for the types of the primary key fields of
+     that table.  An unspecified value is returned.
+
+ - Function: present? HANDLE KEY
+     Returns a non-`#f' value if there is a row associated with KEY in
+     the table opened in HANDLE and `#f' otherwise.
+
+ - Function: delete HANDLE KEY
+     Removes the row associated with KEY from the table opened in
+     HANDLE.  An unspecified value is returned.
+
+ - Function: make-getter KEY-DIMENSION TYPES
+     Returns a procedure which takes arguments HANDLE and KEY.  This
+     procedure returns a list of the non-primary values of the relation
+     (in the base table opened in HANDLE) whose primary key is KEY if
+     it exists, and `#f' otherwise.
+
+ - Function: make-putter KEY-DIMENSION TYPES
+     Returns a procedure which takes arguments HANDLE and KEY and
+     VALUE-LIST.  This procedure associates the primary key KEY with
+     the values in VALUE-LIST (in the base table opened in HANDLE) and
+     returns an unspecified value.
+
+ - Function: supported-type? SYMBOL
+     Returns `#t' if SYMBOL names a type allowed as a column value by
+     the implementation, and `#f' otherwise.  At a minimum, an
+     implementation must support the types `integer', `symbol',
+     `string', `boolean', and `base-id'.
+
+ - Function: supported-key-type? SYMBOL
+     Returns `#t' if SYMBOL names a type allowed as a key value by the
+     implementation, and `#f' otherwise.  At a minimum, an
+     implementation must support the types `integer', and `symbol'.
+
+`integer'
+     Scheme exact integer.
+
+`symbol'
+     Scheme symbol.
+
+`boolean'
+     `#t' or `#f'.
+
+`base-id'
+     Objects suitable for passing as the BASE-ID parameter to
+     `open-table'.  The value of CATALOG-ID must be an acceptable
+     `base-id'.
+
+
+File: slib.info,  Node: Relational Database,  Next: Weight-Balanced Trees,  Prev: Base Table,  Up: Data Structures
+
+Relational Database
+===================
+
+  `(require 'relational-database)'
+
+  This package implements a database system inspired by the Relational
+Model (`E. F. Codd, A Relational Model of Data for Large Shared Data
+Banks').  An SLIB relational database implementation can be created
+from any *Note Base Table:: implementation.
+
+* Menu:
+
+* Motivations::                 Database Manifesto
+* Creating and Opening Relational Databases::
+* Relational Database Operations::
+* Table Operations::
+* Catalog Representation::
+* Unresolved Issues::
+* Database Utilities::          'database-utilities
+
+
+File: slib.info,  Node: Motivations,  Next: Creating and Opening Relational Databases,  Prev: Relational Database,  Up: Relational Database
+
+Motivations
+-----------
+
+  Most nontrivial programs contain databases: Makefiles, configure
+scripts, file backup, calendars, editors, source revision control, CAD
+systems, display managers, menu GUIs, games, parsers, debuggers,
+profilers, and even error reporting are all rife with databases.  Coding
+databases is such a common activity in programming that many may not be
+aware of how often they do it.
+
+  A database often starts as a dispatch in a program.  The author,
+perhaps because of the need to make the dispatch configurable, the need
+for correlating dispatch in other routines, or because of changes or
+growth, devises a data structure to contain the information, a routine
+for interpreting that data structure, and perhaps routines for
+augmenting and modifying the stored data.  The dispatch must be
+converted into this form and tested.
+
+  The programmer may need to devise an interactive program for enabling
+easy examination and modification of the information contained in this
+database.  Often, in an attempt to foster modularity and avoid delays in
+release, intermediate file formats for the database information are
+devised.  It often turns out that users prefer modifying these
+intermediate files with a text editor to using the interactive program
+in order to do operations (such as global changes) not forseen by the
+program's author.
+
+  In order to address this need, the concientous software engineer may
+even provide a scripting language to allow users to make repetitive
+database changes.  Users will grumble that they need to read a large
+manual and learn yet another programming language (even if it *almost*
+has language "xyz" syntax) in order to do simple configuration.
+
+  All of these facilities need to be designed, coded, debugged,
+documented, and supported; often causing what was very simple in concept
+to become a major developement project.
+
+  This view of databases just outlined is somewhat the reverse of the
+view of the originators of the "Relational Model" of database
+abstraction.  The relational model was devised to unify and allow
+interoperation of large multi-user databases running on diverse
+platforms.  A fairly general purpose "Comprehensive Language" for
+database manipulations is mandated (but not specified) as part of the
+relational model for databases.
+
+  One aspect of the Relational Model of some importance is that the
+"Comprehensive Language" must be expressible in some form which can be
+stored in the database.  This frees the programmer from having to make
+programs data-driven in order to use a database.
+
+  This package includes as one of its basic supported types Scheme
+"expression"s.  This type allows expressions as defined by the Scheme
+standards to be stored in the database.  Using `slib:eval' retrieved
+expressions can be evaluated (in the top-level environment).  Scheme's
+`lambda' facilitates closure of environments, modularity, etc. so that
+procedures (which could not be stored directly most databases) can
+still be effectively retrieved.  Since `slib:eval' evaluates
+expressions in the top-level environment, built-in and user defined
+procedures can be easily accessed by name.
+
+  This package's purpose is to standardize (through a common interface)
+database creation and usage in Scheme programs.  The relational model's
+provision for inclusion of language expressions as data as well as the
+description (in tables, of course) of all of its tables assures that
+relational databases are powerful enough to assume the roles currently
+played by thousands of ad-hoc routines and data formats.
+
+Such standardization to a relational-like model brings many benefits:
+
+   * Tables, fields, domains, and types can be dealt with by name in
+     programs.
+
+   * The underlying database implementation can be changed (for
+     performance or other reasons) by changing a single line of code.
+
+   * The formats of tables can be easily extended or changed without
+     altering code.
+
+   * Consistency checks are specified as part of the table descriptions.
+     Changes in checks need only occur in one place.
+
+   * All the configuration information which the developer wishes to
+     group together is easily grouped, without needing to change
+     programs aware of only some of these tables.
+
+   * Generalized report generators, interactive entry programs, and
+     other database utilities can be part of a shared library.  The
+     burden of adding configurability to a program is greatly reduced.
+
+   * Scheme is the "comprehensive language" for these databases.
+     Scripting for configuration no longer needs to be in a separate
+     language with additional documentation.
+
+   * Scheme's latent types mesh well with the strict typing and logical
+     requirements of the relational model.
+
+   * Portable formats allow easy interchange of data.  The included
+     table descriptions help prevent misinterpretation of format.
+
+
+File: slib.info,  Node: Creating and Opening Relational Databases,  Next: Relational Database Operations,  Prev: Motivations,  Up: Relational Database
+
+Creating and Opening Relational Databases
+-----------------------------------------
+
+ - Function: make-relational-system BASE-TABLE-IMPLEMENTATION
+     Returns a procedure implementing a relational database using the
+     BASE-TABLE-IMPLEMENTATION.
+
+     All of the operations of a base table implementation are accessed
+     through a procedure defined by `require'ing that implementation.
+     Similarly, all of the operations of the relational database
+     implementation are accessed through the procedure returned by
+     `make-relational-system'.  For instance, a new relational database
+     could be created from the procedure returned by
+     `make-relational-system' by:
+
+          (require 'alist-table)
+          (define relational-alist-system
+                  (make-relational-system alist-table))
+          (define create-alist-database
+                  (relational-alist-system 'create-database))
+          (define my-database
+                  (create-alist-database "mydata.db"))
+
+What follows are the descriptions of the methods available from
+relational system returned by a call to `make-relational-system'.
+
+ - Function: create-database FILENAME
+     Returns an open, nearly empty relational database associated with
+     FILENAME.  The only tables defined are the system catalog and
+     domain table.  Calling the `close-database' method on this database
+     and possibly other operations will cause FILENAME to be written
+     to.  If FILENAME is `#f' a temporary, non-disk based database will
+     be created if such can be supported by the underlying base table
+     implelentation.  If the database cannot be created as specified
+     `#f' is returned.  For the fields and layout of descriptor tables,
+     *Note Catalog Representation::
+
+ - Function: open-database FILENAME MUTABLE?
+     Returns an open relational database associated with FILENAME.  If
+     MUTABLE? is `#t', this database will have methods capable of
+     effecting change to the database.  If MUTABLE? is `#f', only
+     methods for inquiring the database will be available.  Calling the
+     `close-database' (and possibly other) method on a MUTABLE?
+     database will cause FILENAME to be written to.  If the database
+     cannot be opened as specified `#f' is returned.
+
+
+File: slib.info,  Node: Relational Database Operations,  Next: Table Operations,  Prev: Creating and Opening Relational Databases,  Up: Relational Database
+
+Relational Database Operations
+------------------------------
+
+These are the descriptions of the methods available from an open
+relational database.  A method is retrieved from a database by calling
+the database with the symbol name of the operation.  For example:
+
+     (define my-database
+             (create-alist-database "mydata.db"))
+     (define telephone-table-desc
+             ((my-database 'create-table) 'telephone-table-desc))
+
+ - Function: close-database
+     Causes the relational database to be written to its associated
+     file (if any).  If the write is successful, subsequent operations
+     to this database will signal an error.  If the operations completed
+     successfully, `#t' is returned.  Otherwise, `#f' is returned.
+
+ - Function: write-database FILENAME
+     Causes the relational database to be written to FILENAME.  If the
+     write is successful, also causes the database to henceforth be
+     associated with FILENAME.  Calling the `close-database' (and
+     possibly other) method on this database will cause FILENAME to be
+     written to.  If FILENAME is `#f' this database will be changed to
+     a temporary, non-disk based database if such can be supported by
+     the underlying base table implelentation.  If the operations
+     completed successfully, `#t' is returned.  Otherwise, `#f' is
+     returned.
+
+ - Function: table-exists? TABLE-NAME
+     Returns `#t' if TABLE-NAME exists in the system catalog, otherwise
+     returns `#f'.
+
+ - Function: open-table TABLE-NAME MUTABLE?
+     Returns a "methods" procedure for an existing relational table in
+     this database if it exists and can be opened in the mode indicated
+     by MUTABLE?, otherwise returns `#f'.
+
+These methods will be present only in databases which are MUTABLE?.
+
+ - Function: delete-table TABLE-NAME
+     Removes and returns the TABLE-NAME row from the system catalog if
+     the table or view associated with TABLE-NAME gets removed from the
+     database, and `#f' otherwise.
+
+ - Function: create-table TABLE-DESC-NAME
+     Returns a methods procedure for a new (open) relational table for
+     describing the columns of a new base table in this database,
+     otherwise returns `#f'.  For the fields and layout of descriptor
+     tables, *Note Catalog Representation::.
+
+ - Function: create-table TABLE-NAME TABLE-DESC-NAME
+     Returns a methods procedure for a new (open) relational table with
+     columns as described by TABLE-DESC-NAME, otherwise returns `#f'.
+
+ - Function: create-view ??
+ - Function: project-table ??
+ - Function: restrict-table ??
+ - Function: cart-prod-tables ??
+     Not yet implemented.
+
+
+File: slib.info,  Node: Table Operations,  Next: Catalog Representation,  Prev: Relational Database Operations,  Up: Relational Database
+
+Table Operations
+----------------
+
+These are the descriptions of the methods available from an open
+relational table.  A method is retrieved from a table by calling the
+table with the symbol name of the operation.  For example:
+
+     (define telephone-table-desc
+             ((my-database 'create-table) 'telephone-table-desc))
+     (require 'common-list-functions)
+     (define ndrp (telephone-table-desc 'row:insert))
+     (ndrp '(1 #t name #f string))
+     (ndrp '(2 #f telephone
+               (lambda (d)
+                 (and (string? d) (> (string-length d) 2)
+                      (every
+                       (lambda (c)
+                         (memv c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+                                       #\+ #\( #\  #\) #\-)))
+                       (string->list d))))
+               string))
+
+Operations on a single column of a table are retrieved by giving the
+column name as the second argument to the methods procedure.  For
+example:
+
+     (define column-ids ((telephone-table-desc 'get* 'column-number)))
+
+Some operations described below require primary key arguments.  Primary
+keys arguments are denoted KEY1 KEY2 ....  It is an error to call an
+operation for a table which takes primary key arguments with the wrong
+number of primary keys for that table.
+
+The term "row" used below refers to a Scheme list of values (one for
+each column) in the order specified in the descriptor (table) for this
+table.  Missing values appear as `#f'.  Primary keys may not be missing.
+
+ - Function: get KEY1 KEY2 ...
+     Returns the value for the specified column of the row associated
+     with primary keys KEY1, KEY2 ... if it exists, or `#f' otherwise.
+
+ - Function: get*
+     Returns a list of the values for the specified column for all rows
+     in this table.
+
+ - Function: row:retrieve KEY1 KEY2 ...
+     Returns the row associated with primary keys KEY1, KEY2 ... if it
+     exists, or `#f' otherwise.
+
+ - Function: row:retrieve*
+     Returns a list of all rows in this table.
+
+ - Function: row:remove KEY1 KEY2 ...
+     Removes and returns the row associated with primary keys KEY1,
+     KEY2 ... if it exists, or `#f' otherwise.
+
+ - Function: row:remove*
+     Removes and returns a list of all rows in this table.
+
+ - Function: row:delete KEY1 KEY2 ...
+     Deletes the row associated with primary keys KEY1, KEY2 ... if it
+     exists.  The value returned is unspecified.
+
+ - Function: row:delete*
+     Deletes all rows in this table.  The value returned is
+     unspecified.  The descriptor table and catalog entry for this
+     table are not affected.
+
+ - Function: row:update ROW
+     Adds the row, ROW, to this table.  If a row for the primary key(s)
+     specified by ROW already exists in this table, it will be
+     overwritten.  The value returned is unspecified.
+
+ - Function: row:update* ROWS
+     Adds each row in the list ROWS, to this table.  If a row for the
+     primary key specified by an element of ROWS already exists in this
+     table, it will be overwritten.  The value returned is unspecified.
+
+ - Function: row:insert ROW
+     Adds the row ROW to this table.  If a row for the primary key(s)
+     specified by ROW already exists in this table an error is
+     signaled.  The value returned is unspecified.
+
+ - Function: row:insert* ROWS
+     Adds each row in the list ROWS, to this table.  If a row for the
+     primary key specified by an element of ROWS already exists in this
+     table, an error is signaled.  The value returned is unspecified.
+
+ - Function: for-each-row PROC
+     Calls PROC with each ROW in this table in the natural ordering for
+     the primary key types.  *Real* relational programmers would use
+     some least-upper-bound join for every row to get them in order;
+     But we don't have joins yet.
+
+ - Function: close-table
+     Subsequent operations to this table will signal an error.
+
+ - Constant: column-names
+ - Constant: column-foreigns
+ - Constant: column-domains
+ - Constant: column-types
+     Return a list of the column names, foreign-key table names, domain
+     names, or type names respectively for this table.  These 4 methods
+     are different from the others in that the list is returned, rather
+     than a procedure to obtain the list.
+
+ - Constant: primary-limit
+     Returns the number of primary keys fields in the relations in this
+     table.
+
+
+File: slib.info,  Node: Catalog Representation,  Next: Unresolved Issues,  Prev: Table Operations,  Up: Relational Database
+
+Catalog Representation
+----------------------
+
+Each database (in an implementation) has a "system catalog" which
+describes all the user accessible tables in that database (including
+itself).
+
+The system catalog base table has the following fields.  `PRI'
+indicates a primary key for that table.
+
+     PRI table-name
+         column-limit            the highest column number
+         coltab-name             descriptor table name
+         bastab-id               data base table identifier
+         user-integrity-rule
+         view-procedure          A scheme thunk which, when called,
+                                 produces a handle for the view.  coltab
+                                 and bastab are specified if and only if
+                                 view-procedure is not.
+
+Descriptors for base tables (not views) are tables (pointed to by
+system catalog).  Descriptor (base) tables have the fields:
+
+     PRI column-number           sequential integers from 1
+         primary-key?            boolean TRUE for primary key components
+         column-name
+         column-integrity-rule
+         domain-name
+
+A "primary key" is any column marked as `primary-key?' in the
+corresponding descriptor table.  All the `primary-key?' columns must
+have lower column numbers than any non-`primary-key?' columns.  Every
+table must have at least one primary key.  Primary keys must be
+sufficient to distinguish all rows from each other in the table.  All of
+the system defined tables have a single primary key.
+
+This package currently supports tables having from 1 to 4 primary keys
+if there are non-primary columns, and any (natural) number if *all*
+columns are primary keys.  If you need more than 4 primary keys, I would
+like to hear what you are doing!
+
+A "domain" is a category describing the allowable values to occur in a
+column.  It is described by a (base) table with the fields:
+
+     PRI domain-name
+         foreign-table
+         domain-integrity-rule
+         type-id
+         type-param
+
+The "type-id" field value is a symbol.  This symbol may be used by the
+underlying base table implementation in storing that field.
+
+If the `foreign-table' field is non-`#f' then that field names a table
+from the catalog.  The values for that domain must match a primary key
+of the table referenced by the TYPE-PARAM (or `#f', if allowed).  This
+package currently does not support composite foreign-keys.
+
+The types for which support is planned are:
+         atom
+         symbol
+         string                  [<length>]
+         number                  [<base>]
+         money                   <currency>
+         date-time
+         boolean
+     
+         foreign-key             <table-name>
+         expression
+         virtual                 <expression>
+
+
+File: slib.info,  Node: Unresolved Issues,  Next: Database Utilities,  Prev: Catalog Representation,  Up: Relational Database
+
+Unresolved Issues
+-----------------
+
+  Although `rdms.scm' is not large I found it very difficult to write
+(six rewrites).  I am not aware of any other examples of a generalized
+relational system (although there is little new in CS).  I left out
+several aspects of the Relational model in order to simplify the job.
+The major features lacking (which might be addressed portably) are
+views, transaction boundaries, and protection.
+
+  Protection needs a model for specifying priveledges.  Given how
+operations are accessed from handles it should not be difficult to
+restrict table accesses to those allowed for that user.
+
+  The system catalog has a field called `view-procedure'.  This should
+allow a purely functional implementation of views.  This will work but
+is unsatisfying for views resulting from a "select"ion (subset of
+rows); for whole table operations it will not be possible to reduce the
+number of keys scanned over when the selection is specified only by an
+opaque procedure.
+
+  Transaction boundaries present the most intriguing area.  Transaction
+boundaries are actually a feature of the "Comprehensive Language" of the
+Relational database and not of the database.  Scheme would seem to
+provide the opportunity for an extremely clean semantics for transaction
+boundaries since the builtin procedures with side effects are small in
+number and easily identified.
+
+  These side-effect builtin procedures might all be portably redefined
+to versions which properly handled transactions.  Compiled library
+routines would need to be recompiled as well.  Many system extensions
+(delete-file, system, etc.) would also need to be redefined.
+
+There are 2 scope issues that must be resolved for multiprocess
+transaction boundaries:
+
+Process scope
+     The actions captured by a transaction should be only for the
+     process which invoked the start of transaction.  Although standard
+     Scheme does not provide process primitives as such, `dynamic-wind'
+     would provide a workable hook into process switching for many
+     implementations.
+
+Shared utilities with state
+     Some shared utilities have state which should *not* be part of a
+     transaction.  An example would be calling a pseudo-random number
+     generator.  If the success of a transaction depended on the
+     pseudo-random number and failed, the state of the generator would
+     be set back.  Subsequent calls would keep returning the same
+     number and keep failing.
+
+     Pseudo-random number generators are not reentrant and so would
+     require locks in order to operate properly in a multiprocess
+     environment.  Are all examples of utilities whose state should not
+     part of transactions also non-reentrant?  If so, perhaps
+     suspending transaction capture for the duration of locks would fix
+     it.
+
+
+File: slib.info,  Node: Database Utilities,  Prev: Unresolved Issues,  Up: Relational Database
+
+Database Utilities
+------------------
+
+  `(require 'database-utilities)'
+
+This enhancement wraps a utility layer on `relational-database' which
+provides:
+   * Automatic loading of the appropriate base-table package when
+     opening a database.
+
+   * Automatic execution of initialization commands stored in database.
+
+   * Transparent execution of database commands stored in `*commands*'
+     table in database.
+
+Also included are utilities which provide:
+   * Data definition from Scheme lists and
+
+   * Report generation
+
+for any SLIB relational database.
+
+ - Function: create-database FILENAME BASE-TABLE-TYPE
+     Returns an open, nearly empty enhanced (with `*commands*' table)
+     relational database (with base-table type BASE-TABLE-TYPE)
+     associated with FILENAME.
+
+ - Function: open-database FILENAME
+ - Function: open-database FILENAME BASE-TABLE-TYPE
+     Returns an open enchanced relational database associated with
+     FILENAME.  The database will be opened with base-table type
+     BASE-TABLE-TYPE) if supplied.  If BASE-TABLE-TYPE is not supplied,
+     `open-database' will attempt to deduce the correct
+     base-table-type.  If the database can not be opened or if it lacks
+     the `*commands*' table, `#f' is returned.
+
+ - Function: open-database! FILENAME
+ - Function: open-database! FILENAME BASE-TABLE-TYPE
+     Returns *mutable* open enchanced relational database ...
+
+The table `*commands*' in an "enhanced" relational-database has the
+fields (with domains):
+     PRI name        symbol
+         parameters  parameter-list
+         procedure   expression
+         documentation string
+
+  The `parameters' field is a foreign key (domain `parameter-list') of
+the `*catalog-data*' table and should have the value of a table
+described by `*parameter-columns*'.  This `parameter-list' table
+describes the arguments suitable for passing to the associated command.
+The intent of this table is to be of a form such that different
+user-interfaces (for instance, pull-down menus or plain-text queries)
+can operate from the same table.  A `parameter-list' table has the
+following fields:
+     PRI index       uint
+         name        symbol
+         arity       parameter-arity
+         domain      domain
+         default     expression
+         documentation string
+
+  The `arity' field can take the values:
+
+`single'
+     Requires a single parameter of the specified domain.
+
+`optional'
+     A single parameter of the specified domain or zero parameters is
+     acceptable.
+
+`boolean'
+     A single boolean parameter or zero parameters (in which case `#f'
+     is substituted) is acceptable.
+
+`nary'
+     Any number of parameters of the specified domain are acceptable.
+     The argument passed to the command function is always a list of the
+     parameters.
+
+`nary1'
+     One or more of parameters of the specified domain are acceptable.
+     The argument passed to the command function is always a list of the
+     parameters.
+
+  The `domain' field specifies the domain which a parameter or
+parameters in the `index'th field must satisfy.
+
+  The `default' field is an expression whose value is either `#f' or a
+procedure of no arguments which returns a parameter or parameter list
+as appropriate.  If the expression's value is `#f' then no default is
+appropriate for this parameter.  Note that since the `default'
+procedure is called every time a default parameter is needed for this
+column, "sticky" defaults can be implemented using shared state with
+the domain-integrity-rule.
+
+Invoking Commands
+.................
+
+  When an enhanced relational-database is called with a symbol which
+matches a NAME in the `*commands*' table, the associated procedure
+expression is evaluated and applied to the enhanced
+relational-database.  A procedure should then be returned which the user
+can invoke on (optional) arguments.
+
+  The command `*initialize*' is special.  If present in the
+`*commands*' table, `open-database' or `open-database!' will return the
+value of the `*initialize*' command.  Notice that arbitrary code can be
+run when the `*initialize*' procedure is automatically applied to the
+enhanced relational-database.
+
+  Note also that if you wish to shadow or hide from the user
+relational-database methods described in *Note Relational Database
+Operations::, this can be done by a dispatch in the closure returned by
+the `*initialize*' expression rather than by entries in the
+`*commands*' table if it is desired that the underlying methods remain
+accessible to code in the `*commands*' table.
+
+ - Function: make-command-server RDB TABLE-NAME
+     Returns a procedure of 2 arguments, a (symbol) command and a
+     call-back procedure.  When this returned procedure is called, it
+     looks up COMMAND in table TABLE-NAME and calls the call-back
+     procedure with arguments:
+    COMMAND
+          The COMMAND
+
+    COMMAND-VALUE
+          The result of evaluating the expression in the PROCEDURE
+          field of TABLE-NAME and calling it with RDB.
+
+    PARAMETER-NAME
+          A list of the "official" name of each parameter.  Corresponds
+          to the `name' field of the COMMAND's parameter-table.
+
+    POSITIONS
+          A list of the positive integer index of each parameter.
+          Corresponds to the `index' field of the COMMAND's
+          parameter-table.
+
+    ARITIES
+          A list of the arities of each parameter.  Corresponds to the
+          `arity' field of the COMMAND's parameter-table.  For a
+          description of `arity' see table above.
+
+    DEFAULTS
+          A list of the defaults for each parameter.  Corresponds to
+          the `defaults' field of the COMMAND's parameter-table.
+
+    DOMAIN-INTEGRITY-RULES
+          A list of procedures (one for each parameter) which tests
+          whether a value for a parameter is acceptable for that
+          parameter.  The procedure should be called with each datum in
+          the list for `nary' arity parameters.
+
+    ALIASES
+          A list of lists of `(alias parameter-name)'.  There can be
+          more than one alias per PARAMETER-NAME.
+
+  For information about parameters, *Note Parameter lists::.  Here is an
+example of setting up a command with arguments and parsing those
+arguments from a `getopt' style argument list (*note Getopt::.).
+
+     (require 'database-utilities)
+     (require 'parameters)
+     (require 'getopt)
+     
+     (define my-rdb (create-database #f 'alist-table))
+     
+     (define-tables my-rdb
+       '(foo-params
+         *parameter-columns*
+         *parameter-columns*
+         ((1 first-argument single string "hithere" "first argument")
+          (2 flag boolean boolean #f "a flag")))
+       '(foo-pnames
+         ((name string))
+         ((parameter-index uint))
+         (("l" 1)
+          ("a" 2)))
+       '(my-commands
+         ((name symbol))
+         ((parameters parameter-list)
+          (parameter-names parameter-name-translation)
+          (procedure expression)
+          (documentation string))
+         ((foo
+           foo-params
+           foo-pnames
+           (lambda (rdb) (lambda (foo aflag) (print foo aflag)))
+           "test command arguments"))))
+     
+     (define (dbutil:serve-command-line rdb command-table
+                                        command argc argv)
+       (set! argv (if (vector? argv) (vector->list argv) argv))
+       ((make-command-server rdb command-table)
+        command
+        (lambda (comname comval options positions
+                         arities types defaults dirs aliases)
+          (apply comval (getopt->arglist argc argv options positions
+                                         arities types defaults dirs aliases)))))
+     
+     (define (test)
+       (set! *optind* 1)
+       (dbutil:serve-command-line
+        my-rdb 'my-commands 'foo 4 '("dummy" "-l" "foo" "-a")))
+     (test)
+     -|
+     "foo" #t
+
+  Some commands are defined in all extended relational-databases.  The
+are called just like *Note Relational Database Operations::.
+
+ - Function: add-domain DOMAIN-ROW
+     Adds DOMAIN-ROW to the "domains" table if there is no row in the
+     domains table associated with key `(car DOMAIN-ROW)' and returns
+     `#t'.  Otherwise returns `#f'.
+
+     For the fields and layout of the domain table, *Note Catalog
+     Representation::
+
+ - Function: delete-domain DOMAIN-NAME
+     Removes and returns the DOMAIN-NAME row from the "domains" table.
+
+ - Function: domain-checker DOMAIN
+     Returns a procedure to check an argument for conformance to domain
+     DOMAIN.
+
+Defining Tables
+---------------
+
+ - Procedure: define-tables RDB SPEC-0 ...
+     Adds tables as specified in SPEC-0 ... to the open
+     relational-database RDB.  Each SPEC has the form:
+
+          (<name> <descriptor-name> <descriptor-name> <rows>)
+     or
+          (<name> <primary-key-fields> <other-fields> <rows>)
+
+     where <name> is the table name, <descriptor-name> is the symbol
+     name of a descriptor table, <primary-key-fields> and
+     <other-fields> describe the primary keys and other fields
+     respectively, and <rows> is a list of data rows to be added to the
+     table.
+
+     <primary-key-fields> and <other-fields> are lists of field
+     descriptors of the form:
+
+          (<column-name> <domain>)
+     or
+          (<column-name> <domain> <column-integrity-rule>)
+
+     where <column-name> is the column name, <domain> is the domain of
+     the column, and <column-integrity-rule> is an expression whose
+     value is a procedure of one argument (and returns non-`#f' to
+     signal an error).
+
+     If <domain> is not a defined domain name and it matches the name of
+     this table or an already defined (in one of SPEC-0 ...) single key
+     field table, a foriegn-key domain will be created for it.
+
+ - Procedure: create-report RDB DESTINATION REPORT-NAME TABLE
+ - Procedure: create-report RDB DESTINATION REPORT-NAME
+     The symbol REPORT-NAME must be primary key in the table named
+     `*reports*' in the relational database RDB.  DESTINATION is a
+     port, string, or symbol.  If DESTINATION is a:
+
+    port
+          The table is created as ascii text and written to that port.
+
+    string
+          The table is created as ascii text and written to the file
+          named by DESTINATION.
+
+    symbol
+          DESTINATION is the primary key for a row in the table named
+          *printers*.
+
+     Each row in the table *reports* has the fields:
+
+    name
+          The report name.
+
+    default-table
+          The table to report on if none is specified.
+
+    header, footer
+          A `format' string.  At the beginning and end of each page
+          respectively, `format' is called with this string and the
+          (list of) column-names of this table.
+
+    reporter
+          A `format' string.  For each row in the table, `format' is
+          called with this string and the row.
+
+    minimum-break
+          The minimum number of lines into which the report lines for a
+          row can be broken.  Use `0' if a row's lines should not be
+          broken over page boundaries.
+
+     Each row in the table *printers* has the fields:
+
+    name
+          The printer name.
+
+    print-procedure
+          The procedure to call to actually print.
+
+     The report is prepared as follows:
+
+          `Format' (*note Format::.) is called with the `header' field
+          and the (list of) `column-names' of the table.
+
+          `Format' is called with the `reporter' field and (on
+          successive calls) each record in the natural order for the
+          table.  A count is kept of the number of newlines output by
+          format.  When the number of newlines to be output exceeds the
+          number of lines per page, the set of lines will be broken if
+          there are more than `minimum-break' left on this page and the
+          number of lines for this row is larger or equal to twice
+          `minimum-break'.
+
+          `Format' is called with the `footer' field and the (list of)
+          `column-names' of the table.  The footer field should not
+          output a newline.
+
+          A new page is output.
+
+          This entire process repeats until all the rows are output.
+
+The following example shows a new database with the name of `foo.db'
+being created with tables describing processor families and
+processor/os/compiler combinations.
+
+The database command `define-tables' is defined to call `define-tables'
+with its arguments.  The database is also configured to print `Welcome'
+when the database is opened.  The database is then closed and reopened.
+
+     (require 'database-utilities)
+     (define my-rdb (create-database "foo.db" 'alist-table))
+     
+     (define-tables my-rdb
+       '(*commands*
+         ((name symbol))
+         ((parameters parameter-list)
+          (procedure expression)
+          (documentation string))
+         ((define-tables
+           no-parameters
+           no-parameter-names
+           (lambda (rdb) (lambda specs (apply define-tables rdb specs)))
+           "Create or Augment tables from list of specs")
+          (*initialize*
+           no-parameters
+           no-parameter-names
+           (lambda (rdb) (display "Welcome") (newline) rdb)
+           "Print Welcome"))))
+     
+     ((my-rdb 'define-tables)
+      '(processor-family
+        ((family    atom))
+        ((also-ran  processor-family))
+        ((m68000           #f)
+         (m68030           m68000)
+         (i386             8086)
+         (8086             #f)
+         (powerpc          #f)))
+     
+      '(platform
+        ((name      symbol))
+        ((processor processor-family)
+         (os        symbol)
+         (compiler  symbol))
+        ((aix              powerpc aix     -)
+         (amiga-dice-c     m68000  amiga   dice-c)
+         (amiga-aztec      m68000  amiga   aztec)
+         (amiga-sas/c-5.10 m68000  amiga   sas/c)
+         (atari-st-gcc     m68000  atari   gcc)
+         (atari-st-turbo-c m68000  atari   turbo-c)
+         (borland-c-3.1    8086    ms-dos  borland-c)
+         (djgpp            i386    ms-dos  gcc)
+         (linux            i386    linux   gcc)
+         (microsoft-c      8086    ms-dos  microsoft-c)
+         (os/2-emx         i386    os/2    gcc)
+         (turbo-c-2        8086    ms-dos  turbo-c)
+         (watcom-9.0       i386    ms-dos  watcom))))
+     
+     ((my-rdb 'close-database))
+     
+     (set! my-rdb (open-database "foo.db" 'alist-table))
+     -|
+     Welcome
+
diff --git a/slib.info-3 b/slib.info-3
new file mode 100644
index 0000000..7109890
--- /dev/null
+++ b/slib.info-3
@@ -0,0 +1,859 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+File: slib.info,  Node: Weight-Balanced Trees,  Next: Structures,  Prev: Relational Database,  Up: Data Structures
+
+Weight-Balanced Trees
+=====================
+
+  `(require 'wt-tree)'
+
+  Balanced binary trees are a useful data structure for maintaining
+large sets of ordered objects or sets of associations whose keys are
+ordered.  MIT Scheme has an comprehensive implementation of
+weight-balanced binary trees which has several advantages over the
+other data structures for large aggregates:
+
+   * In addition to the usual element-level operations like insertion,
+     deletion and lookup, there is a full complement of collection-level
+     operations, like set intersection, set union and subset test, all
+     of which are implemented with good orders of growth in time and
+     space.  This makes weight balanced trees ideal for rapid
+     prototyping of functionally derived specifications.
+
+   * An element in a tree may be indexed by its position under the
+     ordering of the keys, and the ordinal position of an element may
+     be determined, both with reasonable efficiency.
+
+   * Operations to find and remove minimum element make weight balanced
+     trees simple to use for priority queues.
+
+   * The implementation is *functional* rather than *imperative*.  This
+     means that operations like `inserting' an association in a tree do
+     not destroy the old tree, in much the same way that `(+ 1 x)'
+     modifies neither the constant 1 nor the value bound to `x'.  The
+     trees are referentially transparent thus the programmer need not
+     worry about copying the trees.  Referential transparency allows
+     space efficiency to be achieved by sharing subtrees.
+
+  These features make weight-balanced trees suitable for a wide range of
+applications, especially those that require large numbers of sets or
+discrete maps.  Applications that have a few global databases and/or
+concentrate on element-level operations like insertion and lookup are
+probably better off using hash-tables or red-black trees.
+
+  The *size* of a tree is the number of associations that it contains.
+Weight balanced binary trees are balanced to keep the sizes of the
+subtrees of each node within a constant factor of each other.  This
+ensures logarithmic times for single-path operations (like lookup and
+insertion).  A weight balanced tree takes space that is proportional to
+the number of associations in the tree.  For the current
+implementation, the constant of proportionality is six words per
+association.
+
+  Weight balanced trees can be used as an implementation for either
+discrete sets or discrete maps (associations).  Sets are implemented by
+ignoring the datum that is associated with the key.  Under this scheme
+if an associations exists in the tree this indicates that the key of the
+association is a member of the set.  Typically a value such as `()',
+`#t' or `#f' is associated with the key.
+
+  Many operations can be viewed as computing a result that, depending on
+whether the tree arguments are thought of as sets or maps, is known by
+two different names.  An example is `wt-tree/member?', which, when
+regarding the tree argument as a set, computes the set membership
+operation, but, when regarding the tree as a discrete map,
+`wt-tree/member?' is the predicate testing if the map is defined at an
+element in its domain.  Most names in this package have been chosen
+based on interpreting the trees as sets, hence the name
+`wt-tree/member?' rather than `wt-tree/defined-at?'.
+
+  The weight balanced tree implementation is a run-time-loadable option.
+To use weight balanced trees, execute
+
+     (load-option 'wt-tree)
+
+once before calling any of the procedures defined here.
+
+* Menu:
+
+* Construction of Weight-Balanced Trees::
+* Basic Operations on Weight-Balanced Trees::
+* Advanced Operations on Weight-Balanced Trees::
+* Indexing Operations on Weight-Balanced Trees::
+
+
+File: slib.info,  Node: Construction of Weight-Balanced Trees,  Next: Basic Operations on Weight-Balanced Trees,  Prev: Weight-Balanced Trees,  Up: Weight-Balanced Trees
+
+Construction of Weight-Balanced Trees
+-------------------------------------
+
+  Binary trees require there to be a total order on the keys used to
+arrange the elements in the tree.  Weight balanced trees are organized
+by *types*, where the type is an object encapsulating the ordering
+relation.  Creating a tree is a two-stage process.  First a tree type
+must be created from the predicate which gives the ordering.  The tree
+type is then used for making trees, either empty or singleton trees or
+trees from other aggregate structures like association lists.  Once
+created, a tree `knows' its type and the type is used to test
+compatibility between trees in operations taking two trees.  Usually a
+small number of tree types are created at the beginning of a program
+and used many times throughout the program's execution.
+
+ - procedure+: make-wt-tree-type KEY<?
+     This procedure creates and returns a new tree type based on the
+     ordering predicate KEY<?.  KEY<? must be a total ordering, having
+     the property that for all key values `a', `b' and `c':
+
+          (key<? a a)                         => #f
+          (and (key<? a b) (key<? b a))       => #f
+          (if (and (key<? a b) (key<? b c))
+              (key<? a c)
+              #t)                             => #t
+
+     Two key values are assumed to be equal if neither is less than the
+     other by KEY<?.
+
+     Each call to `make-wt-tree-type' returns a distinct value, and
+     trees are only compatible if their tree types are `eq?'.  A
+     consequence is that trees that are intended to be used in binary
+     tree operations must all be created with a tree type originating
+     from the same call to `make-wt-tree-type'.
+
+ - variable+: number-wt-type
+     A standard tree type for trees with numeric keys.  `Number-wt-type'
+     could have been defined by
+
+          (define number-wt-type (make-wt-tree-type  <))
+
+ - variable+: string-wt-type
+     A standard tree type for trees with string keys.  `String-wt-type'
+     could have been defined by
+
+          (define string-wt-type (make-wt-tree-type  string<?))
+
+ - procedure+: make-wt-tree WT-TREE-TYPE
+     This procedure creates and returns a newly allocated weight
+     balanced tree.  The tree is empty, i.e. it contains no
+     associations.  WT-TREE-TYPE is a weight balanced tree type
+     obtained by calling `make-wt-tree-type'; the returned tree has
+     this type.
+
+ - procedure+: singleton-wt-tree WT-TREE-TYPE KEY DATUM
+     This procedure creates and returns a newly allocated weight
+     balanced tree.  The tree contains a single association, that of
+     DATUM with KEY.  WT-TREE-TYPE is a weight balanced tree type
+     obtained by calling `make-wt-tree-type'; the returned tree has
+     this type.
+
+ - procedure+: alist->wt-tree TREE-TYPE ALIST
+     Returns a newly allocated weight-balanced tree that contains the
+     same associations as ALIST.  This procedure is equivalent to:
+
+          (lambda (type alist)
+            (let ((tree (make-wt-tree type)))
+              (for-each (lambda (association)
+                          (wt-tree/add! tree
+                                        (car association)
+                                        (cdr association)))
+                        alist)
+              tree))
+
+
+File: slib.info,  Node: Basic Operations on Weight-Balanced Trees,  Next: Advanced Operations on Weight-Balanced Trees,  Prev: Construction of Weight-Balanced Trees,  Up: Weight-Balanced Trees
+
+Basic Operations on Weight-Balanced Trees
+-----------------------------------------
+
+  This section describes the basic tree operations on weight balanced
+trees.  These operations are the usual tree operations for insertion,
+deletion and lookup, some predicates and a procedure for determining the
+number of associations in a tree.
+
+ - procedure+: wt-tree? OBJECT
+     Returns `#t' if OBJECT is a weight-balanced tree, otherwise
+     returns `#f'.
+
+ - procedure+: wt-tree/empty? WT-TREE
+     Returns `#t' if WT-TREE contains no associations, otherwise
+     returns `#f'.
+
+ - procedure+: wt-tree/size WT-TREE
+     Returns the number of associations in WT-TREE, an exact
+     non-negative integer.  This operation takes constant time.
+
+ - procedure+: wt-tree/add WT-TREE KEY DATUM
+     Returns a new tree containing all the associations in WT-TREE and
+     the association of DATUM with KEY.  If WT-TREE already had an
+     association for KEY, the new association overrides the old.  The
+     average and worst-case times required by this operation are
+     proportional to the logarithm of the number of associations in
+     WT-TREE.
+
+ - procedure+: wt-tree/add! WT-TREE KEY DATUM
+     Associates DATUM with KEY in WT-TREE and returns an unspecified
+     value.  If WT-TREE already has an association for KEY, that
+     association is replaced.  The average and worst-case times
+     required by this operation are proportional to the logarithm of
+     the number of associations in WT-TREE.
+
+ - procedure+: wt-tree/member? KEY WT-TREE
+     Returns `#t' if WT-TREE contains an association for KEY, otherwise
+     returns `#f'.  The average and worst-case times required by this
+     operation are proportional to the logarithm of the number of
+     associations in WT-TREE.
+
+ - procedure+: wt-tree/lookup WT-TREE KEY DEFAULT
+     Returns the datum associated with KEY in WT-TREE.  If WT-TREE
+     doesn't contain an association for KEY, DEFAULT is returned.  The
+     average and worst-case times required by this operation are
+     proportional to the logarithm of the number of associations in
+     WT-TREE.
+
+ - procedure+: wt-tree/delete WT-TREE KEY
+     Returns a new tree containing all the associations in WT-TREE,
+     except that if WT-TREE contains an association for KEY, it is
+     removed from the result.  The average and worst-case times required
+     by this operation are proportional to the logarithm of the number
+     of associations in WT-TREE.
+
+ - procedure+: wt-tree/delete! WT-TREE KEY
+     If WT-TREE contains an association for KEY the association is
+     removed.  Returns an unspecified value.  The average and worst-case
+     times required by this operation are proportional to the logarithm
+     of the number of associations in WT-TREE.
+
+
+File: slib.info,  Node: Advanced Operations on Weight-Balanced Trees,  Next: Indexing Operations on Weight-Balanced Trees,  Prev: Basic Operations on Weight-Balanced Trees,  Up: Weight-Balanced Trees
+
+Advanced Operations on Weight-Balanced Trees
+--------------------------------------------
+
+  In the following the *size* of a tree is the number of associations
+that the tree contains, and a *smaller* tree contains fewer
+associations.
+
+ - procedure+: wt-tree/split< WT-TREE BOUND
+     Returns a new tree containing all and only the associations in
+     WT-TREE which have a key that is less than BOUND in the ordering
+     relation of the tree type of WT-TREE.  The average and worst-case
+     times required by this operation are proportional to the logarithm
+     of the size of WT-TREE.
+
+ - procedure+: wt-tree/split> WT-TREE BOUND
+     Returns a new tree containing all and only the associations in
+     WT-TREE which have a key that is greater than BOUND in the
+     ordering relation of the tree type of WT-TREE.  The average and
+     worst-case times required by this operation are proportional to the
+     logarithm of size of WT-TREE.
+
+ - procedure+: wt-tree/union WT-TREE-1 WT-TREE-2
+     Returns a new tree containing all the associations from both trees.
+     This operation is asymmetric: when both trees have an association
+     for the same key, the returned tree associates the datum from
+     WT-TREE-2 with the key.  Thus if the trees are viewed as discrete
+     maps then `wt-tree/union' computes the map override of WT-TREE-1 by
+     WT-TREE-2.  If the trees are viewed as sets the result is the set
+     union of the arguments.  The worst-case time required by this
+     operation is proportional to the sum of the sizes of both trees.
+     If the minimum key of one tree is greater than the maximum key of
+     the other tree then the time required is at worst proportional to
+     the logarithm of the size of the larger tree.
+
+ - procedure+: wt-tree/intersection WT-TREE-1 WT-TREE-2
+     Returns a new tree containing all and only those associations from
+     WT-TREE-1 which have keys appearing as the key of an association
+     in WT-TREE-2.  Thus the associated data in the result are those
+     from WT-TREE-1.  If the trees are being used as sets the result is
+     the set intersection of the arguments.  As a discrete map
+     operation, `wt-tree/intersection' computes the domain restriction
+     of WT-TREE-1 to (the domain of) WT-TREE-2.  The time required by
+     this operation is never worse that proportional to the sum of the
+     sizes of the trees.
+
+ - procedure+: wt-tree/difference WT-TREE-1 WT-TREE-2
+     Returns a new tree containing all and only those associations from
+     WT-TREE-1 which have keys that *do not* appear as the key of an
+     association in WT-TREE-2.  If the trees are viewed as sets the
+     result is the asymmetric set difference of the arguments.  As a
+     discrete map operation, it computes the domain restriction of
+     WT-TREE-1 to the complement of (the domain of) WT-TREE-2.  The
+     time required by this operation is never worse that proportional to
+     the sum of the sizes of the trees.
+
+ - procedure+: wt-tree/subset? WT-TREE-1 WT-TREE-2
+     Returns `#t' iff the key of each association in WT-TREE-1 is the
+     key of some association in WT-TREE-2, otherwise returns `#f'.
+     Viewed as a set operation, `wt-tree/subset?' is the improper subset
+     predicate.  A proper subset predicate can be constructed:
+
+          (define (proper-subset? s1 s2)
+            (and (wt-tree/subset? s1 s2)
+                 (< (wt-tree/size s1) (wt-tree/size s2))))
+
+     As a discrete map operation, `wt-tree/subset?' is the subset test
+     on the domain(s) of the map(s).  In the worst-case the time
+     required by this operation is proportional to the size of
+     WT-TREE-1.
+
+ - procedure+: wt-tree/set-equal? WT-TREE-1 WT-TREE-2
+     Returns `#t' iff for every association in WT-TREE-1 there is an
+     association in WT-TREE-2 that has the same key, and *vice versa*.
+
+     Viewing the arguments as sets `wt-tree/set-equal?' is the set
+     equality predicate.  As a map operation it determines if two maps
+     are defined on the same domain.
+
+     This procedure is equivalent to
+
+          (lambda (wt-tree-1 wt-tree-2)
+            (and (wt-tree/subset? wt-tree-1 wt-tree-2
+                 (wt-tree/subset? wt-tree-2 wt-tree-1)))
+
+     In the worst-case the time required by this operation is
+     proportional to the size of the smaller tree.
+
+ - procedure+: wt-tree/fold COMBINER INITIAL WT-TREE
+     This procedure reduces WT-TREE by combining all the associations,
+     using an reverse in-order traversal, so the associations are
+     visited in reverse order.  COMBINER is a procedure of three
+     arguments: a key, a datum and the accumulated result so far.
+     Provided COMBINER takes time bounded by a constant, `wt-tree/fold'
+     takes time proportional to the size of WT-TREE.
+
+     A sorted association list can be derived simply:
+
+          (wt-tree/fold  (lambda (key datum list)
+                           (cons (cons key datum) list))
+                         '()
+                         WT-TREE))
+
+     The data in the associations can be summed like this:
+
+          (wt-tree/fold  (lambda (key datum sum) (+ sum datum))
+                         0
+                         WT-TREE)
+
+ - procedure+: wt-tree/for-each ACTION WT-TREE
+     This procedure traverses the tree in-order, applying ACTION to
+     each association.  The associations are processed in increasing
+     order of their keys.  ACTION is a procedure of two arguments which
+     take the key and datum respectively of the association.  Provided
+     ACTION takes time bounded by a constant, `wt-tree/for-each' takes
+     time proportional to in the size of WT-TREE.  The example prints
+     the tree:
+
+          (wt-tree/for-each (lambda (key value)
+                              (display (list key value)))
+                            WT-TREE))
+
+
+File: slib.info,  Node: Indexing Operations on Weight-Balanced Trees,  Prev: Advanced Operations on Weight-Balanced Trees,  Up: Weight-Balanced Trees
+
+Indexing Operations on Weight-Balanced Trees
+--------------------------------------------
+
+  Weight balanced trees support operations that view the tree as sorted
+sequence of associations.  Elements of the sequence can be accessed by
+position, and the position of an element in the sequence can be
+determined, both in logarthmic time.
+
+ - procedure+: wt-tree/index WT-TREE INDEX
+ - procedure+: wt-tree/index-datum WT-TREE INDEX
+ - procedure+: wt-tree/index-pair WT-TREE INDEX
+     Returns the 0-based INDEXth association of WT-TREE in the sorted
+     sequence under the tree's ordering relation on the keys.
+     `wt-tree/index' returns the INDEXth key, `wt-tree/index-datum'
+     returns the datum associated with the INDEXth key and
+     `wt-tree/index-pair' returns a new pair `(KEY . DATUM)' which is
+     the `cons' of the INDEXth key and its datum.  The average and
+     worst-case times required by this operation are proportional to
+     the logarithm of the number of associations in the tree.
+
+     These operations signal an error if the tree is empty, if
+     INDEX`<0', or if INDEX is greater than or equal to the number of
+     associations in the tree.
+
+     Indexing can be used to find the median and maximum keys in the
+     tree as follows:
+
+          median:   (wt-tree/index WT-TREE (quotient (wt-tree/size WT-TREE) 2))
+          
+          maximum:  (wt-tree/index WT-TREE (-1+ (wt-tree/size WT-TREE)))
+
+ - procedure+: wt-tree/rank WT-TREE KEY
+     Determines the 0-based position of KEY in the sorted sequence of
+     the keys under the tree's ordering relation, or `#f' if the tree
+     has no association with for KEY.  This procedure returns either an
+     exact non-negative integer or `#f'.  The average and worst-case
+     times required by this operation are proportional to the logarithm
+     of the number of associations in the tree.
+
+ - procedure+: wt-tree/min WT-TREE
+ - procedure+: wt-tree/min-datum WT-TREE
+ - procedure+: wt-tree/min-pair WT-TREE
+     Returns the association of WT-TREE that has the least key under
+     the tree's ordering relation.  `wt-tree/min' returns the least key,
+     `wt-tree/min-datum' returns the datum associated with the least
+     key and `wt-tree/min-pair' returns a new pair `(key . datum)'
+     which is the `cons' of the minimum key and its datum.  The average
+     and worst-case times required by this operation are proportional
+     to the logarithm of the number of associations in the tree.
+
+     These operations signal an error if the tree is empty.  They could
+     be written
+          (define (wt-tree/min tree)        (wt-tree/index tree 0))
+          (define (wt-tree/min-datum tree)  (wt-tree/index-datum tree 0))
+          (define (wt-tree/min-pair tree)   (wt-tree/index-pair tree 0))
+
+ - procedure+: wt-tree/delete-min WT-TREE
+     Returns a new tree containing all of the associations in WT-TREE
+     except the association with the least key under the WT-TREE's
+     ordering relation.  An error is signalled if the tree is empty.
+     The average and worst-case times required by this operation are
+     proportional to the logarithm of the number of associations in the
+     tree.  This operation is equivalent to
+
+          (wt-tree/delete WT-TREE (wt-tree/min WT-TREE))
+
+ - procedure+: wt-tree/delete-min! WT-TREE
+     Removes the association with the least key under the WT-TREE's
+     ordering relation.  An error is signalled if the tree is empty.
+     The average and worst-case times required by this operation are
+     proportional to the logarithm of the number of associations in the
+     tree.  This operation is equivalent to
+
+          (wt-tree/delete! WT-TREE (wt-tree/min WT-TREE))
+
+
+File: slib.info,  Node: Structures,  Prev: Weight-Balanced Trees,  Up: Data Structures
+
+Structures
+==========
+
+  `(require 'struct)' (uses defmacros)
+
+  `defmacro's which implement "records" from the book `Essentials of
+Programming Languages' by Daniel P. Friedman, M.  Wand and C.T. Haynes.
+Copyright 1992 Jeff Alexander, Shinnder Lee, and Lewis Patterson
+
+  Matthew McDonald <mafm@cs.uwa.edu.au> added field setters.
+
+ - Macro: define-record TAG (VAR1 VAR2 ...)
+     Defines several functions pertaining to record-name TAG:
+
+      - Function: make-TAG VAR1 VAR2 ...
+
+      - Function: TAG? OBJ
+
+      - Function: TAG->VAR1 OBJ
+
+      - Function: TAG->VAR2 OBJ
+     ...
+
+      - Function: set-TAG-VAR1! OBJ VAL
+
+      - Function: set-TAG-VAR2! OBJ VAL
+     ...
+
+     Here is an example of its use.
+
+          (define-record term (operator left right))
+          => #<unspecified>
+          (define foo (make-term 'plus  1 2))
+          => foo
+          (term-left foo)
+          => 1
+          (set-term-left! foo 2345)
+          => #<unspecified>
+          (term-left foo)
+          => 2345
+
+ - Macro: variant-case EXP (TAG (VAR1 VAR2 ...) BODY) ...
+     executes the following for the matching clause:
+
+          ((lambda (VAR1 VAR ...) BODY)
+             (TAG->VAR1 EXP)
+             (TAG->VAR2 EXP) ...)
+
+
+File: slib.info,  Node: Macros,  Next: Numerics,  Prev: Data Structures,  Up: Top
+
+Macros
+******
+
+* Menu:
+
+* Defmacro::                    Supported by all implementations
+
+* R4RS Macros::                 'macro
+* Macro by Example::            'macro-by-example
+* Macros That Work::            'macros-that-work
+* Syntactic Closures::          'syntactic-closures
+* Syntax-Case Macros::          'syntax-case
+
+Syntax extensions (macros) included with SLIB.  Also *Note Structures::.
+
+* Fluid-Let::                   'fluid-let
+* Yasos::                       'yasos, 'oop, 'collect
+
+
+File: slib.info,  Node: Defmacro,  Next: R4RS Macros,  Prev: Macros,  Up: Macros
+
+Defmacro
+========
+
+  Defmacros are supported by all implementations.
+
+ - Function: gentemp
+     Returns a new (interned) symbol each time it is called.  The symbol
+     names are implementation-dependent
+          (gentemp) => scm:G0
+          (gentemp) => scm:G1
+
+ - Function: defmacro:eval E
+     Returns the `slib:eval' of expanding all defmacros in scheme
+     expression E.
+
+ - Function: defmacro:load FILENAME
+     FILENAME should be a string.  If filename names an existing file,
+     the `defmacro:load' procedure reads Scheme source code expressions
+     and definitions from the file and evaluates them sequentially.
+     These source code expressions and definitions may contain defmacro
+     definitions.  The `macro:load' procedure does not affect the values
+     returned by `current-input-port' and `current-output-port'.
+
+ - Function: defmacro? SYM
+     Returns `#t' if SYM has been defined by `defmacro', `#f' otherwise.
+
+ - Function: macroexpand-1 FORM
+ - Function: macroexpand FORM
+     If FORM is a macro call, `macroexpand-1' will expand the macro
+     call once and return it.  A FORM is considered to be a macro call
+     only if it is a cons whose `car' is a symbol for which a `defmacr'
+     has been defined.
+
+     `macroexpand' is similar to `macroexpand-1', but repeatedly
+     expands FORM until it is no longer a macro call.
+
+ - Macro: defmacro NAME LAMBDA-LIST FORM ...
+     When encountered by `defmacro:eval', `defmacro:macroexpand*', or
+     `defmacro:load' defines a new macro which will henceforth be
+     expanded when encountered by `defmacro:eval',
+     `defmacro:macroexpand*', or `defmacro:load'.
+
+Defmacroexpand
+--------------
+
+  `(require 'defmacroexpand)'
+
+ - Function: defmacro:expand* E
+     Returns the result of expanding all defmacros in scheme expression
+     E.
+
+
+File: slib.info,  Node: R4RS Macros,  Next: Macro by Example,  Prev: Defmacro,  Up: Macros
+
+R4RS Macros
+===========
+
+  `(require 'macro)' is the appropriate call if you want R4RS
+high-level macros but don't care about the low level implementation.  If
+an SLIB R4RS macro implementation is already loaded it will be used.
+Otherwise, one of the R4RS macros implemetations is loaded.
+
+  The SLIB R4RS macro implementations support the following uniform
+interface:
+
+ - Function: macro:expand SEXPRESSION
+     Takes an R4RS expression, macro-expands it, and returns the result
+     of the macro expansion.
+
+ - Function: macro:eval SEXPRESSION
+     Takes an R4RS expression, macro-expands it, evals the result of the
+     macro expansion, and returns the result of the evaluation.
+
+ - Procedure: macro:load FILENAME
+     FILENAME should be a string.  If filename names an existing file,
+     the `macro:load' procedure reads Scheme source code expressions and
+     definitions from the file and evaluates them sequentially.  These
+     source code expressions and definitions may contain macro
+     definitions.  The `macro:load' procedure does not affect the
+     values returned by `current-input-port' and `current-output-port'.
+
+
+File: slib.info,  Node: Macro by Example,  Next: Macros That Work,  Prev: R4RS Macros,  Up: Macros
+
+Macro by Example
+================
+
+  `(require 'macro-by-example)'
+
+  A vanilla implementation of `Macro by Example' (Eugene Kohlbecker,
+R4RS) by Dorai Sitaram, (dorai@cs.rice.edu) using `defmacro'.
+
+   * generating hygienic global `define-syntax' Macro-by-Example macros
+     *cheaply*.
+
+   * can define macros which use `...'.
+
+   * needn't worry about a lexical variable in a macro definition
+     clashing with a variable from the macro use context
+
+   * don't suffer the overhead of redefining the repl if `defmacro'
+     natively supported (most implementations)
+
+Caveat
+------
+
+  These macros are not referentially transparent (*note Macros:
+(r4rs)Macros.).  Lexically scoped macros (i.e., `let-syntax' and
+`letrec-syntax') are not supported.  In any case, the problem of
+referential transparency gains poignancy only when `let-syntax' and
+`letrec-syntax' are used.  So you will not be courting large-scale
+disaster unless you're using system-function names as local variables
+with unintuitive bindings that the macro can't use.  However, if you
+must have the full `r4rs' macro functionality, look to the more
+featureful (but also more expensive) versions of syntax-rules available
+in slib *Note Macros That Work::, *Note Syntactic Closures::, and *Note
+Syntax-Case Macros::.
+
+ - Macro: define-syntax KEYWORD TRANSFORMER-SPEC
+     The KEYWORD is an identifier, and the TRANSFORMER-SPEC should be
+     an instance of `syntax-rules'.
+
+     The top-level syntactic environment is extended by binding the
+     KEYWORD to the specified transformer.
+
+          (define-syntax let*
+            (syntax-rules ()
+              ((let* () body1 body2 ...)
+               (let () body1 body2 ...))
+              ((let* ((name1 val1) (name2 val2) ...)
+                 body1 body2 ...)
+               (let ((name1 val1))
+                 (let* (( name2 val2) ...)
+                   body1 body2 ...)))))
+
+ - Macro: syntax-rules LITERALS SYNTAX-RULE ...
+     LITERALS is a list of identifiers, and each SYNTAX-RULE should be
+     of the form
+
+     `(PATTERN TEMPLATE)'
+
+     where the PATTERN and  TEMPLATE are as in the grammar above.
+
+     An instance of `syntax-rules' produces a new macro transformer by
+     specifying a sequence of hygienic rewrite rules.  A use of a macro
+     whose keyword is associated with a transformer specified by
+     `syntax-rules' is matched against the patterns contained in the
+     SYNTAX-RULEs, beginning with the leftmost SYNTAX-RULE.  When a
+     match is found, the macro use is trancribed hygienically according
+     to the template.
+
+     Each pattern begins with the keyword for the macro.  This keyword
+     is not involved in the matching and is not considered a pattern
+     variable or literal identifier.
+
+
+File: slib.info,  Node: Macros That Work,  Next: Syntactic Closures,  Prev: Macro by Example,  Up: Macros
+
+Macros That Work
+================
+
+  `(require 'macros-that-work)'
+
+  `Macros That Work' differs from the other R4RS macro implementations
+in that it does not expand derived expression types to primitive
+expression types.
+
+ - Function: macro:expand EXPRESSION
+ - Function: macwork:expand EXPRESSION
+     Takes an R4RS expression, macro-expands it, and returns the result
+     of the macro expansion.
+
+ - Function: macro:eval EXPRESSION
+ - Function: macwork:eval EXPRESSION
+     `macro:eval' returns the value of EXPRESSION in the current top
+     level environment.  EXPRESSION can contain macro definitions.
+     Side effects of EXPRESSION will affect the top level environment.
+
+ - Procedure: macro:load FILENAME
+ - Procedure: macwork:load FILENAME
+     FILENAME should be a string.  If filename names an existing file,
+     the `macro:load' procedure reads Scheme source code expressions and
+     definitions from the file and evaluates them sequentially.  These
+     source code expressions and definitions may contain macro
+     definitions.  The `macro:load' procedure does not affect the
+     values returned by `current-input-port' and `current-output-port'.
+
+  References:
+
+  The `Revised^4 Report on the Algorithmic Language Scheme' Clinger and
+Rees [editors].  To appear in LISP Pointers.  Also available as a
+technical report from the University of Oregon, MIT AI Lab, and Cornell.
+
+            Macros That Work.  Clinger and Rees.  POPL '91.
+
+  The supported syntax differs from the R4RS in that vectors are allowed
+as patterns and as templates and are not allowed as pattern or template
+data.
+
+     transformer spec  ==>  (syntax-rules literals rules)
+     
+     rules  ==>  ()
+              |  (rule . rules)
+     
+     rule  ==>  (pattern template)
+     
+     pattern  ==>  pattern_var      ; a symbol not in literals
+                |  symbol           ; a symbol in literals
+                |  ()
+                |  (pattern . pattern)
+                |  (ellipsis_pattern)
+                |  #(pattern*)                     ; extends R4RS
+                |  #(pattern* ellipsis_pattern)    ; extends R4RS
+                |  pattern_datum
+     
+     template  ==>  pattern_var
+                 |  symbol
+                 |  ()
+                 |  (template2 . template2)
+                 |  #(template*)                   ; extends R4RS
+                 |  pattern_datum
+     
+     template2  ==>  template
+                  |  ellipsis_template
+     
+     pattern_datum  ==>  string                    ; no vector
+                      |  character
+                      |  boolean
+                      |  number
+     
+     ellipsis_pattern  ==> pattern ...
+     
+     ellipsis_template  ==>  template ...
+     
+     pattern_var  ==>  symbol   ; not in literals
+     
+     literals  ==>  ()
+                 |  (symbol . literals)
+
+Definitions
+-----------
+
+Scope of an ellipsis
+     Within a pattern or template, the scope of an ellipsis (`...') is
+     the pattern or template that appears to its left.
+
+Rank of a pattern variable
+     The rank of a pattern variable is the number of ellipses within
+     whose scope it appears in the pattern.
+
+Rank of a subtemplate
+     The rank of a subtemplate is the number of ellipses within whose
+     scope it appears in the template.
+
+Template rank of an occurrence of a pattern variable
+     The template rank of an occurrence of a pattern variable within a
+     template is the rank of that occurrence, viewed as a subtemplate.
+
+Variables bound by a pattern
+     The variables bound by a pattern are the pattern variables that
+     appear within it.
+
+Referenced variables of a subtemplate
+     The referenced variables of a subtemplate are the pattern
+     variables that appear within it.
+
+Variables opened by an ellipsis template
+     The variables opened by an ellipsis template are the referenced
+     pattern variables whose rank is greater than the rank of the
+     ellipsis template.
+
+Restrictions
+------------
+
+  No pattern variable appears more than once within a pattern.
+
+  For every occurrence of a pattern variable within a template, the
+template rank of the occurrence must be greater than or equal to the
+pattern variable's rank.
+
+  Every ellipsis template must open at least one variable.
+
+  For every ellipsis template, the variables opened by an ellipsis
+template must all be bound to sequences of the same length.
+
+  The compiled form of a RULE is
+
+     rule  ==>  (pattern template inserted)
+     
+     pattern  ==>  pattern_var
+                |  symbol
+                |  ()
+                |  (pattern . pattern)
+                |  ellipsis_pattern
+                |  #(pattern)
+                |  pattern_datum
+     
+     template  ==>  pattern_var
+                 |  symbol
+                 |  ()
+                 |  (template2 . template2)
+                 |  #(pattern)
+                 |  pattern_datum
+     
+     template2  ==>  template
+                  |  ellipsis_template
+     
+     pattern_datum  ==>  string
+                      |  character
+                      |  boolean
+                      |  number
+     
+     pattern_var  ==>  #(V symbol rank)
+     
+     ellipsis_pattern  ==>  #(E pattern pattern_vars)
+     
+     ellipsis_template  ==>  #(E template pattern_vars)
+     
+     inserted  ==>  ()
+                 |  (symbol . inserted)
+     
+     pattern_vars  ==>  ()
+                     |  (pattern_var . pattern_vars)
+     
+     rank  ==>  exact non-negative integer
+
+  where V and E are unforgeable values.
+
+  The pattern variables associated with an ellipsis pattern are the
+variables bound by the pattern, and the pattern variables associated
+with an ellipsis template are the variables opened by the ellipsis
+template.
+
+  If the template contains a big chunk that contains no pattern
+variables or inserted identifiers, then the big chunk will be copied
+unnecessarily.  That shouldn't matter very often.
+
diff --git a/slib.info-4 b/slib.info-4
new file mode 100644
index 0000000..3d3da19
--- /dev/null
+++ b/slib.info-4
@@ -0,0 +1,1248 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+File: slib.info,  Node: Syntactic Closures,  Next: Syntax-Case Macros,  Prev: Macros That Work,  Up: Macros
+
+Syntactic Closures
+==================
+
+  `(require 'syntactic-closures)'
+
+ - Function: macro:expand EXPRESSION
+ - Function: synclo:expand EXPRESSION
+     Returns scheme code with the macros and derived expression types of
+     EXPRESSION expanded to primitive expression types.
+
+ - Function: macro:eval EXPRESSION
+ - Function: synclo:eval EXPRESSION
+     `macro:eval' returns the value of EXPRESSION in the current top
+     level environment.  EXPRESSION can contain macro definitions.
+     Side effects of EXPRESSION will affect the top level environment.
+
+ - Procedure: macro:load FILENAME
+ - Procedure: synclo:load FILENAME
+     FILENAME should be a string.  If filename names an existing file,
+     the `macro:load' procedure reads Scheme source code expressions and
+     definitions from the file and evaluates them sequentially.  These
+     source code expressions and definitions may contain macro
+     definitions.  The `macro:load' procedure does not affect the
+     values returned by `current-input-port' and `current-output-port'.
+
+Syntactic Closure Macro Facility
+--------------------------------
+
+                  A Syntactic Closures Macro Facility
+
+                            by Chris Hanson
+
+                            9 November 1991
+
+  This document describes "syntactic closures", a low-level macro
+facility for the Scheme programming language.  The facility is an
+alternative to the low-level macro facility described in the `Revised^4
+Report on Scheme.' This document is an addendum to that report.
+
+  The syntactic closures facility extends the BNF rule for TRANSFORMER
+SPEC to allow a new keyword that introduces a low-level macro
+transformer:
+     TRANSFORMER SPEC := (transformer EXPRESSION)
+
+  Additionally, the following procedures are added:
+     make-syntactic-closure
+     capture-syntactic-environment
+     identifier?
+     identifier=?
+
+  The description of the facility is divided into three parts.  The
+first part defines basic terminology.  The second part describes how
+macro transformers are defined.  The third part describes the use of
+"identifiers", which extend the syntactic closure mechanism to be
+compatible with `syntax-rules'.
+
+Terminology
+...........
+
+  This section defines the concepts and data types used by the syntactic
+closures facility.
+
+     "Forms" are the syntactic entities out of which programs are
+     recursively constructed.  A form is any expression, any
+     definition, any syntactic keyword, or any syntactic closure.  The
+     variable name that appears in a `set!' special form is also a
+     form.  Examples of forms:
+          17
+          #t
+          car
+          (+ x 4)
+          (lambda (x) x)
+          (define pi 3.14159)
+          if
+          define
+
+     An "alias" is an alternate name for a given symbol.  It can appear
+     anywhere in a form that the symbol could be used, and when quoted
+     it is replaced by the symbol; however, it does not satisfy the
+     predicate `symbol?'.  Macro transformers rarely distinguish
+     symbols from aliases, referring to both as identifiers.
+
+     A "syntactic" environment maps identifiers to their meanings.
+     More precisely, it determines whether an identifier is a syntactic
+     keyword or a variable.  If it is a keyword, the meaning is an
+     interpretation for the form in which that keyword appears.  If it
+     is a variable, the meaning identifies which binding of that
+     variable is referenced.  In short, syntactic environments contain
+     all of the contextual information necessary for interpreting the
+     meaning of a particular form.
+
+     A "syntactic closure" consists of a form, a syntactic environment,
+     and a list of identifiers.  All identifiers in the form take their
+     meaning from the syntactic environment, except those in the given
+     list.  The identifiers in the list are to have their meanings
+     determined later.  A syntactic closure may be used in any context
+     in which its form could have been used.  Since a syntactic closure
+     is also a form, it may not be used in contexts where a form would
+     be illegal.  For example, a form may not appear as a clause in the
+     cond special form.  A syntactic closure appearing in a quoted
+     structure is replaced by its form.
+
+Transformer Definition
+......................
+
+  This section describes the `transformer' special form and the
+procedures `make-syntactic-closure' and `capture-syntactic-environment'.
+
+ - Syntax: transformer EXPRESSION
+     Syntax: It is an error if this syntax occurs except as a
+     TRANSFORMER SPEC.
+
+     Semantics: The EXPRESSION is evaluated in the standard transformer
+     environment to yield a macro transformer as described below.  This
+     macro transformer is bound to a macro keyword by the special form
+     in which the `transformer' expression appears (for example,
+     `let-syntax').
+
+     A "macro transformer" is a procedure that takes two arguments, a
+     form and a syntactic environment, and returns a new form.  The
+     first argument, the "input form", is the form in which the macro
+     keyword occurred.  The second argument, the "usage environment",
+     is the syntactic environment in which the input form occurred.
+     The result of the transformer, the "output form", is automatically
+     closed in the "transformer environment", which is the syntactic
+     environment in which the `transformer' expression occurred.
+
+     For example, here is a definition of a push macro using
+     `syntax-rules':
+          (define-syntax  push
+            (syntax-rules ()
+              ((push item list)
+               (set! list (cons item list)))))
+
+     Here is an equivalent definition using `transformer':
+          (define-syntax push
+            (transformer
+             (lambda (exp env)
+               (let ((item
+                      (make-syntactic-closure env '() (cadr exp)))
+                     (list
+                      (make-syntactic-closure env '() (caddr exp))))
+                 `(set! ,list (cons ,item ,list))))))
+
+     In this example, the identifiers `set!' and `cons' are closed in
+     the transformer environment, and thus will not be affected by the
+     meanings of those identifiers in the usage environment `env'.
+
+     Some macros may be non-hygienic by design.  For example, the
+     following defines a loop macro that implicitly binds `exit' to an
+     escape procedure.  The binding of `exit' is intended to capture
+     free references to `exit' in the body of the loop, so `exit' must
+     be left free when the body is closed:
+          (define-syntax loop
+            (transformer
+             (lambda (exp env)
+               (let ((body (cdr exp)))
+                 `(call-with-current-continuation
+                   (lambda (exit)
+                     (let f ()
+                       ,@(map (lambda  (exp)
+                                 (make-syntactic-closure env '(exit)
+                                                         exp))
+                               body)
+                       (f))))))))
+
+     To assign meanings to the identifiers in a form, use
+     `make-syntactic-closure' to close the form in a syntactic
+     environment.
+
+ - Function: make-syntactic-closure ENVIRONMENT FREE-NAMES FORM
+     ENVIRONMENT must be a syntactic environment, FREE-NAMES must be a
+     list of identifiers, and FORM must be a form.
+     `make-syntactic-closure' constructs and returns a syntactic closure
+     of FORM in ENVIRONMENT, which can be used anywhere that FORM could
+     have been used.  All the identifiers used in FORM, except those
+     explicitly excepted by FREE-NAMES, obtain their meanings from
+     ENVIRONMENT.
+
+     Here is an example where FREE-NAMES is something other than the
+     empty list.  It is instructive to compare the use of FREE-NAMES in
+     this example with its use in the `loop' example above: the examples
+     are similar except for the source of the identifier being left
+     free.
+          (define-syntax let1
+            (transformer
+             (lambda (exp env)
+               (let ((id (cadr exp))
+                     (init (caddr exp))
+                     (exp (cadddr exp)))
+                 `((lambda (,id)
+                     ,(make-syntactic-closure env (list id) exp))
+                   ,(make-syntactic-closure env '() init))))))
+
+     `let1' is a simplified version of `let' that only binds a single
+     identifier, and whose body consists of a single expression.  When
+     the body expression is syntactically closed in its original
+     syntactic environment, the identifier that is to be bound by
+     `let1' must be left free, so that it can be properly captured by
+     the `lambda' in the output form.
+
+     To obtain a syntactic environment other than the usage
+     environment, use `capture-syntactic-environment'.
+
+ - Function: capture-syntactic-environment PROCEDURE
+     `capture-syntactic-environment' returns a form that will, when
+     transformed, call PROCEDURE on the current syntactic environment.
+     PROCEDURE should compute and return a new form to be transformed,
+     in that same syntactic environment, in place of the form.
+
+     An example will make this clear.  Suppose we wanted to define a
+     simple `loop-until' keyword equivalent to
+          (define-syntax loop-until
+            (syntax-rules ()
+              ((loop-until id init test return step)
+               (letrec ((loop
+                         (lambda (id)
+                           (if test return (loop step)))))
+                 (loop init)))))
+
+     The following attempt at defining `loop-until' has a subtle bug:
+          (define-syntax loop-until
+            (transformer
+             (lambda (exp env)
+               (let ((id (cadr exp))
+                     (init (caddr exp))
+                     (test (cadddr exp))
+                     (return (cadddr (cdr exp)))
+                     (step (cadddr (cddr exp)))
+                     (close
+                      (lambda (exp free)
+                        (make-syntactic-closure env free exp))))
+                 `(letrec ((loop
+                            (lambda (,id)
+                              (if ,(close test (list id))
+                                  ,(close return (list id))
+                                  (loop ,(close step (list id)))))))
+                    (loop ,(close init '())))))))
+
+     This definition appears to take all of the proper precautions to
+     prevent unintended captures.  It carefully closes the
+     subexpressions in their original syntactic environment and it
+     leaves the `id' identifier free in the `test', `return', and
+     `step' expressions, so that it will be captured by the binding
+     introduced by the `lambda' expression.  Unfortunately it uses the
+     identifiers `if' and `loop' within that `lambda' expression, so if
+     the user of `loop-until' just happens to use, say, `if' for the
+     identifier, it will be inadvertently captured.
+
+     The syntactic environment that `if' and `loop' want to be exposed
+     to is the one just outside the `lambda' expression: before the
+     user's identifier is added to the syntactic environment, but after
+     the identifier loop has been added.
+     `capture-syntactic-environment' captures exactly that environment
+     as follows:
+          (define-syntax loop-until
+            (transformer
+             (lambda (exp env)
+               (let ((id (cadr exp))
+                     (init (caddr exp))
+                     (test (cadddr exp))
+                     (return (cadddr (cdr exp)))
+                     (step (cadddr (cddr exp)))
+                     (close
+                      (lambda (exp free)
+                        (make-syntactic-closure env free exp))))
+                 `(letrec ((loop
+                            ,(capture-syntactic-environment
+                              (lambda (env)
+                                `(lambda (,id)
+                                   (,(make-syntactic-closure env '() `if)
+                                    ,(close test (list id))
+                                    ,(close return (list id))
+                                    (,(make-syntactic-closure env '()
+                                                              `loop)
+                                     ,(close step (list id)))))))))
+                    (loop ,(close init '())))))))
+
+     In this case, having captured the desired syntactic environment,
+     it is convenient to construct syntactic closures of the
+     identifiers `if' and the `loop' and use them in the body of the
+     `lambda'.
+
+     A common use of `capture-syntactic-environment' is to get the
+     transformer environment of a macro transformer:
+          (transformer
+           (lambda (exp env)
+             (capture-syntactic-environment
+              (lambda (transformer-env)
+                ...))))
+
+Identifiers
+...........
+
+  This section describes the procedures that create and manipulate
+identifiers.  Previous syntactic closure proposals did not have an
+identifier data type - they just used symbols.  The identifier data
+type extends the syntactic closures facility to be compatible with the
+high-level `syntax-rules' facility.
+
+  As discussed earlier, an identifier is either a symbol or an "alias".
+An alias is implemented as a syntactic closure whose "form" is an
+identifier:
+     (make-syntactic-closure env '() 'a)
+        => an "alias"
+
+  Aliases are implemented as syntactic closures because they behave just
+like syntactic closures most of the time.  The difference is that an
+alias may be bound to a new value (for example by `lambda' or
+`let-syntax'); other syntactic closures may not be used this way.  If
+an alias is bound, then within the scope of that binding it is looked
+up in the syntactic environment just like any other identifier.
+
+  Aliases are used in the implementation of the high-level facility
+`syntax-rules'.  A macro transformer created by `syntax-rules' uses a
+template to generate its output form, substituting subforms of the
+input form into the template.  In a syntactic closures implementation,
+all of the symbols in the template are replaced by aliases closed in
+the transformer environment, while the output form itself is closed in
+the usage environment.  This guarantees that the macro transformation
+is hygienic, without requiring the transformer to know the syntactic
+roles of the substituted input subforms.
+
+ - Function: identifier? OBJECT
+     Returns `#t' if OBJECT is an identifier, otherwise returns `#f'.
+     Examples:
+          (identifier? 'a)
+             => #t
+          (identifier? (make-syntactic-closure env '() 'a))
+             => #t
+          (identifier? "a")
+             => #f
+          (identifier? #\a)
+             => #f
+          (identifier? 97)
+             => #f
+          (identifier? #f)
+             => #f
+          (identifier? '(a))
+             => #f
+          (identifier? '#(a))
+             => #f
+
+     The predicate `eq?' is used to determine if two identifers are
+     "the same".  Thus `eq?' can be used to compare identifiers exactly
+     as it would be used to compare symbols.  Often, though, it is
+     useful to know whether two identifiers "mean the same thing".  For
+     example, the `cond' macro uses the symbol `else' to identify the
+     final clause in the conditional.  A macro transformer for `cond'
+     cannot just look for the symbol `else', because the `cond' form
+     might be the output of another macro transformer that replaced the
+     symbol `else' with an alias.  Instead the transformer must look
+     for an identifier that "means the same thing" in the usage
+     environment as the symbol `else' means in the transformer
+     environment.
+
+ - Function: identifier=? ENVIRONMENT1 IDENTIFIER1 ENVIRONMENT2
+          IDENTIFIER2
+     ENVIRONMENT1 and ENVIRONMENT2 must be syntactic environments, and
+     IDENTIFIER1 and IDENTIFIER2 must be identifiers.  `identifier=?'
+     returns `#t' if the meaning of IDENTIFIER1 in ENVIRONMENT1 is the
+     same as that of IDENTIFIER2 in ENVIRONMENT2, otherwise it returns
+     `#f'.  Examples:
+
+          (let-syntax
+              ((foo
+                (transformer
+                 (lambda (form env)
+                   (capture-syntactic-environment
+                    (lambda (transformer-env)
+                      (identifier=? transformer-env 'x env 'x)))))))
+            (list (foo)
+                  (let ((x 3))
+                    (foo))))
+             => (#t #f)
+
+          (let-syntax ((bar foo))
+            (let-syntax
+                ((foo
+                  (transformer
+                   (lambda (form env)
+                     (capture-syntactic-environment
+                      (lambda (transformer-env)
+                        (identifier=? transformer-env 'foo
+                                      env (cadr form))))))))
+              (list (foo foo)
+                    (foobar))))
+             => (#f #t)
+
+Acknowledgements
+................
+
+  The syntactic closures facility was invented by Alan Bawden and
+Jonathan Rees.  The use of aliases to implement `syntax-rules' was
+invented by Alan Bawden (who prefers to call them "synthetic names").
+Much of this proposal is derived from an earlier proposal by Alan
+Bawden.
+
+
+File: slib.info,  Node: Syntax-Case Macros,  Next: Fluid-Let,  Prev: Syntactic Closures,  Up: Macros
+
+Syntax-Case Macros
+==================
+
+  `(require 'syntax-case)'
+
+ - Function: macro:expand EXPRESSION
+ - Function: syncase:expand EXPRESSION
+     Returns scheme code with the macros and derived expression types of
+     EXPRESSION expanded to primitive expression types.
+
+ - Function: macro:eval EXPRESSION
+ - Function: syncase:eval EXPRESSION
+     `macro:eval' returns the value of EXPRESSION in the current top
+     level environment.  EXPRESSION can contain macro definitions.
+     Side effects of EXPRESSION will affect the top level environment.
+
+ - Procedure: macro:load FILENAME
+ - Procedure: syncase:load FILENAME
+     FILENAME should be a string.  If filename names an existing file,
+     the `macro:load' procedure reads Scheme source code expressions and
+     definitions from the file and evaluates them sequentially.  These
+     source code expressions and definitions may contain macro
+     definitions.  The `macro:load' procedure does not affect the
+     values returned by `current-input-port' and `current-output-port'.
+
+  This is version 2.1 of `syntax-case', the low-level macro facility
+proposed and implemented by Robert Hieb and R. Kent Dybvig.
+
+  This version is further adapted by Harald Hanche-Olsen
+<hanche@imf.unit.no> to make it compatible with, and easily usable
+with, SLIB.  Mainly, these adaptations consisted of:
+
+   * Removing white space from `expand.pp' to save space in the
+     distribution.  This file is not meant for human readers anyway...
+
+   * Removed a couple of Chez scheme dependencies.
+
+   * Renamed global variables used to minimize the possibility of name
+     conflicts.
+
+   * Adding an SLIB-specific initialization file.
+
+   * Removing a couple extra files, most notably the documentation (but
+     see below).
+
+  If you wish, you can see exactly what changes were done by reading the
+shell script in the file `syncase.sh'.
+
+  The two PostScript files were omitted in order to not burden the SLIB
+distribution with them.  If you do intend to use `syntax-case',
+however, you should get these files and print them out on a PostScript
+printer.  They are available with the original `syntax-case'
+distribution by anonymous FTP in
+`cs.indiana.edu:/pub/scheme/syntax-case'.
+
+  In order to use syntax-case from an interactive top level, execute:
+     (require 'syntax-case)
+     (require 'repl)
+     (repl:top-level macro:eval)
+  See the section Repl (*Note Repl::) for more information.
+
+  To check operation of syntax-case get
+`cs.indiana.edu:/pub/scheme/syntax-case', and type
+     (require 'syntax-case)
+     (syncase:sanity-check)
+
+  Beware that `syntax-case' takes a long time to load - about 20s on a
+SPARCstation SLC (with SCM) and about 90s on a Macintosh SE/30 (with
+Gambit).
+
+Notes
+-----
+
+  All R4RS syntactic forms are defined, including `delay'.  Along with
+`delay' are simple definitions for `make-promise' (into which `delay'
+expressions expand) and `force'.
+
+  `syntax-rules' and `with-syntax' (described in `TR356') are defined.
+
+  `syntax-case' is actually defined as a macro that expands into calls
+to the procedure `syntax-dispatch' and the core form `syntax-lambda';
+do not redefine these names.
+
+  Several other top-level bindings not documented in TR356 are created:
+     the "hooks" in `hooks.ss'
+
+     the `build-' procedures in `output.ss'
+
+     `expand-syntax' (the expander)
+
+  The syntax of define has been extended to allow `(define ID)', which
+assigns ID to some unspecified value.
+
+  We have attempted to maintain R4RS compatibility where possible.  The
+incompatibilities should be confined to `hooks.ss'.  Please let us know
+if there is some incompatibility that is not flagged as such.
+
+  Send bug reports, comments, suggestions, and questions to Kent Dybvig
+(dyb@iuvax.cs.indiana.edu).
+
+Note from maintainer
+--------------------
+
+  Included with the `syntax-case' files was `structure.scm' which
+defines a macro `define-structure'.  There is no documentation for this
+macro and it is not used by any code in SLIB.
+
+
+File: slib.info,  Node: Fluid-Let,  Next: Yasos,  Prev: Syntax-Case Macros,  Up: Macros
+
+Fluid-Let
+=========
+
+  `(require 'fluid-let)'
+
+ - Syntax: fluid-let `(BINDINGS ...)' FORMS...
+
+     (fluid-let ((VARIABLE INIT) ...)
+        EXPRESSION EXPRESSION ...)
+
+  The INITs are evaluated in the current environment (in some
+unspecified order), the current values of the VARIABLEs are saved, the
+results are assigned to the VARIABLEs, the EXPRESSIONs are evaluated
+sequentially in the current environment, the VARIABLEs are restored to
+their original values, and the value of the last EXPRESSION is returned.
+
+  The syntax of this special form is similar to that of `let', but
+`fluid-let' temporarily rebinds existing VARIABLEs.  Unlike `let',
+`fluid-let' creates no new bindings; instead it *assigns* the values of
+each INIT to the binding (determined by the rules of lexical scoping)
+of its corresponding VARIABLE.
+
+
+File: slib.info,  Node: Yasos,  Prev: Fluid-Let,  Up: Macros
+
+Yasos
+=====
+
+  `(require 'oop)' or `(require 'yasos)'
+
+  `Yet Another Scheme Object System' is a simple object system for
+Scheme based on the paper by Norman Adams and Jonathan Rees: `Object
+Oriented Programming in Scheme', Proceedings of the 1988 ACM Conference
+on LISP and Functional Programming, July 1988 [ACM #552880].
+
+  Another reference is:
+
+  Ken Dickey.  Scheming with Objects `AI Expert' Volume 7, Number 10
+(October 1992), pp. 24-33.
+
+* Menu:
+
+* Yasos terms::                 Definitions and disclaimer.
+* Yasos interface::             The Yasos macros and procedures.
+* Setters::                     Dylan-like setters in Yasos.
+* Yasos examples::              Usage of Yasos and setters.
+
+
+File: slib.info,  Node: Yasos terms,  Next: Yasos interface,  Prev: Yasos,  Up: Yasos
+
+Terms
+-----
+
+"Object"
+     Any Scheme data object.
+
+"Instance"
+     An instance of the OO system; an "object".
+
+"Operation"
+     A METHOD.
+
+*Notes:*
+     The object system supports multiple inheritance.  An instance can
+     inherit from 0 or more ancestors.  In the case of multiple
+     inherited operations with the same identity, the operation used is
+     that from the first ancestor which contains it (in the ancestor
+     `let').  An operation may be applied to any Scheme data
+     object--not just instances.  As code which creates instances is
+     just code, there are no "classes" and no meta-ANYTHING.  Method
+     dispatch is by a procedure call a la CLOS rather than by `send'
+     syntax a la Smalltalk.
+
+*Disclaimer:*
+     There are a number of optimizations which can be made.  This
+     implementation is expository (although performance should be quite
+     reasonable).  See the L&FP paper for some suggestions.
+
+
+File: slib.info,  Node: Yasos interface,  Next: Setters,  Prev: Yasos terms,  Up: Yasos
+
+Interface
+---------
+
+ - Syntax: define-operation `('OPNAME SELF ARG ...`)' DEFAULT-BODY
+     Defines a default behavior for data objects which don't handle the
+     operation OPNAME.  The default default behavior (for an empty
+     DEFAULT-BODY) is to generate an error.
+
+ - Syntax: define-predicate OPNAME?
+     Defines a predicate OPNAME?, usually used for determining the
+     "type" of an object, such that `(OPNAME? OBJECT)' returns `#t' if
+     OBJECT has an operation OPNAME? and `#f' otherwise.
+
+ - Syntax: object `((NAME SELF ARG ...) BODY)' ...
+     Returns an object (an instance of the object system) with
+     operations.  Invoking `(NAME OBJECT ARG ...' executes the BODY of
+     the OBJECT with SELF bound to OBJECT and with argument(s) ARG....
+
+ - Syntax: object-with-ancestors `(('ANCESTOR1 INIT1`)' ...`)'
+          OPERATION ...
+     A `let'-like form of `object' for multiple inheritance.  It
+     returns an object inheriting the behaviour of ANCESTOR1 etc.  An
+     operation will be invoked in an ancestor if the object itself does
+     not provide such a method.  In the case of multiple inherited
+     operations with the same identity, the operation used is the one
+     found in the first ancestor in the ancestor list.
+
+ - Syntax: operate-as COMPONENT OPERATION SELF ARG ...
+     Used in an operation definition (of SELF) to invoke the OPERATION
+     in an ancestor COMPONENT but maintain the object's identity.  Also
+     known as "send-to-super".
+
+ - Procedure: print OBJ PORT
+     A default `print' operation is provided which is just `(format
+     PORT OBJ)' (*Note Format::) for non-instances and prints OBJ
+     preceded by `#<INSTANCE>' for instances.
+
+ - Function: size OBJ
+     The default method returns the number of elements in OBJ if it is
+     a vector, string or list, `2' for a pair, `1' for a character and
+     by default id an error otherwise.  Objects such as collections
+     (*Note Collections::) may override the default in an obvious way.
+
+
+File: slib.info,  Node: Setters,  Next: Yasos examples,  Prev: Yasos interface,  Up: Yasos
+
+Setters
+-------
+
+  "Setters" implement "generalized locations" for objects associated
+with some sort of mutable state.  A "getter" operation retrieves a
+value from a generalized location and the corresponding setter
+operation stores a value into the location.  Only the getter is named -
+the setter is specified by a procedure call as below.  (Dylan uses
+special syntax.)  Typically, but not necessarily, getters are access
+operations to extract values from Yasos objects (*Note Yasos::).
+Several setters are predefined, corresponding to getters `car', `cdr',
+`string-ref' and `vector-ref' e.g., `(setter car)' is equivalent to
+`set-car!'.
+
+  This implementation of setters is similar to that in Dylan(TM)
+(`Dylan: An object-oriented dynamic language', Apple Computer Eastern
+Research and Technology).  Common LISP provides similar facilities
+through `setf'.
+
+ - Function: setter GETTER
+     Returns the setter for the procedure GETTER.  E.g., since
+     `string-ref' is the getter corresponding to a setter which is
+     actually `string-set!':
+          (define foo "foo")
+          ((setter string-ref) foo 0 #\F) ; set element 0 of foo
+          foo => "Foo"
+
+ - Syntax: set PLACE NEW-VALUE
+     If PLACE is a variable name, `set' is equivalent to `set!'.
+     Otherwise, PLACE must have the form of a procedure call, where the
+     procedure name refers to a getter and the call indicates an
+     accessible generalized location, i.e., the call would return a
+     value.  The return value of `set' is usually unspecified unless
+     used with a setter whose definition guarantees to return a useful
+     value.
+          (set (string-ref foo 2) #\O)  ; generalized location with getter
+          foo => "FoO"
+          (set foo "foo")               ; like set!
+          foo => "foo"
+
+ - Procedure: add-setter GETTER SETTER
+     Add procedures GETTER and SETTER to the (inaccessible) list of
+     valid setter/getter pairs.  SETTER implements the store operation
+     corresponding to the GETTER access operation for the relevant
+     state.  The return value is unspecified.
+
+ - Procedure: remove-setter-for GETTER
+     Removes the setter corresponding to the specified GETTER from the
+     list of valid setters.  The return value is unspecified.
+
+ - Syntax: define-access-operation GETTER-NAME
+     Shorthand for a Yasos `define-operation' defining an operation
+     GETTER-NAME that objects may support to return the value of some
+     mutable state.  The default operation is to signal an error.  The
+     return value is unspecified.
+
+
+File: slib.info,  Node: Yasos examples,  Prev: Setters,  Up: Yasos
+
+Examples
+--------
+
+     (define-operation (print obj port)
+       (format port
+               (if (instance? obj) "#<instance>" "~s")
+               obj))
+     
+     (define-operation (SIZE obj)
+       (cond
+        ((vector? obj) (vector-length obj))
+        ((list?   obj) (length obj))
+        ((pair?   obj) 2)
+        ((string? obj) (string-length obj))
+        ((char?   obj) 1)
+        (else
+         (error "Operation not supported: size" obj))))
+     
+     (define-predicate cell?)
+     (define-operation (fetch obj))
+     (define-operation (store! obj newValue))
+     
+     (define (make-cell value)
+       (object
+        ((cell? self) #t)
+        ((fetch self) value)
+        ((store! self newValue)
+         (set! value newValue)
+         newValue)
+        ((size self) 1)
+        ((print self port)
+         (format port "#<Cell: ~s>" (fetch self)))))
+     
+     (define-operation (discard obj value)
+       (format #t "Discarding ~s~%" value))
+     
+     (define (make-filtered-cell value filter)
+       (object-with-ancestors ((cell (make-cell value)))
+                              ((store! self newValue)
+                               (if (filter newValue)
+                                   (store! cell newValue)
+                                   (discard self newValue)))))
+     
+     (define-predicate array?)
+     (define-operation (array-ref array index))
+     (define-operation (array-set! array index value))
+     
+     (define (make-array num-slots)
+       (let ((anArray (make-vector num-slots)))
+         (object
+          ((array? self) #t)
+          ((size self) num-slots)
+          ((array-ref self index)           (vector-ref  anArray index))
+          ((array-set! self index newValue) (vector-set! anArray index newValue))
+          ((print self port) (format port "#<Array ~s>" (size self))))))
+     
+     (define-operation (position obj))
+     (define-operation (discarded-value obj))
+     
+     (define (make-cell-with-history value filter size)
+       (let ((pos 0) (most-recent-discard #f))
+         (object-with-ancestors
+          ((cell (make-filtered-call value filter))
+           (sequence (make-array size)))
+          ((array? self) #f)
+          ((position self) pos)
+          ((store! self newValue)
+           (operate-as cell store! self newValue)
+           (array-set! self pos newValue)
+           (set! pos (+ pos 1)))
+          ((discard self value)
+           (set! most-recent-discard value))
+          ((discarded-value self) most-recent-discard)
+          ((print self port)
+           (format port "#<Cell-with-history ~s>" (fetch self))))))
+     
+     (define-access-operation fetch)
+     (add-setter fetch store!)
+     (define foo (make-cell 1))
+     (print foo #f)
+     => "#<Cell: 1>"
+     (set (fetch foo) 2)
+     =>
+     (print foo #f)
+     => "#<Cell: 2>"
+     (fetch foo)
+     => 2
+
+
+File: slib.info,  Node: Numerics,  Next: Procedures,  Prev: Macros,  Up: Top
+
+Numerics
+********
+
+* Menu:
+
+* Bit-Twiddling::               'logical
+* Modular Arithmetic::          'modular
+* Prime Testing and Generation::  'primes
+* Prime Factorization::         'factor
+* Random Numbers::              'random
+* Cyclic Checksum::             'make-crc
+* Plotting::                    'charplot
+* Root Finding::
+
+
+File: slib.info,  Node: Bit-Twiddling,  Next: Modular Arithmetic,  Prev: Numerics,  Up: Numerics
+
+Bit-Twiddling
+=============
+
+  `(require 'logical)'
+
+  The bit-twiddling functions are made available through the use of the
+`logical' package.  `logical' is loaded by inserting `(require
+'logical)' before the code that uses these functions.
+
+ - Function: logand N1 N1
+     Returns the integer which is the bit-wise AND of the two integer
+     arguments.
+
+     Example:
+          (number->string (logand #b1100 #b1010) 2)
+             => "1000"
+
+ - Function: logior N1 N2
+     Returns the integer which is the bit-wise OR of the two integer
+     arguments.
+
+     Example:
+          (number->string (logior #b1100 #b1010) 2)
+             => "1110"
+
+ - Function: logxor N1 N2
+     Returns the integer which is the bit-wise XOR of the two integer
+     arguments.
+
+     Example:
+          (number->string (logxor #b1100 #b1010) 2)
+             => "110"
+
+ - Function: lognot N
+     Returns the integer which is the 2s-complement of the integer
+     argument.
+
+     Example:
+          (number->string (lognot #b10000000) 2)
+             => "-10000001"
+          (number->string (lognot #b0) 2)
+             => "-1"
+
+ - Function: logtest J K
+          (logtest j k) == (not (zero? (logand j k)))
+          
+          (logtest #b0100 #b1011) => #f
+          (logtest #b0100 #b0111) => #t
+
+ - Function: logbit? INDEX J
+          (logbit? index j) == (logtest (integer-expt 2 index) j)
+          
+          (logbit? 0 #b1101) => #t
+          (logbit? 1 #b1101) => #f
+          (logbit? 2 #b1101) => #t
+          (logbit? 3 #b1101) => #t
+          (logbit? 4 #b1101) => #f
+
+ - Function: ash INT COUNT
+     Returns an integer equivalent to `(inexact->exact (floor (* INT
+     (expt 2 COUNT))))'.
+
+     Example:
+          (number->string (ash #b1 3) 2)
+             => "1000"
+          (number->string (ash #b1010 -1) 2)
+             => "101"
+
+ - Function: logcount N
+     Returns the number of bits in integer N.  If integer is positive,
+     the 1-bits in its binary representation are counted.  If negative,
+     the 0-bits in its two's-complement binary representation are
+     counted.  If 0, 0 is returned.
+
+     Example:
+          (logcount #b10101010)
+             => 4
+          (logcount 0)
+             => 0
+          (logcount -2)
+             => 1
+
+ - Function: integer-length N
+     Returns the number of bits neccessary to represent N.
+
+     Example:
+          (integer-length #b10101010)
+             => 8
+          (integer-length 0)
+             => 0
+          (integer-length #b1111)
+             => 4
+
+ - Function: integer-expt N K
+     Returns N raised to the non-negative integer exponent K.
+
+     Example:
+          (integer-expt 2 5)
+             => 32
+          (integer-expt -3 3)
+             => -27
+
+ - Function: bit-extract N START END
+     Returns the integer composed of the START (inclusive) through END
+     (exclusive) bits of N.  The STARTth bit becomes the 0-th bit in
+     the result.
+
+     Example:
+          (number->string (bit-extract #b1101101010 0 4) 2)
+             => "1010"
+          (number->string (bit-extract #b1101101010 4 9) 2)
+             => "10110"
+
+
+File: slib.info,  Node: Modular Arithmetic,  Next: Prime Testing and Generation,  Prev: Bit-Twiddling,  Up: Numerics
+
+Modular Arithmetic
+==================
+
+  `(require 'modular)'
+
+ - Function: extended-euclid N1 N2
+     Returns a list of 3 integers `(d x y)' such that d = gcd(N1, N2) =
+     N1 * x + N2 * y.
+
+ - Function: symmetric:modulus N
+     Returns `(quotient (+ -1 n) -2)' for positive odd integer N.
+
+ - Function: modulus->integer MODULUS
+     Returns the non-negative integer characteristic of the ring formed
+     when MODULUS is used with `modular:' procedures.
+
+ - Function: modular:normalize MODULUS N
+     Returns the integer `(modulo N (modulus->integer MODULUS))' in the
+     representation specified by MODULUS.
+
+The rest of these functions assume normalized arguments; That is, the
+arguments are constrained by the following table:
+
+For all of these functions, if the first argument (MODULUS) is:
+`positive?'
+     Work as before.  The result is between 0 and MODULUS.
+
+`zero?'
+     The arguments are treated as integers.  An integer is returned.
+
+`negative?'
+     The arguments and result are treated as members of the integers
+     modulo `(+ 1 (* -2 MODULUS))', but with "symmetric"
+     representation; i.e. `(<= (- MODULUS) N MODULUS)'.
+
+If all the arguments are fixnums the computation will use only fixnums.
+
+ - Function: modular:invertable? MODULUS K
+     Returns `#t' if there exists an integer n such that K * n == 1 mod
+     MODULUS, and `#f' otherwise.
+
+ - Function: modular:invert MODULUS K2
+     Returns an integer n such that 1 = (n * K2) mod MODULUS.  If K2
+     has no inverse mod MODULUS an error is signaled.
+
+ - Function: modular:negate MODULUS K2
+     Returns (-K2) mod MODULUS.
+
+ - Function: modular:+ MODULUS K2 K3
+     Returns (K2 + K3) mod MODULUS.
+
+ - Function: modular:- MODULUS K2 K3
+     Returns (K2 - K3) mod MODULUS.
+
+ - Function: modular:* MODULUS K2 K3
+     Returns (K2 * K3) mod MODULUS.
+
+     The Scheme code for `modular:*' with negative MODULUS is not
+     completed for fixnum-only implementations.
+
+ - Function: modular:expt MODULUS K2 K3
+     Returns (K2 ^ K3) mod MODULUS.
+
+
+File: slib.info,  Node: Prime Testing and Generation,  Next: Prime Factorization,  Prev: Modular Arithmetic,  Up: Numerics
+
+Prime Testing and Generation
+============================
+
+  `(require 'primes)'
+
+  This package tests and generates prime numbers.  The strategy used is
+as follows:
+
+     First, use trial division by small primes (primes less than 1000)
+     to quickly weed out composites with small factors.  As a side
+     benefit, this makes the test precise for numbers up to one million.
+
+     Second, apply the Miller-Rabin primality test to detect (with high
+     probability) any remaining composites.
+
+  The Miller-Rabin test is a Monte-Carlo test--in other words, it's fast
+and it gets the right answer with high probability.  For a candidate
+that *is* prime, the Miller-Rabin test is certain to report "prime"; it
+will never report "composite".  However, for a candidate that is
+composite, there is a (small) probability that the Miller-Rabin test
+will erroneously report "prime".  This probability can be made
+arbitarily small by adjusting the number of iterations of the
+Miller-Rabin test.
+
+ - Function: probably-prime? CANDIDATE
+ - Function: probably-prime? CANDIDATE ITER
+     Returns `#t' if `candidate' is probably prime.  The optional
+     parameter `iter' controls the number of iterations of the
+     Miller-Rabin test.  The probability of a composite candidate being
+     mistaken for a prime is at most `(1/4)^iter'.  The default value of
+     `iter' is 15, which makes the probability less than 1 in 10^9.
+
+
+ - Function: primes< START COUNT
+ - Function: primes< START COUNT ITER
+ - Function: primes> START COUNT
+ - Function: primes> START COUNT ITER
+     Returns a list of the first `count' odd probable primes less (more)
+     than or equal to `start'.  The optional parameter `iter' controls
+     the number of iterations of the Miller-Rabin test for each
+     candidate.  The probability of a composite candidate being
+     mistaken for a prime is at most `(1/4)^iter'.  The default value
+     of `iter' is 15, which makes the probability less than 1 in 10^9.
+
+
+* Menu:
+
+* The Miller-Rabin Test::       How the Miller-Rabin test works
+
+
+File: slib.info,  Node: The Miller-Rabin Test,  Prev: Prime Testing and Generation,  Up: Prime Testing and Generation
+
+Theory
+------
+
+  Rabin and Miller's result can be summarized as follows.  Let `p' (the
+candidate prime) be any odd integer greater than 2.  Let `b' (the
+"base") be an integer in the range `2 ... p-1'.  There is a fairly
+simple Boolean function--call it `C', for "Composite"--with the
+following properties:
+     If `p' is prime, `C(p, b)' is false for all `b' in the range `2
+     ... p-1'.
+
+     If `p' is composite, `C(p, b)' is false for at most 1/4 of all `b'
+     in the range ` 2 ... p-1'.  (If the test fails for base `b', `p'
+     is called a *strong pseudo-prime to base `b'*.)
+
+  For details of `C', and why it fails for at most 1/4 of the potential
+bases, please consult a book on number theory or cryptography such as
+"A Course in Number Theory and Cryptography" by Neal Koblitz, published
+by Springer-Verlag 1994.
+
+  There is nothing probablistic about this result.  It's true for all
+`p'.  If we had time to test `(1/4)p + 1' different bases, we could
+definitively determine the primality of `p'.  For large candidates,
+that would take much too long--much longer than the simple approach of
+dividing by all numbers up to `sqrt(p)'.  This is where probability
+enters the picture.
+
+  Suppose we have some candidate prime `p'.  Pick a random integer `b'
+in the range `2 ... p-1'.  Compute `C(p,b)'.  If `p' is prime, the
+result will certainly be false.  If `p' is composite, the probability
+is at most 1/4 that the result will be false (demonstrating that `p' is
+a strong pseudoprime to base `b').  The test can be repeated with other
+random bases.  If `p' is prime, each test is certain to return false.
+If `p' is composite, the probability of `C(p,b)' returning false is at
+most 1/4 for each test.  Since the `b' are chosen at random, the tests
+outcomes are independent. So if `p' is composite and the test is
+repeated, say, 15 times, the probability of it returning false all
+fifteen times is at most (1/4)^15, or about 10^-9.  If the test is
+repeated 30 times, the probability of failure drops to at most 8.3e-25.
+
+  Rabin and Miller's result holds for *all* candidates `p'.  However,
+if the candidate `p' is picked at random, the probability of the
+Miller-Rabin test failing is much less than the computed bound.  This
+is because, for *most* composite numbers, the fraction of bases that
+cause the test to fail is much less than 1/4.  For example, if you pick
+a random odd number less than 1000 and apply the Miller-Rabin test with
+only 3 random bases, the computed failure bound is (1/4)^3, or about
+1.6e-2.  However, the actual probability of failure is much less--about
+7.2e-5.  If you accidentally pick 703 to test for primality, the
+probability of failure is (161/703)^3, or about 1.2e-2, which is almost
+as high as the computed bound.  This is because 703 is a strong
+pseudoprime to 161 bases.  But if you pick at random there is only a
+small chance of picking 703, and no other number less than 1000 has
+that high a percentage of pseudoprime bases.
+
+  The Miller-Rabin test is sometimes used in a slightly different
+fashion, where it can, at least in principle, cause problems.  The
+weaker version uses small prime bases instead of random bases.  If you
+are picking candidates at random and testing for primality, this works
+well since very few composites are strong pseudo-primes to small prime
+bases.  (For example, there is only one composite less than 2.5e10 that
+is a strong pseudo-prime to the bases 2, 3, 5, and 7.)  The problem
+with this approach is that once a candidate has been picked, the test is
+deterministic.  This distinction is subtle, but real.  With the
+randomized test, for *any* candidate you pick--even if your
+candidate-picking procedure is strongly biased towards troublesome
+numbers, the test will work with high probability.  With the
+deterministic version, for any particular candidate, the test will
+either work (with probability 1), or fail (with probability 1).  It
+won't fail for very many candidates, but that won't be much consolation
+if your candidate-picking procedure is somehow biased toward troublesome
+numbers.
+
+
+File: slib.info,  Node: Prime Factorization,  Next: Random Numbers,  Prev: Prime Testing and Generation,  Up: Numerics
+
+Prime Factorization
+===================
+
+  `(require 'factor)'
+
+ - Function: factor K
+     Returns a list of the prime factors of K.  The order of the
+     factors is unspecified.  In order to obtain a sorted list do
+     `(sort! (factor k) <)'.
+
+  *Note:* The rest of these procedures implement the Solovay-Strassen
+primality test.  This test has been superseeded by the faster *Note
+probably-prime?: Prime Testing and Generation.  However these are left
+here as they take up little space and may be of use to an
+implementation without bignums.
+
+  See Robert Solovay and Volker Strassen, `A Fast Monte-Carlo Test for
+Primality', SIAM Journal on Computing, 1977, pp 84-85.
+
+ - Function: jacobi-symbol P Q
+     Returns the value (+1, -1, or 0) of the Jacobi-Symbol of exact
+     non-negative integer P and exact positive odd integer Q.
+
+ - Function: prime? P
+     Returns `#f' if P is composite; `#t' if P is prime.  There is a
+     slight chance `(expt 2 (- prime:trials))' that a composite will
+     return `#t'.
+
+ - Function: prime:trials
+     Is the maxinum number of iterations of Solovay-Strassen that will
+     be done to test a number for primality.
+
+
+File: slib.info,  Node: Random Numbers,  Next: Cyclic Checksum,  Prev: Prime Factorization,  Up: Numerics
+
+Random Numbers
+==============
+
+  `(require 'random)'
+
+ - Procedure: random N
+ - Procedure: random N STATE
+     Accepts a positive integer or real N and returns a number of the
+     same type between zero (inclusive) and N (exclusive).  The values
+     returned have a uniform distribution.
+
+     The optional argument STATE must be of the type produced by
+     `(make-random-state)'.  It defaults to the value of the variable
+     `*random-state*'.  This object is used to maintain the state of the
+     pseudo-random-number generator and is altered as a side effect of
+     the `random' operation.
+
+ - Variable: *random-state*
+     Holds a data structure that encodes the internal state of the
+     random-number generator that `random' uses by default.  The nature
+     of this data structure is implementation-dependent.  It may be
+     printed out and successfully read back in, but may or may not
+     function correctly as a random-number state object in another
+     implementation.
+
+ - Procedure: make-random-state
+ - Procedure: make-random-state STATE
+     Returns a new object of type suitable for use as the value of the
+     variable `*random-state*' and as a second argument to `random'.
+     If argument STATE is given, a copy of it is returned.  Otherwise a
+     copy of `*random-state*' is returned.
+
+  If inexact numbers are support by the Scheme implementation,
+`randinex.scm' will be loaded as well.  `randinex.scm' contains
+procedures for generating inexact distributions.
+
+ - Procedure: random:uniform STATE
+     Returns an uniformly distributed inexact real random number in the
+     range between 0 and 1.
+
+ - Procedure: random:solid-sphere! VECT
+ - Procedure: random:solid-sphere! VECT STATE
+     Fills VECT with inexact real random numbers the sum of whose
+     squares is less than 1.0.  Thinking of VECT as coordinates in
+     space of dimension N = `(vector-length VECT)', the coordinates are
+     uniformly distributed within the unit N-shere.  The sum of the
+     squares of the numbers is returned.
+
+ - Procedure: random:hollow-sphere! VECT
+ - Procedure: random:hollow-sphere! VECT STATE
+     Fills VECT with inexact real random numbers the sum of whose
+     squares is equal to 1.0.  Thinking of VECT as coordinates in space
+     of dimension n = `(vector-length VECT)', the coordinates are
+     uniformly distributed over the surface of the unit n-shere.
+
+ - Procedure: random:normal
+ - Procedure: random:normal STATE
+     Returns an inexact real in a normal distribution with mean 0 and
+     standard deviation 1.  For a normal distribution with mean M and
+     standard deviation D use `(+ M (* D (random:normal)))'.
+
+ - Procedure: random:normal-vector! VECT
+ - Procedure: random:normal-vector! VECT STATE
+     Fills VECT with inexact real random numbers which are independent
+     and standard normally distributed (i.e., with mean 0 and variance
+     1).
+
+ - Procedure: random:exp
+ - Procedure: random:exp STATE
+     Returns an inexact real in an exponential distribution with mean
+     1.  For an exponential distribution with mean U use (* U
+     (random:exp)).
+
diff --git a/slib.info-5 b/slib.info-5
new file mode 100644
index 0000000..04d1b28
--- /dev/null
+++ b/slib.info-5
@@ -0,0 +1,1536 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+File: slib.info,  Node: Cyclic Checksum,  Next: Plotting,  Prev: Random Numbers,  Up: Numerics
+
+Cyclic Checksum
+===============
+
+  `(require 'make-crc)'
+
+ - Function: make-port-crc
+ - Function: make-port-crc DEGREE
+ - Function: make-port-crc DEGREE GENERATOR
+     Returns an expression for a procedure of one argument, a port.
+     This procedure reads characters from the port until the end of
+     file and returns the integer checksum of the bytes read.
+
+     The integer DEGREE, if given, specifies the degree of the
+     polynomial being computed - which is also the number of bits
+     computed in the checksums.  The default value is 32.
+
+     The integer GENERATOR specifies the polynomial being computed.
+     The power of 2 generating each 1 bit is the exponent of a term of
+     the polynomial.  The bit at position DEGREE is implicit and should
+     not be part of GENERATOR.  This allows systems with numbers
+     limited to 32 bits to calculate 32 bit checksums.  The default
+     value of GENERATOR when DEGREE is 32 (its default) is:
+
+          (make-port-crc 32 #b00000100110000010001110110110111)
+
+     Creates a procedure to calculate the P1003.2/D11.2 (POSIX.2) 32-bit
+     checksum from the polynomial:
+
+               32    26    23    22    16    12    11
+            ( x   + x   + x   + x   + x   + x   + x   +
+          
+                10    8    7    5    4    2    1
+               x   + x  + x  + x  + x  + x  + x  + 1 )  mod 2
+
+     (require 'make-crc)
+     (define crc32 (slib:eval (make-port-crc)))
+     (define (file-check-sum file) (call-with-input-file file crc32))
+     (file-check-sum (in-vicinity (library-vicinity) "ratize.scm"))
+     
+     => 3553047446
+
+
+File: slib.info,  Node: Plotting,  Next: Root Finding,  Prev: Cyclic Checksum,  Up: Numerics
+
+Plotting on Character Devices
+=============================
+
+  `(require 'charplot)'
+
+  The plotting procedure is made available through the use of the
+`charplot' package.  `charplot' is loaded by inserting `(require
+'charplot)' before the code that uses this procedure.
+
+ - Variable: charplot:height
+     The number of rows to make the plot vertically.
+
+ - Variable: charplot:width
+     The number of columns to make the plot horizontally.
+
+ - Procedure: plot! COORDS X-LABEL Y-LABEL
+     COORDS is a list of pairs of x and y coordinates.  X-LABEL and
+     Y-LABEL are strings with which to label the x and y axes.
+
+     Example:
+          (require 'charplot)
+          (set! charplot:height 19)
+          (set! charplot:width 45)
+          
+          (define (make-points n)
+            (if (zero? n)
+                '()
+                (cons (cons (/ n 6) (sin (/ n 6))) (make-points (1- n)))))
+          
+          (plot! (make-points 37) "x" "Sin(x)")
+          -|
+            Sin(x)   ______________________________________________
+                1.25|-                                             |
+                    |                                              |
+                   1|-       ****                                  |
+                    |      **    **                                |
+            750.0e-3|-    *        *                               |
+                    |    *          *                              |
+            500.0e-3|-  *            *                             |
+                    |  *                                           |
+            250.0e-3|-                *                            |
+                    | *                *                           |
+                   0|-------------------*--------------------------|
+                    |                                     *        |
+           -250.0e-3|-                   *               *         |
+                    |                     *             *          |
+           -500.0e-3|-                     *                       |
+                    |                       *          *           |
+           -750.0e-3|-                       *        *            |
+                    |                         **    **             |
+                  -1|-                          ****               |
+                    |____________:_____._____:_____._____:_________|
+                  x              2           4
+
+
+File: slib.info,  Node: Root Finding,  Prev: Plotting,  Up: Numerics
+
+Root Finding
+============
+
+  `(require 'root)'
+
+ - Function: newtown:find-integer-root F DF/DX X0
+     Given integer valued procedure F, its derivative (with respect to
+     its argument) DF/DX, and initial integer value X0 for which
+     DF/DX(X0) is non-zero, returns an integer X for which F(X) is
+     closer to zero than either of the integers adjacent to X; or
+     returns `#f' if such an integer can't be found.
+
+     To find the closest integer to a given integers square root:
+
+          (define (integer-sqrt y)
+            (newton:find-integer-root
+             (lambda (x) (- (* x x) y))
+             (lambda (x) (* 2 x))
+             (ash 1 (quotient (integer-length y) 2))))
+          
+          (integer-sqrt 15) => 4
+
+ - Function: integer-sqrt Y
+     Given a non-negative integer Y, returns the rounded square-root of
+     Y.
+
+ - Function: newton:find-root F DF/DX X0 PREC
+     Given real valued procedures F, DF/DX of one (real) argument,
+     initial real value X0 for which DF/DX(X0) is non-zero, and
+     positive real number PREC, returns a real X for which `abs'(F(X))
+     is less than PREC; or returns `#f' if such a real can't be found.
+
+     If `prec' is instead a negative integer, `newton:find-root'
+     returns the result of -PREC iterations.
+
+H. J. Orchard, `The Laguerre Method for Finding the Zeros of
+Polynomials', IEEE Transactions on Circuits and Systems, Vol. 36, No.
+11, November 1989, pp 1377-1381.
+
+     There are 2 errors in Orchard's Table II.  Line k=2 for starting
+     value of 1000+j0 should have Z_k of 1.0475 + j4.1036 and line k=2
+     for starting value of 0+j1000 should have Z_k of 1.0988 + j4.0833.
+
+ - Function: laguerre:find-root F DF/DZ DDF/DZ^2 Z0 PREC
+     Given complex valued procedure F of one (complex) argument, its
+     derivative (with respect to its argument) DF/DX, its second
+     derivative DDF/DZ^2, initial complex value Z0, and positive real
+     number PREC, returns a complex number Z for which
+     `magnitude'(F(Z)) is less than PREC; or returns `#f' if such a
+     number can't be found.
+
+     If `prec' is instead a negative integer, `laguerre:find-root'
+     returns the result of -PREC iterations.
+
+ - Function: laguerre:find-polynomial-root DEG F DF/DZ DDF/DZ^2 Z0 PREC
+     Given polynomial procedure F of integer degree DEG of one
+     argument, its derivative (with respect to its argument) DF/DX, its
+     second derivative DDF/DZ^2, initial complex value Z0, and positive
+     real number PREC, returns a complex number Z for which
+     `magnitude'(F(Z)) is less than PREC; or returns `#f' if such a
+     number can't be found.
+
+     If `prec' is instead a negative integer,
+     `laguerre:find-polynomial-root' returns the result of -PREC
+     iterations.
+
+
+File: slib.info,  Node: Procedures,  Next: Standards Support,  Prev: Numerics,  Up: Top
+
+Procedures
+**********
+
+  Anything that doesn't fall neatly into any of the other categories
+winds up here.
+
+* Menu:
+
+* Batch::                       'batch
+* Common List Functions::       'common-list-functions
+* Format::                      'format
+* Generic-Write::               'generic-write
+* Line I/O::                    'line-i/o
+* Multi-Processing::            'process
+* Object-To-String::            'object->string
+* Pretty-Print::                'pretty-print, 'pprint-file
+* Sorting::                     'sort
+* Topological Sort::
+* Standard Formatted I/O::      'printf, 'scanf
+* String-Case::                 'string-case
+* String Ports::                'string-port
+* String Search::
+* Tektronix Graphics Support::
+* Tree Operations::             'tree
+
+
+File: slib.info,  Node: Batch,  Next: Common List Functions,  Prev: Procedures,  Up: Procedures
+
+Batch
+=====
+
+  `(require 'batch)'
+
+The batch procedures provide a way to write and execute portable scripts
+for a variety of operating systems.  Each `batch:' procedure takes as
+its first argument a parameter-list (*note Parameter lists::.).  This
+parameter-list argument PARMS contains named associations.  Batch
+currently uses 2 of these:
+
+`batch-port'
+     The port on which to write lines of the batch file.
+
+`batch-dialect'
+     The syntax of batch file to generate.  Currently supported are:
+        * unix
+
+        * dos
+
+        * vms
+
+        * system
+
+        * *unknown*
+
+`batch.scm' uses 2 enhanced relational tables (*note Database
+Utilities::.) to store information linking the names of
+`operating-system's to `batch-dialect'es.
+
+ - Function: batch:initialize! DATABASE
+     Defines `operating-system' and `batch-dialect' tables and adds the
+     domain `operating-system' to the enhanced relational database
+     DATABASE.
+
+ - Variable: batch:platform
+     Is batch's best guess as to which operating-system it is running
+     under.  `batch:platform' is set to `(software-type)' (*note
+     Configuration::.) unless `(software-type)' is `unix', in which
+     case finer distinctions are made.
+
+ - Function: batch:call-with-output-script PARMS FILE PROC
+     PROC should be a procedure of one argument.  If FILE is an
+     output-port, `batch:call-with-output-script' writes an appropriate
+     header to FILE and then calls PROC with FILE as the only argument.
+     If FILE is a string, `batch:call-with-output-script' opens a
+     output-file of name FILE, writes an appropriate header to FILE,
+     and then calls PROC with the newly opened port as the only
+     argument.  Otherwise, `batch:call-with-output-script' acts as if
+     it was called with the result of `(current-output-port)' as its
+     third argument.
+
+ - Function: batch:apply-chop-to-fit PROC ARG1 ARG2 ... LIST
+     The procedure PROC must accept at least one argument and return
+     `#t' if successful, `#f' if not.  `batch:apply-chop-to-fit' calls
+     PROC with ARG1, ARG2, ..., and CHUNK, where CHUNK is a subset of
+     LIST.  `batch:apply-chop-to-fit' tries PROC with successively
+     smaller subsets of LIST until either PROC returns non-false, or
+     the CHUNKs become empty.
+
+The rest of the `batch:' procedures write (or execute if
+`batch-dialect' is `system') commands to the batch port which has been
+added to PARMS or `(copy-tree PARMS)' by the code:
+
+     (adjoin-parameters! PARMS (list 'batch-port PORT))
+
+ - Function: batch:system PARMS STRING1 STRING2 ...
+     Calls `batch:try-system' (below) with arguments, but signals an
+     error if `batch:try-system' returns `#f'.
+
+These functions return a non-false value if the command was successfully
+translated into the batch dialect and `#f' if not.  In the case of the
+`system' dialect, the value is non-false if the operation suceeded.
+
+ - Function: batch:try-system PARMS STRING1 STRING2 ...
+     Writes a command to the `batch-port' in PARMS which executes the
+     program named STRING1 with arguments STRING2 ....
+
+ - Function: batch:run-script PARMS STRING1 STRING2 ...
+     Writes a command to the `batch-port' in PARMS which executes the
+     batch script named STRING1 with arguments STRING2 ....
+
+     *Note:* `batch:run-script' and `batch:try-system' are not the same
+     for some operating systems (VMS).
+
+ - Function: batch:comment PARMS LINE1 ...
+     Writes comment lines LINE1 ... to the `batch-port' in PARMS.
+
+ - Function: batch:lines->file PARMS FILE LINE1 ...
+     Writes commands to the `batch-port' in PARMS which create a file
+     named FILE with contents LINE1 ....
+
+ - Function: batch:delete-file PARMS FILE
+     Writes a command to the `batch-port' in PARMS which deletes the
+     file named FILE.
+
+ - Function: batch:rename-file PARMS OLD-NAME NEW-NAME
+     Writes a command to the `batch-port' in PARMS which renames the
+     file OLD-NAME to NEW-NAME.
+
+In addition, batch provides some small utilities very useful for writing
+scripts:
+
+ - Function: replace-suffix STR OLD NEW
+     Returns a new string similar to `str' but with the suffix string
+     OLD removed and the suffix string NEW appended.  If the end of STR
+     does not match OLD, an error is signaled.
+
+ - Function: string-join JOINER STRING1 ...
+     Returns a new string consisting of all the strings STRING1 ...  in
+     order appended together with the string JOINER between each
+     adjacent pair.
+
+ - Function: must-be-first LIST1 LIST2
+     Returns a new list consisting of the elements of LIST2 ordered so
+     that if some elements of LIST1 are `equal?' to elements of LIST2,
+     then those elements will appear first and in the order of LIST1.
+
+ - Function: must-be-last LIST1 LIST2
+     Returns a new list consisting of the elements of LIST1 ordered so
+     that if some elements of LIST2 are `equal?' to elements of LIST1,
+     then those elements will appear last and in the order of LIST2.
+
+ - Function: os->batch-dialect OSNAME
+     Returns its best guess for the `batch-dialect' to be used for the
+     operating-system named OSNAME.  `os->batch-dialect' uses the
+     tables added to DATABASE by `batch:initialize!'.
+
+Here is an example of the use of most of batch's procedures:
+
+     (require 'database-utilities)
+     (require 'parameters)
+     (require 'batch)
+     
+     (define batch (create-database #f 'alist-table))
+     (batch:initialize! batch)
+     
+     (define my-parameters
+       (list (list 'batch-dialect (os->batch-dialect batch:platform))
+             (list 'platform batch:platform)
+             (list 'batch-port (current-output-port)))) ;gets filled in later
+     
+     (batch:call-with-output-script
+      my-parameters
+      "my-batch"
+      (lambda (batch-port)
+        (adjoin-parameters! my-parameters (list 'batch-port batch-port))
+        (and
+         (batch:comment my-parameters
+                        "================ Write file with C program.")
+         (batch:rename-file my-parameters "hello.c" "hello.c~")
+         (batch:lines->file my-parameters "hello.c"
+                            "#include <stdio.h>"
+                            "int main(int argc, char **argv)"
+                            "{"
+                            "  printf(\"hello world\\n\");"
+                            "  return 0;"
+                            "}" )
+         (batch:system my-parameters "cc" "-c" "hello.c")
+         (batch:system my-parameters "cc" "-o" "hello"
+                       (replace-suffix "hello.c" ".c" ".o"))
+         (batch:system my-parameters "hello")
+         (batch:delete-file my-parameters "hello")
+         (batch:delete-file my-parameters "hello.c")
+         (batch:delete-file my-parameters "hello.o")
+         (batch:delete-file my-parameters "my-batch")
+         )))
+
+Produces the file `my-batch':
+
+     #!/bin/sh
+     # "my-batch" build script created Sat Jun 10 21:20:37 1995
+     # ================ Write file with C program.
+     mv -f hello.c hello.c~
+     rm -f hello.c
+     echo '#include <stdio.h>'>>hello.c
+     echo 'int main(int argc, char **argv)'>>hello.c
+     echo '{'>>hello.c
+     echo '  printf("hello world\n");'>>hello.c
+     echo '  return 0;'>>hello.c
+     echo '}'>>hello.c
+     cc -c hello.c
+     cc -o hello hello.o
+     hello
+     rm -f hello
+     rm -f hello.c
+     rm -f hello.o
+     rm -f my-batch
+
+When run, `my-batch' prints:
+
+     bash$ my-batch
+     mv: hello.c: No such file or directory
+     hello world
+
+
+File: slib.info,  Node: Common List Functions,  Next: Format,  Prev: Batch,  Up: Procedures
+
+Common List Functions
+=====================
+
+  `(require 'common-list-functions)'
+
+  The procedures below follow the Common LISP equivalents apart from
+optional arguments in some cases.
+
+* Menu:
+
+* List construction::
+* Lists as sets::
+* Lists as sequences::
+* Destructive list operations::
+* Non-List functions::
+
+
+File: slib.info,  Node: List construction,  Next: Lists as sets,  Prev: Common List Functions,  Up: Common List Functions
+
+List construction
+-----------------
+
+ - Function: make-list K . INIT
+     `make-list' creates and returns a list of K elements.  If INIT is
+     included, all elements in the list are initialized to INIT.
+
+     Example:
+          (make-list 3)
+             => (#<unspecified> #<unspecified> #<unspecified>)
+          (make-list 5 'foo)
+             => (foo foo foo foo foo)
+
+ - Function: list* X . Y
+     Works like `list' except that the cdr of the last pair is the last
+     argument unless there is only one argument, when the result is
+     just that argument.  Sometimes called `cons*'.  E.g.:
+          (list* 1)
+             => 1
+          (list* 1 2 3)
+             => (1 2 . 3)
+          (list* 1 2 '(3 4))
+             => (1 2 3 4)
+          (list* ARGS '())
+             == (list ARGS)
+
+ - Function: copy-list LST
+     `copy-list' makes a copy of LST using new pairs and returns it.
+     Only the top level of the list is copied, i.e., pairs forming
+     elements of the copied list remain `eq?' to the corresponding
+     elements of the original; the copy is, however, not `eq?' to the
+     original, but is `equal?' to it.
+
+     Example:
+          (copy-list '(foo foo foo))
+             => (foo foo foo)
+          (define q '(foo bar baz bang))
+          (define p q)
+          (eq? p q)
+             => #t
+          (define r (copy-list q))
+          (eq? q r)
+             => #f
+          (equal? q r)
+             => #t
+          (define bar '(bar))
+          (eq? bar (car (copy-list (list bar 'foo))))
+          => #t
+
+
+File: slib.info,  Node: Lists as sets,  Next: Lists as sequences,  Prev: List construction,  Up: Common List Functions
+
+Lists as sets
+-------------
+
+  `eq?' is used to test for membership by all the procedures below
+which treat lists as sets.
+
+ - Function: adjoin E L
+     `adjoin' returns the adjoint of the element E and the list L.
+     That is, if E is in L, `adjoin' returns L, otherwise, it returns
+     `(cons E L)'.
+
+     Example:
+          (adjoin 'baz '(bar baz bang))
+             => (bar baz bang)
+          (adjoin 'foo '(bar baz bang))
+             => (foo bar baz bang)
+
+ - Function: union L1 L2
+     `union' returns the combination of L1 and L2.  Duplicates between
+     L1 and L2 are culled.  Duplicates within L1 or within L2 may or
+     may not be removed.
+
+     Example:
+          (union '(1 2 3 4) '(5 6 7 8))
+             => (4 3 2 1 5 6 7 8)
+          (union '(1 2 3 4) '(3 4 5 6))
+             => (2 1 3 4 5 6)
+
+ - Function: intersection L1 L2
+     `intersection' returns all elements that are in both L1 and L2.
+
+     Example:
+          (intersection '(1 2 3 4) '(3 4 5 6))
+             => (3 4)
+          (intersection '(1 2 3 4) '(5 6 7 8))
+             => ()
+
+ - Function: set-difference L1 L2
+     `set-difference' returns the union of all elements that are in L1
+     but not in L2.
+
+     Example:
+          (set-difference '(1 2 3 4) '(3 4 5 6))
+             => (1 2)
+          (set-difference '(1 2 3 4) '(1 2 3 4 5 6))
+             => ()
+
+ - Function: member-if PRED LST
+     `member-if' returns LST if `(PRED ELEMENT)' is `#t' for any
+     ELEMENT in LST.  Returns `#f' if PRED does not apply to any
+     ELEMENT in LST.
+
+     Example:
+          (member-if vector? '(1 2 3 4))
+             => #f
+          (member-if number? '(1 2 3 4))
+             => (1 2 3 4)
+
+ - Function: some PRED LST . MORE-LSTS
+     PRED is a boolean function of as many arguments as there are list
+     arguments to `some' i.e., LST plus any optional arguments.  PRED
+     is applied to successive elements of the list arguments in order.
+     `some' returns `#t' as soon as one of these applications returns
+     `#t', and is `#f' if none returns `#t'.  All the lists should have
+     the same length.
+
+     Example:
+          (some odd? '(1 2 3 4))
+             => #t
+          
+          (some odd? '(2 4 6 8))
+             => #f
+          
+          (some > '(2 3) '(1 4))
+             => #f
+
+ - Function: every PRED LST . MORE-LSTS
+     `every' is analogous to `some' except it returns `#t' if every
+     application of PRED is `#t' and `#f' otherwise.
+
+     Example:
+          (every even? '(1 2 3 4))
+             => #f
+          
+          (every even? '(2 4 6 8))
+             => #t
+          
+          (every > '(2 3) '(1 4))
+             => #f
+
+ - Function: notany PRED . LST
+     `notany' is analogous to `some' but returns `#t' if no application
+     of PRED returns `#t' or `#f' as soon as any one does.
+
+ - Function: notevery PRED . LST
+     `notevery' is analogous to `some' but returns `#t' as soon as an
+     application of PRED returns `#f', and `#f' otherwise.
+
+     Example:
+          (notevery even? '(1 2 3 4))
+             => #t
+          
+          (notevery even? '(2 4 6 8))
+             => #f
+
+ - Function: find-if PRED LST
+     `find-if' searches for the first ELEMENT in LST such that `(PRED
+     ELEMENT)' returns `#t'.  If it finds any such ELEMENT in LST,
+     ELEMENT is returned.  Otherwise, `#f' is returned.
+
+     Example:
+          (find-if number? '(foo 1 bar 2))
+             => 1
+          
+          (find-if number? '(foo bar baz bang))
+             => #f
+          
+          (find-if symbol? '(1 2 foo bar))
+             => foo
+
+ - Function: remove ELT LST
+     `remove' removes all occurrences of ELT from LST using `eqv?' to
+     test for equality and returns everything that's left.  N.B.: other
+     implementations (Chez, Scheme->C and T, at least) use `equal?' as
+     the equality test.
+
+     Example:
+          (remove 1 '(1 2 1 3 1 4 1 5))
+             => (2 3 4 5)
+          
+          (remove 'foo '(bar baz bang))
+             => (bar baz bang)
+
+ - Function: remove-if PRED LST
+     `remove-if' removes all ELEMENTs from LST where `(PRED ELEMENT)'
+     is `#t' and returns everything that's left.
+
+     Example:
+          (remove-if number? '(1 2 3 4))
+             => ()
+          
+          (remove-if even? '(1 2 3 4 5 6 7 8))
+             => (1 3 5 7)
+
+ - Function: remove-if-not PRED LST
+     `remove-if-not' removes all ELEMENTs from LST for which `(PRED
+     ELEMENT)' is `#f' and returns everything that's left.
+
+     Example:
+          (remove-if-not number? '(foo bar baz))
+             => ()
+          (remove-if-not odd? '(1 2 3 4 5 6 7 8))
+             => (1 3 5 7)
+
+ - Function: has-duplicates? LST
+     returns `#t' if 2 members of LST are `equal?', `#f' otherwise.
+     Example:
+          (has-duplicates? '(1 2 3 4))
+             => #f
+          
+          (has-duplicates? '(2 4 3 4))
+             => #t
+
+
+File: slib.info,  Node: Lists as sequences,  Next: Destructive list operations,  Prev: Lists as sets,  Up: Common List Functions
+
+Lists as sequences
+------------------
+
+ - Function: position OBJ LST
+     `position' returns the 0-based position of OBJ in LST, or `#f' if
+     OBJ does not occur in LST.
+
+     Example:
+          (position 'foo '(foo bar baz bang))
+             => 0
+          (position 'baz '(foo bar baz bang))
+             => 2
+          (position 'oops '(foo bar baz bang))
+             => #f
+
+ - Function: reduce P LST
+     `reduce' combines all the elements of a sequence using a binary
+     operation (the combination is left-associative).  For example,
+     using `+', one can add up all the elements.  `reduce' allows you to
+     apply a function which accepts only two arguments to more than 2
+     objects.  Functional programmers usually refer to this as "foldl".
+     `collect:reduce' (*Note Collections::) provides a version of
+     `collect' generalized to collections.
+
+     Example:
+          (reduce + '(1 2 3 4))
+             => 10
+          (define (bad-sum . l) (reduce + l))
+          (bad-sum 1 2 3 4)
+             == (reduce + (1 2 3 4))
+             == (+ (+ (+ 1 2) 3) 4)
+          => 10
+          (bad-sum)
+             == (reduce + ())
+             => ()
+          (reduce string-append '("hello" "cruel" "world"))
+             == (string-append (string-append "hello" "cruel") "world")
+             => "hellocruelworld"
+          (reduce anything '())
+             => ()
+          (reduce anything '(x))
+             => x
+
+     What follows is a rather non-standard implementation of `reverse'
+     in terms of `reduce' and a combinator elsewhere called "C".
+
+          ;;; Contributed by Jussi Piitulainen (jpiitula@ling.helsinki.fi)
+          
+          (define commute
+            (lambda (f)
+              (lambda (x y)
+                (f y x))))
+          
+          (define reverse
+            (lambda (args)
+              (reduce-init (commute cons) args)))
+
+ - Function: reduce-init P INIT LST
+     `reduce-init' is the same as reduce, except that it implicitly
+     inserts INIT at the start of the list.  `reduce-init' is preferred
+     if you want to handle the null list, the one-element, and lists
+     with two or more elements consistently.  It is common to use the
+     operator's idempotent as the initializer.  Functional programmers
+     usually call this "foldl".
+
+     Example:
+          (define (sum . l) (reduce-init + 0 l))
+          (sum 1 2 3 4)
+             == (reduce-init + 0 (1 2 3 4))
+             == (+ (+ (+ (+ 0 1) 2) 3) 4)
+             => 10
+          (sum)
+             == (reduce-init + 0 '())
+             => 0
+          
+          (reduce-init string-append "@" '("hello" "cruel" "world"))
+          ==
+          (string-append (string-append (string-append "@" "hello")
+                                         "cruel")
+                         "world")
+          => "@hellocruelworld"
+
+     Given a differentiation of 2 arguments, `diff', the following will
+     differentiate by any number of variables.
+          (define (diff* exp . vars)
+            (reduce-init diff exp vars))
+
+     Example:
+          ;;; Real-world example:  Insertion sort using reduce-init.
+          
+          (define (insert l item)
+            (if (null? l)
+                (list item)
+                (if (< (car l) item)
+                    (cons (car l) (insert (cdr l) item))
+                    (cons item l))))
+          (define (insertion-sort l) (reduce-init insert '() l))
+          
+          (insertion-sort '(3 1 4 1 5)
+             == (reduce-init insert () (3 1 4 1 5))
+             == (insert (insert (insert (insert (insert () 3) 1) 4) 1) 5)
+             == (insert (insert (insert (insert (3)) 1) 4) 1) 5)
+             == (insert (insert (insert (1 3) 4) 1) 5)
+             == (insert (insert (1 3 4) 1) 5)
+             == (insert (1 1 3 4) 5)
+             => (1 1 3 4 5)
+
+ - Function: butlast LST N
+     `butlast' returns all but the last N elements of LST.
+
+     Example:
+          (butlast '(1 2 3 4) 3)
+             => (1)
+          (butlast '(1 2 3 4) 4)
+             => ()
+
+ - Function: nthcdr N LST
+     `nthcdr' takes N `cdr's of LST and returns the result.  Thus
+     `(nthcdr 3 LST)' == `(cdddr LST)'
+
+     Example:
+          (nthcdr 2 '(1 2 3 4))
+             => (3 4)
+          (nthcdr 0 '(1 2 3 4))
+             => (1 2 3 4)
+
+ - Function: last LST N
+     `last' returns the last N elements of LST.  N must be a
+     non-negative integer.
+
+     Example:
+          (last '(foo bar baz bang) 2)
+             => (baz bang)
+          (last '(1 2 3) 0)
+             => 0
+
+
+File: slib.info,  Node: Destructive list operations,  Next: Non-List functions,  Prev: Lists as sequences,  Up: Common List Functions
+
+Destructive list operations
+---------------------------
+
+  These procedures may mutate the list they operate on, but any such
+mutation is undefined.
+
+ - Procedure: nconc ARGS
+     `nconc' destructively concatenates its arguments.  (Compare this
+     with `append', which copies arguments rather than destroying them.)
+     Sometimes called `append!' (*Note Rev2 Procedures::).
+
+     Example:  You want to find the subsets of a set.  Here's the
+     obvious way:
+
+          (define (subsets set)
+            (if (null? set)
+                '(())
+                (append (mapcar (lambda (sub) (cons (car set) sub))
+                                (subsets (cdr set)))
+                        (subsets (cdr set)))))
+     But that does way more consing than you need.  Instead, you could
+     replace the `append' with `nconc', since you don't have any need
+     for all the intermediate results.
+
+     Example:
+          (define x '(a b c))
+          (define y '(d e f))
+          (nconc x y)
+             => (a b c d e f)
+          x
+             => (a b c d e f)
+
+     `nconc' is the same as `append!' in `sc2.scm'.
+
+ - Procedure: nreverse LST
+     `nreverse' reverses the order of elements in LST by mutating
+     `cdr's of the list.  Sometimes called `reverse!'.
+
+     Example:
+          (define foo '(a b c))
+          (nreverse foo)
+             => (c b a)
+          foo
+             => (a)
+
+     Some people have been confused about how to use `nreverse',
+     thinking that it doesn't return a value.  It needs to be pointed
+     out that
+          (set! lst (nreverse lst))
+
+     is the proper usage, not
+          (nreverse lst)
+     The example should suffice to show why this is the case.
+
+ - Procedure: delete ELT LST
+ - Procedure: delete-if PRED LST
+ - Procedure: delete-if-not PRED LST
+     Destructive versions of `remove' `remove-if', and `remove-if-not'.
+
+     Example:
+          (define lst '(foo bar baz bang))
+          (delete 'foo lst)
+             => (bar baz bang)
+          lst
+             => (foo bar baz bang)
+          
+          (define lst '(1 2 3 4 5 6 7 8 9))
+          (delete-if odd? lst)
+             => (2 4 6 8)
+          lst
+             => (1 2 4 6 8)
+
+     Some people have been confused about how to use `delete',
+     `delete-if', and `delete-if', thinking that they dont' return a
+     value.  It needs to be pointed out that
+          (set! lst (delete el lst))
+
+     is the proper usage, not
+          (delete el lst)
+     The examples should suffice to show why this is the case.
+
+
+File: slib.info,  Node: Non-List functions,  Prev: Destructive list operations,  Up: Common List Functions
+
+Non-List functions
+------------------
+
+ - Function: and? . ARGS
+     `and?' checks to see if all its arguments are true.  If they are,
+     `and?' returns `#t', otherwise, `#f'.  (In contrast to `and', this
+     is a function, so all arguments are always evaluated and in an
+     unspecified order.)
+
+     Example:
+          (and? 1 2 3)
+             => #t
+          (and #f 1 2)
+             => #f
+
+ - Function: or? . ARGS
+     `or?' checks to see if any of its arguments are true.  If any is
+     true, `or?' returns `#t', and `#f' otherwise.  (To `or' as `and?'
+     is to `and'.)
+
+     Example:
+          (or? 1 2 #f)
+             => #t
+          (or? #f #f #f)
+             => #f
+
+ - Function: atom? OBJECT
+     Returns `#t' if OBJECT is not a pair and `#f' if it is pair.
+     (Called `atom' in Common LISP.)
+          (atom? 1)
+             => #t
+          (atom? '(1 2))
+             => #f
+          (atom? #(1 2))   ; dubious!
+             => #t
+
+ - Function: type-of OBJECT
+     Returns a symbol name for the type of OBJECT.
+
+ - Function: coerce OBJECT RESULT-TYPE
+     Converts and returns OBJECT of type `char', `number', `string',
+     `symbol', `list', or `vector' to RESULT-TYPE (which must be one of
+     these symbols).
+
+
+File: slib.info,  Node: Format,  Next: Generic-Write,  Prev: Common List Functions,  Up: Procedures
+
+Format
+======
+
+  `(require 'format)'
+
+* Menu:
+
+* Format Interface::
+* Format Specification::
+
+
+File: slib.info,  Node: Format Interface,  Next: Format Specification,  Prev: Format,  Up: Format
+
+Format Interface
+----------------
+
+ - Function: format DESTINATION FORMAT-STRING . ARGUMENTS
+     An almost complete implementation of Common LISP format description
+     according to the CL reference book `Common LISP' from Guy L.
+     Steele, Digital Press.  Backward compatible to most of the
+     available Scheme format implementations.
+
+     Returns `#t', `#f' or a string; has side effect of printing
+     according to FORMAT-STRING.  If DESTINATION is `#t', the output is
+     to the current output port and `#t' is returned.  If DESTINATION
+     is `#f', a formatted string is returned as the result of the call.
+     NEW: If DESTINATION is a string, DESTINATION is regarded as the
+     format string; FORMAT-STRING is then the first argument and the
+     output is returned as a string. If DESTINATION is a number, the
+     output is to the current error port if available by the
+     implementation. Otherwise DESTINATION must be an output port and
+     `#t' is returned.
+
+     FORMAT-STRING must be a string.  In case of a formatting error
+     format returns `#f' and prints a message on the current output or
+     error port.  Characters are output as if the string were output by
+     the `display' function with the exception of those prefixed by a
+     tilde (~).  For a detailed description of the FORMAT-STRING syntax
+     please consult a Common LISP format reference manual.  For a test
+     suite to verify this format implementation load `formatst.scm'.
+     Please send bug reports to `lutzeb@cs.tu-berlin.de'.
+
+     Note: `format' is not reentrant, i.e. only one `format'-call may
+     be executed at a time.
+
+
+
+File: slib.info,  Node: Format Specification,  Prev: Format Interface,  Up: Format
+
+Format Specification (Format version 3.0)
+-----------------------------------------
+
+  Please consult a Common LISP format reference manual for a detailed
+description of the format string syntax.  For a demonstration of the
+implemented directives see `formatst.scm'.
+
+  This implementation supports directive parameters and modifiers (`:'
+and `@' characters). Multiple parameters must be separated by a comma
+(`,').  Parameters can be numerical parameters (positive or negative),
+character parameters (prefixed by a quote character (`''), variable
+parameters (`v'), number of rest arguments parameter (`#'), empty and
+default parameters.  Directive characters are case independent. The
+general form of a directive is:
+
+DIRECTIVE ::= ~{DIRECTIVE-PARAMETER,}[:][@]DIRECTIVE-CHARACTER
+
+DIRECTIVE-PARAMETER ::= [ [-|+]{0-9}+ | 'CHARACTER | v | # ]
+
+Implemented CL Format Control Directives
+........................................
+
+  Documentation syntax: Uppercase characters represent the corresponding
+control directive characters. Lowercase characters represent control
+directive parameter descriptions.
+
+`~A'
+     Any (print as `display' does).
+    `~@A'
+          left pad.
+
+    `~MINCOL,COLINC,MINPAD,PADCHARA'
+          full padding.
+
+`~S'
+     S-expression (print as `write' does).
+    `~@S'
+          left pad.
+
+    `~MINCOL,COLINC,MINPAD,PADCHARS'
+          full padding.
+
+`~D'
+     Decimal.
+    `~@D'
+          print number sign always.
+
+    `~:D'
+          print comma separated.
+
+    `~MINCOL,PADCHAR,COMMACHARD'
+          padding.
+
+`~X'
+     Hexadecimal.
+    `~@X'
+          print number sign always.
+
+    `~:X'
+          print comma separated.
+
+    `~MINCOL,PADCHAR,COMMACHARX'
+          padding.
+
+`~O'
+     Octal.
+    `~@O'
+          print number sign always.
+
+    `~:O'
+          print comma separated.
+
+    `~MINCOL,PADCHAR,COMMACHARO'
+          padding.
+
+`~B'
+     Binary.
+    `~@B'
+          print number sign always.
+
+    `~:B'
+          print comma separated.
+
+    `~MINCOL,PADCHAR,COMMACHARB'
+          padding.
+
+`~NR'
+     Radix N.
+    `~N,MINCOL,PADCHAR,COMMACHARR'
+          padding.
+
+`~@R'
+     print a number as a Roman numeral.
+
+`~:R'
+     print a number as an ordinal English number.
+
+`~:@R'
+     print a number as a cardinal English number.
+
+`~P'
+     Plural.
+    `~@P'
+          prints `y' and `ies'.
+
+    `~:P'
+          as `~P but jumps 1 argument backward.'
+
+    `~:@P'
+          as `~@P but jumps 1 argument backward.'
+
+`~C'
+     Character.
+    `~@C'
+          prints a character as the reader can understand it (i.e. `#\'
+          prefixing).
+
+    `~:C'
+          prints a character as emacs does (eg. `^C' for ASCII 03).
+
+`~F'
+     Fixed-format floating-point (prints a flonum like MMM.NNN).
+    `~WIDTH,DIGITS,SCALE,OVERFLOWCHAR,PADCHARF'
+    `~@F'
+          If the number is positive a plus sign is printed.
+
+`~E'
+     Exponential floating-point (prints a flonum like MMM.NNN`E'EE).
+    `~WIDTH,DIGITS,EXPONENTDIGITS,SCALE,OVERFLOWCHAR,PADCHAR,EXPONENTCHARE'
+    `~@E'
+          If the number is positive a plus sign is printed.
+
+`~G'
+     General floating-point (prints a flonum either fixed or
+     exponential).
+    `~WIDTH,DIGITS,EXPONENTDIGITS,SCALE,OVERFLOWCHAR,PADCHAR,EXPONENTCHARG'
+    `~@G'
+          If the number is positive a plus sign is printed.
+
+`~$'
+     Dollars floating-point (prints a flonum in fixed with signs
+     separated).
+    `~DIGITS,SCALE,WIDTH,PADCHAR$'
+    `~@$'
+          If the number is positive a plus sign is printed.
+
+    `~:@$'
+          A sign is always printed and appears before the padding.
+
+    `~:$'
+          The sign appears before the padding.
+
+`~%'
+     Newline.
+    `~N%'
+          print N newlines.
+
+`~&'
+     print newline if not at the beginning of the output line.
+    `~N&'
+          prints `~&' and then N-1 newlines.
+
+`~|'
+     Page Separator.
+    `~N|'
+          print N page separators.
+
+`~~'
+     Tilde.
+    `~N~'
+          print N tildes.
+
+`~'<newline>
+     Continuation Line.
+    `~:'<newline>
+          newline is ignored, white space left.
+
+    `~@'<newline>
+          newline is left, white space ignored.
+
+`~T'
+     Tabulation.
+    `~@T'
+          relative tabulation.
+
+    `~COLNUM,COLINCT'
+          full tabulation.
+
+`~?'
+     Indirection (expects indirect arguments as a list).
+    `~@?'
+          extracts indirect arguments from format arguments.
+
+`~(STR~)'
+     Case conversion (converts by `string-downcase').
+    `~:(STR~)'
+          converts by `string-capitalize'.
+
+    `~@(STR~)'
+          converts by `string-capitalize-first'.
+
+    `~:@(STR~)'
+          converts by `string-upcase'.
+
+`~*'
+     Argument Jumping (jumps 1 argument forward).
+    `~N*'
+          jumps N arguments forward.
+
+    `~:*'
+          jumps 1 argument backward.
+
+    `~N:*'
+          jumps N arguments backward.
+
+    `~@*'
+          jumps to the 0th argument.
+
+    `~N@*'
+          jumps to the Nth argument (beginning from 0)
+
+`~[STR0~;STR1~;...~;STRN~]'
+     Conditional Expression (numerical clause conditional).
+    `~N['
+          take argument from N.
+
+    `~@['
+          true test conditional.
+
+    `~:['
+          if-else-then conditional.
+
+    `~;'
+          clause separator.
+
+    `~:;'
+          default clause follows.
+
+`~{STR~}'
+     Iteration (args come from the next argument (a list)).
+    `~N{'
+          at most N iterations.
+
+    `~:{'
+          args from next arg (a list of lists).
+
+    `~@{'
+          args from the rest of arguments.
+
+    `~:@{'
+          args from the rest args (lists).
+
+`~^'
+     Up and out.
+    `~N^'
+          aborts if N = 0
+
+    `~N,M^'
+          aborts if N = M
+
+    `~N,M,K^'
+          aborts if N <= M <= K
+
+Not Implemented CL Format Control Directives
+............................................
+
+`~:A'
+     print `#f' as an empty list (see below).
+
+`~:S'
+     print `#f' as an empty list (see below).
+
+`~<~>'
+     Justification.
+
+`~:^'
+     (sorry I don't understand its semantics completely)
+
+Extended, Replaced and Additional Control Directives
+....................................................
+
+`~MINCOL,PADCHAR,COMMACHAR,COMMAWIDTHD'
+`~MINCOL,PADCHAR,COMMACHAR,COMMAWIDTHX'
+`~MINCOL,PADCHAR,COMMACHAR,COMMAWIDTHO'
+`~MINCOL,PADCHAR,COMMACHAR,COMMAWIDTHB'
+`~N,MINCOL,PADCHAR,COMMACHAR,COMMAWIDTHR'
+     COMMAWIDTH is the number of characters between two comma
+     characters.
+
+`~I'
+     print a R4RS complex number as `~F~@Fi' with passed parameters for
+     `~F'.
+
+`~Y'
+     Pretty print formatting of an argument for scheme code lists.
+
+`~K'
+     Same as `~?.'
+
+`~!'
+     Flushes the output if format DESTINATION is a port.
+
+`~_'
+     Print a `#\space' character
+    `~N_'
+          print N `#\space' characters.
+
+`~/'
+     Print a `#\tab' character
+    `~N/'
+          print N `#\tab' characters.
+
+`~NC'
+     Takes N as an integer representation for a character. No arguments
+     are consumed. N is converted to a character by `integer->char'.  N
+     must be a positive decimal number.
+
+`~:S'
+     Print out readproof.  Prints out internal objects represented as
+     `#<...>' as strings `"#<...>"' so that the format output can always
+     be processed by `read'.
+
+`~:A'
+     Print out readproof.  Prints out internal objects represented as
+     `#<...>' as strings `"#<...>"' so that the format output can always
+     be processed by `read'.
+
+`~Q'
+     Prints information and a copyright notice on the format
+     implementation.
+    `~:Q'
+          prints format version.
+
+`~F, ~E, ~G, ~$'
+     may also print number strings, i.e. passing a number as a string
+     and format it accordingly.
+
+Configuration Variables
+.......................
+
+  Format has some configuration variables at the beginning of
+`format.scm' to suit the systems and users needs. There should be no
+modification necessary for the configuration that comes with SLIB.  If
+modification is desired the variable should be set after the format
+code is loaded. Format detects automatically if the running scheme
+system implements floating point numbers and complex numbers.
+
+FORMAT:SYMBOL-CASE-CONV
+     Symbols are converted by `symbol->string' so the case type of the
+     printed symbols is implementation dependent.
+     `format:symbol-case-conv' is a one arg closure which is either
+     `#f' (no conversion), `string-upcase', `string-downcase' or
+     `string-capitalize'. (default `#f')
+
+FORMAT:IOBJ-CASE-CONV
+     As FORMAT:SYMBOL-CASE-CONV but applies for the representation of
+     implementation internal objects. (default `#f')
+
+FORMAT:EXPCH
+     The character prefixing the exponent value in `~E' printing.
+     (default `#\E')
+
+Compatibility With Other Format Implementations
+...............................................
+
+SLIB format 2.x:
+     See `format.doc'.
+
+SLIB format 1.4:
+     Downward compatible except for padding support and `~A', `~S',
+     `~P', `~X' uppercase printing.  SLIB format 1.4 uses C-style
+     `printf' padding support which is completely replaced by the CL
+     `format' padding style.
+
+MIT C-Scheme 7.1:
+     Downward compatible except for `~', which is not documented
+     (ignores all characters inside the format string up to a newline
+     character).  (7.1 implements `~a', `~s', ~NEWLINE, `~~', `~%',
+     numerical and variable parameters and `:/@' modifiers in the CL
+     sense).
+
+Elk 1.5/2.0:
+     Downward compatible except for `~A' and `~S' which print in
+     uppercase.  (Elk implements `~a', `~s', `~~', and `~%' (no
+     directive parameters or modifiers)).
+
+Scheme->C 01nov91:
+     Downward compatible except for an optional destination parameter:
+     S2C accepts a format call without a destination which returns a
+     formatted string. This is equivalent to a #f destination in S2C.
+     (S2C implements `~a', `~s', `~c', `~%', and `~~' (no directive
+     parameters or modifiers)).
+
+  This implementation of format is solely useful in the SLIB context
+because it requires other components provided by SLIB.
+
+
+File: slib.info,  Node: Generic-Write,  Next: Line I/O,  Prev: Format,  Up: Procedures
+
+Generic-Write
+=============
+
+  `(require 'generic-write)'
+
+  `generic-write' is a procedure that transforms a Scheme data value
+(or Scheme program expression) into its textual representation and
+prints it.  The interface to the procedure is sufficiently general to
+easily implement other useful formatting procedures such as pretty
+printing, output to a string and truncated output.
+
+ - Procedure: generic-write OBJ DISPLAY? WIDTH OUTPUT
+    OBJ
+          Scheme data value to transform.
+
+    DISPLAY?
+          Boolean, controls whether characters and strings are quoted.
+
+    WIDTH
+          Extended boolean, selects format:
+         #f
+               single line format
+
+         integer > 0
+               pretty-print (value = max nb of chars per line)
+
+    OUTPUT
+          Procedure of 1 argument of string type, called repeatedly with
+          successive substrings of the textual representation.  This
+          procedure can return `#f' to stop the transformation.
+
+     The value returned by `generic-write' is undefined.
+
+     Examples:
+          (write obj) == (generic-write obj #f #f DISPLAY-STRING)
+          (display obj) == (generic-write obj #t #f DISPLAY-STRING)
+
+     where
+          DISPLAY-STRING ==
+          (lambda (s) (for-each write-char (string->list s)) #t)
+
+
+File: slib.info,  Node: Line I/O,  Next: Multi-Processing,  Prev: Generic-Write,  Up: Procedures
+
+Line I/O
+========
+
+  `(require 'line-i/o)'
+
+ - Function: read-line
+ - Function: read-line PORT
+     Returns a string of the characters up to, but not including a
+     newline or end of file, updating PORT to point to the character
+     following the newline.  If no characters are available, an end of
+     file object is returned.  PORT may be omitted, in which case it
+     defaults to the value returned by `current-input-port'.
+
+ - Function: read-line! STRING
+ - Function: read-line! STRING PORT
+     Fills STRING with characters up to, but not including a newline or
+     end of file, updating the port to point to the last character read
+     or following the newline if it was read.  If no characters are
+     available, an end of file object is returned.  If a newline or end
+     of file was found, the number of characters read is returned.
+     Otherwise, `#f' is returned.  PORT may be omitted, in which case
+     it defaults to the value returned by `current-input-port'.
+
+ - Function: write-line STRING
+ - Function: write-line STRING PORT
+     Writes STRING followed by a newline to the given port and returns
+     an unspecified value.  Port may be omited, in which case it
+     defaults to the value returned by `current-input-port'.
+
+
+File: slib.info,  Node: Multi-Processing,  Next: Object-To-String,  Prev: Line I/O,  Up: Procedures
+
+Multi-Processing
+================
+
+  `(require 'process)'
+
+ - Procedure: add-process! PROC
+     Adds proc, which must be a procedure (or continuation) capable of
+     accepting accepting one argument, to the `process:queue'.  The
+     value returned is unspecified.  The argument to PROC should be
+     ignored.  If PROC returns, the process is killed.
+
+ - Procedure: process:schedule!
+     Saves the current process on `process:queue' and runs the next
+     process from `process:queue'.  The value returned is unspecified.
+
+ - Procedure: kill-process!
+     Kills the current process and runs the next process from
+     `process:queue'.  If there are no more processes on
+     `process:queue', `(slib:exit)' is called (*Note System::).
+
+
+File: slib.info,  Node: Object-To-String,  Next: Pretty-Print,  Prev: Multi-Processing,  Up: Procedures
+
+Object-To-String
+================
+
+  `(require 'object->string)'
+
+ - Function: object->string OBJ
+     Returns the textual representation of OBJ as a string.
+
+
+File: slib.info,  Node: Pretty-Print,  Next: Sorting,  Prev: Object-To-String,  Up: Procedures
+
+Pretty-Print
+============
+
+  `(require 'pretty-print)'
+
+ - Procedure: pretty-print OBJ
+ - Procedure: pretty-print OBJ PORT
+     `pretty-print's OBJ on PORT.  If PORT is not specified,
+     `current-output-port' is used.
+
+     Example:
+          (pretty-print '((1 2 3 4 5) (6 7 8 9 10) (11 12 13 14 15)
+                          (16 17 18 19 20) (21 22 23 24 25)))
+             -| ((1 2 3 4 5)
+             -|  (6 7 8 9 10)
+             -|  (11 12 13 14 15)
+             -|  (16 17 18 19 20)
+             -|  (21 22 23 24 25))
+
+  `(require 'pprint-file)'
+
+ - Procedure: pprint-file INFILE
+ - Procedure: pprint-file INFILE OUTFILE
+     Pretty-prints all the code in INFILE.  If OUTFILE is specified,
+     the output goes to OUTFILE, otherwise it goes to
+     `(current-output-port)'.
+
+ - Function: pprint-filter-file INFILE PROC OUTFILE
+ - Function: pprint-filter-file INFILE PROC
+     INFILE is a port or a string naming an existing file.  Scheme
+     source code expressions and definitions are read from the port (or
+     file) and PROC is applied to them sequentially.
+
+     OUTFILE is a port or a string.  If no OUTFILE is specified then
+     `current-output-port' is assumed.  These expanded expressions are
+     then `pretty-print'ed to this port.
+
+     Whitepsace and comments (introduced by `;') which are not part of
+     scheme expressions are reproduced in the output.  This procedure
+     does not affect the values returned by `current-input-port' and
+     `current-output-port'.
+
+  `pprint-filter-file' can be used to pre-compile macro-expansion and
+thus can reduce loading time.  The following will write into
+`exp-code.scm' the result of expanding all defmacros in `code.scm'.
+     (require 'pprint-file)
+     (require 'defmacroexpand)
+     (defmacro:load "my-macros.scm")
+     (pprint-filter-file "code.scm" defmacro:expand* "exp-code.scm")
+
diff --git a/slib.info-6 b/slib.info-6
new file mode 100644
index 0000000..05d8377
--- /dev/null
+++ b/slib.info-6
@@ -0,0 +1,1410 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+File: slib.info,  Node: Sorting,  Next: Topological Sort,  Prev: Pretty-Print,  Up: Procedures
+
+Sorting
+=======
+
+  `(require 'sort)'
+
+  Many Scheme systems provide some kind of sorting functions.  They do
+not, however, always provide the *same* sorting functions, and those
+that I have had the opportunity to test provided inefficient ones (a
+common blunder is to use quicksort which does not perform well).
+
+  Because `sort' and `sort!' are not in the standard, there is very
+little agreement about what these functions look like.  For example,
+Dybvig says that Chez Scheme provides
+     (merge predicate list1 list2)
+     (merge! predicate list1 list2)
+     (sort predicate list)
+     (sort! predicate list)
+
+while MIT Scheme 7.1, following Common LISP, offers unstable
+     (sort list predicate)
+
+TI PC Scheme offers
+     (sort! list/vector predicate?)
+
+and Elk offers
+     (sort list/vector predicate?)
+     (sort! list/vector predicate?)
+
+  Here is a comprehensive catalogue of the variations I have found.
+
+  1. Both `sort' and `sort!' may be provided.
+
+  2. `sort' may be provided without `sort!'.
+
+  3. `sort!' may be provided without `sort'.
+
+  4. Neither may be provided.
+
+  5. The sequence argument may be either a list or a vector.
+
+  6. The sequence argument may only be a list.
+
+  7. The sequence argument may only be a vector.
+
+  8. The comparison function may be expected to behave like `<'.
+
+  9. The comparison function may be expected to behave like `<='.
+
+ 10. The interface may be `(sort predicate? sequence)'.
+
+ 11. The interface may be `(sort sequence predicate?)'.
+
+ 12. The interface may be `(sort sequence &optional (predicate? <))'.
+
+ 13. The sort may be stable.
+
+ 14. The sort may be unstable.
+
+  All of this variation really does not help anybody.  A nice simple
+merge sort is both stable and fast (quite a lot faster than *quick*
+sort).
+
+  I am providing this source code with no restrictions at all on its use
+(but please retain D.H.D.Warren's credit for the original idea).  You
+may have to rename some of these functions in order to use them in a
+system which already provides incompatible or inferior sorts.  For each
+of the functions, only the top-level define needs to be edited to do
+that.
+
+  I could have given these functions names which would not clash with
+any Scheme that I know of, but I would like to encourage implementors to
+converge on a single interface, and this may serve as a hint.  The
+argument order for all functions has been chosen to be as close to
+Common LISP as made sense, in order to avoid NIH-itis.
+
+  Each of the five functions has a required *last* parameter which is a
+comparison function.  A comparison function `f' is a function of 2
+arguments which acts like `<'.  For example,
+
+     (not (f x x))
+     (and (f x y) (f y z)) == (f x z)
+
+  The standard functions `<', `>', `char<?', `char>?', `char-ci<?',
+`char-ci>?', `string<?', `string>?', `string-ci<?', and `string-ci>?'
+are suitable for use as comparison functions.  Think of `(less? x y)'
+as saying when `x' must *not* precede `y'.
+
+ - Function: sorted? SEQUENCE LESS?
+     Returns `#t' when the sequence argument is in non-decreasing order
+     according to LESS? (that is, there is no adjacent pair `... x y
+     ...' for which `(less? y x)').
+
+     Returns `#f' when the sequence contains at least one out-of-order
+     pair.  It is an error if the sequence is neither a list nor a
+     vector.
+
+ - Function: merge LIST1 LIST2 LESS?
+     This merges two lists, producing a completely new list as result.
+     I gave serious consideration to producing a Common-LISP-compatible
+     version.  However, Common LISP's `sort' is our `sort!' (well, in
+     fact Common LISP's `stable-sort' is our `sort!', merge sort is
+     *fast* as well as stable!) so adapting CL code to Scheme takes a
+     bit of work anyway.  I did, however, appeal to CL to determine the
+     *order* of the arguments.
+
+ - Procedure: merge! LIST1 LIST2 LESS?
+     Merges two lists, re-using the pairs of LIST1 and LIST2 to build
+     the result.  If the code is compiled, and LESS? constructs no new
+     pairs, no pairs at all will be allocated.  The first pair of the
+     result will be either the first pair of LIST1 or the first pair of
+     LIST2, but you can't predict which.
+
+     The code of `merge' and `merge!' could have been quite a bit
+     simpler, but they have been coded to reduce the amount of work
+     done per iteration.  (For example, we only have one `null?' test
+     per iteration.)
+
+ - Function: sort SEQUENCE LESS?
+     Accepts either a list or a vector, and returns a new sequence
+     which is sorted.  The new sequence is the same type as the input.
+     Always `(sorted? (sort sequence less?) less?)'.  The original
+     sequence is not altered in any way.  The new sequence shares its
+     *elements* with the old one; no elements are copied.
+
+ - Procedure: sort! SEQUENCE LESS?
+     Returns its sorted result in the original boxes.  If the original
+     sequence is a list, no new storage is allocated at all.  If the
+     original sequence is a vector, the sorted elements are put back in
+     the same vector.
+
+     Some people have been confused about how to use `sort!', thinking
+     that it doesn't return a value.  It needs to be pointed out that
+          (set! slist (sort! slist <))
+
+     is the proper usage, not
+          (sort! slist <)
+
+  Note that these functions do *not* accept a CL-style `:key' argument.
+A simple device for obtaining the same expressiveness is to define
+     (define (keyed less? key)
+       (lambda (x y) (less? (key x) (key y))))
+
+and then, when you would have written
+     (sort a-sequence #'my-less :key #'my-key)
+
+in Common LISP, just write
+     (sort! a-sequence (keyed my-less? my-key))
+
+in Scheme.
+
+
+File: slib.info,  Node: Topological Sort,  Next: Standard Formatted I/O,  Prev: Sorting,  Up: Procedures
+
+Topological Sort
+================
+
+  `(require 'topological-sort)' or `(require 'tsort)'
+
+The algorithm is inspired by Cormen, Leiserson and Rivest (1990)
+`Introduction to Algorithms', chapter 23.
+
+ - Function: tsort DAG PRED
+ - Function: topological-sort DAG PRED
+     where
+    DAG
+          is a list of sublists.  The car of each sublist is a vertex.
+          The cdr is the adjacency list of that vertex, i.e. a list of
+          all vertices to which there exists an edge from the car
+          vertex.
+
+    PRED
+          is one of `eq?', `eqv?', `equal?', `=', `char=?',
+          `char-ci=?', `string=?', or `string-ci=?'.
+
+     Sort the directed acyclic graph DAG so that for every edge from
+     vertex U to V, U will come before V in the resulting list of
+     vertices.
+
+     Time complexity: O (|V| + |E|)
+
+     Example (from Cormen):
+          Prof. Bumstead topologically sorts his clothing when getting
+          dressed.  The first argument to `tsort' describes which
+          garments he needs to put on before others.  (For example,
+          Prof Bumstead needs to put on his shirt before he puts on his
+          tie or his belt.)  `tsort' gives the correct order of
+          dressing:
+
+          (require 'tsort)
+          (tsort '((shirt tie belt)
+                   (tie jacket)
+                   (belt jacket)
+                   (watch)
+                   (pants shoes belt)
+                   (undershorts pants shoes)
+                   (socks shoes))
+                 eq?)
+          =>
+          (socks undershorts pants shoes watch shirt belt tie jacket)
+
+
+File: slib.info,  Node: Standard Formatted I/O,  Next: String-Case,  Prev: Topological Sort,  Up: Procedures
+
+Standard Formatted I/O
+======================
+
+* Menu:
+
+* Standard Formatted Output::
+* Standard Formatted Input::
+
+stdio
+-----
+
+  `(require 'stdio)'
+
+  `require's `printf' and `scanf' and additionally defines the symbols:
+
+ - Variable: stdin
+     Defined to be `(current-input-port)'.
+
+ - Variable: stdout
+     Defined to be `(current-output-port)'.
+
+ - Variable: stderr
+     Defined to be `(current-error-port)'.
+
+
+File: slib.info,  Node: Standard Formatted Output,  Next: Standard Formatted Input,  Prev: Standard Formatted I/O,  Up: Standard Formatted I/O
+
+Standard Formatted Output
+-------------------------
+
+  `(require 'printf)'
+
+ - Procedure: printf FORMAT ARG1 ...
+ - Procedure: fprintf PORT FORMAT ARG1 ...
+ - Procedure: sprintf STR FORMAT ARG1 ...
+     Each function converts, formats, and outputs its ARG1 ...
+     arguments according to the control string FORMAT argument and
+     returns the number of characters output.
+
+     `printf' sends its output to the port `(current-output-port)'.
+     `fprintf' sends its output to the port PORT.  `sprintf'
+     `string-set!'s locations of the non-constant string argument STR
+     to the output characters.
+
+          *Note:* sprintf should be changed to a macro so a `substring'
+          expression could be used for the STR argument.
+
+     The string FORMAT contains plain characters which are copied to
+     the output stream, and conversion specifications, each of which
+     results in fetching zero or more of the arguments ARG1 ....  The
+     results are undefined if there are an insufficient number of
+     arguments for the format.  If FORMAT is exhausted while some of the
+     ARG1 ... arguments remain unused, the excess ARG1 ... arguments
+     are ignored.
+
+     The conversion specifications in a format string have the form:
+
+          % [ FLAGS ] [ WIDTH ] [ . PRECISION ] [ TYPE ] CONVERSION
+
+     An output conversion specifications consist of an initial `%'
+     character followed in sequence by:
+
+        * Zero or more "flag characters" that modify the normal
+          behavior of the conversion specification.
+
+         `-'
+               Left-justify the result in the field.  Normally the
+               result is right-justified.
+
+         `+'
+               For the signed `%d' and `%i' conversions and all inexact
+               conversions, prefix a plus sign if the value is positive.
+
+         ` '
+               For the signed `%d' and `%i' conversions, if the result
+               doesn't start with a plus or minus sign, prefix it with
+               a space character instead.  Since the `+' flag ensures
+               that the result includes a sign, this flag is ignored if
+               both are specified.
+
+         `#'
+               For inexact conversions, `#' specifies that the result
+               should always include a decimal point, even if no digits
+               follow it.  For the `%g' and `%G' conversions, this also
+               forces trailing zeros after the decimal point to be
+               printed where they would otherwise be elided.
+
+               For the `%o' conversion, force the leading digit to be
+               `0', as if by increasing the precision.  For `%x' or
+               `%X', prefix a leading `0x' or `0X' (respectively) to
+               the result.  This doesn't do anything useful for the
+               `%d', `%i', or `%u' conversions.  Using this flag
+               produces output which can be parsed by the `scanf'
+               functions with the `%i' conversion (*note Standard
+               Formatted Input::.).
+
+         `0'
+               Pad the field with zeros instead of spaces.  The zeros
+               are placed after any indication of sign or base.  This
+               flag is ignored if the `-' flag is also specified, or if
+               a precision is specified for an exact converson.
+
+        * An optional decimal integer specifying the "minimum field
+          width".  If the normal conversion produces fewer characters
+          than this, the field is padded (with spaces or zeros per the
+          `0' flag) to the specified width.  This is a *minimum* width;
+          if the normal conversion produces more characters than this,
+          the field is *not* truncated.
+
+          Alternatively, if the field width is `*', the next argument
+          in the argument list (before the actual value to be printed)
+          is used as the field width.  The width value must be an
+          integer.  If the value is negative it is as though the `-'
+          flag is set (see above) and the absolute value is used as the
+          field width.
+
+        * An optional "precision" to specify the number of digits to be
+          written for numeric conversions and the maximum field width
+          for string conversions.  The precision is specified by a
+          period (`.') followed optionally by a decimal integer (which
+          defaults to zero if omitted).
+
+          Alternatively, if the precision is `.*', the next argument in
+          the argument list (before the actual value to be printed) is
+          used as the precision.  The value must be an integer, and is
+          ignored if negative.  If you specify `*' for both the field
+          width and precision, the field width argument precedes the
+          precision argument.  The `.*' precision is an enhancement.  C
+          library versions may not accept this syntax.
+
+          For the `%f', `%e', and `%E' conversions, the precision
+          specifies how many digits follow the decimal-point character.
+          The default precision is `6'.  If the precision is
+          explicitly `0', the decimal point character is suppressed.
+
+          For the `%g' and `%G' conversions, the precision specifies how
+          many significant digits to print.  Significant digits are the
+          first digit before the decimal point, and all the digits
+          after it.  If the precision is `0' or not specified for `%g'
+          or `%G', it is treated like a value of `1'.  If the value
+          being printed cannot be expressed accurately in the specified
+          number of digits, the value is rounded to the nearest number
+          that fits.
+
+          For exact conversions, if a precision is supplied it
+          specifies the minimum number of digits to appear; leading
+          zeros are produced if necessary.  If a precision is not
+          supplied, the number is printed with as many digits as
+          necessary.  Converting an exact `0' with an explicit
+          precision of zero produces no characters.
+
+        * An optional one of `l', `h' or `L', which is ignored for
+          numeric conversions.  It is an error to specify these
+          modifiers for non-numeric conversions.
+
+        * A character that specifies the conversion to be applied.
+
+Exact Conversions
+.................
+
+    `d', `i'
+          Print an integer as a signed decimal number.  `%d' and `%i'
+          are synonymous for output, but are different when used with
+          `scanf' for input (*note Standard Formatted Input::.).
+
+    `o'
+          Print an integer as an unsigned octal number.
+
+    `u'
+          Print an integer as an unsigned decimal number.
+
+    `x', `X'
+          Print an integer as an unsigned hexadecimal number.  `%x'
+          prints using the digits `0123456789abcdef'.  `%X' prints
+          using the digits `0123456789ABCDEF'.
+
+Inexact Conversions
+...................
+
+     *Note:* Inexact conversions are not supported yet.
+
+    `f'
+          Print a floating-point number in fixed-point notation.
+
+    `e', `E'
+          Print a floating-point number in exponential notation.  `%e'
+          prints `e' between mantissa and exponont.  `%E' prints `E'
+          between mantissa and exponont.
+
+    `g', `G'
+          Print a floating-point number in either normal or exponential
+          notation, whichever is more appropriate for its magnitude.
+          `%g' prints `e' between mantissa and exponont.  `%G' prints
+          `E' between mantissa and exponont.
+
+Other Conversions
+.................
+
+    `c'
+          Print a single character.  The `-' flag is the only one which
+          can be specified.  It is an error to specify a precision.
+
+    `s'
+          Print a string.  The `-' flag is the only one which can be
+          specified.  A precision specifies the maximum number of
+          characters to output; otherwise all characters in the string
+          are output.
+
+    `a', `A'
+          Print a scheme expression.  The `-' flag left-justifies the
+          output.  The `#' flag specifies that strings and characters
+          should be quoted as by `write' (which can be read using
+          `read'); otherwise, output is as `display' prints.  A
+          precision specifies the maximum number of characters to
+          output; otherwise as many characters as needed are output.
+
+          *Note:* `%a' and `%A' are SLIB extensions.
+
+    `%'
+          Print a literal `%' character.  No argument is consumed.  It
+          is an error to specifiy flags, field width, precision, or
+          type modifiers with `%%'.
+
+
+File: slib.info,  Node: Standard Formatted Input,  Prev: Standard Formatted Output,  Up: Standard Formatted I/O
+
+Standard Formatted Input
+------------------------
+
+  `(require 'scanf)'
+
+ - Function: scanf-read-list FORMAT
+ - Function: scanf-read-list FORMAT PORT
+ - Function: scanf-read-list FORMAT STRING
+
+ - Macro: scanf FORMAT ARG1 ...
+ - Macro: fscanf PORT FORMAT ARG1 ...
+ - Macro: sscanf STR FORMAT ARG1 ...
+     Each function reads characters, interpreting them according to the
+     control string FORMAT argument.
+
+     `scanf-read-list' returns a list of the items specified as far as
+     the input matches FORMAT.  `scanf', `fscanf', and `sscanf' return
+     the number of items successfully matched and stored.  `scanf',
+     `fscanf', and `sscanf' also set the location corresponding to ARG1
+     ... using the methods:
+
+    symbol
+          `set!'
+
+    car expression
+          `set-car!'
+
+    cdr expression
+          `set-cdr!'
+
+    vector-ref expression
+          `vector-set!'
+
+    substring expression
+          `substring-move-left!'
+
+     The argument to a `substring' expression in ARG1 ... must be a
+     non-constant string.  Characters will be stored starting at the
+     position specified by the second argument to `substring'.  The
+     number of characters stored will be limited by either the position
+     specified by the third argument to `substring' or the length of the
+     matched string, whichever is less.
+
+     The control string, FORMAT, contains conversion specifications and
+     other characters used to direct interpretation of input sequences.
+     The control string contains:
+
+        * White-space characters (blanks, tabs, newlines, or formfeeds)
+          that cause input to be read (and discarded) up to the next
+          non-white-space character.
+
+        * An ordinary character (not `%') that must match the next
+          character of the input stream.
+
+        * Conversion specifications, consisting of the character `%', an
+          optional assignment suppressing character `*', an optional
+          numerical maximum-field width, an optional `l', `h' or `L'
+          which is ignored, and a conversion code.
+
+     Unless the specification contains the `n' conversion character
+     (described below), a conversion specification directs the
+     conversion of the next input field.  The result of a conversion
+     specification is returned in the position of the corresponding
+     argument points, unless `*' indicates assignment suppression.
+     Assignment suppression provides a way to describe an input field
+     to be skipped.  An input field is defined as a string of
+     characters; it extends to the next inappropriate character or
+     until the field width, if specified, is exhausted.
+
+          *Note:* This specification of format strings differs from the
+          `ANSI C' and `POSIX' specifications.  In SLIB, white space
+          before an input field is not skipped unless white space
+          appears before the conversion specification in the format
+          string.  In order to write format strings which work
+          identically with `ANSI C' and SLIB, prepend whitespace to all
+          conversion specifications except `[' and `c'.
+
+     The conversion code indicates the interpretation of the input
+     field; For a suppressed field, no value is returned.  The
+     following conversion codes are legal:
+
+    `%'
+          A single % is expected in the input at this point; no value
+          is returned.
+
+    `d', `D'
+          A decimal integer is expected.
+
+    `u', `U'
+          An unsigned decimal integer is expected.
+
+    `o', `O'
+          An octal integer is expected.
+
+    `x', `X'
+          A hexadecimal integer is expected.
+
+    `i'
+          An integer is expected.  Returns the value of the next input
+          item, interpreted according to C conventions; a leading `0'
+          implies octal, a leading `0x' implies hexadecimal; otherwise,
+          decimal is assumed.
+
+    `n'
+          Returns the total number of bytes (including white space)
+          read by `scanf'.  No input is consumed by `%n'.
+
+    `f', `F', `e', `E', `g', `G'
+          A floating-point number is expected.  The input format for
+          floating-point numbers is an optionally signed string of
+          digits, possibly containing a radix character `.', followed
+          by an optional exponent field consisting of an `E' or an `e',
+          followed by an optional `+', `-', or space, followed by an
+          integer.
+
+    `c', `C'
+          WIDTH characters are expected.  The normal
+          skip-over-white-space is suppressed in this case; to read the
+          next non-space character, use `%1s'.  If a field width is
+          given, a string is returned; up to the indicated number of
+          characters is read.
+
+    `s', `S'
+          A character string is expected The input field is terminated
+          by a white-space character.  `scanf' cannot read a null
+          string.
+
+    `['
+          Indicates string data and the normal
+          skip-over-leading-white-space is suppressed.  The left
+          bracket is followed by a set of characters, called the
+          scanset, and a right bracket; the input field is the maximal
+          sequence of input characters consisting entirely of
+          characters in the scanset.  `^', when it appears as the first
+          character in the scanset, serves as a complement operator and
+          redefines the scanset as the set of all characters not
+          contained in the remainder of the scanset string.
+          Construction of the scanset follows certain conventions.  A
+          range of characters may be represented by the construct
+          first-last, enabling `[0123456789]' to be expressed `[0-9]'.
+          Using this convention, first must be lexically less than or
+          equal to last; otherwise, the dash stands for itself.  The
+          dash also stands for itself when it is the first or the last
+          character in the scanset.  To include the right square
+          bracket as an element of the scanset, it must appear as the
+          first character (possibly preceded by a `^') of the scanset,
+          in which case it will not be interpreted syntactically as the
+          closing bracket.  At least one character must match for this
+          conversion to succeed.
+
+     The `scanf' functions terminate their conversions at end-of-file,
+     at the end of the control string, or when an input character
+     conflicts with the control string.  In the latter case, the
+     offending character is left unread in the input stream.
+
+
+File: slib.info,  Node: String-Case,  Next: String Ports,  Prev: Standard Formatted I/O,  Up: Procedures
+
+String-Case
+===========
+
+  `(require 'string-case)'
+
+ - Procedure: string-upcase STR
+ - Procedure: string-downcase STR
+ - Procedure: string-capitalize STR
+     The obvious string conversion routines.  These are non-destructive.
+
+ - Function: string-upcase! STR
+ - Function: string-downcase! STR
+ - Function: string-captialize! STR
+     The destructive versions of the functions above.
+
+
+File: slib.info,  Node: String Ports,  Next: String Search,  Prev: String-Case,  Up: Procedures
+
+String Ports
+============
+
+  `(require 'string-port)'
+
+ - Procedure: call-with-output-string PROC
+     PROC must be a procedure of one argument.  This procedure calls
+     PROC with one argument: a (newly created) output port.  When the
+     function returns, the string composed of the characters written
+     into the port is returned.
+
+ - Procedure: call-with-input-string STRING PROC
+     PROC must be a procedure of one argument.  This procedure calls
+     PROC with one argument: an (newly created) input port from which
+     STRING's contents may be read.  When PROC returns, the port is
+     closed and the value yielded by the procedure PROC is returned.
+
+
+File: slib.info,  Node: String Search,  Next: Tektronix Graphics Support,  Prev: String Ports,  Up: Procedures
+
+String Search
+=============
+
+  `(require 'string-search)'
+
+ - Procedure: string-index STRING CHAR
+     Returns the index of the first occurence of CHAR within STRING, or
+     `#f' if the STRING does not contain a character CHAR.
+
+ - procedure: substring? PATTERN STRING
+     Searches STRING to see if some substring of STRING is equal to
+     PATTERN.  `substring?' returns the index of the first character of
+     the first substring of STRING that is equal to PATTERN; or `#f' if
+     STRING does not contain PATTERN.
+
+          (substring? "rat" "pirate") =>  2
+          (substring? "rat" "outrage") =>  #f
+          (substring? "" any-string) =>  0
+
+ - Procedure: find-string-from-port? STR IN-PORT MAX-NO-CHARS
+ - Procedure: find-string-from-port? STR IN-PORT
+     Looks for a string STR within the first MAX-NO-CHARS chars of the
+     input port IN-PORT.  MAX-NO-CHARS may be omitted: in that case,
+     the search span is limited by the end of the input stream.  When
+     the STR is found, the function returns the number of characters it
+     has read from the port, and the port is set to read the first char
+     after that (that is, after the STR) The function returns `#f' when
+     the STR isn't found.
+
+     `find-string-from-port?' reads the port *strictly* sequentially,
+     and does not perform any buffering.  So `find-string-from-port?'
+     can be used even if the IN-PORT is open to a pipe or other
+     communication channel.
+
+
+File: slib.info,  Node: Tektronix Graphics Support,  Next: Tree Operations,  Prev: String Search,  Up: Procedures
+
+Tektronix Graphics Support
+==========================
+
+  *Note:* The Tektronix graphics support files need more work, and are
+not complete.
+
+Tektronix 4000 Series Graphics
+------------------------------
+
+  The Tektronix 4000 series graphics protocol gives the user a 1024 by
+1024 square drawing area.  The origin is in the lower left corner of the
+screen.  Increasing y is up and increasing x is to the right.
+
+  The graphics control codes are sent over the current-output-port and
+can be mixed with regular text and ANSI or other terminal control
+sequences.
+
+ - Procedure: tek40:init
+
+ - Procedure: tek40:graphics
+
+ - Procedure: tek40:text
+
+ - Procedure: tek40:linetype LINETYPE
+
+ - Procedure: tek40:move X Y
+
+ - Procedure: tek40:draw X Y
+
+ - Procedure: tek40:put-text X Y STR
+
+ - Procedure: tek40:reset
+
+Tektronix 4100 Series Graphics
+------------------------------
+
+  The graphics control codes are sent over the current-output-port and
+can be mixed with regular text and ANSI or other terminal control
+sequences.
+
+ - Procedure: tek41:init
+
+ - Procedure: tek41:reset
+
+ - Procedure: tek41:graphics
+
+ - Procedure: tek41:move X Y
+
+ - Procedure: tek41:draw X Y
+
+ - Procedure: tek41:point X Y NUMBER
+
+ - Procedure: tek41:encode-x-y X Y
+
+ - Procedure: tek41:encode-int NUMBER
+
+
+File: slib.info,  Node: Tree Operations,  Prev: Tektronix Graphics Support,  Up: Procedures
+
+Tree operations
+===============
+
+  `(require 'tree)'
+
+  These are operations that treat lists a representations of trees.
+
+ - Function: subst NEW OLD TREE
+ - Function: substq NEW OLD TREE
+ - Function: substv NEW OLD TREE
+     `subst' makes a copy of TREE, substituting NEW for every subtree
+     or leaf of TREE which is `equal?' to OLD and returns a modified
+     tree.  The original TREE is unchanged, but may share parts with
+     the result.
+
+     `substq' and `substv' are similar, but test against OLD using
+     `eq?' and `eqv?' respectively.
+
+     Examples:
+          (substq 'tempest 'hurricane '(shakespeare wrote (the hurricane)))
+             => (shakespeare wrote (the tempest))
+          (substq 'foo '() '(shakespeare wrote (twelfth night)))
+             => (shakespeare wrote (twelfth night . foo) . foo)
+          (subst '(a . cons) '(old . pair)
+                 '((old . spice) ((old . shoes) old . pair) (old . pair)))
+             => ((old . spice) ((old . shoes) a . cons) (a . cons))
+
+ - Function: copy-tree TREE
+     Makes a copy of the nested list structure TREE using new pairs and
+     returns it.  All levels are copied, so that none of the pairs in
+     the tree are `eq?' to the original ones - only the leaves are.
+
+     Example:
+          (define bar '(bar))
+          (copy-tree (list bar 'foo))
+             => ((bar) foo)
+          (eq? bar (car (copy-tree (list bar 'foo))))
+             => #f
+
+
+File: slib.info,  Node: Standards Support,  Next: Session Support,  Prev: Procedures,  Up: Top
+
+Standards Support
+*****************
+
+* Menu:
+
+* With-File::                   'with-file
+* Transcripts::                 'transcript
+* Rev2 Procedures::             'rev2-procedures
+* Rev4 Optional Procedures::    'rev4-optional-procedures
+* Multi-argument / and -::      'multiarg/and-
+* Multi-argument Apply::        'multiarg-apply
+* Rationalize::                 'rationalize
+* Promises::                    'promise
+* Dynamic-Wind::                'dynamic-wind
+* Values::                      'values
+* Time::                        'time
+* CLTime::                      'common-lisp-time
+
+
+File: slib.info,  Node: With-File,  Next: Transcripts,  Prev: Standards Support,  Up: Standards Support
+
+With-File
+=========
+
+  `(require 'with-file)'
+
+ - Function: with-input-from-file FILE THUNK
+ - Function: with-output-to-file FILE THUNK
+     Description found in R4RS.
+
+
+File: slib.info,  Node: Transcripts,  Next: Rev2 Procedures,  Prev: With-File,  Up: Standards Support
+
+Transcripts
+===========
+
+  `(require 'transcript)'
+
+ - Function: transcript-on FILENAME
+ - Function: transcript-off FILENAME
+     Redefines `read-char', `read', `write-char', `write', `display',
+     and `newline'.
+
+
+File: slib.info,  Node: Rev2 Procedures,  Next: Rev4 Optional Procedures,  Prev: Transcripts,  Up: Standards Support
+
+Rev2 Procedures
+===============
+
+  `(require 'rev2-procedures)'
+
+  The procedures below were specified in the `Revised^2 Report on
+Scheme'.  *N.B.*: The symbols `1+' and `-1+' are not `R4RS' syntax.
+Scheme->C, for instance, barfs on this module.
+
+ - Procedure: substring-move-left! STRING1 START1 END1 STRING2 START2
+ - Procedure: substring-move-right! STRING1 START1 END1 STRING2 START2
+     STRING1 and STRING2 must be a strings, and START1, START2 and END1
+     must be exact integers satisfying
+
+          0 <= START1 <= END1 <= (string-length STRING1)
+          0 <= START2 <= END1 - START1 + START2 <= (string-length STRING2)
+
+     `substring-move-left!' and `substring-move-right!' store
+     characters of STRING1 beginning with index START1 (inclusive) and
+     ending with index END1 (exclusive) into STRING2 beginning with
+     index START2 (inclusive).
+
+     `substring-move-left!' stores characters in time order of
+     increasing indices.  `substring-move-right!' stores characters in
+     time order of increasing indeces.
+
+ - Procedure: substring-fill! STRING START END CHAR
+     Fills the elements START-END of STRING with the character CHAR.
+
+ - Function: string-null? STR
+     == `(= 0 (string-length STR))'
+
+ - Procedure: append! . PAIRS
+     Destructively appends its arguments.  Equivalent to `nconc'.
+
+ - Function: 1+ N
+     Adds 1 to N.
+
+ - Function: -1+ N
+     Subtracts 1 from N.
+
+ - Function: <?
+ - Function: <=?
+ - Function: =?
+ - Function: >?
+ - Function: >=?
+     These are equivalent to the procedures of the same name but
+     without the trailing `?'.
+
+
+File: slib.info,  Node: Rev4 Optional Procedures,  Next: Multi-argument / and -,  Prev: Rev2 Procedures,  Up: Standards Support
+
+Rev4 Optional Procedures
+========================
+
+  `(require 'rev4-optional-procedures)'
+
+  For the specification of these optional procedures, *Note Standard
+procedures: (r4rs)Standard procedures.
+
+ - Function: list-tail L P
+
+ - Function: string->list S
+
+ - Function: list->string L
+
+ - Function: string-copy
+
+ - Procedure: string-fill! S OBJ
+
+ - Function: list->vector L
+
+ - Function: vector->list S
+
+ - Procedure: vector-fill! S OBJ
+
+
+File: slib.info,  Node: Multi-argument / and -,  Next: Multi-argument Apply,  Prev: Rev4 Optional Procedures,  Up: Standards Support
+
+Multi-argument / and -
+======================
+
+  `(require 'mutliarg/and-)'
+
+  For the specification of these optional forms, *Note Numerical
+operations: (r4rs)Numerical operations.  The `two-arg:'* forms are only
+defined if the implementation does not support the many-argument forms.
+
+ - Function: two-arg:/ N1 N2
+     The original two-argument version of `/'.
+
+ - Function: / DIVIDENT . DIVISORS
+
+ - Function: two-arg:- N1 N2
+     The original two-argument version of `-'.
+
+ - Function: - MINUEND . SUBTRAHENDS
+
+
+File: slib.info,  Node: Multi-argument Apply,  Next: Rationalize,  Prev: Multi-argument / and -,  Up: Standards Support
+
+Multi-argument Apply
+====================
+
+  `(require 'multiarg-apply)'
+
+For the specification of this optional form, *Note Control features:
+(r4rs)Control features.
+
+ - Function: two-arg:apply PROC L
+     The implementation's native `apply'.  Only defined for
+     implementations which don't support the many-argument version.
+
+ - Function: apply PROC . ARGS
+
+
+File: slib.info,  Node: Rationalize,  Next: Promises,  Prev: Multi-argument Apply,  Up: Standards Support
+
+Rationalize
+===========
+
+  `(require 'rationalize)'
+
+  The procedure rationalize is interesting because most programming
+languages do not provide anything analogous to it.  For simplicity, we
+present an algorithm which computes the correct result for exact
+arguments (provided the implementation supports exact rational numbers
+of unlimited precision), and produces a reasonable answer for inexact
+arguments when inexact arithmetic is implemented using floating-point.
+We thank Alan Bawden for contributing this algorithm.
+
+ - Function: rationalize X E
+
+
+File: slib.info,  Node: Promises,  Next: Dynamic-Wind,  Prev: Rationalize,  Up: Standards Support
+
+Promises
+========
+
+  `(require 'promise)'
+
+ - Function: make-promise PROC
+
+  Change occurrences of `(delay EXPRESSION)' to `(make-promise (lambda
+() EXPRESSION))' and `(define force promise:force)' to implement
+promises if your implementation doesn't support them (*note Control
+features: (r4rs)Control features.).
+
+
+File: slib.info,  Node: Dynamic-Wind,  Next: Values,  Prev: Promises,  Up: Standards Support
+
+Dynamic-Wind
+============
+
+  `(require 'dynamic-wind)'
+
+  This facility is a generalization of Common LISP `unwind-protect',
+designed to take into account the fact that continuations produced by
+`call-with-current-continuation' may be reentered.
+
+ - Procedure: dynamic-wind THUNK1 THUNK2 THUNK3
+     The arguments THUNK1, THUNK2, and THUNK3 must all be procedures of
+     no arguments (thunks).
+
+     `dynamic-wind' calls THUNK1, THUNK2, and then THUNK3.  The value
+     returned by THUNK2 is returned as the result of `dynamic-wind'.
+     THUNK3 is also called just before control leaves the dynamic
+     context of THUNK2 by calling a continuation created outside that
+     context.  Furthermore, THUNK1 is called before reentering the
+     dynamic context of THUNK2 by calling a continuation created inside
+     that context.  (Control is inside the context of THUNK2 if THUNK2
+     is on the current return stack).
+
+     *Warning:* There is no provision for dealing with errors or
+     interrupts.  If an error or interrupt occurs while using
+     `dynamic-wind', the dynamic environment will be that in effect at
+     the time of the error or interrupt.
+
+
+File: slib.info,  Node: Values,  Next: Time,  Prev: Dynamic-Wind,  Up: Standards Support
+
+Values
+======
+
+  `(require 'values)'
+
+ - Function: values OBJ ...
+     `values' takes any number of arguments, and passes (returns) them
+     to its continuation.
+
+ - Function: call-with-values THUNK PROC
+     THUNK must be a procedure of no arguments, and PROC must be a
+     procedure.  `call-with-values' calls THUNK with a continuation
+     that, when passed some values, calls PROC with those values as
+     arguments.
+
+     Except for continuations created by the `call-with-values'
+     procedure, all continuations take exactly one value, as now; the
+     effect of passing no value or more than one value to continuations
+     that were not created by the `call-with-values' procedure is
+     unspecified.
+
+
+File: slib.info,  Node: Time,  Next: CLTime,  Prev: Values,  Up: Standards Support
+
+Time
+====
+
+  The procedures `current-time', `difftime', and `offset-time' are
+supported by all implementations (SLIB provides them if feature
+`('current-time)' is missing.  `current-time' returns a "calendar time"
+(caltime) which can be a number or other type.
+
+ - Function: current-time
+     Returns the time since 00:00:00 GMT, January 1, 1970, measured in
+     seconds.  Note that the reference time is different from the
+     reference time for `get-universal-time' in *Note CLTime::.  On
+     implementations which cannot support actual times, `current-time'
+     will increment a counter and return its value when called.
+
+ - Function: difftime CALTIME1 CALTIME0
+     Returns the difference (number of seconds) between twe calendar
+     times: CALTIME1 - CALTIME0.  CALTIME0 can also be a number.
+
+ - Function: offset-time CALTIME OFFSET
+     Returns the calendar time of CALTIME offset by OFFSET number of
+     seconds `(+ caltime offset)'.
+
+     (require 'posix-time)
+
+  These procedures are intended to be compatible with Posix time
+conversion functions.
+
+ - Variable: *timezone*
+     contains the difference, in seconds, between UTC and local
+     standard time (for example, in the U.S.  Eastern time zone (EST),
+     timezone is 5*60*60).  `*timezone*' is initialized by `tzset'.
+
+ - Function: tzset
+     initializes the *TIMEZONE* variable from the TZ environment
+     variable.  This function is automatically called by the other time
+     conversion functions that depend on the time zone.
+
+ - Function: gmtime CALTIME
+     converts the calendar time CALTIME to a vector of integers
+     representing the time expressed as Coordinated Universal Time
+     (UTC).
+
+ - Function: localtime CALTIME
+     converts the calendar time CALTIME to a vector of integers
+     expressed relative to the user's time zone.  `localtime' sets the
+     variable *TIMEZONE* with the difference between Coordinated
+     Universal Time (UTC) and local standard time in seconds by calling
+     `tzset'.  The elements of the returned vector are as follows:
+
+       0.  seconds (0 - 61)
+
+       1.  minutes (0 - 59)
+
+       2.  hours since midnight
+
+       3.  day of month
+
+       4.  month (0 - 11).  Note difference from
+          `decode-universal-time'.
+
+       5.  year (A.D.)
+
+       6.  day of week (0 - 6)
+
+       7.  day of year (0 - 365)
+
+       8.  1 for daylight savings, 0 for regular time
+
+ - Function: mktime UNIVTIME
+     Converts a vector of integers in Coordinated Universal Time (UTC)
+     format to calendar time (caltime) format.
+
+ - Function: asctime UNIVTIME
+     Converts the vector of integers CALTIME in Coordinated Universal
+     Time (UTC) format into a string of the form `"Wed Jun 30 21:49:08
+     1993"'.
+
+ - Function: ctime CALTIME
+     Equivalent to `(time:asctime (time:localtime CALTIME))'.
+
+
+File: slib.info,  Node: CLTime,  Prev: Time,  Up: Standards Support
+
+CLTime
+======
+
+ - Function: get-decoded-time
+     Equivalent to `(decode-universal-time (get-universal-time))'.
+
+ - Function: get-universal-time
+     Returns the current time as "Universal Time", number of seconds
+     since 00:00:00 Jan 1, 1900 GMT.  Note that the reference time is
+     different from `current-time'.
+
+ - Function: decode-universal-time UNIVTIME
+     Converts UNIVTIME to "Decoded Time" format.  Nine values are
+     returned:
+       0.  seconds (0 - 61)
+
+       1.  minutes (0 - 59)
+
+       2.  hours since midnight
+
+       3.  day of month
+
+       4.  month (1 - 12).  Note difference from `gmtime' and
+          `localtime'.
+
+       5.  year (A.D.)
+
+       6.  day of week (0 - 6)
+
+       7.  #t for daylight savings, #f otherwise
+
+       8.  hours west of GMT (-24 - +24)
+
+     Notice that the values returned by `decode-universal-time' do not
+     match the arguments to `encode-universal-time'.
+
+ - Function: encode-universal-time SECOND MINUTE HOUR DATE MONTH YEAR
+ - Function: encode-universal-time SECOND MINUTE HOUR DATE MONTH YEAR
+          TIME-ZONE
+     Converts the arguments in Decoded Time format to Universal Time
+     format.  If TIME-ZONE is not specified, the returned time is
+     adjusted for daylight saving time.  Otherwise, no adjustment is
+     performed.
+
+     Notice that the values returned by `decode-universal-time' do not
+     match the arguments to `encode-universal-time'.
+
+
+File: slib.info,  Node: Session Support,  Next: Optional SLIB Packages,  Prev: Standards Support,  Up: Top
+
+Session Support
+***************
+
+* Menu:
+
+* Repl::                        Macros at top-level
+* Quick Print::                 Loop-safe Output
+* Debug::                       To err is human ...
+* Breakpoints::                 Pause execution
+* Trace::                       'trace
+* Getopt::                      Command Line option parsing
+* Command Line::                A command line reader for Scheme shells
+* System Interface::            'system and 'getenv
+
+Certain features are so simple, system-dependent, or widely subcribed
+that they are supported by all implementations as part of the
+`*.init' files.
+
+The features described in the following sections are provided by all
+implementations.
+
+* Require::                     Module Management
+* Vicinity::                    Pathname Management
+* Configuration::               Characteristics of Scheme Implementation
+* Input/Output::                Things not provided by the Scheme specs.
+* Legacy::
+* System::                      LOADing, EVALing, ERRORing, and EXITing
+
+
+File: slib.info,  Node: Repl,  Next: Quick Print,  Prev: Session Support,  Up: Session Support
+
+Repl
+====
+
+  `(require 'repl)'
+
+  Here is a read-eval-print-loop which, given an eval, evaluates forms.
+
+ - Procedure: repl:top-level REPL:EVAL
+     `read's, `repl:eval's and `write's expressions from
+     `(current-input-port)' to `(current-output-port)' until an
+     end-of-file is encountered.  `load', `slib:eval', `slib:error',
+     and `repl:quit' dynamically bound during `repl:top-level'.
+
+ - Procedure: repl:quit
+     Exits from the invocation of `repl:top-level'.
+
+  The `repl:' procedures establish, as much as is possible to do
+portably, a top level environment supporting macros.  `repl:top-level'
+uses `dynamic-wind' to catch error conditions and interrupts.  If your
+implementation supports this you are all set.
+
+  Otherwise, if there is some way your implementation can catch error
+conditions and interrupts, then have them call `slib:error'.  It will
+display its arguments and reenter `repl:top-level'.  `slib:error'
+dynamically bound by `repl:top-level'.
+
+  To have your top level loop always use macros, add any interrupt
+catching lines and the following lines to your Scheme init file:
+     (require 'macro)
+     (require 'repl)
+     (repl:top-level macro:eval)
+
+
+File: slib.info,  Node: Quick Print,  Next: Debug,  Prev: Repl,  Up: Session Support
+
+Quick Print
+===========
+
+  `(require 'qp)'
+
+When displaying error messages and warnings, it is paramount that the
+output generated for circular lists and large data structures be
+limited.  This section supplies a procedure to do this.  It could be
+much improved.
+
+     Notice that the neccessity for truncating output eliminates
+     Common-Lisp's *Note Format:: from consideration; even when
+     variables `*print-level*' and `*print-level*' are set, huge
+     strings and bit-vectors are *not* limited.
+
+ - Procedure: qp ARG1 ...
+ - Procedure: qpn ARG1 ...
+ - Procedure: qpr ARG1 ...
+     `qp' writes its arguments, separated by spaces, to
+     `(current-output-port)'.  `qp' compresses printing by substituting
+     `...' for substructure it does not have sufficient room to print.
+     `qpn' is like `qp' but outputs a newline before returning.  `qpr'
+     is like `qpn' except that it returns its last argument.
+
+ - Variable: *qp-width*
+     `*qp-width*' is the largest number of characters that `qp' should
+     use.
+
+
+File: slib.info,  Node: Debug,  Next: Breakpoints,  Prev: Quick Print,  Up: Session Support
+
+Debug
+=====
+
+  `(require 'debug)'
+
+Requiring `debug' automatically requires `trace' and `break'.
+
+An application with its own datatypes may want to substitute its own
+printer for `qp'.  This example shows how to do this:
+
+     (define qpn (lambda args) ...)
+     (provide 'qp)
+     (require 'debug)
+
+ - Procedure: trace-all FILE
+     Traces (*note Trace::.) all procedures `define'd at top-level in
+     file `file'.
+
+ - Procedure: break-all FILE
+     Breakpoints (*note Breakpoints::.) all procedures `define'd at
+     top-level in file `file'.
+
+
+File: slib.info,  Node: Breakpoints,  Next: Trace,  Prev: Debug,  Up: Session Support
+
+Breakpoints
+===========
+
+  `(require 'break)'
+
+ - Function: init-debug
+     If your Scheme implementation does not support `break' or `abort',
+     a message will appear when you `(require 'break)' or `(require
+     'debug)' telling you to type `(init-debug)'.  This is in order to
+     establish a top-level continuation.  Typing `(init-debug)' at top
+     level sets up a continuation for `break'.
+
+ - Function: breakpoint ARG1 ...
+     Returns from the top level continuation and pushes the
+     continuation from which it was called on a continuation stack.
+
+ - Function: continue
+     Pops the topmost continuation off of the continuation stack and
+     returns an unspecified value to it.
+
+ - Function: continue ARG1 ...
+     Pops the topmost continuation off of the continuation stack and
+     returns ARG1 ... to it.
+
+ - Macro: break PROC1 ...
+     Redefines the top-level named procedures given as arguments so that
+     `breakpoint' is called before calling PROC1 ....
+
+ - Macro: break
+     With no arguments, makes sure that all the currently broken
+     identifiers are broken (even if those identifiers have been
+     redefined) and returns a list of the broken identifiers.
+
+ - Macro: unbreak PROC1 ...
+     Turns breakpoints off for its arguments.
+
+ - Macro: unbreak
+     With no arguments, unbreaks all currently broken identifiers and
+     returns a list of these formerly broken identifiers.
+
+  The following routines are the procedures which actually do the
+tracing when this module is supplied by SLIB, rather than natively.  If
+defmacros are not natively supported by your implementation, these might
+be more convenient to use.
+
+ - Function: breakf PROC
+ - Function: breakf PROC NAME
+ - Function: debug:breakf PROC
+ - Function: debug:breakf PROC NAME
+     To break, type
+          (set! SYMBOL (breakf SYMBOL))
+
+     or
+          (set! SYMBOL (breakf SYMBOL 'SYMBOL))
+
+     or
+          (define SYMBOL (breakf FUNCTION))
+
+     or
+          (define SYMBOL (breakf FUNCTION 'SYMBOL))
+
+ - Function: unbreakf PROC
+ - Function: debug:unbreakf PROC
+     To unbreak, type
+          (set! SYMBOL (unbreakf SYMBOL))
+
+
+File: slib.info,  Node: Trace,  Next: Getopt,  Prev: Breakpoints,  Up: Session Support
+
+Tracing
+=======
+
+  `(require 'trace)'
+
+ - Macro: trace PROC1 ...
+     Traces the top-level named procedures given as arguments.
+
+ - Macro: trace
+     With no arguments, makes sure that all the currently traced
+     identifiers are traced (even if those identifiers have been
+     redefined) and returns a list of the traced identifiers.
+
+ - Macro: untrace PROC1 ...
+     Turns tracing off for its arguments.
+
+ - Macro: untrace
+     With no arguments, untraces all currently traced identifiers and
+     returns a list of these formerly traced identifiers.
+
+  The following routines are the procedures which actually do the
+tracing when this module is supplied by SLIB, rather than natively.  If
+defmacros are not natively supported by your implementation, these might
+be more convenient to use.
+
+ - Function: tracef PROC
+ - Function: tracef PROC NAME
+ - Function: debug:tracef PROC
+ - Function: debug:tracef PROC NAME
+     To trace, type
+          (set! SYMBOL (tracef SYMBOL))
+
+     or
+          (set! SYMBOL (tracef SYMBOL 'SYMBOL))
+
+     or
+          (define SYMBOL (tracef FUNCTION))
+
+     or
+          (define SYMBOL (tracef FUNCTION 'SYMBOL))
+
+ - Function: untracef PROC
+ - Function: debug:untracef PROC
+     To untrace, type
+          (set! SYMBOL (untracef SYMBOL))
+
diff --git a/slib.info-7 b/slib.info-7
new file mode 100644
index 0000000..2ed9fcd
--- /dev/null
+++ b/slib.info-7
@@ -0,0 +1,615 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+File: slib.info,  Node: Getopt,  Next: Command Line,  Prev: Trace,  Up: Session Support
+
+Getopt
+======
+
+  `(require 'getopt)'
+
+  This routine implements Posix command line argument parsing.  Notice
+that returning values through global variables means that `getopt' is
+*not* reentrant.
+
+ - Variable: *optind*
+     Is the index of the current element of the command line.  It is
+     initially one.  In order to parse a new command line or reparse an
+     old one, *OPTING* must be reset.
+
+ - Variable: *optarg*
+     Is set by getopt to the (string) option-argument of the current
+     option.
+
+ - Procedure: getopt ARGC ARGV OPTSTRING
+     Returns the next option letter in ARGV (starting from `(vector-ref
+     argv *optind*)') that matches a letter in OPTSTRING.  ARGV is a
+     vector or list of strings, the 0th of which getopt usually
+     ignores. ARGC is the argument count, usually the length of ARGV.
+     OPTSTRING is a string of recognized option characters; if a
+     character is followed by a colon, the option takes an argument
+     which may be immediately following it in the string or in the next
+     element of ARGV.
+
+     *OPTIND* is the index of the next element of the ARGV vector to be
+     processed.  It is initialized to 1 by `getopt.scm', and `getopt'
+     updates it when it finishes with each element of ARGV.
+
+     `getopt' returns the next option character from ARGV that matches
+     a character in OPTSTRING, if there is one that matches.  If the
+     option takes an argument, `getopt' sets the variable *OPTARG* to
+     the option-argument as follows:
+
+        * If the option was the last character in the string pointed to
+          by an element of ARGV, then *OPTARG* contains the next
+          element of ARGV, and *OPTIND* is incremented by 2.  If the
+          resulting value of *OPTIND* is greater than or equal to ARGC,
+          this indicates a missing option argument, and `getopt'
+          returns an error indication.
+
+        * Otherwise, *OPTARG* is set to the string following the option
+          character in that element of ARGV, and *OPTIND* is
+          incremented by 1.
+
+     If, when `getopt' is called, the string `(vector-ref argv
+     *optind*)' either does not begin with the character `#\-' or is
+     just `"-"', `getopt' returns `#f' without changing *OPTIND*.  If
+     `(vector-ref argv *optind*)' is the string `"--"', `getopt'
+     returns `#f' after incrementing *OPTIND*.
+
+     If `getopt' encounters an option character that is not contained in
+     OPTSTRING, it returns the question-mark `#\?' character.  If it
+     detects a missing option argument, it returns the colon character
+     `#\:' if the first character of OPTSTRING was a colon, or a
+     question-mark character otherwise.  In either case, `getopt' sets
+     the variable GETOPT:OPT to the option character that caused the
+     error.
+
+     The special option `"--"' can be used to delimit the end of the
+     options; `#f' is returned, and `"--"' is skipped.
+
+     RETURN VALUE
+
+     `getopt' returns the next option character specified on the command
+     line.  A colon `#\:' is returned if `getopt' detects a missing
+     argument and the first character of OPTSTRING was a colon `#\:'.
+
+     A question-mark `#\?' is returned if `getopt' encounters an option
+     character not in OPTSTRING or detects a missing argument and the
+     first character of OPTSTRING was not a colon `#\:'.
+
+     Otherwise, `getopt' returns `#f' when all command line options
+     have been parsed.
+
+     Example:
+          #! /usr/local/bin/scm
+          ;;;This code is SCM specific.
+          (define argv (program-arguments))
+          (require 'getopt)
+          
+          (define opts ":a:b:cd")
+          (let loop ((opt (getopt (length argv) argv opts)))
+            (case opt
+              ((#\a) (print "option a: " *optarg*))
+              ((#\b) (print "option b: " *optarg*))
+              ((#\c) (print "option c"))
+              ((#\d) (print "option d"))
+              ((#\?) (print "error" getopt:opt))
+              ((#\:) (print "missing arg" getopt:opt))
+              ((#f) (if (< *optind* (length argv))
+                        (print "argv[" *optind* "]="
+                               (list-ref argv *optind*)))
+                    (set! *optind* (+ *optind* 1))))
+            (if (< *optind* (length argv))
+                (loop (getopt (length argv) argv opts))))
+          
+          (slib:exit)
+
+Getopt-
+=======
+
+ - Function: getopt- ARGC ARGV OPTSTRING
+     The procedure `getopt--' is an extended version of `getopt' which
+     parses "long option names" of the form `--hold-the-onions' and
+     `--verbosity-level=extreme'.  `Getopt--' behaves as `getopt'
+     except for non-empty options beginning with `--'.
+
+     Options beginning with `--' are returned as strings rather than
+     characters.  If a value is assigned (using `=') to a long option,
+     `*optarg*' is set to the value.  The `=' and value are not
+     returned as part of the option string.
+
+     No information is passed to `getopt--' concerning which long
+     options should be accepted or whether such options can take
+     arguments.  If a long option did not have an argument, `*optarg'
+     will be set to `#f'.  The caller is responsible for detecting and
+     reporting errors.
+
+          (define opts ":-:b:")
+          (define argc 5)
+          (define argv '("foo" "-b9" "--f1" "--2=" "--g3=35234.342" "--"))
+          (define *optind* 1)
+          (define *optarg* #f)
+          (require 'qp)
+          (do ((i 5 (+ -1 i)))
+              ((zero? i))
+            (define opt (getopt-- argc argv opts))
+            (print *optind* opt *optarg*)))
+          -|
+          2 #\b "9"
+          3 "f1" #f
+          4 "2" ""
+          5 "g3" "35234.342"
+          5 #f "35234.342"
+
+
+File: slib.info,  Node: Command Line,  Next: System Interface,  Prev: Getopt,  Up: Session Support
+
+Command Line
+============
+
+  `(require 'read-command)'
+
+ - Function: read-command PORT
+ - Function: read-command
+     `read-command' converts a "command line" into a list of strings
+     suitable for parsing by `getopt'.  The syntax of command lines
+     supported resembles that of popular "shell"s.  `read-command'
+     updates PORT to point to the first character past the command
+     delimiter.
+
+     If an end of file is encountered in the input before any
+     characters are found that can begin an object or comment, then an
+     end of file object is returned.
+
+     The PORT argument may be omitted, in which case it defaults to the
+     value returned by `current-input-port'.
+
+     The fields into which the command line is split are delimited by
+     whitespace as defined by `char-whitespace?'.  The end of a command
+     is delimited by end-of-file or unescaped semicolon (;) or newline.
+     Any character can be literally included in a field by escaping it
+     with a backslach (\).
+
+     The initial character and types of fields recognized are:
+    `\'
+          The next character has is taken literally and not interpreted
+          as a field delimiter.  If \ is the last character before a
+          newline, that newline is just ignored.  Processing continues
+          from the characters after the newline as though the backslash
+          and newline were not there.
+
+    `"'
+          The characters up to the next unescaped " are taken literally,
+          according to [R4RS] rules for literal strings (*note Strings:
+          (r4rs)Strings.).
+
+    `(', `%''
+          One scheme expression is `read' starting with this character.
+          The `read' expression is evaluated, converted to a string
+          (using `display'), and replaces the expression in the returned
+          field.
+
+    `;'
+          Semicolon delimits a command.  Using semicolons more than one
+          command can appear on a line.  Escaped semicolons and
+          semicolons inside strings do not delimit commands.
+
+     The comment field differs from the previous fields in that it must
+     be the first character of a command or appear after whitespace in
+     order to be recognized.  # can be part of fields if these
+     conditions are not met.  For instance, `ab#c' is just the field
+     ab#c.
+
+    `#'
+          Introduces a comment.  The comment continues to the end of
+          the line on which the semicolon appears.  Comments are
+          treated as whitespace by `read-dommand-line' and backslashes
+          before newlines in comments are also ignored.
+
+
+File: slib.info,  Node: System Interface,  Next: Require,  Prev: Command Line,  Up: Session Support
+
+System Interface
+================
+
+  If `(provided? 'getenv)':
+
+ - Function: getenv NAME
+     Looks up NAME, a string, in the program environment.  If NAME is
+     found a string of its value is returned.  Otherwise, `#f' is
+     returned.
+
+  If `(provided? 'system)':
+
+ - Function: system COMMAND-STRING
+     Executes the COMMAND-STRING on the computer and returns the
+     integer status code.
+
+
+File: slib.info,  Node: Require,  Next: Vicinity,  Prev: System Interface,  Up: Session Support
+
+Require
+=======
+
+  These variables and procedures are provided by all implementations.
+
+ - Variable: *features*
+     Is a list of symbols denoting features supported in this
+     implementation.
+
+ - Variable: *modules*
+     Is a list of pathnames denoting files which have been loaded.
+
+ - Variable: *catalog*
+     Is an association list of features (symbols) and pathnames which
+     will supply those features.  The pathname can be either a string
+     or a pair.  If pathname is a pair then the first element should be
+     a macro feature symbol, `source', or `compiled'.  The cdr of the
+     pathname should be either a string or a list.
+
+  In the following three functions if FEATURE is not a symbol it is
+assumed to be a pathname.
+
+ - Function: provided? FEATURE
+     Returns `#t' if FEATURE is a member of `*features*' or `*modules*'
+     or if FEATURE is supported by a file already loaded and `#f'
+     otherwise.
+
+ - Procedure: require FEATURE
+     If `(not (provided? FEATURE))' it is loaded if FEATURE is a
+     pathname or if `(assq FEATURE *catalog*)'.  Otherwise an error is
+     signaled.
+
+ - Procedure: provide FEATURE
+     Assures that FEATURE is contained in `*features*' if FEATURE is a
+     symbol and `*modules*' otherwise.
+
+ - Function: require:feature->path FEATURE
+     Returns `#t' if FEATURE is a member of `*features*' or `*modules*'
+     or if FEATURE is supported by a file already loaded.  Returns a
+     path if one was found in `*catalog*' under the feature name, and
+     `#f' otherwise.  The path can either be a string suitable as an
+     argument to load or a pair as described above for *catalog*.
+
+  Below is a list of features that are automatically determined by
+`require'.  For each item, `(provided? 'FEATURE)' will return `#t' if
+that feature is available, and `#f' if not.
+
+   * 'inexact
+
+   * 'rational
+
+   * 'real
+
+   * 'complex
+
+   * 'bignum
+
+
+File: slib.info,  Node: Vicinity,  Next: Configuration,  Prev: Require,  Up: Session Support
+
+Vicinity
+========
+
+  A vicinity is a descriptor for a place in the file system.  Vicinities
+hide from the programmer the concepts of host, volume, directory, and
+version.  Vicinities express only the concept of a file environment
+where a file name can be resolved to a file in a system independent
+manner.  Vicinities can even be used on "flat" file systems (which have
+no directory structure) by having the vicinity express constraints on
+the file name.  On most systems a vicinity would be a string.  All of
+these procedures are file system dependent.
+
+  These procedures are provided by all implementations.
+
+ - Function: make-vicinity FILENAME
+     Returns the vicinity of FILENAME for use by `in-vicinity'.
+
+ - Function: program-vicinity
+     Returns the vicinity of the currently loading Scheme code.  For an
+     interpreter this would be the directory containing source code.
+     For a compiled system (with multiple files) this would be the
+     directory where the object or executable files are.  If no file is
+     currently loading it the result is undefined.  *Warning:*
+     `program-vicinity' can return incorrectl values if your program
+     escapes back into a `load'.
+
+ - Function: library-vicinity
+     Returns the vicinity of the shared Scheme library.
+
+ - Function: implementation-vicinity
+     Returns the vicinity of the underlying Scheme implementation.  This
+     vicinity will likely contain startup code and messages and a
+     compiler.
+
+ - Function: user-vicinity
+     Returns the vicinity of the current directory of the user.  On most
+     systems this is `""' (the empty string).
+
+ - Function: in-vicinity VICINITY FILENAME
+     Returns a filename suitable for use by `slib:load',
+     `slib:load-source', `slib:load-compiled', `open-input-file',
+     `open-output-file', etc.  The returned filename is FILENAME in
+     VICINITY.  `in-vicinity' should allow FILENAME to override
+     VICINITY when FILENAME is an absolute pathname and VICINITY is
+     equal to the value of `(user-vicinity)'.  The behavior of
+     `in-vicinity' when FILENAME is absolute and VICINITY is not equal
+     to the value of `(user-vicinity)' is unspecified.  For most systems
+     `in-vicinity' can be `string-append'.
+
+ - Function: sub-vicinity VICINITY NAME
+     Returns the vicinity of VICINITY restricted to NAME.  This is used
+     for large systems where names of files in subsystems could
+     conflict.  On systems with directory structure `sub-vicinity' will
+     return a pathname of the subdirectory NAME of VICINITY.
+
+
+File: slib.info,  Node: Configuration,  Next: Input/Output,  Prev: Vicinity,  Up: Session Support
+
+Configuration
+=============
+
+  These constants and procedures describe characteristics of the Scheme
+and underlying operating system.  They are provided by all
+implementations.
+
+ - Constant: char-code-limit
+     An integer 1 larger that the largest value which can be returned by
+     `char->integer'.
+
+ - Constant: most-positive-fixnum
+     The immediate integer closest to positive infinity.
+
+ - Constant: slib:tab
+     The tab character.
+
+ - Constant: slib:form-feed
+     The form-feed character.
+
+ - Function: software-type
+     Returns a symbol denoting the generic operating system type.  For
+     instance, `unix', `vms', `macos', `amiga', or `ms-dos'.
+
+ - Function: slib:report-version
+     Displays the versions of SLIB and the underlying Scheme
+     implementation and the name of the operating system.  An
+     unspecified value is returned.
+
+          (slib:report-version) => slib "2a3" on scm "4e1" on unix
+
+ - Function: slib:report
+     Displays the information of `(slib:report-version)' followed by
+     almost all the information neccessary for submitting a problem
+     report.  An unspecified value is returned.
+
+ - Function: slib:report #T
+     provides a more verbose listing.
+
+ - Function: slib:report FILENAME
+     Writes the report to file `filename'.
+
+          (slib:report)
+          =>
+          slib "2a3" on scm "4e1" on unix
+          (implementation-vicinity) is "/usr/local/src/scm/"
+          (library-vicinity) is "/usr/local/lib/slib/"
+          (scheme-file-suffix) is ".scm"
+          implementation *features* :
+                  bignum complex real rational
+                  inexact vicinity ed getenv
+                  tmpnam system abort transcript
+                  with-file ieee-p1178 rev4-report rev4-optional-procedures
+                  hash object-hash delay eval
+                  dynamic-wind multiarg-apply multiarg/and- logical
+                  defmacro string-port source array-for-each
+                  array full-continuation char-ready? line-i/o
+                  i/o-extensions pipe
+          implementation *catalog* :
+                  (rev4-optional-procedures . "/usr/local/lib/slib/sc4opt")
+                  ...
+
+
+File: slib.info,  Node: Input/Output,  Next: Legacy,  Prev: Configuration,  Up: Session Support
+
+Input/Output
+============
+
+  These procedures are provided by all implementations.
+
+ - Procedure: file-exists? FILENAME
+     Returns `#t' if the specified file exists.  Otherwise, returns
+     `#f'.  If the underlying implementation does not support this
+     feature then `#f' is always returned.
+
+ - Procedure: delete-file FILENAME
+     Deletes the file specified by FILENAME.  If FILENAME can not be
+     deleted, `#f' is returned.  Otherwise, `#t' is returned.
+
+ - Procedure: tmpnam
+     Returns a pathname for a file which will likely not be used by any
+     other process.  Successive calls to `(tmpnam)' will return
+     different pathnames.
+
+ - Procedure: current-error-port
+     Returns the current port to which diagnostic and error output is
+     directed.
+
+ - Procedure: force-output
+ - Procedure: force-output PORT
+     Forces any pending output on PORT to be delivered to the output
+     device and returns an unspecified value.  The PORT argument may be
+     omitted, in which case it defaults to the value returned by
+     `(current-output-port)'.
+
+ - Procedure: output-port-width
+ - Procedure: output-port-width PORT
+     Returns the width of PORT, which defaults to
+     `(current-output-port)' if absent.  If the width cannot be
+     determined 79 is returned.
+
+ - Procedure: output-port-height
+ - Procedure: output-port-height PORT
+     Returns the height of PORT, which defaults to
+     `(current-output-port)' if absent.  If the height cannot be
+     determined 24 is returned.
+
+
+File: slib.info,  Node: Legacy,  Next: System,  Prev: Input/Output,  Up: Session Support
+
+Legacy
+======
+
+ - Function: identity X
+     IDENTITY returns its argument.
+
+     Example:
+          (identity 3)
+             => 3
+          (identity '(foo bar))
+             => (foo bar)
+          (map identity LST)
+             == (copy-list LST)
+
+  These were present in Scheme until R4RS (*note Language changes:
+(r4rs)Notes.).
+
+ - Constant: t
+     Derfined as `#t'.
+
+ - Constant: nil
+     Defined as `#f'.
+
+ - Function: last-pair L
+     Returns the last pair in the list L.  Example:
+          (last-pair (cons 1 2))
+             => (1 . 2)
+          (last-pair '(1 2))
+             => (2)
+              == (cons 2 '())
+
+
+File: slib.info,  Node: System,  Prev: Legacy,  Up: Session Support
+
+System
+======
+
+  These procedures are provided by all implementations.
+
+ - Procedure: slib:load-source NAME
+     Loads a file of Scheme source code from NAME with the default
+     filename extension used in SLIB.  For instance if the filename
+     extension used in SLIB is `.scm' then `(slib:load-source "foo")'
+     will load from file `foo.scm'.
+
+ - Procedure: slib:load-compiled NAME
+     On implementations which support separtely loadable compiled
+     modules, loads a file of compiled code from NAME with the
+     implementation's filename extension for compiled code appended.
+
+ - Procedure: slib:load NAME
+     Loads a file of Scheme source or compiled code from NAME with the
+     appropriate suffixes appended.  If both source and compiled code
+     are present with the appropriate names then the implementation
+     will load just one.  It is up to the implementation to choose
+     which one will be loaded.
+
+     If an implementation does not support compiled code then
+     `slib:load' will be identical to `slib:load-source'.
+
+ - Procedure: slib:eval OBJ
+     `eval' returns the value of OBJ evaluated in the current top level
+     environment.
+
+ - Procedure: slib:eval-load FILENAME EVAL
+     FILENAME should be a string.  If filename names an existing file,
+     the Scheme source code expressions and definitions are read from
+     the file and EVAL called with them sequentially.  The
+     `slib:eval-load' procedure does not affect the values returned by
+     `current-input-port' and `current-output-port'.
+
+ - Procedure: slib:error ARG1 ARG2 ...
+     Outputs an error message containing the arguments, aborts
+     evaluation of the current form and responds in a system dependent
+     way to the error.  Typical responses are to abort the program or
+     to enter a read-eval-print loop.
+
+ - Procedure: slib:exit N
+ - Procedure: slib:exit
+     Exits from the Scheme session returning status N to the system.
+     If N is omitted or `#t', a success status is returned to the
+     system (if possible).  If N is `#f' a failure is returned to the
+     system (if possible).  If N is an integer, then N is returned to
+     the system (if possible).  If the Scheme session cannot exit an
+     unspecified value is returned from `slib:exit'.
+
+
+File: slib.info,  Node: Optional SLIB Packages,  Next: Procedure and Macro Index,  Prev: Session Support,  Up: Top
+
+Optional SLIB Packages
+**********************
+
+  Several Scheme packages have been written using SLIB.  There are
+several reasons why a package might not be included in the SLIB
+distribution:
+   * Because it requires special hardware or software which is not
+     universal.
+
+   * Because it is large and of limited interest to most Scheme users.
+
+   * Because it has copying terms different enough from the other SLIB
+     packages that its inclusion would cause confusion.
+
+   * Because it is an application program, rather than a library module.
+
+   * Because I have been too busy to integrate it.
+
+  Once an optional package is installed (and an entry added to
+`*catalog*', the `require' mechanism allows it to be called up and used
+as easily as any other SLIB package.  Some optional packages (for which
+`*catalog*' already has entries) available from SLIB sites are:
+
+SLIB-PSD is a portable debugger for Scheme (requires emacs editor).
+          ftp-swiss.ai.mit.edu:pub/scm/slib-psd1-3.tar.gz
+          prep.ai.mit.edu:pub/gnu/jacal/slib-psd1-3.tar.gz
+          ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz
+          ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz
+
+     With PSD, you can run a Scheme program in an Emacs buffer, set
+     breakpoints, single step evaluation and access and modify the
+     program's variables. It works by instrumenting the original source
+     code, so it should run with any R4RS compliant Scheme. It has been
+     tested with SCM, Elk 1.5, and the sci interpreter in the Scheme->C
+     system, but should work with other Schemes with a minimal amount
+     of porting, if at all. Includes documentation and user's manual.
+     Written by Pertti Kellom\"aki, pk@cs.tut.fi.  The Lisp Pointers
+     article describing PSD (Lisp Pointers VI(1):15-23, January-March
+     1993) is available as
+          http://www.cs.tut.fi/staff/pk/scheme/psd/article/article.html
+
+SLIB-SCHELOG is an embedding of Prolog in Scheme.
+          ftp-swiss.ai.mit.edu:pub/scm/slib-schelog.tar.gz
+          prep.ai.mit.edu:pub/gnu/jacal/slib-schelog.tar.gz
+          ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-schelog.tar.gz
+          ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-schelog.tar.gz
+
diff --git a/slib.info-8 b/slib.info-8
new file mode 100644
index 0000000..670e9c1
--- /dev/null
+++ b/slib.info-8
@@ -0,0 +1,570 @@
+This is Info file slib.info, produced by Makeinfo-1.64 from the input
+file slib.texi.
+
+  This file documents SLIB, the portable Scheme library.
+
+  Copyright (C) 1993 Todd R. Eigenschink Copyright (C) 1993, 1994, 1995
+Aubrey Jaffer
+
+  Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+  Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+  Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be stated in a
+translation approved by the author.
+
+
+File: slib.info,  Node: Procedure and Macro Index,  Next: Variable Index,  Prev: Optional SLIB Packages,  Up: Top
+
+Procedure and Macro Index
+*************************
+
+  This is an alphabetical list of all the procedures and macros in SLIB.
+
+* Menu:
+
+* -:                                    Multi-argument / and -.
+* -1+:                                  Rev2 Procedures.
+* /:                                    Multi-argument / and -.
+* 1+:                                   Rev2 Procedures.
+* <=?:                                  Rev2 Procedures.
+* <?:                                   Rev2 Procedures.
+* =?:                                   Rev2 Procedures.
+* >=?:                                  Rev2 Procedures.
+* >?:                                   Rev2 Procedures.
+* TAG:                                  Structures.
+* add-domain:                           Database Utilities.
+* add-process!:                         Multi-Processing.
+* add-setter:                           Setters.
+* adjoin:                               Lists as sets.
+* adjoin-parameters!:                   Parameter lists.
+* alist->wt-tree:                       Construction of Weight-Balanced Trees.
+* alist-associator:                     Association Lists.
+* alist-for-each:                       Association Lists.
+* alist-inquirer:                       Association Lists.
+* alist-map:                            Association Lists.
+* alist-remover:                        Association Lists.
+* and?:                                 Non-List functions.
+* any?:                                 Collections.
+* append!:                              Rev2 Procedures.
+* apply:                                Multi-argument Apply.
+* array-1d-ref:                         Arrays.
+* array-1d-set!:                        Arrays.
+* array-2d-ref:                         Arrays.
+* array-2d-set!:                        Arrays.
+* array-3d-ref:                         Arrays.
+* array-3d-set!:                        Arrays.
+* array-copy!:                          Array Mapping.
+* array-dimensions:                     Arrays.
+* array-for-each:                       Array Mapping.
+* array-in-bounds?:                     Arrays.
+* array-indexes:                        Array Mapping.
+* array-map!:                           Array Mapping.
+* array-rank:                           Arrays.
+* array-ref:                            Arrays.
+* array-set!:                           Arrays.
+* array-shape:                          Arrays.
+* array?:                               Arrays.
+* asctime:                              Time.
+* ash:                                  Bit-Twiddling.
+* atom?:                                Non-List functions.
+* batch:apply-chop-to-fit:              Batch.
+* batch:call-with-output-script:        Batch.
+* batch:comment:                        Batch.
+* batch:delete-file:                    Batch.
+* batch:initialize!:                    Batch.
+* batch:lines->file:                    Batch.
+* batch:rename-file:                    Batch.
+* batch:run-script:                     Batch.
+* batch:system:                         Batch.
+* batch:try-system:                     Batch.
+* bit-extract:                          Bit-Twiddling.
+* break:                                Breakpoints.
+* break-all:                            Debug.
+* breakf:                               Breakpoints.
+* breakpoint:                           Breakpoints.
+* butlast:                              Lists as sequences.
+* call-with-dynamic-binding:            Dynamic Data Type.
+* call-with-input-string:               String Ports.
+* call-with-output-string:              String Ports.
+* call-with-values:                     Values.
+* capture-syntactic-environment:        Syntactic Closures.
+* cart-prod-tables:                     Relational Database Operations.
+* chap:next-string:                     Chapter Ordering.
+* chap:string<=?:                       Chapter Ordering.
+* chap:string<?:                        Chapter Ordering.
+* chap:string>=?:                       Chapter Ordering.
+* chap:string>?:                        Chapter Ordering.
+* check-parameters:                     Parameter lists.
+* close-base:                           Base Table.
+* close-database:                       Relational Database Operations.
+* close-table:                          Table Operations.
+* coerce:                               Non-List functions.
+* collection?:                          Collections.
+* continue:                             Breakpoints.
+* copy-list:                            List construction.
+* copy-tree:                            Tree Operations.
+* create-database <1>:                  Database Utilities.
+* create-database:                      Creating and Opening Relational Databases.
+* create-report:                        Database Utilities.
+* create-table:                         Relational Database Operations.
+* create-view:                          Relational Database Operations.
+* ctime:                                Time.
+* current-error-port:                   Input/Output.
+* current-time:                         Time.
+* debug:breakf:                         Breakpoints.
+* debug:tracef:                         Trace.
+* debug:unbreakf:                       Breakpoints.
+* debug:untracef:                       Trace.
+* decode-universal-time:                CLTime.
+* define-access-operation:              Setters.
+* define-operation:                     Yasos interface.
+* define-predicate:                     Yasos interface.
+* define-record:                        Structures.
+* define-syntax:                        Macro by Example.
+* define-tables:                        Database Utilities.
+* defmacro:                             Defmacro.
+* defmacro:eval:                        Defmacro.
+* defmacro:expand*:                     Defmacro.
+* defmacro:load:                        Defmacro.
+* defmacro?:                            Defmacro.
+* delete <1>:                           Destructive list operations.
+* delete:                               Base Table.
+* delete-domain:                        Database Utilities.
+* delete-file:                          Input/Output.
+* delete-if:                            Destructive list operations.
+* delete-if-not:                        Destructive list operations.
+* delete-table:                         Relational Database Operations.
+* dequeue!:                             Queues.
+* difftime:                             Time.
+* do-elts:                              Collections.
+* do-keys:                              Collections.
+* domain-checker:                       Database Utilities.
+* dynamic-ref:                          Dynamic Data Type.
+* dynamic-set!:                         Dynamic Data Type.
+* dynamic-wind:                         Dynamic-Wind.
+* dynamic?:                             Dynamic Data Type.
+* empty?:                               Collections.
+* encode-universal-time:                CLTime.
+* enquque!:                             Queues.
+* every:                                Lists as sets.
+* every?:                               Collections.
+* extended-euclid:                      Modular Arithmetic.
+* factor:                               Prime Factorization.
+* file-exists?:                         Input/Output.
+* fill-empty-parameters:                Parameter lists.
+* find-if:                              Lists as sets.
+* find-string-from-port?:               String Search.
+* fluid-let:                            Fluid-Let.
+* for-each-elt:                         Collections.
+* for-each-key <1>:                     Base Table.
+* for-each-key:                         Collections.
+* for-each-row:                         Table Operations.
+* force-output:                         Input/Output.
+* format:                               Format Interface.
+* fprintf:                              Standard Formatted Output.
+* fscanf:                               Standard Formatted Input.
+* generic-write:                        Generic-Write.
+* gentemp:                              Defmacro.
+* get:                                  Table Operations.
+* get*:                                 Table Operations.
+* get-decoded-time:                     CLTime.
+* get-method:                           Object.
+* get-universal-time:                   CLTime.
+* getenv:                               System Interface.
+* getopt:                               Getopt.
+* getopt-:                              Getopt.
+* getopt->arglist:                      Parameter lists.
+* getopt->parameter-list:               Parameter lists.
+* gmtime:                               Time.
+* has-duplicates?:                      Lists as sets.
+* hash:                                 Hashing.
+* hash-associator:                      Hash Tables.
+* hash-for-each:                        Hash Tables.
+* hash-inquirer:                        Hash Tables.
+* hash-map:                             Hash Tables.
+* hash-remover:                         Hash Tables.
+* hashq:                                Hashing.
+* hashv:                                Hashing.
+* heap-extract-max!:                    Priority Queues.
+* heap-insert!:                         Priority Queues.
+* heap-length:                          Priority Queues.
+* identifier=?:                         Syntactic Closures.
+* identifier?:                          Syntactic Closures.
+* identity:                             Legacy.
+* implementation-vicinity:              Vicinity.
+* in-vicinity:                          Vicinity.
+* init-debug:                           Breakpoints.
+* integer-expt:                         Bit-Twiddling.
+* integer-length:                       Bit-Twiddling.
+* integer-sqrt:                         Root Finding.
+* intersection:                         Lists as sets.
+* jacobi-symbol:                        Prime Factorization.
+* kill-process!:                        Multi-Processing.
+* kill-table:                           Base Table.
+* laguerre:find-polynomial-root:        Root Finding.
+* laguerre:find-root:                   Root Finding.
+* last:                                 Lists as sequences.
+* last-pair:                            Legacy.
+* library-vicinity:                     Vicinity.
+* list*:                                List construction.
+* list->string:                         Rev4 Optional Procedures.
+* list->vector:                         Rev4 Optional Procedures.
+* list-tail:                            Rev4 Optional Procedures.
+* load-option:                          Weight-Balanced Trees.
+* localtime:                            Time.
+* logand:                               Bit-Twiddling.
+* logbit?:                              Bit-Twiddling.
+* logcount:                             Bit-Twiddling.
+* logior:                               Bit-Twiddling.
+* lognot:                               Bit-Twiddling.
+* logtest:                              Bit-Twiddling.
+* logxor:                               Bit-Twiddling.
+* macro:eval <1>:                       Syntax-Case Macros.
+* macro:eval <2>:                       Syntactic Closures.
+* macro:eval <3>:                       Macros That Work.
+* macro:eval:                           R4RS Macros.
+* macro:expand <1>:                     Syntax-Case Macros.
+* macro:expand <2>:                     Syntactic Closures.
+* macro:expand <3>:                     Macros That Work.
+* macro:expand:                         R4RS Macros.
+* macro:load <1>:                       Syntax-Case Macros.
+* macro:load <2>:                       Syntactic Closures.
+* macro:load <3>:                       Macros That Work.
+* macro:load:                           R4RS Macros.
+* macroexpand:                          Defmacro.
+* macroexpand-1:                        Defmacro.
+* macwork:eval:                         Macros That Work.
+* macwork:expand:                       Macros That Work.
+* macwork:load:                         Macros That Work.
+* make-:                                Structures.
+* make-array:                           Arrays.
+* make-base:                            Base Table.
+* make-command-server:                  Database Utilities.
+* make-dynamic:                         Dynamic Data Type.
+* make-generic-method:                  Object.
+* make-generic-predicate:               Object.
+* make-getter:                          Base Table.
+* make-hash-table:                      Hash Tables.
+* make-heap:                            Priority Queues.
+* make-key->list:                       Base Table.
+* make-key-extractor:                   Base Table.
+* make-keyifier-1:                      Base Table.
+* make-list:                            List construction.
+* make-list-keyifier:                   Base Table.
+* make-method!:                         Object.
+* make-object:                          Object.
+* make-parameter-list:                  Parameter lists.
+* make-port-crc:                        Cyclic Checksum.
+* make-predicate!:                      Object.
+* make-promise:                         Promises.
+* make-putter:                          Base Table.
+* make-queue:                           Queues.
+* make-random-state:                    Random Numbers.
+* make-record-type:                     Records.
+* make-relational-system:               Creating and Opening Relational Databases.
+* make-shared-array:                    Arrays.
+* make-sierpinski-indexer:              Hashing.
+* make-syntactic-closure:               Syntactic Closures.
+* make-table:                           Base Table.
+* make-vicinity:                        Vicinity.
+* make-wt-tree:                         Construction of Weight-Balanced Trees.
+* make-wt-tree-type:                    Construction of Weight-Balanced Trees.
+* map-elts:                             Collections.
+* map-key:                              Base Table.
+* map-keys:                             Collections.
+* member-if:                            Lists as sets.
+* merge:                                Sorting.
+* merge!:                               Sorting.
+* mktime:                               Time.
+* modular::                             Modular Arithmetic.
+* modular:*:                            Modular Arithmetic.
+* modular:+:                            Modular Arithmetic.
+* modular:expt:                         Modular Arithmetic.
+* modular:invert:                       Modular Arithmetic.
+* modular:invertable?:                  Modular Arithmetic.
+* modular:negate:                       Modular Arithmetic.
+* modular:normalize:                    Modular Arithmetic.
+* modulus->integer:                     Modular Arithmetic.
+* must-be-first:                        Batch.
+* must-be-last:                         Batch.
+* nconc:                                Destructive list operations.
+* newton:find-root:                     Root Finding.
+* newtown:find-integer-root:            Root Finding.
+* notany:                               Lists as sets.
+* notevery:                             Lists as sets.
+* nreverse:                             Destructive list operations.
+* nthcdr:                               Lists as sequences.
+* object:                               Yasos interface.
+* object->string:                       Object-To-String.
+* object-with-ancestors:                Yasos interface.
+* object?:                              Object.
+* offset-time:                          Time.
+* open-base:                            Base Table.
+* open-database <1>:                    Database Utilities.
+* open-database:                        Creating and Opening Relational Databases.
+* open-database!:                       Database Utilities.
+* open-table <1>:                       Relational Database Operations.
+* open-table:                           Base Table.
+* operate-as:                           Yasos interface.
+* or?:                                  Non-List functions.
+* ordered-for-each-key:                 Base Table.
+* os->batch-dialect:                    Batch.
+* output-port-height:                   Input/Output.
+* output-port-width:                    Input/Output.
+* parameter-list->arglist:              Parameter lists.
+* parameter-list-expand:                Parameter lists.
+* parameter-list-ref:                   Parameter lists.
+* plot!:                                Plotting.
+* position:                             Lists as sequences.
+* pprint-file:                          Pretty-Print.
+* pprint-filter-file:                   Pretty-Print.
+* predicate->asso:                      Association Lists.
+* predicate->hash:                      Hash Tables.
+* predicate->hash-asso:                 Hash Tables.
+* present?:                             Base Table.
+* pretty-print:                         Pretty-Print.
+* prime:trials:                         Prime Factorization.
+* prime?:                               Prime Factorization.
+* primes<:                              Prime Testing and Generation.
+* primes>:                              Prime Testing and Generation.
+* print:                                Yasos interface.
+* printf:                               Standard Formatted Output.
+* probably-prime?:                      Prime Testing and Generation.
+* process:schedule!:                    Multi-Processing.
+* program-vicinity:                     Vicinity.
+* project-table:                        Relational Database Operations.
+* provide:                              Require.
+* provided?:                            Require.
+* qp:                                   Quick Print.
+* qpn:                                  Quick Print.
+* qpr:                                  Quick Print.
+* queue-empty?:                         Queues.
+* queue-front:                          Queues.
+* queue-pop!:                           Queues.
+* queue-push!:                          Queues.
+* queue-rear:                           Queues.
+* queue?:                               Queues.
+* random:                               Random Numbers.
+* random:exp:                           Random Numbers.
+* random:hollow-sphere!:                Random Numbers.
+* random:normal:                        Random Numbers.
+* random:normal-vector!:                Random Numbers.
+* random:solid-sphere!:                 Random Numbers.
+* random:uniform:                       Random Numbers.
+* rationalize:                          Rationalize.
+* read-command:                         Command Line.
+* read-line:                            Line I/O.
+* read-line!:                           Line I/O.
+* record-accessor:                      Records.
+* record-constructor:                   Records.
+* record-modifier:                      Records.
+* record-predicate:                     Records.
+* record-type-descriptor:               Records.
+* record-type-field-names:              Records.
+* record-type-name:                     Records.
+* record?:                              Records.
+* reduce <1>:                           Lists as sequences.
+* reduce:                               Collections.
+* reduce-init:                          Lists as sequences.
+* remove:                               Lists as sets.
+* remove-if:                            Lists as sets.
+* remove-if-not:                        Lists as sets.
+* remove-setter-for:                    Setters.
+* repl:quit:                            Repl.
+* repl:top-level:                       Repl.
+* replace-suffix:                       Batch.
+* require:                              Require.
+* require:feature->path:                Require.
+* restrict-table:                       Relational Database Operations.
+* row:delete:                           Table Operations.
+* row:delete*:                          Table Operations.
+* row:insert:                           Table Operations.
+* row:insert*:                          Table Operations.
+* row:remove:                           Table Operations.
+* row:remove*:                          Table Operations.
+* row:retrieve:                         Table Operations.
+* row:retrieve*:                        Table Operations.
+* row:update:                           Table Operations.
+* row:update*:                          Table Operations.
+* scanf:                                Standard Formatted Input.
+* scanf-read-list:                      Standard Formatted Input.
+* set:                                  Setters.
+* set-:                                 Structures.
+* set-difference:                       Lists as sets.
+* setter:                               Setters.
+* Setter:                               Collections.
+* singleton-wt-tree:                    Construction of Weight-Balanced Trees.
+* size <1>:                             Yasos interface.
+* size:                                 Collections.
+* slib:error:                           System.
+* slib:eval:                            System.
+* slib:eval-load:                       System.
+* slib:exit:                            System.
+* slib:load:                            System.
+* slib:load-compiled:                   System.
+* slib:load-source:                     System.
+* slib:report:                          Configuration.
+* slib:report-version:                  Configuration.
+* software-type:                        Configuration.
+* some:                                 Lists as sets.
+* sort:                                 Sorting.
+* sort!:                                Sorting.
+* sorted?:                              Sorting.
+* soundex:                              Hashing.
+* sprintf:                              Standard Formatted Output.
+* sscanf:                               Standard Formatted Input.
+* string->list:                         Rev4 Optional Procedures.
+* string-capitalize:                    String-Case.
+* string-captialize!:                   String-Case.
+* string-copy:                          Rev4 Optional Procedures.
+* string-downcase:                      String-Case.
+* string-downcase!:                     String-Case.
+* string-fill!:                         Rev4 Optional Procedures.
+* string-index:                         String Search.
+* string-join:                          Batch.
+* string-null?:                         Rev2 Procedures.
+* string-upcase:                        String-Case.
+* string-upcase!:                       String-Case.
+* sub-vicinity:                         Vicinity.
+* subst:                                Tree Operations.
+* substq:                               Tree Operations.
+* substring-fill!:                      Rev2 Procedures.
+* substring-move-left!:                 Rev2 Procedures.
+* substring-move-right!:                Rev2 Procedures.
+* substring?:                           String Search.
+* substv:                               Tree Operations.
+* supported-key-type?:                  Base Table.
+* supported-type?:                      Base Table.
+* symmetric:modulus:                    Modular Arithmetic.
+* sync-base:                            Base Table.
+* syncase:eval:                         Syntax-Case Macros.
+* syncase:expand:                       Syntax-Case Macros.
+* syncase:load:                         Syntax-Case Macros.
+* synclo:eval:                          Syntactic Closures.
+* synclo:expand:                        Syntactic Closures.
+* synclo:load:                          Syntactic Closures.
+* syntax-rules:                         Macro by Example.
+* system:                               System Interface.
+* table-exists?:                        Relational Database Operations.
+* tek40:draw:                           Tektronix Graphics Support.
+* tek40:graphics:                       Tektronix Graphics Support.
+* tek40:init:                           Tektronix Graphics Support.
+* tek40:linetype:                       Tektronix Graphics Support.
+* tek40:move:                           Tektronix Graphics Support.
+* tek40:put-text:                       Tektronix Graphics Support.
+* tek40:reset:                          Tektronix Graphics Support.
+* tek40:text:                           Tektronix Graphics Support.
+* tek41:draw:                           Tektronix Graphics Support.
+* tek41:encode-int:                     Tektronix Graphics Support.
+* tek41:encode-x-y:                     Tektronix Graphics Support.
+* tek41:graphics:                       Tektronix Graphics Support.
+* tek41:init:                           Tektronix Graphics Support.
+* tek41:move:                           Tektronix Graphics Support.
+* tek41:point:                          Tektronix Graphics Support.
+* tek41:reset:                          Tektronix Graphics Support.
+* tmpnam:                               Input/Output.
+* topological-sort:                     Topological Sort.
+* trace:                                Trace.
+* trace-all:                            Debug.
+* tracef:                               Trace.
+* transcript-off:                       Transcripts.
+* transcript-on:                        Transcripts.
+* transformer:                          Syntactic Closures.
+* tsort:                                Topological Sort.
+* two-arg:-:                            Multi-argument / and -.
+* two-arg:/:                            Multi-argument / and -.
+* two-arg:apply:                        Multi-argument Apply.
+* type-of:                              Non-List functions.
+* tzset:                                Time.
+* unbreak:                              Breakpoints.
+* unbreakf:                             Breakpoints.
+* union:                                Lists as sets.
+* unmake-method!:                       Object.
+* untrace:                              Trace.
+* untracef:                             Trace.
+* user-vicinity:                        Vicinity.
+* values:                               Values.
+* variant-case:                         Structures.
+* vector->list:                         Rev4 Optional Procedures.
+* vector-fill!:                         Rev4 Optional Procedures.
+* with-input-from-file:                 With-File.
+* with-output-to-file:                  With-File.
+* write-base:                           Base Table.
+* write-database:                       Relational Database Operations.
+* write-line:                           Line I/O.
+* wt-tree/add:                          Basic Operations on Weight-Balanced Trees.
+* wt-tree/add!:                         Basic Operations on Weight-Balanced Trees.
+* wt-tree/delete:                       Basic Operations on Weight-Balanced Trees.
+* wt-tree/delete!:                      Basic Operations on Weight-Balanced Trees.
+* wt-tree/delete-min:                   Indexing Operations on Weight-Balanced Trees.
+* wt-tree/delete-min!:                  Indexing Operations on Weight-Balanced Trees.
+* wt-tree/difference:                   Advanced Operations on Weight-Balanced Trees.
+* wt-tree/empty?:                       Basic Operations on Weight-Balanced Trees.
+* wt-tree/fold:                         Advanced Operations on Weight-Balanced Trees.
+* wt-tree/for-each:                     Advanced Operations on Weight-Balanced Trees.
+* wt-tree/index:                        Indexing Operations on Weight-Balanced Trees.
+* wt-tree/index-datum:                  Indexing Operations on Weight-Balanced Trees.
+* wt-tree/index-pair:                   Indexing Operations on Weight-Balanced Trees.
+* wt-tree/intersection:                 Advanced Operations on Weight-Balanced Trees.
+* wt-tree/lookup:                       Basic Operations on Weight-Balanced Trees.
+* wt-tree/member?:                      Basic Operations on Weight-Balanced Trees.
+* wt-tree/min:                          Indexing Operations on Weight-Balanced Trees.
+* wt-tree/min-datum:                    Indexing Operations on Weight-Balanced Trees.
+* wt-tree/min-pair:                     Indexing Operations on Weight-Balanced Trees.
+* wt-tree/rank:                         Indexing Operations on Weight-Balanced Trees.
+* wt-tree/set-equal?:                   Advanced Operations on Weight-Balanced Trees.
+* wt-tree/size:                         Basic Operations on Weight-Balanced Trees.
+* wt-tree/split<:                       Advanced Operations on Weight-Balanced Trees.
+* wt-tree/split>:                       Advanced Operations on Weight-Balanced Trees.
+* wt-tree/subset?:                      Advanced Operations on Weight-Balanced Trees.
+* wt-tree/union:                        Advanced Operations on Weight-Balanced Trees.
+* wt-tree?:                             Basic Operations on Weight-Balanced Trees.
+
+
+File: slib.info,  Node: Variable Index,  Prev: Procedure and Macro Index,  Up: Top
+
+Variable Index
+**************
+
+  This is an alphabetical list of all the global variables in SLIB.
+
+* Menu:
+
+* *catalog*:                            Require.
+* *features*:                           Require.
+* *modules*:                            Require.
+* *optarg*:                             Getopt.
+* *optind*:                             Getopt.
+* *qp-width*:                           Quick Print.
+* *random-state*:                       Random Numbers.
+* *timezone*:                           Time.
+* batch:platform:                       Batch.
+* catalog-id:                           Base Table.
+* char-code-limit:                      Configuration.
+* charplot:height:                      Plotting.
+* charplot:width:                       Plotting.
+* column-domains:                       Table Operations.
+* column-foreigns:                      Table Operations.
+* column-names:                         Table Operations.
+* column-types:                         Table Operations.
+* most-positive-fixnum:                 Configuration.
+* nil:                                  Legacy.
+* number-wt-type:                       Construction of Weight-Balanced Trees.
+* primary-limit:                        Table Operations.
+* slib:form-feed:                       Configuration.
+* slib:tab:                             Configuration.
+* stderr:                               Standard Formatted I/O.
+* stdin:                                Standard Formatted I/O.
+* stdout:                               Standard Formatted I/O.
+* string-wt-type:                       Construction of Weight-Balanced Trees.
+* t:                                    Legacy.
+
+
diff --git a/slib.texi b/slib.texi
new file mode 100644
index 0000000..1d41fdc
--- /dev/null
+++ b/slib.texi
@@ -0,0 +1,9058 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename slib.info
+@settitle SLIB
+@setchapternewpage on
+@c Choices for setchapternewpage are {on,off,odd}.
+@paragraphindent 2
+@c %**end of header
+
+@iftex
+@finalout
+@c DL: lose the egregious vertical whitespace, esp. around examples
+@c but paras in @defun-like things don't have parindent
+@parskip 4pt plus 1pt
+@end iftex
+
+@ifinfo
+This file documents SLIB, the portable Scheme library.
+
+Copyright (C) 1993 Todd R. Eigenschink
+Copyright (C) 1993, 1994, 1995 Aubrey Jaffer
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the author.
+@end ifinfo
+
+@titlepage
+@title SLIB
+@subtitle The Portable Scheme Library
+@subtitle Version 2a3
+@subtitle June 1995
+@author by Todd R. Eigenschink, Dave Love, and Aubrey Jaffer
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1993, 1994, 1995 Todd R. Eigenschink and Aubrey Jaffer
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the author.
+@end titlepage
+
+
+
+
+
+@node Top, Overview, (dir), (dir)
+
+@ifinfo
+This file documents SLIB, the portable Scheme library.
+
+@heading Good Engineering is 1% inspiration and 99% documentation.
+
+Herein lies the good part.  Many thanks to Todd Eigenschink
+<eigenstr@@CS.Rose-Hulman.Edu> (who thanks Dave Love <D.Love@@dl.ac.uk>)
+for creating @file{slib.texi}.  I have learned much from their example.
+
+Aubrey Jaffer
+jaffer@@ai.mit.edu
+@end ifinfo
+
+
+@menu
+* Overview::                    What is SLIB?
+
+* Data Structures::             Various data structures.
+* Macros::                      Extensions to Scheme syntax.
+* Numerics::                    
+* Procedures::                  Miscellaneous utility procedures.
+* Standards Support::           Support for Scheme Standards.
+* Session Support::             Debugging, Pathnames, Require, etc.
+
+* Optional SLIB Packages::      
+* Procedure and Macro Index::   
+* Variable Index::              
+@end menu
+
+
+@node Overview, Data Structures, Top, Top
+@chapter Overview
+
+SLIB is a portable Scheme library meant to provide compatibility and
+utility functions for all standard Scheme implementations, and fixes
+several implementations which are non-conforming.  SLIB conforms to
+@cite{Revised^4 Report on the Algorithmic Language Scheme} and the IEEE
+P1178 specification.  SLIB supports Unix and similar systems, VMS, and
+MS-DOS.@refill
+
+For a summary of what each file contains, see the file @file{README}.
+For a list of the features that have changed since the last SLIB
+release, see the file @file{ANNOUNCE}.  For a list of the features that
+have changed over time, see the file @file{ChangeLog}.
+
+The maintainer can be reached as @samp{jaffer@@ai.mit.edu}.
+
+@menu
+* Installation::                How to install SLIB on your system.
+* Porting::                     SLIB to new platforms
+* Coding Standards::            How to write modules for SLIB.
+* Copyrights::                  Intellectual propery issues.
+* Manual Conventions::          Conventions used in this manual.
+@end menu
+
+@node Installation, Porting, Overview, Overview
+@section Installation
+
+Check the manifest in @file{README} to find a configuration file for
+your Scheme implementation.  Initialization files for most IEEE P1178
+compliant Scheme Implementations are included with this distribution.
+
+If the Scheme implementation supports @code{getenv}, then the value of
+the shell environment variable @var{SCHEME_LIBRARY_PATH} will be used
+for @code{(library-vicinity)} if it is defined.  Currently, Chez, Elk,
+MITScheme, scheme->c, VSCM, and SCM support @code{getenv}.
+
+You should check the definitions of @code{software-type},
+@code{scheme-implementation-version},
+@iftex
+@*
+@end iftex
+@code{implementation-vicinity},
+and @code{library-vicinity} in the initialization file.  There are
+comments in the file for how to configure it.
+
+Once this is done you can modify the startup file for your Scheme
+implementation to @code{load} this initialization file.  SLIB is then
+installed.
+
+Multiple implementations of Scheme can all use the same SLIB directory.
+Simply configure each implementation's initialization file as outlined
+above.
+
+The SCM implementation does not require any initialization file as SLIB
+support is already built in to SCM.  See the documentation with SCM for
+installation instructions.
+
+SLIB includes methods to create heap images for the VSCM and Scheme48
+implementations.  The instructions for creating a VSCM image are in
+comments in @file{vscm.init}.  To make a Scheme48 image, @code{cd} to
+the SLIB directory and type @code{make slib48}.  This will also create a
+shell script with the name @code{slib48} which will invoke the saved
+image.
+
+@node Porting, Coding Standards, Installation, Overview
+@section Porting
+
+If there is no initialization file for your Scheme implementation, you
+will have to create one.  Your Scheme implementation must be largely
+compliant with @cite{IEEE Std 1178-1990} or @cite{Revised^4 Report on
+the Algorithmic Language Scheme} to support SLIB.
+
+@file{Template.scm} is an example configuration file.  The comments
+inside will direct you on how to customize it to reflect your system.
+Give your new initialization file the implementation's name with
+@file{.init} appended.  For instance, if you were porting
+@code{foo-scheme} then the initialization file might be called
+@file{foo.init}.
+
+Your customized version should then be loaded as part of your scheme
+implementation's initialization.  It will load @file{require.scm}
+(@xref{Require}) from the library; this will allow the use of
+@code{provide}, @code{provided?}, and @code{require} along with the
+@dfn{vicinity} functions (@code{vicinity} functions are documented in
+the section on Require.  @xref{Require}).  The rest of the library will
+then be accessible in a system independent fashion.@refill
+
+Please mail new working configuration files to @code{jaffer@@ai.mit.edu}
+so that they can be included in the SLIB distribution.@refill
+
+@node Coding Standards, Copyrights, Porting, Overview
+@section Coding Standards
+
+All library packages are written in IEEE P1178 Scheme and assume that a
+configuration file and @file{require.scm} package have already been
+loaded.  Other versions of Scheme can be supported in library packages
+as well by using, for example, @code{(provided? 'rev3-report)} or
+@code{(require 'rev3-report)} (@xref{Require}).@refill
+
+@file{require.scm} defines @code{*catalog*}, an association list of
+module names and filenames.  When a new package is added to the library,
+an entry should be added to @file{require.scm}.  Local packages can also
+be added to @code{*catalog*} and even shadow entries already in the
+table.@refill
+
+The module name and @samp{:} should prefix each symbol defined in the
+package.  Definitions for external use should then be exported by having
+@code{(define foo module-name:foo)}.@refill
+
+Submitted code should not duplicate routines which are already in SLIB
+files.  Use @code{require} to force those features to be supported in
+your package.  Care should be taken that there are no circularities in
+the @code{require}s and @code{load}s between the library
+packages.@refill
+
+Documentation should be provided in Emacs Texinfo format if possible,
+But documentation must be provided.
+
+Your package will be released sooner with SLIB if you send me a file
+which tests your code.  Please run this test @emph{before} you send me
+the code!
+
+@subheading Modifications
+
+Please document your changes.  A line or two for @file{ChangeLog} is
+sufficient for simple fixes or extensions.  Look at the format of
+@file{ChangeLog} to see what information is desired.  Please send me
+@code{diff} files from the latest SLIB distribution (remember to send
+@code{diff}s of @file{slib.texi} and @file{ChangeLog}).  This makes for
+less email traffic and makes it easier for me to integrate when more
+than one person is changing a file (this happens a lot with
+@file{slib.texi} and @samp{*.init} files).
+
+If someone else wrote a package you want to significantly modify, please
+try to contact the author, who may be working on a new version.  This
+will insure against wasting effort on obsolete versions.
+
+Please @emph{do not} reformat the source code with your favorite
+beautifier, make 10 fixes, and send me the resulting source code.  I do
+not have the time to fish through 10000 diffs to find your 10 real fixes.
+
+@node Copyrights, Manual Conventions, Coding Standards, Overview
+@section Copyrights
+
+This section has instructions for SLIB authors regarding copyrights.
+
+Each package in SLIB must either be in the public domain, or come with a
+statement of terms permitting users to copy, redistribute and modify it.
+The comments at the beginning of @file{require.scm} and
+@file{macwork.scm} illustrate copyright and appropriate terms.
+
+If your code or changes amount to less than about 10 lines, you do not
+need to add your copyright or send a disclaimer.
+
+@subheading Putting code into the Public Domain
+
+In order to put code in the public domain you should sign a copyright
+disclaimer and send it to the SLIB maintainer.  Contact
+jaffer@@ai.mit.edu for the address to mail the disclaimer to.
+
+@quotation
+I, @var{name}, hereby affirm that I have placed the software package
+@var{name} in the public domain.
+
+I affirm that I am the sole author and sole copyright holder for the
+software package, that I have the right to place this software package
+in the public domain, and that I will do nothing to undermine this
+status in the future.
+
+@flushright
+                                        @var{signature and date}
+@end flushright
+@end quotation
+
+This wording assumes that you are the sole author.  If you are not the
+sole author, the wording needs to be different.  If you don't want to be
+bothered with sending a letter every time you release or modify a
+module, make your letter say that it also applies to your future
+revisions of that module.
+
+Make sure no employer has any claim to the copyright on the work you are
+submitting.  If there is any doubt, create a copyright disclaimer and
+have your employer sign it.  Mail the signed disclaimer to the SLIB
+maintainer.  Contact jaffer@@ai.mit.edu for the address to mail the
+disclaimer to.  An example disclaimer follows.
+
+@subheading Explicit copying terms
+
+@noindent
+If you submit more than about 10 lines of code which you are not placing
+into the Public Domain (by sending me a disclaimer) you need to:
+
+@itemize @bullet
+@item
+Arrange that your name appears in a copyright line for the appropriate
+year.   Multiple copyright lines are acceptable.
+@item
+With your copyright line, specify any terms you require to be different
+from those already in the file.
+@item
+Make sure no employer has any claim to the copyright on the work you are
+submitting.  If there is any doubt, create a copyright disclaimer and
+have your employer sign it.  Mail the signed disclaim to the SLIB
+maintainer.  Contact jaffer@@ai.mit.edu for the address to mail the
+disclaimer to.
+@end itemize
+
+@subheading Example: Company Copyright Disclaimer
+
+This disclaimer should be signed by a vice president or general manager
+of the company.  If you can't get at them, anyone else authorized to
+license out software produced there will do.  Here is a sample wording:
+
+@quotation
+@var{employer} Corporation hereby disclaims all copyright
+interest in the program @var{program} written by @var{name}.
+
+@var{employer} Corporation affirms that it has no other intellectual
+property interest that would undermine this release, and will do nothing
+to undermine it in the future.
+
+@flushleft
+@var{signature and date},
+@var{name}, @var{title}, @var{employer} Corporation
+@end flushleft
+@end quotation
+
+@node Manual Conventions,  , Copyrights, Overview
+@section Manual Conventions
+
+Things that are labeled as Functions are called for their return values.
+Things that are labeled as Procedures are called primarily for their
+side effects.
+
+All examples throughout this text were produced using the @code{scm}
+Scheme implementation.
+
+At the beginning of each section, there is a line that looks something
+like
+
+@code{(require 'feature)}.
+
+@noindent
+This means that, in order to use @code{feature}, you must include the
+line @code{(require 'feature)} somewhere in your code prior to the use
+of that feature.  @code{require} will make sure that the feature is
+loaded.@refill
+
+
+
+
+
+@node Data Structures, Macros, Overview, Top
+@chapter Data Structures
+
+
+
+@menu
+* Arrays::                      'array
+* Array Mapping::               'array-for-each
+* Association Lists::           'alist
+* Collections::                 'collect
+* Dynamic Data Type::           'dynamic
+* Hash Tables::                 'hash-table
+* Hashing::                     'hash, 'sierpinski, 'soundex
+* Chapter Ordering::            'chapter-order
+* Object::                      'object
+* Parameter lists::             'parameters
+* Priority Queues::             'priority-queue
+* Queues::                      'queue
+* Records::                     'record
+* Base Table::                  
+* Relational Database::         'relational-database
+* Weight-Balanced Trees::       'wt-tree
+* Structures::                  'struct, 'structure
+@end menu
+
+
+
+
+@node Arrays, Array Mapping, Data Structures, Data Structures
+@section Arrays
+
+@code{(require 'array)}
+
+@defun array? obj
+Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not.
+@end defun
+
+@defun make-array initial-value bound1 bound2 @dots{}
+Creates and returns an array that has as many dimensins as there are
+@var{bound}s and fills it with @var{initial-value}.@refill
+@end defun
+
+When constructing an array, @var{bound} is either an inclusive range of
+indices expressed as a two element list, or an upper bound expressed as
+a single integer.  So@refill
+@lisp
+(make-array 'foo 3 3) @equiv{} (make-array 'foo '(0 2) '(0 2))
+@end lisp
+
+@defun make-shared-array array mapper bound1 bound2 @dots{}
+@code{make-shared-array} can be used to create shared subarrays of other
+arrays.  The @var{mapper} is a function that translates coordinates in
+the new array into coordinates in the old array.  A @var{mapper} must be
+linear, and its range must stay within the bounds of the old array, but
+it can be otherwise arbitrary.  A simple example:@refill
+@lisp
+(define fred (make-array #f 8 8))
+(define freds-diagonal
+  (make-shared-array fred (lambda (i) (list i i)) 8))
+(array-set! freds-diagonal 'foo 3)
+(array-ref fred 3 3)
+   @result{} FOO
+(define freds-center
+  (make-shared-array fred (lambda (i j) (list (+ 3 i) (+ 3 j)))
+                     2 2))
+(array-ref freds-center 0 0)
+   @result{} FOO
+@end lisp
+@end defun
+
+@defun array-rank obj
+Returns the number of dimensions of @var{obj}.  If @var{obj} is not an
+array, 0 is returned.
+@end defun
+
+@defun array-shape array
+@code{array-shape} returns a list of inclusive bounds.  So:
+@lisp
+(array-shape (make-array 'foo 3 5))
+   @result{} ((0 2) (0 4))
+@end lisp
+@end defun
+
+@defun array-dimensions array
+@code{array-dimensions} is similar to @code{array-shape} but replaces
+elements with a 0 minimum with one greater than the maximum. So:
+@lisp
+(array-dimensions (make-array 'foo 3 5))
+   @result{} (3 5)
+@end lisp
+@end defun
+
+@deffn Procedure array-in-bounds? array index1 index2 @dots{}
+Returns @code{#t} if its arguments would be acceptable to
+@code{array-ref}.
+@end deffn
+
+@defun array-ref array index1 index2 @dots{}
+Returns the element at the @code{(@var{index1}, @var{index2})} element
+in @var{array}.@refill
+@end defun
+
+@deffn Procedure array-set! array new-value index1 index2 @dots{}
+@end deffn
+
+@defun array-1d-ref array index
+@defunx array-2d-ref array index index
+@defunx array-3d-ref array index index index
+@end defun
+
+@deffn Procedure array-1d-set! array new-value index
+@deffnx Procedure array-2d-set! array new-value index index
+@deffnx Procedure array-3d-set! array new-value index index index
+@end deffn
+
+The functions are just fast versions of @code{array-ref} and
+@code{array-set!} that take a fixed number of arguments, and perform no
+bounds checking.@refill
+
+If you comment out the bounds checking code, this is about as efficient
+as you could ask for without help from the compiler.
+
+An exercise left to the reader: implement the rest of APL.
+
+
+
+@node Array Mapping, Association Lists, Arrays, Data Structures
+@section Array Mapping
+
+@code{(require 'array-for-each)}
+
+@defun array-map! array0 proc array1 @dots{}
+@var{array1}, @dots{} must have the same number of dimensions as
+@var{array0} and have a range for each index which includes the range
+for the corresponding index in @var{array0}.  @var{proc} is applied to
+each tuple of elements of @var{array1} @dots{} and the result is stored
+as the corresponding element in @var{array0}.  The value returned is
+unspecified.  The order of application is unspecified.
+@end defun
+
+@defun array-for-each @var{proc} @var{array0} @dots{}
+@var{proc} is applied to each tuple of elements of @var{array0} @dots{}
+in row-major order.  The value returned is unspecified.
+@end defun
+
+@defun array-indexes @var{array}
+Returns an array of lists of indexes for @var{array} such that, if
+@var{li} is a list of indexes for which @var{array} is defined, (equal?
+@var{li} (apply array-ref (array-indexes @var{array}) @var{li})).
+@end defun
+
+@defun array-copy! source destination
+Copies every element from vector or array @var{source} to the
+corresponding element of @var{destination}.  @var{destination} must have
+the same rank as @var{source}, and be at least as large in each
+dimension.  The order of copying is unspecified.
+@end defun
+
+
+@node Association Lists, Collections, Array Mapping, Data Structures
+@section Association Lists
+
+@code{(require 'alist)}
+
+Alist functions provide utilities for treating a list of key-value pairs
+as an associative database.  These functions take an equality predicate,
+@var{pred}, as an argument.  This predicate should be repeatable,
+symmetric, and transitive.@refill
+
+Alist functions can be used with a secondary index method such as hash
+tables for improved performance.
+
+@defun predicate->asso pred
+Returns an @dfn{association function} (like @code{assq}, @code{assv}, or
+@code{assoc}) corresponding to @var{pred}.  The returned function
+returns a key-value pair whose key is @code{pred}-equal to its first
+argument or @code{#f} if no key in the alist is @var{pred}-equal to the
+first argument.@refill
+@end defun
+
+@defun alist-inquirer pred
+Returns a procedure of 2 arguments, @var{alist} and @var{key}, which
+returns the value associated with @var{key} in @var{alist} or @code{#f} if
+@var{key} does not appear in @var{alist}.@refill
+@end defun
+
+@defun alist-associator pred
+Returns a procedure of 3 arguments, @var{alist}, @var{key}, and
+@var{value}, which returns an alist with @var{key} and @var{value}
+associated.  Any previous value associated with @var{key} will be
+lost.  This returned procedure may or may not have side effects on its
+@var{alist} argument.  An example of correct usage is:@refill
+@lisp
+(define put (alist-associator string-ci=?))
+(define alist '())
+(set! alist (put alist "Foo" 9))
+@end lisp
+@end defun
+
+@defun alist-remover pred
+Returns a procedure of 2 arguments, @var{alist} and @var{key}, which
+returns an alist with an association whose @var{key} is key removed.
+This returned procedure may or may not have side effects on its
+@var{alist} argument.  An example of correct usage is:@refill
+@lisp
+(define rem (alist-remover string-ci=?))
+(set! alist (rem alist "foo"))
+@end lisp
+@end defun
+
+@defun alist-map proc alist
+Returns a new association list formed by mapping @var{proc} over the
+keys and values of @var{alist}.   @var{proc} must be a function of 2
+arguments which returns the new value part.
+@end defun
+
+@defun alist-for-each proc alist
+Applies @var{proc} to each pair of keys and values of @var{alist}.
+@var{proc} must be a function of 2 arguments.  The returned value is
+unspecified.
+@end defun
+
+
+@node Collections, Dynamic Data Type, Association Lists, Data Structures
+@section Collections
+
+@c Much of the documentation in this section was written by Dave Love
+@c (d.love@dl.ac.uk) -- don't blame Ken Dickey for its faults.
+@c but we can blame him for not writing it!
+
+@code{(require 'collect)}
+
+Routines for managing collections.  Collections are aggregate data
+structures supporting iteration over their elements, similar to the
+Dylan(TM) language, but with a different interface.  They have
+@dfn{elements} indexed by corresponding @dfn{keys}, although the keys
+may be implicit (as with lists).@refill
+
+New types of collections may be defined as YASOS objects (@xref{Yasos}).
+They must support the following operations:
+@itemize @bullet
+@item
+@code{(collection? @var{self})} (always returns @code{#t});
+
+@item
+@code{(size @var{self})} returns the number of elements in the collection;
+
+@item
+@code{(print @var{self} @var{port})} is a specialized print operation
+for the collection which prints a suitable representation on the given
+@var{port} or returns it as a string if @var{port} is @code{#t};@refill
+
+@item
+@code{(gen-elts @var{self})} returns a thunk which on successive
+invocations yields elements of @var{self} in order or gives an error if
+it is invoked more than @code{(size @var{self})} times;@refill
+
+@item
+@code{(gen-keys @var{self})} is like @code{gen-elts}, but yields the
+collection's keys in order.
+
+@end itemize
+They might support specialized @code{for-each-key} and
+@code{for-each-elt} operations.@refill
+
+@defun collection? obj
+A predicate, true initially of lists, vectors and strings.  New sorts of
+collections must answer @code{#t} to @code{collection?}.@refill
+@end defun
+
+@deffn Procedure map-elts proc . collections
+@deffnx Procedure do-elts proc . collections
+@var{proc} is a procedure taking as many arguments as there are
+@var{collections} (at least one).  The @var{collections} are iterated
+over in their natural order and @var{proc} is applied to the elements
+yielded by each iteration in turn.  The order in which the arguments are
+supplied corresponds to te order in which the @var{collections} appear.
+@code{do-elts} is used when only side-effects of @var{proc} are of
+interest and its return value is unspecified.  @code{map-elts} returns a
+collection (actually a vector) of the results of the applications of
+@var{proc}.@refill
+
+Example:
+@lisp
+(map-elts + (list 1 2 3) (vector 1 2 3))
+   @result{} #(2 4 6)
+@end lisp
+@end deffn
+
+@deffn Procedure map-keys proc . collections
+@deffnx Procedure do-keys proc . collections
+These are analogous to @code{map-elts} and @code{do-elts}, but each
+iteration is over the @var{collections}' @emph{keys} rather than their
+elements.@refill
+
+Example:
+@lisp
+(map-keys + (list 1 2 3) (vector 1 2 3))
+   @result{} #(0 2 4)
+@end lisp
+@end deffn
+
+@deffn Procedure for-each-key collection proc
+@deffnx Procedure for-each-elt collection proc
+These are like @code{do-keys} and @code{do-elts} but only for a single
+collection; they are potentially more efficient.
+@end deffn
+
+@defun reduce proc seed . collections
+A generalization of the list-based @code{comlist:reduce-init}
+(@xref{Lists as sequences}) to collections which will shadow the
+list-based version if @code{(require 'collect)} follows @code{(require
+'common-list-functions)} (@xref{Common List Functions}).@refill
+
+Examples:
+@lisp
+(reduce + 0 (vector 1 2 3))
+   @result{} 6
+(reduce union '() '((a b c) (b c d) (d a)))
+   @result{} (c b d a).
+@end lisp
+@end defun
+
+@defun any? pred . collections
+A generalization of the list-based @code{some} (@xref{Lists as
+sequences}) to collections.@refill
+
+Example:
+@lisp
+(any? odd? (list 2 3 4 5))
+   @result{} #t
+@end lisp
+@end defun
+
+@defun every? pred . collections
+A generalization of the list-based @code{every} (@xref{Lists as
+sequences}) to collections.@refill
+
+Example:
+@lisp
+(every? collection? '((1 2) #(1 2)))
+   @result{} #t
+@end lisp
+@end defun
+
+@defun empty? collection
+Returns @code{#t} iff there are no elements in @var{collection}.
+
+@code{(empty? @var{collection}) @equiv{} (zero? (size @var{collection}))}
+@end defun
+
+@defun size collection
+Returns the number of elements in @var{collection}.
+@end defun
+
+@defun Setter list-ref
+See @xref{Setters} for a definition of @dfn{setter}.  N.B.
+@code{(setter list-ref)} doesn't work properly for element 0 of a
+list.@refill
+@end defun
+
+Here is a sample collection: @code{simple-table} which is also a
+@code{table}.@refill
+@lisp
+(define-predicate TABLE?)
+(define-operation (LOOKUP table key failure-object))
+(define-operation (ASSOCIATE! table key value)) ;; returns key
+(define-operation (REMOVE! table key))          ;; returns value
+
+(define (MAKE-SIMPLE-TABLE)
+  (let ( (table (list)) )
+    (object
+     ;; table behaviors
+     ((TABLE? self) #t)
+     ((SIZE self) (size table))
+     ((PRINT self port) (format port "#<SIMPLE-TABLE>"))
+     ((LOOKUP self key failure-object)
+      (cond
+       ((assq key table) => cdr)
+       (else failure-object)
+       ))
+     ((ASSOCIATE! self key value)
+      (cond
+       ((assq key table)
+        => (lambda (bucket) (set-cdr! bucket value) key))
+       (else
+        (set! table (cons (cons key value) table))
+        key)
+       ))
+     ((REMOVE! self key);; returns old value
+      (cond
+       ((null? table) (slib:error "TABLE:REMOVE! Key not found: " key))
+       ((eq? key (caar table))
+        (let ( (value (cdar table)) )
+          (set! table (cdr table))
+          value)
+        )
+       (else
+        (let loop ( (last table) (this (cdr table)) )
+          (cond
+           ((null? this)
+            (slib:error "TABLE:REMOVE! Key not found: " key))
+           ((eq? key (caar this))
+            (let ( (value (cdar this)) )
+              (set-cdr! last (cdr this))
+              value)
+            )
+           (else
+            (loop (cdr last) (cdr this)))
+           ) ) )
+       ))
+     ;; collection behaviors
+     ((COLLECTION? self) #t)
+     ((GEN-KEYS self) (collect:list-gen-elts (map car table)))
+     ((GEN-ELTS self) (collect:list-gen-elts (map cdr table)))
+     ((FOR-EACH-KEY self proc)
+      (for-each (lambda (bucket) (proc (car bucket))) table)
+      )
+     ((FOR-EACH-ELT self proc)
+      (for-each (lambda (bucket) (proc (cdr bucket))) table)
+      )
+     ) ) )
+@end lisp
+
+
+
+
+
+@node Dynamic Data Type, Hash Tables, Collections, Data Structures
+@section Dynamic Data Type
+
+@code{(require 'dynamic)}
+
+@defun make-dynamic obj
+Create and returns a new @dfn{dynamic} whose global value is @var{obj}.
+@end defun
+
+@defun dynamic? obj
+Returns true if and only if @var{obj} is a dynamic.  No object
+satisfying @code{dynamic?} satisfies any of the other standard type
+predicates.@refill
+@end defun
+
+@defun dynamic-ref dyn
+Return the value of the given dynamic in the current dynamic
+environment.
+@end defun
+
+@deffn Procedure dynamic-set! dyn obj
+Change the value of the given dynamic to @var{obj} in the current
+dynamic environment.  The returned value is unspecified.@refill
+@end deffn
+
+@defun call-with-dynamic-binding dyn obj thunk
+Invoke and return the value of the given thunk in a new, nested dynamic
+environment in which the given dynamic has been bound to a new location
+whose initial contents are the value @var{obj}.  This dynamic
+environment has precisely the same extent as the invocation of the thunk
+and is thus captured by continuations created within that invocation and
+re-established by those continuations when they are invoked.@refill
+@end defun
+
+The @code{dynamic-bind} macro is not implemented.
+
+
+
+
+@node Hash Tables, Hashing, Dynamic Data Type, Data Structures
+@section Hash Tables
+
+@code{(require 'hash-table)}
+
+@defun predicate->hash pred
+Returns a hash function (like @code{hashq}, @code{hashv}, or
+@code{hash}) corresponding to the equality predicate @var{pred}.
+@var{pred} should be @code{eq?}, @code{eqv?}, @code{equal?}, @code{=},
+@code{char=?}, @code{char-ci=?}, @code{string=?}, or
+@code{string-ci=?}.@refill
+@end defun
+
+A hash table is a vector of association lists.
+
+@defun make-hash-table k
+Returns a vector of @var{k} empty (association) lists.
+@end defun
+
+Hash table functions provide utilities for an associative database.
+These functions take an equality predicate, @var{pred}, as an argument.
+@var{pred} should be @code{eq?}, @code{eqv?}, @code{equal?}, @code{=},
+@code{char=?}, @code{char-ci=?}, @code{string=?}, or
+@code{string-ci=?}.@refill
+
+@defun predicate->hash-asso pred
+Returns a hash association function of 2 arguments, @var{key} and
+@var{hashtab}, corresponding to @var{pred}.  The returned function
+returns a key-value pair whose key is @var{pred}-equal to its first
+argument or @code{#f} if no key in @var{hashtab} is @var{pred}-equal to
+the first argument.@refill
+@end defun
+
+@defun hash-inquirer pred
+Returns a procedure of 3 arguments, @code{hashtab} and @code{key}, which
+returns the value associated with @code{key} in @code{hashtab} or
+@code{#f} if key does not appear in @code{hashtab}.@refill
+@end defun
+
+@defun hash-associator pred
+Returns a procedure of 3 arguments, @var{hashtab}, @var{key}, and
+@var{value}, which modifies @var{hashtab} so that @var{key} and
+@var{value} associated.  Any previous value associated with @var{key}
+will be lost.@refill
+@end defun
+
+@defun hash-remover pred
+Returns a procedure of 2 arguments, @var{hashtab} and @var{key}, which
+modifies @var{hashtab} so that the association whose key is @var{key} is
+removed.@refill
+@end defun
+
+@defun hash-map proc hash-table
+Returns a new hash table formed by mapping @var{proc} over the
+keys and values of @var{hash-table}.  @var{proc} must be a function of 2
+arguments which returns the new value part.
+@end defun
+
+@defun hash-for-each proc hash-table
+Applies @var{proc} to each pair of keys and values of @var{hash-table}.
+@var{proc} must be a function of 2 arguments.  The returned value is
+unspecified.
+@end defun
+
+
+
+
+
+@node Hashing, Chapter Ordering, Hash Tables, Data Structures
+@section Hashing
+
+@code{(require 'hash)}
+
+These hashing functions are for use in quickly classifying objects.
+Hash tables use these functions.
+
+@defun hashq obj k
+@defunx hashv obj k
+@defunx hash obj k
+Returns an exact non-negative integer less than @var{k}.  For each
+non-negative integer less than @var{k} there are arguments @var{obj} for
+which the hashing functions applied to @var{obj} and @var{k} returns
+that integer.@refill
+
+For @code{hashq}, @code{(eq? obj1 obj2)} implies @code{(= (hashq obj1 k)
+(hashq obj2))}.@refill
+
+For @code{hashv}, @code{(eqv? obj1 obj2)} implies @code{(= (hashv obj1 k)
+(hashv obj2))}.@refill
+
+For @code{hash}, @code{(equal? obj1 obj2)} implies @code{(= (hash obj1 k)
+(hash obj2))}.@refill
+
+@code{hash}, @code{hashv}, and @code{hashq} return in time bounded by a
+constant.  Notice that items having the same @code{hash} implies the
+items have the same @code{hashv} implies the items have the same
+@code{hashq}.@refill
+@end defun
+
+
+@code{(require 'sierpinski)}
+
+@defun make-sierpinski-indexer max-coordinate
+Returns a procedure (eg hash-function) of 2 numeric arguments which
+preserves @emph{nearness} in its mapping from NxN to N.
+
+@var{max-coordinate} is the maximum coordinate (a positive integer) of a
+population of points.  The returned procedures is a function that takes
+the x and y coordinates of a point, (non-negative integers) and returns
+an integer corresponding to the relative position of that point along a
+Sierpinski curve.  (You can think of this as computing a (pseudo-)
+inverse of the Sierpinski spacefilling curve.)
+
+Example use: Make an indexer (hash-function) for integer points lying in
+square of integer grid points [0,99]x[0,99]:
+@example
+(define space-key (make-sierpinski-indexer 100))
+@end example
+Now let's compute the index of some points:
+@example
+(space-key 24 78)               @result{} 9206
+(space-key 23 80)               @result{} 9172
+@end example
+
+Note that locations (24, 78) and (23, 80) are near in index and
+therefore, because the Sierpinski spacefilling curve is continuous, we
+know they must also be near in the plane.  Nearness in the plane does
+not, however, necessarily correspond to nearness in index, although it
+@emph{tends} to be so.
+
+Example applications:
+@table @asis
+
+@item
+Sort points by Sierpinski index to get heuristic solution to
+@emph{travelling salesman problem}.  For details of performance,
+see L. Platzman and J. Bartholdi, "Spacefilling curves and the
+Euclidean travelling salesman problem", JACM 36(4):719--737
+(October 1989) and references therein.
+
+@item
+Use Sierpinski index as key by which to store 2-dimensional data
+in a 1-dimensional data structure (such as a table).  Then
+locations that are near each other in 2-d space will tend to
+be near each other in 1-d data structure; and locations that
+are near in 1-d data structure will be near in 2-d space.  This
+can significantly speed retrieval from secondary storage because
+contiguous regions in the plane will tend to correspond to
+contiguous regions in secondary storage.  (This is a standard
+technique for managing CAD/CAM or geographic data.)
+
+@end table
+@end defun
+
+
+
+@code{(require 'soundex)}
+
+@defun soundex name
+Computes the @emph{soundex} hash of @var{name}.  Returns a string of an
+initial letter and up to three digits between 0 and 6.  Soundex
+supposedly has the property that names that sound similar in normal
+English pronunciation tend to map to the same key.
+
+Soundex was a classic algorithm used for manual filing of personal
+records before the advent of computers.  It performs adequately for
+English names but has trouble with other nationalities.
+
+See Knuth, Vol. 3 @cite{Sorting and searching}, pp 391--2
+
+To manage unusual inputs, @code{soundex} omits all non-alphabetic
+characters.  Consequently, in this implementation:
+
+@example
+(soundex <string of blanks>)    @result{} ""
+(soundex "")                    @result{} ""
+@end example
+
+Examples from Knuth:
+
+@example
+(map soundex '("Euler" "Gauss" "Hilbert" "Knuth"
+                       "Lloyd" "Lukasiewicz"))
+        @result{} ("E460" "G200" "H416" "K530" "L300" "L222")
+
+(map soundex '("Ellery" "Ghosh" "Heilbronn" "Kant"
+                        "Ladd" "Lissajous"))
+        @result{} ("E460" "G200" "H416" "K530" "L300" "L222")
+@end example
+
+Some cases in which the algorithm fails (Knuth):
+
+@example
+(map soundex '("Rogers" "Rodgers"))     @result{} ("R262" "R326")
+
+(map soundex '("Sinclair" "St. Clair")) @result{} ("S524" "S324")
+
+(map soundex '("Tchebysheff" "Chebyshev")) @result{} ("T212" "C121")
+@end example
+@end defun
+
+@node Chapter Ordering, Object, Hashing, Data Structures
+@section Chapter Ordering
+
+@code{(require 'chapter-order)}
+
+The @samp{chap:} functions deal with strings which are ordered like
+chapter numbers (or letters) in a book.  Each section of the string
+consists of consecutive numeric or consecutive aphabetic characters of
+like case.
+
+@defun chap:string<? string1 string2
+Returns #t if the first non-matching run of alphabetic upper-case or the
+first non-matching run of alphabetic lower-case or the first
+non-matching run of numeric characters of @var{string1} is
+@code{string<?} than the corresponding non-matching run of characters of
+@var{string2}.
+
+@example
+(chap:string<? "a.9" "a.10")                    @result{} #t
+(chap:string<? "4c" "4aa")                      @result{} #t
+(chap:string<? "Revised^@{3.99@}" "Revised^@{4@}")  @result{} #t
+@end example
+
+@defunx chap:string>? string1 string2
+@defunx chap:string<=? string1 string2
+@defunx chap:string>=? string1 string2
+Implement the corresponding chapter-order predicates.
+@end defun
+
+@defun chap:next-string string
+Returns the next string in the @emph{chapter order}.  If @var{string}
+has no alphabetic or numeric characters,
+@code{(string-append @var{string} "0")} is returnd.  The argument to
+chap:next-string will always be @code{chap:string<?} than the result.
+
+@example
+(chap:next-string "a.9")                @result{} "a.10"
+(chap:next-string "4c")                 @result{} "4d"
+(chap:next-string "4z")                 @result{} "4aa"
+(chap:next-string "Revised^@{4@}")        @result{} "Revised^@{5@}"
+
+@end example
+@end defun
+
+@node Object, Parameter lists, Chapter Ordering, Data Structures
+@section Macroless Object System
+
+@code{(require 'object)}
+
+This is the Macroless Object System written by Wade Humeniuk
+(whumeniu@@datap.ca).  Conceptual Tributes: @ref{Yasos}, MacScheme's
+%object, CLOS, Lack of R4RS macros.
+
+@subsection Concepts
+@table @asis
+
+@item OBJECT
+An object is an ordered association-list (by @code{eq?}) of methods
+(procedures).  Methods can be added (@code{make-method!}), deleted
+(@code{unmake-method!}) and retrieved (@code{get-method}).  Objects may
+inherit methods from other objects.  The object binds to the environment
+it was created in, allowing closures to be used to hide private
+procedures and data.
+
+@item GENERIC-METHOD
+A generic-method associates (in terms of @code{eq?}) object's method.
+This allows scheme function style to be used for objects.  The calling
+scheme for using a generic method is @code{(generic-method object param1
+param2 ...)}.
+
+@item METHOD
+A method is a procedure that exists in the object.  To use a method
+get-method must be called to look-up the method.  Generic methods
+implement the get-method functionality.  Methods may be added to an
+object associated with any scheme obj in terms of eq?
+
+@item GENERIC-PREDICATE
+A generic method that returns a boolean value for any scheme obj.
+
+@item PREDICATE
+A object's method asscociated with a generic-predicate. Returns
+@code{#t}.
+@end table
+
+@subsection Procedures
+
+@defun make-object ancestor @dots{}
+Returns an object.  Current object implementation is a tagged vector.
+@var{ancestor}s are optional and must be objects in terms of object?.
+@var{ancestor}s methods are included in the object.  Multiple
+@var{ancestor}s might associate the same generic-method with a method.
+In this case the method of the @var{ancestor} first appearing in the
+list is the one returned by @code{get-method}.
+@end defun
+
+@defun object? obj
+Returns boolean value whether @var{obj} was created by make-object.
+@end defun
+
+@defun make-generic-method exception-procedure
+Returns a procedure which be associated with an object's methods.  If
+@var{exception-procedure} is specified then it is used to process
+non-objects.
+@end defun
+
+@defun make-generic-predicate
+Returns a boolean procedure for any scheme object.
+@end defun
+
+@defun make-method! object generic-method method
+Associates @var{method} to the @var{generic-method} in the object.  The
+@var{method} overrides any previous association with the
+@var{generic-method} within the object.  Using @code{unmake-method!}
+will restore the object's previous association with the
+@var{generic-method}.  @var{method} must be a procedure.
+@end defun
+
+@defun make-predicate! object generic-preciate
+Makes a predicate method associated with the @var{generic-predicate}.
+@end defun
+
+@defun unmake-method! object generic-method
+Removes an object's association with a @var{generic-method} .
+@end defun
+
+@defun get-method object generic-method
+Returns the object's method associated (if any) with the
+@var{generic-method}.  If no associated method exists an error is
+flagged.
+@end defun
+
+@subsection Examples
+
+@example
+(require 'object)
+
+(define instantiate (make-generic-method))
+
+(define (make-instance-object . ancestors)
+  (define self (apply make-object
+                      (map (lambda (obj) (instantiate obj)) ancestors)))
+  (make-method! self instantiate (lambda (self) self))
+  self)
+
+(define who (make-generic-method))
+(define imigrate! (make-generic-method))
+(define emigrate! (make-generic-method))
+(define describe (make-generic-method))
+(define name (make-generic-method))
+(define address (make-generic-method))
+(define members (make-generic-method))
+
+(define society
+  (let ()
+    (define self (make-instance-object))
+    (define population '())
+    (make-method! self imigrate!
+                  (lambda (new-person)
+                    (if (not (eq? new-person self))
+                        (set! population (cons new-person population)))))
+    (make-method! self emigrate!
+                  (lambda (person)
+                    (if (not (eq? person self))
+                        (set! population
+                              (comlist:remove-if (lambda (member)
+                                                   (eq? member person))
+                                                 population)))))
+    (make-method! self describe
+                  (lambda (self)
+                    (map (lambda (person) (describe person)) population)))
+    (make-method! self who
+                  (lambda (self) (map (lambda (person) (name person))
+                                      population)))
+    (make-method! self members (lambda (self) population))
+    self))
+
+(define (make-person %name %address)
+  (define self (make-instance-object society))
+  (make-method! self name (lambda (self) %name))
+  (make-method! self address (lambda (self) %address))
+  (make-method! self who (lambda (self) (name self)))
+  (make-method! self instantiate
+                (lambda (self)
+                  (make-person (string-append (name self) "-son-of")
+                               %address)))
+  (make-method! self describe
+                (lambda (self) (list (name self) (address self))))
+  (imigrate! self)
+  self)
+@end example
+
+@subsubsection Inverter Documentation
+Inheritance:
+@lisp
+        <inverter>::(<number> <description>)
+@end lisp
+Generic-methods
+@lisp
+        <inverter>::value      @result{} <number>::value
+        <inverter>::set-value! @result{} <number>::set-value!
+        <inverter>::describe   @result{} <description>::describe
+        <inverter>::help
+        <inverter>::invert
+        <inverter>::inverter?
+@end lisp
+
+@subsubsection Number Documention
+Inheritance
+@lisp
+        <number>::()
+@end lisp
+Slots
+@lisp
+        <number>::<x>
+@end lisp
+Generic Methods
+@lisp
+        <number>::value
+        <number>::set-value!
+@end lisp
+
+@subsubsection Inverter code
+@example
+(require 'object)
+
+(define value (make-generic-method (lambda (val) val)))
+(define set-value! (make-generic-method))
+(define invert (make-generic-method
+                (lambda (val)
+                  (if (number? val)
+                      (/ 1 val)
+                      (error "Method not supported:" val)))))
+(define noop (make-generic-method))
+(define inverter? (make-generic-predicate))
+(define describe (make-generic-method))
+(define help (make-generic-method))
+
+(define (make-number x)
+  (define self (make-object))
+  (make-method! self value (lambda (this) x))
+  (make-method! self set-value!
+                (lambda (this new-value) (set! x new-value)))
+  self)
+
+(define (make-description str)
+  (define self (make-object))
+  (make-method! self describe (lambda (this) str))
+  (make-method! self help (lambda (this) "Help not available"))
+  self)
+
+(define (make-inverter)
+  (define self (make-object
+                (make-number 1)
+                (make-description "A number which can be inverted")))
+  (define <value> (get-method self value))
+  (make-method! self invert (lambda (self) (/ 1 (<value> self))))
+  (make-predicate! self inverter?)
+  (unmake-method! self help)
+  (make-method! self help
+                (lambda (self)
+                  (display "Inverter Methods:") (newline)
+                  (display "  (value inverter) ==> n") (newline)))
+  self)
+
+;;;; Try it out
+
+(define invert! (make-generic-method))
+
+(define x (make-inverter))
+
+(make-method! x invert! (lambda () (set-value! x (/ 1 (value x)))))
+
+(value x)                       @result{} 1
+(set-value! x 33)               @result{} undefined
+(invert! x)                     @result{} undefined
+(value x)                       @result{} 1/33
+
+(unmake-method! x invert!)      @result{} undefined
+
+(invert! x)                     @error{}  ERROR: Method not supported: x
+@end example
+
+@node Parameter lists, Priority Queues, Object, Data Structures
+@section Parameter lists
+
+@code{(require 'parameters)}
+
+@noindent
+Arguments to procedures in scheme are distinguished from each other by
+their position in the procedure call.  This can be confusing when a
+procedure takes many arguments, many of which are not often used.
+
+@noindent
+A @dfn{parameter-list} is a way of passing named information to a
+procedure.  Procedures are also defined to set unused parameters to
+default values, check parameters, and combine parameter lists.
+
+@noindent
+A @var{parameter} has the form @code{(@r{parameter-name} @r{value1}
+@dots{})}.  This format allows for more than one value per
+parameter-name.
+
+@noindent
+A @var{parameter-list} is a list of @var{parameter}s, each with a
+different @var{parameter-name}.
+
+@deffn Function make-parameter-list parameter-names
+Returns an empty parameter-list with slots for @var{parameter-names}.
+@end deffn
+
+@deffn Function parameter-list-ref parameter-list parameter-name
+@var{parameter-name} must name a valid slot of @var{parameter-list}.
+@code{parameter-list-ref} returns the value of parameter
+@var{parameter-name} of @var{parameter-list}.
+@end deffn
+
+@deffn Procedure adjoin-parameters! parameter-list parameter1 @dots{}
+Returns @var{parameter-list} with @var{parameter1} @dots{} merged in.
+@end deffn
+
+@deffn Procedure parameter-list-expand expanders parameter-list
+@var{expanders} is a list of procedures whose order matches the order of
+the @var{parameter-name}s in the call to @code{make-parameter-list}
+which created @var{parameter-list}.  For each non-false element of
+@var{expanders} that procedure is mapped over the corresponding
+parameter value and the returned parameter lists are merged into
+@var{parameter-list}.
+
+This process is repeated until @var{parameter-list} stops growing.  The
+value returned from @code{parameter-list-expand} is unspecified.
+@end deffn
+
+@deffn Function fill-empty-parameters defaults parameter-list
+@var{defaults} is a list of lists whose order matches the order of the
+@var{parameter-name}s in the call to @code{make-parameter-list} which
+created @var{parameter-list}.  @code{fill-empty-parameters} returns a
+new parameter-list with each empty parameter filled with the
+corresponding @var{default}.
+@end deffn
+
+@deffn Function check-parameters checks parameter-list
+@var{checks} is a list of procedures whose order matches the order of
+the @var{parameter-name}s in the call to @code{make-parameter-list}
+which created @var{parameter-list}.
+
+@code{check-parameters} returns @var{parameter-list} if each @var{check}
+of the corresponding @var{parameter-list} returns non-false.  If some
+@var{check} returns @code{#f} an error is signaled.
+@end deffn
+
+@noindent
+In the following procedures @var{arities} is a list of symbols.  The
+elements of @code{arities} can be:
+
+@table @code
+@item single
+Requires a single parameter.
+@item optional
+A single parameter or no parameter is acceptable.
+@item boolean
+A single boolean parameter or zero parameters is acceptable.
+@item nary
+Any number of parameters are acceptable.
+@item nary1
+One or more of parameters are acceptable.
+@end table
+
+@deffn Function parameter-list->arglist positions arities types parameter-list
+Returns @var{parameter-list} converted to an argument list.  Parameters
+of @var{arity} type @code{single} and @code{boolean} are converted to
+the single value associated with them.  The other @var{arity} types are
+converted to lists of the value(s) of type @var{types}.
+
+@var{positions} is a list of positive integers whose order matches the
+order of the @var{parameter-name}s in the call to
+@code{make-parameter-list} which created @var{parameter-list}.  The
+integers specify in which argument position the corresponding parameter
+should appear.
+@end deffn
+
+@deffn Function getopt->parameter-list argc argv optnames arities types aliases
+Returns @var{argv} converted to a parameter-list.  @var{optnames} are
+the parameter-names.  @var{aliases} is a list of lists of strings and
+elements of @var{optnames}.  Each of these strings which have length of
+1 will be treated as a single @key{-} option by @code{getopt}.  Longer
+strings will be treated as long-named options (@pxref{Getopt, getopt--}).
+@end deffn
+
+@deffn Function getopt->arglist argc argv optnames positions arities types defaults checks aliases
+Like @code{getopt->parameter-list}, but converts @var{argv} to an
+argument-list as specified by @var{optnames}, @var{positions},
+@var{arities}, @var{types}, @var{defaults}, @var{checks}, and
+@var{aliases}.
+@end deffn
+
+These @code{getopt} functions can be used with SLIB relational
+databases.  For an example, @xref{Database Utilities,
+make-command-server}.
+
+@node Priority Queues, Queues, Parameter lists, Data Structures
+@section Priority Queues
+
+@code{(require 'priority-queue)}
+
+@defun make-heap pred<?
+Returns a binary heap suitable which can be used for priority queue
+operations.
+@end defun
+
+@defun heap-length heap
+Returns the number of elements in @var{heap}.@refill
+@end defun
+
+@deffn Procedure heap-insert! heap item
+Inserts @var{item} into @var{heap}.  @var{item} can be inserted multiple
+times.  The value returned is unspecified.@refill
+@end deffn
+
+@defun heap-extract-max! heap
+Returns the item which is larger than all others according to the
+@var{pred<?} argument to @code{make-heap}.  If there are no items in
+@var{heap}, an error is signaled.@refill
+@end defun
+
+The algorithm for priority queues was taken from @cite{Introduction to
+Algorithms} by T. Cormen, C. Leiserson, R. Rivest.  1989 MIT Press.
+
+
+
+@node Queues, Records, Priority Queues, Data Structures
+@section Queues
+
+@code{(require 'queue)}
+
+A @dfn{queue} is a list where elements can be added to both the front
+and rear, and removed from the front (i.e., they are what are often
+called @dfn{dequeues}).  A queue may also be used like a stack.@refill
+
+@defun make-queue
+Returns a new, empty queue.
+@end defun
+
+@defun queue? obj
+Returns @code{#t} if @var{obj} is a queue.
+@end defun
+
+@defun queue-empty? q
+Returns @code{#t} if the queue @var{q} is empty.
+@end defun
+
+@deffn Procedure queue-push! q datum
+Adds @var{datum} to the front of queue @var{q}.
+@end deffn
+
+@deffn Procedure enquque! q datum
+Adds @var{datum} to the rear of queue @var{q}.
+@end deffn
+
+All of the following functions raise an error if the queue @var{q} is
+empty.@refill
+
+@defun queue-front q
+Returns the datum at the front of the queue @var{q}.
+@end defun
+
+@defun queue-rear q
+Returns the datum at the rear of the queue @var{q}.
+@end defun
+
+@deffn Prcoedure queue-pop! q
+@deffnx Procedure dequeue! q
+Both of these procedures remove and return the datum at the front of the
+queue.  @code{queue-pop!} is used to suggest that the queue is being
+used like a stack.@refill
+@end deffn
+
+
+
+
+
+@node Records, Base Table, Queues, Data Structures
+@section Records
+
+@code{(require 'record)}
+
+The Record package provides a facility for user to define their own
+record data types.
+
+@defun make-record-type type-name field-names
+Returns a @dfn{record-type descriptor}, a value representing a new data
+type disjoint from all others.  The @var{type-name} argument must be a
+string, but is only used for debugging purposes (such as the printed
+representation of a record of the new type).  The @var{field-names}
+argument is a list of symbols naming the @dfn{fields} of a record of the
+new type.  It is an error if the list contains any duplicates.  It is
+unspecified how record-type descriptors are represented.@refill
+@end defun
+
+@c @defun make-record-sub-type type-name field-names rtd
+@c Returns a @dfn{record-type descriptor}, a value representing a new data
+@c type, disjoint from all others.  The @var{type-name} argument must be a
+@c string.  The @var{field-names} argument is a list of symbols naming the
+@c additional @dfn{fields} to be appended to @var{field-names} of
+@c @var{rtd}.  It is an error if the combinded list contains any
+@c duplicates.@refill
+@c
+@c Record-modifiers and record-accessors for @var{rtd} work for the new
+@c record-sub-type as well.  But record-modifiers and record-accessors for
+@c the new record-sub-type will not neccessarily work for @var{rtd}.@refill
+@c @end defun
+
+@defun record-constructor rtd [field-names]
+Returns a procedure for constructing new members of the type represented
+by @var{rtd}.  The returned procedure accepts exactly as many arguments
+as there are symbols in the given list, @var{field-names}; these are
+used, in order, as the initial values of those fields in a new record,
+which is returned by the constructor procedure.  The values of any
+fields not named in that list are unspecified.  The @var{field-names}
+argument defaults to the list of field names in the call to
+@code{make-record-type} that created the type represented by @var{rtd};
+if the @var{field-names} argument is provided, it is an error if it
+contains any duplicates or any symbols not in the default list.@refill
+@end defun
+
+@defun record-predicate rtd
+Returns a procedure for testing membership in the type represented by
+@var{rtd}.  The returned procedure accepts exactly one argument and
+returns a true value if the argument is a member of the indicated record
+type; it returns a false value otherwise.@refill
+@end defun
+
+@c @defun record-sub-predicate rtd
+@c Returns a procedure for testing membership in the type represented by
+@c @var{rtd} or its parents.  The returned procedure accepts exactly one
+@c argument and returns a true value if the argument is a member of the
+@c indicated record type or its parents; it returns a false value
+@c otherwise.@refill
+@c @end defun
+
+@defun record-accessor rtd field-name
+Returns a procedure for reading the value of a particular field of a
+member of the type represented by @var{rtd}.  The returned procedure
+accepts exactly one argument which must be a record of the appropriate
+type; it returns the current value of the field named by the symbol
+@var{field-name} in that record.  The symbol @var{field-name} must be a
+member of the list of field-names in the call to @code{make-record-type}
+that created the type represented by @var{rtd}.@refill
+@end defun
+
+
+@defun record-modifier rtd field-name
+Returns a procedure for writing the value of a particular field of a
+member of the type represented by @var{rtd}.  The returned procedure
+accepts exactly two arguments: first, a record of the appropriate type,
+and second, an arbitrary Scheme value; it modifies the field named by
+the symbol @var{field-name} in that record to contain the given value.
+The returned value of the modifier procedure is unspecified.  The symbol
+@var{field-name} must be a member of the list of field-names in the call
+to @code{make-record-type} that created the type represented by
+@var{rtd}.@refill
+@end defun
+
+@defun record? obj
+Returns a true value if @var{obj} is a record of any type and a false
+value otherwise.  Note that @code{record?} may be true of any Scheme
+value; of course, if it returns true for some particular value, then
+@code{record-type-descriptor} is applicable to that value and returns an
+appropriate descriptor.@refill
+@end defun
+
+@defun record-type-descriptor record
+Returns a record-type descriptor representing the type of the given
+record.  That is, for example, if the returned descriptor were passed to
+@code{record-predicate}, the resulting predicate would return a true
+value when passed the given record.  Note that it is not necessarily the
+case that the returned descriptor is the one that was passed to
+@code{record-constructor} in the call that created the constructor
+procedure that created the given record.@refill
+@end defun
+
+@defun record-type-name rtd
+Returns the type-name associated with the type represented by rtd.  The
+returned value is @code{eqv?} to the @var{type-name} argument given in
+the call to @code{make-record-type} that created the type represented by
+@var{rtd}.@refill
+@end defun
+
+@defun record-type-field-names rtd
+Returns a list of the symbols naming the fields in members of the type
+represented by @var{rtd}.  The returned value is @code{equal?} to the
+field-names argument given in the call to @code{make-record-type} that
+created the type represented by @var{rtd}.@refill
+@end defun
+
+
+
+@node Base Table, Relational Database, Records, Data Structures
+@section Base Table
+
+A base table implementation using Scheme association lists is available
+as the value of the identifier @code{alist-table} after doing:
+
+@example
+(require 'alist-table)
+@end example
+
+
+Association list base tables are suitable for small databases and
+support all Scheme types when temporary and readable/writeable Scheme
+types when saved.  I hope support for other base table implementations
+will be added in the future.
+
+This rest of this section documents the interface for a base table
+implementation from which the @ref{Relational Database} package
+constructs a Relational system.  It will be of interest primarily to
+those wishing to port or write new base-table implementations.
+
+All of these functions are accessed through a single procedure by
+calling that procedure with the symbol name of the operation.  A
+procedure will be returned if that operation is supported and @code{#f}
+otherwise.  For example:
+
+@example
+@group
+(require 'alist-table)
+(define open-base (alist-table 'make-base))
+make-base       @result{} *a procedure*
+(define foo (alist-table 'foo))
+foo             @result{} #f
+@end group
+@end example
+
+@defun make-base filename key-dimension column-types
+Returns a new, open, low-level database (collection of tables)
+associated with @var{filename}.  This returned database has an empty
+table associated with @var{catalog-id}.  The positive integer
+@var{key-dimension} is the number of keys composed to make a
+@var{primary-key} for the catalog table.  The list of symbols
+@var{column-types} describes the types of each column for that table.
+If the database cannot be created as specified, @code{#f} is returned.
+
+Calling the @code{close-base} method on this database and possibly other
+operations will cause @var{filename} to be written to.  If
+@var{filename} is @code{#f} a temporary, non-disk based database will be
+created if such can be supported by the base table implelentation.
+@end defun
+
+@defun open-base filename mutable
+Returns an open low-level database associated with @var{filename}.  If
+@var{mutable?} is @code{#t}, this database will have methods capable of
+effecting change to the database.  If @var{mutable?} is @code{#f}, only
+methods for inquiring the database will be available.  If the database
+cannot be opened as specified @code{#f} is returned.
+
+Calling the @code{close-base} (and possibly other) method on a
+@var{mutable?}  database will cause @var{filename} to be written to.
+@end defun
+
+@defun write-base lldb filename
+Causes the low-level database @var{lldb} to be written to
+@var{filename}.  If the write is successful, also causes @var{lldb} to
+henceforth be associated with @var{filename}.  Calling the
+@code{close-database} (and possibly other) method on @var{lldb} may
+cause @var{filename} to be written to.  If @var{filename} is @code{#f}
+this database will be changed to a temporary, non-disk based database if
+such can be supported by the underlying base table implelentation.  If
+the operations completed successfully, @code{#t} is returned.
+Otherwise, @code{#f} is returned.
+@end defun
+
+@defun sync-base lldb
+Causes the file associated with the low-level database @var{lldb} to be
+updated to reflect its current state.  If the associated filename is
+@code{#f}, no action is taken and @code{#f} is returned.  If this
+operation completes successfully, @code{#t} is returned.  Otherwise,
+@code{#f} is returned.
+@end defun
+
+@defun close-base lldb
+Causes the low-level database @var{lldb} to be written to its associated
+file (if any).  If the write is successful, subsequent operations to
+@var{lldb} will signal an error.  If the operations complete
+successfully, @code{#t} is returned.  Otherwise, @code{#f} is returned.
+@end defun
+
+@defun make-table lldb key-dimension column-types
+Returns the @var{base-id} for a new base table, otherwise returns
+@code{#f}.  The base table can then be opened using @code{(open-table
+@var{lldb} @var{base-id})}.  The positive integer @var{key-dimension} is
+the number of keys composed to make a @var{primary-key} for this table.
+The list of symbols @var{column-types} describes the types of each
+column.
+@end defun
+
+@defvr Constant catalog-id
+A constant @var{base-id} suitable for passing as a parameter to
+@code{open-table}.  @var{catalog-id} will be used as the base table for
+the system catalog.
+@end defvr
+
+@defun open-table lldb base-id key-dimension column-types
+Returns a @var{handle} for an existing base table in the low-level
+database @var{lldb} if that table exists and can be opened in the mode
+indicated by @var{mutable?}, otherwise returns @code{#f}.
+
+As with @code{make-table}, the positive integer @var{key-dimension} is
+the number of keys composed to make a @var{primary-key} for this table.
+The list of symbols @var{column-types} describes the types of each
+column.
+@end defun
+
+@defun kill-table lldb base-id key-dimension column-types
+Returns @code{#t} if the base table associated with @var{base-id} was
+removed from the low level database @var{lldb}, and @code{#f} otherwise.
+@end defun
+
+@defun make-keyifier-1 type
+Returns a procedure which accepts a single argument which must be of
+type @var{type}.  This returned procedure returns an object suitable for
+being a @var{key} argument in the functions whose descriptions follow.
+
+Any 2 arguments of the supported type passed to the returned function
+which are not @code{equal?} must result in returned values which are not
+@code{equal?}.
+@end defun
+
+@defun make-list-keyifier key-dimension types
+The list of symbols @var{types} must have at least @var{key-dimension}
+elements.  Returns a procedure which accepts a list of length
+@var{key-dimension} and whose types must corresopond to the types named
+by @var{types}.  This returned procedure combines the elements of its
+list argument into an object suitable for being a @var{key} argument in
+the functions whose descriptions follow.
+
+Any 2 lists of supported types (which must at least include symbols and
+non-negative integers) passed to the returned function which are not
+@code{equal?} must result in returned values which are not
+@code{equal?}.
+@end defun
+
+@defun make-key-extractor key-dimension types column-number
+Returns a procedure which accepts objects produced by application of the
+result of @code{(make-list-keyifier @var{key-dimension} @var{types})}.
+This procedure returns a @var{key} which is @code{equal?} to the
+@var{column-number}th element of the list which was passed to create
+@var{combined-key}.  The list @var{types} must have at least
+@var{key-dimension} elements.
+@end defun
+
+@defun make-key->list key-dimension types
+Returns a procedure which accepts objects produced by application of the
+result of @code{(make-list-keyifier @var{key-dimension} @var{types})}.
+This procedure returns a list of @var{key}s which are elementwise
+@code{equal?} to the list which was passed to create @var{combined-key}.
+@end defun
+
+@noindent
+In the following functions, the @var{key} argument can always be assumed
+to be the value returned by a call to a @emph{keyify} routine.
+
+@defun for-each-key handle procedure
+Calls @var{procedure} once with each @var{key} in the table opened in
+@var{handle} in an unspecified order.  An unspecified value is returned.
+@end defun
+
+@defun map-key handle procedure
+Returns a list of the values returned by calling @var{procedure} once
+with each @var{key} in the table opened in @var{handle} in an
+unspecified order.
+@end defun
+
+@defun ordered-for-each-key handle procedure
+Calls @var{procedure} once with each @var{key} in the table opened in
+@var{handle} in the natural order for the types of the primary key
+fields of that table.  An unspecified value is returned.
+@end defun
+
+@defun present? handle key
+Returns a non-@code{#f} value if there is a row associated with
+@var{key} in the table opened in @var{handle} and @code{#f} otherwise.
+@end defun
+
+@defun delete handle key
+Removes the row associated with @var{key} from the table opened in
+@var{handle}.  An unspecified value is returned.
+@end defun
+
+@defun make-getter key-dimension types
+Returns a procedure which takes arguments @var{handle} and @var{key}.
+This procedure returns a list of the non-primary values of the relation
+(in the base table opened in @var{handle}) whose primary key is
+@var{key} if it exists, and @code{#f} otherwise.
+@end defun
+
+@defun make-putter key-dimension types
+Returns a procedure which takes arguments @var{handle} and @var{key} and
+@var{value-list}.  This procedure associates the primary key @var{key}
+with the values in @var{value-list} (in the base table opened in
+@var{handle}) and returns an unspecified value.
+@end defun
+
+@defun supported-type? symbol
+Returns @code{#t} if @var{symbol} names a type allowed as a column value
+by the implementation, and @code{#f} otherwise.  At a minimum, an
+implementation must support the types @code{integer}, @code{symbol},
+@code{string}, @code{boolean}, and @code{base-id}.
+@end defun
+
+@defun supported-key-type? symbol
+Returns @code{#t} if @var{symbol} names a type allowed as a key value by
+the implementation, and @code{#f} otherwise.  At a minimum, an
+implementation must support the types @code{integer}, and @code{symbol}.
+@end defun
+
+@table @code
+@item integer
+Scheme exact integer.
+@item symbol
+Scheme symbol.
+@item boolean
+@code{#t} or @code{#f}.
+@item base-id
+Objects suitable for passing as the @var{base-id} parameter to
+@code{open-table}.  The value of @var{catalog-id} must be an acceptable
+@code{base-id}.
+@end table
+
+@node Relational Database, Weight-Balanced Trees, Base Table, Data Structures
+@section Relational Database
+
+@code{(require 'relational-database)}
+
+This package implements a database system inspired by the Relational
+Model (@cite{E. F. Codd, A Relational Model of Data for Large Shared
+Data Banks}).  An SLIB relational database implementation can be created
+from any @ref{Base Table} implementation.
+
+@menu
+* Motivations::                 Database Manifesto
+* Creating and Opening Relational Databases::  
+* Relational Database Operations::  
+* Table Operations::            
+* Catalog Representation::      
+* Unresolved Issues::           
+* Database Utilities::          'database-utilities
+@end menu
+
+@node Motivations, Creating and Opening Relational Databases, Relational Database, Relational Database
+@subsection Motivations
+
+Most nontrivial programs contain databases: Makefiles, configure
+scripts, file backup, calendars, editors, source revision control, CAD
+systems, display managers, menu GUIs, games, parsers, debuggers,
+profilers, and even error reporting are all rife with databases.  Coding
+databases is such a common activity in programming that many may not be
+aware of how often they do it.
+
+A database often starts as a dispatch in a program.  The author, perhaps
+because of the need to make the dispatch configurable, the need for
+correlating dispatch in other routines, or because of changes or growth,
+devises a data structure to contain the information, a routine for
+interpreting that data structure, and perhaps routines for augmenting
+and modifying the stored data.  The dispatch must be converted into this
+form and tested.
+
+The programmer may need to devise an interactive program for enabling
+easy examination and modification of the information contained in this
+database.  Often, in an attempt to foster modularity and avoid delays in
+release, intermediate file formats for the database information are
+devised.  It often turns out that users prefer modifying these
+intermediate files with a text editor to using the interactive program
+in order to do operations (such as global changes) not forseen by the
+program's author.
+
+In order to address this need, the concientous software engineer may
+even provide a scripting language to allow users to make repetitive
+database changes.  Users will grumble that they need to read a large
+manual and learn yet another programming language (even if it
+@emph{almost} has language "xyz" syntax) in order to do simple
+configuration.
+
+All of these facilities need to be designed, coded, debugged,
+documented, and supported; often causing what was very simple in concept
+to become a major developement project.
+
+This view of databases just outlined is somewhat the reverse of the view
+of the originators of the @dfn{Relational Model} of database
+abstraction.  The relational model was devised to unify and allow
+interoperation of large multi-user databases running on diverse
+platforms.  A fairly general purpose "Comprehensive Language" for
+database manipulations is mandated (but not specified) as part of the
+relational model for databases.
+
+One aspect of the Relational Model of some importance is that the
+"Comprehensive Language" must be expressible in some form which can be
+stored in the database.  This frees the programmer from having to make
+programs data-driven in order to use a database.
+
+This package includes as one of its basic supported types Scheme
+@dfn{expression}s.  This type allows expressions as defined by the
+Scheme standards to be stored in the database.  Using @code{slib:eval}
+retrieved expressions can be evaluated (in the top-level environment).
+Scheme's @code{lambda} facilitates closure of environments, modularity,
+etc. so that procedures (which could not be stored directly most
+databases) can still be effectively retrieved.  Since @code{slib:eval}
+evaluates expressions in the top-level environment, built-in and user
+defined procedures can be easily accessed by name.
+
+This package's purpose is to standardize (through a common interface)
+database creation and usage in Scheme programs.  The relational model's
+provision for inclusion of language expressions as data as well as the
+description (in tables, of course) of all of its tables assures that
+relational databases are powerful enough to assume the roles currently
+played by thousands of ad-hoc routines and data formats.
+
+@noindent
+Such standardization to a relational-like model brings many benefits:
+
+@itemize @bullet
+@item
+Tables, fields, domains, and types can be dealt with by name in
+programs.
+@item
+The underlying database implementation can be changed (for
+performance or other reasons) by changing a single line of code.
+@item
+The formats of tables can be easily extended or changed without
+altering code.
+@item
+Consistency checks are specified as part of the table descriptions.
+Changes in checks need only occur in one place.
+@item
+All the configuration information which the developer wishes to group
+together is easily grouped, without needing to change programs aware of
+only some of these tables.
+@item
+Generalized report generators, interactive entry programs, and other
+database utilities can be part of a shared library.  The burden of
+adding configurability to a program is greatly reduced.
+@item
+Scheme is the "comprehensive language" for these databases.  Scripting
+for configuration no longer needs to be in a separate language with
+additional documentation.
+@item
+Scheme's latent types mesh well with the strict typing and logical
+requirements of the relational model.
+@item
+Portable formats allow easy interchange of data.  The included table
+descriptions help prevent misinterpretation of format.
+@end itemize
+
+@node Creating and Opening Relational Databases, Relational Database Operations, Motivations, Relational Database
+@subsection Creating and Opening Relational Databases
+
+@defun make-relational-system base-table-implementation
+
+Returns a procedure implementing a relational database using the
+@var{base-table-implementation}.
+
+All of the operations of a base table implementation are accessed
+through a procedure defined by @code{require}ing that implementation.
+Similarly, all of the operations of the relational database
+implementation are accessed through the procedure returned by
+@code{make-relational-system}.  For instance, a new relational database
+could be created from the procedure returned by
+@code{make-relational-system} by:
+
+@example
+(require 'alist-table)
+(define relational-alist-system
+        (make-relational-system alist-table))
+(define create-alist-database
+        (relational-alist-system 'create-database))
+(define my-database
+        (create-alist-database "mydata.db"))
+@end example
+@end defun
+
+@noindent
+What follows are the descriptions of the methods available from
+relational system returned by a call to @code{make-relational-system}.
+
+@defun create-database filename
+
+Returns an open, nearly empty relational database associated with
+@var{filename}.  The only tables defined are the system catalog and
+domain table.  Calling the @code{close-database} method on this database
+and possibly other operations will cause @var{filename} to be written
+to.  If @var{filename} is @code{#f} a temporary, non-disk based database
+will be created if such can be supported by the underlying base table
+implelentation.  If the database cannot be created as specified
+@code{#f} is returned.  For the fields and layout of descriptor tables,
+@xref{Catalog Representation}
+@end defun
+
+@defun open-database filename mutable?
+
+Returns an open relational database associated with @var{filename}.  If
+@var{mutable?} is @code{#t}, this database will have methods capable of
+effecting change to the database.  If @var{mutable?} is @code{#f}, only
+methods for inquiring the database will be available.  Calling the
+@code{close-database} (and possibly other) method on a @var{mutable?}
+database will cause @var{filename} to be written to.  If the database
+cannot be opened as specified @code{#f} is returned.
+@end defun
+
+@node Relational Database Operations, Table Operations, Creating and Opening Relational Databases, Relational Database
+@subsection Relational Database Operations
+
+@noindent
+These are the descriptions of the methods available from an open
+relational database.  A method is retrieved from a database by calling
+the database with the symbol name of the operation.  For example:
+
+@example
+(define my-database
+        (create-alist-database "mydata.db"))
+(define telephone-table-desc
+        ((my-database 'create-table) 'telephone-table-desc))
+@end example
+
+@defun close-database
+Causes the relational database to be written to its associated file (if
+any).  If the write is successful, subsequent operations to this
+database will signal an error.  If the operations completed
+successfully, @code{#t} is returned.  Otherwise, @code{#f} is returned.
+@end defun
+
+@defun write-database filename
+Causes the relational database to be written to @var{filename}.  If the
+write is successful, also causes the database to henceforth be
+associated with @var{filename}.  Calling the @code{close-database} (and
+possibly other) method on this database will cause @var{filename} to be
+written to.  If @var{filename} is @code{#f} this database will be
+changed to a temporary, non-disk based database if such can be supported
+by the underlying base table implelentation.  If the operations
+completed successfully, @code{#t} is returned.  Otherwise, @code{#f} is
+returned.
+@end defun
+
+@defun table-exists? table-name
+Returns @code{#t} if @var{table-name} exists in the system catalog,
+otherwise returns @code{#f}.
+@end defun
+
+@defun open-table table-name mutable?
+Returns a @dfn{methods} procedure for an existing relational table in
+this database if it exists and can be opened in the mode indicated by
+@var{mutable?}, otherwise returns @code{#f}.
+@end defun
+
+@noindent
+These methods will be present only in databases which are
+@var{mutable?}.
+
+@defun delete-table table-name
+Removes and returns the @var{table-name} row from the system catalog if
+the table or view associated with @var{table-name} gets removed from the
+database, and @code{#f} otherwise.
+@end defun
+
+@defun create-table table-desc-name
+Returns a methods procedure for a new (open) relational table for
+describing the columns of a new base table in this database, otherwise
+returns @code{#f}.  For the fields and layout of descriptor tables,
+@xref{Catalog Representation}.
+
+@defunx create-table table-name table-desc-name
+Returns a methods procedure for a new (open) relational table with
+columns as described by @var{table-desc-name}, otherwise returns
+@code{#f}.
+@end defun
+
+@defun create-view ??
+@defunx project-table ??
+@defunx restrict-table ??
+@defunx cart-prod-tables ??
+Not yet implemented.
+@end defun
+
+@node Table Operations, Catalog Representation, Relational Database Operations, Relational Database
+@subsection Table Operations
+
+@noindent
+These are the descriptions of the methods available from an open
+relational table.  A method is retrieved from a table by calling
+the table with the symbol name of the operation.  For example:
+
+@example
+@group
+(define telephone-table-desc
+        ((my-database 'create-table) 'telephone-table-desc))
+(require 'common-list-functions)
+(define ndrp (telephone-table-desc 'row:insert))
+(ndrp '(1 #t name #f string))
+(ndrp '(2 #f telephone
+          (lambda (d)
+            (and (string? d) (> (string-length d) 2)
+                 (every
+                  (lambda (c)
+                    (memv c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+                                  #\+ #\( #\  #\) #\-)))
+                  (string->list d))))
+          string))
+@end group
+@end example
+
+@noindent
+Operations on a single column of a table are retrieved by giving the
+column name as the second argument to the methods procedure.  For
+example:
+
+@example
+(define column-ids ((telephone-table-desc 'get* 'column-number)))
+@end example
+
+@noindent
+Some operations described below require primary key arguments.  Primary
+keys arguments are denoted @var{key1} @var{key2} @dots{}.  It is an
+error to call an operation for a table which takes primary key arguments
+with the wrong number of primary keys for that table.
+
+@noindent
+The term @dfn{row} used below refers to a Scheme list of values (one for
+each column) in the order specified in the descriptor (table) for this
+table.  Missing values appear as @code{#f}.  Primary keys may not
+be missing.
+
+@defun get key1 key2 @dots{}
+Returns the value for the specified column of the row associated with
+primary keys @var{key1}, @var{key2} @dots{} if it exists, or @code{#f}
+otherwise.
+
+@defunx get*
+Returns a list of the values for the specified column for all rows in
+this table.
+
+@defunx row:retrieve key1 key2 @dots{}
+Returns the row associated with primary keys @var{key1}, @var{key2}
+@dots{} if it exists, or @code{#f} otherwise.
+
+@defunx row:retrieve*
+Returns a list of all rows in this table.
+@end defun
+
+@defun row:remove key1 key2 @dots{}
+Removes and returns the row associated with primary keys @var{key1},
+@var{key2} @dots{} if it exists, or @code{#f} otherwise.
+
+@defunx row:remove*
+Removes and returns a list of all rows in this table.
+@end defun
+
+@defun row:delete key1 key2 @dots{}
+Deletes the row associated with primary keys @var{key1}, @var{key2}
+@dots{} if it exists.  The value returned is unspecified.
+
+@defunx row:delete*
+Deletes all rows in this table.  The value returned is unspecified.  The
+descriptor table and catalog entry for this table are not affected.
+@end defun
+
+@defun row:update row
+Adds the row, @var{row}, to this table.  If a row for the primary key(s)
+specified by @var{row} already exists in this table, it will be
+overwritten.  The value returned is unspecified.
+
+@defunx row:update* rows
+Adds each row in the list @var{rows}, to this table.  If a row for the
+primary key specified by an element of @var{rows} already exists in this
+table, it will be overwritten.  The value returned is unspecified.
+@end defun
+
+@defun row:insert row
+Adds the row @var{row} to this table.  If a row for the primary key(s)
+specified by @var{row} already exists in this table an error is
+signaled.  The value returned is unspecified.
+
+@defunx row:insert* rows
+Adds each row in the list @var{rows}, to this table.  If a row for the
+primary key specified by an element of @var{rows} already exists in this
+table, an error is signaled.  The value returned is unspecified.
+@end defun
+
+@defun for-each-row proc
+Calls @var{proc} with each @var{row} in this table in the natural
+ordering for the primary key types.  @emph{Real} relational programmers
+would use some least-upper-bound join for every row to get them in
+order; But we don't have joins yet.
+@end defun
+
+@defun close-table
+Subsequent operations to this table will signal an error.
+@end defun
+
+@defvr Constant column-names
+@defvrx Constant column-foreigns
+@defvrx Constant column-domains
+@defvrx Constant column-types
+Return a list of the column names, foreign-key table names, domain
+names, or type names respectively for this table.  These 4 methods are
+different from the others in that the list is returned, rather than a
+procedure to obtain the list.
+
+@defvrx Constant primary-limit
+Returns the number of primary keys fields in the relations in this
+table.
+@end defvr
+
+@node Catalog Representation, Unresolved Issues, Table Operations, Relational Database
+@subsection Catalog Representation
+
+@noindent
+Each database (in an implementation) has a @dfn{system catalog} which
+describes all the user accessible tables in that database (including
+itself).
+
+@noindent
+The system catalog base table has the following fields.  @code{PRI}
+indicates a primary key for that table.
+
+@example
+@group
+PRI table-name
+    column-limit            the highest column number
+    coltab-name             descriptor table name
+    bastab-id               data base table identifier
+    user-integrity-rule
+    view-procedure          A scheme thunk which, when called,
+                            produces a handle for the view.  coltab
+                            and bastab are specified if and only if
+                            view-procedure is not.
+@end group
+@end example
+
+@noindent
+Descriptors for base tables (not views) are tables (pointed to by
+system catalog).  Descriptor (base) tables have the fields:
+
+@example
+@group
+PRI column-number           sequential integers from 1
+    primary-key?            boolean TRUE for primary key components
+    column-name
+    column-integrity-rule
+    domain-name
+@end group
+@end example
+
+@noindent
+A @dfn{primary key} is any column marked as @code{primary-key?} in the
+corresponding descriptor table.  All the @code{primary-key?} columns
+must have lower column numbers than any non-@code{primary-key?} columns.
+Every table must have at least one primary key.  Primary keys must be
+sufficient to distinguish all rows from each other in the table.  All of
+the system defined tables have a single primary key.
+
+@noindent
+This package currently supports tables having from 1 to 4 primary keys
+if there are non-primary columns, and any (natural) number if @emph{all}
+columns are primary keys.  If you need more than 4 primary keys, I would
+like to hear what you are doing!
+
+@noindent
+A @dfn{domain} is a category describing the allowable values to occur in
+a column.  It is described by a (base) table with the fields:
+
+@example
+@group
+PRI domain-name
+    foreign-table
+    domain-integrity-rule
+    type-id
+    type-param
+@end group
+@end example
+
+@noindent
+The @dfn{type-id} field value is a symbol.  This symbol may be used by
+the underlying base table implementation in storing that field.
+
+@noindent
+If the @code{foreign-table} field is non-@code{#f} then that field names
+a table from the catalog.  The values for that domain must match a
+primary key of the table referenced by the @var{type-param} (or
+@code{#f}, if allowed).  This package currently does not support
+composite foreign-keys.
+
+@noindent
+The types for which support is planned are:
+@example
+@group
+    atom
+    symbol
+    string                  [<length>]
+    number                  [<base>]
+    money                   <currency>
+    date-time
+    boolean
+
+    foreign-key             <table-name>
+    expression
+    virtual                 <expression>
+@end group
+@end example
+
+@node Unresolved Issues, Database Utilities, Catalog Representation, Relational Database
+@subsection Unresolved Issues
+
+Although @file{rdms.scm} is not large I found it very difficult to write
+(six rewrites).  I am not aware of any other examples of a generalized
+relational system (although there is little new in CS).  I left out
+several aspects of the Relational model in order to simplify the job.
+The major features lacking (which might be addressed portably) are
+views, transaction boundaries, and protection.
+
+Protection needs a model for specifying priveledges.  Given how
+operations are accessed from handles it should not be difficult to
+restrict table accesses to those allowed for that user.
+
+The system catalog has a field called @code{view-procedure}.  This
+should allow a purely functional implementation of views.  This will
+work but is unsatisfying for views resulting from a @dfn{select}ion
+(subset of rows); for whole table operations it will not be possible to
+reduce the number of keys scanned over when the selection is specified
+only by an opaque procedure.
+
+Transaction boundaries present the most intriguing area.  Transaction
+boundaries are actually a feature of the "Comprehensive Language" of the
+Relational database and not of the database.  Scheme would seem to
+provide the opportunity for an extremely clean semantics for transaction
+boundaries since the builtin procedures with side effects are small in
+number and easily identified.
+
+These side-effect builtin procedures might all be portably redefined to
+versions which properly handled transactions.  Compiled library routines
+would need to be recompiled as well.  Many system extensions
+(delete-file, system, etc.) would also need to be redefined.
+
+@noindent
+There are 2 scope issues that must be resolved for multiprocess
+transaction boundaries:
+
+@table @asis
+@item Process scope
+The actions captured by a transaction should be only for the process
+which invoked the start of transaction.  Although standard Scheme does
+not provide process primitives as such, @code{dynamic-wind} would
+provide a workable hook into process switching for many implementations.
+@item Shared utilities with state
+Some shared utilities have state which should @emph{not} be part of a
+transaction.  An example would be calling a pseudo-random number
+generator.  If the success of a transaction depended on the
+pseudo-random number and failed, the state of the generator would be set
+back.  Subsequent calls would keep returning the same number and keep
+failing.
+
+Pseudo-random number generators are not reentrant and so would require
+locks in order to operate properly in a multiprocess environment.  Are
+all examples of utilities whose state should not part of transactions
+also non-reentrant?  If so, perhaps suspending transaction capture for
+the duration of locks would fix it.
+@end table
+
+@node Database Utilities,  , Unresolved Issues, Relational Database
+@subsection Database Utilities
+
+@code{(require 'database-utilities)}
+
+@noindent
+This enhancement wraps a utility layer on @code{relational-database}
+which provides:
+@itemize @bullet
+@item
+Automatic loading of the appropriate base-table package when opening a
+database.
+@item
+Automatic execution of initialization commands stored in database.
+@item
+Transparent execution of database commands stored in @code{*commands*}
+table in database.
+@end itemize
+
+@noindent
+Also included are utilities which provide:
+@itemize @bullet
+@item
+Data definition from Scheme lists and
+@item
+Report generation
+@end itemize
+@noindent
+for any SLIB relational database.
+
+@defun create-database filename base-table-type
+Returns an open, nearly empty enhanced (with @code{*commands*} table)
+relational database (with base-table type @var{base-table-type})
+associated with @var{filename}.
+@end defun
+
+@defun open-database filename
+@defunx open-database filename base-table-type
+Returns an open enchanced relational database associated with
+@var{filename}.  The database will be opened with base-table type
+@var{base-table-type}) if supplied.  If @var{base-table-type} is not
+supplied, @code{open-database} will attempt to deduce the correct
+base-table-type.  If the database can not be opened or if it lacks the
+@code{*commands*} table, @code{#f} is returned.
+
+@defunx open-database! filename
+@defunx open-database! filename base-table-type
+Returns @emph{mutable} open enchanced relational database @dots{}
+@end defun
+
+@noindent
+The table @code{*commands*} in an @dfn{enhanced} relational-database has
+the fields (with domains):
+@example
+@group
+PRI name        symbol
+    parameters  parameter-list
+    procedure   expression
+    documentation string
+@end group
+@end example
+
+The @code{parameters} field is a foreign key (domain
+@code{parameter-list}) of the @code{*catalog-data*} table and should
+have the value of a table described by @code{*parameter-columns*}.  This
+@code{parameter-list} table describes the arguments suitable for passing
+to the associated command.  The intent of this table is to be of a form
+such that different user-interfaces (for instance, pull-down menus or
+plain-text queries) can operate from the same table.  A
+@code{parameter-list} table has the following fields:
+@example
+@group
+PRI index       uint
+    name        symbol
+    arity       parameter-arity
+    domain      domain
+    default     expression
+    documentation string
+@end group
+@end example
+
+The @code{arity} field can take the values:
+
+@table @code
+@item single
+Requires a single parameter of the specified domain.
+@item optional
+A single parameter of the specified domain or zero parameters is
+acceptable.
+@item boolean
+A single boolean parameter or zero parameters (in which case @code{#f}
+is substituted) is acceptable.
+@item nary
+Any number of parameters of the specified domain are acceptable.  The
+argument passed to the command function is always a list of the
+parameters.
+@item nary1
+One or more of parameters of the specified domain are acceptable.  The
+argument passed to the command function is always a list of the
+parameters.
+@end table
+
+The @code{domain} field specifies the domain which a parameter or
+parameters in the @code{index}th field must satisfy.
+
+The @code{default} field is an expression whose value is either
+@code{#f} or a procedure of no arguments which returns a parameter or
+parameter list as appropriate.  If the expression's value is @code{#f}
+then no default is appropriate for this parameter.  Note that since the
+@code{default} procedure is called every time a default parameter is
+needed for this column, @dfn{sticky} defaults can be implemented using
+shared state with the domain-integrity-rule.
+
+@subsubheading Invoking Commands
+
+When an enhanced relational-database is called with a symbol which
+matches a @var{name} in the @code{*commands*} table, the associated
+procedure expression is evaluated and applied to the enhanced
+relational-database.  A procedure should then be returned which the user
+can invoke on (optional) arguments.
+
+The command @code{*initialize*} is special.  If present in the
+@code{*commands*} table, @code{open-database} or @code{open-database!}
+will return the value of the @code{*initialize*} command.  Notice that
+arbitrary code can be run when the @code{*initialize*} procedure is
+automatically applied to the enhanced relational-database.
+
+Note also that if you wish to shadow or hide from the user
+relational-database methods described in @ref{Relational Database
+Operations}, this can be done by a dispatch in the closure returned by
+the @code{*initialize*} expression rather than by entries in the
+@code{*commands*} table if it is desired that the underlying methods
+remain accessible to code in the @code{*commands*} table.
+
+@defun make-command-server rdb table-name
+Returns a procedure of 2 arguments, a (symbol) command and a call-back
+procedure.  When this returned procedure is called, it looks up
+@var{command} in table @var{table-name} and calls the call-back
+procedure with arguments:
+@table @var
+@item command
+The @var{command}
+@item command-value
+The result of evaluating the expression in the @var{procedure} field of
+@var{table-name} and calling it with @var{rdb}.
+@item parameter-name
+A list of the @dfn{official} name of each parameter.  Corresponds to the
+@code{name} field of the @var{command}'s parameter-table.
+@item positions
+A list of the positive integer index of each parameter.  Corresponds to
+the @code{index} field of the @var{command}'s parameter-table.
+@item arities
+A list of the arities of each parameter.  Corresponds to the
+@code{arity} field of the @var{command}'s parameter-table.  For a
+description of @code{arity} see table above.
+@item defaults
+A list of the defaults for each parameter.  Corresponds to
+the @code{defaults} field of the @var{command}'s parameter-table.
+@item domain-integrity-rules
+A list of procedures (one for each parameter) which tests whether a
+value for a parameter is acceptable for that parameter.  The procedure
+should be called with each datum in the list for @code{nary} arity
+parameters.
+@item aliases
+A list of lists of @code{(@r{alias} @r{parameter-name})}.  There can be
+more than one alias per @var{parameter-name}.
+@end table
+@end defun
+
+For information about parameters, @xref{Parameter lists}.  Here is an
+example of setting up a command with arguments and parsing those
+arguments from a @code{getopt} style argument list (@pxref{Getopt}).
+
+@example
+(require 'database-utilities)
+(require 'parameters)
+(require 'getopt)
+
+(define my-rdb (create-database #f 'alist-table))
+
+(define-tables my-rdb
+  '(foo-params
+    *parameter-columns*
+    *parameter-columns*
+    ((1 first-argument single string "hithere" "first argument")
+     (2 flag boolean boolean #f "a flag")))
+  '(foo-pnames
+    ((name string))
+    ((parameter-index uint))
+    (("l" 1)
+     ("a" 2)))
+  '(my-commands
+    ((name symbol))
+    ((parameters parameter-list)
+     (parameter-names parameter-name-translation)
+     (procedure expression)
+     (documentation string))
+    ((foo
+      foo-params
+      foo-pnames
+      (lambda (rdb) (lambda (foo aflag) (print foo aflag)))
+      "test command arguments"))))
+
+(define (dbutil:serve-command-line rdb command-table
+                                   command argc argv)
+  (set! argv (if (vector? argv) (vector->list argv) argv))
+  ((make-command-server rdb command-table)
+   command
+   (lambda (comname comval options positions
+                    arities types defaults dirs aliases)
+     (apply comval (getopt->arglist argc argv options positions
+                                    arities types defaults dirs aliases)))))
+
+(define (test)
+  (set! *optind* 1)
+  (dbutil:serve-command-line
+   my-rdb 'my-commands 'foo 4 '("dummy" "-l" "foo" "-a")))
+(test)
+@print{}
+"foo" #t
+@end example
+
+Some commands are defined in all extended relational-databases.  The are
+called just like @ref{Relational Database Operations}.
+
+@defun add-domain domain-row
+Adds @var{domain-row} to the @dfn{domains} table if there is no row in
+the domains table associated with key @code{(car @var{domain-row})} and
+returns @code{#t}.  Otherwise returns @code{#f}.
+
+For the fields and layout of the domain table, @xref{Catalog
+Representation}
+@end defun
+
+@defun delete-domain domain-name
+Removes and returns the @var{domain-name} row from the @dfn{domains}
+table.
+@end defun
+
+@defun domain-checker domain
+Returns a procedure to check an argument for conformance to domain
+@var{domain}.
+@end defun
+
+@subheading Defining Tables
+
+@deffn Procedure define-tables rdb spec-0 @dots{}
+Adds tables as specified in @var{spec-0} @dots{} to the open
+relational-database @var{rdb}.  Each @var{spec} has the form:
+
+@lisp
+(@r{<name>} @r{<descriptor-name>} @r{<descriptor-name>} @r{<rows>})
+@end lisp
+or
+@lisp
+(@r{<name>} @r{<primary-key-fields>} @r{<other-fields>} @r{<rows>})
+@end lisp
+
+where @r{<name>} is the table name, @r{<descriptor-name>} is the symbol
+name of a descriptor table, @r{<primary-key-fields>} and
+@r{<other-fields>} describe the primary keys and other fields
+respectively, and @r{<rows>} is a list of data rows to be added to the
+table.
+
+@r{<primary-key-fields>} and @r{<other-fields>} are lists of field
+descriptors of the form:
+
+@lisp
+(@r{<column-name>} @r{<domain>})
+@end lisp
+or
+@lisp
+(@r{<column-name>} @r{<domain>} @r{<column-integrity-rule>})
+@end lisp
+
+where @r{<column-name>} is the column name, @r{<domain>} is the domain
+of the column, and @r{<column-integrity-rule>} is an expression whose
+value is a procedure of one argument (and returns non-@code{#f} to
+signal an error).
+
+If @r{<domain>} is not a defined domain name and it matches the name of
+this table or an already defined (in one of @var{spec-0} @dots{}) single
+key field table, a foriegn-key domain will be created for it.
+@end deffn
+
+
+@deffn Procedure create-report rdb destination report-name table
+@deffnx Procedure create-report rdb destination report-name
+The symbol @var{report-name} must be primary key in the table named
+@code{*reports*} in the relational database @var{rdb}.
+@var{destination} is a port, string, or symbol.  If @var{destination} is
+a:
+
+@table @asis
+@item port
+The table is created as ascii text and written to that port.
+@item string
+The table is created as ascii text and written to the file named by
+@var{destination}.
+@item symbol
+@var{destination} is the primary key for a row in the table named *printers*.
+@end table
+
+Each row in the table *reports* has the fields:
+
+@table @asis
+@item name
+The report name.
+@item default-table
+The table to report on if none is specified.
+@item header, footer
+A @code{format} string.  At the beginning and end of each page
+respectively, @code{format} is called with this string and the (list of)
+column-names of this table.
+@item reporter
+A @code{format} string.  For each row in the table, @code{format} is
+called with this string and the row.
+@item minimum-break
+The minimum number of lines into which the report lines for a row can be
+broken.  Use @code{0} if a row's lines should not be broken over page
+boundaries.
+@end table
+
+Each row in the table *printers* has the fields:
+
+@table @asis
+@item name
+The printer name.
+@item print-procedure
+The procedure to call to actually print.
+@end table
+
+The report is prepared as follows:
+
+@itemize
+@item
+@code{Format} (@pxref{Format}) is called with the @code{header} field
+and the (list of) @code{column-names} of the table.
+@item
+@code{Format} is called with the @code{reporter} field and (on
+successive calls) each record in the natural order for the table.  A
+count is kept of the number of newlines output by format.  When the
+number of newlines to be output exceeds the number of lines per page,
+the set of lines will be broken if there are more than
+@code{minimum-break} left on this page and the number of lines for this
+row is larger or equal to twice @code{minimum-break}.
+@item
+@code{Format} is called with the @code{footer} field and the (list of)
+@code{column-names} of the table.  The footer field should not output a
+newline.
+@item
+A new page is output.
+@item
+This entire process repeats until all the rows are output.
+@end itemize
+@end deffn
+
+@noindent
+The following example shows a new database with the name of
+@file{foo.db} being created with tables describing processor families
+and processor/os/compiler combinations.
+
+@noindent
+The database command @code{define-tables} is defined to call
+@code{define-tables} with its arguments.  The database is also
+configured to print @samp{Welcome} when the database is opened.  The
+database is then closed and reopened.
+
+@example
+(require 'database-utilities)
+(define my-rdb (create-database "foo.db" 'alist-table))
+
+(define-tables my-rdb
+  '(*commands*
+    ((name symbol))
+    ((parameters parameter-list)
+     (procedure expression)
+     (documentation string))
+    ((define-tables
+      no-parameters
+      no-parameter-names
+      (lambda (rdb) (lambda specs (apply define-tables rdb specs)))
+      "Create or Augment tables from list of specs")
+     (*initialize*
+      no-parameters
+      no-parameter-names
+      (lambda (rdb) (display "Welcome") (newline) rdb)
+      "Print Welcome"))))
+
+((my-rdb 'define-tables)
+ '(processor-family
+   ((family    atom))
+   ((also-ran  processor-family))
+   ((m68000           #f)
+    (m68030           m68000)
+    (i386             8086)
+    (8086             #f)
+    (powerpc          #f)))
+
+ '(platform
+   ((name      symbol))
+   ((processor processor-family)
+    (os        symbol)
+    (compiler  symbol))
+   ((aix              powerpc aix     -)
+    (amiga-dice-c     m68000  amiga   dice-c)
+    (amiga-aztec      m68000  amiga   aztec)
+    (amiga-sas/c-5.10 m68000  amiga   sas/c)
+    (atari-st-gcc     m68000  atari   gcc)
+    (atari-st-turbo-c m68000  atari   turbo-c)
+    (borland-c-3.1    8086    ms-dos  borland-c)
+    (djgpp            i386    ms-dos  gcc)
+    (linux            i386    linux   gcc)
+    (microsoft-c      8086    ms-dos  microsoft-c)
+    (os/2-emx         i386    os/2    gcc)
+    (turbo-c-2        8086    ms-dos  turbo-c)
+    (watcom-9.0       i386    ms-dos  watcom))))
+
+((my-rdb 'close-database))
+
+(set! my-rdb (open-database "foo.db" 'alist-table))
+@print{}
+Welcome
+@end example
+
+@node Weight-Balanced Trees, Structures, Relational Database, Data Structures
+@section Weight-Balanced Trees
+
+@code{(require 'wt-tree)}
+
+@cindex trees, balanced binary
+@cindex balanced binary trees
+@cindex binary trees
+@cindex weight-balanced binary trees
+Balanced binary trees are a useful data structure for maintaining large
+sets of ordered objects or sets of associations whose keys are ordered.
+MIT Scheme has an comprehensive implementation of weight-balanced binary
+trees which has several advantages over the other data structures for
+large aggregates:
+
+@itemize @bullet
+@item
+In addition to the usual element-level operations like insertion,
+deletion and lookup, there is a full complement of collection-level
+operations, like set intersection, set union and subset test, all of
+which are implemented with good orders of growth in time and space.
+This makes weight balanced trees ideal for rapid prototyping of
+functionally derived specifications.
+
+@item
+An element in a tree may be indexed by its position under the ordering
+of the keys, and the ordinal position of an element may be determined,
+both with reasonable efficiency.
+
+@item
+Operations to find and remove minimum element make weight balanced trees
+simple to use for priority queues.
+
+@item
+The implementation is @emph{functional} rather than @emph{imperative}.
+This means that operations like `inserting' an association in a tree do
+not destroy the old tree, in much the same way that @code{(+ 1 x)}
+modifies neither the constant 1 nor the value bound to @code{x}.  The
+trees are referentially transparent thus the programmer need not worry
+about copying the trees.  Referential transparency allows space
+efficiency to be achieved by sharing subtrees.
+
+@end itemize
+
+These features make weight-balanced trees suitable for a wide range of
+applications, especially those that
+require large numbers of sets or discrete maps.  Applications that have
+a few global databases and/or concentrate on element-level operations like
+insertion and lookup are probably better off using hash-tables or
+red-black trees.
+
+The @emph{size} of a tree is the number of associations that it
+contains.  Weight balanced binary trees are balanced to keep the sizes
+of the subtrees of each node within a constant factor of each other.
+This ensures logarithmic times for single-path operations (like lookup
+and insertion).  A weight balanced tree takes space that is proportional
+to the number of associations in the tree.  For the current
+implementation, the constant of proportionality is six words per
+association.
+
+@cindex binary trees, as sets
+@cindex binary trees, as discrete maps
+@cindex sets, using binary trees
+@cindex discrete maps, using binary trees
+Weight balanced trees can be used as an implementation for either
+discrete sets or discrete maps (associations).  Sets are implemented by
+ignoring the datum that is associated with the key.  Under this scheme
+if an associations exists in the tree this indicates that the key of the
+association is a member of the set.  Typically a value such as
+@code{()}, @code{#t} or @code{#f} is associated with the key.
+
+Many operations can be viewed as computing a result that, depending on
+whether the tree arguments are thought of as sets or maps, is known by
+two different names.
+An example is @code{wt-tree/member?}, which, when
+regarding the tree argument as a set, computes the set membership operation, but,
+when regarding the tree as a discrete map, @code{wt-tree/member?} is the
+predicate testing if the map is defined at an element in its domain.
+Most names in this package have been chosen based on interpreting the
+trees as sets, hence the name @code{wt-tree/member?} rather than
+@code{wt-tree/defined-at?}.
+
+
+@cindex run-time-loadable option
+@cindex option, run-time-loadable
+The weight balanced tree implementation is a run-time-loadable option.
+To use weight balanced trees, execute
+
+@example
+(load-option 'wt-tree)
+@end example
+@findex load-option
+
+@noindent
+once before calling any of the procedures defined here.
+
+
+@menu
+* Construction of Weight-Balanced Trees::  
+* Basic Operations on Weight-Balanced Trees::  
+* Advanced Operations on Weight-Balanced Trees::  
+* Indexing Operations on Weight-Balanced Trees::  
+@end menu
+
+@node Construction of Weight-Balanced Trees, Basic Operations on Weight-Balanced Trees, Weight-Balanced Trees, Weight-Balanced Trees
+@subsection Construction of Weight-Balanced Trees
+
+Binary trees require there to be a total order on the keys used to
+arrange the elements in the tree.  Weight balanced trees are organized
+by @emph{types}, where the type is an object encapsulating the ordering
+relation.  Creating a tree is a two-stage process.  First a tree type
+must be created from the predicate which gives the ordering.  The tree type
+is then used for making trees, either empty or singleton trees or trees
+from other aggregate structures like association lists.  Once created, a
+tree `knows' its type and the type is used to test compatibility between
+trees in operations taking two trees.  Usually a small number of tree
+types are created at the beginning of a program and used many times
+throughout the program's execution.
+
+@deffn {procedure+} make-wt-tree-type key<?
+This procedure creates and returns a new tree type based on the ordering
+predicate @var{key<?}.
+@var{Key<?} must be a total ordering, having the property that for all
+key values @code{a}, @code{b} and @code{c}:
+
+@example
+(key<? a a)                         @result{} #f
+(and (key<? a b) (key<? b a))       @result{} #f
+(if (and (key<? a b) (key<? b c))
+    (key<? a c)
+    #t)                             @result{} #t
+@end example
+
+@noindent
+Two key values are assumed to be equal if neither is less than the other
+by @var{key<?}.
+
+Each call to @code{make-wt-tree-type} returns a distinct value, and
+trees are only compatible if their tree types are @code{eq?}.
+A consequence is 
+that trees that are intended to be used in binary tree operations must all be
+created with a tree type originating from the same call to
+@code{make-wt-tree-type}.
+@end deffn
+
+@defvr {variable+} number-wt-type
+A standard tree type for trees with numeric keys.  @code{Number-wt-type}
+could have been defined by
+
+@example
+(define number-wt-type (make-wt-tree-type  <))
+@end example
+@end defvr
+
+@defvr {variable+} string-wt-type
+A standard tree type for trees with string keys.  @code{String-wt-type}
+could have been defined by
+
+@example
+(define string-wt-type (make-wt-tree-type  string<?))
+@end example
+@end defvr
+
+
+
+@deffn {procedure+} make-wt-tree wt-tree-type
+This procedure creates and returns a newly allocated weight balanced
+tree.  The tree is empty, i.e. it contains no associations.
+@var{Wt-tree-type} is a weight balanced tree type obtained by calling
+@code{make-wt-tree-type}; the returned tree has this type.
+@end deffn
+
+@deffn {procedure+} singleton-wt-tree wt-tree-type key datum
+This procedure creates and returns a newly allocated weight balanced
+tree.  The tree contains a single association, that of @var{datum} with
+@var{key}.  @var{Wt-tree-type} is a weight balanced tree type obtained
+by calling @code{make-wt-tree-type}; the returned tree has this type.
+@end deffn
+
+@deffn {procedure+} alist->wt-tree tree-type alist
+Returns a newly allocated weight-balanced tree that contains the same
+associations as @var{alist}.  This procedure is equivalent to:
+
+@example
+(lambda (type alist)
+  (let ((tree (make-wt-tree type)))
+    (for-each (lambda (association)
+                (wt-tree/add! tree
+                              (car association)
+                              (cdr association)))
+              alist)
+    tree))
+@end example
+@end deffn
+
+
+
+@node Basic Operations on Weight-Balanced Trees, Advanced Operations on Weight-Balanced Trees, Construction of Weight-Balanced Trees, Weight-Balanced Trees
+@subsection Basic Operations on Weight-Balanced Trees
+
+This section describes the basic tree operations on weight balanced
+trees.  These operations are the usual tree operations for insertion,
+deletion and lookup, some predicates and a procedure for determining the
+number of associations in a tree.
+
+@deffn {procedure+} wt-tree? object
+Returns @code{#t} if @var{object} is a weight-balanced tree, otherwise
+returns @code{#f}.
+@end deffn
+
+@deffn {procedure+} wt-tree/empty? wt-tree
+Returns @code{#t} if @var{wt-tree} contains no associations, otherwise
+returns @code{#f}.
+@end deffn
+
+@deffn {procedure+} wt-tree/size wt-tree
+Returns the number of associations in @var{wt-tree}, an exact
+non-negative integer.  This operation takes constant time.
+@end deffn
+
+
+@deffn {procedure+} wt-tree/add wt-tree key datum
+Returns a new tree containing all the associations in @var{wt-tree} and
+the association of @var{datum} with @var{key}.  If @var{wt-tree} already
+had an association for @var{key}, the new association overrides the old.
+The average and worst-case times required by this operation are
+proportional to the logarithm of the number of associations in
+@var{wt-tree}.
+@end deffn
+
+@deffn {procedure+} wt-tree/add! wt-tree key datum
+Associates @var{datum} with @var{key} in @var{wt-tree} and returns an
+unspecified value.  If @var{wt-tree} already has an association for
+@var{key}, that association is replaced.  The average and worst-case
+times required by this operation are proportional to the logarithm of
+the number of associations in @var{wt-tree}.
+@end deffn
+
+@deffn {procedure+} wt-tree/member? key wt-tree
+Returns @code{#t} if @var{wt-tree} contains an association for
+@var{key}, otherwise returns @code{#f}.  The average and worst-case
+times required by this operation are proportional to the logarithm of
+the number of associations in @var{wt-tree}.
+@end deffn
+
+@deffn {procedure+} wt-tree/lookup wt-tree key default
+Returns the datum associated with @var{key} in @var{wt-tree}.  If
+@var{wt-tree} doesn't contain an association for @var{key},
+@var{default} is returned.  The average and worst-case times required by
+this operation are proportional to the logarithm of the number of
+associations in @var{wt-tree}.
+@end deffn
+
+@deffn {procedure+} wt-tree/delete wt-tree key
+Returns a new tree containing all the associations in @var{wt-tree},
+except that if @var{wt-tree} contains an association for @var{key}, it
+is removed from the result.  The average and worst-case times required
+by this operation are proportional to the logarithm of the number of
+associations in @var{wt-tree}.
+@end deffn
+
+@deffn {procedure+} wt-tree/delete! wt-tree key
+If @var{wt-tree} contains an association for @var{key} the association
+is removed.  Returns an unspecified value.  The average and worst-case
+times required by this operation are proportional to the logarithm of
+the number of associations in @var{wt-tree}.
+@end deffn
+
+
+@node Advanced Operations on Weight-Balanced Trees, Indexing Operations on Weight-Balanced Trees, Basic Operations on Weight-Balanced Trees, Weight-Balanced Trees
+@subsection Advanced Operations on Weight-Balanced Trees
+
+In the following the @emph{size} of a tree is the number of associations
+that the tree contains, and a @emph{smaller} tree contains fewer
+associations.
+
+@deffn {procedure+} wt-tree/split< wt-tree bound
+Returns a new tree containing all and only the associations in
+@var{wt-tree} which have a key that is less than @var{bound} in the
+ordering relation of the tree type of @var{wt-tree}.  The average and
+worst-case times required by this operation are proportional to the
+logarithm of the size of @var{wt-tree}.
+@end deffn
+
+@deffn {procedure+} wt-tree/split> wt-tree bound
+Returns a new tree containing all and only the associations in
+@var{wt-tree} which have a key that is greater than @var{bound} in the
+ordering relation of the tree type of @var{wt-tree}.  The average and
+worst-case times required by this operation are proportional to the
+logarithm of size of @var{wt-tree}.
+@end deffn
+
+@deffn {procedure+} wt-tree/union wt-tree-1 wt-tree-2
+Returns a new tree containing all the associations from both trees.
+This operation is asymmetric: when both trees have an association for
+the same key, the returned tree associates the datum from @var{wt-tree-2}
+with the key.  Thus if the trees are viewed as discrete maps then
+@code{wt-tree/union} computes the map override of @var{wt-tree-1} by
+@var{wt-tree-2}.  If the trees are viewed as sets the result is the set
+union of the arguments.
+The worst-case time required by this operation
+is proportional to the sum of the sizes of both trees.
+If the minimum key of one tree is greater than the maximum key of
+the other tree then the time required is at worst proportional to
+the logarithm of the size of the larger tree.
+@end deffn
+
+@deffn {procedure+} wt-tree/intersection wt-tree-1 wt-tree-2
+Returns a new tree containing all and only those associations from
+@var{wt-tree-1} which have keys appearing as the key of an association
+in @var{wt-tree-2}.  Thus the associated data in the result are those
+from @var{wt-tree-1}.  If the trees are being used as sets the result is
+the set intersection of the arguments.  As a discrete map operation,
+@code{wt-tree/intersection} computes the domain restriction of
+@var{wt-tree-1} to (the domain of) @var{wt-tree-2}.
+The time required by this operation is never worse that proportional to
+the sum of the sizes of the trees.
+@end deffn
+
+@deffn {procedure+} wt-tree/difference wt-tree-1 wt-tree-2
+Returns a new tree containing all and only those associations from
+@var{wt-tree-1} which have keys that @emph{do not} appear as the key of
+an association in @var{wt-tree-2}.  If the trees are viewed as sets the
+result is the asymmetric set difference of the arguments.  As a discrete
+map operation, it computes the domain restriction of @var{wt-tree-1} to
+the complement of (the domain of) @var{wt-tree-2}.
+The time required by this operation is never worse that proportional to
+the sum of the sizes of the trees.
+@end deffn
+
+
+@deffn {procedure+} wt-tree/subset? wt-tree-1 wt-tree-2
+Returns @code{#t} iff the key of each association in @var{wt-tree-1} is
+the key of some association in @var{wt-tree-2}, otherwise returns @code{#f}.
+Viewed as a set operation, @code{wt-tree/subset?} is the improper subset
+predicate.
+A proper subset predicate can be constructed:
+
+@example
+(define (proper-subset? s1 s2)
+  (and (wt-tree/subset? s1 s2)
+       (< (wt-tree/size s1) (wt-tree/size s2))))
+@end example
+
+As a discrete map operation, @code{wt-tree/subset?} is the subset
+test on the domain(s) of the map(s).  In the worst-case the time
+required by this operation is proportional to the size of
+@var{wt-tree-1}.
+@end deffn
+
+
+@deffn {procedure+} wt-tree/set-equal? wt-tree-1 wt-tree-2
+Returns @code{#t} iff for every association in @var{wt-tree-1} there is
+an association in @var{wt-tree-2} that has the same key, and @emph{vice
+versa}.
+
+Viewing the arguments as sets @code{wt-tree/set-equal?} is the set
+equality predicate.  As a map operation it determines if two maps are
+defined on the same domain.
+
+This procedure is equivalent to
+
+@example
+(lambda (wt-tree-1 wt-tree-2)
+  (and (wt-tree/subset? wt-tree-1 wt-tree-2
+       (wt-tree/subset? wt-tree-2 wt-tree-1)))
+@end example
+
+In the worst-case the time required by this operation is proportional to
+the size of the smaller tree.
+@end deffn
+
+
+@deffn {procedure+} wt-tree/fold combiner initial wt-tree
+This procedure reduces @var{wt-tree} by combining all the associations,
+using an reverse in-order traversal, so the associations are visited in
+reverse order.  @var{Combiner} is a procedure of three arguments: a key,
+a datum and the accumulated result so far.  Provided @var{combiner}
+takes time bounded by a constant, @code{wt-tree/fold} takes time
+proportional to the size of @var{wt-tree}.
+
+A sorted association list can be derived simply:
+
+@example
+(wt-tree/fold  (lambda (key datum list)
+                 (cons (cons key datum) list))
+               '()
+               @var{wt-tree}))
+@end example
+
+The data in the associations can be summed like this:
+
+@example
+(wt-tree/fold  (lambda (key datum sum) (+ sum datum))
+               0
+               @var{wt-tree})
+@end example
+@end deffn
+
+@deffn {procedure+} wt-tree/for-each action wt-tree
+This procedure traverses the tree in-order, applying @var{action} to
+each association.
+The associations are processed in increasing order of their keys.
+@var{Action} is a procedure of two arguments which take the key and
+datum respectively of the association.
+Provided @var{action} takes time bounded by a constant,
+@code{wt-tree/for-each} takes time proportional to in the size of
+@var{wt-tree}.
+The example prints the tree:
+
+@example
+(wt-tree/for-each (lambda (key value)
+                    (display (list key value)))
+                  @var{wt-tree}))
+@end example
+@end deffn
+
+
+@node Indexing Operations on Weight-Balanced Trees,  , Advanced Operations on Weight-Balanced Trees, Weight-Balanced Trees
+@subsection Indexing Operations on Weight-Balanced Trees
+
+Weight balanced trees support operations that view the tree as sorted
+sequence of associations.  Elements of the sequence can be accessed by
+position, and the position of an element in the sequence can be
+determined, both in logarthmic time.
+
+@deffn {procedure+} wt-tree/index wt-tree index
+@deffnx {procedure+} wt-tree/index-datum wt-tree index
+@deffnx {procedure+} wt-tree/index-pair wt-tree index
+Returns the 0-based @var{index}th association of @var{wt-tree} in the
+sorted sequence under the tree's ordering relation on the keys.
+@code{wt-tree/index} returns the @var{index}th key,
+@code{wt-tree/index-datum} returns the datum associated with the
+@var{index}th key and @code{wt-tree/index-pair} returns a new pair
+@code{(@var{key} . @var{datum})} which is the @code{cons} of the @var{index}th
+key and its datum.  The average and worst-case times required by this
+operation are proportional to the logarithm of the number of
+associations in the tree.
+
+These operations signal an error if the tree is empty, if
+@var{index}@code{<0}, or if @var{index} is greater than or equal to the
+number of associations in the tree.
+
+Indexing can be used to find the median and maximum keys in the tree as
+follows:
+
+@example
+median:   (wt-tree/index @var{wt-tree} (quotient (wt-tree/size @var{wt-tree}) 2))
+
+maximum:  (wt-tree/index @var{wt-tree} (-1+ (wt-tree/size @var{wt-tree})))
+@end example
+@end deffn
+
+@deffn {procedure+} wt-tree/rank wt-tree key
+Determines the 0-based position of @var{key} in the sorted sequence of
+the keys under the tree's ordering relation, or @code{#f} if the tree
+has no association with for @var{key}.  This procedure returns either an
+exact non-negative integer or @code{#f}.  The average and worst-case
+times required by this operation are proportional to the logarithm of
+the number of associations in the tree.
+@end deffn
+
+@deffn {procedure+} wt-tree/min wt-tree
+@deffnx {procedure+} wt-tree/min-datum wt-tree
+@deffnx {procedure+} wt-tree/min-pair wt-tree
+Returns the association of @var{wt-tree} that has the least key under the tree's ordering relation.
+@code{wt-tree/min} returns the least key,
+@code{wt-tree/min-datum} returns the datum associated with the
+least key and @code{wt-tree/min-pair} returns a new pair
+@code{(key . datum)} which is the @code{cons} of the minimum key and its datum.
+The average and worst-case times required by this operation are
+proportional to the logarithm of the number of associations in the tree.
+
+These operations signal an error if the tree is empty.
+They could be written
+@example
+(define (wt-tree/min tree)        (wt-tree/index tree 0))
+(define (wt-tree/min-datum tree)  (wt-tree/index-datum tree 0))
+(define (wt-tree/min-pair tree)   (wt-tree/index-pair tree 0))
+@end example
+@end deffn
+
+@deffn {procedure+} wt-tree/delete-min wt-tree
+Returns a new tree containing all of the associations in @var{wt-tree}
+except the association with the least key under the @var{wt-tree}'s
+ordering relation.  An error is signalled if the tree is empty.  The
+average and worst-case times required by this operation are proportional
+to the logarithm of the number of associations in the tree.  This
+operation is equivalent to
+
+@example
+(wt-tree/delete @var{wt-tree} (wt-tree/min @var{wt-tree}))
+@end example
+@end deffn
+
+
+@deffn {procedure+} wt-tree/delete-min! wt-tree
+Removes the association with the least key under the @var{wt-tree}'s
+ordering relation.  An error is signalled if the tree is empty.  The
+average and worst-case times required by this operation are proportional
+to the logarithm of the number of associations in the tree.  This
+operation is equivalent to
+
+@example
+(wt-tree/delete! @var{wt-tree} (wt-tree/min @var{wt-tree}))
+@end example
+@end deffn
+
+
+
+@node Structures,  , Weight-Balanced Trees, Data Structures
+@section Structures
+
+@code{(require 'struct)} (uses defmacros)
+
+@code{defmacro}s which implement @dfn{records} from the book
+@cite{Essentials of Programming Languages} by Daniel P. Friedman, M.
+Wand and C.T. Haynes.  Copyright 1992 Jeff Alexander, Shinnder Lee, and
+Lewis Patterson@refill
+
+Matthew McDonald <mafm@@cs.uwa.edu.au> added field setters.
+
+@defmac define-record tag (var1 var2 @dots{})
+Defines several functions pertaining to record-name @var{tag}:
+
+@defun make-@var{tag} var1 var2 @dots{}
+@end defun
+@defun @var{tag}? obj
+@end defun
+@defun @var{tag}->var1 obj
+@end defun
+@defun @var{tag}->var2 obj
+@end defun
+@dots{}
+@defun set-@var{@var{tag}}-var1! obj val
+@end defun
+@defun set-@var{@var{tag}}-var2! obj val
+@end defun
+@dots{}
+
+Here is an example of its use.
+
+@example
+(define-record term (operator left right))
+@result{} #<unspecified>
+(define foo (make-term 'plus  1 2))
+@result{} foo
+(term-left foo)
+@result{} 1
+(set-term-left! foo 2345)
+@result{} #<unspecified>
+(term-left foo)
+@result{} 2345
+@end example
+@end defmac
+
+@defmac variant-case exp (tag (var1 var2 @dots{}) body) @dots{}
+executes the following for the matching clause:
+
+@example
+((lambda (@var{var1} @var{var} @dots{}) @var{body})
+   (@var{tag->var1} @var{exp})
+   (@var{tag->var2} @var{exp}) @dots{})
+@end example
+@end defmac
+
+@node Macros, Numerics, Data Structures, Top
+@chapter Macros
+@menu
+* Defmacro::                    Supported by all implementations
+
+* R4RS Macros::                 'macro
+* Macro by Example::            'macro-by-example
+* Macros That Work::            'macros-that-work
+* Syntactic Closures::          'syntactic-closures
+* Syntax-Case Macros::          'syntax-case
+
+Syntax extensions (macros) included with SLIB.  Also @xref{Structures}.
+
+* Fluid-Let::                   'fluid-let
+* Yasos::                       'yasos, 'oop, 'collect
+@end menu
+
+
+@node Defmacro, R4RS Macros, Macros, Macros
+@section Defmacro
+
+Defmacros are supported by all implementations.
+@c See also @code{gentemp}, in @ref{Macros}.
+
+@defun gentemp
+Returns a new (interned) symbol each time it is called.  The symbol
+names are implementation-dependent
+@lisp
+(gentemp) @result{} scm:G0
+(gentemp) @result{} scm:G1
+@end lisp
+@end defun
+
+@defun defmacro:eval e
+Returns the @code{slib:eval} of expanding all defmacros in scheme
+expression @var{e}.
+@end defun
+
+@defun defmacro:load filename
+@var{filename} should be a string.  If filename names an existing file,
+the @code{defmacro:load} procedure reads Scheme source code expressions
+and definitions from the file and evaluates them sequentially.  These
+source code expressions and definitions may contain defmacro
+definitions.  The @code{macro:load} procedure does not affect the values
+returned by @code{current-input-port} and
+@code{current-output-port}.@refill
+@end defun
+
+@defun defmacro? sym
+Returns @code{#t} if @var{sym} has been defined by @code{defmacro},
+@code{#f} otherwise.
+@end defun
+
+@defun macroexpand-1 form
+@defunx macroexpand form
+If @var{form} is a macro call, @code{macroexpand-1} will expand the
+macro call once and return it.  A @var{form} is considered to be a macro
+call only if it is a cons whose @code{car} is a symbol for which a
+@code{defmacr} has been defined.
+
+@code{macroexpand} is similar to @code{macroexpand-1}, but repeatedly
+expands @var{form} until it is no longer a macro call.
+@end defun
+
+@defmac defmacro name lambda-list form @dots{}
+When encountered by @code{defmacro:eval}, @code{defmacro:macroexpand*},
+or @code{defmacro:load} defines a new macro which will henceforth be
+expanded when encountered by @code{defmacro:eval},
+@code{defmacro:macroexpand*}, or @code{defmacro:load}.
+@end defmac
+
+@subsection Defmacroexpand
+@code{(require 'defmacroexpand)}
+
+@defun defmacro:expand* e
+Returns the result of expanding all defmacros in scheme expression
+@var{e}.
+@end defun
+
+@node R4RS Macros, Macro by Example, Defmacro, Macros
+@section R4RS Macros
+
+@code{(require 'macro)} is the appropriate call if you want R4RS
+high-level macros but don't care about the low level implementation.  If
+an SLIB R4RS macro implementation is already loaded it will be used.
+Otherwise, one of the R4RS macros implemetations is loaded.
+
+The SLIB R4RS macro implementations support the following uniform
+interface:
+
+@defun macro:expand sexpression
+Takes an R4RS expression, macro-expands it, and returns the result of
+the macro expansion.
+@end defun
+
+@defun macro:eval sexpression
+Takes an R4RS expression, macro-expands it, evals the result of the
+macro expansion, and returns the result of the evaluation.
+@end defun
+
+@deffn Procedure macro:load filename
+@var{filename} should be a string.  If filename names an existing file,
+the @code{macro:load} procedure reads Scheme source code expressions and
+definitions from the file and evaluates them sequentially.  These source
+code expressions and definitions may contain macro definitions.  The
+@code{macro:load} procedure does not affect the values returned by
+@code{current-input-port} and @code{current-output-port}.@refill
+@end deffn
+
+@node  Macro by Example, Macros That Work, R4RS Macros, Macros
+@section Macro by Example
+
+@code{(require 'macro-by-example)}
+
+A vanilla implementation of @cite{Macro by Example} (Eugene Kohlbecker,
+R4RS) by Dorai Sitaram, (dorai@@cs.rice.edu) using @code{defmacro}.
+
+@itemize @bullet
+
+@item
+generating hygienic global @code{define-syntax} Macro-by-Example macros
+@strong{cheaply}.
+
+@item
+can define macros which use @code{...}.
+
+@item
+needn't worry about a lexical variable in a macro definition
+clashing with a variable from the macro use context
+
+@item
+don't suffer the overhead of redefining the repl if @code{defmacro}
+natively supported (most implementations)
+
+@end itemize
+@subsection Caveat
+These macros are not referentially transparent (@pxref{Macros, , ,r4rs,
+Revised(4) Scheme}).  Lexically scoped macros (i.e., @code{let-syntax}
+and @code{letrec-syntax}) are not supported.  In any case, the problem
+of referential transparency gains poignancy only when @code{let-syntax}
+and @code{letrec-syntax} are used.  So you will not be courting
+large-scale disaster unless you're using system-function names as local
+variables with unintuitive bindings that the macro can't use.  However,
+if you must have the full @cite{r4rs} macro functionality, look to the
+more featureful (but also more expensive) versions of syntax-rules
+available in slib @ref{Macros That Work}, @ref{Syntactic Closures}, and
+@ref{Syntax-Case Macros}.
+
+@defmac define-syntax keyword transformer-spec
+The @var{keyword} is an identifier, and the @var{transformer-spec}
+should be an instance of @code{syntax-rules}.
+
+The top-level syntactic environment is extended by binding the
+@var{keyword} to the specified transformer.
+
+@example
+(define-syntax let*
+  (syntax-rules ()
+    ((let* () body1 body2 ...)
+     (let () body1 body2 ...))
+    ((let* ((name1 val1) (name2 val2) ...)
+       body1 body2 ...)
+     (let ((name1 val1))
+       (let* (( name2 val2) ...)
+         body1 body2 ...)))))
+@end example
+@end defmac
+
+@defmac syntax-rules literals syntax-rule @dots{}
+@var{literals} is a list of identifiers, and each @var{syntax-rule}
+should be of the form
+
+@code{(@var{pattern} @var{template})}
+
+where the @var{pattern} and  @var{template} are as in the grammar above.
+
+An instance of @code{syntax-rules} produces a new macro transformer by
+specifying a sequence of hygienic rewrite rules.  A use of a macro whose
+keyword is associated with a transformer specified by
+@code{syntax-rules} is matched against the patterns contained in the
+@var{syntax-rule}s, beginning with the leftmost @var{syntax-rule}.
+When a match is found, the macro use is trancribed hygienically
+according to the template.
+
+Each pattern begins with the keyword for the macro.  This keyword is not
+involved in the matching and is not considered a pattern variable or
+literal identifier.
+@end defmac
+
+@node Macros That Work, Syntactic Closures, Macro by Example, Macros
+@section Macros That Work
+
+@code{(require 'macros-that-work)}
+
+@cite{Macros That Work} differs from the other R4RS macro
+implementations in that it does not expand derived expression types to
+primitive expression types.
+
+@defun macro:expand expression
+@defunx macwork:expand expression
+Takes an R4RS expression, macro-expands it, and returns the result of
+the macro expansion.
+@end defun
+
+@defun macro:eval expression
+@defunx macwork:eval expression
+@code{macro:eval} returns the value of @var{expression} in the current
+top level environment.  @var{expression} can contain macro definitions.
+Side effects of @var{expression} will affect the top level
+environment.@refill
+@end defun
+
+@deffn Procedure macro:load filename
+@deffnx Procedure macwork:load filename
+@var{filename} should be a string.  If filename names an existing file,
+the @code{macro:load} procedure reads Scheme source code expressions and
+definitions from the file and evaluates them sequentially.  These source
+code expressions and definitions may contain macro definitions.  The
+@code{macro:load} procedure does not affect the values returned by
+@code{current-input-port} and @code{current-output-port}.@refill
+@end deffn
+
+References:
+
+The @cite{Revised^4 Report on the Algorithmic Language Scheme} Clinger
+and Rees [editors].  To appear in LISP Pointers.  Also available as a
+technical report from the University of Oregon, MIT AI Lab, and
+Cornell.@refill
+
+@center Macros That Work.  Clinger and Rees.  POPL '91.
+
+The supported syntax differs from the R4RS in that vectors are allowed
+as patterns and as templates and are not allowed as pattern or template
+data.
+
+@example
+transformer spec  @expansion{}  (syntax-rules literals rules)
+
+rules  @expansion{}  ()
+         |  (rule . rules)
+
+rule  @expansion{}  (pattern template)
+
+pattern  @expansion{}  pattern_var      ; a symbol not in literals
+           |  symbol           ; a symbol in literals
+           |  ()
+           |  (pattern . pattern)
+           |  (ellipsis_pattern)
+           |  #(pattern*)                     ; extends R4RS
+           |  #(pattern* ellipsis_pattern)    ; extends R4RS
+           |  pattern_datum
+
+template  @expansion{}  pattern_var
+            |  symbol
+            |  ()
+            |  (template2 . template2)
+            |  #(template*)                   ; extends R4RS
+            |  pattern_datum
+
+template2  @expansion{}  template
+             |  ellipsis_template
+
+pattern_datum  @expansion{}  string                    ; no vector
+                 |  character
+                 |  boolean
+                 |  number
+
+ellipsis_pattern  @expansion{} pattern ...
+
+ellipsis_template  @expansion{}  template ...
+
+pattern_var  @expansion{}  symbol   ; not in literals
+
+literals  @expansion{}  ()
+            |  (symbol . literals)
+@end example
+
+@subsection Definitions
+
+@table @asis
+
+@item Scope of an ellipsis
+Within a pattern or template, the scope of an ellipsis (@code{...}) is
+the pattern or template that appears to its left.
+
+@item Rank of a pattern variable
+The rank of a pattern variable is the number of ellipses within whose
+scope it appears in the pattern.
+
+@item Rank of a subtemplate
+The rank of a subtemplate is the number of ellipses within whose scope
+it appears in the template.
+
+@item Template rank of an occurrence of a pattern variable
+The template rank of an occurrence of a pattern variable within a
+template is the rank of that occurrence, viewed as a subtemplate.
+
+@item Variables bound by a pattern
+The variables bound by a pattern are the pattern variables that appear
+within it.
+
+@item Referenced variables of a subtemplate
+The referenced variables of a subtemplate are the pattern variables that
+appear within it.
+
+@item Variables opened by an ellipsis template
+The variables opened by an ellipsis template are the referenced pattern
+variables whose rank is greater than the rank of the ellipsis template.
+
+@end table
+
+@subsection Restrictions
+
+No pattern variable appears more than once within a pattern.
+
+For every occurrence of a pattern variable within a template, the
+template rank of the occurrence must be greater than or equal to the
+pattern variable's rank.
+
+Every ellipsis template must open at least one variable.
+
+For every ellipsis template, the variables opened by an ellipsis
+template must all be bound to sequences of the same length.
+
+The compiled form of a @var{rule} is
+
+@example
+rule  @expansion{}  (pattern template inserted)
+
+pattern  @expansion{}  pattern_var
+           |  symbol
+           |  ()
+           |  (pattern . pattern)
+           |  ellipsis_pattern
+           |  #(pattern)
+           |  pattern_datum
+
+template  @expansion{}  pattern_var
+            |  symbol
+            |  ()
+            |  (template2 . template2)
+            |  #(pattern)
+            |  pattern_datum
+
+template2  @expansion{}  template
+             |  ellipsis_template
+
+pattern_datum  @expansion{}  string
+                 |  character
+                 |  boolean
+                 |  number
+
+pattern_var  @expansion{}  #(V symbol rank)
+
+ellipsis_pattern  @expansion{}  #(E pattern pattern_vars)
+
+ellipsis_template  @expansion{}  #(E template pattern_vars)
+
+inserted  @expansion{}  ()
+            |  (symbol . inserted)
+
+pattern_vars  @expansion{}  ()
+                |  (pattern_var . pattern_vars)
+
+rank  @expansion{}  exact non-negative integer
+@end example
+
+where V and E are unforgeable values.
+
+The pattern variables associated with an ellipsis pattern are the
+variables bound by the pattern, and the pattern variables associated
+with an ellipsis template are the variables opened by the ellipsis
+template.
+
+If the template contains a big chunk that contains no pattern variables
+or inserted identifiers, then the big chunk will be copied
+unnecessarily.  That shouldn't matter very often.
+
+
+
+
+
+@node Syntactic Closures, Syntax-Case Macros, Macros That Work, Macros
+@section Syntactic Closures
+
+@code{(require 'syntactic-closures)}
+
+@defun macro:expand expression
+@defunx synclo:expand expression
+Returns scheme code with the macros and derived expression types of
+@var{expression} expanded to primitive expression types.@refill
+@end defun
+
+@defun macro:eval expression
+@defunx synclo:eval expression
+@code{macro:eval} returns the value of @var{expression} in the current
+top level environment.  @var{expression} can contain macro definitions.
+Side effects of @var{expression} will affect the top level
+environment.@refill
+@end defun
+
+@deffn Procedure macro:load filename
+@deffnx Procedure synclo:load filename
+@var{filename} should be a string.  If filename names an existing file,
+the @code{macro:load} procedure reads Scheme source code expressions and
+definitions from the file and evaluates them sequentially.  These
+source code expressions and definitions may contain macro definitions.
+The @code{macro:load} procedure does not affect the values returned by
+@code{current-input-port} and @code{current-output-port}.@refill
+@end deffn
+
+@subsection Syntactic Closure Macro Facility
+
+@center A Syntactic Closures Macro Facility
+@center by Chris Hanson
+@center 9 November 1991
+
+This document describes @dfn{syntactic closures}, a low-level macro
+facility for the Scheme programming language.  The facility is an
+alternative to the low-level macro facility described in the
+@cite{Revised^4 Report on Scheme.} This document is an addendum to that
+report.
+
+The syntactic closures facility extends the BNF rule for
+@var{transformer spec} to allow a new keyword that introduces a
+low-level macro transformer:@refill
+@example
+@var{transformer spec} := (transformer @var{expression})
+@end example
+
+Additionally, the following procedures are added:
+@lisp
+make-syntactic-closure
+capture-syntactic-environment
+identifier?
+identifier=?
+@end lisp
+
+The description of the facility is divided into three parts.  The first
+part defines basic terminology.  The second part describes how macro
+transformers are defined.  The third part describes the use of
+@dfn{identifiers}, which extend the syntactic closure mechanism to be
+compatible with @code{syntax-rules}.@refill
+
+@subsubsection Terminology
+
+This section defines the concepts and data types used by the syntactic
+closures facility.
+
+@itemize
+
+@item @dfn{Forms} are the syntactic entities out of which programs are
+recursively constructed.  A form is any expression, any definition, any
+syntactic keyword, or any syntactic closure.  The variable name that
+appears in a @code{set!} special form is also a form.  Examples of
+forms:@refill
+@lisp
+17
+#t
+car
+(+ x 4)
+(lambda (x) x)
+(define pi 3.14159)
+if
+define
+@end lisp
+
+@item An @dfn{alias} is an alternate name for a given symbol.  It can
+appear anywhere in a form that the symbol could be used, and when quoted
+it is replaced by the symbol; however, it does not satisfy the predicate
+@code{symbol?}.  Macro transformers rarely distinguish symbols from
+aliases, referring to both as identifiers.@refill
+
+@item A @dfn{syntactic} environment maps identifiers to their
+meanings.  More precisely, it determines whether an identifier is a
+syntactic keyword or a variable.  If it is a keyword, the meaning is an
+interpretation for the form in which that keyword appears.  If it is a
+variable, the meaning identifies which binding of that variable is
+referenced.  In short, syntactic environments contain all of the
+contextual information necessary for interpreting the meaning of a
+particular form.@refill
+
+@item A @dfn{syntactic closure} consists of a form, a syntactic
+environment, and a list of identifiers.  All identifiers in the form
+take their meaning from the syntactic environment, except those in the
+given list.  The identifiers in the list are to have their meanings
+determined later.  A syntactic closure may be used in any context in
+which its form could have been used.  Since a syntactic closure is also
+a form, it may not be used in contexts where a form would be illegal.
+For example, a form may not appear as a clause in the cond special form.
+A syntactic closure appearing in a quoted structure is replaced by its
+form.@refill
+
+@end itemize
+
+@subsubsection Transformer Definition
+
+This section describes the @code{transformer} special form and the
+procedures @code{make-syntactic-closure} and
+@code{capture-syntactic-environment}.@refill
+
+@deffn Syntax transformer expression
+
+Syntax: It is an error if this syntax occurs except as a
+@var{transformer spec}.@refill
+
+Semantics: The @var{expression} is evaluated in the standard transformer
+environment to yield a macro transformer as described below.  This macro
+transformer is bound to a macro keyword by the special form in which the
+@code{transformer} expression appears (for example,
+@code{let-syntax}).@refill
+
+A @dfn{macro transformer} is a procedure that takes two arguments, a
+form and a syntactic environment, and returns a new form.  The first
+argument, the @dfn{input form}, is the form in which the macro keyword
+occurred.  The second argument, the @dfn{usage environment}, is the
+syntactic environment in which the input form occurred.  The result of
+the transformer, the @dfn{output form}, is automatically closed in the
+@dfn{transformer environment}, which is the syntactic environment in
+which the @code{transformer} expression occurred.@refill
+
+For example, here is a definition of a push macro using
+@code{syntax-rules}:@refill
+@lisp
+(define-syntax  push
+  (syntax-rules ()
+    ((push item list)
+     (set! list (cons item list)))))
+@end lisp
+
+Here is an equivalent definition using @code{transformer}:
+@lisp
+(define-syntax push
+  (transformer
+   (lambda (exp env)
+     (let ((item
+            (make-syntactic-closure env '() (cadr exp)))
+           (list
+            (make-syntactic-closure env '() (caddr exp))))
+       `(set! ,list (cons ,item ,list))))))
+@end lisp
+
+In this example, the identifiers @code{set!} and @code{cons} are closed
+in the transformer environment, and thus will not be affected by the
+meanings of those identifiers in the usage environment
+@code{env}.@refill
+
+Some macros may be non-hygienic by design.  For example, the following
+defines a loop macro that implicitly binds @code{exit} to an escape
+procedure.  The binding of @code{exit} is intended to capture free
+references to @code{exit} in the body of the loop, so @code{exit} must
+be left free when the body is closed:@refill
+@lisp
+(define-syntax loop
+  (transformer
+   (lambda (exp env)
+     (let ((body (cdr exp)))
+       `(call-with-current-continuation
+         (lambda (exit)
+           (let f ()
+             ,@@(map (lambda  (exp)
+                       (make-syntactic-closure env '(exit)
+                                               exp))
+                     body)
+             (f))))))))
+@end lisp
+
+To assign meanings to the identifiers in a form, use
+@code{make-syntactic-closure} to close the form in a syntactic
+environment.@refill
+@end deffn
+
+@defun make-syntactic-closure environment free-names form
+
+@var{environment} must be a syntactic environment, @var{free-names} must
+be a list of identifiers, and @var{form} must be a form.
+@code{make-syntactic-closure} constructs and returns a syntactic closure
+of @var{form} in @var{environment}, which can be used anywhere that
+@var{form} could have been used.  All the identifiers used in
+@var{form}, except those explicitly excepted by @var{free-names}, obtain
+their meanings from @var{environment}.@refill
+
+Here is an example where @var{free-names} is something other than the
+empty list.  It is instructive to compare the use of @var{free-names} in
+this example with its use in the @code{loop} example above: the examples
+are similar except for the source of the identifier being left
+free.@refill
+@lisp
+(define-syntax let1
+  (transformer
+   (lambda (exp env)
+     (let ((id (cadr exp))
+           (init (caddr exp))
+           (exp (cadddr exp)))
+       `((lambda (,id)
+           ,(make-syntactic-closure env (list id) exp))
+         ,(make-syntactic-closure env '() init))))))
+@end lisp
+
+@code{let1} is a simplified version of @code{let} that only binds a
+single identifier, and whose body consists of a single expression.  When
+the body expression is syntactically closed in its original syntactic
+environment, the identifier that is to be bound by @code{let1} must be
+left free, so that it can be properly captured by the @code{lambda} in
+the output form.@refill
+
+To obtain a syntactic environment other than the usage environment, use
+@code{capture-syntactic-environment}.@refill
+@end defun
+
+@defun capture-syntactic-environment procedure
+
+@code{capture-syntactic-environment} returns a form that will, when
+transformed, call @var{procedure} on the current syntactic environment.
+@var{procedure} should compute and return a new form to be transformed,
+in that same syntactic environment, in place of the form.@refill
+
+An example will make this clear.  Suppose we wanted to define a simple
+@code{loop-until} keyword equivalent to@refill
+@lisp
+(define-syntax loop-until
+  (syntax-rules ()
+    ((loop-until id init test return step)
+     (letrec ((loop
+               (lambda (id)
+                 (if test return (loop step)))))
+       (loop init)))))
+@end lisp
+
+The following attempt at defining @code{loop-until} has a subtle bug:
+@lisp
+(define-syntax loop-until
+  (transformer
+   (lambda (exp env)
+     (let ((id (cadr exp))
+           (init (caddr exp))
+           (test (cadddr exp))
+           (return (cadddr (cdr exp)))
+           (step (cadddr (cddr exp)))
+           (close
+            (lambda (exp free)
+              (make-syntactic-closure env free exp))))
+       `(letrec ((loop
+                  (lambda (,id)
+                    (if ,(close test (list id))
+                        ,(close return (list id))
+                        (loop ,(close step (list id)))))))
+          (loop ,(close init '())))))))
+@end lisp
+
+This definition appears to take all of the proper precautions to prevent
+unintended captures.  It carefully closes the subexpressions in their
+original syntactic environment and it leaves the @code{id} identifier
+free in the @code{test}, @code{return}, and @code{step} expressions, so
+that it will be captured by the binding introduced by the @code{lambda}
+expression.  Unfortunately it uses the identifiers @code{if} and
+@code{loop} within that @code{lambda} expression, so if the user of
+@code{loop-until} just happens to use, say, @code{if} for the
+identifier, it will be inadvertently captured.@refill
+
+The syntactic environment that @code{if} and @code{loop} want to be
+exposed to is the one just outside the @code{lambda} expression: before
+the user's identifier is added to the syntactic environment, but after
+the identifier loop has been added.
+@code{capture-syntactic-environment} captures exactly that environment
+as follows:@refill
+@lisp
+(define-syntax loop-until
+  (transformer
+   (lambda (exp env)
+     (let ((id (cadr exp))
+           (init (caddr exp))
+           (test (cadddr exp))
+           (return (cadddr (cdr exp)))
+           (step (cadddr (cddr exp)))
+           (close
+            (lambda (exp free)
+              (make-syntactic-closure env free exp))))
+       `(letrec ((loop
+                  ,(capture-syntactic-environment
+                    (lambda (env)
+                      `(lambda (,id)
+                         (,(make-syntactic-closure env '() `if)
+                          ,(close test (list id))
+                          ,(close return (list id))
+                          (,(make-syntactic-closure env '()
+                                                    `loop)
+                           ,(close step (list id)))))))))
+          (loop ,(close init '())))))))
+@end lisp
+
+In this case, having captured the desired syntactic environment, it is
+convenient to construct syntactic closures of the identifiers @code{if}
+and the @code{loop} and use them in the body of the
+@code{lambda}.@refill
+
+A common use of @code{capture-syntactic-environment} is to get the
+transformer environment of a macro transformer:@refill
+@lisp
+(transformer
+ (lambda (exp env)
+   (capture-syntactic-environment
+    (lambda (transformer-env)
+      ...))))
+@end lisp
+@end defun
+
+@subsubsection Identifiers
+
+This section describes the procedures that create and manipulate
+identifiers.  Previous syntactic closure proposals did not have an
+identifier data type -- they just used symbols.  The identifier data
+type extends the syntactic closures facility to be compatible with the
+high-level @code{syntax-rules} facility.@refill
+
+As discussed earlier, an identifier is either a symbol or an
+@dfn{alias}.  An alias is implemented as a syntactic closure whose
+@dfn{form} is an identifier:@refill
+@lisp
+(make-syntactic-closure env '() 'a)
+   @result{} an @dfn{alias}
+@end lisp
+
+Aliases are implemented as syntactic closures because they behave just
+like syntactic closures most of the time.  The difference is that an
+alias may be bound to a new value (for example by @code{lambda} or
+@code{let-syntax}); other syntactic closures may not be used this way.
+If an alias is bound, then within the scope of that binding it is looked
+up in the syntactic environment just like any other identifier.@refill
+
+Aliases are used in the implementation of the high-level facility
+@code{syntax-rules}.  A macro transformer created by @code{syntax-rules}
+uses a template to generate its output form, substituting subforms of
+the input form into the template.  In a syntactic closures
+implementation, all of the symbols in the template are replaced by
+aliases closed in the transformer environment, while the output form
+itself is closed in the usage environment.  This guarantees that the
+macro transformation is hygienic, without requiring the transformer to
+know the syntactic roles of the substituted input subforms.
+
+@defun identifier?  object
+Returns @code{#t} if @var{object} is an identifier, otherwise returns
+@code{#f}.  Examples:@refill
+@lisp
+(identifier? 'a)
+   @result{} #t
+(identifier? (make-syntactic-closure env '() 'a))
+   @result{} #t
+(identifier? "a")
+   @result{} #f
+(identifier? #\a)
+   @result{} #f
+(identifier? 97)
+   @result{} #f
+(identifier? #f)
+   @result{} #f
+(identifier? '(a))
+   @result{} #f
+(identifier? '#(a))
+   @result{} #f
+@end lisp
+
+The predicate @code{eq?} is used to determine if two identifers are
+``the same''.  Thus @code{eq?} can be used to compare identifiers
+exactly as it would be used to compare symbols.  Often, though, it is
+useful to know whether two identifiers ``mean the same thing''.  For
+example, the @code{cond} macro uses the symbol @code{else} to identify
+the final clause in the conditional.  A macro transformer for
+@code{cond} cannot just look for the symbol @code{else}, because the
+@code{cond} form might be the output of another macro transformer that
+replaced the symbol @code{else} with an alias.  Instead the transformer
+must look for an identifier that ``means the same thing'' in the usage
+environment as the symbol @code{else} means in the transformer
+environment.@refill
+@end defun
+
+@defun identifier=? environment1 identifier1 environment2 identifier2
+@var{environment1} and @var{environment2} must be syntactic
+environments, and @var{identifier1} and @var{identifier2} must be
+identifiers.  @code{identifier=?} returns @code{#t} if the meaning of
+@var{identifier1} in @var{environment1} is the same as that of
+@var{identifier2} in @var{environment2}, otherwise it returns @code{#f}.
+Examples:@refill
+
+@lisp
+(let-syntax
+    ((foo
+      (transformer
+       (lambda (form env)
+         (capture-syntactic-environment
+          (lambda (transformer-env)
+            (identifier=? transformer-env 'x env 'x)))))))
+  (list (foo)
+        (let ((x 3))
+          (foo))))
+   @result{} (#t #f)
+@end lisp
+
+@lisp
+(let-syntax ((bar foo))
+  (let-syntax
+      ((foo
+        (transformer
+         (lambda (form env)
+           (capture-syntactic-environment
+            (lambda (transformer-env)
+              (identifier=? transformer-env 'foo
+                            env (cadr form))))))))
+    (list (foo foo)
+          (foobar))))
+   @result{} (#f #t)
+@end lisp
+@end defun
+
+@subsubsection Acknowledgements
+
+The syntactic closures facility was invented by Alan Bawden and Jonathan
+Rees.  The use of aliases to implement @code{syntax-rules} was invented
+by Alan Bawden (who prefers to call them @dfn{synthetic names}).  Much
+of this proposal is derived from an earlier proposal by Alan
+Bawden.@refill
+
+
+
+
+
+@node Syntax-Case Macros, Fluid-Let, Syntactic Closures, Macros
+@section Syntax-Case Macros
+
+@code{(require 'syntax-case)}
+
+@defun macro:expand expression
+@defunx syncase:expand expression
+Returns scheme code with the macros and derived expression types of
+@var{expression} expanded to primitive expression types.@refill
+@end defun
+
+@defun macro:eval expression
+@defunx syncase:eval expression
+@code{macro:eval} returns the value of @var{expression} in the current
+top level environment.  @var{expression} can contain macro definitions.
+Side effects of @var{expression} will affect the top level
+environment.@refill
+@end defun
+
+@deffn Procedure macro:load filename
+@deffnx Procedure syncase:load filename
+@var{filename} should be a string.  If filename names an existing file,
+the @code{macro:load} procedure reads Scheme source code expressions and
+definitions from the file and evaluates them sequentially.  These
+source code expressions and definitions may contain macro definitions.
+The @code{macro:load} procedure does not affect the values returned by
+@code{current-input-port} and @code{current-output-port}.@refill
+@end deffn
+
+This is version 2.1 of @code{syntax-case}, the low-level macro facility
+proposed and implemented by Robert Hieb and R. Kent Dybvig.
+
+This version is further adapted by Harald Hanche-Olsen
+<hanche@@imf.unit.no> to make it compatible with, and easily usable
+with, SLIB.  Mainly, these adaptations consisted of:
+
+@itemize @bullet
+@item
+Removing white space from @file{expand.pp} to save space in the
+distribution.  This file is not meant for human readers anyway@dots{}
+
+@item
+Removed a couple of Chez scheme dependencies.
+
+@item
+Renamed global variables used to minimize the possibility of name
+conflicts.
+
+@item
+Adding an SLIB-specific initialization file.
+
+@item
+Removing a couple extra files, most notably the documentation (but see
+below).
+@end itemize
+
+If you wish, you can see exactly what changes were done by reading the
+shell script in the file @file{syncase.sh}.
+
+The two PostScript files were omitted in order to not burden the SLIB
+distribution with them.  If you do intend to use @code{syntax-case},
+however, you should get these files and print them out on a PostScript
+printer.  They are available with the original @code{syntax-case}
+distribution by anonymous FTP in
+@file{cs.indiana.edu:/pub/scheme/syntax-case}.@refill
+
+In order to use syntax-case from an interactive top level, execute:
+@lisp
+(require 'syntax-case)
+(require 'repl)
+(repl:top-level macro:eval)
+@end lisp
+See the section Repl (@xref{Repl}) for more information.
+
+To check operation of syntax-case get
+@file{cs.indiana.edu:/pub/scheme/syntax-case}, and type
+@lisp
+(require 'syntax-case)
+(syncase:sanity-check)
+@end lisp
+
+Beware that @code{syntax-case} takes a long time to load -- about 20s on
+a SPARCstation SLC (with SCM) and about 90s on a Macintosh SE/30 (with
+Gambit).
+
+@subsection Notes
+
+All R4RS syntactic forms are defined, including @code{delay}.  Along
+with @code{delay} are simple definitions for @code{make-promise} (into
+which @code{delay} expressions expand) and @code{force}.@refill
+
+@code{syntax-rules} and @code{with-syntax} (described in @cite{TR356})
+are defined.@refill
+
+@code{syntax-case} is actually defined as a macro that expands into
+calls to the procedure @code{syntax-dispatch} and the core form
+@code{syntax-lambda}; do not redefine these names.@refill
+
+Several other top-level bindings not documented in TR356 are created:
+@itemize
+@item the ``hooks'' in @file{hooks.ss}
+@item the @code{build-} procedures in @file{output.ss}
+@item @code{expand-syntax} (the expander)
+@end itemize
+
+The syntax of define has been extended to allow @code{(define @var{id})},
+which assigns @var{id} to some unspecified value.@refill
+
+We have attempted to maintain R4RS compatibility where possible.  The
+incompatibilities should be confined to @file{hooks.ss}.  Please let us
+know if there is some incompatibility that is not flagged as such.@refill
+
+Send bug reports, comments, suggestions, and questions to Kent Dybvig
+(dyb@@iuvax.cs.indiana.edu).
+
+@subsection Note from maintainer
+
+Included with the @code{syntax-case} files was @file{structure.scm}
+which defines a macro @code{define-structure}.  There is no
+documentation for this macro and it is not used by any code in SLIB.
+
+@node Fluid-Let, Yasos, Syntax-Case Macros, Macros
+@section Fluid-Let
+
+@code{(require 'fluid-let)}
+
+@deffn Syntax fluid-let @code{(@var{bindings} @dots{})} @var{forms}@dots{}
+@end deffn
+@lisp
+(fluid-let ((@var{variable} @var{init}) @dots{})
+   @var{expression} @var{expression} @dots{})
+@end lisp
+
+The @var{init}s are evaluated in the current environment (in some
+unspecified order), the current values of the @var{variable}s are saved,
+the results are assigned to the @var{variable}s, the @var{expression}s
+are evaluated sequentially in the current environment, the
+@var{variable}s are restored to their original values, and the value of
+the last @var{expression} is returned.@refill
+
+The syntax of this special form is similar to that of @code{let}, but
+@code{fluid-let} temporarily rebinds existing @var{variable}s.  Unlike
+@code{let}, @code{fluid-let} creates no new bindings; instead it
+@emph{assigns} the values of each @var{init} to the binding (determined
+by the rules of lexical scoping) of its corresponding
+@var{variable}.@refill
+
+
+@node Yasos,  , Fluid-Let, Macros
+@section Yasos
+
+@c Much of the documentation in this section was written by Dave Love
+@c (d.love@dl.ac.uk) -- don't blame Ken Dickey for its faults.
+@c but we can blame him for not writing it!
+
+@code{(require 'oop)} or @code{(require 'yasos)}
+
+`Yet Another Scheme Object System' is a simple object system for Scheme
+based on the paper by Norman Adams and Jonathan Rees: @cite{Object
+Oriented Programming in Scheme}, Proceedings of the 1988 ACM Conference
+on LISP and Functional Programming, July 1988 [ACM #552880].@refill
+
+Another reference is:
+
+Ken Dickey.
+@ifset html
+<A HREF="ftp://ftp.cs.indiana.edu/pub/scheme-repository/doc/pubs/swob.txt">
+@end ifset
+Scheming with Objects
+@ifset html
+</A>
+@end ifset
+@cite{AI Expert} Volume 7, Number 10 (October 1992), pp. 24-33.
+
+@menu
+* Yasos terms::                 Definitions and disclaimer.
+* Yasos interface::             The Yasos macros and procedures.
+* Setters::                     Dylan-like setters in Yasos.
+* Yasos examples::              Usage of Yasos and setters.
+@end menu
+
+@node Yasos terms, Yasos interface, Yasos, Yasos
+@subsection Terms
+
+@table @asis
+@item @dfn{Object}
+Any Scheme data object.
+
+@item @dfn{Instance}
+An instance of the OO system; an @dfn{object}.
+
+@item @dfn{Operation}
+A @var{method}.
+@end table
+
+@table @emph
+@item Notes:
+The object system supports multiple inheritance.  An instance can
+inherit from 0 or more ancestors.  In the case of multiple inherited
+operations with the same identity, the operation used is that from the
+first ancestor which contains it (in the ancestor @code{let}).  An
+operation may be applied to any Scheme data object---not just instances.
+As code which creates instances is just code, there are no @dfn{classes}
+and no meta-@var{anything}.  Method dispatch is by a procedure call a la
+CLOS rather than by @code{send} syntax a la Smalltalk.@refill
+
+@item Disclaimer:
+There are a number of optimizations which can be made.  This
+implementation is expository (although performance should be quite
+reasonable).  See the L&FP paper for some suggestions.@refill
+@end table
+
+
+
+
+
+@node Yasos interface, Setters, Yasos terms, Yasos
+@subsection Interface
+
+@deffn Syntax define-operation @code{(}opname self arg @dots{}@code{)} @var{default-body}
+Defines a default behavior for data objects which don't handle the
+operation @var{opname}.  The default default behavior (for an empty
+@var{default-body}) is to generate an error.@refill
+@end deffn
+
+@deffn Syntax define-predicate opname?
+Defines a predicate @var{opname?}, usually used for determining the
+@dfn{type} of an object, such that @code{(@var{opname?} @var{object})}
+returns @code{#t} if @var{object} has an operation @var{opname?} and
+@code{#f} otherwise.@refill
+@end deffn
+
+@deffn Syntax object @code{((@var{name} @var{self} @var{arg} @dots{}) @var{body})} @dots{}
+Returns an object (an instance of the object system) with operations.
+Invoking @code{(@var{name} @var{object} @var{arg} @dots{}} executes the
+@var{body} of the @var{object} with @var{self} bound to @var{object} and
+with argument(s) @var{arg}@dots{}.@refill
+@end deffn
+
+@deffn Syntax object-with-ancestors @code{((}ancestor1 init1@code{)} @dots{}@code{)} operation @dots{}
+A @code{let}-like form of @code{object} for multiple inheritance.  It
+returns an object inheriting the behaviour of @var{ancestor1} etc.  An
+operation will be invoked in an ancestor if the object itself does not
+provide such a method.  In the case of multiple inherited operations
+with the same identity, the operation used is the one found in the first
+ancestor in the ancestor list.
+@end deffn
+
+@deffn Syntax operate-as component operation self arg @dots{}
+Used in an operation definition (of @var{self}) to invoke the
+@var{operation} in an ancestor @var{component} but maintain the object's
+identity.  Also known as ``send-to-super''.@refill
+@end deffn
+
+@deffn Procedure print obj port
+A default @code{print} operation is provided which is just @code{(format
+@var{port} @var{obj})} (@xref{Format}) for non-instances and prints
+@var{obj} preceded by @samp{#<INSTANCE>} for instances.
+@end deffn
+
+@defun size obj
+The default method returns the number of elements in @var{obj} if it is
+a vector, string or list, @code{2} for a pair, @code{1} for a character
+and by default id an error otherwise.  Objects such as collections
+(@xref{Collections}) may override the default in an obvious way.@refill
+@end defun
+
+
+
+
+
+@node Setters, Yasos examples, Yasos interface, Yasos
+@subsection Setters
+
+@dfn{Setters} implement @dfn{generalized locations} for objects
+associated with some sort of mutable state.  A @dfn{getter} operation
+retrieves a value from a generalized location and the corresponding
+setter operation stores a value into the location.  Only the getter is
+named -- the setter is specified by a procedure call as below.  (Dylan
+uses special syntax.)  Typically, but not necessarily, getters are
+access operations to extract values from Yasos objects (@xref{Yasos}).
+Several setters are predefined, corresponding to getters @code{car},
+@code{cdr}, @code{string-ref} and @code{vector-ref} e.g., @code{(setter
+car)} is equivalent to @code{set-car!}.
+
+This implementation of setters is similar to that in Dylan(TM)
+(@cite{Dylan: An object-oriented dynamic language}, Apple Computer
+Eastern Research and Technology).  Common LISP provides similar
+facilities through @code{setf}.
+
+@defun setter getter
+Returns the setter for the procedure @var{getter}.  E.g., since
+@code{string-ref} is the getter corresponding to a setter which is
+actually @code{string-set!}:
+@example
+(define foo "foo")
+((setter string-ref) foo 0 #\F) ; set element 0 of foo
+foo @result{} "Foo"
+@end example
+@end defun
+
+@deffn Syntax set place new-value
+If @var{place} is a variable name, @code{set} is equivalent to
+@code{set!}.  Otherwise, @var{place} must have the form of a procedure
+call, where the procedure name refers to a getter and the call indicates
+an accessible generalized location, i.e., the call would return a value.
+The return value of @code{set} is usually unspecified unless used with a
+setter whose definition guarantees to return a useful value.
+@example
+(set (string-ref foo 2) #\O)  ; generalized location with getter
+foo @result{} "FoO"
+(set foo "foo")               ; like set!
+foo @result{} "foo"
+@end example
+@end deffn
+
+@deffn Procedure add-setter getter setter
+Add procedures @var{getter} and @var{setter} to the (inaccessible) list
+of valid setter/getter pairs.  @var{setter} implements the store
+operation corresponding to the @var{getter} access operation for the
+relevant state.  The return value is unspecified.
+@end deffn
+
+@deffn Procedure remove-setter-for getter
+Removes the setter corresponding to the specified @var{getter} from the
+list of valid setters.  The return value is unspecified.
+@end deffn
+
+@deffn Syntax define-access-operation getter-name
+Shorthand for a Yasos @code{define-operation} defining an operation
+@var{getter-name} that objects may support to return the value of some
+mutable state.  The default operation is to signal an error.  The return
+value is unspecified.
+@end deffn
+
+
+
+
+
+@node Yasos examples,  , Setters, Yasos
+@subsection Examples
+
+@lisp
+(define-operation (print obj port)
+  (format port
+          (if (instance? obj) "#<instance>" "~s")
+          obj))
+
+(define-operation (SIZE obj)
+  (cond
+   ((vector? obj) (vector-length obj))
+   ((list?   obj) (length obj))
+   ((pair?   obj) 2)
+   ((string? obj) (string-length obj))
+   ((char?   obj) 1)
+   (else
+    (error "Operation not supported: size" obj))))
+
+(define-predicate cell?)
+(define-operation (fetch obj))
+(define-operation (store! obj newValue))
+
+(define (make-cell value)
+  (object
+   ((cell? self) #t)
+   ((fetch self) value)
+   ((store! self newValue)
+    (set! value newValue)
+    newValue)
+   ((size self) 1)
+   ((print self port)
+    (format port "#<Cell: ~s>" (fetch self)))))
+
+(define-operation (discard obj value)
+  (format #t "Discarding ~s~%" value))
+
+(define (make-filtered-cell value filter)
+  (object-with-ancestors ((cell (make-cell value)))
+                         ((store! self newValue)
+                          (if (filter newValue)
+                              (store! cell newValue)
+                              (discard self newValue)))))
+
+(define-predicate array?)
+(define-operation (array-ref array index))
+(define-operation (array-set! array index value))
+
+(define (make-array num-slots)
+  (let ((anArray (make-vector num-slots)))
+    (object
+     ((array? self) #t)
+     ((size self) num-slots)
+     ((array-ref self index)           (vector-ref  anArray index))
+     ((array-set! self index newValue) (vector-set! anArray index newValue))
+     ((print self port) (format port "#<Array ~s>" (size self))))))
+
+(define-operation (position obj))
+(define-operation (discarded-value obj))
+
+(define (make-cell-with-history value filter size)
+  (let ((pos 0) (most-recent-discard #f))
+    (object-with-ancestors
+     ((cell (make-filtered-call value filter))
+      (sequence (make-array size)))
+     ((array? self) #f)
+     ((position self) pos)
+     ((store! self newValue)
+      (operate-as cell store! self newValue)
+      (array-set! self pos newValue)
+      (set! pos (+ pos 1)))
+     ((discard self value)
+      (set! most-recent-discard value))
+     ((discarded-value self) most-recent-discard)
+     ((print self port)
+      (format port "#<Cell-with-history ~s>" (fetch self))))))
+
+(define-access-operation fetch)
+(add-setter fetch store!)
+(define foo (make-cell 1))
+(print foo #f)
+@result{} "#<Cell: 1>"
+(set (fetch foo) 2)
+@result{}
+(print foo #f)
+@result{} "#<Cell: 2>"
+(fetch foo)
+@result{} 2
+@end lisp
+
+@node Numerics, Procedures, Macros, Top
+@chapter Numerics
+
+@menu
+* Bit-Twiddling::               'logical
+* Modular Arithmetic::          'modular
+* Prime Testing and Generation::  'primes
+* Prime Factorization::         'factor
+* Random Numbers::              'random
+* Cyclic Checksum::             'make-crc
+* Plotting::                    'charplot
+* Root Finding::                
+@end menu
+
+
+@node Bit-Twiddling, Modular Arithmetic, Numerics, Numerics
+@section Bit-Twiddling
+
+@code{(require 'logical)}
+
+The bit-twiddling functions are made available through the use of the
+@code{logical} package.  @code{logical} is loaded by inserting
+@code{(require 'logical)} before the code that uses these
+functions.@refill
+
+@defun logand n1 n1
+Returns the integer which is the bit-wise AND of the two integer
+arguments.
+
+Example:
+@lisp
+(number->string (logand #b1100 #b1010) 2)
+   @result{} "1000"
+@end lisp
+@end defun
+
+@defun logior n1 n2
+Returns the integer which is the bit-wise OR of the two integer
+arguments.
+
+Example:
+@lisp
+(number->string (logior #b1100 #b1010) 2)
+   @result{} "1110"
+@end lisp
+@end defun
+
+@defun logxor n1 n2
+Returns the integer which is the bit-wise XOR of the two integer
+arguments.
+
+Example:
+@lisp
+(number->string (logxor #b1100 #b1010) 2)
+   @result{} "110"
+@end lisp
+@end defun
+
+@defun lognot n
+Returns the integer which is the 2s-complement of the integer argument.
+
+Example:
+@lisp
+(number->string (lognot #b10000000) 2)
+   @result{} "-10000001"
+(number->string (lognot #b0) 2)
+   @result{} "-1"
+@end lisp
+@end defun
+
+@defun logtest j k
+@example
+(logtest j k) @equiv{} (not (zero? (logand j k)))
+
+(logtest #b0100 #b1011) @result{} #f
+(logtest #b0100 #b0111) @result{} #t
+@end example
+@end defun
+
+@defun logbit? index j
+@example
+(logbit? index j) @equiv{} (logtest (integer-expt 2 index) j)
+
+(logbit? 0 #b1101) @result{} #t
+(logbit? 1 #b1101) @result{} #f
+(logbit? 2 #b1101) @result{} #t
+(logbit? 3 #b1101) @result{} #t
+(logbit? 4 #b1101) @result{} #f
+@end example
+@end defun
+
+@defun ash int count
+Returns an integer equivalent to
+@code{(inexact->exact (floor (* @var{int} (expt 2 @var{count}))))}.@refill
+
+Example:
+@lisp
+(number->string (ash #b1 3) 2)
+   @result{} "1000"
+(number->string (ash #b1010 -1) 2)
+   @result{} "101"
+@end lisp
+@end defun
+
+@defun logcount n
+Returns the number of bits in integer @var{n}.  If integer is positive,
+the 1-bits in its binary representation are counted.  If negative, the
+0-bits in its two's-complement binary representation are counted.  If 0,
+0 is returned.
+
+Example:
+@lisp
+(logcount #b10101010)
+   @result{} 4
+(logcount 0)
+   @result{} 0
+(logcount -2)
+   @result{} 1
+@end lisp
+@end defun
+
+@defun integer-length n
+Returns the number of bits neccessary to represent @var{n}.
+
+Example:
+@lisp
+(integer-length #b10101010)
+   @result{} 8
+(integer-length 0)
+   @result{} 0
+(integer-length #b1111)
+   @result{} 4
+@end lisp
+@end defun
+
+@defun integer-expt n k
+Returns @var{n} raised to the non-negative integer exponent @var{k}.
+
+Example:
+@lisp
+(integer-expt 2 5)
+   @result{} 32
+(integer-expt -3 3)
+   @result{} -27
+@end lisp
+@end defun
+
+@defun bit-extract n start end
+Returns the integer composed of the @var{start} (inclusive) through
+@var{end} (exclusive) bits of @var{n}.  The @var{start}th bit becomes
+the 0-th bit in the result.@refill
+
+Example:
+@lisp
+(number->string (bit-extract #b1101101010 0 4) 2)
+   @result{} "1010"
+(number->string (bit-extract #b1101101010 4 9) 2)
+   @result{} "10110"
+@end lisp
+@end defun
+
+
+@node Modular Arithmetic, Prime Testing and Generation, Bit-Twiddling, Numerics
+@section Modular Arithmetic
+
+@code{(require 'modular)}
+
+@defun extended-euclid n1 n2
+Returns a list of 3 integers @code{(d x y)} such that d = gcd(@var{n1},
+@var{n2}) = @var{n1} * x + @var{n2} * y.@refill
+@end defun
+
+@defun symmetric:modulus n
+Returns @code{(quotient (+ -1 n) -2)} for positive odd integer @var{n}.
+@end defun
+
+@defun modulus->integer modulus
+Returns the non-negative integer characteristic of the ring formed when
+@var{modulus} is used with @code{modular:} procedures.
+@end defun
+
+@defun modular:normalize modulus n
+Returns the integer @code{(modulo @var{n} (modulus->integer
+@var{modulus}))} in the representation specified by @var{modulus}.
+@end defun
+
+@noindent
+The rest of these functions assume normalized arguments; That is, the
+arguments are constrained by the following table:
+
+@noindent
+For all of these functions, if the first argument (@var{modulus}) is:
+@table @code
+@item positive?
+Work as before.  The result is between 0 and @var{modulus}.
+
+@item zero?
+The arguments are treated as integers.  An integer is returned.
+
+@item negative?
+The arguments and result are treated as members of the integers modulo
+@code{(+ 1 (* -2 @var{modulus}))}, but with @dfn{symmetric}
+representation; i.e. @code{(<= (- @var{modulus}) @var{n}
+@var{modulus})}.
+@end table
+
+@noindent
+If all the arguments are fixnums the computation will use only fixnums.
+
+@defun modular:invertable? modulus k
+Returns @code{#t} if there exists an integer n such that @var{k} * n
+@equiv{} 1 mod @var{modulus}, and @code{#f} otherwise.
+@end defun
+
+@defun modular:invert modulus k2
+Returns an integer n such that 1 = (n * @var{k2}) mod @var{modulus}.  If
+@var{k2} has no inverse mod @var{modulus} an error is signaled.
+@end defun
+
+@defun modular:negate modulus k2
+Returns (@minus{}@var{k2}) mod @var{modulus}.
+@end defun
+
+@defun modular:+ modulus k2 k3
+Returns (@var{k2} + @var{k3}) mod @var{modulus}.
+@end defun
+
+@defun modular:@minus{} modulus k2 k3
+Returns (@var{k2} @minus{} @var{k3}) mod @var{modulus}.
+@end defun
+
+@defun modular:* modulus k2 k3
+Returns (@var{k2} * @var{k3}) mod @var{modulus}.
+
+The Scheme code for @code{modular:*} with negative @var{modulus} is not
+completed for fixnum-only implementations.
+@end defun
+
+@defun modular:expt modulus k2 k3
+Returns (@var{k2} ^ @var{k3}) mod @var{modulus}.
+@end defun
+
+
+@node Prime Testing and Generation, Prime Factorization, Modular Arithmetic, Numerics
+@section Prime Testing and Generation
+
+@code{(require 'primes)}
+
+This package tests and generates prime numbers.  The strategy used is
+as follows:
+
+@itemize
+@item
+First, use trial division by small primes (primes less than 1000) to
+quickly weed out composites with small factors.  As a side benefit, this
+makes the test precise for numbers up to one million.
+@item
+Second, apply the Miller-Rabin primality test to detect (with high
+probability) any remaining composites.
+@end itemize
+
+The Miller-Rabin test is a Monte-Carlo test---in other words, it's fast
+and it gets the right answer with high probability.  For a candidate
+that @emph{is} prime, the Miller-Rabin test is certain to report
+"prime"; it will never report "composite".  However, for a candidate
+that is composite, there is a (small) probability that the Miller-Rabin
+test will erroneously report "prime".  This probability can be made
+arbitarily small by adjusting the number of iterations of the
+Miller-Rabin test.
+
+@defun probably-prime? candidate
+@defunx probably-prime? candidate iter
+Returns @code{#t} if @code{candidate} is probably prime.  The optional
+parameter @code{iter} controls the number of iterations of the
+Miller-Rabin test.  The probability of a composite candidate being
+mistaken for a prime is at most @code{(1/4)^iter}.  The default value of
+@code{iter} is 15, which makes the probability less than 1 in 10^9.
+
+@end defun
+
+@defun primes< start count
+@defunx primes< start count iter
+@defunx primes> start count
+@defunx primes> start count iter
+Returns a list of the first @code{count} odd probable primes less (more)
+than or equal to @code{start}.  The optional parameter @code{iter}
+controls the number of iterations of the Miller-Rabin test for each
+candidate.  The probability of a composite candidate being mistaken for
+a prime is at most @code{(1/4)^iter}.  The default value of @code{iter}
+is 15, which makes the probability less than 1 in 10^9.
+
+@end defun
+
+@menu
+* The Miller-Rabin Test::       How the Miller-Rabin test works
+@end menu
+
+@node The Miller-Rabin Test,  , Prime Testing and Generation, Prime Testing and Generation
+@subsection Theory
+
+Rabin and Miller's result can be summarized as follows.  Let @code{p}
+(the candidate prime) be any odd integer greater than 2.  Let @code{b}
+(the "base") be an integer in the range @code{2 ... p-1}.  There is a
+fairly simple Boolean function---call it @code{C}, for
+"Composite"---with the following properties:
+@itemize
+
+@item
+If @code{p} is prime, @code{C(p, b)} is false for all @code{b} in the range
+@code{2 ... p-1}.
+
+@item
+If @code{p} is composite, @code{C(p, b)} is false for at most 1/4 of all
+@code{b} in the range @code{ 2 ... p-1}.  (If the test fails for base
+@code{b}, @code{p} is called a @emph{strong pseudo-prime to base
+@code{b}}.)
+
+@end itemize
+For details of @code{C}, and why it fails for at most 1/4 of the
+potential bases, please consult a book on number theory or cryptography
+such as "A Course in Number Theory and Cryptography" by Neal Koblitz,
+published by Springer-Verlag 1994.
+
+There is nothing probablistic about this result.  It's true for all
+@code{p}.  If we had time to test @code{(1/4)p + 1} different bases, we
+could definitively determine the primality of @code{p}.  For large
+candidates, that would take much too long---much longer than the simple
+approach of dividing by all numbers up to @code{sqrt(p)}.  This is
+where probability enters the picture.
+
+Suppose we have some candidate prime @code{p}.  Pick a random integer
+@code{b} in the range @code{2 ... p-1}.  Compute @code{C(p,b)}.  If
+@code{p} is prime, the result will certainly be false.  If @code{p} is
+composite, the probability is at most 1/4 that the result will be false
+(demonstrating that @code{p} is a strong pseudoprime to base @code{b}).
+The test can be repeated with other random bases.  If @code{p} is prime,
+each test is certain to return false.  If @code{p} is composite, the
+probability of @code{C(p,b)} returning false is at most 1/4 for each
+test.  Since the @code{b} are chosen at random, the tests outcomes are
+independent. So if @code{p} is composite and the test is repeated, say,
+15 times, the probability of it returning false all fifteen times is at
+most (1/4)^15, or about 10^-9.  If the test is repeated 30 times, the
+probability of failure drops to at most 8.3e-25.
+
+Rabin and Miller's result holds for @emph{all} candidates @code{p}.
+However, if the candidate @code{p} is picked at random, the probability
+of the Miller-Rabin test failing is much less than the computed bound.
+This is because, for @emph{most} composite numbers, the fraction of
+bases that cause the test to fail is much less than 1/4.  For example,
+if you pick a random odd number less than 1000 and apply the
+Miller-Rabin test with only 3 random bases, the computed failure bound
+is (1/4)^3, or about 1.6e-2.  However, the actual probability of failure
+is much less---about 7.2e-5.  If you accidentally pick 703 to test for
+primality, the probability of failure is (161/703)^3, or about 1.2e-2,
+which is almost as high as the computed bound.  This is because 703 is a
+strong pseudoprime to 161 bases.  But if you pick at random there is
+only a small chance of picking 703, and no other number less than 1000
+has that high a percentage of pseudoprime bases.
+
+The Miller-Rabin test is sometimes used in a slightly different fashion,
+where it can, at least in principle, cause problems.  The weaker version
+uses small prime bases instead of random bases.  If you are picking
+candidates at random and testing for primality, this works well since
+very few composites are strong pseudo-primes to small prime bases.  (For
+example, there is only one composite less than 2.5e10 that is a strong
+pseudo-prime to the bases 2, 3, 5, and 7.)  The problem with this
+approach is that once a candidate has been picked, the test is
+deterministic.  This distinction is subtle, but real.  With the
+randomized test, for @emph{any} candidate you pick---even if your
+candidate-picking procedure is strongly biased towards troublesome
+numbers, the test will work with high probability.  With the
+deterministic version, for any particular candidate, the test will
+either work (with probability 1), or fail (with probability 1).  It
+won't fail for very many candidates, but that won't be much consolation
+if your candidate-picking procedure is somehow biased toward troublesome
+numbers.
+
+
+@node Prime Factorization, Random Numbers, Prime Testing and Generation, Numerics
+@section Prime Factorization
+
+@code{(require 'factor)}
+
+
+@defun factor k
+Returns a list of the prime factors of @var{k}.  The order of the
+factors is unspecified.  In order to obtain a sorted list do
+@code{(sort! (factor k) <)}.@refill
+@end defun
+
+@emph{Note:} The rest of these procedures implement the Solovay-Strassen
+primality test.  This test has been superseeded by the faster
+@xref{Prime Testing and Generation, probably-prime?}.  However these are
+left here as they take up little space and may be of use to an
+implementation without bignums.
+
+See Robert Solovay and Volker Strassen, @cite{A Fast Monte-Carlo Test
+for Primality}, SIAM Journal on Computing, 1977, pp 84-85.
+
+@defun jacobi-symbol p q
+Returns the value (+1, @minus{}1, or 0) of the Jacobi-Symbol of exact
+non-negative integer @var{p} and exact positive odd integer
+@var{q}.@refill
+@end defun
+
+@defun prime? p
+Returns @code{#f} if @var{p} is composite; @code{#t} if @var{p} is
+prime.  There is a slight chance @code{(expt 2 (- prime:trials))} that a
+composite will return @code{#t}.@refill
+@end defun
+
+@defun prime:trials
+Is the maxinum number of iterations of Solovay-Strassen that will be
+done to test a number for primality.
+@end defun
+
+
+
+@node Random Numbers, Cyclic Checksum, Prime Factorization, Numerics
+@section Random Numbers
+
+@code{(require 'random)}
+
+
+@deffn Procedure random n
+@deffnx Procedure random n state
+Accepts a positive integer or real @var{n} and returns a number of the
+same type between zero (inclusive) and @var{n} (exclusive).  The values
+returned have a uniform distribution.@refill
+
+The optional argument @var{state} must be of the type produced by
+@code{(make-random-state)}.  It defaults to the value of the variable
+@code{*random-state*}.  This object is used to maintain the state of the
+pseudo-random-number generator and is altered as a side effect of the
+@code{random} operation.@refill
+@end deffn
+
+@defvar *random-state*
+Holds a data structure that encodes the internal state of the
+random-number generator that @code{random} uses by default.  The nature
+of this data structure is implementation-dependent.  It may be printed
+out and successfully read back in, but may or may not function correctly
+as a random-number state object in another implementation.@refill
+@end defvar
+
+@deffn Procedure make-random-state
+@deffnx Procedure make-random-state state
+Returns a new object of type suitable for use as the value of the
+variable @code{*random-state*} and as a second argument to
+@code{random}.  If argument @var{state} is given, a copy of it is
+returned.  Otherwise a copy of @code{*random-state*} is returned.@refill
+@end deffn
+
+If inexact numbers are support by the Scheme implementation,
+@file{randinex.scm} will be loaded as well.  @file{randinex.scm}
+contains procedures for generating inexact distributions.@refill
+
+@deffn Procedure random:uniform state
+Returns an uniformly distributed inexact real random number in the
+range between 0 and 1.
+@end deffn
+
+@deffn Procedure random:solid-sphere! vect
+@deffnx Procedure random:solid-sphere! vect state
+Fills @var{vect} with inexact real random numbers the sum of whose
+squares is less than 1.0.  Thinking of @var{vect} as coordinates in
+space of dimension @var{n} = @code{(vector-length @var{vect})}, the
+coordinates are uniformly distributed within the unit @var{n}-shere.
+The sum of the squares of the numbers is returned.@refill
+@end deffn
+
+@deffn Procedure random:hollow-sphere! vect
+@deffnx Procedure random:hollow-sphere! vect state
+Fills @var{vect} with inexact real random numbers the sum of whose
+squares is equal to 1.0.  Thinking of @var{vect} as coordinates in space
+of dimension n = @code{(vector-length @var{vect})}, the coordinates are
+uniformly distributed over the surface of the unit n-shere.@refill
+@end deffn
+
+@deffn Procedure random:normal
+@deffnx Procedure random:normal state
+Returns an inexact real in a normal distribution with mean 0 and
+standard deviation 1.  For a normal distribution with mean @var{m} and
+standard deviation @var{d} use @code{(+ @var{m} (* @var{d}
+(random:normal)))}.@refill
+@end deffn
+
+@deffn Procedure random:normal-vector! vect
+@deffnx Procedure random:normal-vector! vect state
+Fills @var{vect} with inexact real random numbers which are independent
+and standard normally distributed (i.e., with mean 0 and variance 1).
+@end deffn
+
+@deffn Procedure random:exp
+@deffnx Procedure random:exp state
+Returns an inexact real in an exponential distribution with mean 1.  For
+an exponential distribution with mean @var{u} use (* @var{u}
+(random:exp)).@refill
+@end deffn
+
+
+@node Cyclic Checksum, Plotting, Random Numbers, Numerics
+@section Cyclic Checksum
+
+@code{(require 'make-crc)}
+
+@defun make-port-crc
+@defunx make-port-crc degree
+@defunx make-port-crc degree generator
+Returns an expression for a procedure of one argument, a port.  This
+procedure reads characters from the port until the end of file and
+returns the integer checksum of the bytes read.
+
+The integer @var{degree}, if given, specifies the degree of the
+polynomial being computed -- which is also the number of bits computed
+in the checksums.  The default value is 32.
+
+The integer @var{generator} specifies the polynomial being computed.
+The power of 2 generating each 1 bit is the exponent of a term of the
+polynomial.  The bit at position @var{degree} is implicit and should not
+be part of @var{generator}.  This allows systems with numbers limited to
+32 bits to calculate 32 bit checksums.  The default value of
+@var{generator} when @var{degree} is 32 (its default) is:
+
+@example
+(make-port-crc 32 #b00000100110000010001110110110111)
+@end example
+
+Creates a procedure to calculate the P1003.2/D11.2 (POSIX.2) 32-bit
+checksum from the polynomial:
+
+@example
+     32    26    23    22    16    12    11
+  ( x   + x   + x   + x   + x   + x   + x   +
+
+      10    8    7    5    4    2    1
+     x   + x  + x  + x  + x  + x  + x  + 1 )  mod 2
+@end example
+@end defun
+
+@example
+(require 'make-crc)
+(define crc32 (slib:eval (make-port-crc)))
+(define (file-check-sum file) (call-with-input-file file crc32))
+(file-check-sum (in-vicinity (library-vicinity) "ratize.scm"))
+
+@result{} 3553047446
+@end example
+
+@node Plotting, Root Finding, Cyclic Checksum, Numerics
+@section Plotting on Character Devices
+
+@code{(require 'charplot)}
+
+The plotting procedure is made available through the use of the
+@code{charplot} package.  @code{charplot} is loaded by inserting
+@code{(require 'charplot)} before the code that uses this
+procedure.@refill
+
+@defvar charplot:height
+The number of rows to make the plot vertically.
+@end defvar
+
+@defvar charplot:width
+The number of columns to make the plot horizontally.
+@end defvar
+
+@deffn Procedure plot! coords x-label y-label
+@var{coords} is a list of pairs of x and y coordinates.  @var{x-label}
+and @var{y-label} are strings with which to label the x and y
+axes.@refill
+
+Example:
+@example
+(require 'charplot)
+(set! charplot:height 19)
+(set! charplot:width 45)
+
+(define (make-points n)
+  (if (zero? n)
+      '()
+      (cons (cons (/ n 6) (sin (/ n 6))) (make-points (1- n)))))
+
+(plot! (make-points 37) "x" "Sin(x)")
+@print{}
+@group
+  Sin(x)   ______________________________________________
+      1.25|-                                             |
+          |                                              |
+         1|-       ****                                  |
+          |      **    **                                |
+  750.0e-3|-    *        *                               |
+          |    *          *                              |
+  500.0e-3|-  *            *                             |
+          |  *                                           |
+  250.0e-3|-                *                            |
+          | *                *                           |
+         0|-------------------*--------------------------|
+          |                                     *        |
+ -250.0e-3|-                   *               *         |
+          |                     *             *          |
+ -500.0e-3|-                     *                       |
+          |                       *          *           |
+ -750.0e-3|-                       *        *            |
+          |                         **    **             |
+        -1|-                          ****               |
+          |____________:_____._____:_____._____:_________|
+        x              2           4      
+@end group
+@end example
+@end deffn
+
+
+@node Root Finding,  , Plotting, Numerics
+@section Root Finding
+
+@code{(require 'root)}
+
+@defun newtown:find-integer-root f df/dx x0
+Given integer valued procedure @var{f}, its derivative (with respect to
+its argument) @var{df/dx}, and initial integer value @var{x0} for which
+@var{df/dx}(@var{x0}) is non-zero, returns an integer @var{x} for which
+@var{f}(@var{x}) is closer to zero than either of the integers adjacent
+to @var{x}; or returns @code{#f} if such an integer can't be found.
+
+To find the closest integer to a given integers square root:
+
+@example
+(define (integer-sqrt y)
+  (newton:find-integer-root
+   (lambda (x) (- (* x x) y))
+   (lambda (x) (* 2 x))
+   (ash 1 (quotient (integer-length y) 2))))
+
+(integer-sqrt 15) @result{} 4
+@end example
+@end defun
+
+@defun integer-sqrt y
+Given a non-negative integer @var{y}, returns the rounded square-root of
+@var{y}.
+@end defun
+
+@defun newton:find-root f df/dx x0 prec
+Given real valued procedures @var{f}, @var{df/dx} of one (real)
+argument, initial real value @var{x0} for which @var{df/dx}(@var{x0}) is
+non-zero, and positive real number @var{prec}, returns a real @var{x}
+for which @code{abs}(@var{f}(@var{x})) is less than @var{prec}; or
+returns @code{#f} if such a real can't be found.
+
+If @code{prec} is instead a negative integer, @code{newton:find-root}
+returns the result of -@var{prec} iterations.
+@end defun
+
+@noindent
+H. J. Orchard, @cite{The Laguerre Method for Finding the Zeros of
+Polynomials}, IEEE Transactions on Circuits and Systems, Vol. 36,
+No. 11, November 1989, pp 1377-1381.
+
+@quotation
+There are 2 errors in Orchard's Table II.  Line k=2 for starting
+value of 1000+j0 should have Z_k of 1.0475 + j4.1036 and line k=2
+for starting value of 0+j1000 should have Z_k of 1.0988 + j4.0833.
+@end quotation
+
+
+@defun laguerre:find-root f df/dz ddf/dz^2 z0 prec
+Given complex valued procedure @var{f} of one (complex) argument, its
+derivative (with respect to its argument) @var{df/dx}, its second
+derivative @var{ddf/dz^2}, initial complex value @var{z0}, and positive
+real number @var{prec}, returns a complex number @var{z} for which
+@code{magnitude}(@var{f}(@var{z})) is less than @var{prec}; or returns
+@code{#f} if such a number can't be found.
+
+If @code{prec} is instead a negative integer, @code{laguerre:find-root}
+returns the result of -@var{prec} iterations.
+@end defun
+
+@defun laguerre:find-polynomial-root deg f df/dz ddf/dz^2 z0 prec
+Given polynomial procedure @var{f} of integer degree @var{deg} of one
+argument, its derivative (with respect to its argument) @var{df/dx}, its
+second derivative @var{ddf/dz^2}, initial complex value @var{z0}, and
+positive real number @var{prec}, returns a complex number @var{z} for
+which @code{magnitude}(@var{f}(@var{z})) is less than @var{prec}; or
+returns @code{#f} if such a number can't be found.
+
+If @code{prec} is instead a negative integer,
+@code{laguerre:find-polynomial-root} returns the result of -@var{prec}
+iterations.
+@end defun
+
+
+@node Procedures, Standards Support, Numerics, Top
+@chapter Procedures
+
+Anything that doesn't fall neatly into any of the other categories winds
+up here.
+
+@menu
+* Batch::                       'batch
+* Common List Functions::       'common-list-functions
+* Format::                      'format
+* Generic-Write::               'generic-write
+* Line I/O::                    'line-i/o
+* Multi-Processing::            'process
+* Object-To-String::            'object->string
+* Pretty-Print::                'pretty-print, 'pprint-file
+* Sorting::                     'sort
+* Topological Sort::            
+* Standard Formatted I/O::      'printf, 'scanf
+* String-Case::                 'string-case
+* String Ports::                'string-port
+* String Search::               
+* Tektronix Graphics Support::  
+* Tree Operations::             'tree
+@end menu
+
+@node Batch, Common List Functions, Procedures, Procedures
+@section Batch
+
+@code{(require 'batch)}
+
+@noindent
+The batch procedures provide a way to write and execute portable scripts
+for a variety of operating systems.  Each @code{batch:} procedure takes
+as its first argument a parameter-list (@pxref{Parameter lists}).  This
+parameter-list argument @var{parms} contains named associations.  Batch
+currently uses 2 of these:
+
+@table @code
+@item batch-port
+The port on which to write lines of the batch file.
+@item batch-dialect
+The syntax of batch file to generate.  Currently supported are:
+@itemize @bullet
+@item
+unix
+@item
+dos
+@item
+vms
+@item
+system
+@item
+*unknown*
+@end itemize
+@end table
+
+@noindent
+@file{batch.scm} uses 2 enhanced relational tables (@pxref{Database
+Utilities}) to store information linking the names of
+@code{operating-system}s to @code{batch-dialect}es.
+
+@defun batch:initialize! database
+Defines @code{operating-system} and @code{batch-dialect} tables and adds
+the domain @code{operating-system} to the enhanced relational database
+@var{database}.
+@end defun
+
+@defvar batch:platform
+Is batch's best guess as to which operating-system it is running under.
+@code{batch:platform} is set to @code{(software-type)}
+(@pxref{Configuration}) unless @code{(software-type)} is @code{unix},
+in which case finer distinctions are made.
+@end defvar
+
+@defun batch:call-with-output-script parms file proc
+@var{proc} should be a procedure of one argument.  If @var{file} is an
+output-port, @code{batch:call-with-output-script} writes an appropriate
+header to @var{file} and then calls @var{proc} with @var{file} as the
+only argument.  If @var{file} is a string,
+@code{batch:call-with-output-script} opens a output-file of name
+@var{file}, writes an appropriate header to @var{file}, and then calls
+@var{proc} with the newly opened port as the only argument.  Otherwise,
+@code{batch:call-with-output-script} acts as if it was called with the
+result of @code{(current-output-port)} as its third argument.
+@end defun
+
+@defun batch:apply-chop-to-fit proc arg1 arg2 @dots{} list
+The procedure @var{proc} must accept at least one argument and return
+@code{#t} if successful, @code{#f} if not.
+@code{batch:apply-chop-to-fit} calls @var{proc} with @var{arg1},
+@var{arg2}, @dots{}, and @var{chunk}, where @var{chunk} is a subset of
+@var{list}.  @code{batch:apply-chop-to-fit} tries @var{proc} with
+successively smaller subsets of @var{list} until either @var{proc}
+returns non-false, or the @var{chunk}s become empty.
+@end defun
+
+@noindent
+The rest of the @code{batch:} procedures write (or execute if
+@code{batch-dialect} is @code{system}) commands to the batch port which
+has been added to @var{parms} or @code{(copy-tree @var{parms})} by the
+code:
+
+@example
+(adjoin-parameters! @var{parms} (list 'batch-port @var{port}))
+@end example
+
+@defun batch:system parms string1 string2 @dots{}
+Calls @code{batch:try-system} (below) with arguments, but signals an
+error if @code{batch:try-system} returns @code{#f}.
+@end defun
+
+@noindent
+These functions return a non-false value if the command was successfully
+translated into the batch dialect and @code{#f} if not.  In the case of
+the @code{system} dialect, the value is non-false if the operation
+suceeded.
+
+@defun batch:try-system parms string1 string2 @dots{}
+Writes a command to the @code{batch-port} in @var{parms} which executes
+the program named @var{string1} with arguments @var{string2} @dots{}.
+@end defun
+
+@defun batch:run-script parms string1 string2 @dots{}
+Writes a command to the @code{batch-port} in @var{parms} which executes
+the batch script named @var{string1} with arguments @var{string2}
+@dots{}.
+
+@emph{Note:} @code{batch:run-script} and @code{batch:try-system} are not the
+same for some operating systems (VMS).
+@end defun
+
+@defun batch:comment parms line1 @dots{}
+Writes comment lines @var{line1} @dots{} to the @code{batch-port} in
+@var{parms}.
+@end defun
+
+@defun batch:lines->file parms file line1 @dots{}
+Writes commands to the @code{batch-port} in @var{parms} which create a
+file named @var{file} with contents @var{line1} @dots{}.
+@end defun
+
+@defun batch:delete-file parms file
+Writes a command to the @code{batch-port} in @var{parms} which deletes
+the file named @var{file}.
+@end defun
+
+@defun batch:rename-file parms old-name new-name
+Writes a command to the @code{batch-port} in @var{parms} which renames
+the file @var{old-name} to @var{new-name}.
+@end defun
+
+@noindent
+In addition, batch provides some small utilities very useful for writing
+scripts:
+
+@defun replace-suffix str old new
+Returns a new string similar to @code{str} but with the suffix string
+@var{old} removed and the suffix string @var{new} appended.  If the end
+of @var{str} does not match @var{old}, an error is signaled.
+@end defun
+
+@defun string-join joiner string1 @dots{}
+Returns a new string consisting of all the strings @var{string1} @dots{}
+in order appended together with the string @var{joiner} between each
+adjacent pair.
+@end defun
+
+@defun must-be-first list1 list2
+Returns a new list consisting of the elements of @var{list2} ordered so
+that if some elements of @var{list1} are @code{equal?} to elements of
+@var{list2}, then those elements will appear first and in the order of
+@var{list1}.
+@end defun
+
+@defun must-be-last list1 list2
+Returns a new list consisting of the elements of @var{list1} ordered so
+that if some elements of @var{list2} are @code{equal?} to elements of
+@var{list1}, then those elements will appear last and in the order of
+@var{list2}.
+@end defun
+
+@defun os->batch-dialect osname
+Returns its best guess for the @code{batch-dialect} to be used for the
+operating-system named @var{osname}.  @code{os->batch-dialect} uses the
+tables added to @var{database} by @code{batch:initialize!}.
+@end defun
+
+@noindent
+Here is an example of the use of most of batch's procedures:
+
+@example
+(require 'database-utilities)
+(require 'parameters)
+(require 'batch)
+
+(define batch (create-database #f 'alist-table))
+(batch:initialize! batch)
+
+(define my-parameters
+  (list (list 'batch-dialect (os->batch-dialect batch:platform))
+        (list 'platform batch:platform)
+        (list 'batch-port (current-output-port)))) ;gets filled in later
+
+(batch:call-with-output-script
+ my-parameters
+ "my-batch"
+ (lambda (batch-port)
+   (adjoin-parameters! my-parameters (list 'batch-port batch-port))
+   (and
+    (batch:comment my-parameters
+                   "================ Write file with C program.")
+    (batch:rename-file my-parameters "hello.c" "hello.c~")
+    (batch:lines->file my-parameters "hello.c"
+                       "#include <stdio.h>"
+                       "int main(int argc, char **argv)"
+                       "@{"
+                       "  printf(\"hello world\\n\");"
+                       "  return 0;"
+                       "@}" )
+    (batch:system my-parameters "cc" "-c" "hello.c")
+    (batch:system my-parameters "cc" "-o" "hello"
+                  (replace-suffix "hello.c" ".c" ".o"))
+    (batch:system my-parameters "hello")
+    (batch:delete-file my-parameters "hello")
+    (batch:delete-file my-parameters "hello.c")
+    (batch:delete-file my-parameters "hello.o")
+    (batch:delete-file my-parameters "my-batch")
+    )))
+@end example
+
+@noindent
+Produces the file @file{my-batch}:
+
+@example
+#!/bin/sh
+# "my-batch" build script created Sat Jun 10 21:20:37 1995
+# ================ Write file with C program.
+mv -f hello.c hello.c~
+rm -f hello.c
+echo '#include <stdio.h>'>>hello.c
+echo 'int main(int argc, char **argv)'>>hello.c
+echo '@{'>>hello.c
+echo '  printf("hello world\n");'>>hello.c
+echo '  return 0;'>>hello.c
+echo '@}'>>hello.c
+cc -c hello.c
+cc -o hello hello.o
+hello
+rm -f hello
+rm -f hello.c
+rm -f hello.o
+rm -f my-batch
+@end example
+
+@noindent
+When run, @file{my-batch} prints:
+
+@example
+bash$ my-batch
+mv: hello.c: No such file or directory
+hello world
+@end example
+
+
+@node Common List Functions, Format, Batch, Procedures
+@section Common List Functions
+
+@code{(require 'common-list-functions)}
+
+The procedures below follow the Common LISP equivalents apart from
+optional arguments in some cases.
+
+@menu
+* List construction::           
+* Lists as sets::               
+* Lists as sequences::          
+* Destructive list operations::  
+* Non-List functions::          
+@end menu
+
+
+@node List construction, Lists as sets, Common List Functions, Common List Functions
+@subsection List construction
+
+@defun make-list k . init
+@code{make-list} creates and returns a list of @var{k} elements.  If
+@var{init} is included, all elements in the list are initialized to
+@var{init}.@refill
+
+Example:
+@lisp
+(make-list 3)
+   @result{} (#<unspecified> #<unspecified> #<unspecified>)
+(make-list 5 'foo)
+   @result{} (foo foo foo foo foo)
+@end lisp
+@end defun
+
+
+@defun list* x . y
+Works like @code{list} except that the cdr of the last pair is the last
+argument unless there is only one argument, when the result is just that
+argument.  Sometimes called @code{cons*}.  E.g.:@refill
+@lisp
+(list* 1)
+   @result{} 1
+(list* 1 2 3)
+   @result{} (1 2 . 3)
+(list* 1 2 '(3 4))
+   @result{} (1 2 3 4)
+(list* @var{args} '())
+   @equiv{} (list @var{args})
+@end lisp
+@end defun
+
+@defun copy-list lst
+@code{copy-list} makes a copy of @var{lst} using new pairs and returns
+it. Only the top level of the list is copied, i.e., pairs forming
+elements of the copied list remain @code{eq?} to the corresponding
+elements of the original; the copy is, however, not @code{eq?} to the
+original, but is @code{equal?} to it.@refill
+
+Example:
+@lisp
+(copy-list '(foo foo foo))
+   @result{} (foo foo foo)
+(define q '(foo bar baz bang))
+(define p q)
+(eq? p q)
+   @result{} #t
+(define r (copy-list q))
+(eq? q r)
+   @result{} #f
+(equal? q r)
+   @result{} #t
+(define bar '(bar))
+(eq? bar (car (copy-list (list bar 'foo))))
+@result{} #t
+   @end lisp
+@end defun
+
+
+
+
+
+
+@node Lists as sets, Lists as sequences, List construction, Common List Functions
+@subsection Lists as sets
+
+@code{eq?} is used to test for membership by all the procedures below
+which treat lists as sets.@refill
+
+@defun adjoin e l
+@code{adjoin} returns the adjoint of the element @var{e} and the list
+@var{l}.  That is, if @var{e} is in @var{l}, @code{adjoin} returns
+@var{l}, otherwise, it returns @code{(cons @var{e} @var{l})}.@refill
+
+Example:
+@lisp
+(adjoin 'baz '(bar baz bang))
+   @result{} (bar baz bang)
+(adjoin 'foo '(bar baz bang))
+   @result{} (foo bar baz bang)
+@end lisp
+@end defun
+
+@defun union l1 l2
+@code{union} returns the combination of @var{l1} and @var{l2}.
+Duplicates between @var{l1} and @var{l2} are culled.  Duplicates within
+@var{l1} or within @var{l2} may or may not be removed.@refill
+
+Example:
+@lisp
+(union '(1 2 3 4) '(5 6 7 8))
+   @result{} (4 3 2 1 5 6 7 8)
+(union '(1 2 3 4) '(3 4 5 6))
+   @result{} (2 1 3 4 5 6)
+@end lisp
+@end defun
+
+@defun intersection l1 l2
+@code{intersection} returns all elements that are in both @var{l1} and
+@var{l2}.@refill
+
+Example:
+@lisp
+(intersection '(1 2 3 4) '(3 4 5 6))
+   @result{} (3 4)
+(intersection '(1 2 3 4) '(5 6 7 8))
+   @result{} ()
+@end lisp
+@end defun
+
+@defun set-difference l1 l2
+@code{set-difference} returns the union of all elements that are in
+@var{l1} but not in @var{l2}.@refill
+
+Example:
+@lisp
+(set-difference '(1 2 3 4) '(3 4 5 6))
+   @result{} (1 2)
+(set-difference '(1 2 3 4) '(1 2 3 4 5 6))
+   @result{} ()
+@end lisp
+@end defun
+
+@defun member-if pred lst
+@code{member-if} returns @var{lst} if @code{(@var{pred} @var{element})}
+is @code{#t} for any @var{element} in @var{lst}.  Returns @code{#f} if
+@var{pred} does not apply to any @var{element} in @var{lst}.@refill
+
+Example:
+@lisp
+(member-if vector? '(1 2 3 4))
+   @result{} #f
+(member-if number? '(1 2 3 4))
+   @result{} (1 2 3 4)
+@end lisp
+@end defun
+
+@defun some pred lst . more-lsts
+@var{pred} is a boolean function of as many arguments as there are list
+arguments to @code{some} i.e., @var{lst} plus any optional arguments.
+@var{pred} is applied to successive elements of the list arguments in
+order.  @code{some} returns @code{#t} as soon as one of these
+applications returns @code{#t}, and is @code{#f} if none returns
+@code{#t}.  All the lists should have the same length.@refill
+
+
+Example:
+@lisp
+(some odd? '(1 2 3 4))
+   @result{} #t
+
+(some odd? '(2 4 6 8))
+   @result{} #f
+
+(some > '(2 3) '(1 4))
+   @result{} #f
+@end lisp
+@end defun
+
+@defun every pred lst . more-lsts
+@code{every} is analogous to @code{some} except it returns @code{#t} if
+every application of @var{pred} is @code{#t} and @code{#f}
+otherwise.@refill
+
+Example:
+@lisp
+(every even? '(1 2 3 4))
+   @result{} #f
+
+(every even? '(2 4 6 8))
+   @result{} #t
+
+(every > '(2 3) '(1 4))
+   @result{} #f
+@end lisp
+@end defun
+
+@defun notany pred . lst
+@code{notany} is analogous to @code{some} but returns @code{#t} if no
+application of @var{pred} returns @code{#t} or @code{#f} as soon as any
+one does.@refill
+@end defun
+
+@defun notevery pred . lst
+@code{notevery} is analogous to @code{some} but returns @code{#t} as soon
+as an application of @var{pred} returns @code{#f}, and @code{#f}
+otherwise.@refill
+
+Example:
+@lisp
+(notevery even? '(1 2 3 4))
+   @result{} #t
+
+(notevery even? '(2 4 6 8))
+   @result{} #f
+@end lisp
+@end defun
+
+@defun find-if pred lst
+@code{find-if} searches for the first @var{element} in @var{lst} such
+that @code{(@var{pred} @var{element})} returns @code{#t}.  If it finds
+any such @var{element} in @var{lst}, @var{element} is returned.
+Otherwise, @code{#f} is returned.@refill
+
+Example:
+@lisp
+(find-if number? '(foo 1 bar 2))
+   @result{} 1
+
+(find-if number? '(foo bar baz bang))
+   @result{} #f
+
+(find-if symbol? '(1 2 foo bar))
+   @result{} foo
+@end lisp
+@end defun
+
+@defun remove elt lst
+@code{remove} removes all occurrences of @var{elt} from @var{lst} using
+@code{eqv?} to test for equality and returns everything that's left.
+N.B.: other implementations (Chez, Scheme->C and T, at least) use
+@code{equal?} as the equality test.@refill
+
+Example:
+@lisp
+(remove 1 '(1 2 1 3 1 4 1 5))
+   @result{} (2 3 4 5)
+
+(remove 'foo '(bar baz bang))
+   @result{} (bar baz bang)
+@end lisp
+@end defun
+
+@defun remove-if pred lst
+@code{remove-if} removes all @var{element}s from @var{lst} where
+@code{(@var{pred} @var{element})} is @code{#t} and returns everything
+that's left.@refill
+
+Example:
+@lisp
+(remove-if number? '(1 2 3 4))
+   @result{} ()
+
+(remove-if even? '(1 2 3 4 5 6 7 8))
+   @result{} (1 3 5 7)
+@end lisp
+@end defun
+
+@defun remove-if-not pred lst
+@code{remove-if-not} removes all @var{element}s from @var{lst} for which
+@code{(@var{pred} @var{element})} is @code{#f} and returns everything that's
+left.@refill
+
+Example:
+@lisp
+(remove-if-not number? '(foo bar baz))
+   @result{} ()
+(remove-if-not odd? '(1 2 3 4 5 6 7 8))
+   @result{} (1 3 5 7)
+@end lisp
+@end defun
+
+@defun has-duplicates? lst
+returns @code{#t} if 2 members of @var{lst} are @code{equal?}, @code{#f}
+otherwise.
+Example:
+@lisp
+(has-duplicates? '(1 2 3 4))
+   @result{} #f
+
+(has-duplicates? '(2 4 3 4))
+   @result{} #t
+@end lisp
+@end defun
+
+
+@node Lists as sequences, Destructive list operations, Lists as sets, Common List Functions
+@subsection Lists as sequences
+
+@defun position obj lst
+@code{position} returns the 0-based position of @var{obj} in @var{lst},
+or @code{#f} if @var{obj} does not occur in @var{lst}.@refill
+
+Example:
+@lisp
+(position 'foo '(foo bar baz bang))
+   @result{} 0
+(position 'baz '(foo bar baz bang))
+   @result{} 2
+(position 'oops '(foo bar baz bang))
+   @result{} #f
+@end lisp
+@end defun
+
+@defun reduce p lst
+@code{reduce} combines all the elements of a sequence using a binary
+operation (the combination is left-associative).  For example, using
+@code{+}, one can add up all the elements.  @code{reduce} allows you to
+apply a function which accepts only two arguments to more than 2
+objects.  Functional programmers usually refer to this as @dfn{foldl}.
+@code{collect:reduce} (@xref{Collections}) provides a version of
+@code{collect} generalized to collections.@refill
+
+Example:
+@lisp
+(reduce + '(1 2 3 4))
+   @result{} 10
+(define (bad-sum . l) (reduce + l))
+(bad-sum 1 2 3 4)
+   @equiv{} (reduce + (1 2 3 4))
+   @equiv{} (+ (+ (+ 1 2) 3) 4)
+@result{} 10
+(bad-sum)
+   @equiv{} (reduce + ())
+   @result{} ()
+(reduce string-append '("hello" "cruel" "world"))
+   @equiv{} (string-append (string-append "hello" "cruel") "world")
+   @result{} "hellocruelworld"
+(reduce anything '())
+   @result{} ()
+(reduce anything '(x))
+   @result{} x
+@end lisp
+
+What follows is a rather non-standard implementation of @code{reverse}
+in terms of @code{reduce} and a combinator elsewhere called
+@dfn{C}.@refill
+
+@lisp
+;;; Contributed by Jussi Piitulainen (jpiitula@@ling.helsinki.fi)
+
+(define commute
+  (lambda (f)
+    (lambda (x y)
+      (f y x))))
+
+(define reverse
+  (lambda (args)
+    (reduce-init (commute cons) args)))
+@end lisp
+@end defun
+
+@defun reduce-init p init lst
+@code{reduce-init} is the same as reduce, except that it implicitly
+inserts @var{init} at the start of the list.  @code{reduce-init} is
+preferred if you want to handle the null list, the one-element, and
+lists with two or more elements consistently.  It is common to use the
+operator's idempotent as the initializer.  Functional programmers
+usually call this @dfn{foldl}.@refill
+
+Example:
+@lisp
+(define (sum . l) (reduce-init + 0 l))
+(sum 1 2 3 4)
+   @equiv{} (reduce-init + 0 (1 2 3 4))
+   @equiv{} (+ (+ (+ (+ 0 1) 2) 3) 4)
+   @result{} 10
+(sum)
+   @equiv{} (reduce-init + 0 '())
+   @result{} 0
+
+(reduce-init string-append "@@" '("hello" "cruel" "world"))
+@equiv{}
+(string-append (string-append (string-append "@@" "hello")
+                               "cruel")
+               "world")
+@result{} "@@hellocruelworld"
+@end lisp
+
+Given a differentiation of 2 arguments, @code{diff}, the following will
+differentiate by any number of variables.
+@lisp
+(define (diff* exp . vars)
+  (reduce-init diff exp vars))
+@end lisp
+
+Example:
+@lisp
+;;; Real-world example:  Insertion sort using reduce-init.
+
+(define (insert l item)
+  (if (null? l)
+      (list item)
+      (if (< (car l) item)
+          (cons (car l) (insert (cdr l) item))
+          (cons item l))))
+(define (insertion-sort l) (reduce-init insert '() l))
+
+(insertion-sort '(3 1 4 1 5)
+   @equiv{} (reduce-init insert () (3 1 4 1 5))
+   @equiv{} (insert (insert (insert (insert (insert () 3) 1) 4) 1) 5)
+   @equiv{} (insert (insert (insert (insert (3)) 1) 4) 1) 5)
+   @equiv{} (insert (insert (insert (1 3) 4) 1) 5)
+   @equiv{} (insert (insert (1 3 4) 1) 5)
+   @equiv{} (insert (1 1 3 4) 5)
+   @result{} (1 1 3 4 5)
+   @end lisp
+@end defun
+
+@defun butlast lst n
+@code{butlast} returns all but the last @var{n} elements of
+@var{lst}.@refill
+
+Example:
+@lisp
+(butlast '(1 2 3 4) 3)
+   @result{} (1)
+(butlast '(1 2 3 4) 4)
+   @result{} ()
+@end lisp
+@end defun
+
+@defun nthcdr n lst
+@code{nthcdr} takes @var{n} @code{cdr}s of @var{lst} and returns the
+result.  Thus @code{(nthcdr 3 @var{lst})} @equiv{} @code{(cdddr
+@var{lst})}
+
+Example:
+@lisp
+(nthcdr 2 '(1 2 3 4))
+   @result{} (3 4)
+(nthcdr 0 '(1 2 3 4))
+   @result{} (1 2 3 4)
+@end lisp
+@end defun
+
+@defun last lst n
+@code{last} returns the last @var{n} elements of @var{lst}.  @var{n}
+must be a non-negative integer.
+
+Example:
+@lisp
+(last '(foo bar baz bang) 2)
+   @result{} (baz bang)
+(last '(1 2 3) 0)
+   @result{} 0
+@end lisp
+@end defun
+
+
+
+
+
+
+@node Destructive list operations, Non-List functions, Lists as sequences, Common List Functions
+@subsection Destructive list operations
+
+These procedures may mutate the list they operate on, but any such
+mutation is undefined.
+
+@deffn Procedure nconc args
+@code{nconc} destructively concatenates its arguments.  (Compare this
+with @code{append}, which copies arguments rather than destroying them.)
+Sometimes called @code{append!} (@xref{Rev2 Procedures}).@refill
+
+Example:  You want to find the subsets of a set.  Here's the obvious way:
+
+@lisp
+(define (subsets set)
+  (if (null? set)
+      '(())
+      (append (mapcar (lambda (sub) (cons (car set) sub))
+                      (subsets (cdr set)))
+              (subsets (cdr set)))))
+@end lisp
+But that does way more consing than you need.  Instead, you could
+replace the @code{append} with @code{nconc}, since you don't have any
+need for all the intermediate results.@refill
+
+Example:
+@lisp
+(define x '(a b c))
+(define y '(d e f))
+(nconc x y)
+   @result{} (a b c d e f)
+x
+   @result{} (a b c d e f)
+@end lisp
+
+@code{nconc} is the same as @code{append!} in @file{sc2.scm}.
+@end deffn
+
+@deffn Procedure nreverse lst
+@code{nreverse} reverses the order of elements in @var{lst} by mutating
+@code{cdr}s of the list.  Sometimes called @code{reverse!}.@refill
+
+Example:
+@lisp
+(define foo '(a b c))
+(nreverse foo)
+   @result{} (c b a)
+foo
+   @result{} (a)
+@end lisp
+
+Some people have been confused about how to use @code{nreverse},
+thinking that it doesn't return a value.  It needs to be pointed out
+that@refill
+@lisp
+(set! lst (nreverse lst))
+@end lisp
+@noindent
+is the proper usage, not
+@lisp
+(nreverse lst)
+@end lisp
+The example should suffice to show why this is the case.
+@end deffn
+
+@deffn Procedure delete elt lst
+@deffnx Procedure delete-if pred lst
+@deffnx Procedure delete-if-not pred lst
+Destructive versions of @code{remove} @code{remove-if}, and
+@code{remove-if-not}.@refill
+
+Example:
+@lisp
+(define lst '(foo bar baz bang))
+(delete 'foo lst)
+   @result{} (bar baz bang)
+lst
+   @result{} (foo bar baz bang)
+
+(define lst '(1 2 3 4 5 6 7 8 9))
+(delete-if odd? lst)
+   @result{} (2 4 6 8)
+lst
+   @result{} (1 2 4 6 8)
+@end lisp
+
+Some people have been confused about how to use @code{delete},
+@code{delete-if}, and @code{delete-if}, thinking that they dont' return
+a value.  It needs to be pointed out that@refill
+@lisp
+(set! lst (delete el lst))
+@end lisp
+@noindent
+is the proper usage, not
+@lisp
+(delete el lst)
+@end lisp
+The examples should suffice to show why this is the case.
+@end deffn
+
+
+
+@node Non-List functions,  , Destructive list operations, Common List Functions
+@subsection Non-List functions
+
+@defun and? . args
+@code{and?} checks to see if all its arguments are true.  If they are,
+@code{and?} returns @code{#t}, otherwise, @code{#f}.  (In contrast to
+@code{and}, this is a function, so all arguments are always evaluated
+and in an unspecified order.)@refill
+
+Example:
+@lisp
+(and? 1 2 3)
+   @result{} #t
+(and #f 1 2)
+   @result{} #f
+@end lisp
+@end defun
+
+@defun or? . args
+@code{or?} checks to see if any of its arguments are true.  If any is
+true, @code{or?} returns @code{#t}, and @code{#f} otherwise.  (To
+@code{or} as @code{and?} is to @code{and}.)@refill
+
+Example:
+@lisp
+(or? 1 2 #f)
+   @result{} #t
+(or? #f #f #f)
+   @result{} #f
+@end lisp
+@end defun
+
+@defun atom? object
+Returns @code{#t} if @var{object} is not a pair and @code{#f} if it is
+pair.  (Called @code{atom} in Common LISP.)
+@lisp
+(atom? 1)
+   @result{} #t
+(atom? '(1 2))
+   @result{} #f
+(atom? #(1 2))   ; dubious!
+   @result{} #t
+@end lisp
+@end defun
+
+@defun type-of object
+Returns a symbol name for the type of @var{object}.
+@end defun
+
+@defun coerce object result-type
+Converts and returns @var{object} of type @code{char}, @code{number},
+@code{string}, @code{symbol}, @code{list}, or @code{vector} to
+@var{result-type} (which must be one of these symbols).
+@end defun
+
+@node Format, Generic-Write, Common List Functions, Procedures
+@section Format
+
+@code{(require 'format)}
+
+@menu
+* Format Interface::            
+* Format Specification::        
+@end menu
+
+@node Format Interface, Format Specification, Format, Format
+@subsection Format Interface
+
+@defun format destination format-string . arguments
+An almost complete implementation of Common LISP format description
+according to the CL reference book @cite{Common LISP} from Guy L.
+Steele, Digital Press.  Backward compatible to most of the available
+Scheme format implementations.
+
+Returns @code{#t}, @code{#f} or a string; has side effect of printing
+according to @var{format-string}.  If @var{destination} is @code{#t},
+the output is to the current output port and @code{#t} is returned.  If
+@var{destination} is @code{#f}, a formatted string is returned as the
+result of the call.  NEW: If @var{destination} is a string,
+@var{destination} is regarded as the format string; @var{format-string} is
+then the first argument and the output is returned as a string. If
+@var{destination} is a number, the output is to the current error port
+if available by the implementation. Otherwise @var{destination} must be
+an output port and @code{#t} is returned.@refill
+
+@var{format-string} must be a string.  In case of a formatting error
+format returns @code{#f} and prints a message on the current output or
+error port.  Characters are output as if the string were output by the
+@code{display} function with the exception of those prefixed by a tilde
+(~).  For a detailed description of the @var{format-string} syntax
+please consult a Common LISP format reference manual.  For a test suite
+to verify this format implementation load @file{formatst.scm}. Please
+send bug reports to @code{lutzeb@@cs.tu-berlin.de}.
+
+Note: @code{format} is not reentrant, i.e. only one @code{format}-call
+may be executed at a time.
+
+@end defun
+
+@node Format Specification,  , Format Interface, Format
+@subsection Format Specification (Format version 3.0)
+
+Please consult a Common LISP format reference manual for a detailed
+description of the format string syntax.  For a demonstration of the
+implemented directives see @file{formatst.scm}.@refill
+
+This implementation supports directive parameters and modifiers
+(@code{:} and @code{@@} characters). Multiple parameters must be
+separated by a comma (@code{,}).  Parameters can be numerical parameters
+(positive or negative), character parameters (prefixed by a quote
+character (@code{'}), variable parameters (@code{v}), number of rest
+arguments parameter (@code{#}), empty and default parameters.  Directive
+characters are case independent. The general form of a directive
+is:@refill
+
+@noindent
+@var{directive} ::= ~@{@var{directive-parameter},@}[:][@@]@var{directive-character}
+
+@noindent
+@var{directive-parameter} ::= [ [-|+]@{0-9@}+ | '@var{character} | v | # ]
+
+
+@subsubsection Implemented CL Format Control Directives
+
+Documentation syntax: Uppercase characters represent the corresponding
+control directive characters. Lowercase characters represent control
+directive parameter descriptions.
+
+@table @asis
+@item @code{~A}
+Any (print as @code{display} does).
+@table @asis
+@item @code{~@@A}
+left pad.
+@item @code{~@var{mincol},@var{colinc},@var{minpad},@var{padchar}A}
+full padding.
+@end table
+@item @code{~S}
+S-expression (print as @code{write} does).
+@table @asis
+@item @code{~@@S}
+left pad.
+@item @code{~@var{mincol},@var{colinc},@var{minpad},@var{padchar}S}
+full padding.
+@end table
+@item @code{~D}
+Decimal.
+@table @asis
+@item @code{~@@D}
+print number sign always.
+@item @code{~:D}
+print comma separated.
+@item @code{~@var{mincol},@var{padchar},@var{commachar}D}
+padding.
+@end table
+@item @code{~X}
+Hexadecimal.
+@table @asis
+@item @code{~@@X}
+print number sign always.
+@item @code{~:X}
+print comma separated.
+@item @code{~@var{mincol},@var{padchar},@var{commachar}X}
+padding.
+@end table
+@item @code{~O}
+Octal.
+@table @asis
+@item @code{~@@O}
+print number sign always.
+@item @code{~:O}
+print comma separated.
+@item @code{~@var{mincol},@var{padchar},@var{commachar}O}
+padding.
+@end table
+@item @code{~B}
+Binary.
+@table @asis
+@item @code{~@@B}
+print number sign always.
+@item @code{~:B}
+print comma separated.
+@item @code{~@var{mincol},@var{padchar},@var{commachar}B}
+padding.
+@end table
+@item @code{~@var{n}R}
+Radix @var{n}.
+@table @asis
+@item @code{~@var{n},@var{mincol},@var{padchar},@var{commachar}R}
+padding.
+@end table
+@item @code{~@@R}
+print a number as a Roman numeral.
+@item @code{~:R}
+print a number as an ordinal English number.
+@item @code{~:@@R}
+print a number as a cardinal English number.
+@item @code{~P}
+Plural.
+@table @asis
+@item @code{~@@P}
+prints @code{y} and @code{ies}.
+@item @code{~:P}
+as @code{~P but jumps 1 argument backward.}
+@item @code{~:@@P}
+as @code{~@@P but jumps 1 argument backward.}
+@end table
+@item @code{~C}
+Character.
+@table @asis
+@item @code{~@@C}
+prints a character as the reader can understand it (i.e. @code{#\} prefixing).
+@item @code{~:C}
+prints a character as emacs does (eg. @code{^C} for ASCII 03).
+@end table
+@item @code{~F}
+Fixed-format floating-point (prints a flonum like @var{mmm.nnn}).
+@table @asis
+@item @code{~@var{width},@var{digits},@var{scale},@var{overflowchar},@var{padchar}F}
+@item @code{~@@F}
+If the number is positive a plus sign is printed.
+@end table
+@item @code{~E}
+Exponential floating-point (prints a flonum like @var{mmm.nnn@code{E}ee}).
+@table @asis
+@item @code{~@var{width},@var{digits},@var{exponentdigits},@var{scale},@var{overflowchar},@var{padchar},@var{exponentchar}E}
+@item @code{~@@E}
+If the number is positive a plus sign is printed.
+@end table
+@item @code{~G}
+General floating-point (prints a flonum either fixed or exponential).
+@table @asis
+@item @code{~@var{width},@var{digits},@var{exponentdigits},@var{scale},@var{overflowchar},@var{padchar},@var{exponentchar}G}
+@item @code{~@@G}
+If the number is positive a plus sign is printed.
+@end table
+@item @code{~$}
+Dollars floating-point (prints a flonum in fixed with signs separated).
+@table @asis
+@item @code{~@var{digits},@var{scale},@var{width},@var{padchar}$}
+@item @code{~@@$}
+If the number is positive a plus sign is printed.
+@item @code{~:@@$}
+A sign is always printed and appears before the padding.
+@item @code{~:$}
+The sign appears before the padding.
+@end table
+@item @code{~%}
+Newline.
+@table @asis
+@item @code{~@var{n}%}
+print @var{n} newlines.
+@end table
+@item @code{~&}
+print newline if not at the beginning of the output line.
+@table @asis
+@item @code{~@var{n}&}
+prints @code{~&} and then @var{n-1} newlines.
+@end table
+@item @code{~|}
+Page Separator.
+@table @asis
+@item @code{~@var{n}|}
+print @var{n} page separators.
+@end table
+@item @code{~~}
+Tilde.
+@table @asis
+@item @code{~@var{n}~}
+print @var{n} tildes.
+@end table
+@item @code{~}<newline>
+Continuation Line.
+@table @asis
+@item @code{~:}<newline>
+newline is ignored, white space left.
+@item @code{~@@}<newline>
+newline is left, white space ignored.
+@end table
+@item @code{~T}
+Tabulation.
+@table @asis
+@item @code{~@@T}
+relative tabulation.
+@item @code{~@var{colnum,colinc}T}
+full tabulation.
+@end table
+@item @code{~?}
+Indirection (expects indirect arguments as a list).
+@table @asis
+@item @code{~@@?}
+extracts indirect arguments from format arguments.
+@end table
+@item @code{~(@var{str}~)}
+Case conversion (converts by @code{string-downcase}).
+@table @asis
+@item @code{~:(@var{str}~)}
+converts by @code{string-capitalize}.
+@item @code{~@@(@var{str}~)}
+converts by @code{string-capitalize-first}.
+@item @code{~:@@(@var{str}~)}
+converts by @code{string-upcase}.
+@end table
+@item @code{~*}
+Argument Jumping (jumps 1 argument forward).
+@table @asis
+@item @code{~@var{n}*}
+jumps @var{n} arguments forward.
+@item @code{~:*}
+jumps 1 argument backward.
+@item @code{~@var{n}:*}
+jumps @var{n} arguments backward.
+@item @code{~@@*}
+jumps to the 0th argument.
+@item @code{~@var{n}@@*}
+jumps to the @var{n}th argument (beginning from 0)
+@end table
+@item @code{~[@var{str0}~;@var{str1}~;...~;@var{strn}~]}
+Conditional Expression (numerical clause conditional).
+@table @asis
+@item @code{~@var{n}[}
+take argument from @var{n}.
+@item @code{~@@[}
+true test conditional.
+@item @code{~:[}
+if-else-then conditional.
+@item @code{~;}
+clause separator.
+@item @code{~:;}
+default clause follows.
+@end table
+@item @code{~@{@var{str}~@}}
+Iteration (args come from the next argument (a list)).
+@table @asis
+@item @code{~@var{n}@{}
+at most @var{n} iterations.
+@item @code{~:@{}
+args from next arg (a list of lists).
+@item @code{~@@@{}
+args from the rest of arguments.
+@item @code{~:@@@{}
+args from the rest args (lists).
+@end table
+@item @code{~^}
+Up and out.
+@table @asis
+@item @code{~@var{n}^}
+aborts if @var{n} = 0
+@item @code{~@var{n},@var{m}^}
+aborts if @var{n} = @var{m}
+@item @code{~@var{n},@var{m},@var{k}^}
+aborts if @var{n} <= @var{m} <= @var{k}
+@end table
+@end table
+
+
+@subsubsection Not Implemented CL Format Control Directives
+
+@table @asis
+@item @code{~:A}
+print @code{#f} as an empty list (see below).
+@item @code{~:S}
+print @code{#f} as an empty list (see below).
+@item @code{~<~>}
+Justification.
+@item @code{~:^}
+(sorry I don't understand its semantics completely)
+@end table
+
+
+@subsubsection Extended, Replaced and Additional Control Directives
+
+@table @asis
+@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}D}
+@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}X}
+@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}O}
+@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}B}
+@item @code{~@var{n},@var{mincol},@var{padchar},@var{commachar},@var{commawidth}R}
+@var{commawidth} is the number of characters between two comma characters.
+@end table
+
+@table @asis
+@item @code{~I}
+print a R4RS complex number as @code{~F~@@Fi} with passed parameters for
+@code{~F}.
+@item @code{~Y}
+Pretty print formatting of an argument for scheme code lists.
+@item @code{~K}
+Same as @code{~?.}
+@item @code{~!}
+Flushes the output if format @var{destination} is a port.
+@item @code{~_}
+Print a @code{#\space} character
+@table @asis
+@item @code{~@var{n}_}
+print @var{n} @code{#\space} characters.
+@end table
+@item @code{~/}
+Print a @code{#\tab} character
+@table @asis
+@item @code{~@var{n}/}
+print @var{n} @code{#\tab} characters.
+@end table
+@item @code{~@var{n}C}
+Takes @var{n} as an integer representation for a character. No arguments
+are consumed. @var{n} is converted to a character by
+@code{integer->char}.  @var{n} must be a positive decimal number.@refill
+@item @code{~:S}
+Print out readproof.  Prints out internal objects represented as
+@code{#<...>} as strings @code{"#<...>"} so that the format output can always
+be processed by @code{read}.
+@refill
+@item @code{~:A}
+Print out readproof.  Prints out internal objects represented as
+@code{#<...>} as strings @code{"#<...>"} so that the format output can always
+be processed by @code{read}.
+@item @code{~Q}
+Prints information and a copyright notice on the format implementation.
+@table @asis
+@item @code{~:Q}
+prints format version.
+@end table
+@refill
+@item @code{~F, ~E, ~G, ~$}
+may also print number strings, i.e. passing a number as a string and
+format it accordingly.
+@end table
+
+@subsubsection Configuration Variables
+
+Format has some configuration variables at the beginning of
+@file{format.scm} to suit the systems and users needs. There should be
+no modification necessary for the configuration that comes with SLIB.
+If modification is desired the variable should be set after the format
+code is loaded. Format detects automatically if the running scheme
+system implements floating point numbers and complex numbers.
+
+@table @asis
+
+@item @var{format:symbol-case-conv}
+Symbols are converted by @code{symbol->string} so the case type of the
+printed symbols is implementation dependent.
+@code{format:symbol-case-conv} is a one arg closure which is either
+@code{#f} (no conversion), @code{string-upcase}, @code{string-downcase}
+or @code{string-capitalize}. (default @code{#f})
+
+@item @var{format:iobj-case-conv}
+As @var{format:symbol-case-conv} but applies for the representation of
+implementation internal objects. (default @code{#f})
+
+@item @var{format:expch}
+The character prefixing the exponent value in @code{~E} printing. (default
+@code{#\E})
+
+@end table
+
+@subsubsection Compatibility With Other Format Implementations
+
+@table @asis
+@item SLIB format 2.x:
+See @file{format.doc}.
+
+@item SLIB format 1.4:
+Downward compatible except for padding support and @code{~A}, @code{~S},
+@code{~P}, @code{~X} uppercase printing.  SLIB format 1.4 uses C-style
+@code{printf} padding support which is completely replaced by the CL
+@code{format} padding style.
+
+@item MIT C-Scheme 7.1:
+Downward compatible except for @code{~}, which is not documented
+(ignores all characters inside the format string up to a newline
+character).  (7.1 implements @code{~a}, @code{~s},
+~@var{newline}, @code{~~}, @code{~%}, numerical and variable
+parameters and @code{:/@@} modifiers in the CL sense).@refill
+
+@item Elk 1.5/2.0:
+Downward compatible except for @code{~A} and @code{~S} which print in
+uppercase.  (Elk implements @code{~a}, @code{~s}, @code{~~}, and
+@code{~%} (no directive parameters or modifiers)).@refill
+
+@item Scheme->C 01nov91:
+Downward compatible except for an optional destination parameter: S2C
+accepts a format call without a destination which returns a formatted
+string. This is equivalent to a #f destination in S2C. (S2C implements
+@code{~a}, @code{~s}, @code{~c}, @code{~%}, and @code{~~} (no directive
+parameters or modifiers)).@refill
+
+@end table
+
+This implementation of format is solely useful in the SLIB context
+because it requires other components provided by SLIB.@refill
+
+
+@node Generic-Write, Line I/O, Format, Procedures
+@section Generic-Write
+
+@code{(require 'generic-write)}
+
+@code{generic-write} is a procedure that transforms a Scheme data value
+(or Scheme program expression) into its textual representation and
+prints it.  The interface to the procedure is sufficiently general to
+easily implement other useful formatting procedures such as pretty
+printing, output to a string and truncated output.@refill
+
+@deffn Procedure generic-write obj display? width output
+@table @var
+@item obj
+Scheme data value to transform.
+@item display?
+Boolean, controls whether characters and strings are quoted.
+@item width
+Extended boolean, selects format:
+@table @asis
+@item #f
+single line format
+@item integer > 0
+pretty-print (value = max nb of chars per line)
+@end table
+@item output
+Procedure of 1 argument of string type, called repeatedly with
+successive substrings of the textual representation.  This procedure can
+return @code{#f} to stop the transformation.
+@end table
+
+The value returned by @code{generic-write} is undefined.
+
+Examples:
+@lisp
+(write obj) @equiv{} (generic-write obj #f #f @var{display-string})
+(display obj) @equiv{} (generic-write obj #t #f @var{display-string})
+@end lisp
+@noindent
+where
+@lisp
+@var{display-string} @equiv{}
+(lambda (s) (for-each write-char (string->list s)) #t)
+@end lisp
+@end deffn
+
+
+
+
+
+@node Line I/O, Multi-Processing, Generic-Write, Procedures
+@section Line I/O
+
+@code{(require 'line-i/o)}
+
+@defun read-line
+@defunx read-line port
+Returns a string of the characters up to, but not including a newline or
+end of file, updating @var{port} to point to the character following the
+newline.  If no characters are available, an end of file object is
+returned.  @var{port} may be omitted, in which case it defaults to the
+value returned by @code{current-input-port}.@refill
+@end defun
+
+@defun read-line! string
+@defunx read-line! string port
+Fills @var{string} with characters up to, but not including a newline or
+end of file, updating the port to point to the last character read or
+following the newline if it was read.  If no characters are available,
+an end of file object is returned.  If a newline or end of file was
+found, the number of characters read is returned.  Otherwise, @code{#f}
+is returned.  @var{port} may be omitted, in which case it defaults to
+the value returned by @code{current-input-port}.@refill
+@end defun
+
+@defun write-line string
+@defunx write-line string port
+Writes @var{string} followed by a newline to the given port and returns
+an unspecified value.  Port may be omited, in which case it defaults to
+the value returned by @code{current-input-port}.@refill
+@end defun
+
+
+
+
+@node Multi-Processing, Object-To-String, Line I/O, Procedures
+@section Multi-Processing
+
+@code{(require 'process)}
+
+@deffn Procedure add-process! proc
+Adds proc, which must be a procedure (or continuation) capable of
+accepting accepting one argument, to the @code{process:queue}.  The
+value returned is unspecified.  The argument to @var{proc} should be
+ignored.  If @var{proc} returns, the process is killed.@refill
+@end deffn
+
+@deffn Procedure process:schedule!
+Saves the current process on @code{process:queue} and runs the next
+process from @code{process:queue}.  The value returned is
+unspecified.@refill
+@end deffn
+
+
+@deffn Procedure kill-process!
+Kills the current process and runs the next process from
+@code{process:queue}.  If there are no more processes on
+@code{process:queue}, @code{(slib:exit)} is called (@xref{System}).
+@end deffn
+
+
+
+
+
+@node Object-To-String, Pretty-Print, Multi-Processing, Procedures
+@section Object-To-String
+
+@code{(require 'object->string)}
+
+@defun object->string obj
+Returns the textual representation of @var{obj} as a string.
+@end defun
+
+
+
+
+@node Pretty-Print, Sorting, Object-To-String, Procedures
+@section Pretty-Print
+
+@code{(require 'pretty-print)}
+
+@deffn Procedure pretty-print obj
+@deffnx Procedure pretty-print obj port
+
+@code{pretty-print}s @var{obj} on @var{port}.  If @var{port} is not
+specified, @code{current-output-port} is used.
+
+Example:
+@example
+@group
+(pretty-print '((1 2 3 4 5) (6 7 8 9 10) (11 12 13 14 15)
+                (16 17 18 19 20) (21 22 23 24 25)))
+   @print{} ((1 2 3 4 5)
+   @print{}  (6 7 8 9 10)
+   @print{}  (11 12 13 14 15)
+   @print{}  (16 17 18 19 20)
+   @print{}  (21 22 23 24 25))
+@end group
+@end example
+@end deffn
+
+
+@code{(require 'pprint-file)}
+
+@deffn Procedure pprint-file infile
+@deffnx Procedure pprint-file infile outfile
+Pretty-prints all the code in @var{infile}.  If @var{outfile} is
+specified, the output goes to @var{outfile}, otherwise it goes to
+@code{(current-output-port)}.@refill
+@end deffn
+
+@defun pprint-filter-file infile proc outfile
+@defunx pprint-filter-file infile proc
+@var{infile} is a port or a string naming an existing file.  Scheme
+source code expressions and definitions are read from the port (or file)
+and @var{proc} is applied to them sequentially.
+
+@var{outfile} is a port or a string.  If no @var{outfile} is specified
+then @code{current-output-port} is assumed.  These expanded expressions
+are then @code{pretty-print}ed to this port.
+
+Whitepsace and comments (introduced by @code{;}) which are not part of
+scheme expressions are reproduced in the output.  This procedure does
+not affect the values returned by @code{current-input-port} and
+@code{current-output-port}.@refill
+@end defun
+
+@code{pprint-filter-file} can be used to pre-compile macro-expansion and
+thus can reduce loading time.  The following will write into
+@file{exp-code.scm} the result of expanding all defmacros in
+@file{code.scm}.
+@lisp
+(require 'pprint-file)
+(require 'defmacroexpand)
+(defmacro:load "my-macros.scm")
+(pprint-filter-file "code.scm" defmacro:expand* "exp-code.scm")
+@end lisp
+
+
+@node Sorting, Topological Sort, Pretty-Print, Procedures
+@section Sorting
+
+@code{(require 'sort)}
+
+Many Scheme systems provide some kind of sorting functions.  They do
+not, however, always provide the @emph{same} sorting functions, and
+those that I have had the opportunity to test provided inefficient ones
+(a common blunder is to use quicksort which does not perform well).
+
+Because @code{sort} and @code{sort!} are not in the standard, there is
+very little agreement about what these functions look like.  For
+example, Dybvig says that Chez Scheme provides
+@lisp
+(merge predicate list1 list2)
+(merge! predicate list1 list2)
+(sort predicate list)
+(sort! predicate list)
+@end lisp
+@noindent
+while MIT Scheme 7.1, following Common LISP, offers unstable
+@lisp
+(sort list predicate)
+@end lisp
+@noindent
+TI PC Scheme offers
+@lisp
+(sort! list/vector predicate?)
+@end lisp
+@noindent
+and Elk offers
+@lisp
+(sort list/vector predicate?)
+(sort! list/vector predicate?)
+@end lisp
+
+Here is a comprehensive catalogue of the variations I have found.
+
+@enumerate
+@item
+Both @code{sort} and @code{sort!} may be provided.
+@item
+@code{sort} may be provided without @code{sort!}.
+@item
+@code{sort!} may be provided without @code{sort}.
+@item
+Neither may be provided.
+@item
+The sequence argument may be either a list or a vector.
+@item
+The sequence argument may only be a list.
+@item
+The sequence argument may only be a vector.
+@item
+The comparison function may be expected to behave like @code{<}.
+@item
+The comparison function may be expected to behave like @code{<=}.
+@item
+The interface may be @code{(sort predicate? sequence)}.
+@item
+The interface may be @code{(sort sequence predicate?)}.
+@item
+The interface may be @code{(sort sequence &optional (predicate? <))}.
+@item
+The sort may be stable.
+@item
+The sort may be unstable.
+@end enumerate
+
+All of this variation really does not help anybody.  A nice simple merge
+sort is both stable and fast (quite a lot faster than @emph{quick} sort).
+
+I am providing this source code with no restrictions at all on its use
+(but please retain D.H.D.Warren's credit for the original idea).  You
+may have to rename some of these functions in order to use them in a
+system which already provides incompatible or inferior sorts.  For each
+of the functions, only the top-level define needs to be edited to do
+that.
+
+I could have given these functions names which would not clash with any
+Scheme that I know of, but I would like to encourage implementors to
+converge on a single interface, and this may serve as a hint.  The
+argument order for all functions has been chosen to be as close to
+Common LISP as made sense, in order to avoid NIH-itis.
+
+Each of the five functions has a required @emph{last} parameter which is
+a comparison function.  A comparison function @code{f} is a function of
+2 arguments which acts like @code{<}.  For example,@refill
+
+@lisp
+(not (f x x))
+(and (f x y) (f y z)) @equiv{} (f x z)
+@end lisp
+
+The standard functions @code{<}, @code{>}, @code{char<?}, @code{char>?},
+@code{char-ci<?}, @code{char-ci>?}, @code{string<?}, @code{string>?},
+@code{string-ci<?}, and @code{string-ci>?} are suitable for use as
+comparison functions.  Think of @code{(less? x y)} as saying when
+@code{x} must @emph{not} precede @code{y}.@refill
+
+@defun sorted? sequence less?
+Returns @code{#t} when the sequence argument is in non-decreasing order
+according to @var{less?} (that is, there is no adjacent pair @code{@dots{} x
+y @dots{}} for which @code{(less? y x)}).@refill
+
+Returns @code{#f} when the sequence contains at least one out-of-order
+pair.  It is an error if the sequence is neither a list nor a vector.
+@end defun
+
+@defun merge list1 list2 less?
+This merges two lists, producing a completely new list as result.  I
+gave serious consideration to producing a Common-LISP-compatible
+version.  However, Common LISP's @code{sort} is our @code{sort!} (well,
+in fact Common LISP's @code{stable-sort} is our @code{sort!}, merge sort
+is @emph{fast} as well as stable!) so adapting CL code to Scheme takes a
+bit of work anyway.  I did, however, appeal to CL to determine the
+@emph{order} of the arguments.
+@end defun
+
+@deffn Procedure merge! list1 list2 less?
+Merges two lists, re-using the pairs of @var{list1} and @var{list2} to
+build the result.  If the code is compiled, and @var{less?} constructs
+no new pairs, no pairs at all will be allocated.  The first pair of the
+result will be either the first pair of @var{list1} or the first pair of
+@var{list2}, but you can't predict which.
+
+The code of @code{merge} and @code{merge!} could have been quite a bit
+simpler, but they have been coded to reduce the amount of work done per
+iteration.  (For example, we only have one @code{null?} test per
+iteration.)@refill
+@end deffn
+
+@defun sort sequence less?
+Accepts either a list or a vector, and returns a new sequence which is
+sorted.  The new sequence is the same type as the input.  Always
+@code{(sorted? (sort sequence less?) less?)}.  The original sequence is
+not altered in any way.  The new sequence shares its @emph{elements}
+with the old one; no elements are copied.@refill
+@end defun
+
+@deffn Procedure sort! sequence less?
+Returns its sorted result in the original boxes.  If the original
+sequence is a list, no new storage is allocated at all.  If the original
+sequence is a vector, the sorted elements are put back in the same
+vector.
+
+Some people have been confused about how to use @code{sort!}, thinking
+that it doesn't return a value.  It needs to be pointed out that
+@lisp
+(set! slist (sort! slist <))
+@end lisp
+@noindent
+is the proper usage, not
+@lisp
+(sort! slist <)
+@end lisp
+@end deffn
+
+Note that these functions do @emph{not} accept a CL-style @samp{:key}
+argument.  A simple device for obtaining the same expressiveness is to
+define@refill
+@lisp
+(define (keyed less? key)
+  (lambda (x y) (less? (key x) (key y))))
+@end lisp
+@noindent
+and then, when you would have written
+@lisp
+(sort a-sequence #'my-less :key #'my-key)
+@end lisp
+@noindent
+in Common LISP, just write
+@lisp
+(sort! a-sequence (keyed my-less? my-key))
+@end lisp
+@noindent
+in Scheme.
+
+@node Topological Sort, Standard Formatted I/O, Sorting, Procedures
+@section Topological Sort
+
+@code{(require 'topological-sort)} or @code{(require 'tsort)}
+
+@noindent
+The algorithm is inspired by Cormen, Leiserson and Rivest (1990)
+@cite{Introduction to Algorithms}, chapter 23.
+
+@defun tsort dag pred
+@defunx topological-sort dag pred
+where
+@table @var
+@item dag
+is a list of sublists.  The car of each sublist is a vertex.  The cdr is
+the adjacency list of that vertex, i.e. a list of all vertices to which
+there exists an edge from the car vertex.
+@item pred
+is one of @code{eq?}, @code{eqv?}, @code{equal?}, @code{=},
+@code{char=?}, @code{char-ci=?}, @code{string=?}, or @code{string-ci=?}.
+@end table
+
+Sort the directed acyclic graph @var{dag} so that for every edge from
+vertex @var{u} to @var{v}, @var{u} will come before @var{v} in the
+resulting list of vertices.
+
+Time complexity: O (|V| + |E|)
+
+Example (from Cormen):
+@quotation
+Prof. Bumstead topologically sorts his clothing when getting
+dressed.  The first argument to `tsort' describes which
+garments he needs to put on before others.  (For example,
+Prof Bumstead needs to put on his shirt before he puts on his
+tie or his belt.)  `tsort' gives the correct order of dressing:
+@end quotation
+
+@example
+(require 'tsort)
+(tsort '((shirt tie belt)
+         (tie jacket)
+         (belt jacket)
+         (watch)
+         (pants shoes belt)
+         (undershorts pants shoes)
+         (socks shoes))
+       eq?)
+@result{}
+(socks undershorts pants shoes watch shirt belt tie jacket)
+@end example
+@end defun
+
+@node Standard Formatted I/O, String-Case, Topological Sort, Procedures
+@section Standard Formatted I/O
+
+@menu
+* Standard Formatted Output::   
+* Standard Formatted Input::    
+@end menu
+
+@subsection stdio
+
+@code{(require 'stdio)}
+
+@code{require}s @code{printf} and @code{scanf} and additionally defines
+the symbols:
+
+@defvar stdin
+Defined to be @code{(current-input-port)}.
+@end defvar
+@defvar stdout
+Defined to be @code{(current-output-port)}.
+@end defvar
+@defvar stderr
+Defined to be @code{(current-error-port)}.
+@end defvar
+
+
+@node Standard Formatted Output, Standard Formatted Input, Standard Formatted I/O, Standard Formatted I/O
+@subsection Standard Formatted Output
+
+@code{(require 'printf)}
+
+@deffn Procedure printf format arg1 @dots{}
+@deffnx Procedure fprintf port format arg1 @dots{}
+@deffnx Procedure sprintf str format arg1 @dots{}
+
+Each function converts, formats, and outputs its @var{arg1} @dots{}
+arguments according to the control string @var{format} argument and
+returns the number of characters output.
+
+@code{printf} sends its output to the port @code{(current-output-port)}.
+@code{fprintf} sends its output to the port @var{port}.  @code{sprintf}
+@code{string-set!}s locations of the non-constant string argument
+@var{str} to the output characters.
+
+@quotation
+@emph{Note:} sprintf should be changed to a macro so a @code{substring}
+expression could be used for the @var{str} argument.
+@end quotation
+
+The string @var{format} contains plain characters which are copied to
+the output stream, and conversion specifications, each of which results
+in fetching zero or more of the arguments @var{arg1} @dots{}.  The
+results are undefined if there are an insufficient number of arguments
+for the format.  If @var{format} is exhausted while some of the
+@var{arg1} @dots{} arguments remain unused, the excess @var{arg1}
+@dots{} arguments are ignored.
+
+The conversion specifications in a format string have the form:
+
+@example
+% @r{[} @var{flags} @r{]} @r{[} @var{width} @r{]} @r{[} . @var{precision} @r{]} @r{[} @var{type} @r{]} @var{conversion}
+@end example
+
+An output conversion specifications consist of an initial @samp{%}
+character followed in sequence by:
+
+@itemize @bullet
+@item 
+Zero or more @dfn{flag characters} that modify the normal behavior of
+the conversion specification.
+
+@table @asis
+@item @samp{-}
+Left-justify the result in the field.  Normally the result is
+right-justified.
+
+@item @samp{+}
+For the signed @samp{%d} and @samp{%i} conversions and all inexact
+conversions, prefix a plus sign if the value is positive.
+
+@item @samp{ }
+For the signed @samp{%d} and @samp{%i} conversions, if the result
+doesn't start with a plus or minus sign, prefix it with a space
+character instead.  Since the @samp{+} flag ensures that the result
+includes a sign, this flag is ignored if both are specified.
+
+@item @samp{#}
+For inexact conversions, @samp{#} specifies that the result should
+always include a decimal point, even if no digits follow it.  For the
+@samp{%g} and @samp{%G} conversions, this also forces trailing zeros
+after the decimal point to be printed where they would otherwise be
+elided.
+
+For the @samp{%o} conversion, force the leading digit to be @samp{0}, as
+if by increasing the precision.  For @samp{%x} or @samp{%X}, prefix a
+leading @samp{0x} or @samp{0X} (respectively) to the result.  This
+doesn't do anything useful for the @samp{%d}, @samp{%i}, or @samp{%u}
+conversions.  Using this flag produces output which can be parsed by the
+@code{scanf} functions with the @samp{%i} conversion (@pxref{Standard
+Formatted Input}).
+
+
+@item @samp{0}
+Pad the field with zeros instead of spaces.  The zeros are placed after
+any indication of sign or base.  This flag is ignored if the @samp{-}
+flag is also specified, or if a precision is specified for an exact
+converson.
+@end table
+
+@item 
+An optional decimal integer specifying the @dfn{minimum field width}.
+If the normal conversion produces fewer characters than this, the field
+is padded (with spaces or zeros per the @samp{0} flag) to the specified
+width.  This is a @emph{minimum} width; if the normal conversion
+produces more characters than this, the field is @emph{not} truncated.
+@cindex minimum field width (@code{printf})
+
+Alternatively, if the field width is @samp{*}, the next argument in the
+argument list (before the actual value to be printed) is used as the
+field width.  The width value must be an integer.  If the value is
+negative it is as though the @samp{-} flag is set (see above) and the
+absolute value is used as the field width.
+
+@item 
+An optional @dfn{precision} to specify the number of digits to be
+written for numeric conversions and the maximum field width for string
+conversions.  The precision is specified by a period (@samp{.}) followed
+optionally by a decimal integer (which defaults to zero if omitted).
+@cindex precision (@code{printf})
+
+Alternatively, if the precision is @samp{.*}, the next argument in the
+argument list (before the actual value to be printed) is used as the
+precision.  The value must be an integer, and is ignored if negative.
+If you specify @samp{*} for both the field width and precision, the
+field width argument precedes the precision argument.  The @samp{.*}
+precision is an enhancement.  C library versions may not accept this
+syntax.
+
+For the @samp{%f}, @samp{%e}, and @samp{%E} conversions, the precision
+specifies how many digits follow the decimal-point character.  The
+default precision is @code{6}.  If the precision is explicitly @code{0},
+the decimal point character is suppressed.
+
+For the @samp{%g} and @samp{%G} conversions, the precision specifies how
+many significant digits to print.  Significant digits are the first
+digit before the decimal point, and all the digits after it.  If the
+precision is @code{0} or not specified for @samp{%g} or @samp{%G}, it is
+treated like a value of @code{1}.  If the value being printed cannot be
+expressed accurately in the specified number of digits, the value is
+rounded to the nearest number that fits.
+
+For exact conversions, if a precision is supplied it specifies the
+minimum number of digits to appear; leading zeros are produced if
+necessary.  If a precision is not supplied, the number is printed with
+as many digits as necessary.  Converting an exact @samp{0} with an
+explicit precision of zero produces no characters.
+
+@item
+An optional one of @samp{l}, @samp{h} or @samp{L}, which is ignored for
+numeric conversions.  It is an error to specify these modifiers for
+non-numeric conversions.
+
+@item
+A character that specifies the conversion to be applied.
+@end itemize
+
+@subsubsection Exact Conversions
+
+@table @asis
+@item @samp{d}, @samp{i}
+Print an integer as a signed decimal number.  @samp{%d} and @samp{%i}
+are synonymous for output, but are different when used with @code{scanf}
+for input (@pxref{Standard Formatted Input}).
+
+@item @samp{o}
+Print an integer as an unsigned octal number.
+
+@item @samp{u}
+Print an integer as an unsigned decimal number.
+
+@item @samp{x}, @samp{X}
+Print an integer as an unsigned hexadecimal number.  @samp{%x} prints
+using the digits @samp{0123456789abcdef}.  @samp{%X} prints using the
+digits @samp{0123456789ABCDEF}.
+@end table
+
+@subsubsection Inexact Conversions
+@emph{Note:} Inexact conversions are not supported yet.
+
+@table @asis
+@item @samp{f}
+Print a floating-point number in fixed-point notation.
+
+@item @samp{e}, @samp{E}
+Print a floating-point number in exponential notation.  @samp{%e} prints
+@samp{e} between mantissa and exponont.  @samp{%E} prints @samp{E}
+between mantissa and exponont.
+
+@item @samp{g}, @samp{G}
+Print a floating-point number in either normal or exponential notation,
+whichever is more appropriate for its magnitude.  @samp{%g} prints
+@samp{e} between mantissa and exponont.  @samp{%G} prints @samp{E}
+between mantissa and exponont.
+@end table
+
+@subsubsection Other Conversions
+@table @asis
+@item @samp{c}
+Print a single character.  The @samp{-} flag is the only one which can
+be specified.  It is an error to specify a precision.
+
+@item @samp{s}
+Print a string.  The @samp{-} flag is the only one which can be
+specified.  A precision specifies the maximum number of characters to
+output; otherwise all characters in the string are output.
+
+@item @samp{a}, @samp{A}
+Print a scheme expression.  The @samp{-} flag left-justifies the output.
+The @samp{#} flag specifies that strings and characters should be quoted
+as by @code{write} (which can be read using @code{read}); otherwise,
+output is as @code{display} prints.  A precision specifies the maximum
+number of characters to output; otherwise as many characters as needed
+are output.
+
+@emph{Note:} @samp{%a} and @samp{%A} are SLIB extensions.
+
+@c @item @samp{p}
+@c Print the value of a pointer.
+
+@c @item @samp{n}
+@c Get the number of characters printed so far.  @xref{Other Output Conversions}.
+@c Note that this conversion specification never produces any output.
+
+@c @item @samp{m}
+@c Print the string corresponding to the value of @code{errno}.
+@c (This is a GNU extension.)
+@c @xref{Other Output Conversions}.
+
+@item @samp{%}
+Print a literal @samp{%} character.  No argument is consumed.  It is an
+error to specifiy flags, field width, precision, or type modifiers with
+@samp{%%}.
+@end table
+@end deffn
+
+
+@node Standard Formatted Input,  , Standard Formatted Output, Standard Formatted I/O
+@subsection Standard Formatted Input
+
+@code{(require 'scanf)}
+
+@deffn Function scanf-read-list format
+@deffnx Function scanf-read-list format port
+@deffnx Function scanf-read-list format string
+@end deffn
+
+@defmac scanf format arg1 @dots{}
+@defmacx fscanf port format arg1 @dots{}
+@defmacx sscanf str format arg1 @dots{}
+
+Each function reads characters, interpreting them according to the
+control string @var{format} argument.
+
+@code{scanf-read-list} returns a list of the items specified as far as
+the input matches @var{format}.  @code{scanf}, @code{fscanf}, and
+@code{sscanf} return the number of items successfully matched and
+stored.  @code{scanf}, @code{fscanf}, and @code{sscanf} also set the
+location corresponding to @var{arg1} @dots{} using the methods:
+
+@table @asis
+@item symbol
+@code{set!}
+@item car expression
+@code{set-car!}
+@item cdr expression
+@code{set-cdr!}
+@item vector-ref expression
+@code{vector-set!}
+@item substring expression
+@code{substring-move-left!}
+@end table
+
+The argument to a @code{substring} expression in @var{arg1} @dots{} must
+be a non-constant string.  Characters will be stored starting at the
+position specified by the second argument to @code{substring}.  The
+number of characters stored will be limited by either the position
+specified by the third argument to @code{substring} or the length of the
+matched string, whichever is less.
+
+The control string, @var{format}, contains conversion specifications and
+other characters used to direct interpretation of input sequences.  The
+control string contains:
+
+@itemize @bullet
+@item White-space characters (blanks, tabs, newlines, or formfeeds)
+that cause input to be read (and discarded) up to the next
+non-white-space character.
+
+@item An ordinary character (not @samp{%}) that must match the next
+character of the input stream.
+
+@item Conversion specifications, consisting of the character @samp{%}, an
+optional assignment suppressing character @samp{*}, an optional
+numerical maximum-field width, an optional @samp{l}, @samp{h} or
+@samp{L} which is ignored, and a conversion code.
+
+@c @item The conversion specification can alternatively be prefixed by
+@c the character sequence @samp{%n$} instead of the character @samp{%},
+@c where @var{n} is a decimal integer in the range.  The @samp{%n$}
+@c construction indicates that the value of the next input field should be
+@c placed in the @var{n}th place in the return list, rather than to the next
+@c unused one.  The two forms of introducing a conversion specification,
+@c @samp{%} and @samp{%n$}, must not be mixed within a single format string
+@c with the following exception: Skip fields (see below) can be designated
+@c as @samp{%*} or @samp{%n$*}.  In the latter case, @var{n} is ignored.
+
+@end itemize
+
+Unless the specification contains the @samp{n} conversion character
+(described below), a conversion specification directs the conversion of
+the next input field.  The result of a conversion specification is
+returned in the position of the corresponding argument points, unless
+@samp{*} indicates assignment suppression.  Assignment suppression
+provides a way to describe an input field to be skipped.  An input field
+is defined as a string of characters; it extends to the next
+inappropriate character or until the field width, if specified, is
+exhausted.
+
+@quotation
+@emph{Note:} This specification of format strings differs from the
+@cite{ANSI C} and @cite{POSIX} specifications.  In SLIB, white space
+before an input field is not skipped unless white space appears before
+the conversion specification in the format string.  In order to write
+format strings which work identically with @cite{ANSI C} and SLIB,
+prepend whitespace to all conversion specifications except @samp{[} and
+@samp{c}.
+@end quotation
+
+The conversion code indicates the interpretation of the input field; For
+a suppressed field, no value is returned.  The following conversion
+codes are legal:
+
+@table @asis
+
+@item @samp{%}
+A single % is expected in the input at this point; no value is returned.
+
+@item @samp{d}, @samp{D}
+A decimal integer is expected.
+
+@item @samp{u}, @samp{U}
+An unsigned decimal integer is expected.
+
+@item @samp{o}, @samp{O}
+An octal integer is expected.
+
+@item @samp{x}, @samp{X}
+A hexadecimal integer is expected.
+
+@item @samp{i}
+An integer is expected.  Returns the value of the next input item,
+interpreted according to C conventions; a leading @samp{0} implies
+octal, a leading @samp{0x} implies hexadecimal; otherwise, decimal is
+assumed.
+
+@item @samp{n}
+Returns the total number of bytes (including white space) read by
+@code{scanf}.  No input is consumed by @code{%n}.
+
+@item @samp{f}, @samp{F}, @samp{e}, @samp{E}, @samp{g}, @samp{G}
+A floating-point number is expected.  The input format for
+floating-point numbers is an optionally signed string of digits,
+possibly containing a radix character @samp{.}, followed by an optional
+exponent field consisting of an @samp{E} or an @samp{e}, followed by an
+optional @samp{+}, @samp{-}, or space, followed by an integer.
+
+@item @samp{c}, @samp{C}
+@var{Width} characters are expected.  The normal skip-over-white-space
+is suppressed in this case; to read the next non-space character, use
+@samp{%1s}.  If a field width is given, a string is returned; up to the
+indicated number of characters is read.
+
+@item @samp{s}, @samp{S}
+A character string is expected The input field is terminated by a
+white-space character.  @code{scanf} cannot read a null string.
+
+@item @samp{[}
+Indicates string data and the normal skip-over-leading-white-space is
+suppressed.  The left bracket is followed by a set of characters, called
+the scanset, and a right bracket; the input field is the maximal
+sequence of input characters consisting entirely of characters in the
+scanset.  @samp{^}, when it appears as the first character in the
+scanset, serves as a complement operator and redefines the scanset as
+the set of all characters not contained in the remainder of the scanset
+string.  Construction of the scanset follows certain conventions.  A
+range of characters may be represented by the construct first-last,
+enabling @samp{[0123456789]} to be expressed @samp{[0-9]}.  Using this
+convention, first must be lexically less than or equal to last;
+otherwise, the dash stands for itself.  The dash also stands for itself
+when it is the first or the last character in the scanset.  To include
+the right square bracket as an element of the scanset, it must appear as
+the first character (possibly preceded by a @samp{^}) of the scanset, in
+which case it will not be interpreted syntactically as the closing
+bracket.  At least one character must match for this conversion to
+succeed.
+@end table
+
+The @code{scanf} functions terminate their conversions at end-of-file,
+at the end of the control string, or when an input character conflicts
+with the control string.  In the latter case, the offending character is
+left unread in the input stream.
+@end defmac
+
+@node String-Case, String Ports, Standard Formatted I/O, Procedures
+@section String-Case
+
+@code{(require 'string-case)}
+
+@deffn Procedure string-upcase str
+@deffnx Procedure string-downcase str
+@deffnx Procedure string-capitalize str
+The obvious string conversion routines.  These are non-destructive.
+@end deffn
+
+@defun string-upcase! str
+@defunx string-downcase! str
+@defunx string-captialize! str
+The destructive versions of the functions above.
+@end defun
+
+
+
+
+
+@node String Ports, String Search, String-Case, Procedures
+@section String Ports
+
+@code{(require 'string-port)}
+
+@deffn Procedure call-with-output-string proc
+@var{proc} must be a procedure of one argument.  This procedure calls
+@var{proc} with one argument: a (newly created) output port.  When the
+function returns, the string composed of the characters written into the
+port is returned.@refill
+@end deffn
+
+@deffn Procedure call-with-input-string string proc
+@var{proc} must be a procedure of one argument.  This procedure calls
+@var{proc} with one argument: an (newly created) input port from which
+@var{string}'s contents may be read.  When @var{proc} returns, the port
+is closed and the value yielded by the procedure @var{proc} is
+returned.@refill
+@end deffn
+
+
+@node String Search, Tektronix Graphics Support, String Ports, Procedures
+@section String Search
+
+@code{(require 'string-search)}
+
+@deffn Procedure string-index string char
+Returns the index of the first occurence of @var{char} within
+@var{string}, or @code{#f} if the @var{string} does not contain a
+character @var{char}.
+@end deffn
+
+@deffn procedure substring? pattern string
+Searches @var{string} to see if some substring of @var{string} is equal
+to @var{pattern}.  @code{substring?} returns the index of the first
+character of the first substring of @var{string} that is equal to
+@var{pattern}; or @code{#f} if @var{string} does not contain
+@var{pattern}.
+
+@example
+(substring? "rat" "pirate") @result{}  2
+(substring? "rat" "outrage") @result{}  #f
+(substring? "" any-string) @result{}  0
+@end example
+@end deffn
+
+@deffn Procedure find-string-from-port? str in-port max-no-chars
+@deffnx Procedure find-string-from-port? str in-port
+Looks for a string @var{str} within the first @var{max-no-chars} chars
+of the input port @var{in-port}.  @var{max-no-chars} may be omitted: in
+that case, the search span is limited by the end of the input stream.
+When the @var{str} is found, the function returns the number of
+characters it has read from the port, and the port is set to read the
+first char after that (that is, after the @var{str}) The function
+returns @code{#f} when the @var{str} isn't found.
+
+@code{find-string-from-port?} reads the port @emph{strictly}
+sequentially, and does not perform any buffering.  So
+@code{find-string-from-port?} can be used even if the @var{in-port} is
+open to a pipe or other communication channel.
+@end deffn
+
+
+@node Tektronix Graphics Support, Tree Operations, String Search, Procedures
+@section Tektronix Graphics Support
+
+@emph{Note:} The Tektronix graphics support files need more work, and
+are not complete.
+
+@subsection Tektronix 4000 Series Graphics
+
+The Tektronix 4000 series graphics protocol gives the user a 1024 by
+1024 square drawing area.  The origin is in the lower left corner of the
+screen.  Increasing y is up and increasing x is to the right.
+
+The graphics control codes are sent over the current-output-port and can
+be mixed with regular text and ANSI or other terminal control sequences.
+
+@deffn Procedure tek40:init
+@end deffn
+
+@deffn Procedure tek40:graphics
+@end deffn
+
+@deffn Procedure tek40:text
+@end deffn
+
+@deffn Procedure tek40:linetype linetype
+@end deffn
+
+@deffn Procedure tek40:move x y
+@end deffn
+
+@deffn Procedure tek40:draw x y
+@end deffn
+
+@deffn Procedure tek40:put-text x y str
+@end deffn
+
+@deffn Procedure tek40:reset
+@end deffn
+
+
+@subsection Tektronix 4100 Series Graphics
+
+The graphics control codes are sent over the current-output-port and can
+be mixed with regular text and ANSI or other terminal control sequences.
+
+@deffn Procedure tek41:init
+@end deffn
+
+@deffn Procedure tek41:reset
+@end deffn
+
+@deffn Procedure tek41:graphics
+@end deffn
+
+@deffn Procedure tek41:move x y
+@end deffn
+
+@deffn Procedure tek41:draw x y
+@end deffn
+
+@deffn Procedure tek41:point x y number
+@end deffn
+
+@deffn Procedure tek41:encode-x-y x y
+@end deffn
+
+@deffn Procedure tek41:encode-int number
+@end deffn
+
+
+
+@node Tree Operations,  , Tektronix Graphics Support, Procedures
+@section Tree operations
+
+@code{(require 'tree)}
+
+These are operations that treat lists a representations of trees.
+
+@defun subst new old tree
+@defunx substq new old tree
+@defunx substv new old tree
+@code{subst} makes a copy of @var{tree}, substituting @var{new} for
+every subtree or leaf of @var{tree} which is @code{equal?} to @var{old}
+and returns a modified tree.  The original @var{tree} is unchanged, but
+may share parts with the result.@refill
+
+@code{substq} and @code{substv} are similar, but test against @var{old}
+using @code{eq?} and @code{eqv?} respectively.@refill
+
+Examples:
+@lisp
+(substq 'tempest 'hurricane '(shakespeare wrote (the hurricane)))
+   @result{} (shakespeare wrote (the tempest))
+(substq 'foo '() '(shakespeare wrote (twelfth night)))
+   @result{} (shakespeare wrote (twelfth night . foo) . foo)
+(subst '(a . cons) '(old . pair)
+       '((old . spice) ((old . shoes) old . pair) (old . pair)))
+   @result{} ((old . spice) ((old . shoes) a . cons) (a . cons))
+@end lisp
+@end defun
+
+@defun copy-tree tree
+Makes a copy of the nested list structure @var{tree} using new pairs and
+returns it.  All levels are copied, so that none of the pairs in the
+tree are @code{eq?} to the original ones -- only the leaves are.@refill
+
+Example:
+@lisp
+(define bar '(bar))
+(copy-tree (list bar 'foo))
+   @result{} ((bar) foo)
+(eq? bar (car (copy-tree (list bar 'foo))))
+   @result{} #f
+@end lisp
+@end defun
+
+
+
+
+
+@node Standards Support, Session Support, Procedures, Top
+@chapter Standards Support
+
+
+
+@menu
+* With-File::                   'with-file
+* Transcripts::                 'transcript
+* Rev2 Procedures::             'rev2-procedures
+* Rev4 Optional Procedures::    'rev4-optional-procedures
+* Multi-argument / and -::      'multiarg/and-
+* Multi-argument Apply::        'multiarg-apply
+* Rationalize::                 'rationalize
+* Promises::                    'promise
+* Dynamic-Wind::                'dynamic-wind
+* Values::                      'values
+* Time::                        'time
+* CLTime::                      'common-lisp-time
+@end menu
+
+@node With-File, Transcripts, Standards Support, Standards Support
+@section With-File
+
+@code{(require 'with-file)}
+
+@defun with-input-from-file file thunk
+@defunx with-output-to-file file thunk
+Description found in R4RS.
+@end defun
+
+@node Transcripts, Rev2 Procedures, With-File, Standards Support
+@section Transcripts
+
+@code{(require 'transcript)}
+
+@defun transcript-on filename
+@defunx transcript-off filename
+Redefines @code{read-char}, @code{read}, @code{write-char},
+@code{write}, @code{display}, and @code{newline}.@refill
+@end defun
+
+
+
+
+
+@node Rev2 Procedures, Rev4 Optional Procedures, Transcripts, Standards Support
+@section Rev2 Procedures
+
+@code{(require 'rev2-procedures)}
+
+The procedures below were specified in the @cite{Revised^2 Report on
+Scheme}.  @strong{N.B.}: The symbols @code{1+} and @code{-1+} are not
+@cite{R4RS} syntax.  Scheme->C, for instance, barfs on this
+module.@refill
+
+@deffn Procedure substring-move-left! string1 start1 end1 string2 start2
+@deffnx Procedure substring-move-right! string1 start1 end1 string2 start2
+@var{string1} and @var{string2} must be a strings, and @var{start1},
+@var{start2} and @var{end1} must be exact integers satisfying@refill
+
+@display
+0 <= @var{start1} <= @var{end1} <= (string-length @var{string1})
+0 <= @var{start2} <= @var{end1} - @var{start1} + @var{start2} <= (string-length @var{string2})
+@end display
+
+@code{substring-move-left!} and @code{substring-move-right!} store
+characters of @var{string1} beginning with index @var{start1}
+(inclusive) and ending with index @var{end1} (exclusive) into
+@var{string2} beginning with index @var{start2} (inclusive).@refill
+
+@code{substring-move-left!} stores characters in time order of
+increasing indices.  @code{substring-move-right!} stores characters in
+time order of increasing indeces.@refill
+@end deffn
+
+@deffn Procedure substring-fill! string start end char
+Fills the elements @var{start}--@var{end} of @var{string} with the
+character @var{char}.@refill
+@end deffn
+
+@defun string-null? str
+@equiv{} @code{(= 0 (string-length @var{str}))}
+@end defun
+
+@deffn Procedure append! . pairs
+Destructively appends its arguments.  Equivalent to @code{nconc}.
+@end deffn
+
+@defun 1+ n
+Adds 1 to @var{n}.
+@end defun
+
+@defun -1+ n
+Subtracts 1 from @var{n}.
+@end defun
+
+@defun <?
+@defunx <=?
+@defunx =?
+@defunx >?
+@defunx >=?
+These are equivalent to the procedures of the same name but without the
+trailing @samp{?}.
+@end defun
+
+
+
+@node Rev4 Optional Procedures, Multi-argument / and -, Rev2 Procedures, Standards Support
+@section Rev4 Optional Procedures
+
+@code{(require 'rev4-optional-procedures)}
+
+For the specification of these optional procedures,
+@xref{Standard procedures, , ,r4rs, Revised(4) Scheme}.
+
+@defun list-tail l p
+@end defun
+
+@defun string->list s
+@end defun
+
+@defun list->string l
+@end defun
+
+@defun string-copy
+@end defun
+
+@deffn Procedure string-fill! s obj
+@end deffn
+
+@defun list->vector l
+@end defun
+
+@defun vector->list s
+@end defun
+
+@deffn Procedure vector-fill! s obj
+@end deffn
+
+
+
+
+
+@node Multi-argument / and -, Multi-argument Apply, Rev4 Optional Procedures, Standards Support
+@section Multi-argument / and -
+
+@code{(require 'mutliarg/and-)}
+
+For the specification of these optional forms, @xref{Numerical
+operations, , ,r4rs, Revised(4) Scheme}.  The @code{two-arg:}* forms are
+only defined if the implementation does not support the many-argument
+forms.@refill
+
+@defun two-arg:/ n1 n2
+The original two-argument version of @code{/}.
+@end defun
+
+@defun / divident . divisors
+@end defun
+
+@defun two-arg:- n1 n2
+The original two-argument version of @code{-}.
+@end defun
+
+@defun - minuend . subtrahends
+@end defun
+
+
+
+
+
+@node Multi-argument Apply, Rationalize, Multi-argument / and -, Standards Support
+@section Multi-argument Apply
+
+@code{(require 'multiarg-apply)}
+
+@noindent
+For the specification of this optional form,
+@xref{Control features, , ,r4rs, Revised(4) Scheme}.
+
+@defun two-arg:apply proc l
+The implementation's native @code{apply}.  Only defined for
+implementations which don't support the many-argument version.
+@end defun
+
+@defun apply proc . args
+@end defun
+
+
+
+
+
+@node Rationalize, Promises, Multi-argument Apply, Standards Support
+@section Rationalize
+
+@code{(require 'rationalize)}
+
+The procedure rationalize is interesting because most programming
+languages do not provide anything analogous to it.  For simplicity, we
+present an algorithm which computes the correct result for exact
+arguments (provided the implementation supports exact rational numbers
+of unlimited precision), and produces a reasonable answer for inexact
+arguments when inexact arithmetic is implemented using floating-point.
+We thank Alan Bawden for contributing this algorithm.
+
+@defun rationalize x e
+@end defun
+
+
+
+
+
+@node Promises, Dynamic-Wind, Rationalize, Standards Support
+@section Promises
+
+@code{(require 'promise)}
+
+@defun make-promise proc
+@end defun
+
+Change occurrences of @code{(delay @var{expression})} to
+@code{(make-promise (lambda () @var{expression}))} and @code{(define
+force promise:force)} to implement promises if your implementation
+doesn't support them
+(@pxref{Control features, , ,r4rs, Revised(4) Scheme}).
+
+
+
+
+@node Dynamic-Wind, Values, Promises, Standards Support
+@section Dynamic-Wind
+
+@code{(require 'dynamic-wind)}
+
+This facility is a generalization of Common LISP @code{unwind-protect},
+designed to take into account the fact that continuations produced by
+@code{call-with-current-continuation} may be reentered.@refill
+
+@deffn Procedure dynamic-wind thunk1 thunk2 thunk3
+The arguments @var{thunk1}, @var{thunk2}, and @var{thunk3} must all be
+procedures of no arguments (thunks).@refill
+
+@code{dynamic-wind} calls @var{thunk1}, @var{thunk2}, and then
+@var{thunk3}.  The value returned by @var{thunk2} is returned as the
+result of @code{dynamic-wind}.  @var{thunk3} is also called just before
+control leaves the dynamic context of @var{thunk2} by calling a
+continuation created outside that context.  Furthermore, @var{thunk1} is
+called before reentering the dynamic context of @var{thunk2} by calling
+a continuation created inside that context.  (Control is inside the
+context of @var{thunk2} if @var{thunk2} is on the current return stack).
+
+@strong{Warning:} There is no provision for dealing with errors or
+interrupts.  If an error or interrupt occurs while using
+@code{dynamic-wind}, the dynamic environment will be that in effect at
+the time of the error or interrupt.@refill
+@end deffn
+
+
+
+
+@node Values, Time, Dynamic-Wind, Standards Support
+@section Values
+
+@code{(require 'values)}
+
+@defun values obj @dots{}
+@code{values} takes any number of arguments, and passes (returns) them
+to its continuation.@refill
+@end defun
+
+
+@defun call-with-values thunk proc
+@var{thunk} must be a procedure of no arguments, and @var{proc} must be
+a procedure.  @code{call-with-values} calls @var{thunk} with a
+continuation that, when passed some values, calls @var{proc} with those
+values as arguments.@refill
+
+Except for continuations created by the @code{call-with-values}
+procedure, all continuations take exactly one value, as now; the effect
+of passing no value or more than one value to continuations that were
+not created by the @code{call-with-values} procedure is
+unspecified.@refill
+@end defun
+
+@node Time, CLTime, Values, Standards Support
+@section Time
+
+The procedures @code{current-time}, @code{difftime}, and
+@code{offset-time} are supported by all implementations (SLIB provides
+them if feature @code{('current-time)} is missing.  @code{current-time}
+returns a @dfn{calendar time} (caltime) which can be a number or other
+type.
+
+@defun current-time
+Returns the time since 00:00:00 GMT, January 1, 1970, measured in
+seconds.  Note that the reference time is different from the reference
+time for @code{get-universal-time} in @ref{CLTime}.  On implementations
+which cannot support actual times, @code{current-time} will increment a
+counter and return its value when called.
+@end defun
+
+@defun difftime caltime1 caltime0
+Returns the difference (number of seconds) between twe calendar times:
+@var{caltime1} - @var{caltime0}.  @var{caltime0} can also be a number.
+@end defun
+
+@defun offset-time caltime offset
+Returns the calendar time of @var{caltime} offset by @var{offset} number
+of seconds @code{(+ caltime offset)}.
+@end defun
+
+@example
+(require 'posix-time)
+@end example
+
+These procedures are intended to be compatible with Posix time
+conversion functions.
+
+@defvar *timezone*
+contains the difference, in seconds, between UTC and local standard time
+(for example, in the U.S.  Eastern time zone (EST), timezone is
+5*60*60).  @code{*timezone*} is initialized by @code{tzset}.
+@end defvar
+
+@defun tzset
+initializes the @var{*timezone*} variable from the TZ environment
+variable.  This function is automatically called by the other time
+conversion functions that depend on the time zone.
+@end defun
+
+@defun gmtime caltime
+converts the calendar time @var{caltime} to a vector of integers
+representing the time expressed as Coordinated Universal Time (UTC).
+
+@defunx localtime caltime
+converts the calendar time @var{caltime} to a vector of integers expressed
+relative to the user's time zone.  @code{localtime} sets the variable
+@var{*timezone*} with the difference between Coordinated Universal Time
+(UTC) and local standard time in seconds by calling @code{tzset}.
+The elements of the returned vector are as follows:
+
+@enumerate 0
+@item
+ seconds (0 - 61)
+@item
+ minutes (0 - 59)
+@item
+ hours since midnight
+@item
+ day of month
+@item
+ month (0 - 11).  Note difference from @code{decode-universal-time}.
+@item
+ year (A.D.)
+@item
+ day of week (0 - 6)
+@item
+ day of year (0 - 365)
+@item
+ 1 for daylight savings, 0 for regular time
+@end enumerate
+@end defun
+
+@defun mktime univtime
+Converts a vector of integers in Coordinated Universal Time (UTC) format
+to calendar time (caltime) format.
+@end defun
+
+@defun asctime univtime
+Converts the vector of integers @var{caltime} in Coordinated
+Universal Time (UTC) format into a string of the form
+@code{"Wed Jun 30 21:49:08 1993"}.
+@end defun
+
+@defun ctime caltime
+Equivalent to @code{(time:asctime (time:localtime @var{caltime}))}.
+@end defun
+
+@node CLTime,  , Time, Standards Support
+@section CLTime
+
+@defun get-decoded-time
+Equivalent to @code{(decode-universal-time (get-universal-time))}.
+@end defun
+
+@defun get-universal-time
+Returns the current time as @dfn{Universal Time}, number of seconds
+since 00:00:00 Jan 1, 1900 GMT.  Note that the reference time is
+different from @code{current-time}.
+@end defun
+
+@defun decode-universal-time univtime
+Converts @var{univtime} to @dfn{Decoded Time} format.
+Nine values are returned:
+@enumerate 0
+@item
+ seconds (0 - 61)
+@item
+ minutes (0 - 59)
+@item
+ hours since midnight
+@item
+ day of month
+@item
+ month (1 - 12).  Note difference from @code{gmtime} and @code{localtime}.
+@item
+ year (A.D.)
+@item
+ day of week (0 - 6)
+@item
+ #t for daylight savings, #f otherwise
+@item
+ hours west of GMT (-24 - +24)
+@end enumerate
+
+Notice that the values returned by @code{decode-universal-time} do not
+match the arguments to @code{encode-universal-time}.
+@end defun
+
+@defun encode-universal-time second minute hour date month year
+@defunx encode-universal-time second minute hour date month year time-zone
+Converts the arguments in Decoded Time format to Universal Time format.
+If @var{time-zone} is not specified, the returned time is adjusted for
+daylight saving time.  Otherwise, no adjustment is performed.
+
+Notice that the values returned by @code{decode-universal-time} do not
+match the arguments to @code{encode-universal-time}.
+@end defun
+
+
+@node Session Support, Optional SLIB Packages, Standards Support, Top
+@chapter Session Support
+
+@menu
+* Repl::                        Macros at top-level
+* Quick Print::                 Loop-safe Output
+* Debug::                       To err is human ...
+* Breakpoints::                 Pause execution
+* Trace::                       'trace
+* Getopt::                      Command Line option parsing
+* Command Line::                A command line reader for Scheme shells
+* System Interface::            'system and 'getenv
+
+Certain features are so simple, system-dependent, or widely subcribed
+that they are supported by all implementations as part of the
+@samp{*.init} files.
+
+The features described in the following sections are provided by all
+implementations.
+
+* Require::                     Module Management
+* Vicinity::                    Pathname Management
+* Configuration::               Characteristics of Scheme Implementation
+* Input/Output::                Things not provided by the Scheme specs.
+* Legacy::                      
+* System::                      LOADing, EVALing, ERRORing, and EXITing
+@end menu
+
+
+
+@node Repl, Quick Print, Session Support, Session Support
+@section Repl
+
+@code{(require 'repl)}
+
+Here is a read-eval-print-loop which, given an eval, evaluates forms.
+
+@deffn Procedure repl:top-level repl:eval
+@code{read}s, @code{repl:eval}s and @code{write}s expressions from
+@code{(current-input-port)} to @code{(current-output-port)} until an
+end-of-file is encountered.  @code{load}, @code{slib:eval},
+@code{slib:error}, and @code{repl:quit} dynamically bound during
+@code{repl:top-level}.@refill
+@end deffn
+
+@deffn Procedure repl:quit
+Exits from the invocation of @code{repl:top-level}.
+@end deffn
+
+The @code{repl:} procedures establish, as much as is possible to do
+portably, a top level environment supporting macros.
+@code{repl:top-level} uses @code{dynamic-wind} to catch error conditions
+and interrupts.  If your implementation supports this you are all set.
+
+Otherwise, if there is some way your implementation can catch error
+conditions and interrupts, then have them call @code{slib:error}.  It
+will display its arguments and reenter @code{repl:top-level}.
+@code{slib:error} dynamically bound by @code{repl:top-level}.@refill
+
+To have your top level loop always use macros, add any interrupt
+catching lines and the following lines to your Scheme init file:
+@lisp
+(require 'macro)
+(require 'repl)
+(repl:top-level macro:eval)
+@end lisp
+
+@node Quick Print, Debug, Repl, Session Support
+@section Quick Print
+
+@code{(require 'qp)}
+
+@noindent
+When displaying error messages and warnings, it is paramount that the
+output generated for circular lists and large data structures be
+limited.  This section supplies a procedure to do this.  It could be
+much improved.
+
+@quotation
+Notice that the neccessity for truncating output eliminates
+Common-Lisp's @xref{Format} from consideration; even when variables
+@code{*print-level*} and @code{*print-level*} are set, huge strings and
+bit-vectors are @emph{not} limited.
+@end quotation
+
+@deffn Procedure qp arg1 @dots{}
+@deffnx Procedure qpn arg1 @dots{}
+@deffnx Procedure qpr arg1 @dots{}
+@code{qp} writes its arguments, separated by spaces, to
+@code{(current-output-port)}.  @code{qp} compresses printing by
+substituting @samp{...} for substructure it does not have sufficient
+room to print.  @code{qpn} is like @code{qp} but outputs a newline
+before returning.  @code{qpr} is like @code{qpn} except that it returns
+its last argument.@refill
+@end deffn
+
+@defvar *qp-width*
+@code{*qp-width*} is the largest number of characters that @code{qp}
+should use.@refill
+@end defvar
+
+@node Debug, Breakpoints, Quick Print, Session Support
+@section Debug
+
+@code{(require 'debug)}
+
+@noindent
+Requiring @code{debug} automatically requires @code{trace} and
+@code{break}.
+
+@noindent
+An application with its own datatypes may want to substitute its own
+printer for @code{qp}.  This example shows how to do this:
+
+@example
+(define qpn (lambda args) @dots{})
+(provide 'qp)
+(require 'debug)
+@end example
+
+@deffn Procedure trace-all file
+Traces (@pxref{Trace}) all procedures @code{define}d at top-level in
+file @file{file}.
+@end deffn
+
+@deffn Procedure break-all file
+Breakpoints (@pxref{Breakpoints}) all procedures @code{define}d at
+top-level in file @file{file}.
+@end deffn
+
+@node Breakpoints, Trace, Debug, Session Support
+@section Breakpoints
+
+@code{(require 'break)}
+
+@defun init-debug
+If your Scheme implementation does not support @code{break} or
+@code{abort}, a message will appear when you @code{(require 'break)} or
+@code{(require 'debug)} telling you to type @code{(init-debug)}.  This
+is in order to establish a top-level continuation.  Typing
+@code{(init-debug)} at top level sets up a continuation for
+@code{break}.
+@end defun
+
+@defun breakpoint arg1 @dots{}
+Returns from the top level continuation and pushes the continuation from
+which it was called on a continuation stack.
+@end defun
+
+@defun continue
+Pops the topmost continuation off of the continuation stack and returns
+an unspecified value to it.
+@defunx continue arg1 @dots{}
+Pops the topmost continuation off of the continuation stack and returns
+@var{arg1} @dots{} to it.
+@end defun
+
+@defmac break proc1 @dots{}
+Redefines the top-level named procedures given as arguments so that
+@code{breakpoint} is called before calling @var{proc1} @dots{}.
+@defmacx break
+With no arguments, makes sure that all the currently broken identifiers
+are broken (even if those identifiers have been redefined) and returns a
+list of the broken identifiers.
+@end defmac
+
+@defmac unbreak proc1 @dots{}
+Turns breakpoints off for its arguments.
+@defmacx unbreak
+With no arguments, unbreaks all currently broken identifiers and returns
+a list of these formerly broken identifiers.
+@end defmac
+
+The following routines are the procedures which actually do the tracing
+when this module is supplied by SLIB, rather than natively.  If
+defmacros are not natively supported by your implementation, these might
+be more convenient to use.
+
+@defun breakf proc
+@defunx breakf proc name
+@defunx debug:breakf proc
+@defunx debug:breakf proc name
+To break, type
+@lisp
+(set! @var{symbol} (breakf @var{symbol}))
+@end lisp
+@noindent
+or
+@lisp
+(set! @var{symbol} (breakf @var{symbol} '@var{symbol}))
+@end lisp
+@noindent
+or
+@lisp
+(define @var{symbol} (breakf @var{function}))
+@end lisp
+@noindent
+or
+@lisp
+(define @var{symbol} (breakf @var{function} '@var{symbol}))
+@end lisp
+@end defun
+
+@defun unbreakf proc
+@defunx debug:unbreakf proc
+To unbreak, type
+@lisp
+(set! @var{symbol} (unbreakf @var{symbol}))
+@end lisp
+@end defun
+
+@node Trace, Getopt, Breakpoints, Session Support
+@section Tracing
+
+@code{(require 'trace)}
+
+@defmac trace proc1 @dots{}
+Traces the top-level named procedures given as arguments.
+@defmacx trace
+With no arguments, makes sure that all the currently traced identifiers
+are traced (even if those identifiers have been redefined) and returns a
+list of the traced identifiers.
+@end defmac
+
+@defmac untrace proc1 @dots{}
+Turns tracing off for its arguments.
+@defmacx untrace
+With no arguments, untraces all currently traced identifiers and returns
+a list of these formerly traced identifiers.
+@end defmac
+
+The following routines are the procedures which actually do the tracing
+when this module is supplied by SLIB, rather than natively.  If
+defmacros are not natively supported by your implementation, these might
+be more convenient to use.
+
+@defun tracef proc
+@defunx tracef proc name
+@defunx debug:tracef proc
+@defunx debug:tracef proc name
+To trace, type
+@lisp
+(set! @var{symbol} (tracef @var{symbol}))
+@end lisp
+@noindent
+or
+@lisp
+(set! @var{symbol} (tracef @var{symbol} '@var{symbol}))
+@end lisp
+@noindent
+or
+@lisp
+(define @var{symbol} (tracef @var{function}))
+@end lisp
+@noindent
+or
+@lisp
+(define @var{symbol} (tracef @var{function} '@var{symbol}))
+@end lisp
+@end defun
+
+@defun untracef proc
+@defunx debug:untracef proc
+To untrace, type
+@lisp
+(set! @var{symbol} (untracef @var{symbol}))
+@end lisp
+@end defun
+
+
+@node Getopt, Command Line, Trace, Session Support
+@section Getopt
+
+@code{(require 'getopt)}
+
+This routine implements Posix command line argument parsing.  Notice
+that returning values through global variables means that @code{getopt}
+is @emph{not} reentrant.
+
+@defvar *optind*
+Is the index of the current element of the command line.  It is
+initially one.  In order to parse a new command line or reparse an old
+one, @var{*opting*} must be reset.
+@end defvar
+
+@defvar *optarg*
+Is set by getopt to the (string) option-argument of the current option.
+@end defvar
+
+@deffn Procedure getopt argc argv optstring
+Returns the next option letter in @var{argv} (starting from
+@code{(vector-ref argv *optind*)}) that matches a letter in
+@var{optstring}.  @var{argv} is a vector or list of strings, the 0th of
+which getopt usually ignores. @var{argc} is the argument count, usually
+the length of @var{argv}.  @var{optstring} is a string of recognized
+option characters; if a character is followed by a colon, the option
+takes an argument which may be immediately following it in the string or
+in the next element of @var{argv}.
+
+@var{*optind*} is the index of the next element of the @var{argv} vector
+to be processed.  It is initialized to 1 by @file{getopt.scm}, and
+@code{getopt} updates it when it finishes with each element of
+@var{argv}.
+
+@code{getopt} returns the next option character from @var{argv} that
+matches a character in @var{optstring}, if there is one that matches.
+If the option takes an argument, @code{getopt} sets the variable
+@var{*optarg*} to the option-argument as follows:
+
+@itemize @bullet
+@item
+If the option was the last character in the string pointed to by an
+element of @var{argv}, then @var{*optarg*} contains the next element of
+@var{argv}, and @var{*optind*} is incremented by 2.  If the resulting
+value of @var{*optind*} is greater than or equal to @var{argc}, this
+indicates a missing option argument, and @code{getopt} returns an error
+indication.
+
+@item
+Otherwise, @var{*optarg*} is set to the string following the option
+character in that element of @var{argv}, and @var{*optind*} is
+incremented by 1.
+@end itemize
+
+If, when @code{getopt} is called, the string @code{(vector-ref argv
+*optind*)} either does not begin with the character @code{#\-} or is
+just @code{"-"}, @code{getopt} returns @code{#f} without changing
+@var{*optind*}.  If @code{(vector-ref argv *optind*)} is the string
+@code{"--"}, @code{getopt} returns @code{#f} after incrementing
+@var{*optind*}.
+
+If @code{getopt} encounters an option character that is not contained in
+@var{optstring}, it returns the question-mark @code{#\?} character.  If
+it detects a missing option argument, it returns the colon character
+@code{#\:} if the first character of @var{optstring} was a colon, or a
+question-mark character otherwise.  In either case, @code{getopt} sets
+the variable @var{getopt:opt} to the option character that caused the
+error.
+
+The special option @code{"--"} can be used to delimit the end of the
+options; @code{#f} is returned, and @code{"--"} is skipped.
+
+RETURN VALUE
+
+@code{getopt} returns the next option character specified on the command
+line.  A colon @code{#\:} is returned if @code{getopt} detects a missing argument
+and the first character of @var{optstring} was a colon @code{#\:}.
+
+A question-mark @code{#\?} is returned if @code{getopt} encounters an option
+character not in @var{optstring} or detects a missing argument and the first
+character of @var{optstring} was not a colon @code{#\:}.
+
+Otherwise, @code{getopt} returns @code{#f} when all command line options have been
+parsed.
+
+Example:
+@lisp
+#! /usr/local/bin/scm
+;;;This code is SCM specific.
+(define argv (program-arguments))
+(require 'getopt)
+
+(define opts ":a:b:cd")
+(let loop ((opt (getopt (length argv) argv opts)))
+  (case opt
+    ((#\a) (print "option a: " *optarg*))
+    ((#\b) (print "option b: " *optarg*))
+    ((#\c) (print "option c"))
+    ((#\d) (print "option d"))
+    ((#\?) (print "error" getopt:opt))
+    ((#\:) (print "missing arg" getopt:opt))
+    ((#f) (if (< *optind* (length argv))
+              (print "argv[" *optind* "]="
+                     (list-ref argv *optind*)))
+          (set! *optind* (+ *optind* 1))))
+  (if (< *optind* (length argv))
+      (loop (getopt (length argv) argv opts))))
+
+(slib:exit)
+@end lisp
+@end deffn
+
+@section Getopt--
+
+@defun getopt-- argc argv optstring
+The procedure @code{getopt--} is an extended version of @code{getopt}
+which parses @dfn{long option names} of the form
+@samp{--hold-the-onions} and @samp{--verbosity-level=extreme}.  
+@w{@code{Getopt--}} behaves as @code{getopt} except for non-empty
+options beginning with @samp{--}.
+
+Options beginning with @samp{--} are returned as strings rather than
+characters.  If a value is assigned (using @samp{=}) to a long option,
+@code{*optarg*} is set to the value.  The @samp{=} and value are
+not returned as part of the option string.
+
+No information is passed to @code{getopt--} concerning which long
+options should be accepted or whether such options can take arguments.
+If a long option did not have an argument, @code{*optarg} will be set to
+@code{#f}.  The caller is responsible for detecting and reporting
+errors.
+
+@example
+(define opts ":-:b:")
+(define argc 5)
+(define argv '("foo" "-b9" "--f1" "--2=" "--g3=35234.342" "--"))
+(define *optind* 1)
+(define *optarg* #f)
+(require 'qp)
+(do ((i 5 (+ -1 i)))
+    ((zero? i))
+  (define opt (getopt-- argc argv opts))
+  (print *optind* opt *optarg*)))
+@print{}
+2 #\b "9" 
+3 "f1" #f 
+4 "2" "" 
+5 "g3" "35234.342" 
+5 #f "35234.342" 
+@end example
+@end defun
+
+@node Command Line, System Interface, Getopt, Session Support
+@section Command Line
+
+@code{(require 'read-command)}
+
+@defun read-command port
+@defunx read-command
+@code{read-command} converts a @dfn{command line} into a list of strings
+suitable for parsing by @code{getopt}.  The syntax of command lines
+supported resembles that of popular @dfn{shell}s.  @code{read-command}
+updates @var{port} to point to the first character past the command
+delimiter.
+
+If an end of file is encountered in the input before any characters are
+found that can begin an object or comment, then an end of file object is
+returned.
+
+The @var{port} argument may be omitted, in which case it defaults to the
+value returned by @code{current-input-port}.
+
+The fields into which the command line is split are delimited by
+whitespace as defined by @code{char-whitespace?}.  The end of a command
+is delimited by end-of-file or unescaped semicolon (@key{;}) or
+@key{newline}.  Any character can be literally included in a field by
+escaping it with a backslach (@key{\}).
+
+The initial character and types of fields recognized are:
+@table @asis
+@item @samp{\}
+The next character has is taken literally and not interpreted as a field
+delimiter.  If @key{\} is the last character before a @key{newline},
+that @key{newline} is just ignored.  Processing continues from the
+characters after the @key{newline} as though the backslash and
+@key{newline} were not there.
+@item @samp{"}
+The characters up to the next unescaped @key{"} are taken literally,
+according to [R4RS] rules for literal strings (@pxref{Strings, , ,r4rs,
+Revised(4) Scheme}).
+@item @samp{(}, @samp{%'}
+One scheme expression is @code{read} starting with this character.  The
+@code{read} expression is evaluated, converted to a string
+(using @code{display}), and replaces the expression in the returned
+field.
+@item @samp{;}
+Semicolon delimits a command.  Using semicolons more than one command
+can appear on a line.  Escaped semicolons and semicolons inside strings
+do not delimit commands.
+@end table
+
+@noindent
+The comment field differs from the previous fields in that it must be
+the first character of a command or appear after whitespace in order to
+be recognized.  @key{#} can be part of fields if these conditions are
+not met.  For instance, @code{ab#c} is just the field ab#c.
+
+@table @samp
+@item #
+Introduces a comment.  The comment continues to the end of the line on
+which the semicolon appears.  Comments are treated as whitespace by
+@code{read-dommand-line} and backslashes before @key{newline}s in
+comments are also ignored.
+@end table
+@end defun
+
+@node System Interface, Require, Command Line, Session Support
+@section System Interface
+
+If @code{(provided? 'getenv)}:
+
+@defun getenv name
+Looks up @var{name}, a string, in the program environment.  If @var{name} is
+found a string of its value is returned.  Otherwise, @code{#f} is returned.
+@end defun
+
+If @code{(provided? 'system)}:
+
+@defun system command-string
+Executes the @var{command-string} on the computer and returns the
+integer status code.
+@end defun
+
+
+@node Require, Vicinity, System Interface, Session Support
+@section Require
+
+These variables and procedures are provided by all implementations.
+
+@defvar *features*
+Is a list of symbols denoting features supported in this implementation.
+@end defvar
+
+@defvar *modules*
+Is a list of pathnames denoting files which have been loaded.
+@end defvar
+
+@defvar *catalog*
+Is an association list of features (symbols) and pathnames which will
+supply those features.  The pathname can be either a string or a pair.
+If pathname is a pair then the first element should be a macro feature
+symbol, @code{source}, or @code{compiled}.  The cdr of the pathname
+should be either a string or a list.
+@end defvar
+
+In the following three functions if @var{feature} is not a symbol it is
+assumed to be a pathname.@refill
+
+@defun provided? feature
+Returns @code{#t} if @var{feature} is a member of @code{*features*} or
+@code{*modules*} or if @var{feature} is supported by a file already
+loaded and @code{#f} otherwise.@refill
+@end defun
+
+@deffn Procedure require feature
+If @code{(not (provided? @var{feature}))} it is loaded if @var{feature}
+is a pathname or if @code{(assq @var{feature} *catalog*)}.  Otherwise an
+error is signaled.@refill
+@end deffn
+
+@deffn Procedure provide feature
+Assures that @var{feature} is contained in @code{*features*} if
+@var{feature} is a symbol and @code{*modules*} otherwise.@refill
+@end deffn
+
+@defun require:feature->path feature
+Returns @code{#t} if @var{feature} is a member of @code{*features*} or
+@code{*modules*} or if @var{feature} is supported by a file already
+loaded.  Returns a path if one was found in @code{*catalog*} under the
+feature name, and @code{#f} otherwise.  The path can either be a string
+suitable as an argument to load or a pair as described above for
+*catalog*.
+@end defun
+
+Below is a list of features that are automatically determined by
+@code{require}.  For each item, @code{(provided? '@var{feature})} will
+return @code{#t} if that feature is available, and @code{#f} if
+not.@refill
+
+@itemize @bullet
+@item
+'inexact
+@item
+'rational
+@item
+'real
+@item
+'complex
+@item
+'bignum
+@end itemize
+
+
+
+
+
+@node Vicinity, Configuration, Require, Session Support
+@section Vicinity
+
+A vicinity is a descriptor for a place in the file system.  Vicinities
+hide from the programmer the concepts of host, volume, directory, and
+version.  Vicinities express only the concept of a file environment
+where a file name can be resolved to a file in a system independent
+manner.  Vicinities can even be used on @dfn{flat} file systems (which
+have no directory structure) by having the vicinity express constraints
+on the file name.  On most systems a vicinity would be a string.  All of
+these procedures are file system dependent.
+
+These procedures are provided by all implementations.
+
+@defun make-vicinity filename
+Returns the vicinity of @var{filename} for use by @code{in-vicinity}.
+@end defun
+
+@defun program-vicinity
+Returns the vicinity of the currently loading Scheme code.  For an
+interpreter this would be the directory containing source code.  For a
+compiled system (with multiple files) this would be the directory where
+the object or executable files are.  If no file is currently loading it
+the result is undefined.  @strong{Warning:} @code{program-vicinity} can
+return incorrectl values if your program escapes back into a
+@code{load}.@refill
+@end defun
+
+@defun library-vicinity
+Returns the vicinity of the shared Scheme library.
+@end defun
+
+@defun implementation-vicinity
+Returns the vicinity of the underlying Scheme implementation.  This
+vicinity will likely contain startup code and messages and a compiler.
+@end defun
+
+@defun user-vicinity
+Returns the vicinity of the current directory of the user.  On most
+systems this is @file{""} (the empty string).
+@end defun
+
+@c @defun scheme-file-suffix
+@c Returns the default filename suffix for scheme source files.  On most
+@c systems this is @samp{.scm}.@refill
+@c @end defun
+
+@defun in-vicinity vicinity filename
+Returns a filename suitable for use by @code{slib:load},
+@code{slib:load-source}, @code{slib:load-compiled},
+@code{open-input-file}, @code{open-output-file}, etc.  The returned
+filename is @var{filename} in @var{vicinity}.  @code{in-vicinity} should
+allow @var{filename} to override @var{vicinity} when @var{filename} is
+an absolute pathname and @var{vicinity} is equal to the value of
+@code{(user-vicinity)}.  The behavior of @code{in-vicinity} when
+@var{filename} is absolute and @var{vicinity} is not equal to the value
+of @code{(user-vicinity)} is unspecified.  For most systems
+@code{in-vicinity} can be @code{string-append}.@refill
+@end defun
+
+@defun sub-vicinity vicinity name
+Returns the vicinity of @var{vicinity} restricted to @var{name}.  This
+is used for large systems where names of files in subsystems could
+conflict.  On systems with directory structure @code{sub-vicinity} will
+return a pathname of the subdirectory @var{name} of
+@var{vicinity}.@refill
+@end defun
+
+
+
+@node Configuration, Input/Output, Vicinity, Session Support
+@section Configuration
+
+These constants and procedures describe characteristics of the Scheme
+and underlying operating system.  They are provided by all
+implementations.
+
+@defvr Constant char-code-limit
+An integer 1 larger that the largest value which can be returned by
+@code{char->integer}.@refill
+@end defvr
+
+@defvr Constant most-positive-fixnum
+The immediate integer closest to positive infinity.
+@end defvr
+
+@defvr Constant slib:tab
+The tab character.
+@end defvr
+
+@defvr Constant slib:form-feed
+The form-feed character.
+@end defvr
+
+@defun software-type
+Returns a symbol denoting the generic operating system type.  For
+instance, @code{unix}, @code{vms}, @code{macos}, @code{amiga}, or
+@code{ms-dos}.
+@end defun
+
+@defun slib:report-version
+Displays the versions of SLIB and the underlying Scheme implementation
+and the name of the operating system.  An unspecified value is returned.
+
+@example
+(slib:report-version) @result{} slib "2a3" on scm "4e1" on unix 
+@end example
+@end defun
+
+@defun slib:report
+Displays the information of @code{(slib:report-version)} followed by
+almost all the information neccessary for submitting a problem report.
+An unspecified value is returned.
+
+@defunx slib:report #t
+provides a more verbose listing.
+
+@defunx slib:report filename
+Writes the report to file @file{filename}.
+
+@example
+(slib:report)
+@result{}
+slib "2a3" on scm "4e1" on unix 
+(implementation-vicinity) is "/usr/local/src/scm/" 
+(library-vicinity) is "/usr/local/lib/slib/" 
+(scheme-file-suffix) is ".scm" 
+implementation *features* : 
+        bignum complex real rational
+        inexact vicinity ed getenv
+        tmpnam system abort transcript
+        with-file ieee-p1178 rev4-report rev4-optional-procedures
+        hash object-hash delay eval
+        dynamic-wind multiarg-apply multiarg/and- logical
+        defmacro string-port source array-for-each
+        array full-continuation char-ready? line-i/o
+        i/o-extensions pipe
+implementation *catalog* : 
+        (rev4-optional-procedures . "/usr/local/lib/slib/sc4opt")
+        ... 
+@end example
+@end defun
+
+@node Input/Output, Legacy, Configuration, Session Support
+@section Input/Output
+
+These procedures are provided by all implementations.
+
+@deffn Procedure file-exists? filename
+Returns @code{#t} if the specified file exists.  Otherwise, returns
+@code{#f}.  If the underlying implementation does not support this
+feature then @code{#f} is always returned.
+@end deffn
+
+@deffn Procedure delete-file filename
+Deletes the file specified by @var{filename}.  If @var{filename} can not
+be deleted, @code{#f} is returned.  Otherwise, @code{#t} is
+returned.@refill
+@end deffn
+
+@deffn Procedure tmpnam
+Returns a pathname for a file which will likely not be used by any other
+process.  Successive calls to @code{(tmpnam)} will return different
+pathnames.@refill
+@end deffn
+
+@deffn Procedure current-error-port
+Returns the current port to which diagnostic and error output is
+directed.
+@end deffn
+
+@deffn Procedure force-output
+@deffnx Procedure force-output port
+Forces any pending output on @var{port} to be delivered to the output
+device and returns an unspecified value.  The @var{port} argument may be
+omitted, in which case it defaults to the value returned by
+@code{(current-output-port)}.@refill
+@end deffn
+
+@deffn Procedure output-port-width
+@deffnx Procedure output-port-width port
+
+Returns the width of @var{port}, which defaults to
+@code{(current-output-port)} if absent.  If the width cannot be
+determined 79 is returned.@refill
+@end deffn
+
+@deffn Procedure output-port-height
+@deffnx Procedure output-port-height port
+
+Returns the height of @var{port}, which defaults to
+@code{(current-output-port)} if absent.  If the height cannot be
+determined 24 is returned.@refill
+@end deffn
+
+@node Legacy, System, Input/Output, Session Support
+@section Legacy
+
+@defun identity x
+@var{identity} returns its argument.
+
+Example:
+@lisp
+(identity 3)
+   @result{} 3
+(identity '(foo bar))
+   @result{} (foo bar)
+(map identity @var{lst})
+   @equiv{} (copy-list @var{lst})
+@end lisp
+@end defun
+
+These were present in Scheme until R4RS (@pxref{Notes, , Language
+changes ,r4rs, Revised(4) Scheme}).
+
+@defvr Constant t
+Derfined as @code{#t}.
+@end defvr
+
+@defvr Constant nil
+Defined as @code{#f}.
+@end defvr
+
+@defun last-pair l
+Returns the last pair in the list @var{l}.  Example:
+@lisp
+(last-pair (cons 1 2))
+   @result{} (1 . 2)
+(last-pair '(1 2))
+   @result{} (2)
+    @equiv{} (cons 2 '())
+@end lisp
+@end defun
+
+@node  System,  , Legacy, Session Support
+@section System
+
+These procedures are provided by all implementations.
+
+@deffn Procedure slib:load-source name
+Loads a file of Scheme source code from @var{name} with the default
+filename extension used in SLIB.  For instance if the filename extension
+used in SLIB is @file{.scm} then @code{(slib:load-source "foo")} will
+load from file @file{foo.scm}.
+@end deffn
+
+@deffn Procedure slib:load-compiled name
+On implementations which support separtely loadable compiled modules,
+loads a file of compiled code from @var{name} with the implementation's
+filename extension for compiled code appended.
+@end deffn
+
+@deffn Procedure slib:load name
+Loads a file of Scheme source or compiled code from @var{name} with the
+appropriate suffixes appended.  If both source and compiled code are
+present with the appropriate names then the implementation will load
+just one.  It is up to the implementation to choose which one will be
+loaded.
+
+If an implementation does not support compiled code then
+@code{slib:load} will be identical to @code{slib:load-source}.
+@end deffn
+
+@deffn Procedure slib:eval obj
+@code{eval} returns the value of @var{obj} evaluated in the current top
+level environment.@refill
+@end deffn
+
+@deffn Procedure slib:eval-load filename eval
+@var{filename} should be a string.  If filename names an existing file,
+the Scheme source code expressions and definitions are read from the
+file and @var{eval} called with them sequentially.  The
+@code{slib:eval-load} procedure does not affect the values returned by
+@code{current-input-port} and @code{current-output-port}.@refill
+@end deffn
+
+@deffn Procedure slib:error arg1 arg2 @dots{}
+Outputs an error message containing the arguments, aborts evaluation of
+the current form and responds in a system dependent way to the error.
+Typical responses are to abort the program or to enter a read-eval-print
+loop.@refill
+@end deffn
+
+@deffn Procedure slib:exit n
+@deffnx Procedure slib:exit
+Exits from the Scheme session returning status @var{n} to the system.
+If @var{n} is omitted or @code{#t}, a success status is returned to the
+system (if possible).  If @var{n} is @code{#f} a failure is returned to
+the system (if possible).  If @var{n} is an integer, then @var{n} is
+returned to the system (if possible).  If the Scheme session cannot exit
+an unspecified value is returned from @code{slib:exit}.
+@end deffn
+
+
+@node Optional SLIB Packages, Procedure and Macro Index, Session Support, Top
+@chapter Optional SLIB Packages
+
+Several Scheme packages have been written using SLIB.  There are several
+reasons why a package might not be included in the SLIB distribution:
+@itemize @bullet
+@item
+Because it requires special hardware or software which is not universal.
+@item
+Because it is large and of limited interest to most Scheme users.
+@item
+Because it has copying terms different enough from the other SLIB
+packages that its inclusion would cause confusion.
+@item
+Because it is an application program, rather than a library module.
+@item
+Because I have been too busy to integrate it.
+@end itemize
+
+Once an optional package is installed (and an entry added to
+@code{*catalog*}, the @code{require} mechanism allows it to be called up
+and used as easily as any other SLIB package.  Some optional packages
+(for which @code{*catalog*} already has entries) available from SLIB
+sites are:
+
+@table @asis
+@item SLIB-PSD is a portable debugger for Scheme (requires emacs editor).
+@lisp
+ftp-swiss.ai.mit.edu:pub/scm/slib-psd1-3.tar.gz
+prep.ai.mit.edu:pub/gnu/jacal/slib-psd1-3.tar.gz
+ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz
+ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-psd1-3.tar.gz
+@end lisp
+
+With PSD, you can run a Scheme program in an Emacs buffer, set
+breakpoints, single step evaluation and access and modify the program's
+variables. It works by instrumenting the original source code, so it
+should run with any R4RS compliant Scheme. It has been tested with SCM,
+Elk 1.5, and the sci interpreter in the Scheme->C system, but should
+work with other Schemes with a minimal amount of porting, if at
+all. Includes documentation and user's manual.  Written by Pertti
+Kellom\"aki, pk@@cs.tut.fi.  The Lisp Pointers article describing PSD
+(Lisp Pointers VI(1):15-23, January-March 1993) is available as
+@lisp
+http://www.cs.tut.fi/staff/pk/scheme/psd/article/article.html
+@end lisp
+@item SLIB-SCHELOG is an embedding of Prolog in Scheme.
+@lisp
+ftp-swiss.ai.mit.edu:pub/scm/slib-schelog.tar.gz
+prep.ai.mit.edu:pub/gnu/jacal/slib-schelog.tar.gz
+ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-schelog.tar.gz
+ftp.cs.indiana.edu:/pub/scheme-repository/utl/slib-schelog.tar.gz
+@end lisp
+@end table
+
+@node Procedure and Macro Index, Variable Index, Optional SLIB Packages, Top
+@unnumbered Procedure and Macro Index
+
+This is an alphabetical list of all the procedures and macros in SLIB.
+
+@printindex fn
+
+@node Variable Index,  , Procedure and Macro Index, Top
+@unnumbered Variable Index
+
+This is an alphabetical list of all the global variables in SLIB.
+
+@printindex vr
+
+@contents
+@bye
diff --git a/sort.scm b/sort.scm
new file mode 100644
index 0000000..ab9b938
--- /dev/null
+++ b/sort.scm
@@ -0,0 +1,154 @@
+;;; "sort.scm" Defines: sorted?, merge, merge!, sort, sort!
+;;; Author : Richard A. O'Keefe (based on Prolog code by D.H.D.Warren)
+;;;
+;;; This code is in the public domain.
+
+;;; Updated: 11 June 1991
+;;; Modified for scheme library: Aubrey Jaffer 19 Sept. 1991
+;;; Updated: 19 June 1995
+
+;;; (sorted? sequence less?)
+;;; is true when sequence is a list (x0 x1 ... xm) or a vector #(x0 ... xm)
+;;; such that for all 1 <= i <= m,
+;;;	(not (less? (list-ref list i) (list-ref list (- i 1)))).
+
+(define (sort:sorted? seq less?)
+    (cond
+	((null? seq)
+	    #t)
+	((vector? seq)
+	    (let ((n (vector-length seq)))
+		(if (<= n 1)
+		    #t
+		    (do ((i 1 (+ i 1)))
+			((or (= i n)
+			     (less? (vector-ref seq (- i 1))
+			     	    (vector-ref seq i)))
+			    (= i n)) )) ))
+	(else
+	    (let loop ((last (car seq)) (next (cdr seq)))
+		(or (null? next)
+		    (and (not (less? (car next) last))
+			 (loop (car next) (cdr next)) )) )) ))
+
+
+;;; (merge a b less?)
+;;; takes two lists a and b such that (sorted? a less?) and (sorted? b less?)
+;;; and returns a new list in which the elements of a and b have been stably
+;;; interleaved so that (sorted? (merge a b less?) less?).
+;;; Note:  this does _not_ accept vectors.  See below.
+
+(define (sort:merge a b less?)
+    (cond
+	((null? a) b)
+	((null? b) a)
+	(else (let loop ((x (car a)) (a (cdr a)) (y (car b)) (b (cdr b)))
+	    ;; The loop handles the merging of non-empty lists.  It has
+	    ;; been written this way to save testing and car/cdring.
+	    (if (less? y x)
+		(if (null? b)
+		    (cons y (cons x a))
+		    (cons y (loop x a (car b) (cdr b)) ))
+		;; x <= y
+		(if (null? a)
+		    (cons x (cons y b))
+		    (cons x (loop (car a) (cdr a) y b)) )) )) ))
+
+
+;;; (merge! a b less?)
+;;; takes two sorted lists a and b and smashes their cdr fields to form a
+;;; single sorted list including the elements of both.
+;;; Note:  this does _not_ accept vectors.
+
+(define (sort:merge! a b less?)
+    (define (loop r a b)
+	(if (less? (car b) (car a))
+	    (begin
+		(set-cdr! r b)
+		(if (null? (cdr b))
+		    (set-cdr! b a)
+		    (loop b a (cdr b)) ))
+	    ;; (car a) <= (car b)
+	    (begin
+		(set-cdr! r a)
+		(if (null? (cdr a))
+		    (set-cdr! a b)
+		    (loop a (cdr a) b)) )) )
+    (cond
+	((null? a) b)
+	((null? b) a)
+	((less? (car b) (car a))
+	    (if (null? (cdr b))
+		(set-cdr! b a)
+		(loop b a (cdr b)))
+	    b)
+	(else ; (car a) <= (car b)
+	    (if (null? (cdr a))
+		(set-cdr! a b)
+		(loop a (cdr a) b))
+	    a)))
+
+
+
+;;; (sort! sequence less?)
+;;; sorts the list or vector sequence destructively.  It uses a version
+;;; of merge-sort invented, to the best of my knowledge, by David H. D.
+;;; Warren, and first used in the DEC-10 Prolog system.  R. A. O'Keefe
+;;; adapted it to work destructively in Scheme.
+
+(define (sort:sort! seq less?)
+    (define (step n)
+	(cond
+	    ((> n 2)
+		(let* ((j (quotient n 2))
+		       (a (step j))
+		       (k (- n j))
+		       (b (step k)))
+		    (sort:merge! a b less?)))
+	    ((= n 2)
+		(let ((x (car seq))
+		      (y (cadr seq))
+		      (p seq))
+		    (set! seq (cddr seq))
+		    (if (less? y x) (begin
+			(set-car! p y)
+			(set-car! (cdr p) x)))
+		    (set-cdr! (cdr p) '())
+		    p))
+	    ((= n 1)
+		(let ((p seq))
+		    (set! seq (cdr seq))
+		    (set-cdr! p '())
+		    p))
+	    (else
+		'()) ))
+    (if (vector? seq)
+	(let ((n (vector-length seq))
+	      (vec seq))
+	  (set! seq (vector->list seq))
+	  (do ((p (step n) (cdr p))
+	       (i 0 (+ i 1)))
+	      ((null? p) vec)
+	    (vector-set! vec i (car p)) ))
+	;; otherwise, assume it is a list
+	(step (length seq)) ))
+
+;;; (sort sequence less?)
+;;; sorts a vector or list non-destructively.  It does this by sorting a
+;;; copy of the sequence.  My understanding is that the Standard says
+;;; that the result of append is always "newly allocated" except for
+;;; sharing structure with "the last argument", so (append x '()) ought
+;;; to be a standard way of copying a list x.
+
+(define (sort:sort seq less?)
+    (if (vector? seq)
+	(list->vector (sort:sort! (vector->list seq) less?))
+	(sort:sort! (append seq '()) less?)))
+
+;;; eof
+
+(define sorted? sort:sorted?)
+(define merge sort:merge)
+(define merge! sort:merge!)
+(define sort sort:sort)
+(define sort! sort:sort!)
diff --git a/soundex.scm b/soundex.scm
new file mode 100644
index 0000000..eb3a542
--- /dev/null
+++ b/soundex.scm
@@ -0,0 +1,82 @@
+;"soundex.scm" Original SOUNDEX algorithm.
+;From jjb@isye.gatech.edu Mon May  2 22:29:43 1994
+;
+; This code is in the public domain.
+
+;Date: Mon, 2 May 94 13:45:39 -0500
+
+; Taken from Knuth, Vol. 3 "Sorting and searching", pp 391--2
+
+(require 'common-list-functions)
+
+(define SOUNDEX
+  (let* ((letters-to-omit
+           (list #\A #\E #\H #\I #\O #\U #\W #\Y))
+         (codes
+          (list (list #\B #\1)
+                (list #\F #\1)
+                (list #\P #\1)
+                (list #\V #\1)
+                ;
+                (list #\C #\2)
+                (list #\G #\2)
+                (list #\J #\2)
+                (list #\K #\2)
+                (list #\Q #\2)
+                (list #\S #\2)
+                (list #\X #\2)
+                (list #\Z #\2)
+                ;
+                (list #\D #\3)
+                (list #\T #\3)
+                ;
+                (list #\L #\4)
+                ;
+                (list #\M #\5)
+                (list #\N #\5)
+                ;
+                (list #\R #\6)))
+         (xform
+          (lambda (c)
+            (let ((code (assq c codes)))
+              (if code
+                  (cadr code)
+                  c)))))
+    (lambda (name)
+      (let ((char-list
+             (map char-upcase
+                  (remove-if (lambda (c)
+                               (not (char-alphabetic? c)))
+                             (string->list name)))))
+        (if (null? char-list)
+            name
+            (let* (; Replace letters except first with codes:
+                   (n1 (cons (car char-list) (map xform char-list)))
+                   ; If 2 or more letter with same code are adjacent
+                   ; in the original name, omit all but the first:
+                   (n2 (let loop ((chars n1))
+                         (cond ((null? (cdr chars))
+                                chars)
+                               (else
+                                (if (char=? (xform (car chars))
+                                            (cadr chars))
+                                    (loop (cdr chars))
+                                    (cons (car chars) (loop (cdr chars))))))))
+                   ; Omit vowels and similar letters, except first:
+                   (n3 (cons (car char-list)
+                             (remove-if
+                              (lambda (c)
+                                (memq c letters-to-omit))
+                              (cdr n2)))))
+              ;
+              ; pad with 0's or drop rightmost digits until of form "annn":
+              (let loop ((rev-chars (reverse n3)))
+                (let ((len (length rev-chars)))
+                  (cond ((= 4 len)
+                         (list->string (reverse rev-chars)))
+                        ((> 4 len)
+                         (loop (cons #\0 rev-chars)))
+                        ((< 4 len)
+                         (loop (cdr rev-chars))))))))))))
+
+
diff --git a/stdio.scm b/stdio.scm
new file mode 100644
index 0000000..bc4e914
--- /dev/null
+++ b/stdio.scm
@@ -0,0 +1,7 @@
+
+(require 'scanf)
+(require 'printf)
+
+(define stdin (current-input-port))
+(define stdout (current-output-port))
+(define stderr (current-error-port))
diff --git a/strcase.scm b/strcase.scm
new file mode 100644
index 0000000..f223527
--- /dev/null
+++ b/strcase.scm
@@ -0,0 +1,45 @@
+;;; "strcase.scm" String casing functions.
+; Written 1992 by Dirk Lutzebaeck (lutzeb@cs.tu-berlin.de)
+;
+; This code is in the public domain.
+
+; Modified by Aubrey Jaffer Nov 1992.
+; Authors of the original version were Ken Dickey and Aubrey Jaffer.
+
+;string-upcase, string-downcase, string-capitalize
+; are obvious string conversion procedures and are non destructive.
+;string-upcase!, string-downcase!, string-capitalize!
+; are destructive versions.
+
+(define (string-upcase! str)
+  (do ((i (- (string-length str) 1) (- i 1)))
+      ((< i 0) str)
+    (string-set! str i (char-upcase (string-ref str i)))))
+
+(define (string-upcase str)
+  (string-upcase! (string-copy str)))
+  
+(define (string-downcase! str)
+  (do ((i (- (string-length str) 1) (- i 1)))
+      ((< i 0) str)
+    (string-set! str i (char-downcase (string-ref str i)))))
+
+(define (string-downcase str)
+  (string-downcase! (string-copy str)))
+
+(define (string-capitalize! str)	; "hello" -> "Hello"
+  (let ((non-first-alpha #f)		; "hELLO" -> "Hello"
+	(str-len (string-length str)))	; "*hello" -> "*Hello"
+    (do ((i 0 (+ i 1)))			; "hello you" -> "Hello You"
+	((= i str-len) str)
+      (let ((c (string-ref str i)))
+	(if (char-alphabetic? c)
+	    (if non-first-alpha
+		(string-set! str i (char-downcase c))
+		(begin
+		  (set! non-first-alpha #t)
+		  (string-set! str i (char-upcase c))))
+	    (set! non-first-alpha #f))))))
+
+(define (string-capitalize str)
+  (string-capitalize! (string-copy str)))
diff --git a/strport.scm b/strport.scm
new file mode 100644
index 0000000..54d8d39
--- /dev/null
+++ b/strport.scm
@@ -0,0 +1,51 @@
+;;;;"strport.scm" Portable string ports for Scheme
+;;;Copyright 1993 Dorai Sitaram and Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;N.B.: This implementation assumes you have tmpnam and
+;delete-file defined in your .init file.  tmpnam generates
+;temp file names.  delete-file may be defined to be a dummy
+;procedure that does nothing.
+
+(define (call-with-output-string f)
+  (let ((tmpf (tmpnam)))
+    (call-with-output-file tmpf f)
+    (let ((s "") (buf (make-string 512)))
+      (call-with-input-file tmpf
+	(lambda (inp)
+	  (let loop ((i 0))
+	    (let ((c (read-char inp)))
+	      (cond ((eof-object? c)
+		     (set! s (string-append s (substring buf 0 i))))
+		    ((>= i 512)
+		     (set! s (string-append s buf))
+		     (loop 0))
+		    (else
+		     (string-set! buf i c)
+		     (loop (+ i 1))))))))
+      (delete-file tmpf)
+      s)))
+
+(define (call-with-input-string s f)
+  (let ((tmpf (tmpnam)))
+    (call-with-output-file tmpf
+      (lambda (outp)
+	(display s outp)))
+    (let ((x (call-with-input-file tmpf f)))
+      (delete-file tmpf)
+      x)))
diff --git a/strsrch.scm b/strsrch.scm
new file mode 100644
index 0000000..a08510e
--- /dev/null
+++ b/strsrch.scm
@@ -0,0 +1,95 @@
+;;; "MISCIO" Search for string from port.
+; Written 1995, 1996 by Oleg Kiselyov (oleg@ponder.csci.unt.edu)
+; Modified 1996 by A. Jaffer (jaffer@ai.mit.edu)
+;
+; This code is in the public domain.
+
+;;; Return the index of the first occurence of a-char in str, or #f
+(define (string-index str a-char)
+  (let loop ((pos 0))
+    (cond
+     ;; whole string has been searched, in vain
+     ((>= pos (string-length str)) #f)
+     ((char=? a-char (string-ref str pos)) pos)
+     (else (loop (+ 1 pos))))))
+
+(define (substring? pattern str)
+  (let* ((pat-len (string-length pattern))
+	 (search-span (- (string-length str) pat-len))
+	 (c1 (if (zero? pat-len) #f (string-ref pattern 0)))
+	 (c2 (if (<= pat-len 1) #f (string-ref pattern 1))))
+    (cond
+     ((not c1) 0)			; empty pattern, matches upfront
+     ((not c2) (string-index str c1))	; one-char pattern
+     (else				; matching pattern of > two chars
+      (let outer ((pos 0))
+	(cond
+	 ((> pos search-span) #f)	; nothing was found thru the whole str
+	 ((not (char=? c1 (string-ref str pos)))
+	  (outer (+ 1 pos)))		; keep looking for the right beginning
+	 ((not (char=? c2 (string-ref str (+ 1 pos))))
+	  (outer (+ 1 pos)))		; could've done pos+2 if c1 == c2....
+	 (else				; two char matched: high probability
+					; the rest will match too
+	  (let inner ((i-pat 2) (i-str (+ 2 pos)))
+	    (if (>= i-pat pat-len) pos	; the whole pattern matched
+		(if (char=? (string-ref pattern i-pat)
+			    (string-ref str i-str))
+		    (inner (+ 1 i-pat) (+ 1 i-str))
+		    ;; mismatch after partial match
+		    (outer (+ 1 pos))))))))))))
+
+(define (find-string-from-port? str <input-port> . max-no-char)
+  (set! max-no-char (if (null? max-no-char) #f (car max-no-char)))
+  (letrec
+      ((no-chars-read 0)
+       (my-peek-char			; Return a peeked char or #f
+	(lambda () (and (or (not max-no-char) (< no-chars-read max-no-char))
+			(let ((c (peek-char <input-port>)))
+			  (if (eof-object? c) #f c)))))
+       (next-char (lambda () (read-char <input-port>)
+			  (set! no-chars-read  (+ 1 no-chars-read))))
+       (match-1st-char			; of the string str
+	(lambda ()
+	  (let ((c (my-peek-char)))
+	    (if (not c) #f
+		(begin (next-char)
+		       (if (char=? c (string-ref str 0))
+			   (match-other-chars 1)
+			   (match-1st-char)))))))
+       ;; There has been a partial match, up to the point pos-to-match
+       ;; (for example, str[0] has been found in the stream)
+       ;; Now look to see if str[pos-to-match] for would be found, too
+       (match-other-chars
+	(lambda (pos-to-match)
+	  (if (>= pos-to-match (string-length str))
+	      no-chars-read		; the entire string has matched
+	      (let ((c (my-peek-char)))
+		(and c
+		     (if (not (char=? c (string-ref str pos-to-match)))
+			 (backtrack 1 pos-to-match)
+			 (begin (next-char)
+				(match-other-chars (+ 1 pos-to-match)))))))))
+
+       ;; There had been a partial match, but then a wrong char showed up.
+       ;; Before discarding previously read (and matched) characters, we check
+       ;; to see if there was some smaller partial match. Note, characters read
+       ;; so far (which matter) are those of str[0..matched-substr-len - 1]
+       ;; In other words, we will check to see if there is such i>0 that
+       ;; substr(str,0,j) = substr(str,i,matched-substr-len)
+       ;; where j=matched-substr-len - i
+       (backtrack
+	(lambda (i matched-substr-len)
+	  (let ((j (- matched-substr-len i)))
+	    (if (<= j 0)
+		;; backed off completely to the begining of str
+		(match-1st-char)
+		(let loop ((k 0))
+		  (if (>= k j)
+		      (match-other-chars j) ; there was indeed a shorter match
+		      (if (char=? (string-ref str k)
+				  (string-ref str (+ i k)))
+			  (loop (+ 1 k))
+			  (backtrack (+ 1 i) matched-substr-len))))))))
+       )
+    (match-1st-char)))
diff --git a/struct.scm b/struct.scm
new file mode 100644
index 0000000..8c5c423
--- /dev/null
+++ b/struct.scm
@@ -0,0 +1,165 @@
+;;; "struct.scm": defmacros for RECORDS
+;;; Copyright 1992 Jeff Alexander, Shinnder Lee, and Lewis Patterson
+
+;;; Defmacros which implement RECORDS from the book:
+;;; "Essentials of Programming Languages" by Daniel P. Friedman,
+;;;   M. Wand and C.T. Haynes.
+
+;;; jaffer@ai.mit.edu, Feb 1993 ported to SLIB.
+
+;;;  Date: Sun, 20 Aug 1995 19:20:35 -0500
+;;;  From: Gary Leavens <leavens@cs.iastate.edu>
+;;; I thought you might want to know that, for using the file
+;;; struct.scm with the EOPL book, one has to make 2 corrections.  To
+;;; correct it, there are two places where "-" has to be replaced by
+;;; "->" as in the code below.
+
+(require 'common-list-functions)
+
+(defmacro define-record args
+  (check-define-record-syntax args
+    (lambda (name make-name name? field-accessors field-setters)
+      (letrec
+	((make-fields
+	   (lambda (field-accessors i)
+	     (if (null? field-accessors)
+	       '()
+	       (cons
+		 `(define ,(car field-accessors)
+		    (lambda (obj)
+		      (if (,name? obj)
+			(vector-ref obj ,i)
+			(slib:error ',(car field-accessors)
+			  ": bad record" obj))))
+		 (make-fields (cdr field-accessors) (+ i 1))))))
+	 (make-setters
+	  (lambda (field-accessors i)
+	    (if (null? field-accessors)
+		'()
+		(cons
+		 `(define ,(car field-accessors)
+		    (lambda (obj val)
+		      (if (,name? obj)
+			  (vector-set! obj ,i val)
+			  (slib:error ',(car field-accessors)
+				      ": bad record" obj))))
+		 (make-setters (cdr field-accessors) (+ i 1)))))))
+	 `(begin
+	   ,@(make-fields field-accessors 1)
+	   ,@(make-setters field-setters 1)
+	   (define ,name?
+	     (lambda (obj)
+	       (and (vector? obj)
+		 (= (vector-length obj) ,(+ 1 (length field-accessors)))
+		 (eq? (vector-ref obj 0) ',name))))
+	   (define ,make-name
+	     (lambda ,field-accessors
+	       (vector ',name ,@field-accessors))))))))
+
+(defmacro variant-case args
+  (check-variant-case-syntax args
+    (lambda (exp clauses)
+      (let ((var (gentemp)))
+	(let
+	  ((make-clause
+	     (lambda (clause)
+	       (if (eq? (car clause) 'else)
+		 `(#t ,@(cdr clause))
+		 `((,(car clause) ,var)
+		   (let ,(map (lambda (field)
+				`(,(car field) (,(cdr field) ,var)))
+			   (cadr clause))
+		     ,@(cddr clause)))))))
+	  `(let ((,var ,exp))
+	     (cond ,@(map make-clause clauses))))))))
+
+;;; syntax checkers
+
+;;; name make-name name? field-accessors
+
+(define check-define-record-syntax
+  (lambda (x k)
+      (cond
+	((and (list? x)
+	   (= (length x) 2)
+	   (symbol? (car x))
+	   (list? (cadr x))
+	   (comlist:every symbol? (cadr x))
+	   (not (struct:duplicate-fields? (cadr x))))
+	 (let ((name (symbol->string (car x))))
+	   (let ((make-name (string->symbol
+			      (string-append (symbol->string 'make-) name)))
+		 (name? (string->symbol (string-append name "?")))
+		 (field-accessors
+		   (map
+		     (lambda (field)
+		       (string->symbol
+			 (string-append name "->" (symbol->string field))))
+		     (cadr x)))
+		 (field-setters
+		  (map
+		   (lambda (field)
+		     (string->symbol
+		      (string-append 
+		       "set-" name "-" (symbol->string field) "!")))
+		   (cadr x))))
+	     (k (car x) make-name name? field-accessors field-setters))))
+	(else (slib:error "define-record: invalid syntax" x)))))
+       
+(define check-variant-case-syntax
+  (let
+    ((make-clause
+       (lambda (clause)
+	 (if (eq? (car clause) 'else) 
+	   clause
+	   (let ((name (symbol->string (car clause))))
+	     (let ((name? (string->symbol (string-append name "?")))
+		   (fields
+		     (map
+		       (lambda (field)
+			 (cons field
+			   (string->symbol
+			     (string-append name "->"
+			       (symbol->string field)))))
+		       (cadr clause))))
+	       (cons name? (cons fields (cddr clause)))))))))
+    (lambda (args k)
+      (if (and (list? args)
+	    (<= 2 (length args))
+	    (struct:clauses? (cdr args)))
+	(k (car args) (map make-clause (cdr args)))
+	(slib:error "variant-case: invalid syntax" args)))))
+
+(define struct:duplicate-fields?
+  (lambda (fields)
+    (cond
+      ((null? fields) #f)
+      ((memq (car fields) (cdr fields)) #t)
+      (else (struct:duplicate-fields? (cdr fields))))))
+
+(define struct:clauses?
+  (let
+    ((clause?
+       (lambda (clause)
+	 (and (list? clause)
+	      (not (null? clause))
+	      (cond
+		((eq? (car clause) 'else)
+		 (not (null? (cdr clause))))
+		(else (and (symbol? (car clause))
+			   (not (null? (cdr clause)))
+			   (list? (cadr clause))
+			   (comlist:every symbol? (cadr clause))
+			   (not (struct:duplicate-fields? (cadr clause)))
+			   (not (null? (cddr clause))))))))))
+    (letrec
+      ((struct:duplicate-tags?
+	 (lambda (tags)
+	   (cond
+	     ((null? tags) #f)
+	     ((eq? (car tags) 'else) (not (null? (cdr tags))))
+	     ((memq (car tags) (cdr tags)) #t)
+	     (else (struct:duplicate-tags? (cdr tags)))))))
+      (lambda (clauses)
+	(and (comlist:every clause? clauses)
+	     (not (struct:duplicate-tags? (map car clauses))))))))
diff --git a/structst.scm b/structst.scm
new file mode 100644
index 0000000..ea298e0
--- /dev/null
+++ b/structst.scm
@@ -0,0 +1,37 @@
+;"structst.scm" test "struct.scm"
+;Copyright (C) 1993 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'struct)
+
+(define-record foo (a b c))
+(define-record goo (xx yy))
+
+(define a-foo (make-foo 1 2 3))
+(define a-goo (make-goo 4 5))
+
+(define (struct:test)
+  (define (t1 x)
+    (variant-case x
+      (foo (a b c) (list a b c))
+      (goo (xx yy) (list xx yy))
+      (else (list 7 8))))
+  (write (append (t1 a-foo) (t1 a-goo) (t1 9)))
+  (newline))
+
+(struct:test)
diff --git a/structure.scm b/structure.scm
new file mode 100644
index 0000000..0d379b9
--- /dev/null
+++ b/structure.scm
@@ -0,0 +1,80 @@
+;;; "structure.scm" syntax-case structure macros
+;;; Copyright (C) 1992 R. Kent Dybvig
+;;;
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full.  This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; Written by Robert Hieb & Kent Dybvig
+
+;;; This file was munged by a simple minded sed script since it left
+;;; its original authors' hands.  See syncase.sh for the horrid details.
+
+;;; structure.ss
+;;; Robert Hieb & Kent Dybvig
+;;; 92/06/18
+
+(define-syntax define-structure
+  (lambda (x)
+     (define construct-name
+	(lambda (template-identifier . args)
+	   (implicit-identifier
+	      template-identifier
+	      (string->symbol
+		 (apply string-append
+			(map (lambda (x)
+				(if (string? x)
+				    x
+				    (symbol->string (syntax-object->datum x))))
+			     args))))))
+     (syntax-case x ()
+	((_ (name id1 ...))
+	 (syntax (define-structure (name id1 ...) ())))
+	((_ (name id1 ...) ((id2 init) ...))
+	 (with-syntax
+	    ((constructor (construct-name (syntax name) "make-" (syntax name)))
+	     (predicate (construct-name (syntax name) (syntax name) "?"))
+	     ((access ...)
+	      (map (lambda (x) (construct-name x (syntax name) "-" x))
+		   (syntax (id1 ... id2 ...))))
+	     ((assign ...)
+	      (map (lambda (x)
+		      (construct-name x "set-" (syntax name) "-" x "!"))
+		   (syntax (id1 ... id2 ...))))
+	     (structure-length
+	      (+ (length (syntax (id1 ... id2 ...))) 1))
+	     ((index ...)
+	      (let f ((i 1) (ids (syntax (id1 ... id2 ...))))
+		 (if (null? ids)
+		     '()
+		     (cons i (f (+ i 1) (cdr ids)))))))
+	    (syntax (begin
+		       (define constructor
+			  (lambda (id1 ...)
+			     (let* ((id2 init) ...)
+				(vector 'name id1 ... id2 ...))))
+		       (define predicate
+			  (lambda (x)
+			     (and (vector? x)
+				  (= (vector-length x) structure-length)
+				  (eq? (vector-ref x 0) 'name))))
+		       (define access
+			  (lambda (x)
+			     (vector-ref x index)))
+		       ...
+		       ;; define macro accessors this way:
+		       ;; (define-syntax access
+		       ;;       (syntax-case x ()
+		       ;;          ((_ x)
+		       ;;           (syntax (vector-ref x index)))))
+		       ;; ...
+		       (define assign
+			  (lambda (x update)
+			     (vector-set! x index update)))
+		       ...)))))))
diff --git a/syncase.sh b/syncase.sh
new file mode 100644
index 0000000..4ae4db4
--- /dev/null
+++ b/syncase.sh
@@ -0,0 +1,146 @@
+#! /bin/sh -e
+
+echo Cleaning up old version and unpacking original ...
+rm -fr syntax-case
+gzip --decompress --stdout syntax-case.tar.z | tar xf -
+
+cd syntax-case
+
+echo Removing some files ...
+rm *.ps loadpp.ss hooks*
+
+# Remove enormous amount (about 200k) of white space in expand.pp
+echo Slimming expand.pp ...
+sed -e '/^ */s///' expand.pp > tt; mv tt expand.pp
+
+echo Patching ...
+patch -s -b .ORIG << 'PATCH'
+--- ./expand.pp.ORIG	Wed Mar 24 19:54:52 1993
++++ ./expand.pp	Wed Mar 24 19:54:52 1993
+@@ -337,9 +337,10 @@
+ '()
+ (lambda (e maps) (regen e)))))
+ (ellipsis? (lambda (x)
+-(if (if (top-level-bound? 'dp) dp #f)
+-(break)
+-(void))
++;; I dont know what this is supposed to do, and removing it seemed harmless.
++;; (if (if (top-level-bound? 'dp) dp #f)
++;; (break)
++;; (void))
+ (if (identifier? x)
+ (free-id=? x '...)
+ #f)))
+@@ -1674,7 +1675,7 @@
+ (set! generate-temporaries
+ (lambda (ls)
+ (arg-check list? ls 'generate-temporaries)
+-(map (lambda (x) (wrap (gensym) top-wrap)) ls)))
++(map (lambda (x) (wrap (new-symbol-hook "g") top-wrap)) ls)))
+ (set! free-identifier=?
+ (lambda (x y)
+ (arg-check id? x 'free-identifier=?)
+--- ./expand.ss.ORIG	Thu Jul  2 13:56:19 1992
++++ ./expand.ss	Wed Mar 24 19:54:53 1993
+@@ -564,7 +564,8 @@
+ 
+ (define ellipsis?
+    (lambda (x)
+-      (when (and (top-level-bound? 'dp) dp) (break))
++      ;; I dont know what this is supposed to do, and removing it seemed harmless.
++      ;; (when (and (top-level-bound? 'dp) dp) (break))
+       (and (identifier? x)
+            (free-id=? x (syntax (... ...))))))
+ 
+@@ -887,7 +888,7 @@
+    ;; gensym
+    (lambda (ls)
+       (arg-check list? ls 'generate-temporaries)
+-      (map (lambda (x) (wrap (gensym) top-wrap)) ls)))
++      (map (lambda (x) (wrap (new-symbol-hook "g") top-wrap)) ls)))
+ 
+ (set! free-identifier=?
+    (lambda (x y)
+--- ./macro-defs.ss.ORIG	Thu Jul  2 12:28:49 1992
++++ ./macro-defs.ss	Wed Mar 24 19:55:31 1993
+@@ -161,26 +161,3 @@
+        (syntax-case x ()
+           ((- e) (gen (syntax e) 0))))))
+ 
+-;;; simple delay and force; also defines make-promise
+-
+-(define-syntax delay
+-   (lambda (x)
+-      (syntax-case x ()
+-         ((delay exp)
+-          (syntax (make-promise (lambda () exp)))))))
+-
+-(define make-promise
+-   (lambda (thunk)
+-      (let ([value (void)] [set? #f])
+-         (lambda ()
+-            (unless set?
+-               (let ([v (thunk)])
+-                  (unless set?
+-                     (set! value v)
+-                     (set! set? #t))))
+-            value))))
+-
+-(define force
+-   (lambda (promise)
+-      (promise)))
+-
+PATCH
+test $# -gt 0 && exit 0
+rm *.ORIG
+###############################################################################
+
+echo Renaming globals ...
+
+CR='
+'
+SEDCMD='s/list\*/syncase:list*/g'
+for x in \
+  build- void andmap install-global-transformer eval-hook error-hook \
+  new-symbol-hook put-global-definition-hook get-global-definition-hook \
+  expand-install-hook;
+do SEDCMD=$SEDCMD$CR"s/$x/syncase:$x/g"; done
+
+WARN=";;; This file was munged by a simple minded sed script since it left
+;;; its original authors' hands.  See syncase.doc for the horrid details.
+"
+
+for f in *.pp *.ss; do
+  mv $f tt; (echo "$WARN"; sed -e "$SEDCMD" tt) >$f; rm tt; done
+
+echo Making the doc file ...
+DOC=syncase.doc
+cp ../$DOC .
+for f in Notes ReadMe; do
+echo "
+*******************************************************************************
+The file named $f in the original distribution:
+"
+cat $f
+rm $f
+done >>$DOC
+
+echo "
+*******************************************************************************
+The shell script that created these files out of the original distribution:
+" >>$DOC
+cat ../fixit >>$DOC
+
+echo Renaming files ...
+mv compat.ss sca-comp.scm
+mv output.ss scaoutp.scm
+mv init.ss scaglob.scm
+mv expand.pp scaexpp.scm
+mv expand.ss sca-exp.scm
+mv macro-defs.ss scamacr.scm
+mv structure.ss structure.scm
+
+echo Adding new pieces ...
+cp ../sca-init.scm scainit.scm
+
+echo Done.
diff --git a/synchk.scm b/synchk.scm
new file mode 100644
index 0000000..7e45a73
--- /dev/null
+++ b/synchk.scm
@@ -0,0 +1,104 @@
+;;; "synchk.scm" Syntax Checking			-*-Scheme-*-
+;;; Copyright (c) 1989-91 Massachusetts Institute of Technology
+;;;
+;;; This material was developed by the Scheme project at the
+;;; Massachusetts Institute of Technology, Department of Electrical
+;;; Engineering and Computer Science.  Permission to copy this
+;;; software, to redistribute it, and to use it for any purpose is
+;;; granted, subject to the following restrictions and understandings.
+;;;
+;;; 1. Any copy made of this software must include this copyright
+;;; notice in full.
+;;;
+;;; 2. Users of this software agree to make their best efforts (a) to
+;;; return to the MIT Scheme project any improvements or extensions
+;;; that they make, so that these may be included in future releases;
+;;; and (b) to inform MIT of noteworthy uses of this software.
+;;;
+;;; 3. All materials developed as a consequence of the use of this
+;;; software shall duly acknowledge such use, in accordance with the
+;;; usual standards of acknowledging credit in academic research.
+;;;
+;;; 4. MIT has made no warrantee or representation that the operation
+;;; of this software will be error-free, and MIT is under no
+;;; obligation to provide any services, by way of maintenance, update,
+;;; or otherwise.
+;;;
+;;; 5. In conjunction with products arising from the use of this
+;;; material, there shall be no use of the name of the Massachusetts
+;;; Institute of Technology nor of any adaptation thereof in any
+;;; advertising, promotional, or sales literature without prior
+;;; written consent from MIT in each case.
+
+;;;; Syntax Checking
+;;; written by Alan Bawden
+;;; modified by Chris Hanson
+
+(define (syntax-check pattern form)
+  (if (not (syntax-match? (cdr pattern) (cdr form)))
+      (syntax-error "ill-formed special form" form)))
+
+(define (ill-formed-syntax form)
+  (syntax-error "ill-formed special form" form))
+
+(define (syntax-match? pattern object)
+  (let ((match-error
+	 (lambda ()
+	   (impl-error "ill-formed pattern" pattern))))
+    (cond ((symbol? pattern)
+	   (case pattern
+	     ((IDENTIFIER) (identifier? object))
+	     ((DATUM EXPRESSION FORM) #t)
+	     ((R4RS-BVL)
+	      (let loop ((seen '()) (object object))
+		(or (null? object)
+		    (if (identifier? object)
+			(not (memq object seen))
+			(and (pair? object)
+			     (identifier? (car object))
+			     (not (memq (car object) seen))
+			     (loop (cons (car object) seen) (cdr object)))))))
+	     ((MIT-BVL) (lambda-list? object))
+	     (else (match-error))))
+	  ((pair? pattern)
+	   (case (car pattern)
+	     ((*)
+	      (if (pair? (cdr pattern))
+		  (let ((head (cadr pattern))
+			(tail (cddr pattern)))
+		    (let loop ((object object))
+		      (or (and (pair? object)
+			       (syntax-match? head (car object))
+			       (loop (cdr object)))
+			  (syntax-match? tail object))))
+		  (match-error)))
+	     ((+)
+	      (if (pair? (cdr pattern))
+		  (let ((head (cadr pattern))
+			(tail (cddr pattern)))
+		    (and (pair? object)
+			 (syntax-match? head (car object))
+			 (let loop ((object (cdr object)))
+			   (or (and (pair? object)
+				    (syntax-match? head (car object))
+				    (loop (cdr object)))
+			       (syntax-match? tail object)))))
+		  (match-error)))
+	     ((?)
+	      (if (pair? (cdr pattern))
+		  (or (and (pair? object)
+			   (syntax-match? (cadr pattern) (car object))
+			   (syntax-match? (cddr pattern) (cdr object)))
+		      (syntax-match? (cddr pattern) object))
+		  (match-error)))
+	     ((QUOTE)
+	      (if (and (pair? (cdr pattern))
+		       (null? (cddr pattern)))
+		  (eqv? (cadr pattern) object)
+		  (match-error)))
+	     (else
+	      (and (pair? object)
+		   (syntax-match? (car pattern) (car object))
+		   (syntax-match? (cdr pattern) (cdr object))))))
+	  (else
+	   (eqv? pattern object)))))
diff --git a/synclo.scm b/synclo.scm
new file mode 100644
index 0000000..3c61de3
--- /dev/null
+++ b/synclo.scm
@@ -0,0 +1,748 @@
+;;; "synclo.scm" Syntactic Closures		-*-Scheme-*-
+;;; Copyright (c) 1989-91 Massachusetts Institute of Technology
+;;;
+;;; This material was developed by the Scheme project at the
+;;; Massachusetts Institute of Technology, Department of Electrical
+;;; Engineering and Computer Science.  Permission to copy this
+;;; software, to redistribute it, and to use it for any purpose is
+;;; granted, subject to the following restrictions and understandings.
+;;;
+;;; 1. Any copy made of this software must include this copyright
+;;; notice in full.
+;;;
+;;; 2. Users of this software agree to make their best efforts (a) to
+;;; return to the MIT Scheme project any improvements or extensions
+;;; that they make, so that these may be included in future releases;
+;;; and (b) to inform MIT of noteworthy uses of this software.
+;;;
+;;; 3. All materials developed as a consequence of the use of this
+;;; software shall duly acknowledge such use, in accordance with the
+;;; usual standards of acknowledging credit in academic research.
+;;;
+;;; 4. MIT has made no warrantee or representation that the operation
+;;; of this software will be error-free, and MIT is under no
+;;; obligation to provide any services, by way of maintenance, update,
+;;; or otherwise.
+;;;
+;;; 5. In conjunction with products arising from the use of this
+;;; material, there shall be no use of the name of the Massachusetts
+;;; Institute of Technology nor of any adaptation thereof in any
+;;; advertising, promotional, or sales literature without prior
+;;; written consent from MIT in each case.
+
+;;;; Syntactic Closures
+;;; written by Alan Bawden
+;;; extensively modified by Chris Hanson
+
+;;; See "Syntactic Closures", by Alan Bawden and Jonathan Rees, in
+;;; Proceedings of the 1988 ACM Conference on Lisp and Functional
+;;; Programming, page 86.
+
+;;;; Classifier
+;;;  The classifier maps forms into items.  In addition to locating
+;;;  definitions so that they can be properly processed, it also
+;;;  identifies keywords and variables, which allows a powerful form
+;;;  of syntactic binding to be implemented.
+
+(define (classify/form form environment definition-environment)
+  (cond ((identifier? form)
+	 (syntactic-environment/lookup environment form))
+	((syntactic-closure? form)
+	 (let ((form (syntactic-closure/form form))
+	       (environment
+		(filter-syntactic-environment
+		 (syntactic-closure/free-names form)
+		 environment
+		 (syntactic-closure/environment form))))
+	   (classify/form form
+			  environment
+			  definition-environment)))
+	((pair? form)
+	 (let ((item
+		(classify/subexpression (car form) environment)))
+	   (cond ((keyword-item? item)
+		  ((keyword-item/classifier item) form
+						  environment
+						  definition-environment))
+		 ((list? (cdr form))
+		  (let ((items
+			 (classify/subexpressions (cdr form)
+						  environment)))
+		    (make-expression-item
+		     (lambda ()
+		       (output/combination
+			(compile-item/expression item)
+			(map compile-item/expression items)))
+		     form)))
+		 (else
+		  (syntax-error "combination must be a proper list"
+				form)))))
+	(else
+	 (make-expression-item ;don't quote literals evaluating to themselves
+	   (if (or (boolean? form) (char? form) (number? form) (string? form))
+	       (lambda () (output/literal-unquoted form))
+	       (lambda () (output/literal-quoted form))) form))))
+
+(define (classify/subform form environment definition-environment)
+  (classify/form form
+		 environment
+		 definition-environment))
+
+(define (classify/subforms forms environment definition-environment)
+  (map (lambda (form)
+	 (classify/subform form environment definition-environment))
+       forms))
+
+(define (classify/subexpression expression environment)
+  (classify/subform expression environment environment))
+
+(define (classify/subexpressions expressions environment)
+  (classify/subforms expressions environment environment))
+
+;;;; Compiler
+;;;  The compiler maps items into the output language.
+
+(define (compile-item/expression item)
+  (let ((illegal
+	 (lambda (item name)
+	   (let ((decompiled (decompile-item item))) (newline)
+	   (slib:error (string-append name
+					" may not be used as an expression")
+			 decompiled)))))
+    (cond ((variable-item? item)
+	   (output/variable (variable-item/name item)))
+	  ((expression-item? item)
+	   ((expression-item/compiler item)))
+	  ((body-item? item)
+	   (let ((items (flatten-body-items (body-item/components item))))
+	     (if (null? items)
+		 (illegal item "empty sequence")
+		 (output/sequence (map compile-item/expression items)))))
+	  ((definition-item? item)
+	   (let ((binding ;allows later scheme errors, but allows top-level
+		  (bind-definition-item! ;(if (not (defined? x)) define it)
+		   scheme-syntactic-environment item))) ;as in Init.scm
+	     (output/top-level-definition
+	      (car binding)
+	      (compile-item/expression (cdr binding)))))
+	  ((keyword-item? item)
+	   (illegal item "keyword"))
+	  (else
+	   (impl-error "unknown item" item)))))
+
+(define (compile/subexpression expression environment)
+  (compile-item/expression
+   (classify/subexpression expression environment)))
+
+(define (compile/top-level forms environment)
+  ;; Top-level syntactic definitions affect all forms that appear
+  ;; after them.
+  (output/top-level-sequence
+   (let forms-loop ((forms forms))
+     (if (null? forms)
+	 '()
+	 (let items-loop
+	     ((items
+	       (item->list
+		(classify/subform (car forms)
+				  environment
+				  environment))))
+	   (cond ((null? items)
+		  (forms-loop (cdr forms)))
+		 ((definition-item? (car items))
+		  (let ((binding
+			 (bind-definition-item! environment (car items))))
+		    (if binding
+			(cons (output/top-level-definition
+			       (car binding)
+			       (compile-item/expression (cdr binding)))
+			      (items-loop (cdr items)))
+			(items-loop (cdr items)))))
+		 (else
+		  (cons (compile-item/expression (car items))
+			(items-loop (cdr items))))))))))
+
+;;;; De-Compiler
+;;;  The de-compiler maps partly-compiled things back to the input language,
+;;;  as far as possible.  Used to display more meaningful macro error messages.
+
+(define (decompile-item item)
+    (display " ")
+    (cond ((variable-item? item) (variable-item/name item))
+	  ((expression-item? item)
+	   (decompile-item (expression-item/annotation item)))
+	  ((body-item? item)
+	   (let ((items (flatten-body-items (body-item/components item))))
+	     (display "sequence")
+	     (if (null? items)
+		 "empty sequence"
+		 "non-empty sequence")))
+	  ((definition-item? item) "definition")
+	  ((keyword-item? item)
+	   (decompile-item (keyword-item/name item)));in case expression
+	  ((syntactic-closure? item); (display "syntactic-closure;")
+	   (decompile-item (syntactic-closure/form item)))
+	  ((list? item) (display "(")
+		(map decompile-item item) (display ")") "see list above")
+	  ((string? item) item);explicit name-string for keyword-item
+	  ((symbol? item) (display item) item) ;symbol for syntactic-closures
+	  ((boolean? item) (display item) item) ;symbol for syntactic-closures
+	  (else (write item) (impl-error "unknown item" item))))
+
+;;;; Syntactic Closures
+
+(define syntactic-closure-type
+  (make-record-type "syntactic-closure" '(ENVIRONMENT FREE-NAMES FORM)))
+
+(define make-syntactic-closure
+  (record-constructor syntactic-closure-type '(ENVIRONMENT FREE-NAMES FORM)))
+
+(define syntactic-closure?
+  (record-predicate syntactic-closure-type))
+
+(define syntactic-closure/environment
+  (record-accessor syntactic-closure-type 'ENVIRONMENT))
+
+(define syntactic-closure/free-names
+  (record-accessor syntactic-closure-type 'FREE-NAMES))
+
+(define syntactic-closure/form
+  (record-accessor syntactic-closure-type 'FORM))
+
+(define (make-syntactic-closure-list environment free-names forms)
+  (map (lambda (form) (make-syntactic-closure environment free-names form))
+       forms))
+
+(define (strip-syntactic-closures object)
+  (cond ((syntactic-closure? object)
+	 (strip-syntactic-closures (syntactic-closure/form object)))
+	((pair? object)
+	 (cons (strip-syntactic-closures (car object))
+	       (strip-syntactic-closures (cdr object))))
+	((vector? object)
+	 (let ((length (vector-length object)))
+	   (let ((result (make-vector length)))
+	     (do ((i 0 (+ i 1)))
+		 ((= i length))
+	       (vector-set! result i
+			    (strip-syntactic-closures (vector-ref object i))))
+	     result)))
+	(else
+	 object)))
+
+(define (identifier? object)
+  (or (symbol? object)
+      (synthetic-identifier? object)))
+
+(define (synthetic-identifier? object)
+  (and (syntactic-closure? object)
+       (identifier? (syntactic-closure/form object))))
+
+(define (identifier->symbol identifier)
+  (cond ((symbol? identifier)
+	 identifier)
+	((synthetic-identifier? identifier)
+	 (identifier->symbol (syntactic-closure/form identifier)))
+	(else
+	 (impl-error "not an identifier" identifier))))
+
+(define (identifier=? environment-1 identifier-1 environment-2 identifier-2)
+  (let ((item-1 (syntactic-environment/lookup environment-1 identifier-1))
+	(item-2 (syntactic-environment/lookup environment-2 identifier-2)))
+    (or (eq? item-1 item-2)
+	;; This is necessary because an identifier that is not
+	;; explicitly bound by an environment is mapped to a variable
+	;; item, and the variable items are not cached.  Therefore
+	;; two references to the same variable result in two
+	;; different variable items.
+	(and (variable-item? item-1)
+	     (variable-item? item-2)
+	     (eq? (variable-item/name item-1)
+		  (variable-item/name item-2))))))
+
+;;;; Syntactic Environments
+
+(define syntactic-environment-type
+  (make-record-type
+   "syntactic-environment"
+   '(PARENT
+     LOOKUP-OPERATION
+     RENAME-OPERATION
+     DEFINE-OPERATION
+     BINDINGS-OPERATION)))
+
+(define make-syntactic-environment
+  (record-constructor syntactic-environment-type
+		      '(PARENT
+			LOOKUP-OPERATION
+			RENAME-OPERATION
+			DEFINE-OPERATION
+			BINDINGS-OPERATION)))
+
+(define syntactic-environment?
+  (record-predicate syntactic-environment-type))
+
+(define syntactic-environment/parent
+  (record-accessor syntactic-environment-type 'PARENT))
+
+(define syntactic-environment/lookup-operation
+  (record-accessor syntactic-environment-type 'LOOKUP-OPERATION))
+
+(define (syntactic-environment/assign! environment name item)
+  (let ((binding
+	 ((syntactic-environment/lookup-operation environment) name)))
+    (if binding
+	(set-cdr! binding item)
+	(impl-error "can't assign unbound identifier" name))))
+
+(define syntactic-environment/rename-operation
+  (record-accessor syntactic-environment-type 'RENAME-OPERATION))
+
+(define (syntactic-environment/rename environment name)
+  ((syntactic-environment/rename-operation environment) name))
+
+(define syntactic-environment/define!
+  (let ((accessor
+	 (record-accessor syntactic-environment-type 'DEFINE-OPERATION)))
+    (lambda (environment name item)
+      ((accessor environment) name item))))
+
+(define syntactic-environment/bindings
+  (let ((accessor
+	 (record-accessor syntactic-environment-type 'BINDINGS-OPERATION)))
+    (lambda (environment)
+      ((accessor environment)))))
+
+(define (syntactic-environment/lookup environment name)
+  (let ((binding
+	 ((syntactic-environment/lookup-operation environment) name)))
+    (cond (binding
+	   (let ((item (cdr binding)))
+	     (if (reserved-name-item? item)
+		 (syntax-error "premature reference to reserved name"
+			       name)
+		 item)))
+	  ((symbol? name)
+	   (make-variable-item name))
+	  ((synthetic-identifier? name)
+	   (syntactic-environment/lookup (syntactic-closure/environment name)
+					 (syntactic-closure/form name)))
+	  (else
+	   (impl-error "not an identifier" name)))))
+
+(define root-syntactic-environment
+  (make-syntactic-environment
+   #f
+   (lambda (name)
+     name
+     #f)
+   (lambda (name)
+     name)
+   (lambda (name item)
+     (impl-error "can't bind name in root syntactic environment" name item))
+   (lambda ()
+     '())))
+
+(define null-syntactic-environment
+  (make-syntactic-environment
+   #f
+   (lambda (name)
+     (impl-error "can't lookup name in null syntactic environment" name))
+   (lambda (name)
+     (impl-error "can't rename name in null syntactic environment" name))
+   (lambda (name item)
+     (impl-error "can't bind name in null syntactic environment" name item))
+   (lambda ()
+     '())))
+
+(define (top-level-syntactic-environment parent)
+  (let ((bound '()))
+    (make-syntactic-environment
+     parent
+     (let ((parent-lookup (syntactic-environment/lookup-operation parent)))
+       (lambda (name)
+	 (or (assq name bound)
+	     (parent-lookup name))))
+     (lambda (name)
+       name)
+     (lambda (name item)
+       (let ((binding (assq name bound)))
+	 (if binding
+	     (set-cdr! binding item)
+	     (set! bound (cons (cons name item) bound)))))
+     (lambda ()
+       (map (lambda (pair) (cons (car pair) (cdr pair))) bound)))))
+
+(define (internal-syntactic-environment parent)
+  (let ((bound '())
+	(free '()))
+    (make-syntactic-environment
+     parent
+     (let ((parent-lookup (syntactic-environment/lookup-operation parent)))
+       (lambda (name)
+	 (or (assq name bound)
+	     (assq name free)
+	     (let ((binding (parent-lookup name)))
+	       (if binding (set! free (cons binding free)))
+	       binding))))
+     (make-name-generator)
+     (lambda (name item)
+       (cond ((assq name bound)
+	      =>
+	      (lambda (association)
+		(if (and (reserved-name-item? (cdr association))
+			 (not (reserved-name-item? item)))
+		    (set-cdr! association item)
+		    (impl-error "can't redefine name; already bound" name))))
+	     ((assq name free)
+	      (if (reserved-name-item? item)
+		  (syntax-error "premature reference to reserved name"
+				name)
+		  (impl-error "can't define name; already free" name)))
+	     (else
+	      (set! bound (cons (cons name item) bound)))))
+     (lambda ()
+       (map (lambda (pair) (cons (car pair) (cdr pair))) bound)))))
+
+(define (filter-syntactic-environment names names-env else-env)
+  (if (or (null? names)
+	  (eq? names-env else-env))
+      else-env
+      (let ((make-operation
+	     (lambda (get-operation)
+	       (let ((names-operation (get-operation names-env))
+		     (else-operation (get-operation else-env)))
+		 (lambda (name)
+		   ((if (memq name names) names-operation else-operation)
+		    name))))))
+	(make-syntactic-environment
+	 else-env
+	 (make-operation syntactic-environment/lookup-operation)
+	 (make-operation syntactic-environment/rename-operation)
+	 (lambda (name item)
+	   (impl-error "can't bind name in filtered syntactic environment"
+		       name item))
+	 (lambda ()
+	   (map (lambda (name)
+		  (cons name
+			(syntactic-environment/lookup names-env name)))
+		names))))))
+
+;;;; Items
+
+;;; Reserved name items do not represent any form, but instead are
+;;; used to reserve a particular name in a syntactic environment.  If
+;;; the classifier refers to a reserved name, a syntax error is
+;;; signalled.  This is used in the implementation of LETREC-SYNTAX
+;;; to signal a meaningful error when one of the <init>s refers to
+;;; one of the names being bound.
+
+(define reserved-name-item-type
+  (make-record-type "reserved-name-item" '()))
+
+(define make-reserved-name-item
+  (record-constructor reserved-name-item-type))	; '()
+
+(define reserved-name-item?
+  (record-predicate reserved-name-item-type))
+
+;;; Keyword items represent macro keywords.
+
+(define keyword-item-type
+  (make-record-type "keyword-item" '(CLASSIFIER NAME)))
+;  (make-record-type "keyword-item" '(CLASSIFIER)))
+
+(define make-keyword-item
+;  (lambda (cl) (display "make-keyword-item:") (write cl) (newline)
+;	((record-constructor keyword-item-type '(CLASSIFIER)) cl)))
+  (record-constructor keyword-item-type '(CLASSIFIER NAME)))
+;  (record-constructor keyword-item-type '(CLASSIFIER)))
+
+(define keyword-item?
+  (record-predicate keyword-item-type))
+
+(define keyword-item/classifier
+  (record-accessor keyword-item-type 'CLASSIFIER))
+
+(define keyword-item/name
+  (record-accessor keyword-item-type 'NAME))
+
+;;; Variable items represent run-time variables.
+
+(define variable-item-type
+  (make-record-type "variable-item" '(NAME)))
+
+(define make-variable-item
+  (record-constructor variable-item-type '(NAME)))
+
+(define variable-item?
+  (record-predicate variable-item-type))
+
+(define variable-item/name
+  (record-accessor variable-item-type 'NAME))
+
+;;; Expression items represent any kind of expression other than a
+;;; run-time variable or a sequence.  The ANNOTATION field is used to
+;;; make expression items that can appear in non-expression contexts
+;;; (for example, this could be used in the implementation of SETF).
+
+(define expression-item-type
+  (make-record-type "expression-item" '(COMPILER ANNOTATION)))
+
+(define make-expression-item
+  (record-constructor expression-item-type '(COMPILER ANNOTATION)))
+
+(define expression-item?
+  (record-predicate expression-item-type))
+
+(define expression-item/compiler
+  (record-accessor expression-item-type 'COMPILER))
+
+(define expression-item/annotation
+  (record-accessor expression-item-type 'ANNOTATION))
+
+;;; Body items represent sequences (e.g. BEGIN).
+
+(define body-item-type
+  (make-record-type "body-item" '(COMPONENTS)))
+
+(define make-body-item
+  (record-constructor body-item-type '(COMPONENTS)))
+
+(define body-item?
+  (record-predicate body-item-type))
+
+(define body-item/components
+  (record-accessor body-item-type 'COMPONENTS))
+
+;;; Definition items represent definitions, whether top-level or
+;;; internal, keyword or variable.
+
+(define definition-item-type
+  (make-record-type "definition-item" '(BINDING-THEORY NAME VALUE)))
+
+(define make-definition-item
+  (record-constructor definition-item-type '(BINDING-THEORY NAME VALUE)))
+
+(define definition-item?
+  (record-predicate definition-item-type))
+
+(define definition-item/binding-theory
+  (record-accessor definition-item-type 'BINDING-THEORY))
+
+(define definition-item/name
+  (record-accessor definition-item-type 'NAME))
+
+(define definition-item/value
+  (record-accessor definition-item-type 'VALUE))
+
+(define (bind-definition-item! environment item)
+  ((definition-item/binding-theory item)
+   environment
+   (definition-item/name item)
+   (promise:force (definition-item/value item))))
+
+(define (syntactic-binding-theory environment name item)
+  (if (or (keyword-item? item)
+	  (variable-item? item))
+      (begin
+	(syntactic-environment/define! environment name item)
+	#f)
+      (syntax-error "syntactic binding value must be a keyword or a variable"
+		    item)))
+
+(define (variable-binding-theory environment name item)
+  ;; If ITEM isn't a valid expression, an error will be signalled by
+  ;; COMPILE-ITEM/EXPRESSION later.
+  (cons (bind-variable! environment name) item))
+
+(define (overloaded-binding-theory environment name item)
+  (if (keyword-item? item)
+      (begin
+	(syntactic-environment/define! environment name item)
+	#f)
+      (cons (bind-variable! environment name) item)))
+
+;;;; Classifiers, Compilers, Expanders
+
+(define (sc-expander->classifier expander keyword-environment)
+  (lambda (form environment definition-environment)
+    (classify/form (expander form environment)
+		   keyword-environment
+		   definition-environment)))
+
+(define (er-expander->classifier expander keyword-environment)
+  (sc-expander->classifier (er->sc-expander expander) keyword-environment))
+
+(define (er->sc-expander expander)
+  (lambda (form environment)
+    (capture-syntactic-environment
+     (lambda (keyword-environment)
+       (make-syntactic-closure
+	environment '()
+	(expander form
+		  (let ((renames '()))
+		    (lambda (identifier)
+		      (let ((association (assq identifier renames)))
+			(if association
+			    (cdr association)
+			    (let ((rename
+				   (make-syntactic-closure
+				    keyword-environment
+				    '()
+				    identifier)))
+			      (set! renames
+				    (cons (cons identifier rename)
+					  renames))
+			      rename)))))
+		  (lambda (x y)
+		    (identifier=? environment x
+				  environment y))))))))
+
+(define (classifier->keyword classifier)
+  (make-syntactic-closure
+   (let ((environment
+	  (internal-syntactic-environment null-syntactic-environment)))
+     (syntactic-environment/define! environment
+				    'KEYWORD
+				    (make-keyword-item classifier "c->k"))
+     environment)
+   '()
+   'KEYWORD))
+
+(define (compiler->keyword compiler)
+  (classifier->keyword (compiler->classifier compiler)))
+
+(define (classifier->form classifier)
+  `(,(classifier->keyword classifier)))
+
+(define (compiler->form compiler)
+  (classifier->form (compiler->classifier compiler)))
+
+(define (compiler->classifier compiler)
+  (lambda (form environment definition-environment)
+    definition-environment		;ignore
+    (make-expression-item
+     (lambda () (compiler form environment)) form)))
+
+;;;; Macrologies
+;;;  A macrology is a procedure that accepts a syntactic environment
+;;;  as an argument, producing a new syntactic environment that is an
+;;;  extension of the argument.
+
+(define (make-primitive-macrology generate-definitions)
+  (lambda (base-environment)
+    (let ((environment (top-level-syntactic-environment base-environment)))
+      (let ((define-classifier
+	      (lambda (keyword classifier)
+		(syntactic-environment/define!
+		 environment
+		 keyword
+		 (make-keyword-item classifier keyword)))))
+	(generate-definitions
+	 define-classifier
+	 (lambda (keyword compiler)
+	   (define-classifier keyword (compiler->classifier compiler)))))
+      environment)))
+
+(define (make-expander-macrology object->classifier generate-definitions)
+  (lambda (base-environment)
+    (let ((environment (top-level-syntactic-environment base-environment)))
+      (generate-definitions
+       (lambda (keyword object)
+	 (syntactic-environment/define!
+	  environment
+	  keyword
+	  (make-keyword-item (object->classifier object environment) keyword)))
+       base-environment)
+      environment)))
+
+(define (make-sc-expander-macrology generate-definitions)
+  (make-expander-macrology sc-expander->classifier generate-definitions))
+
+(define (make-er-expander-macrology generate-definitions)
+  (make-expander-macrology er-expander->classifier generate-definitions))
+
+(define (compose-macrologies . macrologies)
+  (lambda (environment)
+    (do ((macrologies macrologies (cdr macrologies))
+	 (environment environment ((car macrologies) environment)))
+	((null? macrologies) environment))))
+
+;;;; Utilities
+
+(define (bind-variable! environment name)
+  (let ((rename (syntactic-environment/rename environment name)))
+    (syntactic-environment/define! environment
+				   name
+				   (make-variable-item rename))
+    rename))
+
+(define (reserve-names! names environment)
+  (let ((item (make-reserved-name-item)))
+    (for-each (lambda (name)
+		(syntactic-environment/define! environment name item))
+	      names)))
+
+(define (capture-syntactic-environment expander)
+  (classifier->form
+   (lambda (form environment definition-environment)
+     form				;ignore
+     (classify/form (expander environment)
+		    environment
+		    definition-environment))))
+
+(define (unspecific-expression)
+  (compiler->form
+   (lambda (form environment)
+     form environment			;ignore
+     (output/unspecific))))
+
+(define (unassigned-expression)
+  (compiler->form
+   (lambda (form environment)
+     form environment			;ignore
+     (output/unassigned))))
+
+(define (syntax-quote expression)
+  `(,(compiler->keyword
+      (lambda (form environment)
+	environment			;ignore
+	(syntax-check '(KEYWORD DATUM) form)
+	(output/literal-quoted (cadr form))))
+    ,expression))
+
+(define (flatten-body-items items)
+  (append-map item->list items))
+
+(define (item->list item)
+  (if (body-item? item)
+      (flatten-body-items (body-item/components item))
+      (list item)))
+
+(define (output/let names values body)
+  (if (null? names)
+      body
+      (output/combination (output/lambda names body) values)))
+
+(define (output/letrec names values body)
+  (if (null? names)
+      body
+      (output/let
+       names
+       (map (lambda (name) name (output/unassigned)) names)
+       (output/sequence
+	(list (if (null? (cdr names))
+		  (output/assignment (car names) (car values))
+		  (let ((temps (map (make-name-generator) names)))
+		    (output/let
+		     temps
+		     values
+		     (output/sequence
+		      (map output/assignment names temps)))))
+	      body)))))
+
+(define (output/top-level-sequence expressions)
+  (if (null? expressions)
+      (output/unspecific)
+      (output/sequence expressions)))
diff --git a/synrul.scm b/synrul.scm
new file mode 100644
index 0000000..c23275f
--- /dev/null
+++ b/synrul.scm
@@ -0,0 +1,327 @@
+;;; "synrul.scm" Rule-based Syntactic Expanders		-*-Scheme-*-
+;;; Copyright (c) 1989-91 Massachusetts Institute of Technology
+;;;
+;;; This material was developed by the Scheme project at the
+;;; Massachusetts Institute of Technology, Department of Electrical
+;;; Engineering and Computer Science.  Permission to copy this
+;;; software, to redistribute it, and to use it for any purpose is
+;;; granted, subject to the following restrictions and understandings.
+;;;
+;;; 1. Any copy made of this software must include this copyright
+;;; notice in full.
+;;;
+;;; 2. Users of this software agree to make their best efforts (a) to
+;;; return to the MIT Scheme project any improvements or extensions
+;;; that they make, so that these may be included in future releases;
+;;; and (b) to inform MIT of noteworthy uses of this software.
+;;;
+;;; 3. All materials developed as a consequence of the use of this
+;;; software shall duly acknowledge such use, in accordance with the
+;;; usual standards of acknowledging credit in academic research.
+;;;
+;;; 4. MIT has made no warrantee or representation that the operation
+;;; of this software will be error-free, and MIT is under no
+;;; obligation to provide any services, by way of maintenance, update,
+;;; or otherwise.
+;;;
+;;; 5. In conjunction with products arising from the use of this
+;;; material, there shall be no use of the name of the Massachusetts
+;;; Institute of Technology nor of any adaptation thereof in any
+;;; advertising, promotional, or sales literature without prior
+;;; written consent from MIT in each case.
+
+;;;; Rule-based Syntactic Expanders
+
+;;; See "Syntactic Extensions in the Programming Language Lisp", by
+;;; Eugene Kohlbecker, Ph.D. dissertation, Indiana University, 1986.
+;;; See also "Macros That Work", by William Clinger and Jonathan Rees
+;;; (reference? POPL?).  This implementation is derived from an
+;;; implementation by Kent Dybvig, and includes some ideas from
+;;; another implementation by Jonathan Rees.
+
+;;; The expansion of SYNTAX-RULES references the following keywords:
+;;;   ER-TRANSFORMER LAMBDA IF BEGIN SET! QUOTE
+;;; and the following procedures:
+;;;   CAR CDR NULL? PAIR? EQUAL? MAP LIST CONS APPEND
+;;;   ILL-FORMED-SYNTAX
+;;; it also uses the anonymous keyword SYNTAX-QUOTE.
+
+;;; For testing.
+;;;(define (run-sr form)
+;;;  (expand/syntax-rules form (lambda (x) x) eq?))
+
+(define (make-syntax-rules-macrology)
+  (make-er-expander-macrology
+   (lambda (define-classifier base-environment)
+     base-environment			;ignore
+     (define-classifier 'SYNTAX-RULES expand/syntax-rules))))
+
+(define (expand/syntax-rules form rename compare)
+  (if (syntax-match? '((* IDENTIFIER) + ((IDENTIFIER . DATUM) EXPRESSION))
+		     (cdr form))
+      (let ((keywords (cadr form))
+	    (clauses (cddr form)))
+	(if (let loop ((keywords keywords))
+	      (and (pair? keywords)
+		   (or (memq (car keywords) (cdr keywords))
+		       (loop (cdr keywords)))))
+	    (syntax-error "keywords list contains duplicates" keywords)
+	    (let ((r-form (rename 'FORM))
+		  (r-rename (rename 'RENAME))
+		  (r-compare (rename 'COMPARE)))
+	      `(,(rename 'ER-TRANSFORMER)
+		(,(rename 'LAMBDA)
+		 (,r-form ,r-rename ,r-compare)
+		 ,(let loop ((clauses clauses))
+		    (if (null? clauses)
+			`(,(rename 'ILL-FORMED-SYNTAX) ,r-form)
+			(let ((pattern (caar clauses)))
+			  (let ((sids
+				 (parse-pattern rename compare keywords
+						pattern r-form)))
+			    `(,(rename 'IF)
+			      ,(generate-match rename compare keywords
+					       r-rename r-compare
+					       pattern r-form)
+			      ,(generate-output rename compare r-rename
+						sids (cadar clauses)
+						syntax-error)
+			      ,(loop (cdr clauses))))))))))))
+      (ill-formed-syntax form)))
+
+(define (parse-pattern rename compare keywords pattern expression)
+  (let loop
+      ((pattern pattern)
+       (expression expression)
+       (sids '())
+       (control #f))
+    (cond ((identifier? pattern)
+	   (if (memq pattern keywords)
+	       sids
+	       (cons (make-sid pattern expression control) sids)))
+	  ((and (or (zero-or-more? pattern rename compare)
+		    (at-least-one? pattern rename compare))
+		(null? (cddr pattern)))
+	   (let ((variable ((make-name-generator) 'CONTROL)))
+	     (loop (car pattern)
+		   variable
+		   sids
+		   (make-sid variable expression control))))
+	  ((pair? pattern)
+	   (loop (car pattern)
+		 `(,(rename 'CAR) ,expression)
+		 (loop (cdr pattern)
+		       `(,(rename 'CDR) ,expression)
+		       sids
+		       control)
+		 control))
+	  (else sids))))
+
+(define (generate-match rename compare keywords r-rename r-compare
+			pattern expression)
+  (letrec
+      ((loop
+	(lambda (pattern expression)
+	  (cond ((identifier? pattern)
+		 (if (memq pattern keywords)
+		     (let ((temp (rename 'TEMP)))
+		       `((,(rename 'LAMBDA)
+			  (,temp)
+			  (,(rename 'IF)
+			   (,(rename 'IDENTIFIER?) ,temp)
+			   (,r-compare ,temp
+				       (,r-rename ,(syntax-quote pattern)))
+			   #f))
+			 ,expression))
+		     `#t))
+		((and (zero-or-more? pattern rename compare)
+		      (null? (cddr pattern)))
+		 (do-list (car pattern) expression))
+		((and (at-least-one? pattern rename compare)
+		      (null? (cddr pattern)))
+		 `(,(rename 'IF) (,(rename 'NULL?) ,expression)
+				 #F
+				 ,(do-list (car pattern) expression)))
+		((pair? pattern)
+		 (let ((generate-pair
+			(lambda (expression)
+			  (conjunction
+			   `(,(rename 'PAIR?) ,expression)
+			   (conjunction
+			    (loop (car pattern)
+				  `(,(rename 'CAR) ,expression))
+			    (loop (cdr pattern)
+				  `(,(rename 'CDR) ,expression)))))))
+		   (if (identifier? expression)
+		       (generate-pair expression)
+		       (let ((temp (rename 'TEMP)))
+			 `((,(rename 'LAMBDA) (,temp) ,(generate-pair temp))
+			   ,expression)))))
+		((null? pattern)
+		 `(,(rename 'NULL?) ,expression))
+		(else
+		 `(,(rename 'EQUAL?) ,expression
+				     (,(rename 'QUOTE) ,pattern))))))
+       (do-list
+	(lambda (pattern expression)
+	  (let ((r-loop (rename 'LOOP))
+		(r-l (rename 'L))
+		(r-lambda (rename 'LAMBDA)))
+	    `(((,r-lambda
+		(,r-loop)
+		(,(rename 'BEGIN)
+		 (,(rename 'SET!)
+		  ,r-loop
+		  (,r-lambda
+		   (,r-l)
+		   (,(rename 'IF)
+		    (,(rename 'NULL?) ,r-l)
+		    #T
+		    ,(conjunction
+		      `(,(rename 'PAIR?) ,r-l)
+		      (conjunction (loop pattern `(,(rename 'CAR) ,r-l))
+				   `(,r-loop (,(rename 'CDR) ,r-l)))))))
+		 ,r-loop))
+	       #F)
+	      ,expression))))
+       (conjunction
+	(lambda (predicate consequent)
+	  (cond ((eq? predicate #T) consequent)
+		((eq? consequent #T) predicate)
+		(else `(,(rename 'IF) ,predicate ,consequent #F))))))
+    (loop pattern expression)))
+
+(define (generate-output rename compare r-rename sids template syntax-error)
+  (let loop ((template template) (ellipses '()))
+    (cond ((identifier? template)
+	   (let ((sid
+		  (let loop ((sids sids))
+		    (and (not (null? sids))
+			 (if (eq? (sid-name (car sids)) template)
+			     (car sids)
+			     (loop (cdr sids)))))))
+	     (if sid
+		 (begin
+		   (add-control! sid ellipses syntax-error)
+		   (sid-expression sid))
+		 `(,r-rename ,(syntax-quote template)))))
+	  ((or (zero-or-more? template rename compare)
+	       (at-least-one? template rename compare))
+	   (optimized-append rename compare
+			     (let ((ellipsis (make-ellipsis '())))
+			       (generate-ellipsis rename
+						  ellipsis
+						  (loop (car template)
+							(cons ellipsis
+							      ellipses))))
+			     (loop (cddr template) ellipses)))
+	  ((pair? template)
+	   (optimized-cons rename compare
+			   (loop (car template) ellipses)
+			   (loop (cdr template) ellipses)))
+	  (else
+	   `(,(rename 'QUOTE) ,template)))))
+
+(define (add-control! sid ellipses syntax-error)
+  (let loop ((sid sid) (ellipses ellipses))
+    (let ((control (sid-control sid)))
+      (cond (control
+	     (if (null? ellipses)
+		 (syntax-error "missing ellipsis in expansion" #f)
+		 (let ((sids (ellipsis-sids (car ellipses))))
+		   (cond ((not (memq control sids))
+			  (set-ellipsis-sids! (car ellipses)
+					      (cons control sids)))
+			 ((not (eq? control (car sids)))
+			  (syntax-error "illegal control/ellipsis combination"
+					control sids)))))
+	     (loop control (cdr ellipses)))
+	    ((not (null? ellipses))
+	     (syntax-error "extra ellipsis in expansion" #f))))))
+
+(define (generate-ellipsis rename ellipsis body)
+  (let ((sids (ellipsis-sids ellipsis)))
+    (let ((name (sid-name (car sids)))
+	  (expression (sid-expression (car sids))))
+      (cond ((and (null? (cdr sids))
+		  (eq? body name))
+	     expression)
+	    ((and (null? (cdr sids))
+		  (pair? body)
+		  (pair? (cdr body))
+		  (eq? (cadr body) name)
+		  (null? (cddr body)))
+	     `(,(rename 'MAP) ,(car body) ,expression))
+	    (else
+	     `(,(rename 'MAP) (,(rename 'LAMBDA) ,(map sid-name sids) ,body)
+			      ,@(map sid-expression sids)))))))
+
+(define (zero-or-more? pattern rename compare)
+  (and (pair? pattern)
+       (pair? (cdr pattern))
+       (identifier? (cadr pattern))
+       (compare (cadr pattern) (rename '...))))
+
+(define (at-least-one? pattern rename compare)
+;;;  (and (pair? pattern)
+;;;       (pair? (cdr pattern))
+;;;       (identifier? (cadr pattern))
+;;;       (compare (cadr pattern) (rename '+)))
+  pattern rename compare		;ignore
+  #f)
+
+(define (optimized-cons rename compare a d)
+  (cond ((and (pair? d)
+	      (compare (car d) (rename 'QUOTE))
+	      (pair? (cdr d))
+	      (null? (cadr d))
+	      (null? (cddr d)))
+	 `(,(rename 'LIST) ,a))
+	((and (pair? d)
+	      (compare (car d) (rename 'LIST))
+	      (list? (cdr d)))
+	 `(,(car d) ,a ,@(cdr d)))
+	(else
+	 `(,(rename 'CONS) ,a ,d))))
+
+(define (optimized-append rename compare x y)
+  (if (and (pair? y)
+	   (compare (car y) (rename 'QUOTE))
+	   (pair? (cdr y))
+	   (null? (cadr y))
+	   (null? (cddr y)))
+      x
+      `(,(rename 'APPEND) ,x ,y)))
+
+(define sid-type
+  (make-record-type "sid" '(NAME EXPRESSION CONTROL OUTPUT-EXPRESSION)))
+
+(define make-sid
+  (record-constructor sid-type '(NAME EXPRESSION CONTROL)))
+
+(define sid-name
+  (record-accessor sid-type 'NAME))
+
+(define sid-expression
+  (record-accessor sid-type 'EXPRESSION))
+
+(define sid-control
+  (record-accessor sid-type 'CONTROL))
+
+(define sid-output-expression
+  (record-accessor sid-type 'OUTPUT-EXPRESSION))
+
+(define set-sid-output-expression!
+  (record-modifier sid-type 'OUTPUT-EXPRESSION))
+
+(define ellipsis-type
+  (make-record-type "ellipsis" '(SIDS)))
+
+(define make-ellipsis
+  (record-constructor ellipsis-type '(SIDS)))
+
+(define ellipsis-sids
+  (record-accessor ellipsis-type 'SIDS))
+
+(define set-ellipsis-sids!
+  (record-modifier ellipsis-type 'SIDS))
diff --git a/t3.init b/t3.init
new file mode 100644
index 0000000..b9a0191
--- /dev/null
+++ b/t3.init
@@ -0,0 +1,425 @@
+;"t3.init" Initialization file for SLIB for T3.1.	-*-scheme-*-
+;Copyright (C) 1991, 1992 David Carlton & Stephen Bevan
+;Copyright 1993 F. Javier Thayer.
+;Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; File has T syntax, and should be compiled in standard-env.
+;;; Compiled file has .so suffix.
+;;; File (or compiled version) should be loaded into scheme-env.
+
+;;; This is provided with ABSOLUTELY NO GUARANTEE.
+(herald t3)
+
+(define (software-type) 'UNIX)
+
+(define (scheme-implementation-type) 'T)
+
+(define (scheme-implementation-version) "3.1")
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxillary files to your Scheme
+;;; implementation reside. It is settable.
+
+(define implementation-vicinity
+  (make-simple-switch 'implementation-vicinity
+		      (lambda (x) (or (string? x) (false? x)))
+		      '#f))
+(set (implementation-vicinity) "/usr/local/lib/tsystem/")
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside. It is settable.
+
+(define library-vicinity
+  (make-simple-switch 'library-vicinity
+		      (lambda (x) (or (string? x) (false? x)))
+		      '#f))
+(set (library-vicinity) "/usr/local/lib/slib/")
+;;Obviously put your value here.
+
+;;; *FEATURES* should be set to a list of symbols describing features
+;;; of this implementation.  See Template.scm for the list of feature
+;;; names.
+
+(define *features*
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+	rev3-report
+	rev4-optional-procedures
+	rev3-procedures
+	rev2-procedures
+	multiarg/and-
+	multiarg-apply
+	rationalize
+	object-hash
+	delay
+	i/o-redirection
+	char-ready?
+	with-file
+	transcript
+	full-continuation
+	pretty-print
+	format
+	trace				;has macros: TRACE and UNTRACE
+	program-arguments
+	))
+
+(define substring
+  (let ((primitive-substring (*value standard-env 'substring)))
+    (lambda (string start end)
+      (primitive-substring string start (max 0 (- end 1))))))
+
+; Modify substring as T's substring takes (start,count) instead of
+; (start,end)
+
+(set (syntax-table-entry (env-syntax-table scheme-env) 'require) '#f)
+
+; Turn off the macro REQUIRE so that it can be rebound as a function
+; later.
+
+; extend <, >, <= and >= so that they take more than two arguments.
+
+(define <
+  (let ((primitive< (*value standard-env '<)))
+    (labels ((v (lambda (a b . rest)
+		  (if (null? rest)
+		      (primitive< a b)
+		      (and (primitive< a b)
+			   (apply v b (car rest) (cdr rest)))))))
+	    v)))
+
+(define >
+  (let ((primitive> (*value standard-env '>)))
+    (labels ((v (lambda (a b . rest)
+		  (if (null? rest)
+		      (primitive> a b)
+		      (and (primitive> a b)
+			   (apply v b (car rest) (cdr rest)))))))
+	    v)))
+
+(define <=
+  (let ((primitive<= (*value standard-env '<=)))
+    (labels ((v (lambda (a b . rest)
+		  (if (null? rest)
+		      (primitive<= a b)
+		      (and (primitive<= a b)
+			   (apply v b (car rest) (cdr rest)))))))
+	    v)))
+
+(define >=
+  (let ((primitive>= (*value standard-env '>=)))
+    (labels ((v (lambda (a b . rest)
+		  (if (null? rest)
+		      (primitive>= a b)
+		      (and (primitive>= a b)
+			   (apply v b (car rest) (cdr rest)))))))
+	    v)))
+
+(define =
+  (let ((primitive= (*value standard-env '=)))
+    (labels ((v (lambda (a b . rest)
+		  (if (null? rest)
+		      (primitive= a b)
+		      (and (primitive= a b)
+			   (apply v b (car rest) (cdr rest)))))))
+	    v)))
+
+(define gcd
+  (let ((prim (*value standard-env 'gcd)))
+    (labels ((v (lambda x
+		  (cond ((null? x) 0)
+			((= (length x) 1) (car x))
+			('#t (prim (car x) (apply v (cdr x))))))))
+	    v)))
+
+(define list? (*value standard-env 'proper-list?))
+
+(define program-arguments command-line)
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define output-port-width
+  (lambda x
+    (if (null? x) (line-length (standard-input))
+	(line-length (car x)))))
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (let ((port (current-output-port)))
+    (lambda () port)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam
+  (let ((cntr 100))
+    (lambda () (set! cntr (+ 1 cntr))
+	    (let ((tmp (string-append "slib_" (number->string cntr))))
+	      (if (file-exists? tmp) (tmpnam) tmp)))))
+
+(define delete-file file-delete)
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.
+(define char-code-limit 256)
+
+;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+;;; T already has it.
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval, SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+(define (slib:eval form) (eval form scheme-env))
+
+;;; If your implementation provides R4RS macros:
+;(define macro:eval slib:eval)
+;(define macro:load load)
+
+(define *defmacros*
+  (list (cons 'defmacro
+	      (lambda (name parms . body)
+		`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
+				      *defmacros*))))))
+(define (defmacro? m) (and (assq m *defmacros*) #t))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a) (set! a (assq a *defmacros*))
+				     (if a (apply (cdr a) (cdr e)) e))
+			(else e)))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a)
+			 (set! a (assq a *defmacros*))
+			 (if a (macroexpand (apply (cdr a) (cdr e))) e))
+			(else e)))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define base:eval slib:eval)
+(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+(define (defmacro:expand* x)
+  (require 'defmacroexpand) (apply defmacro:expand* x '()))
+
+(define (defmacro:load <pathname>)
+  (slib:eval-load <pathname> defmacro:eval))
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;;; define an error procedure for the library
+(define slib:error error)
+
+;;; define these as appropriate for your system.
+(define slib:tab #\tab)
+(define slib:form-feed #\form)
+
+;;; Define these if your implementation's syntax can support it and if
+;;; they are not already defined.
+
+;(define (1+ n) (+ n 1))
+(define (1- n) (+ n -1))
+;(define (-1+ n) (+ n -1))
+
+(define program-vicinity
+  (make-simple-switch 'program-vicinity
+		      (lambda (x) (or (string? x) (false? x)))
+		      '#f))
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:exit (lambda args (exit))
+
+(define (string . args) (apply string-append (map char->string args)))
+
+(define make-string
+  (let ((t:make-string (*value standard-env 'make-string)))
+    (lambda (a . b)
+      (let ((str (t:make-string a)))
+	(if b (map-string! (lambda (x) (ignore x) (car b)) str) str)))))
+
+(define (string>? a b)
+  (labels ((aux
+	    (lambda (n a b)
+	      ;;start off with n<=(string-length b) and n<=(string-length a)
+	      ;;a,b coincide for chars <n
+	      (cond ((= (string-length a) n) (< n (string-length b)))
+					;;now (< n (string-length a))
+		    ((= (string-length b) n) '#f)
+					;;now (< n (string-length a))
+		    ((char=? (nthchar a n) (nthchar b n) ) (aux (+ 1 n) a b))
+		    ('#t (char<? (nthchar b n) (nthchar a n)))))))
+    (aux 0 a b)))
+
+(define (string<? a b) (string>? b a))
+(define (string<=? a b) (not (string>? a b)))
+(define (string>=? a b) (not (string<? a b)))
+
+(define (string-ci<? a b)
+  (string<? (string-upcase a) (string-upcase b)))
+
+(define (string-ci>? a b)
+  (string>? (string-upcase a) (string-upcase b)))
+
+(define (string-ci<=? a b)
+  (string<=? (string-upcase a) (string-upcase b)))
+
+(define (string-ci>=? a b)
+  (string>=? (string-upcase a) (string-upcase b)))
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+;;; use this definition if your system doesn't have such a procedure.
+;;; T already has it, but requires 1 argument.
+
+(define force-output
+  (let ((t:force-output (*value standard-env 'force-output)))
+    (lambda x
+      (if x
+	  (t:force-output (car x))
+	  (t:force-output (current-output-port))))))
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+(define (call-with-output-string proc)
+  (with-output-to-string var (proc var)))
+
+(define (call-with-input-string string proc)
+  (with-input-from-string (variable string) (proc variable)))
+
+(define (string->number s . x)
+  (let ((base (if x (car x) 10))
+	(s (string-upcase s)))
+    (or (mem? = base '(8 10 16))
+	(error (format (current-error-port) "Bad radix ~A" base)))
+    (if (= (string-length s) 0) '()
+	(let ((char->number
+	       (lambda (ch)
+		 (cdr (ass char=? ch
+			   '((#\0 . 0)
+			     (#\1 . 1) (#\2 . 2) (#\3 . 3) (#\4 . 4)
+			     (#\5 . 5) (#\6 . 6) (#\7 . 7) (#\8 . 8)
+			     (#\9 . 9) (#\A . 10) (#\B . 11) (#\C . 12)
+			     (#\D . 13) (#\E . 14) (#\F . 15)))))))
+	  (catch not-num
+		 (iterate loop ((pos (- (string-length s) 1))
+				(power 1) (accum 0))
+			  (if (< pos 0) accum
+			      (let ((num (char->number (string-ref s pos))))
+				(or num (not-num '()))
+				(or  (< num base) (not-num '()))
+				(loop (- pos 1)
+				      (* power base)
+				      (+ accum (*  num power)))))))))))
+
+(define (number->string n . x)
+  (let ((rad (if (car x) (car x) 10)))
+    (format nil
+	    (case rad
+	      ((8) "~O")
+	      ((10) "~D")
+	      ((16) "~X")
+	      (else (error (format (current-error-port)
+				   "Bad radix ~A" (car x)))))
+	    n)))
+
+(define (inexact? f)
+  (float? f))
+
+(define (exact? f)
+  (not (inexact? f)))
+
+(define exact->inexact ->float)
+
+(define peek-char
+  (let ((t:peek-char (*value standard-env 'peek-char)))
+    (lambda p
+      (let ((port (if p (car p) (current-input-port))))
+	(t:peek-char port)))))
+
+;;;(set ((*value scheme-env 'standard-early-binding-env) 'load) '#f)
+;;;(set ((*value scheme-env 'standard-early-binding-env) 'substring) '#f)
+(set ((*value scheme-env 'standard-early-binding-env) 'less?) '#f)
+(set ((*value scheme-env 'standard-early-binding-env) 'greater?) '#f)
+(set ((*value scheme-env 'standard-early-binding-env) 'not-less?) '#f)
+(set ((*value scheme-env 'standard-early-binding-env) 'not-greater?) '#f)
+(set ((*value scheme-env 'standard-early-binding-env) 'number-equal?) '#f)
+(set ((*value scheme-internal-env 'standard-early-binding-env) 'list?) '#f)
+
+(set ((*value t-implementation-env 'SOURCE-FILE-EXTENSION)) 'scm)
+
+;;; Here for backward compatability
+(define (scheme-file-suffix) "")
+
+(define load
+  (let ((t:load (*value standard-env 'load)))
+    (lambda (filespec . x)
+      (apply t:load (->filename filespec) x))))
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+(define slib:load-source load)
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require") scheme-env)
+
+;;;(define scheme-read-table
+;;;  (make-read-table standard-read-table 'modified-read-table))
+;;;
+;;;(set (read-table-entry scheme-read-table '#\#)
+;;;     (lambda  (p ch rtable)
+;;;       (ignore ch) (ignore rtable)
+;;;       ((*value scheme-env 'string->number)
+;;;	(symbol->string (read-refusing-eof p)) 16)))
+;;;
+;;;(set (port-read-table (standard-input)) scheme-read-table)
+
+; eof
diff --git a/tek40.scm b/tek40.scm
new file mode 100644
index 0000000..f45a1fa
--- /dev/null
+++ b/tek40.scm
@@ -0,0 +1,92 @@
+;"tek40.scm", Tektronix 4000 series graphics support in Scheme.
+;Copyright (C) 1992, 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;THIS FILE NEEDS MORE WORK.
+
+;The Tektronix 4000 series graphics protocol gives the user a 1024 by
+;1024 square drawing area.  The origin is in the lower left corner of
+;the screen.  Increasing y is up and increasing x is to the right.
+
+;The graphics control codes are sent over the current-output-port and
+;can be mixed with regular text and ANSI or other terminal control
+;sequences.
+
+;  (tek40:init)						procedure
+
+(define (tek40:init) 'noop)
+
+(define esc-string (string (integer->char #o33)))
+
+(define tek40:graphics-str
+  (string-append
+   (string slib:form-feed)
+   esc-string  (string (integer->char #o14))
+   ;; clear the screen
+   ))
+
+(define (tek40:graphics) (display tek40:graphics-str) (force-output))
+
+(define (tek40:text)
+  (tek40:move 0 12)
+  (write-char (integer->char #o37)))
+
+(define (tek40:linetype linetype)
+  (cond ((or (negative? linetype) (> linetype 15))
+	 (slib:error "bad linetype" linetype))
+	(else
+	 (display esc-string)
+	 (write-char (integer->char (+ (char->integer #\`) linetype))))))
+
+(define (tek40:move x y)
+  (write-char (integer->char #o35))
+  (tek40:draw x y))
+
+(define (tek40:draw x y)
+  (display (string
+	    (integer->char (+ #x20 (quotient y 32)))
+	    (integer->char (+ #x60 (remainder y 32)))
+	    (integer->char (+ #x20 (quotient x 32)))
+	    (integer->char (+ #x40 (remainder x 32))))))
+
+(define (tek40:put-text x y str)
+  (tek40:move x (+ y -11))
+  (write-char (integer->char #o37))
+  (display str))
+
+(define (tek40:reset) (display tek40:graphics-str) (force-output))
+
+(define (tek40:test)
+  (tek40:init)
+;  (tek40:reset)
+  (tek40:graphics)
+  (tek40:linetype 0)
+  (tek40:move 100 100)
+  (tek40:draw 200 100)
+  (tek40:draw 200 200)
+  (tek40:draw 100 200)
+  (tek40:draw 100 100)
+  (do ((i 0 (+ 1 i)))
+      ((> i 15))
+    (tek40:linetype i)
+    (tek40:move (+ (* 50 i) 100) 100)
+    (tek40:put-text (+ (* 50 i) 100) 100 (number->string i))
+    (tek40:move (+ (* 50 i) 100) 100)
+    (tek40:draw (+ (* 50 i) 200) 200))
+  (tek40:linetype 0)
+  (tek40:text))
diff --git a/tek41.scm b/tek41.scm
new file mode 100644
index 0000000..988f8ea
--- /dev/null
+++ b/tek41.scm
@@ -0,0 +1,147 @@
+;"tek41.scm", Tektronix 4100 series graphics support in Scheme.
+;Copyright (C) 1992, 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;THIS FILE NEEDS MORE WORK.  Let me know if you test or fix it.
+
+;The graphics control codes are sent over the current-output-port and
+;can be mixed with regular text and ANSI or other terminal control
+;sequences.
+
+(define esc-string (string (integer->char #o33)))
+
+(define tek41:init
+  (string-append
+   esc-string "%!0"
+   ;;1. set tek mode
+   esc-string "MN0"
+   ;;2. set character path to 0 (characters placed equal to rotation)
+   esc-string "MCB7C;"
+   ;;3. set character size to 59 height
+   esc-string "MQ1"
+   ;;4. set character precision to string
+   esc-string "MT1"
+   ;;5. set character text index to 1
+   esc-string "MG1"
+   ;;6. set character write mode to overstrike
+   esc-string "RK!"
+   ;;7. clear the view
+   esc-string "SK!"
+   ;;8. clear the segments
+   esc-string "LZ"
+   ;;9. clear the dialog buffer
+   esc-string "%!1"
+   ;;10. set ansi mode
+   ))
+
+(define (tek41:init) (display tek41:init-str) (force-output))
+
+(define (tek41:reset)
+  (string-append
+   esc-string "%!0"
+   ;;1. set tek mode
+   esc-string "LZ"
+   ;;2. clear the dialog buffer
+   esc-string "%!1"
+   ;;3. set ansi mode
+   ))
+
+(define (tek41:reset) (display tek41:reset-str) (force-output))
+
+(define tek41:graphics-str
+  (string-append
+   esc-string  "%!0"
+   ;;1. set tek mode
+   esc-string  (string (integer->char #o14))
+   ;;2. clear the screen
+   esc-string  "LV0"
+   ;;3. set dialog area invisible
+   ))
+
+(define (tek41:graphics) (display tek41:graphics-str) (force-output))
+
+(define tek41:text-str
+  (string-append
+  esc-string  "LV1"
+  ;;1. set dialog area visible
+  esc-string  "%!1"
+  ;;2. set ansi mode
+  ))
+
+(define (tek41:text) (display tek41:text-str) (force-output))
+
+(define tek41:move-str
+  (string-append esc-string  "LF"))
+
+(define (tek41:move x y)
+  (display tek41:move-str)
+  (tek41:encode-x-y x y)
+  (force-output))
+
+(define tek41:draw-str
+  (string-append esc-string  "LG"))
+
+(define (tek41:draw x y)
+  (display tek41:draw-str)
+  (tek41:encode-x-y x y)
+  (force-output))
+
+(define tek41:set-marker-str (string-append esc-string "MM"))
+(define tek41:draw-marker-str (string-append esc-string "LH"))
+
+(define (tek41:point x y number)
+  (display tek41:set-marker-str)
+  (tek41:encode-int (remainder (max number 0) 11))
+  (display tek41:draw-marker-str)
+  (tek41:encode-x-y x y)
+  (force-output))
+
+(define (tek41:encode-x-y x y)
+  (let ((hix (+ (quotient x 128) 32))
+	(lox (+ (modulo (quotient x 4) 32) 64))
+	(hiy (+ (quotient y 128) 32))
+	(loy (+ (modulo (quotient y 4) 32) 96))
+	(eb (+ (* (modulo y 4) 4) (modulo x 4) 96)))
+    (if (positive? hiy) (write-char (integer->char hiy)))
+    (if (positive? eb) (write-char (integer->char eb)))
+    (if (positive? (+ loy eb hix)) (write-char (integer->char loy)))
+    (if (positive? hix) (write-char (integer->char hix)))
+    (write-char (integer->char lox))))
+
+(define (tek41:encode-int number)
+  (let* ((mag (abs number))
+	 (hi1 (+ (quotient mag 1024) 64))
+	 (hi2 (+ (modulo (quotient mag 16) 64) 64))
+	 (lo (+ (modulo mag 16) 32)))
+    (if (>= number 0) (set! lo (+ lo 16)))
+    (if (not (= hi1 64)) (write-char (integer->char hi1)))
+    (if (or (not (= hi2 64))
+	    (not (= hi1 64)))
+	(write-char (integer->char hi2)))
+    (write-char (integer->char lo))))
+
+(define (test)
+  (tek41:init)
+  (tek41:reset)
+  (tek41:graphics)
+  (do ((i 0 (+ 1 i)))
+      ((> i 15))
+    (tek41:linetype i)
+    (tek41:move (+ (* 200 i) 1000) 1000)
+    (tek41:draw (+ (* 200 i) 2000) 2000))
+  (tek41:text))
diff --git a/time.scm b/time.scm
new file mode 100644
index 0000000..7ddf524
--- /dev/null
+++ b/time.scm
@@ -0,0 +1,158 @@
+;;;; "time.scm" Posix time conversion routines
+;;; Copyright (C) 1994 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define time:daylight 0)
+(define *timezone* 0)
+(define time:tzname #("GMT" "GDT"))
+
+(define (time:tzset)
+  (set! time:daylight 1)
+  (set! *timezone* (* 5 60 60))
+  (set! time:tzname #("EST" "EDT")))
+
+;;; No, it doesn't do leap seconds.  If you want to add it, go ahead.
+
+;;; Returns the `struct tm' representation of T,
+;;; offset TM_GMTOFF seconds east of UCT.
+(define (time:split t tm_isdst tm_gmtoff tm_zone)
+  (set! t (difftime t tm_gmtoff))
+  (let* ((days-in-year (lambda (year)
+			 (if (and (zero? (remainder year 4))
+				  (or (not (zero? (remainder year 100)))
+				      (zero? (remainder year 400))))
+			     366 365)))
+	 (days/month #(#(31 28 31 30 31 30 31 31 30 31 30 31) ; Normal years.
+		       #(31 29 31 30 31 30 31 31 30 31 30 31))) ; Leap years.
+	 (SECS/HOUR (* 60 60))
+	 (SECS/DAY (* SECS/HOUR 24))
+	 (secs (modulo t SECS/DAY))
+	 (days (+ (quotient t SECS/DAY)
+		  (if (and (negative? t) (positive? secs)) -1 0))))
+    (let ((tm_hour (quotient secs SECS/HOUR))
+	  (secs (remainder secs SECS/HOUR))
+	  (tm_wday (modulo (+ 4 days) 7))) ; January 1, 1970 was a Thursday.
+      (let loop ((tm_year 1970)
+		 (tm_yday days))
+	(let ((diy (days-in-year tm_year)))
+	  (cond
+	   ((negative? tm_yday) (loop (+ -1 tm_year) (+ tm_yday diy)))
+	   ((>= tm_yday diy) (loop (+ 1 tm_year) (- tm_yday diy)))
+	   (else
+	    (let* ((mv (vector-ref days/month (- diy 365))))
+	      (do ((tm_mon 0 (+ 1 tm_mon))
+		   (tm_mday tm_yday (- tm_mday (vector-ref mv tm_mon))))
+		  ((< tm_mday (vector-ref mv tm_mon))
+		   (vector
+		    (remainder secs 60)	; Seconds.	[0-61] (2 leap seconds)
+		    (quotient secs 60)	; Minutes.	[0-59]
+		    tm_hour		; Hours.	[0-23]
+		    (+ tm_mday 1)	; Day.		[1-31]
+		    tm_mon		; Month.	[0-11]
+		    (- tm_year 1900)	; Year	- 1900.
+		    tm_wday		; Day of week.	[0-6]
+		    tm_yday		; Days in year. [0-365]
+		    tm_isdst		; DST.		[-1/0/1]
+		    tm_gmtoff		; Seconds west of UTC.
+		    tm_zone		; Timezone abbreviation.
+		    )))))))))))
+
+(define (time:gmtime t)
+  (time:split t 0 0 "GMT"))
+
+(define (time:localtime t)
+  (time:tzset)
+  (time:split t time:daylight *timezone*
+	      (vector-ref time:tzname time:daylight)))
+
+(define time:year-70
+  (let* ((t (current-time)))
+    (offset-time (offset-time t (- (difftime t 0))) (* -70 32140800))))
+
+(define (time:invert decoder target)
+  (let* ((times #(1 60 3600 86400 2678400 32140800))
+	 (trough			; rough time for target
+	  (do ((i 5 (+ i -1))
+	       (trough time:year-70
+		       (offset-time trough (* (vector-ref target i)
+					      (vector-ref times i)))))
+	      ((negative? i) trough))))
+;;;    (print 'trough trough 'target target)
+    (let loop ((guess trough)
+	       (j 0)
+	       (guess-tm (decoder trough)))
+;;;      (print 'guess guess 'guess-tm guess-tm)
+      (do ((i 5 (+ i -1))
+	   (rough time:year-70
+		  (offset-time rough (* (vector-ref guess-tm i)
+					(vector-ref times i))))
+	   (sign (let ((d (- (vector-ref target 5)
+			     (vector-ref guess-tm 5))))
+		   (and (not (zero? d)) d))
+		 (or sign
+		     (let ((d (- (vector-ref target i)
+				 (vector-ref guess-tm i))))
+		       (and (not (zero? d)) d)))))
+	  ((negative? i)
+	   (let* ((distance (abs (- trough rough))))
+	     (cond ((and (zero? distance) sign)
+;;;		    (print "trying to jump")
+		    (set! distance (if (negative? sign) -86400 86400)))
+		   ((and sign (negative? sign)) (set! distance (- distance))))
+	     (set! guess (offset-time guess distance))
+;;;	     (print 'distance distance 'sign sign)
+	     (cond ((zero? distance) guess)
+		   ((> j 5) #f)		;to prevent inf loops.
+		   (else
+		    (loop guess
+			  (+ 1 j)
+			  (decoder guess))))))))))
+
+(define (time:mktime time)
+  (time:tzset)
+  (time:invert localtime time))
+
+(define (time:asctime decoded)
+  (let ((days   #("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
+	(months #("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+			"Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
+	(number->2digits
+	 (lambda (n ch)
+	   (set! n (number->string n))
+	   (if (= 1 (string-length n))
+	       (string-append ch n)
+	       n))))
+    (string-append
+     (vector-ref days (vector-ref decoded 6)) " "
+     (vector-ref months (vector-ref decoded 4)) " "
+     (number->2digits (vector-ref decoded 3) " ") " "
+     (number->2digits (vector-ref decoded 2) "0") ":"
+     (number->2digits (vector-ref decoded 1) "0") ":"
+     (number->2digits (vector-ref decoded 0) "0") " "
+     (number->string (+ 1900 (vector-ref decoded 5)))
+     (string #\newline))))
+
+(define (time:ctime time)
+  (time:asctime (time:localtime time)))
+
+(define tzset time:tzset)
+(define gmtime time:gmtime)
+(define localtime time:localtime)
+(define mktime time:mktime)
+(define asctime time:asctime)
+(define ctime time:ctime)
diff --git a/trace.scm b/trace.scm
new file mode 100644
index 0000000..d595277
--- /dev/null
+++ b/trace.scm
@@ -0,0 +1,106 @@
+;;;; "trace.scm" Utility macros for tracing in Scheme.
+;;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'qp)				;for the qp printer.
+(define debug:indent 0)
+
+(define debug:tracef
+  (let ((null? null?)			;These bindings are so that
+	(not not)			;tracef will not trace parts
+	(car car) (cdr cdr)		;of itself.
+	(eq? eq?) (+ +) (zero? zero?) (modulo modulo)
+	(apply apply) (display display) (qpn qpn))
+    (lambda (function . optname)
+      (set! debug:indent 0)
+      (let ((name (if (null? optname) function (car optname))))
+	(lambda args
+	  (cond ((and (not (null? args))
+		      (eq? (car args) 'debug:untrace-object)
+		      (null? (cdr args)))
+		 function)
+		(else
+		 (do ((i debug:indent (+ -1 i))) ((zero? i)) (display #\ ))
+		 (apply qpn "CALLED" name args)
+		 (set! debug:indent (modulo (+ 1 debug:indent) 8))
+		 (let ((ans (apply function args)))
+		   (set! debug:indent (modulo (+ -1 debug:indent) 8))
+		   (do ((i debug:indent (+ -1 i))) ((zero? i)) (display #\ ))
+		   (qpn "RETURNED" name ans)
+		   ans))))))))
+
+;;; the reason I use a symbol for debug:untrace-object is so
+;;; that functions can still be untraced if this file is read in twice.
+
+(define (debug:untracef function)
+  (set! debug:indent 0)
+  (function 'debug:untrace-object))
+
+;;;;The trace: functions wrap around the debug: functions to provide
+;;; niceties like keeping track of traced functions and dealing with
+;;; redefinition.
+
+(require 'alist)
+(define trace:adder (alist-associator eq?))
+(define trace:deler (alist-remover eq?))
+
+(define *traced-procedures* '())
+(define (trace:tracef fun sym)
+  (cond ((not (procedure? fun))
+	 (display "WARNING: not a procedure " (current-error-port))
+	 (display sym (current-error-port))
+	 (newline (current-error-port))
+	 (set! *traced-procedures* (trace:deler *traced-procedures* sym))
+	 fun)
+	(else
+	 (let ((p (assq sym *traced-procedures*)))
+	   (cond ((and p (eq? (cdr p) fun))
+		  fun)
+		 (else
+		  (let ((tfun (debug:tracef fun sym)))
+		    (set! *traced-procedures*
+			  (trace:adder *traced-procedures* sym tfun))
+		    tfun)))))))
+
+(define (trace:untracef fun sym)
+  (let ((p (assq sym *traced-procedures*)))
+    (set! *traced-procedures* (trace:deler *traced-procedures* sym))
+    (cond ((not (procedure? fun)) fun)
+	  ((not p) fun)
+	  ((eq? (cdr p) fun)
+	   (debug:untracef fun))
+	  (else fun))))
+
+(define tracef debug:tracef)
+(define untracef debug:untracef)
+
+;;;; Finally, the macros trace and untrace
+
+(defmacro trace xs
+  (if (null? xs)
+      `(begin ,@(map (lambda (x) `(set! ,x (trace:tracef ,x ',x)))
+		     (map car *traced-procedures*))
+	      (map car *traced-procedures*))
+      `(begin ,@(map (lambda (x) `(set! ,x (trace:tracef ,x ',x))) xs))))
+(defmacro untrace xs
+  (if (null? xs)
+      (slib:eval
+       `(begin ,@(map (lambda (x) `(set! ,x (trace:untracef ,x ',x)))
+		      (map car *traced-procedures*))
+	       '',(map car *traced-procedures*)))
+      `(begin ,@(map (lambda (x) `(set! ,x (trace:untracef ,x ',x))) xs))))
diff --git a/tree.scm b/tree.scm
new file mode 100644
index 0000000..f400d1b
--- /dev/null
+++ b/tree.scm
@@ -0,0 +1,62 @@
+;;"tree.scm" Implementation of COMMON LISP tree functions for Scheme
+; Copyright 1993, 1994 David Love (d.love@dl.ac.uk)
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;; Deep copy of the tree -- new one has all new pairs.  (Called
+;; tree-copy in Dybvig.)
+(define (tree:copy-tree tree)
+  (if (pair? tree)
+      (cons (tree:copy-tree (car tree))
+	    (tree:copy-tree (cdr tree)))
+      tree))
+
+;; Substitute occurrences of old equal? to new in tree.
+;; Similar to tree walks in SICP without the internal define.
+(define (tree:subst new old tree)
+  (let walk ((tree tree))
+    (cond ((equal? old tree)
+	   new)
+	  ((pair? tree)
+	   (cons (walk (car tree))
+		 (walk (cdr tree))))
+	  (else tree))))
+
+;; The next 2 aren't in CL.  (Names from Dybvig)
+
+(define (tree:substq new old tree)
+  (let walk ((tree tree))
+    (cond ((eq? old tree)
+	   new)
+	  ((pair? tree)
+	   (cons (walk (car tree))
+		 (walk (cdr tree))))
+	  (else tree))))
+
+(define (tree:substv new old tree)
+  (let walk ((tree tree))
+    (cond ((eqv? old tree)
+	   new)
+	  ((pair? tree)
+	   (cons (walk (car tree))
+		 (walk (cdr tree))))
+	  (else tree))))
+
+(define copy-tree tree:copy-tree)
+(define subst tree:subst)
+(define substq tree:substq)
+(define substv tree:substv)
diff --git a/trnscrpt.scm b/trnscrpt.scm
new file mode 100644
index 0000000..45d884e
--- /dev/null
+++ b/trnscrpt.scm
@@ -0,0 +1,76 @@
+; "trnscrpt.scm", transcript functions for Scheme.
+; Copyright (c) 1992, 1993, 1995 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(define transcript:port #f)
+
+(define (transcript-on filename)
+  (set! transcript:port (open-output-file filename)))
+
+(define (transcript-off)
+  (if (output-port? transcript:port)
+      (close-output-port transcript:port))
+  (set! transcript:port #f))
+
+(define read-char
+  (let ((read-char read-char) (write-char write-char))
+    (lambda opt
+      (let ((ans (apply read-char opt)))
+	(cond ((eof-object? ans))
+	      ((output-port? transcript:port)
+	       (write-char ans transcript:port)))
+	ans))))
+
+(define read
+  (let ((read read) (write write) (newline newline))
+    (lambda opt
+      (let ((ans (apply read opt)))
+	(cond ((eof-object? ans))
+	      ((output-port? transcript:port)
+	       (write ans transcript:port)
+	       (if (eqv? #\newline (apply peek-char opt))
+		   (newline transcript:port))))
+	ans))))
+
+(define write-char
+  (let ((write-char write-char))
+    (lambda (obj . opt)
+      (apply write-char obj opt)
+      (if (output-port? transcript:port)
+	  (write-char obj transcript:port)))))
+
+(define write
+  (let ((write write))
+    (lambda (obj . opt)
+      (apply write obj opt)
+      (if (output-port? transcript:port)
+	  (write obj transcript:port)))))
+
+(define display
+  (let ((display display))
+    (lambda (obj . opt)
+      (apply display obj opt)
+      (if (output-port? transcript:port)
+	  (display obj transcript:port)))))
+
+(define newline
+  (let ((newline newline))
+    (lambda opt
+      (apply newline opt)
+      (if (output-port? transcript:port)
+	  (newline transcript:port)))))
diff --git a/tsort.scm b/tsort.scm
new file mode 100644
index 0000000..9371f3c
--- /dev/null
+++ b/tsort.scm
@@ -0,0 +1,46 @@
+;;; "tsort.scm" Topological sort
+;;; Copyright (C) 1995 Mikael Djurfeldt
+;
+; This code is in the public domain.
+
+;;; The algorithm is inspired by Cormen, Leiserson and Rivest (1990)
+;;; "Introduction to Algorithms", chapter 23
+
+(require 'hash-table)
+(require 'primes)
+
+(define (topological-sort dag pred)
+  (if (null? dag)
+      '()
+      (let* ((adj-table (make-hash-table
+			 (car (primes> (length dag) 1))))
+	     (insert (hash-associator pred))
+	     (lookup (hash-inquirer pred))
+	     (sorted '()))
+	(letrec ((visit
+		  (lambda (u adj-list)
+		    ;; Color vertex u
+		    (insert adj-table u 'colored)
+		    ;; Visit uncolored vertices which u connects to
+		    (for-each (lambda (v)
+				(let ((val (lookup adj-table v)))
+				  (if (not (eq? val 'colored))
+				      (visit v (or val '())))))
+			      adj-list)
+		    ;; Since all vertices downstream u are visited
+		    ;; by now, we can safely put u on the output list
+		    (set! sorted (cons u sorted)))))
+	  ;; Hash adjacency lists
+	  (for-each (lambda (def)
+		      (insert adj-table (car def) (cdr def)))
+		    (cdr dag))
+	  ;; Visit vertices
+	  (visit (caar dag) (cdar dag))
+	  (for-each (lambda (def)
+		      (let ((val (lookup adj-table (car def))))
+			(if (not (eq? val 'colored))
+			    (visit (car def) (cdr def)))))
+		    (cdr dag)))
+	sorted)))
+
+(define tsort topological-sort)
diff --git a/values.scm b/values.scm
new file mode 100644
index 0000000..b47e0f8
--- /dev/null
+++ b/values.scm
@@ -0,0 +1,27 @@
+;"values.scm" multiple values
+;By david carlton, carlton@husc.harvard.edu.
+;
+;This code is in the public domain.
+
+(require 'record)
+
+(define values:*values-rtd*
+  (make-record-type "values"
+		    '(values)))
+
+(define values
+  (let ((make-values (record-constructor values:*values-rtd*)))
+    (lambda x
+      (if (and (not (null? x))
+	       (null? (cdr x)))
+	  (car x)
+	  (make-values x)))))
+
+(define call-with-values
+  (let ((access-values (record-accessor values:*values-rtd* 'values))
+	(values-predicate? (record-predicate values:*values-rtd*)))
+    (lambda (producer consumer)
+      (let ((result (producer)))
+	(if (values-predicate? result)
+	    (apply consumer (access-values result))
+	    (consumer result))))))
diff --git a/vscm.init b/vscm.init
new file mode 100644
index 0000000..7d4661b
--- /dev/null
+++ b/vscm.init
@@ -0,0 +1,306 @@
+;;;"vscm.init" Configuration of *features* for VSCM	-*-scheme-*-
+;Copyright (C) 1994 Aubrey Jaffer
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; From: Matthias Blume <blume@cs.Princeton.EDU>
+;;; Date: Tue, 1 Mar 1994 11:42:31 -0500
+;;; Disclaimer: The code below is only a quick hack.  If I find some
+;;; time to spare I might get around to make some more things work.
+;;; In particular, string ports could be made available without too
+;;; much trouble.
+
+;;; You have to provide ``vscm.init'' as an explicit command line
+;;; argument.  Since this is not very nice I would recommend the
+;;; following installation procedure:
+
+;1. run scheme
+;2. (load "vscm.init")
+;3. (slib:dump "dumpfile")
+;3. mv dumpfile place-where-vscm-standard-bootfile-resides, e.g.
+;   mv dumpfile /usr/local/vscm/lib/scheme-boot
+;   (In this case vscm should have been compiled with flag
+;    -DDEFAULT_BOOTFILE='"/usr/local/vscm/lib/scheme-boot"'.  See
+;    Makefile (definition of DDP) for details.)
+
+(define (slib:dump dump-to-file)
+  (let ((args (dump dump-to-file)))
+    (if args
+	(begin
+	  (display "[SLIB available]")
+	  (newline)
+	  (((mcm) 'toplevel) args))
+	(quit))))
+
+;;; Caveat: While playing with this code I discovered a nasty bug.
+;;; (Something is wrong with my ``restore'' code -- it seems to break
+;;; on 64 bit machines (not always, though).)  It works on MIPS, etc.
+
+;;; (software-type) should be set to the generic operating system type.
+;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
+
+(define (software-type) 'UNIX)
+
+;;; (scheme-implementation-type) should return the name of the scheme
+;;; implementation loading this file.
+
+(define (scheme-implementation-type) 'Vscm)
+
+;;; (scheme-implementation-version) should return a string describing the
+;;; version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "?")
+
+;;; (implementation-vicinity) should be defined to be the pathname of
+;;; the directory where any auxillary files to your Scheme
+;;; implementation reside.
+
+(define (implementation-vicinity)
+  (case (software-type)
+    ((UNIX)	 "/usr/local/src/scheme/")
+    ((VMS)	"scheme$src:")
+    ((MS-DOS)	"C:\\scheme\\")))
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+(define library-vicinity
+  (let ((library-path
+	 (or (getenv "SCHEME_LIBRARY_PATH")
+	     ;; Uses this path if SCHEME_LIBRARY_PATH is not set.
+	     (case (software-type)
+	       ((UNIX) "/usr/local/lib/slib/")
+	       ((VMS) "lib$scheme:")
+	       ((MS-DOS) "C:\\SLIB\\")
+	       (else "")))))
+    (lambda () library-path)))
+
+;;; *FEATURES* should be set to a list of symbols describing features
+;;; of this implementation.  Suggestions for features are:
+
+(define *features*
+      '(
+	source				;can load scheme source files
+					;(slib:load-source "filename")
+;	compiled			;can load compiled files
+					;(slib:load-compiled "filename")
+	rev4-report			;conforms to
+;	rev3-report			;conforms to
+	ieee-p1178			;conforms to
+;	sicp				;runs code from Structure and
+					;Interpretation of Computer
+					;Programs by Abelson and Sussman.
+	rev4-optional-procedures	;LIST-TAIL, STRING->LIST,
+					;LIST->STRING, STRING-COPY,
+					;STRING-FILL!, LIST->VECTOR,
+					;VECTOR->LIST, and VECTOR-FILL!
+	rev3-procedures			;LAST-PAIR, T, and NIL
+;	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
+					;SUBSTRING-MOVE-RIGHT!,
+					;SUBSTRING-FILL!,
+					;STRING-NULL?, APPEND!, 1+,
+					;-1+, <?, <=?, =?, >?, >=?
+	multiarg/and-			;/ and - can take more than 2 args.
+	multiarg-apply			;APPLY can take more than 2 args.
+	rationalize
+	delay				;has DELAY and FORCE
+	with-file			;has WITH-INPUT-FROM-FILE and
+					;WITH-OUTPUT-FROM-FILE
+;	string-port			;has CALL-WITH-INPUT-STRING and
+					;CALL-WITH-OUTPUT-STRING
+;	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
+;	char-ready?
+;	macro				;has R4RS high level macros
+;	defmacro			;has Common Lisp DEFMACRO
+	eval				;SLIB:EVAL is single argument eval
+;	record				;has user defined data structures
+	values				;proposed multiple values
+;	dynamic-wind			;proposed dynamic-wind
+	ieee-floating-point		;conforms to
+	full-continuation		;can return multiple times
+;	object-hash			;has OBJECT-HASH
+
+;	sort
+;	queue				;queues
+;	pretty-print
+	object->string
+;	format
+;	trace				;has macros: TRACE and UNTRACE
+;	compiler			;has (COMPILER)
+;	ed				;(ED) is editor
+	system				;posix (system <string>)
+	getenv				;posix (getenv <string>)
+	program-arguments		;returns list of strings (argv)
+;	Xwindows			;X support
+;	curses				;screen management package
+;	termcap				;terminal description package
+;	terminfo			;sysV terminal description
+	))
+
+;;; (OBJECT->STRING obj)  -- analogous to WRITE
+(define object->string string-write)
+
+;;; (PROGRAM-ARGUMENTS)
+;;; 
+(define (program-arguments) command-line-arguments)
+
+;;; (OUTPUT-PORT-WIDTH <port>)
+(define (output-port-width . arg) 79)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+  (standard-port 2))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam (let ((cntr 100))
+		 (lambda () (set! cntr (+ 1 cntr))
+			 (string-append "slib_" (number->string cntr)))))
+
+;;; (FILE-EXISTS? <string>)
+(define (file-exists? f)
+  (system (string-append "test -f " f)))
+
+;;; (DELETE-FILE <string>)
+(define (delete-file f)
+  (remove-file f))
+
+;;; FORCE-OUTPUT flushes any pending output on optional arg output port
+(define force-output flush)
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+
+;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
+;;; be returned by CHAR->INTEGER.
+(define char-code-limit 256)
+
+;;; MOST-POSITIVE-FIXNUM is used in modular.scm
+(define most-positive-fixnum #x0fffffff)
+
+;;; Return argument
+(define (identity x) x)
+
+;;; If your implementation provides eval SLIB:EVAL is single argument
+;;; eval using the top-level (user) environment.
+(define slib:eval eval)
+
+;;; If your implementation provides R4RS macros:
+(define macro:eval slib:eval)
+(define macro:load load)
+
+(define *defmacros*
+  (list (cons 'defmacro
+	      (lambda (name parms . body)
+		`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
+				      *defmacros*))))))
+(define (defmacro? m) (and (assq m *defmacros*) #t))
+
+(define (macroexpand-1 e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a) (set! a (assq a *defmacros*))
+				     (if a (apply (cdr a) (cdr e)) e))
+			(else e)))
+      e))
+
+(define (macroexpand e)
+  (if (pair? e) (let ((a (car e)))
+		  (cond ((symbol? a)
+			 (set! a (assq a *defmacros*))
+			 (if a (macroexpand (apply (cdr a) (cdr e))) e))
+			(else e)))
+      e))
+
+(define gentemp
+  (let ((*gensym-counter* -1))
+    (lambda ()
+      (set! *gensym-counter* (+ *gensym-counter* 1))
+      (string->symbol
+       (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define base:eval slib:eval)
+(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+(define (defmacro:expand* x)
+  (require 'defmacroexpand) (apply defmacro:expand* x '()))
+
+(define (defmacro:load <pathname>)
+  (slib:eval-load <pathname> defmacro:eval))
+
+(define (slib:eval-load <pathname> evl)
+  (if (not (file-exists? <pathname>))
+      (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+  (call-with-input-file <pathname>
+    (lambda (port)
+      (let ((old-load-pathname *load-pathname*))
+	(set! *load-pathname* <pathname>)
+	(do ((o (read port) (read port)))
+	    ((eof-object? o))
+	  (evl o))
+	(set! *load-pathname* old-load-pathname)))))
+
+;;; define an error procedure for the library
+(define slib:error error)
+
+;;; define these as appropriate for your system.
+(define slib:tab #\Tab)
+(define slib:form-feed #\d12)
+
+;;; Support for older versions of Scheme.  Not enough code for its own file.
+(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l))
+(define t #t)
+(define nil #f)
+
+;;; Define these if your implementation's syntax can support it and if
+;;; they are not already defined.
+
+(define (1+ n) (+ n 1))
+(define (-1+ n) (+ n -1))
+(define 1- -1+)
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:exit
+  (lambda args
+    (cond ((null? args) (quit))
+	  ((eqv? #t (car args)) (quit))
+	  ((eqv? #f (car args)) (quit 1))
+	  (else (quit (car args))))))
+
+;;; Here for backward compatability
+(define scheme-file-suffix
+  (let ((suffix (case (software-type)
+		  ((NOSVE) "_scm")
+		  (else ".scm"))))
+    (lambda () suffix)))
+
+;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
+;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
+
+(define (slib:load-source f) (load (string-append f (scheme-file-suffix))))
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/withfile.scm b/withfile.scm
new file mode 100644
index 0000000..fc13510
--- /dev/null
+++ b/withfile.scm
@@ -0,0 +1,82 @@
+; "withfile.scm", with-input-from-file and with-output-to-file for Scheme
+; Copyright (c) 1992, 1993 Aubrey Jaffer
+;;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1.  Any copy made of this software must include this copyright notice
+;in full.
+;
+;2.  I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3.  In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+(require 'dynamic-wind)
+
+(define withfile:current-input (current-input-port))
+(define withfile:current-output (current-output-port))
+
+(define (current-input-port) withfile:current-input)
+(define (current-output-port) withfile:current-output)
+
+(define (with-input-from-file file thunk)
+  (define oport withfile:current-input)
+  (define port (open-input-file file))
+  (dynamic-wind (lambda () (set! oport withfile:current-input)
+			   (set! withfile:current-input port))
+		(lambda() (let ((ans (thunk))) (close-input-port port) ans))
+		(lambda() (set! withfile:current-input oport))))
+
+(define (with-output-from-file file thunk)
+  (define oport withfile:current-output)
+  (define port (open-output-file file))
+  (dynamic-wind (lambda() (set! oport withfile:current-output)
+		          (set! withfile:current-output port))
+		(lambda() (let ((ans (thunk))) (close-output-port port) ans))
+		(lambda() (set! withfile:current-output oport))))
+
+(define peek-char
+  (let ((peek-char peek-char))
+    (lambda opt
+      (peek-char (if (null? opt) withfile:current-input (car opt))))))
+
+(define read-char
+  (let ((read-char read-char))
+    (lambda opt
+      (read-char (if (null? opt) withfile:current-input (car opt))))))
+
+(define read
+  (let ((read read))
+    (lambda opt
+      (read (if (null? opt) withfile:current-input (car opt))))))
+
+(define write-char
+  (let ((write-char write-char))
+    (lambda (obj . opt)
+      (write-char obj (if (null? opt) withfile:current-output (car opt))))))
+
+(define write
+  (let ((write write))
+    (lambda (obj . opt)
+      (write obj (if (null? opt) withfile:current-output (car opt))))))
+
+(define display
+  (let ((display display))
+    (lambda (obj . opt)
+      (display obj (if (null? opt) withfile:current-output (car opt))))))
+
+(define newline
+  (let ((newline newline))
+    (lambda opt
+      (newline (if (null? opt) withfile:current-output (car opt))))))
+
+(define force-output
+  (let ((force-output force-output))
+    (lambda opt
+      (force-output (if (null? opt) withfile:current-output (car opt))))))
diff --git a/wttest.scm b/wttest.scm
new file mode 100644
index 0000000..cc8b5e3
--- /dev/null
+++ b/wttest.scm
@@ -0,0 +1,134 @@
+;;  "wttrtst.scm" Test Weight balanced trees		-*-Scheme-*-
+;;  Copyright (c) 1993-1994 Stephen Adams
+;;
+;;  Copyright (c) 1993-94 Massachusetts Institute of Technology
+;;
+;;  This material was developed by the Scheme project at the Massachusetts
+;;  Institute of Technology, Department of Electrical Engineering and
+;;  Computer Science.  Permission to copy this software, to redistribute
+;;  it, and to use it for any purpose is granted, subject to the following
+;;  restrictions and understandings.
+;;
+;;  1. Any copy made of this software must include this copyright notice
+;;  in full.
+;;
+;;  2. Users of this software agree to make their best efforts (a) to
+;;  return to the MIT Scheme project any improvements or extensions that
+;;  they make, so that these may be included in future releases; and (b)
+;;  to inform MIT of noteworthy uses of this software.
+;;
+;;  3. All materials developed as a consequence of the use of this
+;;  software shall duly acknowledge such use, in accordance with the usual
+;;  standards of acknowledging credit in academic research.
+;;
+;;  4. MIT has made no warrantee or representation that the operation of
+;;  this software will be error-free, and MIT is under no obligation to
+;;  provide any services, by way of maintenance, update, or otherwise.
+;;
+;;  5. In conjunction with products arising from the use of this material,
+;;  there shall be no use of the name of the Massachusetts Institute of
+;;  Technology nor of any adaptation thereof in any advertising,
+;;  promotional, or sales literature without prior written consent from
+;;  MIT in each case.
+
+(require 'wt-tree)
+
+;;  Test code, using maps from digit strings to the numbers they represent.
+
+(define (wt-test)
+
+  (define (make-map lo hi step)
+    (let loop ((i lo) (map (make-wt-tree string-wt-type)))
+      (if (> i hi)
+          map
+          (loop (+ i step) (wt-tree/add map (number->string i) i)))))
+
+  (define (wt-tree->alist t)
+    (wt-tree/fold (lambda (key datum rest) (cons (cons key datum) rest)) '() t))
+
+  (define (try-all operation trees)
+    (map (lambda (t1)
+           (map (lambda (t2)
+                  (operation t1 t2))
+                trees))
+         trees))
+
+  (define (chunk tree)
+    (let ((size  (wt-tree/size tree)))
+      (if (< size 8)
+          size
+          (let* ((midpoint (if (even? size)
+                               (/ size 2)
+                               (/ (+ size 1) 2)))
+                 (fulcrum  (wt-tree/index tree midpoint)))
+            (list (chunk (wt-tree/split< tree fulcrum))
+                  (list fulcrum)
+                  (chunk (wt-tree/split> tree fulcrum)))))))
+
+  (define (verify name result expected)
+    (newline)
+    (display "Test ") (display name)
+    (if (equal? result expected)
+        (begin
+          (display " passed"))
+        (begin
+          (display " unexpected result")
+          (newline)
+          (display "Expected: " expected)
+          (newline)
+          (display "Got:      " result))))
+
+  (let ((t1 (make-map 0 99 2))          ; 0,2,4,...,98
+        (t2 (make-map 1 100 2))         ; 1,3,5,...,99
+        (t3 (make-map 0 100 3)))        ; 0,3,6,...,99
+
+
+    (verify 'alist (wt-tree->alist t3)  ;
+            '(("0" . 0) ("12" . 12) ("15" . 15) ("18" . 18) ("21" . 21)
+              ("24" . 24) ("27" . 27) ("3" . 3) ("30" . 30) ("33" . 33)
+              ("36" . 36) ("39" . 39) ("42" . 42) ("45" . 45) ("48" . 48)
+              ("51" . 51) ("54" . 54) ("57" . 57) ("6" . 6) ("60" . 60)
+              ("63" . 63) ("66" . 66) ("69" . 69) ("72" . 72) ("75" . 75)
+              ("78" . 78) ("81" . 81) ("84" . 84) ("87" . 87) ("9" . 9)
+              ("90" . 90) ("93" . 93) ("96" . 96) ("99" . 99)))
+
+
+    (verify 'union-sizes
+            (try-all (lambda (t1 t2) (wt-tree/size (wt-tree/union t1 t2)))
+                     (list t1 t2 t3))
+            '((50 100 67) (100 50 67) (67 67 34)))
+
+    (verify 'difference-sizes
+            (try-all (lambda (t1 t2)
+                       (wt-tree/size (wt-tree/difference t1 t2)))
+                     (list t1 t2 t3))
+            '((0 50 33) (50 0 33) (17 17 0)))
+
+    (verify 'intersection-sizes
+            (try-all (lambda (t1 t2)
+                       (wt-tree/size (wt-tree/intersection t1 t2)))
+                     (list t1 t2 t3))
+            '((50 0 17) (0 50 17) (17 17 34)))
+
+    (verify 'equalities
+            (try-all (lambda (t1 t2)
+                       (wt-tree/set-equal? (wt-tree/difference t1 t2)
+                                           (wt-tree/difference t2 t1)))
+                     (list t1 t2 t3))
+            '((#t #f #f) (#f #t #f) (#f #f #t)))
+
+    (verify 'indexing
+            (chunk (make-map 0 99 1))
+            '((((7 ("15") 5) ("20") (6 ("27") 4)) ("31")
+               ((6 ("38") 5) ("43") (6 ("5") 4)))
+              ("54")
+              (((7 ("61") 5) ("67") (6 ("73") 4)) ("78")
+               ((6 ("84") 5) ("9") (5 ("95") 4)))))
+    (newline)))
+
+(wt-test)
+
+;;; Local Variables:
+;;; eval: (put 'with-n-node 'scheme-indent-function 1)
+;;; eval: (put 'with-n-node 'scheme-indent-hook 1)
+;;; End:
diff --git a/wttree.scm b/wttree.scm
new file mode 100644
index 0000000..467aa86
--- /dev/null
+++ b/wttree.scm
@@ -0,0 +1,784 @@
+;;  "wttree.scm" Weight balanced trees			-*-Scheme-*-
+;;  Copyright (c) 1993-1994 Stephen Adams
+;;
+;;  $Id: wttree.scm,v 1.1 1994/11/28 21:58:48 adams Exp adams $
+;;
+;;  References:
+;;
+;;    Stephen Adams, Implemeting Sets Efficiently in a Functional
+;;       Language, CSTR 92-10, Department of Electronics and Computer
+;;       Science, University of Southampton, 1992
+;;
+;;
+;;  Copyright (c) 1993-94 Massachusetts Institute of Technology
+;;
+;;  This material was developed by the Scheme project at the Massachusetts
+;;  Institute of Technology, Department of Electrical Engineering and
+;;  Computer Science.  Permission to copy this software, to redistribute
+;;  it, and to use it for any purpose is granted, subject to the following
+;;  restrictions and understandings.
+;;
+;;  1. Any copy made of this software must include this copyright notice
+;;  in full.
+;;
+;;  2. Users of this software agree to make their best efforts (a) to
+;;  return to the MIT Scheme project any improvements or extensions that
+;;  they make, so that these may be included in future releases; and (b)
+;;  to inform MIT of noteworthy uses of this software.
+;;
+;;  3. All materials developed as a consequence of the use of this
+;;  software shall duly acknowledge such use, in accordance with the usual
+;;  standards of acknowledging credit in academic research.
+;;
+;;  4. MIT has made no warrantee or representation that the operation of
+;;  this software will be error-free, and MIT is under no obligation to
+;;  provide any services, by way of maintenance, update, or otherwise.
+;;
+;;  5. In conjunction with products arising from the use of this material,
+;;  there shall be no use of the name of the Massachusetts Institute of
+;;  Technology nor of any adaptation thereof in any advertising,
+;;  promotional, or sales literature without prior written consent from
+;;  MIT in each case.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;  Weight Balanced Binary Trees
+;;
+;;  
+;;
+;;  This file has been modified from the MIT-Scheme library version to
+;;  make it more standard. The main changes are
+;;
+;;   . The whole thing has been put in a LET as R4RS Scheme has no module
+;;     system.
+;;   . The MIT-Scheme define structure operations have been written out by
+;;     hand.
+;;
+;;  It has been tested on MIT-Scheme, scheme48 and scm4e1
+;;
+;;  Non-standard procedures:
+;;    error
+;;    error:wrong-type-argument
+;;    error:band-range-argument
+;;  These are only called when there is an error so it is not critical to
+;;  have them defined :-)
+;;
+;;
+;;  If your system has a compiler and you want this code to run fast, you
+;;  should do whatever is necessary to inline all of the structure accessors.
+;;
+;;  This is MIT-Scheme's way of saying that +, car etc should all be inlined.
+;;
+;;(declare (usual-integrations))
+
+
+;;;
+;;; Interface to this package.
+;;;
+;;; ONLY these procedures (and TEST at the end of the file) will be
+;;; (re)defined in your system.
+;;;
+
+(define make-wt-tree-type #f)
+(define number-wt-type #f)
+(define string-wt-type #f)
+
+(define make-wt-tree #f)
+(define singleton-wt-tree #f)
+(define alist->wt-tree #f)
+(define wt-tree/empty? #f)
+(define wt-tree/size #f)
+(define wt-tree/add #f)
+(define wt-tree/delete #f)
+(define wt-tree/add! #f)
+(define wt-tree/delete! #f)
+(define wt-tree/member? #f)
+(define wt-tree/lookup #f)
+(define wt-tree/split< #f)
+(define wt-tree/split> #f)
+(define wt-tree/union #f)
+(define wt-tree/intersection #f)
+(define wt-tree/difference #f)
+(define wt-tree/subset? #f)
+(define wt-tree/set-equal? #f)
+(define wt-tree/fold #f)
+(define wt-tree/for-each #f)
+(define wt-tree/index #f)
+(define wt-tree/index-datum #f)
+(define wt-tree/index-pair #f)
+(define wt-tree/rank #f)
+(define wt-tree/min #f)
+(define wt-tree/min-datum #f)
+(define wt-tree/min-pair #f)
+(define wt-tree/delete-min #f)
+(define wt-tree/delete-min! #f)
+
+
+;; This LET sets all of the above variables.
+
+(let ()
+
+  ;; We use the folowing MIT-Scheme operation on fixnums (small
+  ;; integers).  R4RS compatible (but less efficient) definitions.
+  ;; You should replace these with something that is efficient in your
+  ;; system.
+
+  (define fix:fixnum? (lambda (x) (and (exact? x) (integer? x))))
+  (define fix:+ +)
+  (define fix:- -)
+  (define fix:< <)
+  (define fix:<= <)
+  (define fix:> >)
+  (define fix:* *)
+
+  ;;  A TREE-TYPE is a collection of those procedures that depend on the
+  ;;  ordering relation.
+
+  ;; MIT-Scheme structure definition
+  ;;(define-structure
+  ;;    (tree-type
+  ;;     (conc-name tree-type/)
+  ;;     (constructor %make-tree-type))
+  ;;  (key<?       #F read-only true)
+  ;;  (alist->tree #F read-only true)
+  ;;  (add         #F read-only true)
+  ;;  (insert!     #F read-only true)
+  ;;  (delete      #F read-only true)
+  ;;  (delete!     #F read-only true)
+  ;;  (member?     #F read-only true)
+  ;;  (lookup      #F read-only true)
+  ;;  (split-lt    #F read-only true)
+  ;;  (split-gt    #F read-only true)
+  ;;  (union       #F read-only true)
+  ;;  (intersection #F read-only true)
+  ;;  (difference  #F read-only true)
+  ;;  (subset?     #F read-only true)
+  ;;  (rank        #F read-only true)
+  ;;)
+
+  ;; Written out by hand, using vectors:
+  ;;
+  ;; If possible, you should teach your system to print out something
+  ;; like #[tree-type <] instread of the whole vector.
+
+  (define tag:tree-type (string->symbol "#[(runtime wttree)tree-type]"))
+
+  (define (%make-tree-type key<?       alist->tree 
+                           add         insert!     
+                           delete      delete!     
+                           member?     lookup      
+                           split-lt    split-gt    
+                           union       intersection 
+                           difference  subset?     
+                           rank        )
+    (vector tag:tree-type
+            key<?       alist->tree   add         insert!     
+            delete      delete!       member?     lookup      
+            split-lt    split-gt      union       intersection 
+            difference  subset?       rank        ))
+
+  (define (tree-type? tt)
+    (and (vector? tt)
+         (eq? (vector-ref tt 0) tag:tree-type)))
+
+  (define (tree-type/key<?        tt) (vector-ref tt 1))
+  (define (tree-type/alist->tree  tt) (vector-ref tt 2))
+  (define (tree-type/add          tt) (vector-ref tt 3))
+  (define (tree-type/insert!      tt) (vector-ref tt 4))
+  (define (tree-type/delete       tt) (vector-ref tt 5))
+  (define (tree-type/delete!      tt) (vector-ref tt 6))
+  (define (tree-type/member?      tt) (vector-ref tt 7))
+  (define (tree-type/lookup       tt) (vector-ref tt 8))
+  (define (tree-type/split-lt     tt) (vector-ref tt 9))
+  (define (tree-type/split-gt     tt) (vector-ref tt 10))
+  (define (tree-type/union        tt) (vector-ref tt 11))
+  (define (tree-type/intersection tt) (vector-ref tt 12))
+  (define (tree-type/difference   tt) (vector-ref tt 13))
+  (define (tree-type/subset?      tt) (vector-ref tt 14))
+  (define (tree-type/rank         tt) (vector-ref tt 15))
+
+  ;;  User level tree representation.
+  ;;
+  ;;  WT-TREE is a wrapper for trees of nodes.
+  ;;
+  ;;MIT-Scheme:
+  ;;(define-structure
+  ;;    (wt-tree
+  ;;     (conc-name tree/)
+  ;;     (constructor %make-wt-tree))
+  ;;  (type  #F read-only true)
+  ;;  (root  #F read-only false))
+
+  ;; If possible, you should teach your system to print out something
+  ;; like #[wt-tree] instread of the whole vector.
+
+  (define tag:wt-tree (string->symbol "#[(runtime wttree)wt-tree]"))
+
+  (define (%make-wt-tree type root)
+    (vector tag:wt-tree type root))
+
+  (define (wt-tree? t)
+    (and (vector? t)
+         (eq? (vector-ref t 0) tag:wt-tree)))
+
+  (define (tree/type t) (vector-ref t 1))
+  (define (tree/root t) (vector-ref t 2))
+  (define (set-tree/root! t v) (vector-set! t 2 v))
+
+  ;;  Nodes are the thing from which the real trees are built.  There are
+  ;;  lots of these and the uninquisitibe user will never see them, so
+  ;;  they are represented as untagged to save the slot that would be
+  ;;  used for tagging structures.
+  ;;  In MIT-Scheme these were all DEFINE-INTEGRABLE
+
+  (define (make-node k v l r w) (vector w l k r v))
+  (define (node/k node) (vector-ref node 2))
+  (define (node/v node) (vector-ref node 4))
+  (define (node/l node) (vector-ref node 1))
+  (define (node/r node) (vector-ref node 3))
+  (define (node/w node) (vector-ref node 0))
+
+  (define empty  'empty)
+  (define (empty? x) (eq? x 'empty))
+
+  (define (node/size node)
+    (if (empty? node) 0  (node/w node)))
+
+  (define (node/singleton k v) (make-node k v empty empty 1))
+
+  (define (with-n-node node receiver)
+    (receiver (node/k node) (node/v node) (node/l node) (node/r node)))
+
+  ;;
+  ;;  Constructors for building node trees of various complexity
+  ;;
+
+  (define (n-join k v l r)
+    (make-node k v l r (fix:+ 1 (fix:+ (node/size l) (node/size r)))))
+
+  (define (single-l a.k a.v x r)
+    (with-n-node r
+      (lambda (b.k b.v y z) (n-join b.k b.v (n-join a.k a.v x y) z))))
+
+  (define (double-l a.k a.v x r)
+    (with-n-node r
+      (lambda (c.k c.v r.l z)
+        (with-n-node r.l
+          (lambda (b.k b.v y1 y2)
+            (n-join b.k b.v
+                    (n-join a.k a.v x y1)
+                    (n-join c.k c.v y2 z)))))))
+
+  (define (single-r b.k b.v l z)
+    (with-n-node l
+      (lambda (a.k a.v x y) (n-join a.k a.v x (n-join b.k b.v y z)))))
+
+  (define (double-r c.k c.v l z)
+    (with-n-node l
+      (lambda (a.k a.v x l.r)
+        (with-n-node l.r
+          (lambda (b.k b.v y1 y2)
+            (n-join b.k b.v
+                    (n-join a.k a.v x y1)
+                    (n-join c.k c.v y2 z)))))))
+
+  ;; (define-integrable wt-tree-ratio 5)
+  (define wt-tree-ratio 5)
+
+  (define (t-join k v l r)
+    (define (simple-join) (n-join k v l r))
+    (let ((l.n  (node/size l))
+          (r.n  (node/size r)))
+      (cond ((fix:< (fix:+ l.n r.n) 2)   (simple-join))
+            ((fix:> r.n (fix:* wt-tree-ratio l.n))
+             ;; right is too big
+             (let ((r.l.n  (node/size (node/l r)))
+                   (r.r.n  (node/size (node/r r))))
+               (if (fix:< r.l.n r.r.n)
+                   (single-l k v l r)
+                   (double-l k v l r))))
+            ((fix:> l.n (fix:* wt-tree-ratio r.n))
+             ;; left is too big
+             (let ((l.l.n  (node/size (node/l l)))
+                   (l.r.n  (node/size (node/r l))))
+               (if (fix:< l.r.n l.l.n)
+                   (single-r k v l r)
+                   (double-r k v l r))))
+            (else
+             (simple-join)))))
+  ;;
+  ;;  Node tree procedures that are independent of key<?
+  ;;
+
+  (define (node/min node)
+    (cond  ((empty? node)          (error:empty 'min))
+           ((empty? (node/l node)) node)
+           (else                   (node/min (node/l node)))))
+
+  (define (node/delmin node)
+    (cond ((empty? node)           (error:empty 'delmin))
+          ((empty? (node/l node))  (node/r node))
+          (else   (t-join (node/k node) (node/v node)
+                          (node/delmin (node/l node)) (node/r node)))))
+
+  (define (node/concat2 node1 node2)
+    (cond ((empty? node1)   node2)
+          ((empty? node2)   node1)
+          (else
+           (let ((min-node (node/min node2)))
+             (t-join (node/k min-node) (node/v min-node)
+                     node1 (node/delmin node2))))))
+
+  (define (node/inorder-fold procedure base node)
+    (define (fold base node)
+      (if (empty? node)
+          base
+          (with-n-node node
+            (lambda (k v l r)
+              (fold (procedure k v (fold base r)) l)))))
+    (fold base node))
+
+  (define (node/for-each procedure node)
+    (if (not (empty? node))
+        (with-n-node node
+          (lambda (k v l r)
+            (node/for-each procedure l)
+            (procedure k v)
+            (node/for-each procedure r)))))
+
+  (define (node/height node)
+    (if (empty? node)
+        0
+        (+ 1 (max (node/height (node/l node))
+                  (node/height (node/r node))))))
+
+  (define (node/index node index)
+    (define (loop node index)
+      (let ((size.l  (node/size (node/l node))))
+        (cond ((fix:< index size.l)  (loop (node/l node) index))
+              ((fix:> index size.l)  (loop (node/r node)
+                                           (fix:- index (fix:+ 1 size.l))))
+              (else                  node))))
+    (let ((bound  (node/size node)))
+      (if (or (< index 0)
+              (>= index bound)
+              (not (fix:fixnum? index)))
+          (error:bad-range-argument index 'node/index)
+          (loop node index))))
+
+  (define (error:empty owner)
+    (error "Operation requires non-empty tree:" owner))
+
+
+  (define (local:make-wt-tree-type key<?)
+
+    ;; MIT-Scheme definitions:
+    ;;(declare (integrate key<?))
+    ;;(define-integrable (key>? x y)  (key<? y x))
+
+    (define (key>? x y)  (key<? y x))
+
+    (define (node/find k node)
+      ;; Returns either the node or #f.
+      ;; Loop takes D comparisons where D is the depth of the tree
+      ;; rather than the traditional compare-low, compare-high which
+      ;; takes on average 1.5(D-1) comparisons
+      (define (loop this best)
+        (cond ((empty? this)  best)
+              ((key<? k (node/k this))   (loop (node/l this) best))
+              (else (loop (node/r this) this))))
+      (let ((best (loop node #f)))
+        (cond ((not best)               #f)
+              ((key<? (node/k best) k)  #f)
+              (else                     best))))
+
+    (define (node/rank k node rank)
+      (cond ((empty? node)             #f)
+            ((key<? k (node/k node))  (node/rank k (node/l node) rank))
+            ((key>? k (node/k node))  
+             (node/rank k (node/r node)
+                        (fix:+ 1 (fix:+ rank (node/size (node/l node))))))
+            (else                     (fix:+ rank (node/size (node/l node))))))
+    
+    (define (node/add node k v)
+      (if (empty? node)
+          (node/singleton k v)
+          (with-n-node node
+            (lambda (key val l r)
+              (cond ((key<? k key)   (t-join key val (node/add l k v) r))
+                    ((key<? key k)   (t-join key val l (node/add r k v)))
+                    (else            (n-join key v   l r)))))))
+
+    (define (node/delete x node)
+      (if (empty? node)
+          empty
+          (with-n-node node
+            (lambda (key val l r)
+              (cond ((key<? x key)   (t-join key val (node/delete x l) r))
+                    ((key<? key x)   (t-join key val l (node/delete x r)))
+                    (else            (node/concat2 l r)))))))
+
+    (define (node/concat tree1 tree2)
+      (cond ((empty? tree1)  tree2)
+            ((empty? tree2)  tree1)
+            (else
+             (let ((min-node (node/min tree2)))
+               (node/concat3 (node/k min-node) (node/v min-node) tree1
+                             (node/delmin tree2))))))
+
+    (define (node/concat3 k v l r)
+      (cond ((empty? l)   (node/add r k v))
+            ((empty? r)   (node/add l k v))
+            (else
+             (let ((n1  (node/size l))
+                   (n2  (node/size r)))
+               (cond ((fix:< (fix:* wt-tree-ratio n1) n2)
+                      (with-n-node r
+                        (lambda (k2 v2 l2 r2)
+                          (t-join k2 v2 (node/concat3 k v l l2) r2))))
+                     ((fix:< (fix:* wt-tree-ratio n2) n1)
+                      (with-n-node l
+                        (lambda (k1 v1 l1 r1)
+                          (t-join k1 v1 l1 (node/concat3 k v r1 r)))))
+                     (else
+                      (n-join k v l r)))))))
+
+    (define (node/split-lt node x)
+      (cond ((empty? node)  empty)
+            ((key<? x (node/k node))
+             (node/split-lt (node/l node) x))
+            ((key<? (node/k node) x)
+             (node/concat3 (node/k node) (node/v node) (node/l node)
+                           (node/split-lt (node/r node) x)))
+            (else (node/l node))))
+
+    (define (node/split-gt node x)
+      (cond ((empty? node)  empty)
+            ((key<? (node/k node) x)
+             (node/split-gt (node/r node) x))
+            ((key<? x (node/k node))
+             (node/concat3 (node/k node) (node/v node) 
+                           (node/split-gt (node/l node) x) (node/r node)))
+            (else (node/r node))))
+
+    (define (node/union tree1 tree2)
+      (cond ((empty? tree1)  tree2)
+            ((empty? tree2)  tree1)
+            (else
+             (with-n-node tree2
+               (lambda (ak av l r)
+                 (let ((l1  (node/split-lt tree1 ak))
+                       (r1  (node/split-gt tree1 ak)))
+                   (node/concat3 ak av (node/union l1 l) (node/union r1 r))))))))
+
+    (define (node/difference tree1 tree2)
+      (cond ((empty? tree1)   empty)
+            ((empty? tree2)   tree1)
+            (else
+             (with-n-node tree2
+               (lambda (ak av l r)
+                 (let ((l1  (node/split-lt tree1 ak))
+                       (r1  (node/split-gt tree1 ak)))
+                   av
+                   (node/concat (node/difference l1 l)
+                                (node/difference r1 r))))))))
+
+    (define (node/intersection tree1 tree2)
+      (cond ((empty? tree1)   empty)
+            ((empty? tree2)   empty)
+            (else
+             (with-n-node tree2
+               (lambda (ak av l r)
+                 (let ((l1  (node/split-lt tree1 ak))
+                       (r1  (node/split-gt tree1 ak)))
+                   (if (node/find ak tree1)
+                       (node/concat3 ak av (node/intersection l1 l)
+                                     (node/intersection r1 r))
+                       (node/concat (node/intersection l1 l)
+                                    (node/intersection r1 r)))))))))
+
+    (define (node/subset? tree1 tree2)
+      (or (empty? tree1)
+          (and (fix:<= (node/size tree1) (node/size tree2))
+               (with-n-node tree1
+                 (lambda (k v l r)
+                   v
+                   (cond ((key<? k (node/k tree2))
+                          (and (node/subset? l (node/l tree2))
+                               (node/find k tree2)
+                               (node/subset? r tree2)))
+                         ((key>? k (node/k tree2))
+                          (and (node/subset? r (node/r tree2))
+                               (node/find k tree2)
+                               (node/subset? l tree2)))
+                         (else
+                          (and (node/subset? l (node/l tree2))
+                               (node/subset? r (node/r tree2))))))))))
+
+
+    ;;; Tree interface: stripping off or injecting the tree types
+
+    (define (tree/map-add tree k v)
+      (%make-wt-tree (tree/type tree)
+                     (node/add (tree/root tree) k v)))
+
+    (define (tree/insert! tree k v)
+      (set-tree/root! tree (node/add (tree/root tree) k v)))
+
+    (define (tree/delete tree k)
+      (%make-wt-tree (tree/type tree)
+                     (node/delete k (tree/root tree))))
+
+    (define (tree/delete! tree k)
+      (set-tree/root! tree (node/delete k (tree/root tree))))
+
+    (define (tree/split-lt tree key)
+      (%make-wt-tree (tree/type tree)
+                     (node/split-lt (tree/root tree) key)))
+
+    (define (tree/split-gt tree key)
+      (%make-wt-tree (tree/type tree)
+                     (node/split-gt (tree/root tree) key)))
+
+    (define (tree/union tree1 tree2)
+      (%make-wt-tree (tree/type tree1)
+                     (node/union (tree/root tree1) (tree/root tree2))))
+
+    (define (tree/intersection tree1 tree2)
+      (%make-wt-tree (tree/type tree1)
+                     (node/intersection (tree/root tree1) (tree/root tree2))))
+
+    (define (tree/difference tree1 tree2)
+      (%make-wt-tree (tree/type tree1)
+                     (node/difference (tree/root tree1) (tree/root tree2))))
+
+    (define (tree/subset? tree1 tree2)
+      (node/subset? (tree/root tree1) (tree/root tree2)))
+
+    (define (alist->tree alist)
+      (define (loop alist node)
+        (cond ((null? alist)  node)
+              ((pair? alist)  (loop (cdr alist)
+                                    (node/add node (caar alist) (cdar alist))))
+              (else           
+               (error:wrong-type-argument alist "alist" 'alist->tree))))
+      (%make-wt-tree my-type (loop alist empty)))
+
+    (define (tree/get tree key default)
+      (let ((node  (node/find key (tree/root tree))))
+        (if node
+            (node/v node)
+            default)))
+
+    (define (tree/rank tree key)  (node/rank key (tree/root tree) 0))
+
+    (define (tree/member? key tree)
+      (and (node/find key (tree/root tree))
+           #t))
+
+    (define my-type #F)
+
+    (set! my-type
+          (%make-tree-type
+           key<?                        ;  key<?
+           alist->tree                  ;  alist->tree
+           tree/map-add                 ;  add
+           tree/insert!                 ;  insert!
+           tree/delete                  ;  delete
+           tree/delete!                 ;  delete!
+           tree/member?                 ;  member?
+           tree/get                     ;  lookup
+           tree/split-lt                ;  split-lt
+           tree/split-gt                ;  split-gt
+           tree/union                   ;  union
+           tree/intersection            ;  intersection
+           tree/difference              ;  difference
+           tree/subset?                 ;  subset?
+           tree/rank                    ;  rank
+           ))
+
+    my-type)
+
+  (define (guarantee-tree tree procedure)
+    (if (not (wt-tree? tree))
+        (error:wrong-type-argument tree "weight-balanced tree" procedure)))
+
+  (define (guarantee-tree-type type procedure)
+    (if (not (tree-type? type))
+        (error:wrong-type-argument type "weight-balanced tree type" procedure)))
+
+  (define (guarantee-compatible-trees tree1 tree2 procedure)
+    (guarantee-tree tree1 procedure)
+    (guarantee-tree tree2 procedure)
+    (if (not (eq? (tree/type tree1) (tree/type tree2)))
+        (error "The trees" tree1 'and tree2 'have 'incompatible 'types
+               (tree/type tree1) 'and (tree/type tree2))))
+
+;;;______________________________________________________________________
+;;;
+;;;  Export interface
+;;;
+  (set! make-wt-tree-type local:make-wt-tree-type)
+
+  (set! make-wt-tree
+        (lambda (tree-type)
+          (%make-wt-tree tree-type empty)))
+
+  (set! singleton-wt-tree
+        (lambda (type key value)
+          (guarantee-tree-type type 'singleton-wt-tree)
+          (%make-wt-tree type (node/singleton key value))))
+
+  (set! alist->wt-tree
+        (lambda (type alist)
+          (guarantee-tree-type type 'alist->wt-tree)
+          ((tree-type/alist->tree type) alist)))
+
+  (set! wt-tree/empty?
+        (lambda (tree)
+          (guarantee-tree tree 'wt-tree/empty?)
+          (empty? (tree/root tree))))
+
+  (set! wt-tree/size
+        (lambda (tree)
+          (guarantee-tree tree 'wt-tree/size)
+          (node/size (tree/root tree))))
+
+  (set! wt-tree/add
+        (lambda (tree key datum)
+          (guarantee-tree tree 'wt-tree/add)
+          ((tree-type/add (tree/type tree)) tree key datum)))
+
+  (set! wt-tree/delete
+        (lambda (tree key)
+          (guarantee-tree tree 'wt-tree/delete)
+          ((tree-type/delete (tree/type tree)) tree key)))
+
+  (set! wt-tree/add!
+        (lambda (tree key datum)
+          (guarantee-tree tree 'wt-tree/add!)
+          ((tree-type/insert! (tree/type tree)) tree key datum)))
+
+  (set! wt-tree/delete!
+        (lambda (tree key)
+          (guarantee-tree tree 'wt-tree/delete!)
+          ((tree-type/delete! (tree/type tree)) tree key)))
+
+  (set! wt-tree/member?
+        (lambda (key tree)
+          (guarantee-tree tree 'wt-tree/member?)
+          ((tree-type/member? (tree/type tree)) key tree)))
+
+  (set! wt-tree/lookup
+        (lambda (tree key default)
+          (guarantee-tree tree 'wt-tree/lookup)
+          ((tree-type/lookup (tree/type tree)) tree key default)))
+
+  (set! wt-tree/split<
+        (lambda (tree key)
+          (guarantee-tree tree 'wt-tree/split<)
+          ((tree-type/split-lt (tree/type tree)) tree key)))
+
+  (set! wt-tree/split>
+        (lambda (tree key)
+          (guarantee-tree tree 'wt-tree/split>)
+          ((tree-type/split-gt (tree/type tree)) tree key)))
+
+  (set! wt-tree/union
+        (lambda (tree1 tree2)
+          (guarantee-compatible-trees tree1 tree2 'wt-tree/union)
+          ((tree-type/union (tree/type tree1)) tree1 tree2)))
+
+  (set! wt-tree/intersection
+        (lambda (tree1 tree2)
+          (guarantee-compatible-trees tree1 tree2 'wt-tree/intersection)
+          ((tree-type/intersection (tree/type tree1)) tree1 tree2)))
+
+  (set! wt-tree/difference
+        (lambda (tree1 tree2)
+          (guarantee-compatible-trees tree1 tree2 'wt-tree/difference)
+          ((tree-type/difference (tree/type tree1)) tree1 tree2)))
+
+  (set! wt-tree/subset?
+        (lambda (tree1 tree2)
+          (guarantee-compatible-trees tree1 tree2 'wt-tree/subset?)
+          ((tree-type/subset? (tree/type tree1)) tree1 tree2)))
+
+  (set! wt-tree/set-equal?
+        (lambda (tree1 tree2)
+          (and (wt-tree/subset? tree1 tree2)
+               (wt-tree/subset? tree2 tree1))))
+
+  (set! wt-tree/fold
+        (lambda (combiner-key-datum-result init tree)
+          (guarantee-tree tree 'wt-tree/fold)
+          (node/inorder-fold combiner-key-datum-result
+                             init
+                             (tree/root tree))))
+
+  (set! wt-tree/for-each
+        (lambda (action-key-datum tree)
+          (guarantee-tree tree 'wt-tree/for-each)
+          (node/for-each action-key-datum (tree/root tree))))
+
+  (set! wt-tree/index
+        (lambda (tree index)
+          (guarantee-tree tree 'wt-tree/index)
+          (let ((node  (node/index (tree/root tree) index)))
+            (and node (node/k node)))))
+
+  (set! wt-tree/index-datum
+        (lambda (tree index)
+          (guarantee-tree tree 'wt-tree/index-datum)
+          (let ((node  (node/index (tree/root tree) index)))
+            (and node (node/v node)))))
+
+  (set! wt-tree/index-pair
+        (lambda (tree index)
+          (guarantee-tree tree 'wt-tree/index-pair)
+          (let ((node  (node/index (tree/root tree) index)))
+            (and node (cons (node/k node) (node/v node))))))
+
+  (set! wt-tree/rank
+        (lambda (tree key)
+          (guarantee-tree tree 'wt-tree/rank)
+          ((tree-type/rank (tree/type tree)) tree key)))
+
+  (set! wt-tree/min
+        (lambda (tree)
+          (guarantee-tree tree 'wt-tree/min)
+          (node/k (node/min (tree/root tree)))))
+
+  (set! wt-tree/min-datum
+        (lambda (tree)
+          (guarantee-tree tree 'wt-tree/min-datum)
+          (node/v (node/min (tree/root tree)))))
+
+  (set! wt-tree/min-pair
+        (lambda (tree)
+          (guarantee-tree tree 'wt-tree/min-pair)
+          (let ((node  (node/min (tree/root tree))))
+            (cons (node/k node) (node/v node)))))
+
+  (set! wt-tree/delete-min
+        (lambda (tree)
+          (guarantee-tree tree 'wt-tree/delete-min)
+          (%make-wt-tree (tree/type tree)
+                         (node/delmin (tree/root tree)))))
+
+  (set! wt-tree/delete-min!
+        (lambda (tree)
+          (guarantee-tree tree 'wt-tree/delete-min!)
+          (set-tree/root! tree (node/delmin (tree/root tree)))))
+
+  ;; < is a lexpr. Many compilers can open-code < so the lambda is faster
+  ;; than passing <.
+  (set! number-wt-type (local:make-wt-tree-type  (lambda (u v) (< u v))))
+  (set! string-wt-type (local:make-wt-tree-type  string<?))
+
+  'done)
+
+;;; Local Variables:
+;;; eval: (put 'with-n-node 'scheme-indent-function 1)
+;;; eval: (put 'with-n-node 'scheme-indent-hook 1)
+;;; End:
diff --git a/yasyn.scm b/yasyn.scm
new file mode 100644
index 0000000..12228f4
--- /dev/null
+++ b/yasyn.scm
@@ -0,0 +1,201 @@
+;;"yasyn.scm" YASOS in terms of "object.scm"
+;;;From: whumeniu@datap.ca (Wade Humeniuk)
+
+(require 'object)
+
+(define yasos:instance?     object?)
+;; Removed (define yasos:make-instance 'bogus)  ;;
+;; Removed (define-syntax YASOS:INSTANCE-DISPATCHER  ;; alias so compiler can inline for speed
+;;   (syntax-rules () ((yasos:instance-dispatcher inst) (cdr inst))))
+;; DEFINE-OPERATION
+
+(define-syntax define-operation
+  (syntax-rules ()
+    ((define-operation (<name> <inst> <arg> ...) <exp1> <exp2> ...)
+     ;;=>
+     (define <name> (make-generic-method
+		     (lambda (<inst> <arg> ...) <exp1> <exp2> ...))))
+
+    ((define-operation (<name> <inst> <arg> ...) ) ;; no body
+     ;;=>
+     (define-operation (<name> <inst> <arg> ...)
+       (slib:error "Operation not handled"
+		   '<name>
+		   (format #f (if (yasos:instance? <inst>) "#<INSTANCE>" "~s")
+			   <inst>))))))
+
+;; DEFINE-PREDICATE
+
+(define-syntax define-predicate
+  (syntax-rules ()
+    ((define-predicate <name>)
+     ;;=>
+     (define <name> (make-generic-predicate)))))
+
+;; OBJECT
+
+(define-syntax object
+  (syntax-rules ()
+    ((object ((<name> <self> <arg> ...) <exp1> <exp2> ...) ...)
+    ;;=>
+     (let ((self (make-object)))
+       (make-method! self <name> (lambda (<self> <arg> ...) <exp1> <exp2> ...))
+       ...
+       self))))
+
+;; OBJECT with MULTIPLE INHERITANCE  {First Found Rule}
+
+(define-syntax object-with-ancestors
+  (syntax-rules ()
+    ((object-with-ancestors ( (<ancestor1> <init1>) ... ) 
+			    ((<name> <self> <arg> ...) <exp1> <exp2> ...) ...)
+    ;;=>
+     (let* ((<ancestor1> <init1>)
+	    ...
+	    (self (make-object <ancestor1> ...)))
+       (make-method! self <name> (lambda (<self> <arg> ...) <exp1> <exp2> ...))
+       ...
+       self))))
+       
+;; OPERATE-AS  {a.k.a. send-to-super}
+
+; used in operations/methods
+
+(define-syntax operate-as
+  (syntax-rules ()
+   ((operate-as <component> <op> <composit> <arg> ...) ;; What is <composit> ???
+   ;;=>
+    ((get-method <component> <op>) <composit> <arg> ...))))
+
+
+
+;; SET & SETTER
+
+
+(define-syntax set
+  (syntax-rules ()
+    ((set (<access> <index> ...) <newval>)
+     ((yasos:setter <access>) <index> ... <newval>)
+    )
+    ((set <var> <newval>)
+     (set! <var> <newval>)
+    )
+) )
+
+
+(define yasos:add-setter	'bogus)
+(define yasos:remove-setter-for 'bogus)
+
+(define yasos:setter
+  (let ( (known-setters (list (cons car set-car!)
+			      (cons cdr set-cdr!)
+			      (cons vector-ref vector-set!)
+			      (cons string-ref string-set!))
+	 )
+	 (added-setters '())
+       )
+
+    (set! YASOS:ADD-SETTER
+      (lambda (getter setter)
+	(set! added-setters (cons (cons getter setter) added-setters)))
+    )
+    (set! YASOS:REMOVE-SETTER-FOR
+      (lambda (getter)
+	(cond
+	  ((null? added-setters)
+	   (slib:error "REMOVE-SETTER-FOR: Unknown getter" getter)
+	  )
+	  ((eq? getter (caar added-setters))
+	   (set! added-setters (cdr added-setters))
+	  )
+	  (else
+	    (let loop ((x added-setters) (y (cdr added-setters)))
+	      (cond
+		((null? y) (slib:error "REMOVE-SETTER-FOR: Unknown getter"
+				       getter))
+		((eq? getter (caar y)) (set-cdr! x (cdr y)))
+		(else (loop (cdr x) (cdr y)))
+	  ) ) )
+     ) ) )
+
+    (letrec ( (self
+		 (lambda (proc-or-operation)
+		   (cond ((assq proc-or-operation known-setters) => cdr)
+			 ((assq proc-or-operation added-setters) => cdr)
+			 (else (proc-or-operation self))) )
+	    ) )
+      self)
+) )
+
+
+
+(define (yasos:make-access-operation <name>)
+  (letrec ( (setter-dispatch
+	       (lambda (inst . args)
+		   (cond
+		     ((and (yasos:instance? inst)
+			   (get-method inst setter-dispatch))
+		       => (lambda (method) (apply method (cons inst args)))
+		     )
+		     (else #f)))
+	    )
+	    (self
+	       (lambda (inst . args)
+		  (cond
+		     ((eq? inst yasos:setter) setter-dispatch) ; for (setter self)
+		     ((and (yasos:instance? inst)
+			   (get-method inst self))
+		      => (lambda (method) (apply method (cons inst args)))
+		     )
+		     (else (slib:error "Operation not handled" <name> inst))
+		)  )
+	    )
+	  )
+
+	  self
+) )
+
+(define-syntax define-access-operation
+  (syntax-rules ()
+    ((define-access-operation <name>)
+     ;=>
+     (define <name> (yasos:make-access-operation '<name>))
+) ) )
+
+
+
+;;---------------------
+;; general operations
+;;---------------------
+
+(define-operation (yasos:print obj port)
+  (format port
+	  ;; if an instance does not have a PRINT operation..
+	  (if (yasos:instance? obj) "#<INSTANCE>" "~s")
+	  obj
+) )
+
+(define-operation (yasos:size obj)
+  ;; default behavior
+  (cond
+    ((vector? obj) (vector-length obj))
+    ((list?   obj) (length obj))
+    ((pair?   obj) 2)
+    ((string? obj) (string-length obj))
+    ((char?   obj) 1)
+    (else
+      (slib:error "Operation not supported: size" obj))
+) )
+
+(require 'format)
+
+;;; exports:
+
+(define print yasos:print)		; print also in debug.scm
+(define size yasos:size)
+(define add-setter yasos:add-setter)
+(define remove-setter-for yasos:remove-setter-for)
+(define setter yasos:setter)
+
+(provide 'oop)				;in case we were loaded this way.
+(provide 'yasos)