aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Pick <jim@jimpick.com>1998-03-08 23:05:22 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commitb21cac3362022718634f7086964208b2eed8e897 (patch)
tree16f4b2e70645c0e8e2202023170b5a94baa967e3
parent3796d2595035e192ed4bf1c9a6bfdb13c3c9d261 (diff)
parentf24b9140d6f74804d5599ec225717d38ca443813 (diff)
downloadslib-b21cac3362022718634f7086964208b2eed8e897.tar.gz
slib-b21cac3362022718634f7086964208b2eed8e897.zip
Import Debian changes 2c0-3debian/2c0-3
slib (2c0-3) unstable; urgency=low * New maintainer. * slibconfig script to automatically configure guile. * Fix type in description, closes: Bug#18996 slib (2c0-2) unstable; urgency=low * Minor fix for debian/rules targets slib (2c0-1) unstable; urgency=low * New upstream source * New maintainer
-rw-r--r--ANNOUNCE91
-rw-r--r--ChangeLog314
-rw-r--r--FAQ45
-rw-r--r--Makefile138
-rw-r--r--README33
-rw-r--r--Template.scm18
-rw-r--r--alistab.scm317
-rw-r--r--array.scm2
-rw-r--r--arraymap.scm14
-rw-r--r--batch.scm67
-rw-r--r--byte.scm14
-rw-r--r--chez.init453
-rw-r--r--cltime.scm37
-rw-r--r--comlist.scm30
-rw-r--r--comparse.scm89
-rw-r--r--cring.scm480
-rw-r--r--dbutil.scm9
-rw-r--r--debian/changelog21
-rw-r--r--debian/control4
-rw-r--r--debian/copyright24
-rw-r--r--debian/postinst3
-rw-r--r--debian/postrm2
-rwxr-xr-xdebian/rules53
-rw-r--r--debian/slibconfig7
-rw-r--r--determ.scm14
-rw-r--r--elk.init36
-rw-r--r--factor.scm8
-rw-r--r--formatst.scm2
-rw-r--r--gambit.init174
-rw-r--r--macscheme.init14
-rw-r--r--makcrc.scm7
-rw-r--r--mbe.scm402
-rw-r--r--mitscheme.init21
-rw-r--r--mklibcat.scm175
-rw-r--r--mularg.scm2
-rw-r--r--object.scm97
-rw-r--r--paramlst.scm74
-rw-r--r--prec.scm438
-rw-r--r--primes.scm36
-rw-r--r--printf.scm25
-rw-r--r--priorque.scm13
-rw-r--r--psxtime.scm (renamed from time.scm)87
-rw-r--r--rdms.scm69
-rw-r--r--recobj.scm54
-rw-r--r--record.scm27
-rw-r--r--require.scm235
-rw-r--r--root.scm12
-rw-r--r--scainit.scm3
-rw-r--r--scanf.scm23
-rw-r--r--scheme2c.init16
-rw-r--r--scheme48.init83
-rw-r--r--scm.init6
-rw-r--r--scsh.init267
-rw-r--r--selfset.scm28
-rw-r--r--slib.info153
-rw-r--r--slib.info-11306
-rw-r--r--slib.info-21193
-rw-r--r--slib.info-3859
-rw-r--r--slib.info-41248
-rw-r--r--slib.info-51536
-rw-r--r--slib.info-61410
-rw-r--r--slib.info-7615
-rw-r--r--slib.info-8570
-rw-r--r--slib.texi11739
-rw-r--r--stdio.scm1
-rw-r--r--strport.scm2
-rw-r--r--strsrch.scm46
-rw-r--r--t3.init14
-rw-r--r--timezone.scm257
-rw-r--r--trace.scm9
-rw-r--r--tzfile.scm140
-rw-r--r--vscm.init89
-rw-r--r--wttree.scm24
-rw-r--r--yasos.scm299
-rw-r--r--yasyn.scm201
75 files changed, 11009 insertions, 15415 deletions
diff --git a/ANNOUNCE b/ANNOUNCE
index f34c063..84c0e95 100644
--- a/ANNOUNCE
+++ b/ANNOUNCE
@@ -1,49 +1,78 @@
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).
+slib2c0.
+
+New in slib2c0:
+
+ * cltime.scm (decode-universal-time encode-universal-time):
+ corrected for (now working) timezones.
+ * tzfile.scm (tzfile-read tz-index): added to read Linux (sysV ?)
+ timezone files.
+ * byte.scm: added `bytes', arrays of small integers.
+ * record.scm (display write): Records now display and write as
+ #<record-type-name>.
+ * timezone.scm: added. Processes TZ environment variable to
+ timezone information.
+ (tzset): takes optional string or timezone argument and returns
+ the current timezone.
+ (time-zone): creates and returns a timezone from a string filename
+ or TZ spec *without* setting global variables.
+ (daylight? *timezone* tzname): Posix (?) global variables are
+ set but SLIB code doesn't depend on them.
+ * psxtime.scm (time:gmktime time:gtime): added to fill out
+ orthogonal function set. The local time functions (localtime
+ mktime ctime) now all take optional timezone arguments.
+ (time:localtime): cleaned interface to timezone.scm: just calls to
+ tzset and tz:params.
+ * require.scm (*SLIB-VERSION*): Bumped from 2b3 to 2c0.
+ * require.scm (catalog:get): Now loads "homecat" and "usercat"
+ catalogs in HOME and current directories.
+ (catalog/require-version-match?): debugged for dumped executables.
+ ((require #f): resets *catalog*.
+ ((require 'new-catalog)): builds new catalog.
+ * mklibcat.scm: Rewrote to output headers and combine
+ implementation and site specific catalogs into "slibcat".
+ * slib.texi (The Library System): Added chapter. Totally
+ reorganized the Manual.
+ * Template.scm *.init (home-vicinity): added.
+ * require.scm (catalog:try-read): split off from
+ catalog:try-impl-read; useful for reading catalogs from other
+ vicinities.
+ * slib.texi (Database Utilities): Rewrote and expanded
+ command-line parser example.
+
+Thu Oct 23 23:14:33 1997 Eric Marsden <marsden@salines.cict.fr>
+
+ * factor.scm (prime:product): added EXACT? test.
+
+Mon Oct 20 22:18:16 1997 Radey Shouman <shouman@zianet.com>
+
+ * arraymap.scm (array-index-map!): Added.
+ (array-indexes): implemented with array-index-map!
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.
+MacScheme, MITScheme, scheme->C, Scheme48, SCM, scsh, T3.1, and VSCM.
Documentation includes a manifest, installation instructions, and
-coding standards for the library. Documentation on each library
+coding standards for the library. Documentation of each library
package is supplied. SLIB Documentation is online at:
- http://ftp-swiss.ai.mit.edu/~jaffer/SLIB.html
+ http://www-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
+ ftp-swiss.ai.mit.edu:pub/scm/slib2c0.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib2c0.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2c0.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
+SCHELOG is an embedding of Prolog in Scheme+SLIB:
+ http://www.cs.rice.edu/CS/PLT/packages/schelog/
Programs for printing and viewing TexInfo documentation (which SLIB
has) come with GNU Emacs or can be obtained via ftp from:
@@ -58,13 +87,13 @@ relation to zip). The program to uncompress them is available from
ftp ftp-swiss.ai.mit.edu (anonymous)
bin
cd pub/scm
- get slib2a6.tar.gz
+ get slib2c0.tar.gz
or
ftp prep.ai.mit.edu (anonymous)
cd pub/gnu/jacal
bin
- get slib2a6.tar.gz
+ get slib2c0.tar.gz
- `slib2a6.tar.gz' is a compressed tar file of a Scheme Library.
+ `slib2c0.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
index 977f23e..ad79625 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,315 @@
+Sat Nov 15 00:15:33 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * cltime.scm (decode-universal-time encode-universal-time):
+ corrected for (now working) timezones.
+
+ * tzfile.scm (tzfile-read tz-index): added to read Linux (sysV ?)
+ timezone files.
+
+ * byte.scm: added `bytes', arrays of small integers.
+
+Thu Nov 13 22:28:15 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * record.scm (display write): Records now display and write as
+ #<record-type-name>.
+
+Sun Nov 9 23:45:46 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * timezone.scm: added. Processes TZ environment variable to
+ timezone information.
+ (tzset): takes optional string or timezone argument and returns
+ the current timezone.
+ (time-zone): creates and returns a timezone from a string filename
+ or TZ spec *without* setting global variables.
+ (daylight? *timezone* tzname): Posix (?) global variables are
+ set but SLIB code doesn't depend on them.
+
+ * psxtime.scm (time:gmktime time:gtime): added to fill out
+ orthogonal function set. The local time functions (localtime
+ mktime ctime) now all take optional timezone arguments.
+ (time:localtime): cleaned interface to timezone.scm: just calls to
+ tzset and tz:params.
+
+Mon Oct 20 22:18:16 1997 Radey Shouman <shouman@zianet.com>
+
+ * arraymap.scm (array-index-map!): Added.
+ (array-indexes): implemented with array-index-map!
+
+Sun Nov 2 22:59:59 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * require.scm (*SLIB-VERSION*): Bumped from 2b3 to 2c0.
+
+ * require.scm (catalog:get): Now loads "homecat" and "usercat"
+ catalogs in HOME and current directories.
+ (catalog/require-version-match?): debugged for dumped executables.
+ ((require #f): resets *catalog*.
+ ((require 'new-catalog)): builds new catalog.
+
+ * mklibcat.scm: Rewrote to output headers and combine
+ implementation and site specific catalogs into "slibcat".
+
+ * slib.texi (The Library System): Added chapter. Totally
+ reorganized the Manual.
+
+Wed Oct 29 22:49:15 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * Template.scm *.init (home-vicinity): added.
+
+ * require.scm (catalog:try-read): split off from
+ catalog:try-impl-read; useful for reading catalogs from other
+ vicinities.
+
+Thu Oct 23 23:14:33 1997 Eric Marsden <marsden@salines.cict.fr>
+
+ * factor.scm (prime:product): added EXACT? test.
+
+Mon Oct 20 19:33:41 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * slib.texi (Database Utilities): Rewrote and expanded
+ command-line parser example.
+
+ * paramlst.scm (getopt->parameter-list): Added "Usage" printer
+ for strange option chars.
+
+ * comlist.scm (coerce): Added 'integer as an alias for 'number.
+
+Sat Oct 18 13:03:24 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * strsrch.scm (string-index-ci string-reverse-index-ci
+ substring-ci): added.
+
+ * comlist.scm (comlist:butnthcdr): added by analogy with butlast.
+
+Sun Oct 5 15:16:17 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * scsh.init: Added (thanks to Tomas By).
+
+Fri Oct 3 20:50:32 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * comparse.scm (read-command): now correctly handles \^M^J
+ (continued lines).
+ (read-options-file): added. Parses multi-line files of options.
+
+Fri Sep 19 22:52:15 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * paramlst.scm (fill-empty-parameters getopt->arglist): defaults
+ argument renamed to defaulters; documentation corrected.
+
+Tue Aug 26 17:41:39 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * batch.scm: Changed sun to sunos as platform name.
+
+Mon Aug 25 12:40:45 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * require.scm (catalog:version-match?): Now checks and issues
+ warning when *SLIB-VERSION* doesn't match first form in
+ "require.scm".
+
+Sun Aug 24 23:56:07 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * require.scm (catalog:version-match?): added to automatically
+ rebuild slibcat when SLIB with new version number is installed.
+
+ * mklibcat.scm: *SLIB-VERSION* association now included in
+ slibcat.
+
+Sat Aug 23 11:35:20 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * selfset.scm: added. (define a 'a) .. (define z 'z).
+
+Sat Aug 23 09:32:44 EDT 1997 Aubrey Jaffer <jaffer@aubrey.jaffer>
+
+ * require.scm (*SLIB-VERSION*): Bumped from 2b2 to 2b3.
+
+Thu Aug 21 10:20:21 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * determ.scm (determinant): added.
+
+Mon Jun 30 10:09:48 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * require.scm: "Supported by all implementations" section removed.
+
+ * chez.init (defmacro:eval): Chez 5.0 no longer can support
+ defmacro; added SLIB autoload defmacro:expand*.
+
+Sun Jun 29 19:36:34 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * cring.scm (cring:db): cring now works for -, /, and ^.
+
+Thu Jun 26 00:19:05 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * cring.scm (expression-< x y): added to sort unreduced
+ expressions.
+
+Tue Jun 24 13:33:40 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * cring.scm: Added 'commutative-ring feature; extend + and * to
+ non-numeric types.
+ (cring:define-rule): Defines rules for + and * reduction of
+ non-numeric types.
+
+Mon Jun 23 22:58:44 EDT 1997 Aubrey Jaffer <jaffer@scm.bertronics.com>
+
+ * require.scm (*SLIB-VERSION*): Bumped from 2b1 to 2b2.
+
+Sat Jun 21 23:20:29 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * alistab.scm (map-key for-each-key ordered-for-each-key): Now
+ take match-key argument.
+ (delete*): added. delete-assoc created to *not* accept wildcards
+ in delete keys.
+
+ * rdms.scm (get* row:delete* row:remove*): Now take match-key
+ arguments, normalize them, and pass to base-table routines.
+
+Thu Jun 19 13:34:36 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * alistab.scm (assoc* make-assoc* delete-assoc* assoc*-for-each
+ assoc*-map sorted-assoc*-for-each alist-sort!): added. Functions
+ now support partial matches and key wild-carding.
+ (remover kill-table): remover removed. Kill-table uses
+ delete-assoc*.
+
+Sat Jun 14 22:51:51 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * alistab.scm (alist-table): Changed table handle from
+ (table-name . TABLE) to (#(table-name key-dim) . TABLE).
+ (alist-table): Changed primary keys from vectors to lists.
+
+Wed 28 May 1997 Dave Love <d.love@dl.ac.uk>
+
+ * yasos.scm: Remove case-sensitivity (for Guile). Chop the
+ duplicated code.
+
+Mon May 26 21:46:45 1997 Bill Nell <bnell@scr.siemens.com>
+
+ * strport.scm (call-with-output-string): losing every 512th
+ character fixed.
+
+Wed May 21 19:16:03 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * printf.scm (stdio:iprintf): changed integer-pad to
+ integer-convert and unified conversion of non-numeric values.
+
+Wed May 14 14:01:02 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * prec.scm (prec:symbolfy): added so that for most user grammar
+ functions, parsing defaults to the triggering token, instead of
+ the symbol @code{?}.
+
+Tue May 13 22:46:22 1997 Albert L. Ting <alt@artisan.com>
+
+ * elk.init (slib:error): re-written.
+
+Sat May 10 22:00:30 EDT 1997 Aubrey Jaffer <jaffer@scm.bertronics.com>
+
+ * require.scm (*SLIB-VERSION*): Bumped from 2b0 to 2b1.
+
+Wed May 7 15:11:12 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * prec.scm: Rewrote nearly all of JACAL parser and moved it here.
+ Now supports dynamic binding of grammar.
+
+Tue May 6 16:23:10 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * strsrch.scm (find-string-from-port?): Enhanced: can take char
+ instead of count and search up to char. Given procedure, tests it
+ on every character.
+
+Wed 30 Apr 1997 John David Stone <stone@math.GRIN.EDU>
+
+ * chez.init: Revised for Chez Scheme 5.0c
+
+Tue Apr 29 19:55:35 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * require.scm (*SLIB-VERSION*): Bumped from 2a7 to 2b0.
+
+ * slib.texi (Library Catalog): section added to describe new
+ catalog mechanism.
+
+ * Makefile (slib48): Now defines library-vicinity and
+ implementation-vicinity from the makefile. "slibcat" support
+ added.
+
+Sat Apr 12 23:40:14 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * mklibcat.scm: moved from "require.scm". Rebuilds "slibcat".
+ * require.scm (catalog:get): now caches *catalog* in
+ implementation-vicinity scheme files "slibcat" and "implcat".
+
+Wed Apr 9 20:55:31 1997 Dorai Sitaram <ds26@gte.com>
+
+ * mbe.scm (hyg:map*): Added to correct a minor bug in the hygienic
+ half of mbe.scm that shows up only when define-syntax is used in a
+ right-hand pattern inside syntax-rules.
+
+ * strsrch.scm (string-reverse-index): added.
+
+Tue Apr 8 16:46:35 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * yasos.scm: Replaces "yasyn.scm" and "object.scm"; Those and
+ "recobj.scm" were removed because of unclear copyright status.
+
+ * printf.scm (stdio:iprintf): no longer translates \r to #\return.
+
+Sat Aug 10 16:11:15 1996 Mike Sperber <sperber@informatik.uni-tuebingen.de>
+
+ * scheme48.init Makefile: Now makes use of module system to access
+ required primitives. Added install48 target to Makefile.
+
+Sat Apr 5 13:26:54 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * array.scm (array-dimensions): fixed off-by-1 bug.
+
+Sat Mar 8 17:44:34 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * scanf.scm (stdio:scan-and-set): corrected handling of %5c with
+ short input.
+
+Fri Mar 7 21:20:57 EST 1997 Aubrey Jaffer <jaffer@scm.bertronics.com>
+
+ * require.scm (*SLIB-VERSION*): Bumped from 2a6 to 2a7.
+
+Sat Feb 22 10:18:36 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * batch.scm (system): added stubifier (returns #f) for when
+ system is not provided.
+ (system:success?): added.
+
+ * wttree.scm (error):
+ (error:wrong-type-argument):
+ (error:bad-range-argument): Stubs added for non-MITScheme
+ implementations.
+
+ * Template.scm *.init (slib:warn): added.
+
+Sun Feb 16 21:55:59 1997 Michael Pope <michael.pope@dsto.defence.GOV.AU>
+
+ * gambit.init (scheme-implementation-version): updated for Gambit
+ v2.4.
+
+Sun Dec 1 00:44:30 1996 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+ * batch.scm (truncate-up-to): Added to support compiler habbit of
+ putting object files in current-directory.
+
+Sat Aug 31 12:17:30 1996 Aubrey Jaffer <jaffer@martigny.bertronics>
+
+ * scm.init: added for completeness
+
+ * record.scm (vector?): infinite recursion fixed.
+
+ * dbutil.scm (make-command-server): Documentation updated.
+
+Wed Aug 21 20:38:26 1996 John Gerard Malecki <johnm@vlibs.com>
+
+ * vscm.init: Implements string ports using `generic ports'.
+
+Wed Aug 21 20:38:26 1996 Aubrey Jaffer <jaffer@jacal.bertronics>
+
+ * record.scm: rewritten to make records disjoint types
+ which are unforgable and uncorruptable by R4RS procedures.
+
Fri Jul 19 11:24:45 1996 Aubrey Jaffer <jaffer@jacal.bertronics>
* structure.scm scaoutp.scm scamacr.scm scainit.scm scaglob.scm
@@ -710,7 +1022,7 @@ Tue May 11 01:22:40 1993 Aubrey Jaffer (jaffer at camelot)
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)
diff --git a/FAQ b/FAQ
index 3b4d812..540f221 100644
--- a/FAQ
+++ b/FAQ
@@ -1,4 +1,4 @@
-FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib2a6).
+FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib2c0).
Written by Aubrey Jaffer (jaffer@ai.mit.edu).
INTRODUCTION AND GENERAL INFORMATION
@@ -17,13 +17,13 @@ Scheme is a programming language in the Lisp family.
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?
+[] How can I obtain 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
+ ftp-swiss.ai.mit.edu:pub/scm/slib2c0.tar.gz
+ prep.ai.mit.edu:pub/gnu/jacal/slib2c0.tar.gz
+ ftp.maths.tcd.ie:pub/bosullvn/jacal/slib2c0.tar.gz
+ ftp.cs.indiana.edu:/pub/scheme-repository/imp/slib2c0.tar.gz
SLIB is also included with SCM floppy disks.
@@ -44,13 +44,15 @@ prep.ai.mit.edu:pub/gnu/texinfo-3.1.tar.gz
[] How often is SLIB released?
-SLIB was released 9 times in 1993.
+SLIB was released twice in 1996.
[] What is the latest version?
-The version as of this writing is slib2a6.
+The version as of this writing is slib2c0. The latest documentation
+is available online at:
+ http://www-swiss.ai.mit.edu/~jaffer/SLIB.html
-[] What version am I using?
+[] Which 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
@@ -162,7 +164,7 @@ 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
+fixed, exception handlers and errors which might occur while using
FORMAT cannot use it.
MACROS
@@ -180,8 +182,8 @@ powerful to accomplish tasks macros are often written to do.
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.
+macro specification. All of the implementations except scheme48
+version 0.45 support defmacro natively.
[] I did (LOAD "slib/yasos.scm"). The error I get is "variable
define-syntax is undefined".
@@ -192,25 +194,26 @@ The way to load the struct macro package is (REQUIRE 'YASOS).
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:
+If your Scheme does not natively support R4RS macros (most
+implementations), 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:
+This would also be true for a Scheme implementation which didn't
+support DEFMACRO. The lines in this case would be:
(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?
+[] I always use R4RS macros with an implementation which doesn't
+ natively support them. 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):
+As 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:
+ catching code and the following script to your Scheme init file:
(require 'macro)
(require 'repl)
(repl:top-level macro:eval)
diff --git a/Makefile b/Makefile
index a2b8de7..0f8d7fe 100644
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
# Makefile for Scheme Library
-# Copyright (C) 1991, 1992, 1993, 1994, 1995 Aubrey Jaffer.
+# Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997 Aubrey Jaffer.
SHELL = /bin/sh
intro:
@@ -20,7 +20,11 @@ $(dvidir)slib.dvi: $(srcdir)slib.texi $(dvidir)slib.fn
$(dvidir)slib.fn:
cd $(dvidir);tex $(srcdir)slib.texi
xdvi: $(dvidir)slib.dvi
- xdvi $(dvidir)slib.dvi
+ xdvi -s 6 $(dvidir)slib.dvi
+htmldir=../public_html/
+html: $(htmldir)slib_toc.html
+$(htmldir)slib_toc.html: $(srcdir)slib.texi
+ cd $(htmldir);make slib_toc.html
prefix = /usr/local
exec_prefix = $(prefix)
@@ -31,8 +35,9 @@ RUNNABLE = scheme48
LIB = $(libdir)/$(RUNNABLE)
VM = scheme48vm
IMAGE = slib.image
+INSTALL_DATA = install -c
-slib48:
+slib48.036:
(echo ,load `pwd`/scheme48.init; \
echo "(define *args* '())"; \
echo "(define (program-arguments) (cons \"$(VM)\" *args*))"; \
@@ -43,33 +48,75 @@ slib48:
> $(bindir)/slib48
chmod +x $(bindir)/slib48
+$(LIB)/slibcat:
+ touch $(LIB)/slibcat
+
+slib48: $(LIB)/slibcat Makefile
+ (echo ",batch on"; \
+ echo ",config"; \
+ echo ",load =scheme48/misc/packages.scm"; \
+ echo "(define-structure slib-primitives"; \
+ echo " (export s48-error"; \
+ echo " s48-ascii->char"; \
+ echo " s48-force-output"; \
+ echo " s48-current-error-port"; \
+ echo " s48-system";\
+ echo " s48-with-handler";\
+ echo " s48-getenv)";\
+ echo " (open scheme signals ascii extended-ports i/o"; \
+ echo " primitives handle unix-getenv)"; \
+ echo " (begin"; \
+ echo " (define s48-error error)"; \
+ echo " (define s48-ascii->char ascii->char)"; \
+ echo " (define s48-force-output force-output)"; \
+ echo " (define s48-current-error-port current-error-port)"; \
+ echo " (define (s48-system c) (vm-extension 96 c))"; \
+ echo " (define s48-with-handler with-handler)"; \
+ echo " (define s48-getenv getenv)))"; \
+ echo ",user"; \
+ echo ",open slib-primitives"; \
+ echo "(define (implementation-vicinity) \"$(LIB)/\")"; \
+ echo "(define (library-vicinity) \"`pwd`/\")"; \
+ echo ",load scheme48.init"; \
+ echo "(define *args* '())"; \
+ echo "(define (program-arguments) (cons \"scheme48\" *args*))"; \
+ echo "(set! *catalog* #f)"; \
+ echo ",collect"; \
+ echo ",batch off"; \
+ echo ",dump $(IMAGE) \"(slib $(VERSION))\""; \
+ echo ",exit") | scheme48
+
+install48: slib48
+ $(INSTALL_DATA) $(IMAGE) $(LIB)
+ (echo '#!/bin/sh'; \
+ echo exec $(RUNNABLE) -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
+ -rm $(infodir)/slib.info*.gz
infoz: $(infodir)/slib.info.gz
- -make schelog-infoz
$(infodir)/slib.info.gz: $(infodir)/slib.info
- -rm $(infodir)/slib.info*.gz
- gzip $(infodir)/slib.info*
+ gzip -f $(infodir)/slib.info*
#### Stuff for maintaining SLIB below ####
-VERSION = 2a6
+VERSION = 2c0
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
+ strsrch.scm prec.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
+ charplot.scm root.scm cring.scm determ.scm selfset.scm \
+ psxtime.scm cltime.scm timezone.scm tzfile.scm
+bfiles = collect.scm fluidlet.scm struct.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 \
@@ -78,15 +125,15 @@ 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
+ sierpinski.scm soundex.scm byte.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
+mfiles = Makefile require.scm Template.scm syncase.sh mklibcat.scm
ifiles = chez.init elk.init macscheme.init \
mitscheme.init scheme2c.init scheme48.init gambit.init t3.init \
- vscm.init mitcomp.pat syncase.sh
+ vscm.init mitcomp.pat scm.init scsh.init
tfiles = plottest.scm formatst.scm macrotst.scm scmactst.scm \
dwindtst.scm structst.scm
sfiles = $(ffiles) $(lfiles) $(revfiles) $(afiles) $(scfiles) $(efiles) \
@@ -139,7 +186,7 @@ pubdiffs: temp/slib
distdiffs: temp/slib
$(makedev) DEST=$(dest) PROD=slib ver=$(ver) distdiffs
announcediffs: temp/slib
- $(makedev) DEST=$(dest) PROD=slib ver=2a1 announcediffs
+ $(makedev) DEST=$(dest) PROD=slib ver=2c0 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
@@ -158,55 +205,23 @@ 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:
+ echo `date` \ Aubrey Jaffer \ \<`whoami`@`hostname`\>> change
+ echo>> change
+ echo \ \* require.scm \(*SLIB-VERSION*\): Bumped from $(VERSION) to $(ver).>>change
+ echo>> change
+ cat ChangeLog >> change
+ mv -f change ChangeLog
$(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
+ ../scm/README ../scm/scm.texi \
+ /c/scm/dist/install.bat /c/scm/dist/makefile \
+ /c/scm/dist/mkdisk.bat
+ $(CHPAT) $(VERSION) $(ver) README slib.texi require.scm Makefile \
+ ../public_html/SLIB.html
tagfiles = slib.texi $(mfiles) $(sfiles) $(bfiles) $(tfiles)
# README and $(ifiles) cause semgentation faults in ETAGS for Emacs version 19.
@@ -217,6 +232,9 @@ test: $(sfiles)
rights:
scm -ladmin -e"(admin:check-all)" $(sfiles) $(tfiles) \
$(bfiles) $(ifiles)
+report:
+ scmlit -e"(slib:report #t)"
+ scm -e"(slib:report #t)"
clean:
-rm -f *~ *.bak *.orig *.rej core a.out *.o \#*
-rm -rf *temp
diff --git a/README b/README
index 35f7448..e440663 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-This directory contains the distribution of Scheme Library slib2a3.
+This directory contains the distribution of Scheme Library slib2c0.
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.
@@ -24,8 +24,11 @@ The maintainer can be reached at jaffer@ai.mit.edu.
for the MitScheme compiler.
`scheme2c.init' is a configuration file for DEC's scheme->c.
`scheme48.init' is a configuration file for Scheme48.
+ `scsh.init' is a configuration file for Scheme-Shell
+ `scm.init' is a configuration file for SCM.
`t3.init' is a configuration file for T3.1 in Scheme mode.
`vscm.init' is a configuration file for VSCM.
+ `mklibcat.scm' builds the *catalog* cache.
`require.scm' has code which allows system independent access to
the library files.
@@ -58,13 +61,18 @@ The maintainer can be reached at jaffer@ai.mit.edu.
`primes.scm' has primes and probably-prime?.
`factor.scm' has factor.
`root.scm' has Newton's and Laguerre's methods for finding roots.
+ `cring.scm' extend + and * to custom commutative rings.
+ `selfset.scm' sets single letter identifiers to their symbols.
+ `determ.scm' compute determinant of list of lists.
`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.
+ `psxtime.scm' has Posix time conversion routines.
`cltime.scm' has Common-Lisp time conversion routines.
+ `timezone.scm' has the default time-zone, UTC.
+ `tzfile.scm' reads sysV style (binary) timezone file.
`comparse.scm' has shell-like command parsing.
`rdms.scm' has code to construct a relational database from a base
@@ -100,10 +108,6 @@ The maintainer can be reached at jaffer@ai.mit.edu.
`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.
@@ -137,6 +141,7 @@ The maintainer can be reached at jaffer@ai.mit.edu.
"Essentials of Programming Languages".
`structure.scm' has syntax-case macros for the same.
`structst.scm' has test code for struct.scm.
+ `byte.scm' has arrays of small integers.
INSTALLATION INSTRUCTIONS
@@ -147,7 +152,9 @@ 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'.
+MITScheme, scheme->c, VSCM, and SCM support `getenv'. Scheme48
+supports `getenv' but does not use it for determining
+`library-vicinity'. (That is done from the Makefile.)
You should check the definitions of `software-type',
`scheme-implementation-version', `implementation-vicinity', and
@@ -159,7 +166,7 @@ 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
+directory. Simply configure each implementation's initialization file
as outlined above.
The SCM implementation does not require any initialization file as
@@ -168,9 +175,11 @@ 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.
+comments in `vscm.init'. To make a Scheme48 image for an installation
+under `<prefix>', `cd' to the SLIB directory and type `make
+prefix=<prefix> slib48'. To install the image, type `make
+prefix=<prefix> install48'. This will also create a shell script with
+the name `slib48' which will invoke the saved image.
PORTING INSTRUCTIONS
@@ -180,7 +189,7 @@ 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
+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'.
diff --git a/Template.scm b/Template.scm
index a03b76b..55011b2 100644
--- a/Template.scm
+++ b/Template.scm
@@ -1,5 +1,5 @@
;"Template.scm" configuration template of *features* for Scheme -*-scheme-*-
-; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+; Copyright (C) 1991, 1992, 1993, 1994, 1997 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
@@ -59,6 +59,14 @@
(else "")))))
(lambda () library-path)))
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-path)))
+
;;; *FEATURES* should be set to a list of symbols describing features
;;; of this implementation. Suggestions for features are:
@@ -172,7 +180,7 @@
(list (cons 'defmacro
(lambda (name parms . body)
`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
- *defmacros*))))))
+ *defmacros*))))))
(define (defmacro? m) (and (assq m *defmacros*) #t))
(define (macroexpand-1 e)
@@ -217,6 +225,12 @@
(evl o))
(set! *load-pathname* old-load-pathname)))))
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;;; define an error procedure for the library
;(define slib:error error)
diff --git a/alistab.scm b/alistab.scm
index c8149bf..f0e8d59 100644
--- a/alistab.scm
+++ b/alistab.scm
@@ -1,5 +1,5 @@
;;; "alistab.scm" database tables using association lists (assoc)
-; Copyright 1994 Aubrey Jaffer
+; Copyright 1994, 1997 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
@@ -18,13 +18,23 @@
;each case.
;;; LLDB is (filename . alist-table)
-;;; HANDLE is (table-name . TABLE)
+;;; HANDLE is (#(table-name key-dim) . TABLE)
;;; TABLE is an alist of (Primary-key . ROW)
;;; ROW is a list of non-primary VALUEs
+(require 'common-list-functions)
+
(define alist-table
-(let ((catalog-id 0)
- (resources '*base-resources*))
+ (let ((catalog-id 0)
+ (resources '*base-resources*)
+ (make-list-keyifier (lambda (prinum types) identity))
+ (make-keyifier-1 (lambda (type) list))
+ (make-key->list (lambda (prinum types) identity))
+ (make-key-extractor (lambda (primary-limit column-type-list index)
+ (let ((i (+ -1 index)))
+ (lambda (lst) (list-ref lst i))))))
+
+(define keyify-1 (make-keyifier-1 'atom))
(define (make-base filename dim types)
(list filename
@@ -85,84 +95,155 @@
(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))
+ (let* ((row (assoc* (keyify-1 'free-id) (handle->alist free-hand)))
+ (table-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)
+ (set! table-id (cadr row))
+ (set-car! (cdr row) (+ 1 table-id))
+ (set-cdr! lldb (cons (list table-id) (cdr lldb)))
+ table-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 ckey (list base-id))
+ (let ((pair (assoc* ckey (cdr lldb))))
+ (and pair (set-cdr! lldb (delete-assoc ckey (cdr lldb))))
+ (and pair (not (assoc* ckey (cdr lldb))))))
-(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 (assoc* keys alist)
+ (let ((pair (assoc (car keys) alist)))
+ (cond ((not pair) #f)
+ ((null? (cdr keys)) pair)
+ (else (assoc* (cdr keys) (cdr pair))))))
-(define (make-list-keyifier prinum types)
- (if (= 1 prinum) car list->vector))
+(define (make-assoc* keys alist vals)
+ (let ((pair (assoc (car keys) alist)))
+ (cond ((not pair) (cons (cons (car keys)
+ (if (null? (cdr keys))
+ vals
+ (make-assoc* (cdr keys) '() vals)))
+ alist))
+ (else (set-cdr! pair (if (null? (cdr keys))
+ vals
+ (make-assoc* (cdr keys) (cdr pair) vals)))
+ alist))))
-(define (make-keyifier-1 type)
- identity)
+(define (delete-assoc ckey alist)
+ (cond
+ ((null? ckey) '())
+ ((assoc (car ckey) alist)
+ => (lambda (match)
+ (let ((adl (delete-assoc (cdr ckey) (cdr match))))
+ (cond ((null? adl) (delete match alist))
+ (else (set-cdr! match adl) alist)))))
+ (else alist)))
-(define (make-key->list prinum types)
- (cond ((= 1 prinum) list)
- (else vector->list)))
+(define (delete-assoc* ckey alist)
+ (cond
+ ((every not ckey) '()) ;includes the null case.
+ ((not (car ckey))
+ (delete '()
+ (map (lambda (fodder)
+ (let ((adl (delete-assoc* (cdr ckey) (cdr fodder))))
+ (if (null? adl) '() (cons (car fodder) adl))))
+ alist)))
+ ((procedure? (car ckey))
+ (delete '()
+ (map (lambda (fodder)
+ (if ((car ckey) (car fodder))
+ (let ((adl (delete-assoc* (cdr ckey) (cdr fodder))))
+ (if (null? adl) '() (cons (car fodder) adl)))
+ fodder))
+ alist)))
+ ((assoc (car ckey) alist)
+ => (lambda (match)
+ (let ((adl (delete-assoc* (cdr ckey) (cdr match))))
+ (cond ((null? adl) (delete match alist))
+ (else (set-cdr! match adl) alist)))))
+ (else alist)))
-(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 (assoc*-for-each proc bkey ckey alist)
+ (cond ((null? ckey) (proc (reverse bkey)))
+ ((not (car ckey))
+ (for-each (lambda (alist)
+ (assoc*-for-each proc
+ (cons (car alist) bkey)
+ (cdr ckey)
+ (cdr alist)))
+ alist))
+ ((procedure? (car ckey))
+ (for-each (lambda (alist)
+ (if ((car ckey) (car alist))
+ (assoc*-for-each proc
+ (cons (car alist) bkey)
+ (cdr ckey)
+ (cdr alist))))
+ alist))
+ ((assoc (car ckey) alist)
+ => (lambda (match)
+ (assoc*-for-each proc
+ (cons (car match) bkey)
+ (cdr ckey)
+ (cdr match))))))
-(define (for-each-key handle operation)
- (for-each (lambda (x) (operation (car x))) (handle->alist handle)))
+(define (assoc*-map proc bkey ckey alist)
+ (cond ((null? ckey) (list (proc (reverse bkey))))
+ ((not (car ckey))
+ (apply append
+ (map (lambda (alist)
+ (assoc*-map proc
+ (cons (car alist) bkey)
+ (cdr ckey)
+ (cdr alist)))
+ alist)))
+ ((procedure? (car ckey))
+ (apply append
+ (map (lambda (alist)
+ (if ((car ckey) (car alist))
+ (assoc*-map proc
+ (cons (car alist) bkey)
+ (cdr ckey)
+ (cdr alist))
+ '()))
+ alist)))
+ ((assoc (car ckey) alist)
+ => (lambda (match)
+ (assoc*-map proc
+ (cons (car match) bkey)
+ (cdr ckey)
+ (cdr match))))
+ (else '())))
-(define (map-key handle operation)
- (map (lambda (x) (operation (car x))) (handle->alist handle)))
+(define (sorted-assoc*-for-each proc bkey ckey alist)
+ (cond ((null? ckey) (proc (reverse bkey)))
+ ((not (car ckey))
+ (for-each (lambda (alist)
+ (sorted-assoc*-for-each proc
+ (cons (car alist) bkey)
+ (cdr ckey)
+ (cdr alist)))
+ (alist-sort! alist)))
+ ((procedure? (car ckey))
+ (sorted-assoc*-for-each proc
+ bkey
+ (cons #f (cdr ckey))
+ (remove-if-not (lambda (pair)
+ ((car ckey) (car pair)))
+ alist)))
+ ((assoc (car ckey) alist)
+ => (lambda (match)
+ (sorted-assoc*-for-each proc
+ (cons (car match) bkey)
+ (cdr ckey)
+ (cdr match))))))
-(define (ordered-for-each-key handle operation)
+(define (alist-sort! alist)
(define (key->sortable k)
(cond ((number? k) k)
((string? k) k)
@@ -182,15 +263,45 @@
((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-<))))
+ (map cdr (sort! (map (lambda (p)
+ (cons (key->sortable (car p)) p))
+ alist)
+ car-key-<)))
+
+(define (present? handle ckey)
+ (assoc* ckey (handle->alist handle)))
+
+(define (make-putter prinum types)
+ (lambda (handle ckey restcols)
+ (set-handle-alist! handle
+ (make-assoc* ckey (handle->alist handle) restcols))))
+
+(define (make-getter prinum types)
+ (lambda (handle ckey)
+ (let ((row (assoc* ckey (handle->alist handle))))
+ (and row (cdr row)))))
+
+(define (for-each-key handle operation match-key)
+ (assoc*-for-each operation
+ '()
+ match-key
+ (handle->alist handle)))
+
+(define (map-key handle operation match-key)
+ (assoc*-map operation
+ '()
+ match-key
+ (handle->alist handle)))
+
+(define (ordered-for-each-key handle operation match-key)
+ (sorted-assoc*-for-each operation
+ '()
+ match-key
+ (handle->alist handle)))
(define (supported-type? type)
(case type
- ((base-id atom integer boolean string symbol expression) #t)
+ ((base-id atom integer boolean string symbol expression number) #t)
(else #f)))
(define (supported-key-type? type)
@@ -198,30 +309,42 @@
((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)
- ))
- ))
+;;make-table open-table remover assoc* make-assoc*
+;;(trace assoc*-for-each assoc*-map sorted-assoc*-for-each)
+
+ (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)
+ ((catalog-id) catalog-id)
+ ((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)
+ (lambda (handle ckey)
+ (set-handle-alist! handle
+ (delete-assoc ckey (handle->alist handle)))))
+ ((delete*)
+ (lambda (handle match-key)
+ (set-handle-alist! handle
+ (delete-assoc* match-key
+ (handle->alist handle)))))
+ ((for-each-key) for-each-key)
+ ((map-key) map-key)
+ ((ordered-for-each-key) ordered-for-each-key)
+ (else #f)))
+ ))
+
+;; #f (trace-all "/home/jaffer/slib/alistab.scm") (untrace alist-table) (set! *qp-width* 333)
diff --git a/array.scm b/array.scm
index 3eecb7a..08b8114 100644
--- a/array.scm
+++ b/array.scm
@@ -48,7 +48,7 @@
(if (array? obj) (length (array-shape obj)) 0))
(define (array-dimensions ra)
- (map (lambda (ind) (if (zero? (car ind)) (cadr ind) ind))
+ (map (lambda (ind) (if (zero? (car ind)) (+ 1 (cadr ind)) ind))
(array-shape ra)))
(define array:construct
diff --git a/arraymap.scm b/arraymap.scm
index 18ee64a..d3dedba 100644
--- a/arraymap.scm
+++ b/arraymap.scm
@@ -52,25 +52,27 @@
(rafe crshape (cons i inds))))))
(rafe (array-shape (car ras)) '()))
-(define (shape->indexes shape)
- (define ra0 (apply make-array '() shape))
+(define (array-index-map! ra fun)
(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))
+ (apply array-set! ra (apply fun 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)
+ (if (zero? (array-rank ra))
+ (array-set! ra (fun))
+ (ramap (reverse (array-shape ra)) '())))
(define (array-indexes ra)
- (shape->indexes (array-shape ra)))
+ (let ((ra0 (apply make-array '() (array-shape ra))))
+ (array-index-map! ra0 list)
+ ra0))
(define (array-copy! source dest)
(array-map! dest identity source))
diff --git a/batch.scm b/batch.scm
index 685dd3e..88684c0 100644
--- a/batch.scm
+++ b/batch.scm
@@ -1,5 +1,5 @@
;;; "batch.scm" Group and execute commands on various systems.
-;Copyright (C) 1994, 1995 Aubrey Jaffer
+;Copyright (C) 1994, 1995, 1997 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
@@ -20,8 +20,18 @@
(require 'line-i/o) ;Just for write-line
(require 'parameters)
(require 'database-utilities)
-
-;;(define (batch parms op . args) ??)
+(require 'string-port)
+(require 'tree)
+
+(define system
+ (if (provided? 'system)
+ system
+ (lambda (str) 1)))
+(define system:success?
+ (case (software-type)
+ ((VMS) (lambda (int) (eqv? 1 int)))
+ (else zero?)))
+;;(trace system system:success? exit quit slib:exit)
(define (batch:port parms)
(car (parameter-list-ref parms 'batch-port)))
@@ -61,8 +71,10 @@
(loop (butlast fodder hlen)))))))
(define (batch:system parms . strings)
- (or (apply batch:try-system parms strings)
- (slib:error 'batch:system 'failed strings)))
+ (cond ((not (provided? 'system))
+ (slib:error 'batch:system 'system "procedure not supported."))
+ ((apply batch:try-system parms strings))
+ (else (slib:error 'batch:system 'failed strings))))
(define (batch:try-system parms . strings)
(define port (batch:port parms))
@@ -71,21 +83,19 @@
((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))))
+ ((system) (cond ((provided? 'system)
+ (write `(system ,(apply string-join " " strings)) port)
+ (newline port)
+ (system:success? (system (apply string-join " " strings))))
+ (else #f)))
((*unknown*) (write `(system ,(apply string-join " " strings)) port)
(newline port)
#f)))
-(define (batch:run-script parms . strings)
+(define (batch:run-script parms name . 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)))
+ ((vms) (batch:system parms (string-append "@" name) strings))
+ (else (batch:system parms name strings))))
(define (batch:comment parms . lines)
(define port (batch:port parms))
@@ -135,6 +145,7 @@
(batch-line parms (string-append "$EOD"))))
((system) (write `(delete-file ,file) port) (newline port)
(delete-file file)
+ (require 'pretty-print)
(pretty-print `(call-with-output-file ,file
(lambda (fp)
(for-each
@@ -147,6 +158,7 @@
#t)
((*unknown*)
(write `(delete-file ,file) port) (newline port)
+ (require 'pretty-print)
(pretty-print
`(call-with-output-file ,file
(lambda (fp)
@@ -175,6 +187,7 @@
(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 " " "REN" 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))
@@ -184,7 +197,7 @@
(define (batch:call-with-output-script parms name proc)
(case (batch:dialect parms)
- ((unix) ((cond ((string? name)
+ ((unix) ((cond ((and (string? name) (provided? 'system))
(lambda (proc)
(let ((ans (call-with-output-file name proc)))
(system (string-append "chmod +x " name))
@@ -239,7 +252,7 @@
port)))
(proc port))))
- ((system) ((cond ((string? name)
+ ((system) ((cond ((and (string? name) (provided? 'system))
(lambda (proc)
(let ((ans (call-with-output-file name
(lambda (port) (proc name)))))
@@ -258,7 +271,7 @@
port)))
(proc port))))
- ((*unknown*) ((cond ((string? name)
+ ((*unknown*) ((cond ((and (string? name) (provided? 'system))
(lambda (proc)
(let ((ans (call-with-output-file name
(lambda (port) (proc name)))))
@@ -290,6 +303,7 @@
(write `(,NAME ,@args) port)
(newline port)
(apply (slib:eval NAME) args))
+ ((not (provided? 'system)) #f)
(else
(let ((pl (make-parameter-list (map car parms))))
(adjoin-parameters!
@@ -305,6 +319,15 @@
(adjoin-parameters! new-parms (list 'batch-port batch-port))
(apply BATCHER new-parms args)))))))))))
+(define (truncate-up-to str chars)
+ (define (tut str)
+ (do ((i (string-length str) (+ -1 i)))
+ ((or (zero? i) (memv (string-ref str (+ -1 i)) chars))
+ (substring str i (string-length str)))))
+ (cond ((char? chars) (set! chars (list chars)))
+ ((string? chars) (set! chars (string->list chars))))
+ (if (string? str) (tut str) (map tut str)))
+
(define (replace-suffix str old new)
(define (cs str)
(let* ((len (string-length str))
@@ -372,6 +395,7 @@
((name symbol))
((os-family batch-dialect))
(;;(3b1 *unknown*)
+ (*unknown* *unknown*)
(acorn *unknown*)
(aix unix)
(alliant *unknown*)
@@ -392,26 +416,27 @@
(linux unix)
(mac *unknown*)
(masscomp unix)
- (ms-dos dos)
(mips *unknown*)
+ (ms-dos dos)
(ncr *unknown*)
(newton *unknown*)
(next unix)
(novell *unknown*)
(os/2 dos)
+ (osf1 unix)
(prime *unknown*)
(psion *unknown*)
(pyramid *unknown*)
(sequent *unknown*)
(sgi *unknown*)
(stratus *unknown*)
- (sun-os unix)
+ (sunos unix)
(transputer *unknown*)
(unicos unix)
(unix unix)
(vms vms)
- (*unknown* *unknown*)
)))
((database 'add-domain) '(operating-system operating-system #f symbol #f))
)
+
diff --git a/byte.scm b/byte.scm
new file mode 100644
index 0000000..3d091ce
--- /dev/null
+++ b/byte.scm
@@ -0,0 +1,14 @@
+;;; "byte.scm" small integers, not necessarily chars.
+
+(define (byte-ref str ind) (char->integer (string-ref str ind)))
+(define (byte-set! str ind val) (string-set! str ind (integer->char val)))
+(define (make-bytes len . opt)
+ (if (null? opt) (make-string len)
+ (make-string len (integer->char (car opt)))))
+(define (write-byte byt . opt) (apply write-char (integer->char byt) opt))
+(define (read-byte . opt)
+ (let ((c (apply read-char opt)))
+ (if (eof-object? c) c (char->integer c))))
+(define (bytes . args) (list->bytes args))
+(define (bytes->list bts) (map char->integer (string->list bts)))
+(define (list->bytes lst) (list->string (map integer->char lst)))
diff --git a/chez.init b/chez.init
index a91cce3..b158304 100644
--- a/chez.init
+++ b/chez.init
@@ -1,6 +1,7 @@
-;"chez.init" Initialization file for SLIB for Chez Scheme -*-scheme-*-
+;"chez.init" Initialization file for SLIB for Chez Scheme 5.0c -*-scheme-*-
; Copyright (C) 1993 dorai@cs.rice.edu (Dorai Sitaram)
-; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+; Copyright (C) 1991, 1992, 1993, 1994, 1997 Aubrey Jaffer.
+; Adapted to version 5.0c by stone@math.grin.edu (John David Stone) 1997
;
;Permission to copy this software, to redistribute it, and to use it
;for any purpose is granted, subject to the following restrictions and
@@ -18,68 +19,180 @@
;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.
+;; The SOFTWARE-TYPE procedure returns a symbol indicating the generic
+;; operating system type. UNIX, VMS, MACOS, AMIGA and MS-DOS are
+;; supported.
-(define (software-type) 'UNIX)
+(define software-type
+ (lambda () 'unix))
-(define (scheme-implementation-type) 'Chez)
+;; The SCHEME-IMPLEMENTATION-TYPE procedure returns a symbol denoting the
+;; Scheme implementation that loads this file.
-;;; (scheme-implementation-version) should return a string describing
-;;; the version the scheme implementation loading this file.
+(define scheme-implementation-type
+ (lambda () 'chez))
-(define (scheme-implementation-version) "?")
+;; The SCHEME-IMPLEMENTATION-VERSION procedure returns a string describing
+;; the version of the Scheme implementation that loads this file.
+
+(define scheme-implementation-version
+ (lambda () "5.0c"))
+
+;; The IMPLEMENTATION-VICINITY procedure returns a string giving the
+;; pathname of the directory that includes any auxiliary files used by this
+;; Scheme implementation.
(define implementation-vicinity
- (lambda () "/usr/local/lib/scheme/"))
+ (lambda () "/usr/local/chez/5.0c/"))
+
+;; The GETENV returns the value of a shell environment variable.
+
+;; In some implementations of Chez Scheme, this can be done with foreign
+;; procedures. However, I [JDS] am using the HP version, which does not
+;; support them, so a different approach is needed.
+;;
+;; Here's the version that doesn't work on HPs:
+;;
+;; (provide-foreign-entries '("getenv"))
+;;
+;; (define getenv
+;; (foreign-procedure "getenv"
+;; (string) string))
+;;
+;; And here's a version that parses the value out of the output of the
+;; /bin/env command:
+
+(define getenv
+ (lambda (env-var)
+ (let ((env-port (car (process "exec /bin/env")))
+ (read-line
+ (lambda (source)
+ (let ((next (peek-char source)))
+ (if (eof-object? next)
+ next
+ (let loop ((ch (read-char source))
+ (so-far '()))
+ (if (or (eof-object? ch)
+ (char=? ch #\newline))
+ (apply string (reverse so-far))
+ (loop (read-char source) (cons ch so-far))))))))
+ (position-of-copula
+ (lambda (str)
+ (let ((len (string-length str)))
+ (do ((position 0 (+ position 1)))
+ ((or (= position len)
+ (char=? (string-ref str position) #\=))
+ position))))))
+ (let loop ((equation (read-line env-port)))
+ (if (eof-object? equation)
+ #f
+ (let ((break (position-of-copula equation))
+ (len (string-length equation)))
+ (if (string=? (substring equation 0 break) env-var)
+ (if (= break len)
+ ""
+ (substring equation (+ break 1) len))
+ (loop (read-line env-port)))))))))
+
+;; The LIBRARY-VICINITY procedure returns the pathname of the directory
+;; where Scheme library functions reside.
+
+(define library-vicinity
+ (let ((library-path (or (getenv "SCHEME_LIBRARY_PATH")
+ "/usr/local/lib/slib/")))
+ (lambda () library-path)))
-;; library-vicinity is moved below the defination of getenv
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-path)))
+
+;; The OUTPUT-PORT-WIDTH procedure returns the number of graphic characters
+;; that can reliably be displayed on one line of the standard output port.
+
+(define output-port-width
+ (lambda arg
+ (let ((env-width-string (getenv "COLUMNS")))
+ (if (and env-width-string
+ (let loop ((remaining (string-length env-width-string)))
+ (or (zero? remaining)
+ (let ((next (- remaining 1)))
+ (and (char-numeric? (string-ref env-width-string
+ next))
+ (loop next))))))
+ (- (string->number env-width-string) 1)
+ 79))))
+
+;; The OUTPUT-PORT-HEIGHT procedure returns the number of lines of text
+;; that can reliably be displayed simultaneously in the standard output
+;; port.
+
+(define output-port-height
+ (lambda arg
+ (let ((env-height-string (getenv "LINES")))
+ (if (and env-height-string
+ (let loop ((remaining (string-length env-height-string)))
+ (or (zero? remaining)
+ (let ((next (- remaining 1)))
+ (and (char-numeric? (string-ref env-height-string
+ next))
+ (loop next))))))
+ (string->number env-height-string)
+ 24))))
+
+;; *FEATURES* is a list of symbols describing features of this
+;; implementation; SLIB procedures sometimes consult this list to figure
+;; out whether to attempt some incompletely standard operation.
(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
+ '(source ; Chez Scheme can load Scheme source files, with the
+ ; command (slib:load-source "filename") -- see below.
+
+ compiled ; Chez Scheme can also load compiled Scheme files, with the
+ ; command (slib:load-compiled "filename") -- see below.
+
+ char-ready? delay dynamic-wind eval 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 string-port system transcript values with-file))
+
+;; Version 5.0c has R4RS macros, but not defmacro.
+
+(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 base:eval eval)
+(define (defmacro:eval x) (base:eval (defmacro:expand* x)))
+(define (defmacro:expand* x)
+ (require 'defmacroexpand) (apply defmacro:expand* x '()))
+
+;; Chez's sorting routines take parameters in the order opposite to SLIB's.
+;; The following definitions override the predefined procedures with the
+;; parameters-reversed versions.
+
(define chez:sort sort)
(define chez:sort! sort!)
(define chez:merge merge)
@@ -98,82 +211,106 @@
(lambda (s1 s2 p)
(chez:merge! p s1 s2)))
-;RENAME-FILE
+;; 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))))))
+
+;; Chez's NIL variable is bound to '(); SLIB's is bound to #F.
+
+(define nil #f)
+
+;; SLIB provides identifiers for the TAB (ASCII 9) and FORM-FEED (ASCII 12)
+;; characters.
+
+(define slib:tab #\tab)
+(define slib:form-feed #\page)
+
+;; The following definitions implement a few widely useful procedures that
+;; Chez Scheme does not provide or provides under a different name.
+
+;; The RENAME-FILE procedure constructs and executes a Unix mv command to
+;; change the name of a file.
+
(define rename-file
(lambda (src dst)
(system (string-append "mv " src " " dst))))
-;OUTPUT-PORT-WIDTH
-(define output-port-width (lambda arg 79))
+;; The CURRENT-ERROR-PORT procedure returns a port to which error
+;; messages are to be displayed; this is the original standard output
+;; port (even if the program subsequently changes the current output port
+;; somehow).
-;;; (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.
+;; SLIB provides its own version of the ERROR procedure.
+
+(define slib:error
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Error: " port)
+ (for-each (lambda (x) (display x port)) args)
+ (error #f ""))))
+
+;; The TMPNAM procedure constructs and returns a temporary file name,
+;; presumably unique and not a duplicate of one already existing.
+
(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))
+ (lambda ()
+ (set! cntr (+ 1 cntr))
+ (let ((tmp (string-append "slib_" (number->string cntr))))
+ (if (file-exists? tmp) (tmpnam) tmp)))))
-(define library-vicinity
- (let ((library-path (or (getenv "SCHEME_LIBRARY_PATH")
- "/usr/local/lib/slib/")))
- (lambda () library-path)))
+;; The FORCE-OUTPUT requires buffered output that has been written to a
+;; port to be transferred all the way out to its ultimate destination.
-;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)
+;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;; port versions of CALL-WITH-INPUT-FILE and CALL-WITH-OUTPUT-FILE.
-;Chez's MOST-POSITIVE-FIXNUM is a thunk rather than a number
-(if (procedure? most-positive-fixnum)
- (set! most-positive-fixnum (most-positive-fixnum)))
+(define call-with-output-string
+ (lambda (f)
+ (let ((outsp (open-output-string)))
+ (f outsp)
+ (let ((s (get-output-string outsp)))
+ (close-output-port outsp)
+ s))))
-;;; Return argument
-(define (identity x) x)
+(define call-with-input-string
+ (lambda (s f)
+ (let* ((insp (open-input-string s))
+ (res (f insp)))
+ (close-input-port insp)
+ res)))
-(define slib:eval eval)
+;; CHAR-CODE-LIMIT is the number of characters in the character set; only
+;; non-negative integers less than CHAR-CODE-LIMIT are eligible as
+;; arguments to INTEGER->CHAR.
+
+(define char-code-limit 256)
+
+;; Chez's MOST-POSITIVE-FIXNUM is a thunk rather than a number.
-(define-macro! defmacro z `(define-macro! ,@z))
+(if (procedure? most-positive-fixnum)
+ (set! most-positive-fixnum (most-positive-fixnum)))
-(define (defmacro? m) (get m '*expander*))
+;; The IDENTITY procedure returns its argument without change.
-(define macroexpand-1 eps-expand-once)
+(define identity
+ (lambda (x) x))
-(define (macroexpand e)
- (if (pair? e) (let ((a (car e)))
- (if (and (symbol? a) (getprop a '*expander*))
- (macroexpand (expand-once e))
- e))
- e))
+;; The GENTEMP procedure generates unused symbols and marks them as
+;; belonging to the SLIB package.
(define gentemp
(let ((*gensym-counter* -1))
@@ -182,54 +319,45 @@
(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)
+;; The IN-VICINITY procedure is simply STRING-APPEND, conventionally used
+;; to attach a directory pathname to the name of a file that is expected to
+;; be in that directory.
-(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 in-vicinity string-append)
-(define slib:error
- (lambda args
- (let ((port (current-error-port)))
- (display "Error: " port)
- (for-each (lambda (x) (display x port)) args)
- (error #f ""))))
+;; For backward compatability, the SCHEME-FILE-SUFFIX procedure is defined
+;; to return the string ".scm". Note, however, that ".ss" is a common Chez
+;; file suffix.
-(define slib:tab #\tab)
-(define slib:form-feed #\page)
+(define scheme-file-suffix
+ (lambda () ".scm"))
-;Chez's nil variable is bound to '() rather than #f
+;; SLIB appropriates Chez Scheme's EVAL procedure.
-(define nil #f)
+(define slib:eval eval)
+(define macro:eval slib:eval)
-(define in-vicinity string-append)
+(define slib:eval-load
+ (lambda (<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))))))
+
+;; SLIB:EXIT is the implementation procedure that exits, or returns
+;; if exiting is not supported.
-;;; 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)])))
+ (let ((arg (call-with-current-continuation identity)))
+ (cond ((procedure? arg) arg)
+ (arg (exit))
+ (else (exit 1)))))
(define slib:exit
(lambda args
@@ -239,28 +367,29 @@
((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")
+;; The SLIB:LOAD-SOURCE procedure, given a string argument, should attach
+;; the appropriate file suffix to the string and load the file named
+;; by the resulting string.
-;;; (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
+ (lambda (f)
+ (load (string-append f (scheme-file-suffix)))))
-(define (slib:load-source f) (load (string-append f (scheme-file-suffix))))
+;;; defmacro:load and macro:load also need the default 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.
+;; The SLIB:LOAD-COMPILED procedure, given a string argument, finds and
+;; loads the file, assumed to have been compiled.
(define slib:load-compiled load)
-;;; At this point SLIB:LOAD must be able to load SLIB files.
+;; SLIB:LOAD can now be defined to load SLIB files.
(define slib:load slib:load-source)
+;; Load the REQUIRE package.
+
(slib:load (in-vicinity (library-vicinity) "require"))
-;end chez.init
+
+;; end of chez.init
diff --git a/cltime.scm b/cltime.scm
index 248f638..441e7f9 100644
--- a/cltime.scm
+++ b/cltime.scm
@@ -1,5 +1,5 @@
;;;; "cltime.scm" Common-Lisp time conversion routines.
-;;; Copyright (C) 1994 Aubrey Jaffer.
+;;; Copyright (C) 1994, 1997 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
@@ -18,8 +18,11 @@
;each case.
(require 'values)
+(require 'time-zone)
(require 'posix-time)
+(define time:1900 (time:invert time:gmtime '#(0 0 0 1 0 0 #f #f 0 0 "GMT")))
+
(define (get-decoded-time)
(decode-universal-time (get-universal-time)))
@@ -27,13 +30,11 @@
(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)
- ""))))
+ (let ((tv (apply time:split
+ (offset-time time:1900 utime)
+ (if (null? tzarg)
+ (tz:params utime (tzset))
+ (list 0 (* 3600 (car tzarg)) "???")))))
(values
(vector-ref tv 0) ;second [0..59]
(vector-ref tv 1) ;minute [0..59]
@@ -41,18 +42,18 @@
(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)
+ (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))))
+ (let* ((tz (if (null? tzarg)
+ (tzset)
+ (time-zone (string-append
+ "???" (number->string (car tzarg))))))
(tv (vector second
minute
hour
@@ -61,14 +62,6 @@
(+ -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))))
+ (difftime (time:invert localtime tv) time:1900)))
-(tzset)
diff --git a/comlist.scm b/comlist.scm
index 2c243fe..1751c7f 100644
--- a/comlist.scm
+++ b/comlist.scm
@@ -137,6 +137,9 @@
(rev-it rev-it rev-cdr))
((begin (set-cdr! rev-it reved) (null? rev-cdr)) rev-it)))))
+(define (comlist:last lst n)
+ (comlist:nthcdr (- (length lst) n) lst))
+
(define (comlist:butlast lst n)
(letrec ((l (- (length lst) n))
(bl (lambda (lst n)
@@ -151,8 +154,15 @@
(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))
+(define (comlist:butnthcdr n lst)
+ (letrec ((bn (lambda (lst n)
+ (cond ((null? lst) lst)
+ ((positive? n)
+ (cons (car lst) (bn (cdr lst) (+ -1 n))))
+ (else '())))))
+ (bn lst (if (negative? n)
+ (slib:error "negative argument to butnthcdr" n)
+ n))))
;;;; CONDITIONALS
@@ -211,7 +221,7 @@
(else
(case obj-type
((char) (case result-type
- ((number) (char->integer obj))
+ ((number integer) (char->integer obj))
((string) (string obj))
((symbol) (string->symbol (string obj)))
((list) (list obj))
@@ -220,6 +230,7 @@
((number) (case result-type
((char) (integer->char obj))
((atom) obj)
+ ((integer) obj)
((string) (number->string obj))
((symbol) (string->symbol (number->string obj)))
((list) (string->list (number->string obj)))
@@ -229,14 +240,14 @@
((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)))
+ ((number integer) (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))
+ ((number integer) (coerce (symbol->string obj) 'number))
((string) (symbol->string obj))
((atom) obj)
((list) (string->list (symbol->string obj)))
@@ -247,7 +258,8 @@
(char? (car obj)))
(car obj)
(err)))
- ((number) (or (string->number (list->string obj)) (err)))
+ ((number integer)
+ (or (string->number (list->string obj)) (err)))
((string) (list->string obj))
((symbol) (string->symbol (list->string obj)))
((vector) (list->vector obj))
@@ -257,7 +269,8 @@
(char? (vector-ref obj 0)))
(vector-ref obj 0)
(err)))
- ((number) (or (string->number (coerce obj string)) (err)))
+ ((number integer)
+ (or (string->number (coerce obj string)) (err)))
((string) (list->string (vector->list obj)))
((symbol) (string->symbol (coerce obj string)))
((list) (list->vector obj))
@@ -310,9 +323,10 @@
(define remove-if-not comlist:remove-if-not)
(define nconc comlist:nconc)
(define nreverse comlist:nreverse)
+(define last comlist:last)
(define butlast comlist:butlast)
(define nthcdr comlist:nthcdr)
-(define last comlist:last)
+(define butnthcdr comlist:butnthcdr)
(define and? comlist:and?)
(define or? comlist:or?)
(define has-duplicates? comlist:has-duplicates?)
diff --git a/comparse.scm b/comparse.scm
index add47c8..9066e36 100644
--- a/comparse.scm
+++ b/comparse.scm
@@ -1,5 +1,5 @@
;;; "comparse.scm" Break command line into arguments.
-;Copyright (C) 1995 Aubrey Jaffer
+;Copyright (C) 1995, 1997 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
@@ -20,73 +20,80 @@
;;;; This is a simple command-line reader. It could be made fancier
;;; to handle lots of `shell' syntaxes.
+;;; Albert L. Ting points out that a similar process can be used for
+;;; reading files of options -- therefore READ-OPTIONS-FILE.
+
(require 'string-port)
-(define (read-command . port)
+(define (read-command-from-port port nl-term?)
(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 backslash
+ (lambda (goto)
+ (readc)
+ (let ((c (readc)))
+ (cond ((eqv? #\newline c) (goto (peekc)))
+ ((and (char-whitespace? c) (eqv? #\newline (peekc))
+ (eqv? 13 (char->integer c)))
+ (readc) (goto (peekc)))
+ (else (set! chars (cons c 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)))))))
+ ((#\#) (do ((c (readc) (readc)))
+ ((or (eof-object? c) (eqv? #\newline c))
+ (if nl-term? c (loop (peekc))))))
+ ((#\;) (readc))
+ ((#\newline) (readc) (and (not nl-term?) (loop (peekc))))
+ (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 buildit
+ (lambda ()
+ (readc)
+ (set! argv (cons (string-append obj (list->string (reverse chars)))
+ argv))))
(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))))
+ ((#\;) (buildit))
+ (else (cond ((or (eof-object? c) (char-whitespace? c))
+ (buildit)
+ (cond ((not (and nl-term? (eqv? c #\newline)))
+ (set! obj "")
+ (set! chars '())
+ (loop (peekc)))))
+ (else (set! chars (cons (readc) chars))
+ (build-token (peekc))))))))
(let ((c (loop (peekc))))
(cond ((and (null? argv) (eof-object? c)) c)
(else (reverse argv)))))
+
+(define (read-command . port)
+ (read-command-from-port (cond ((null? port) (current-input-port))
+ ((= 1 (length port)) (car port))
+ (else
+ (slib:error 'read-command
+ "Wrong Number of ARGs:" port)))
+ #t))
+
+(define (read-options-file filename)
+ (call-with-input-file filename
+ (lambda (port) (read-command-from-port port #f))))
diff --git a/cring.scm b/cring.scm
new file mode 100644
index 0000000..3f594bc
--- /dev/null
+++ b/cring.scm
@@ -0,0 +1,480 @@
+;;;"cring.scm" Extend Scheme numerics to any commutative ring.
+;Copyright (C) 1997 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 'common-list-functions)
+(require 'relational-database)
+(require 'database-utilities)
+(require 'sort)
+
+(define (symbol-alpha? sym)
+ (char-alphabetic? (string-ref (symbol->string sym) 0)))
+(define (expression-< x y)
+ (cond ((and (number? x) (number? y)) (> x y)) ;want negatives last
+ ((number? x) #t)
+ ((number? y) #f)
+ ((and (symbol? x) (symbol? y))
+ (cond ((eqv? (symbol-alpha? x) (symbol-alpha? y))
+ (string<? (symbol->string x) (symbol->string y)))
+ (else (symbol-alpha? x))))
+ ((symbol? x) #t)
+ ((symbol? y) #f)
+ ((null? x) #t)
+ ((null? y) #f)
+ ((expression-< (car x) (car y)) #t)
+ ((expression-< (car y) (car x)) #f)
+ (else (expression-< (cdr x) (cdr y)))))
+(define (expression-sort seq) (sort! seq expression-<))
+
+(define cring:db (create-database #f 'alist-table))
+(define-tables cring:db
+ `(operation
+ ((op symbol)
+ (sub-op1 symbol)
+ (sub-op2 symbol))
+ ((reduction expression))
+ (;; This is the distributive rule (* over +)
+ (* + identity
+ ,(lambda (exp1 exp2)
+ ;;(print 'distributing '* '+ exp1 exp2 '==>)
+ (apply + (map (lambda (trm) (* trm exp2)) (cdr exp1)))))
+ (* - identity
+ ,(lambda (exp1 exp2)
+ ;;(print 'distributing '* '- exp1 exp2 '==>)
+ (apply - (map (lambda (trm) (* trm exp2)) (cdr exp1)))))
+ (/ + identity
+ ,(lambda (exp1 exp2)
+ ;;(print 'distributing '/ '+ exp1 exp2 '==>)
+ (apply + (map (lambda (trm) (/ trm exp2)) (cdr exp1)))))
+ (/ - identity
+ ,(lambda (exp1 exp2)
+ ;;(print 'distributing '/ '- exp1 exp2 '==>)
+ (apply - (map (lambda (trm) (/ trm exp2)) (cdr exp1))))))))
+
+(define cring:op-tab ((cring:db 'open-table) 'operation #t))
+(define cring:rule (cring:op-tab 'get 'reduction))
+(define cring:defrule (cring:op-tab 'row:update))
+(define (cring:define-rule . args) (cring:defrule args))
+
+(define number* *)
+(define number+ +)
+(define number- -)
+(define number/ /)
+(define number^ integer-expt)
+(define is-term-op? (lambda (term op) (and (pair? term) (eq? op (car term)))))
+;;(define (sign x) (if (positive? x) 1 (if (negative? x) -1 0)))
+(define number0? zero?)
+(define (zero? x) (and (number? x) (number0? x)))
+
+(define (make-rat n d)
+ (let* ((g (if (negative? d) (number- (gcd n d)) (gcd n d)))
+ (n/g (quotient n g))
+ (d/g (quotient d g)))
+ (case d/g
+ ((1) n/g)
+ (else
+ (case n/g
+ ((0) 0)
+ ((1) (list '/ d/g))
+ (else (list '/ n/g d/g)))))))
+
+(define (rat-number? r)
+ (and (list? r)
+ (<= 2 (length r) 3)
+ (eq? '/ (car r))
+ (every number? (cdr r))))
+
+(define (rat-numerator r)
+ (cond ((number? r) r)
+ ((rat-number? r)
+ (case (length r)
+ ((2) 1)
+ ((3) (cadr r))))
+ (else (slib:error 'rat-numerator "of non-rat" r))))
+
+(define (rat-denominator r)
+ (cond ((number? r) 1)
+ ((rat-number? r)
+ (case (length r)
+ ((2) (cadr r))
+ ((3) (caddr r))))
+ (else (slib:error 'rat-denominator "of non-rat" r))))
+
+;; To convert to CR internal form, NUMBER-op all the `numbers' in the
+;; argument list and remove them from the argument list. Collect the
+;; remaining arguments into equivalence classes, keeping track of the
+;; number of arguments in each class. The returned list is thus:
+;; (<numeric> (<expression1> . <exp1>) ...)
+
+;;; Converts * argument list to CR internal form
+(define (cr*-args->fcts args)
+ ;;(print (cons 'cr*-args->fcts args) '==>)
+ (let loop ((args args) (pow 1) (nums 1) (denoms 1) (arg.exps '()))
+ ;;(print (list 'loop args pow nums denoms arg.exps) '==>)
+ (cond ((null? args) (cons (make-rat nums denoms) arg.exps))
+ ((number? (car args))
+ (let ((num^pow (number^ (car args) (abs pow))))
+ (if (negative? pow)
+ (loop (cdr args) pow nums (number* num^pow denoms) arg.exps)
+ (loop (cdr args) pow (number* num^pow nums) denoms arg.exps))))
+ ((rat-number? (car args))
+ (let ((num^pow (number^ (rat-numerator (car args)) (abs pow)))
+ (den^pow (number^ (rat-denominator (car args)) (abs pow))))
+ (if (negative? pow)
+ (loop (cdr args) pow
+ (number* den^pow nums)
+ (number* num^pow denoms) arg.exps)
+ (loop (cdr args) pow
+ (number* num^pow nums)
+ (number* den^pow denoms) arg.exps))))
+ ;; Associative Rule
+ ((is-term-op? (car args) '*) (loop (append (cdar args) (cdr args))
+ pow
+ nums denoms
+ arg.exps))
+ ;; Do singlet -
+ ((and (is-term-op? (car args) '-) (= 2 (length (car args))))
+ ;;(print 'got-here (car args))
+ (set! arg.exps (loop (cdar args) pow (number- nums) denoms arg.exps))
+ (loop (cdr args) pow
+ (rat-numerator (car arg.exps))
+ (rat-denominator (car arg.exps))
+ (cdr arg.exps)))
+ ((and (is-term-op? (car args) '/) (= 2 (length (car args))))
+ ;; Do singlet /
+ ;;(print 'got-here=cr+ (car args))
+ (set! arg.exps (loop (cdar args) (number- pow) nums denoms arg.exps))
+ (loop (cdr args) pow
+ (rat-numerator (car arg.exps))
+ (rat-denominator (car arg.exps))
+ (cdr arg.exps)))
+ ((is-term-op? (car args) '/)
+ ;; Do multi-arg /
+ ;;(print 'doing '/ (cddar args) (number- pow))
+ (set! arg.exps
+ (loop (cddar args) (number- pow) nums denoms arg.exps))
+ ;;(print 'finishing '/ (cons (cadar args) (cdr args)) pow)
+ (loop (cons (cadar args) (cdr args))
+ pow
+ (rat-numerator (car arg.exps))
+ (rat-denominator (car arg.exps))
+ (cdr arg.exps)))
+ ;; Pull out numeric exponents as powers
+ ((and (is-term-op? (car args) '^)
+ (= 3 (length (car args)))
+ (number? (caddar args)))
+ (set! arg.exps (loop (list (cadar args))
+ (number* pow (caddar args))
+ nums denoms
+ arg.exps))
+ (loop (cdr args) pow
+ (rat-numerator (car arg.exps))
+ (rat-denominator (car arg.exps)) (cdr arg.exps)))
+ ;; combine with same terms
+ ((assoc (car args) arg.exps)
+ => (lambda (pair) (set-cdr! pair (number+ pow (cdr pair)))
+ (loop (cdr args) pow nums denoms arg.exps)))
+ ;; Add new term to arg.exps
+ (else (loop (cdr args) pow nums denoms
+ (cons (cons (car args) pow) arg.exps))))))
+
+;;; Converts + argument list to CR internal form
+(define (cr+-args->trms args)
+ (let loop ((args args) (cof 1) (numbers 0) (arg.exps '()))
+ (cond ((null? args) (cons numbers arg.exps))
+ ((number? (car args))
+ (loop (cdr args)
+ cof
+ (number+ (number* (car args) cof) numbers)
+ arg.exps))
+ ;; Associative Rule
+ ((is-term-op? (car args) '+) (loop (append (cdar args) (cdr args))
+ cof
+ numbers
+ arg.exps))
+ ;; Idempotent singlet *
+ ((and (is-term-op? (car args) '*) (= 2 (length (car args))))
+ (loop (cons (cadar args) (cdr args))
+ cof
+ numbers
+ arg.exps))
+ ((and (is-term-op? (car args) '-) (= 2 (length (car args))))
+ ;; Do singlet -
+ (set! arg.exps (loop (cdar args) (number- cof) numbers arg.exps))
+ (loop (cdr args) cof (car arg.exps) (cdr arg.exps)))
+ ;; Pull out numeric factors as coefficients
+ ((and (is-term-op? (car args) '*) (some number? (cdar args)))
+ ;;(print 'got-here (car args) '=> (cons '* (remove-if number? (cdar args))))
+ (set! arg.exps
+ (loop (list (cons '* (remove-if number? (cdar args))))
+ (apply number* cof (remove-if-not number? (cdar args)))
+ numbers
+ arg.exps))
+ (loop (cdr args) cof (car arg.exps) (cdr arg.exps)))
+ ((is-term-op? (car args) '-)
+ ;; Do multi-arg -
+ (set! arg.exps (loop (cddar args) (number- cof) numbers arg.exps))
+ (loop (cons (cadar args) (cdr args))
+ cof
+ (car arg.exps)
+ (cdr arg.exps)))
+ ;; combine with same terms
+ ((assoc (car args) arg.exps)
+ => (lambda (pair) (set-cdr! pair (number+ cof (cdr pair)))
+ (loop (cdr args) cof numbers arg.exps)))
+ ;; Add new term to arg.exps
+ (else (loop (cdr args) cof numbers
+ (cons (cons (car args) cof) arg.exps))))))
+
+;;; Converts + or * internal form to Scheme expression
+(define (cr-terms->form op ident inv-op higher-op res.cofs)
+ (define (negative-cof? fct.cof)
+ (negative? (cdr fct.cof)))
+ (define (finish exprs)
+ (if (null? exprs) ident
+ (if (null? (cdr exprs))
+ (car exprs)
+ (cons op exprs))))
+ (define (do-terms sign fct.cofs)
+ (expression-sort
+ (map (lambda (fct.cof)
+ (define cof (number* sign (cdr fct.cof)))
+ (cond ((eqv? 1 cof) (car fct.cof))
+ ((number? (car fct.cof)) (number* cof (car fct.cof)))
+ ((is-term-op? (car fct.cof) higher-op)
+ (if (eq? higher-op '^)
+ (list '^ (cadar fct.cof) (* cof (caddar fct.cof)))
+ (cons higher-op (cons cof (cdar fct.cof)))))
+ ((eqv? -1 cof) (list inv-op (car fct.cof)))
+ (else (list higher-op (car fct.cof) cof))))
+ fct.cofs)))
+ (let* ((all.cofs (remove-if (lambda (fct.cof)
+ (or (zero? (cdr fct.cof))
+ (eqv? ident (car fct.cof))))
+ res.cofs))
+ (cofs (map cdr all.cofs))
+ (some-positive? (some positive? cofs)))
+ ;;(print op 'positive? some-positive? 'negative? (some negative? cofs) all.cofs)
+ (cond ((and some-positive? (some negative? cofs))
+ (append (list inv-op
+ (finish (do-terms
+ 1 (remove-if negative-cof? all.cofs))))
+ (do-terms -1 (remove-if-not negative-cof? all.cofs))))
+ (some-positive? (finish (do-terms 1 all.cofs)))
+ ((not (some negative? cofs)) ident)
+ (else (list inv-op (finish (do-terms -1 all.cofs)))))))
+
+(define (* . args)
+ (cond
+ ((null? args) 1)
+ ;;((null? (cdr args)) (car args))
+ (else
+ (let ((in (cr*-args->fcts args)))
+ (cond
+ ((zero? (car in)) 0)
+ (else
+ (if (null? (cdr in))
+ (set-cdr! in (list (cons 1 1))))
+ (let* ((num #f)
+ (ans (cr-terms->form
+ '* 1 '/ '^
+ (apply
+ (lambda (numeric red.cofs res.cofs)
+ (append
+ (cond ((number? numeric)
+ (set! num numeric)
+ (list (cons (abs numeric) 1)))
+ (else
+ (set! num (rat-numerator numeric))
+ (list (cons (abs num) 1)
+ (cons (rat-denominator numeric) -1))))
+ red.cofs
+ res.cofs))
+ (cr1 '* number* '^ '/ (car in) (cdr in))))))
+ (if (negative? num) (list '- ans) ans))))))))
+
+(define (+ . args)
+ (cond ((null? args) 0)
+ ;;((null? (cdr args)) (car args))
+ (else
+ (let ((in (cr+-args->trms args)))
+ (if (null? (cdr in))
+ (car in)
+ (cr-terms->form
+ '+ 0 '- '*
+ (apply (lambda (numeric red.cofs res.cofs)
+ (append
+ (list (if (and (number? numeric)
+ (negative? numeric))
+ (cons (abs numeric) -1)
+ (cons numeric 1)))
+ red.cofs
+ res.cofs))
+ (cr1 '+ number+ '* '- (car in) (cdr in)))))))))
+
+(define (- arg1 . args)
+ (if (null? args)
+ (if (number? arg1) (number- arg1)
+ (* -1 arg1) ;(list '- arg1)
+ )
+ (+ arg1 (* -1 (apply + args)))))
+
+;;(print `(/ ,arg1 ,@args) '=> )
+(define (/ arg1 . args)
+ (if (null? args)
+ (^ arg1 -1)
+ (* arg1 (^ (apply * args) -1))))
+
+(define (^ arg1 arg2)
+ (cond ((and (number? arg2) (integer? arg2))
+ (* (list '^ arg1 arg2)))
+ (else (list '^ arg1 arg2))))
+
+;; TRY-EACH-PAIR-ONCE algorithm. I think this does the minimum
+;; number of rule lookups given no information about how to sort
+;; terms.
+
+;; Pick equivalence classes one at a time and move them into the
+;; result set of equivalence classes by searching for rules to
+;; multiply an element of the chosen class by itself (if multiple) and
+;; the element of each class already in the result group. Each
+;; (multiplicative) term resulting from rule application would be put
+;; in the result class, if that class exists; or put in an argument
+;; class if not.
+
+(define (cr1 op number-op hop inv-op numeric in)
+ (define red.pows '())
+ (define res.pows '())
+ (let loop.arg.pow.s ((arg (caar in)) (pow (cdar in)) (arg.pows (cdr in)))
+ (define (arg-loop arg.pows)
+ (if (null? arg.pows)
+ (list numeric red.pows res.pows)
+ (loop.arg.pow.s (caar arg.pows) (cdar arg.pows) (cdr arg.pows))))
+ (define (cring:apply-rule->terms exp1 exp2)
+ ;;(display op)
+ (let ((ans (cring:apply-rule op exp1 exp2)))
+ (cond ((not ans) #f)
+ ((number? ans) (list ans))
+ (else (list (cons ans 1))))))
+ (define (cring:apply-inv-rule->terms exp1 exp2)
+ ;;(display inv-op)
+ (let ((ans (cring:apply-rule inv-op exp1 exp2)))
+ (cond ((not ans) #f)
+ ((number? ans) (list ans))
+ (else (list (cons ans 1))))))
+ (define (merge-res tmp.pows multiplicity)
+ (cond ((null? tmp.pows))
+ ((number? (car tmp.pows))
+ (do ((m (number+ -1 (abs multiplicity)) (number+ -1 m))
+ (n numeric (number-op n (abs (car tmp.pows)))))
+ ((negative? m) (set! numeric n)))
+ (merge-res (cdr tmp.pows) multiplicity))
+ ((or (assoc (car tmp.pows) res.pows)
+ (assoc (car tmp.pows) arg.pows))
+ => (lambda (pair)
+ (set-cdr! pair (number+
+ pow (number-op multiplicity (cdar tmp.pows))))
+ (merge-res (cdr tmp.pows) multiplicity)))
+ ((assoc (car tmp.pows) red.pows)
+ => (lambda (pair)
+ (set! arg.pows
+ (cons (cons (caar tmp.pows)
+ (number+
+ (cdr pair)
+ (number* multiplicity (cdar tmp.pows))))
+ arg.pows))
+ (set-cdr! pair 0)
+ (merge-res (cdr tmp.pows) multiplicity)))
+ (else (set! arg.pows
+ (cons (cons (caar tmp.pows)
+ (number* multiplicity (cdar tmp.pows)))
+ arg.pows))
+ (merge-res (cdr tmp.pows) multiplicity))))
+ (define (try-fct.pow fct.pow)
+ ;;(print 'try-fct.pow fct.pow op 'arg arg 'pow pow)
+ (cond ((or (zero? (cdr fct.pow)) (number? (car fct.pow))) #f)
+ ((not (and (number? pow) (number? (cdr fct.pow))
+ (integer? pow) ;(integer? (cdr fct.pow))
+ ))
+ #f)
+ ;;((zero? pow) (slib:error "Don't try exp-0 terms") #f)
+ ;;((or (number? arg) (number? (car fct.pow)))
+ ;; (slib:error 'found-number arg fct.pow) #f)
+ ((and (positive? pow) (positive? (cdr fct.pow))
+ (or (cring:apply-rule->terms arg (car fct.pow))
+ (cring:apply-rule->terms (car fct.pow) arg)))
+ => (lambda (terms)
+ ;;(print op op terms)
+ (let ((multiplicity (min pow (cdr fct.pow))))
+ (set-cdr! fct.pow (number- (cdr fct.pow) multiplicity))
+ (set! pow (number- pow multiplicity))
+ (merge-res terms multiplicity))))
+ ((and (negative? pow) (negative? (cdr fct.pow))
+ (or (cring:apply-rule->terms arg (car fct.pow))
+ (cring:apply-rule->terms (car fct.pow) arg)))
+ => (lambda (terms)
+ ;;(print inv-op inv-op terms)
+ (let ((multiplicity (max pow (cdr fct.pow))))
+ (set-cdr! fct.pow (number+ (cdr fct.pow) multiplicity))
+ (set! pow (number+ pow multiplicity))
+ (merge-res terms multiplicity))))
+ ((and (positive? pow) (negative? (cdr fct.pow))
+ (cring:apply-inv-rule->terms arg (car fct.pow)))
+ => (lambda (terms)
+ ;;(print op inv-op terms)
+ (let ((multiplicity (min pow (number- (cdr fct.pow)))))
+ (set-cdr! fct.pow (number+ (cdr fct.pow) multiplicity))
+ (set! pow (number- pow multiplicity))
+ (merge-res terms multiplicity))))
+ ((and (negative? pow) (positive? (cdr fct.pow))
+ (cring:apply-inv-rule->terms (car fct.pow) arg))
+ => (lambda (terms)
+ ;;(print inv-op op terms)
+ (let ((multiplicity (max (number- pow) (cdr fct.pow))))
+ (set-cdr! fct.pow (number- (cdr fct.pow) multiplicity))
+ (set! pow (number+ pow multiplicity))
+ (merge-res terms multiplicity))))
+ (else #f)))
+ ;;(print op numeric 'arg arg 'pow pow 'arg.pows arg.pows 'red.pows red.pows 'res.pows res.pows)
+ ;;(trace arg-loop cring:apply-rule->terms merge-res try-fct.pow) (set! *qp-width* 333)
+ (cond ((or (zero? pow) (number? arg)) (arg-loop arg.pows))
+ ((assoc arg res.pows) => (lambda (pair)
+ (set-cdr! pair (number+ pow (cdr pair)))
+ (arg-loop arg.pows)))
+ ((and (> (abs pow) 1) (cring:apply-rule->terms arg arg))
+ => (lambda (terms)
+ (merge-res terms (quotient pow 2))
+ (if (odd? pow)
+ (loop.arg.pow.s arg 1 arg.pows)
+ (arg-loop arg.pows))))
+ ((or (some try-fct.pow res.pows) (some try-fct.pow arg.pows))
+ (loop.arg.pow.s arg pow arg.pows))
+ (else (set! res.pows (cons (cons arg pow) res.pows))
+ (arg-loop arg.pows)))))
+
+(define (cring:try-rule op sop1 sop2 exp1 exp2)
+ (let ((rule (cring:rule op sop1 sop2)))
+ (and rule (rule exp1 exp2))))
+
+(define (cring:apply-rule op exp1 exp2)
+ (and (pair? exp1)
+ (or (and (pair? exp2)
+ (cring:try-rule op (car exp1) (car exp2) exp1 exp2))
+ (cring:try-rule op (car exp1) 'identity exp1 exp2))))
+
+;;(begin (trace cr-terms->form) (set! *qp-width* 333))
diff --git a/dbutil.scm b/dbutil.scm
index ffaaf9d..e99b073 100644
--- a/dbutil.scm
+++ b/dbutil.scm
@@ -1,5 +1,5 @@
;;; "dbutil.scm" relational-database-utilities
-; Copyright 1994, 1995 Aubrey Jaffer
+; Copyright 1994, 1995, 1997 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
@@ -18,6 +18,7 @@
;each case.
(require 'relational-database)
+(require 'common-list-functions)
(define (db:base-type path)
'alist-table) ; currently the only one.
@@ -82,7 +83,7 @@
(2 #f name #f symbol)
(3 #f arity #f parameter-arity)
(4 #f domain #f domain)
- (5 #f default #f expression)
+ (5 #f defaulter #f expression)
(6 #f expander #f expression)
(7 #f documentation #f string)))
'(no-parameters
@@ -146,7 +147,7 @@
(options ((parameter-table 'get* 'name)))
(positions ((parameter-table 'get* 'index)))
(arities ((parameter-table 'get* 'arity)))
- (defaults (map slib:eval ((parameter-table 'get* 'default))))
+ (defaulters (map slib:eval ((parameter-table 'get* 'defaulter))))
(domains ((parameter-table 'get* 'domain)))
(types (map (((rdb 'open-table) '*domains-data* #f) 'get 'type-id)
domains))
@@ -156,7 +157,7 @@
(map (parameter-table 'get 'name)
((parameter-names 'get* 'parameter-index))))))
(command-callback comname comval options positions
- arities types defaults dirs aliases)))))
+ arities types defaulters dirs aliases)))))
(define (dbutil:define-tables rdb . spec-list)
(define new-tables '())
diff --git a/debian/changelog b/debian/changelog
index 2b01f25..a91b6e1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,24 @@
+slib (2c0-3) unstable; urgency=low
+
+ * New maintainer.
+ * slibconfig script to automatically configure guile.
+ * Fix type in description, closes: Bug#18996
+
+ -- Jim Pick <jim@jimpick.com> Sun, 8 Mar 1998 23:05:22 -0800
+
+slib (2c0-2) unstable; urgency=low
+
+ * Minor fix for debian/rules targets
+
+ -- Rob Browning <rlb@cs.utexas.edu> Fri, 12 Dec 1997 17:35:22 -0600
+
+slib (2c0-1) unstable; urgency=low
+
+ * New upstream source
+ * New maintainer
+
+ -- Rob Browning <rlb@cs.utexas.edu> Fri, 12 Dec 1997 16:49:13 -0600
+
slib (2a6-1) unstable; urgency=low
* First Debian release.
diff --git a/debian/control b/debian/control
index c262c5c..b71a19b 100644
--- a/debian/control
+++ b/debian/control
@@ -1,13 +1,13 @@
Source: slib
Section: devel
Priority: optional
-Maintainer: Karl Sackett <krs@debian.org>
+Maintainer: Jim Pick <jim@jimpick.com>
Standards-Version: 2.1.1.2
Package: slib
Architecture: all
Description: Portable Scheme library.
- SLIB is a portable scheme library meant to provide compatibiliy and
+ SLIB is a portable scheme library meant to provide compatibility 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
diff --git a/debian/copyright b/debian/copyright
index f2b5931..65247b2 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -1,14 +1,30 @@
This is the Debian GNU/Linux prepackaged version of slib.
-This package was put together by Karl Sackett <krs@debian.org>,
+This package was put together by Rob Browning <rlb@cs.utexas.edu>
from sources obtained from:
- ftp://swiss-ftp.ai.mit.edu/archive/scm/slib2a6.tar.gz
+ ftp://swiss-ftp.ai.mit.edu/archive/scm/slib2c0.tar.gz
For more information see:
http://www-swiss.ai.mit.edu/~jaffer/SLIB.html
-License:
+The source files are all subject to the following copyright:
-scm is distributed under the GNU General Public License.
+; Copyright (C) 1991, 1992, 1993, 1994, 1997 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.
diff --git a/debian/postinst b/debian/postinst
index de5756a..a00d1a5 100644
--- a/debian/postinst
+++ b/debian/postinst
@@ -1,6 +1,7 @@
#!/bin/sh
set -e
-#
+
install-info --quiet --section "Development" "Development" \
--description="The SLIB portable Scheme library" \
/usr/info/slib.info.gz
+/usr/sbin/slibconfig
diff --git a/debian/postrm b/debian/postrm
index 18f9b39..03e39ad 100644
--- a/debian/postrm
+++ b/debian/postrm
@@ -1,4 +1,4 @@
#!/bin/sh
set -e
-#
+
install-info --quiet --remove slib
diff --git a/debian/rules b/debian/rules
index f36c459..e76c9fb 100755
--- a/debian/rules
+++ b/debian/rules
@@ -1,5 +1,5 @@
#! /usr/bin/make -f
-#
+# -*-Makefile-*-
CC =gcc
CFLAGS =-O2 -g -Wall
@@ -14,63 +14,70 @@ INSTALL_PROGRAM =$(INSTALL) -m 755 -o root -g root
INSTALL_DATA =$(INSTALL) -m 644 -o root -g root
INSTALL_MAN =$(INSTALL) -m 444 -o root -g root
-config:
- $(checkdir)
- touch stamp-config
-
build:
$(checkdir)
- test -f stamp-config || make -f debian/rules config
make
texi2html -monolithic slib.texi
- touch stamp-build
+ touch build
clean:
$(checkdir)
- test -f stamp-config || make -f debian/rules config
-rm slib.html
+ -rm slib.info*
make clean
- -rm -f stamp-config stamp-build
- -rm -rf debian/tmp* debian/files debian/substvars
+ -rm -f build
+ -rm -rf debian/tmp* *~ debian/*~ debian/files debian/substvars
binary-arch: checkroot
$(checkdir)
-binary-indep: checkroot
+binary-indep: checkroot build
$(checkdir)
-rm -rf debian/tmp*
- test -f stamp-build || make -f debian/rules build
-#
-#
+
# debian/tmp
$(INSTALL_DIR) debian/tmp
$(INSTALL_DIR) debian/tmp/DEBIAN
$(INSTALL_PROGRAM) debian/postinst debian/tmp/DEBIAN
$(INSTALL_PROGRAM) debian/postrm debian/tmp/DEBIAN
+
# library
$(INSTALL_DIR) debian/tmp/usr/lib/slib
$(INSTALL_DATA) *.scm debian/tmp/usr/lib/slib
+
# documentation
$(INSTALL_DIR) debian/tmp/usr/doc/slib
$(INSTALL_DATA) debian/copyright debian/tmp/usr/doc/slib
$(INSTALL_DATA) debian/changelog \
debian/tmp/usr/doc/slib/changelog.Debian
- gzip -9 debian/tmp/usr/doc/slib/changelog.Debian
-#
+ gzip -9v debian/tmp/usr/doc/slib/changelog.Debian
+
$(INSTALL_DATA) ChangeLog debian/tmp/usr/doc/slib
- gzip -9 debian/tmp/usr/doc/slib/ChangeLog
+ gzip -9v debian/tmp/usr/doc/slib/ChangeLog
$(INSTALL_DATA) README debian/tmp/usr/doc/slib
+ gzip -9v debian/tmp/usr/doc/slib/README
$(INSTALL_DATA) FAQ debian/tmp/usr/doc/slib
+ gzip -9v debian/tmp/usr/doc/slib/FAQ
$(INSTALL_DATA) slib.html debian/tmp/usr/doc/slib
-#
- $(INSTALL_DIR) debian/tmp/usr/doc/slib/init
- $(INSTALL_DATA) *.init debian/tmp/usr/doc/slib/init
+
+ $(INSTALL_DIR) debian/tmp/usr/lib/slib/init
+ $(INSTALL_DATA) *.init debian/tmp/usr/lib/slib/init
+
# info pages
$(INSTALL_DIR) debian/tmp/usr/info
$(INSTALL_DATA) slib.info* debian/tmp/usr/info
- gzip -9 debian/tmp/usr/info/*
-#
- dpkg-gencontrol -isp -pslib -Pdebian/tmp
+ gzip -9v debian/tmp/usr/info/*
+
+# slibconfig
+
+ $(INSTALL_DIR) debian/tmp/usr/sbin
+ $(INSTALL_PROGRAM) debian/slibconfig debian/tmp/usr/sbin
+ $(INSTALL_DIR) debian/tmp/usr/man/man8
+ (cd debian/tmp/usr/man/man8; \
+ ln -s ../man7/undocumented.7.gz slibconfig.8.gz \
+ )
+
+ dpkg-gencontrol
dpkg --build debian/tmp ..
define checkdir
diff --git a/debian/slibconfig b/debian/slibconfig
new file mode 100644
index 0000000..05eee30
--- /dev/null
+++ b/debian/slibconfig
@@ -0,0 +1,7 @@
+#! /bin/sh
+
+if [ -d /usr/share/guile -a -x /usr/bin/guile ]; then
+ (cd /usr/share/guile
+ guile -c "(use-modules (ice-9 slib)) (require 'new-catalog)"
+ )
+fi
diff --git a/determ.scm b/determ.scm
new file mode 100644
index 0000000..4b53e5f
--- /dev/null
+++ b/determ.scm
@@ -0,0 +1,14 @@
+;"determ.scm" Determinant
+
+(define (determinant m)
+ (define (butnth n lst)
+ (if (zero? n) (cdr lst) (cons (car lst) (butnth (+ -1 n) (cdr lst)))))
+ (define (minor m i j)
+ (map (lambda (x) (butnth j x)) (butnth i m)))
+ (define (cofactor m i j)
+ (* (if (odd? (+ i j)) -1 1) (determinant (minor m i j))))
+ (define n (length m))
+ (if (eqv? 1 n) (caar m)
+ (do ((j (+ -1 n) (+ -1 j))
+ (ans 0 (+ ans (* (list-ref (car m) j) (cofactor m 0 j)))))
+ ((negative? j) ans))))
diff --git a/elk.init b/elk.init
index f6dded0..6f09672 100644
--- a/elk.init
+++ b/elk.init
@@ -1,5 +1,5 @@
;;;"elk.init" Initialisation file for SLIB for ELK 2.1 -*- Scheme -*-
-;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;;; Copyright (C) 1991, 1992, 1993, 1994, 1997 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
@@ -41,7 +41,7 @@
;;; (scheme-implementation-version) should return a string describing
;;; the version the scheme implementation loading this file.
-(define (scheme-implementation-version) "?2.1")
+(define (scheme-implementation-version) "3.0")
;;; (implementation-vicinity) should be defined to be the pathname of
;;; the directory where any auxillary files to your Scheme
@@ -56,6 +56,10 @@
;;; (library-vicinity) should be defined to be the pathname of the
;;; directory where files of Scheme library functions reside.
+(require 'unix)
+(define getenv unix-getenv)
+(define system unix-system)
+
(define library-vicinity
(let ((library-path
(or (getenv "SCHEME_LIBRARY_PATH")
@@ -67,6 +71,14 @@
(else "")))))
(lambda () library-path)))
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-path)))
+
;;; *features* should be set to a list of symbols describing features
;;; of this implementation. Suggestions for features are:
@@ -117,8 +129,6 @@
(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.
@@ -218,8 +228,24 @@
(evl o))
(set! *load-pathname* old-load-pathname)))))
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;;; define an error procedure for the library
-(define slib:error error)
+(define slib:error
+ (lambda args
+ (let ((port (open-output-string))
+ (err (if (and (pair? args) (symbol? (car args)))
+ (car args) 'slib))
+ (args (if (and (pair? args) (symbol? (car args)))
+ (cdr args) args)))
+ (for-each (lambda (x) (display x port) (display " " port)) args)
+ (let ((str (get-output-string port)))
+ (close-output-port port)
+ (error err str)))))
;;; define these as appropriate for your system.
(define slib:tab #\tab)
diff --git a/factor.scm b/factor.scm
index a5d3e8c..6d7b38d 100644
--- a/factor.scm
+++ b/factor.scm
@@ -51,9 +51,11 @@
;;; 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"))
+ (for-each (lambda (s)
+ (set! s (string->number s))
+ (set! p (or (and s (exact? s) s) p)))
+ '("2310" "30030" "510510" "9699690" "223092870"
+ "6469693230" "200560490130"))
p))
(define (prime:prime? n)
diff --git a/formatst.scm b/formatst.scm
index 7a2173e..370a39c 100644
--- a/formatst.scm
+++ b/formatst.scm
@@ -82,7 +82,7 @@
(test '("~a" #t) "#t")
(test '("~a" #f) "#f")
(test '("~a" "abc") "abc")
-(test '("~a" #(1 2 3)) "#(1 2 3)")
+(test '("~a" '#(1 2 3)) "#(1 2 3)")
(test '("~a" ()) "()")
(test '("~a" (a)) "(a)")
(test '("~a" (a b)) "(a b)")
diff --git a/gambit.init b/gambit.init
index 47717dc..752d9d0 100644
--- a/gambit.init
+++ b/gambit.init
@@ -1,5 +1,5 @@
;;;"gambit.init" Initialisation for SLIB for Gambit -*-scheme-*-
-;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer
+;;; Copyright (C) 1991, 1992, 1993, 1994, 1997 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
@@ -21,27 +21,32 @@
;;; Date: Wed, 12 Jan 1994 15:03:12 -0500
;;; From: barnett@armadillo.urich.edu (Lewis Barnett)
;;; Relative pathnames for Slib in MacGambit
+;;; Hacked yet again for Gambit v2.4, Jan 1997, by Mike Pope
-(define (SOFTWARE-TYPE) 'UNIX) ; 'MACOS for 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
+(define (scheme-implementation-version) "2.4")
;;; (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)))))))
+ (case (software-type)
+ ((UNIX) (lambda () "/usr/local/src/scheme/"))
+ ((VMS) (lambda () "scheme$src:"))
+ ((MS-DOS) (lambda () "C:\\scheme\\"))
+ ((WINDOWS) (lambda () "c:/scheme/"))
+ ((MACOS)
+ (let ((arg0 (list-ref (argv) 0)))
+ (let loop ((i (- (string-length arg0) 1)))
+ (cond ((negative? i) "")
+ ((char=? #\: (string-ref arg0 i))
+ (set! arg0 (substring arg0 0 (+ i 1)))
+ (lambda () arg0))
+ (else (loop (- i 1)))))))))
;;; (library-vicinity) should be defined to be the pathname of the
;;; directory where files of Scheme library functions reside.
@@ -56,39 +61,77 @@
((MACOS) (string-append (implementation-vicinity) ":slib:"))
((AMIGA) "dh0:scm/Library/")
((VMS) "lib$scheme:")
- ((MS-DOS) "C:\\SLIB\\")
+ ((WINDOWS 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.
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define (home-vicinity) #f)
+
+;;; *FEATURES* should be set to a list of symbols describing features
+;;; of this implementation. Suggestions for features are:
(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
+ 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
- with-file
- transcript
+ 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?
- ieee-floating-point
- full-continuation
- )))
+; 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)
@@ -102,39 +145,56 @@
(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 tmpnam (let ((cntr 100))
+ (lambda () (set! cntr (+ 1 cntr))
+ (string-append "slib_" (number->string cntr)))))
+
+;;; Gambit supports SYSTEM as an "Unstable Addition"; Watch for changes.
+(define system ##shell-command)
+
+;;; (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)
+(define force-output flush-output)
+
+;;; 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 #x1FFFFFFF) ;; 3-bit tag for 68K
+(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
+;;; 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
+(define slib:eval eval)
+
+; Define program-arguments as argv
+(define program-arguments argv)
;;; If your implementation provides R4RS macros:
;(define macro:eval slib:eval)
;(define macro:load load)
+; Set up defmacro in terms of gambit's define-macro
+(define-macro (defmacro name args . body)
+ `(define-macro (,name ,@args) ,@body))
+
(define *defmacros*
(list (cons 'defmacro
(lambda (name parms . body)
`(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body))
- *defmacros*))))))
+ *defmacros*))))))
(define (defmacro? m) (and (assq m *defmacros*) #t))
(define (macroexpand-1 e)
@@ -160,9 +220,7 @@
(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:eval base:eval)
(define (defmacro:load <pathname>)
(slib:eval-load <pathname> defmacro:eval))
@@ -179,13 +237,27 @@
(evl o))
(set! *load-pathname* old-load-pathname)))))
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;; define an error procedure for the library
-(define SLIB:ERROR error)
+(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+)
@@ -197,8 +269,11 @@
(define slib:exit (lambda args (exit)))
;;; Here for backward compatability
-
-(define (scheme-file-suffix) ".scm")
+(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.
@@ -216,4 +291,3 @@
(define slib:load slib:load-source)
(slib:load (in-vicinity (library-vicinity) "require"))
-;;; --- E O F ---
diff --git a/macscheme.init b/macscheme.init
index 56c53a2..281bcec 100644
--- a/macscheme.init
+++ b/macscheme.init
@@ -1,5 +1,5 @@
;;;"macscheme.init" Configuration of *features* for MacScheme -*-scheme-*-
-;Copyright (C) 1994 Aubrey Jaffer
+;Copyright (C) 1994, 1997 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
@@ -45,6 +45,12 @@
(define (library-vicinity) "Macintosh.HD:MacScheme 4.2:slib:")
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define (home-vicinity) #f)
+
;;; *FEATURES* should be set to a list of symbols describing features
;;; of this implementation. Suggestions for features are:
@@ -215,6 +221,12 @@
(evl o))
(set! *load-pathname* old-load-pathname)))))
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;;; define an error procedure for the library
(define slib:error
(lambda args
diff --git a/makcrc.scm b/makcrc.scm
index b11f80e..72e26d9 100644
--- a/makcrc.scm
+++ b/makcrc.scm
@@ -1,5 +1,5 @@
;;;; "makcrc.scm" Compute Cyclic Checksums
-;;; Copyright (C) 1995, 1996 Aubrey Jaffer.
+;;; Copyright (C) 1995, 1996, 1997 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
@@ -17,10 +17,11 @@
;promotional, or sales literature without prior written consent in
;each case.
+(require 'logical)
+
;;;(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 (file-check-sum file) (call-with-input-file file crc32))
(define (make-port-crc . margs)
(define (make-mask hibit)
diff --git a/mbe.scm b/mbe.scm
index e48e1f1..d39a2f7 100644
--- a/mbe.scm
+++ b/mbe.scm
@@ -1,5 +1,5 @@
-;;;; "mbe.scm" "Macro by Example" (Eugene Kohlbecker, r4rs)
-;;; From: Dorai Sitaram, dorai@cs.rice.edu, 1991, revised Sept. 3, 1992,
+;;;; "mbe.scm" "Macro by Example" (Eugene Kohlbecker, R4RS)
+;;; From: Dorai Sitaram, dorai@cs.rice.edu, 1991, 1997
;
;Permission to copy this software, to redistribute it, and to use it
;for any purpose is granted, subject to the following restrictions and
@@ -17,89 +17,192 @@
;promotional, or sales literature without prior written consent in
;each case.
-;;; revised Dec. 6, 1993 to r4rs syntax (if not semantics).
+;;; revised Dec. 6, 1993 to R4RS syntax (if not semantics).
;;; revised Mar. 2 1994 for SLIB (jaffer@ai.mit.edu).
+;;; corrections, Apr. 24, 1997.
-;;; A vanilla implementation of Macro-by-Example (Eugene
-;;; Kohlbecker, r4rs). This file requires defmacro.
+;;; A vanilla implementation of hygienic macro-by-example as described
+;;; by Eugene Kohlbecker and in R4RS Appendix. 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:rassq
+ (lambda (k al)
+ (let loop ((al al))
+ (if (null? al) #f
+ (let ((c (car al)))
+ (if (eq? (cdr c) k) c
+ (loop (cdr al))))))))
-;(define hyg:tag-generic
-; (lambda (e kk tmps) e))
+(define hyg:tag
+ (lambda (e kk al)
+ (cond ((pair? e)
+ (let* ((a-te-al (hyg:tag (car e) kk al))
+ (d-te-al (hyg:tag (cdr e) kk (cdr a-te-al))))
+ (cons (cons (car a-te-al) (car d-te-al))
+ (cdr d-te-al))))
+ ((vector? e)
+ (list->vector
+ (hyg:tag (vector->list e) kk al)))
+ ((symbol? e)
+ (cond ((eq? e '...) (cons '... al))
+ ((memq e kk) (cons e al))
+ ((hyg:rassq e al) =>
+ (lambda (c)
+ (cons (car c) al)))
+ (else
+ (let ((te (gentemp)))
+ (cons te (cons (cons te e) al))))))
+ (else (cons e al)))))
-;;; if you don't want the hygiene filter, comment out the following
-;;; s-exp and uncomment the previous one.
+;;untagging
-(define hyg:tag-generic
- (lambda (e kk tmps)
+(define hyg:untag
+ (lambda (e al 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))))
+ (let ((a (hyg:untag (car e) al tmps)))
+ (if (list? e)
+ (case a
+ ((quote) (hyg:untag-no-tags e al))
+ ((if begin)
+ `(,a ,@(map (lambda (e1)
+ (hyg:untag e1 al tmps)) (cdr e))))
+ ((set! define)
+ `(,a ,(hyg:untag-vanilla (cadr e) al tmps)
+ ,@(map (lambda (e1)
+ (hyg:untag e1 al tmps)) (cddr e))))
+ ((lambda) (hyg:untag-lambda (cadr e) (cddr e) al tmps))
+ ((letrec) (hyg:untag-letrec (cadr e) (cddr e) al tmps))
+ ((let)
+ (let ((e2 (cadr e)))
+ (if (symbol? e2)
+ (hyg:untag-named-let e2 (caddr e) (cdddr e) al tmps)
+ (hyg:untag-let e2 (cddr e) al tmps))))
+ ((let*) (hyg:untag-let* (cadr e) (cddr e) al tmps))
+ ((do) (hyg:untag-do (cadr e) (caddr e) (cdddr e) al tmps))
+ ((case)
+ `(case ,(hyg:untag-vanilla (cadr e) al tmps)
+ ,@(map
+ (lambda (c)
+ `(,(hyg:untag-vanilla (car c) al tmps)
+ ,@(hyg:untag-list (cdr c) al tmps)))
+ (cddr e))))
+ ((cond)
+ `(cond ,@(map
+ (lambda (c)
+ (hyg:untag-list c al tmps))
+ (cdr e))))
+ (else (cons a (hyg:untag-list (cdr e) al tmps))))
+ (cons a (hyg:untag-list* (cdr e) al tmps))))
+ (hyg:untag-vanilla e al 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:untag-list
+ (lambda (ee al tmps)
+ (map (lambda (e)
+ (hyg:untag e al tmps)) ee)))
-(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:untag-list*
+ (lambda (ee al tmps)
+ (let loop ((ee ee))
+ (if (pair? ee)
+ (cons (hyg:untag (car ee) al tmps)
+ (loop (cdr ee)))
+ (hyg:untag ee al tmps)))))
+
+(define hyg:untag-no-tags
+ (lambda (e al)
+ (cond ((pair? e)
+ (cons (hyg:untag-no-tags (car e) al)
+ (hyg:untag-no-tags (cdr e) al)))
+ ((vector? e)
+ (list->vector
+ (hyg:untag-no-tags (vector->list e) al)))
+ ((not (symbol? e)) e)
+ ((assq e al) => cdr)
+ (else e))))
+
+(define hyg:untag-lambda
+ (lambda (bvv body al tmps)
+ (let ((tmps2 (nconc (hyg:flatten bvv) tmps)))
+ `(lambda ,bvv
+ ,@(hyg:untag-list body al tmps2)))))
+
+(define hyg:untag-letrec
+ (lambda (varvals body al tmps)
+ (let ((tmps (nconc (map car varvals) tmps)))
+ `(letrec
+ ,(map
+ (lambda (varval)
+ `(,(car varval)
+ ,(hyg:untag (cadr varval) al tmps)))
+ varvals)
+ ,@(hyg:untag-list body al tmps)))))
+
+(define hyg:untag-let
+ (lambda (varvals body al tmps)
+ (let ((tmps2 (nconc (map car varvals) tmps)))
+ `(let
+ ,(map
+ (lambda (varval)
+ `(,(car varval)
+ ,(hyg:untag (cadr varval) al tmps)))
+ varvals)
+ ,@(hyg:untag-list body al tmps2)))))
+
+(define hyg:untag-named-let
+ (lambda (lname varvals body al tmps)
+ (let ((tmps2 (cons lname (nconc (map car varvals) tmps))))
+ `(let ,lname
+ ,(map
+ (lambda (varval)
+ `(,(car varval)
+ ,(hyg:untag (cadr varval) al tmps)))
+ varvals)
+ ,@(hyg:untag-list body al tmps2)))))
+
+(define hyg:untag-let*
+ (lambda (varvals body al tmps)
+ (let ((tmps2 (nconc (nreverse (map car varvals)) tmps)))
+ `(let*
+ ,(let loop ((varvals varvals)
+ (i (length varvals)))
+ (if (null? varvals) '()
+ (let ((varval (car varvals)))
+ (cons `(,(car varval)
+ ,(hyg:untag (cadr varval)
+ al (list-tail tmps2 i)))
+ (loop (cdr varvals) (- i 1))))))
+ ,@(hyg:untag-list body al tmps2)))))
+
+(define hyg:untag-do
+ (lambda (varinistps exit-test body al tmps)
+ (let ((tmps2 (nconc (map car varinistps) tmps)))
+ `(do
+ ,(map
+ (lambda (varinistp)
+ (let ((var (car varinistp)))
+ `(,var ,@(hyg:untag-list (cdr varinistp) al
+ (cons var tmps)))))
+ varinistps)
+ ,(hyg:untag-list exit-test al tmps2)
+ ,@(hyg:untag-list body al tmps2)))))
+
+(define hyg:untag-vanilla
+ (lambda (e al tmps)
+ (cond ((pair? e)
+ (cons (hyg:untag-vanilla (car e) al tmps)
+ (hyg:untag-vanilla (cdr e) al tmps)))
+ ((vector? e)
+ (list->vector
+ (hyg:untag-vanilla (vector->list e) al tmps)))
+ ((not (symbol? e)) e)
+ ((memq e tmps) e)
+ ((assq e al) => cdr)
+ (else e))))
(define hyg:flatten
(lambda (e)
@@ -109,100 +212,6 @@
((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
@@ -226,7 +235,7 @@
(and e-head=e-tail
(let ((e-head (car e-head=e-tail))
(e-tail (cdr e-head=e-tail)))
- (and (comlist:every
+ (and (every
(lambda (x) (mbe:matches-pattern? p-head x k))
e-head)
(mbe:matches-pattern? p-tail e-tail k)))))))
@@ -294,7 +303,7 @@
;;; variables in nestings
(define mbe:ellipsis-sub-envs
(lambda (nestings r)
- (comlist:some (lambda (c)
+ (some (lambda (c)
(if (mbe:contained-in? nestings (car c)) (cdr c) #f))
r)))
@@ -302,8 +311,8 @@
(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)
+ (some (lambda (v_i)
+ (some (lambda (y_j)
(mbe:contained-in? v_i y_j))
y))
v))))
@@ -328,33 +337,36 @@
(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))
+ (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))))))))
+ `((mbe:matches-pattern? ',in-pattern macro-arg
+ keywords)
+ (let ((tagged-out-pattern+alist
+ (hyg:tag
+ ',out-pattern
+ (nconc (hyg:flatten ',in-pattern)
+ keywords) '())))
+ (hyg:untag
+ (mbe:expand-pattern
+ (car tagged-out-pattern+alist)
+ (mbe:get-bindings ',in-pattern macro-arg
+ keywords)
+ keywords)
+ (cdr tagged-out-pattern+alist)
+ '())))))
+ clauses)
+ (else (slib:error ',macro-name 'no-matching-clause
+ ',clauses))))))))
(define macro:eval slib:eval)
(define macro:load slib:load)
diff --git a/mitscheme.init b/mitscheme.init
index a6f1c0e..9486c18 100644
--- a/mitscheme.init
+++ b/mitscheme.init
@@ -1,5 +1,5 @@
;;;"mitscheme.init" Initialization for SLIB for MITScheme -*-scheme-*-
-;;; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;;; Copyright (C) 1991, 1992, 1993, 1994, 1997 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
@@ -64,6 +64,14 @@
(else "")))))
(lambda () library-path)))
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-path)))
+
(define *features*
'(
source ;can load scheme source files
@@ -98,8 +106,13 @@
compiler
getenv
Xwindows
+ current-time
))
+(define current-time current-file-time)
+(define difftime -)
+(define offset-time +)
+
;;; (OUTPUT-PORT-WIDTH <port>)
(define output-port-width output-port/x-size)
@@ -213,6 +226,12 @@
(define record-modifier record-updater) ;some versions need this?
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;; define an error procedure for the library
(define (slib:error . args)
(apply error-procedure (append args (list (the-environment)))))
diff --git a/mklibcat.scm b/mklibcat.scm
new file mode 100644
index 0000000..050a3ba
--- /dev/null
+++ b/mklibcat.scm
@@ -0,0 +1,175 @@
+;"mklibcat.scm" Build catalog for SLIB
+;Copyright (C) 1997 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.
+
+(call-with-output-file (in-vicinity (implementation-vicinity) "slibcat")
+ (lambda (op)
+ (display ";\"slibcat\" SLIB catalog for " op)
+ (display (scheme-implementation-type) op)
+ (display (scheme-implementation-version) op)
+ (display ". -*-scheme-*-" op) (newline op)
+ (display ";" op) (newline op)
+ (display "; DO NOT EDIT THIS FILE -- it is automagically generated" op)
+ (newline op) (newline op)
+
+ (display "(" op) (newline op)
+ (for-each
+ (lambda (asp) (display " " op) (write asp op) (newline op))
+ (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")))
+ (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")
+ (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)
+ (yasos macro . "yasos")
+ (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 . "psxtime")
+ (common-lisp-time . "cltime")
+ (time-zone . "timezone")
+ (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")
+ (precedence-parse . "prec")
+ (parse . precedence-parse)
+ (commutative-ring . "cring")
+ (self-set . "selfset")
+ (determinant . "determ")
+ (byte . "byte")
+ (tzfile . "tzfile")
+ (new-catalog . "mklibcat")
+ ))))
+ (display " " op)
+
+ (let* ((req (in-vicinity (library-vicinity)
+ (string-append "require" (scheme-file-suffix)))))
+ (write (cons '*SLIB-VERSION* (or (require:version req) *SLIB-VERSION*))
+ op))
+ (newline op)
+ (display ")" op) (newline op)
+
+ (let ((mkimpcat (in-vicinity (implementation-vicinity) "mkimpcat")))
+ (cond ((not (file-exists? mkimpcat))
+ (set! mkimpcat (string-append mkimpcat (scheme-file-suffix)))))
+ (cond ((file-exists? mkimpcat)
+ (slib:load-source mkimpcat))))
+
+ (let ((catcat
+ (lambda (vicinity name specificity)
+ (let ((path (in-vicinity vicinity name)))
+ (and (file-exists? path)
+ (call-with-input-file path
+ (lambda (ip)
+ (newline op)
+ (display "; " op)
+ (write path op)
+ (display " SLIB " op)
+ (display specificity op)
+ (display "-specific catalog additions" op)
+ (newline op) (newline op)
+ (do ((c (read-char ip) (read-char ip)))
+ ((eof-object? c))
+ (write-char c op)))))))))
+ (catcat (library-vicinity) "sitecat" "site")
+ (catcat (implementation-vicinity) "implcat" "implementation")
+ (catcat (implementation-vicinity) "sitecat" "site"))
+ ))
+
+(set! *catalog* #f)
diff --git a/mularg.scm b/mularg.scm
index 3d62cf4..a327b2b 100644
--- a/mularg.scm
+++ b/mularg.scm
@@ -1,5 +1,7 @@
;;; "mularg.scm" Redefine - and / to take more than 2 arguments.
+(define / /)
+(define - -)
(let ((maker
(lambda (op)
(lambda (d1 . ds)
diff --git a/object.scm b/object.scm
deleted file mode 100644
index 4ba28fb..0000000
--- a/object.scm
+++ /dev/null
@@ -1,97 +0,0 @@
-;;; "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
index f01788b..706c91c 100644
--- a/paramlst.scm
+++ b/paramlst.scm
@@ -1,5 +1,5 @@
;;; "paramlst.scm" passing parameters by name.
-; Copyright 1995 Aubrey Jaffer
+; Copyright 1995, 1996, 1997 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
@@ -43,13 +43,13 @@
(lambda (arity)
(assq arity table))))
-(define (fill-empty-parameters defaults parameter-list)
- (map (lambda (default parameter)
+(define (fill-empty-parameters defaulters parameter-list)
+ (map (lambda (defaulter parameter)
(cond ((null? (cdr parameter))
(cons (car parameter)
- (if default (default parameter-list) '())))
+ (if defaulter (defaulter parameter-list) '())))
(else parameter)))
- defaults parameter-list))
+ defaulters parameter-list))
(define (check-parameters checks parameter-list)
(for-each (lambda (check parameter)
@@ -139,7 +139,8 @@
((expression) val)
(else (coerce val ntyp))))
(require 'getopt)
- (let ((optlist '())
+ (let ((starting-optind *optind*)
+ (optlist '())
(long-opt-list '())
(optstring #f)
(parameter-list (make-parameter-list optnames))
@@ -168,9 +169,55 @@
(let ((opt (getopt-- argc argv optstring)))
(case opt
((#\: #\?)
- (slib:error
- 'getopt->parameter-list "unrecognized option"
- getopt:opt))
+ (let ((aliast (map list optnames))
+ (strlen=1? (lambda (s) (= 1 (string-length s))))
+ (cep (current-error-port)))
+ (require 'printf)
+ (require 'common-list-functions)
+ (for-each (lambda (alias)
+ (let ((apr (assq (cadr alias) aliast)))
+ (set-cdr! apr (cons (car alias) (cdr apr)))))
+ aliases)
+ (fprintf cep "Usage: %s [OPTION ARGUMENT ...] ..."
+ (list-ref argv (+ -1 starting-optind)))
+ (newline cep) (newline cep)
+ (for-each
+ (lambda (optname arity aliat)
+ (let loop ((initials (remove-if-not strlen=1? (cdr aliat)))
+ (longname (remove-if strlen=1? (cdr aliat))))
+ (cond ((and (null? initials) (null? longname)))
+ (else
+ (fprintf cep
+ (case arity
+ ((boolean) " %3s %s")
+ (else " %3s %s<%s> %s"))
+ (if (null? initials)
+ ""
+ (string-append
+ "-" (car initials)
+ (if (null? longname) " " ",")))
+ (if (null? longname)
+ " "
+ (string-append
+ "--" (car longname)
+ (case arity
+ ((boolean) " ")
+ (else "="))))
+ (case arity
+ ((boolean) "")
+ (else optname))
+ (case arity
+ ((nary nary1) "...")
+ (else "")))
+ (newline cep)
+ (loop (if (null? initials) '() (cdr initials))
+ (if (null? longname) '() (cdr longname)))))))
+ optnames arities aliast))
+ (slib:error 'getopt->parameter-list
+ (case opt
+ ((#\:) "argument missing after")
+ ((#\?) "unrecognized option"))
+ (string #\- getopt:opt)))
((#f)
(cond ((and (< *optind* argc)
(string=? "-" (list-ref argv *optind*)))
@@ -201,15 +248,16 @@
(list topt (coerce-val *optarg* curopt))))
(else
(set! curopt topt)
- (rdms:warn
- 'getopt->parameter-list "argument missing for option--" opt))))
+;;; (slib:warn 'getopt->parameter-list
+;;; "= missing for option--" opt)
+ )))
(loop)))))
parameter-list))
(define (getopt->arglist argc argv optnames positions
- arities types defaults checks aliases)
+ arities types defaulters checks aliases)
(let* ((params (getopt->parameter-list
argc argv optnames arities types aliases))
- (fparams (fill-empty-parameters defaults params)))
+ (fparams (fill-empty-parameters defaulters params)))
(and (list? params) (check-parameters checks fparams))
(and (list? params) (parameter-list->arglist positions arities fparams))))
diff --git a/prec.scm b/prec.scm
new file mode 100644
index 0000000..bb66763
--- /dev/null
+++ b/prec.scm
@@ -0,0 +1,438 @@
+; "prec.scm", dynamically extensible parser/tokenizer -*-scheme-*-
+; Copyright 1989, 1990, 1991, 1992, 1993, 1995, 1997 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 implements:
+; * a Pratt style parser.
+; * a tokenizer which congeals tokens according to assigned classes of
+; constituent characters.
+;
+; This module is a significant improvement because grammar can be
+; changed dynamically from rulesets which don't need compilation.
+; Theoretically, all possibilities of bad input are handled and return
+; as much structure as was parsed when the error occured; The symbol
+; `?' is substituted for missing input.
+
+; References for the parser are:
+
+; Pratt, V. R.
+; Top Down Operator Precendence.
+; SIGACT/SIGPLAN
+; Symposium on Principles of Programming Languages,
+; Boston, 1973, 41-51
+
+; WORKING PAPER 121
+; CGOL - an Alternative External Representation For LISP users
+; Vaughan R. Pratt
+; MIT Artificial Intelligence Lab.
+; March 1976
+
+; Mathlab Group,
+; MACSYMA Reference Manual, Version Ten,
+; Laboratory for Computer Science, MIT, 1983
+
+(require 'fluid-let)
+(require 'string-search)
+(require 'string-port)
+(require 'delay)
+
+(define *syn-defs* #f)
+(define *syn-rules* #f) ;Dynamically bound
+(define *prec:port* #f) ;Dynamically bound
+
+;; keeps track of input column so we can generate useful error displays.
+(define tok:column 0)
+(define (tok:peek-char) (peek-char *prec:port*))
+(define (tok:read-char)
+ (let ((c (read-char *prec:port*)))
+ (if (or (eqv? c #\newline) (eof-object? c))
+ (set! tok:column 0)
+ (set! tok:column (+ 1 tok:column)))
+ c))
+(define (tok:bump-column pos . ports)
+ ((lambda (thunk)
+ (cond ((null? ports) (thunk))
+ (else (fluid-let ((*prec:port* (car ports))) (thunk)))))
+ (lambda ()
+ (cond ((eqv? #\newline (tok:peek-char))
+ (tok:read-char))) ;to do newline
+ (set! tok:column (+ tok:column pos)))))
+(define (prec:warn msg)
+ (do ((j (+ -1 tok:column) (+ -8 j)))
+ ((> 8 j)
+ (do ((i j (+ -1 i)))
+ ((>= 0 i))
+ (display #\ )))
+ (display slib:tab))
+ (display "^ ")
+ (display msg)
+ (newline))
+
+;; Structure of lexical records.
+(define tok:make-rec cons)
+(define tok:cc car)
+(define tok:sfp cdr)
+
+(define (tok:lookup alist char)
+ (if (eof-object? char)
+ #f
+ (let ((pair (assv char alist)))
+ (and pair (cdr pair)))))
+
+(define (tok:char-group group chars chars-proc)
+ (map (lambda (token)
+;;; (let ((oldlexrec (tok:lookup *syn-defs* token)))
+;;; (cond ((or (not oldlexrec) (eqv? (tok:cc oldlexrec) group)))
+;;; (else (math:warn 'cc-of token 'redefined-to- group))))
+ (cons token (tok:make-rec group chars-proc)))
+ (cond ((string? chars) (string->list chars))
+ ((char? chars) (list chars))
+ (else chars))))
+
+(define (tokenize)
+ (let* ((char (tok:read-char))
+ (rec (tok:lookup *syn-rules* char))
+ (proc (and rec (tok:cc rec)))
+ (clist (list char)))
+ (cond
+ ((not proc) char)
+ ((procedure? proc)
+ (do ((cl clist (begin (set-cdr! cl (list (tok:read-char))) (cdr cl))))
+ ((proc (tok:peek-char))
+ ((or (tok:sfp rec) list->string) clist))))
+ ((eqv? 0 proc) (tokenize))
+ (else
+ (do ((cl clist (begin (set-cdr! cl (list (tok:read-char))) (cdr cl))))
+ ((not (let* ((prec (tok:lookup *syn-rules* (tok:peek-char)))
+ (cclass (and prec (tok:cc prec))))
+ (or (eqv? cclass proc)
+ (eqv? cclass (+ -1 proc)))))
+ ((tok:sfp rec) clist)))))))
+
+;;; PREC:NUD is the null denotation (function and arguments to call when no
+;;; unclaimed tokens).
+;;; PREC:LED is the left denotation (function and arguments to call when
+;;; unclaimed token is on left).
+;;; PREC:LBP is the left binding power of this LED. It is the first
+;;; argument position of PREC:LED
+
+(define (prec:nudf alist self)
+ (let ((pair (assoc (cons 'nud self) alist)))
+ (and pair (cdr pair))))
+(define (prec:ledf alist self)
+ (let ((pair (assoc (cons 'led self) alist)))
+ (and pair (cdr pair))))
+(define (prec:lbp alist self)
+ (let ((pair (assoc (cons 'led self) alist)))
+ (and pair (cadr pair))))
+
+(define (prec:call-or-list proc . args)
+ (prec:apply-or-cons proc args))
+(define (prec:apply-or-cons proc args)
+ (if (procedure? proc) (apply proc args) (cons (or proc '?) args)))
+
+;;; PREC:SYMBOLFY and PREC:DE-SYMBOLFY are not exact inverses.
+(define (prec:symbolfy obj)
+ (cond ((symbol? obj) obj)
+ ((string? obj) (string->symbol obj))
+ ((char? obj) (string->symbol (string obj)))
+ (else obj)))
+
+(define (prec:de-symbolfy obj)
+ (cond ((symbol? obj) (symbol->string obj))
+ (else obj)))
+
+;;;Calls to set up tables.
+
+(define (prec:define-grammar . synlsts)
+ (set! *syn-defs* (append (apply append synlsts) *syn-defs*)))
+
+(define (prec:make-led toks . args)
+ (map (lambda (tok)
+ (cons (cons 'led (prec:de-symbolfy tok))
+ args))
+ (if (pair? toks) toks (list toks))))
+(define (prec:make-nud toks . args)
+ (map (lambda (tok)
+ (cons (cons 'nud (prec:de-symbolfy tok))
+ args))
+ (if (pair? toks) toks (list toks))))
+
+;;; Produce dynamically augmented grammars.
+(define (prec:process-binds binds rules)
+ (if (and #f (not (null? binds)) (eq? #t (car binds)))
+ (cdr binds)
+ (append binds rules)))
+
+;;(define (prec:replace-rules) some-sort-of-magic-cookie)
+
+;;; Here are the procedures to define high-level grammar, along with
+;;; utility functions called during parsing. The utility functions
+;;; (prec:parse-*) could be incorportated into the defining commands,
+;;; but tracing these functions is useful for debugging.
+
+(define (prec:delim tk)
+ (prec:make-led tk 0 #f))
+
+(define (prec:nofix tk sop)
+ (prec:make-nud tk prec:parse-nofix sop))
+(define (prec:parse-nofix self sop)
+ (prec:call-or-list (or sop (prec:symbolfy self))))
+
+(define (prec:prefix tk sop bp . binds)
+ (prec:make-nud tk prec:parse-prefix sop bp (apply append binds)))
+(define (prec:parse-prefix self sop bp binds)
+ (fluid-let ((*syn-rules* (prec:process-binds binds *syn-rules*)))
+ (prec:call-or-list (or sop (prec:symbolfy self)) (prec:parse1 bp))))
+
+(define (prec:infix tk sop lbp bp . binds)
+ (prec:make-led tk lbp prec:parse-infix sop bp (apply append binds)))
+(define (prec:parse-infix left self lbp sop bp binds)
+ (fluid-let ((*syn-rules* (prec:process-binds binds *syn-rules*)))
+ (prec:call-or-list (or sop (prec:symbolfy self)) left (prec:parse1 bp))))
+
+(define (prec:nary tk sop bp)
+ (prec:make-led tk bp prec:parse-nary sop bp))
+(define (prec:parse-nary left self lbp sop bp)
+ (prec:apply-or-cons (or sop (prec:symbolfy self))
+ (cons left (prec:parse-list self bp))))
+
+(define (prec:postfix tk sop lbp)
+ (prec:make-led tk lbp prec:parse-postfix sop))
+(define (prec:parse-postfix left self lbp sop)
+ (prec:call-or-list (or sop (prec:symbolfy self)) left))
+
+(define (prec:prestfix tk sop bp . binds)
+ (prec:make-nud tk prec:parse-rest sop bp (apply append binds)))
+(define (prec:parse-rest self sop bp binds)
+ (fluid-let ((*syn-rules* (prec:process-binds binds *syn-rules*)))
+ (prec:apply-or-cons (or sop (prec:symbolfy self)) (prec:parse-list #f bp))))
+
+(define (prec:commentfix tk stp match . binds)
+ (append
+ (prec:make-nud tk prec:parse-nudcomment stp match (apply append binds))
+ (prec:make-led tk 220 prec:parse-ledcomment stp match (apply append binds))))
+(define (prec:parse-nudcomment self stp match binds)
+ (fluid-let ((*syn-rules* (prec:process-binds binds *syn-rules*)))
+ (tok:read-through-comment stp match)
+ (prec:advance)
+ (cond ((prec:delim? (force prec:token)) #f)
+ (else (prec:parse1 prec:bp)))))
+(define (prec:parse-ledcomment left lbp self stp match binds)
+ (fluid-let ((*syn-rules* (prec:process-binds binds *syn-rules*)))
+ (tok:read-through-comment stp match)
+ (prec:advance)
+ left))
+(define (tok:read-through-comment stp match)
+ (set! match (if (char? match)
+ (string match)
+ (prec:de-symbolfy match)))
+ (cond ((procedure? stp)
+ (let* ((len #f)
+ (str (call-with-output-string
+ (lambda (sp)
+ (set! len (find-string-from-port?
+ match *prec:port*
+ (lambda (c) (display c sp) #f)))))))
+ (stp (and len (substring str 0 (- len (string-length match)))))))
+ (else (find-string-from-port? match *prec:port*))))
+
+(define (prec:matchfix tk sop sep match . binds)
+ (define sep-lbp 0)
+ (prec:make-nud tk prec:parse-matchfix
+ sop sep-lbp sep match
+ (apply append (prec:delim match) binds)))
+(define (prec:parse-matchfix self sop sep-lbp sep match binds)
+ (fluid-let ((*syn-rules* (prec:process-binds binds *syn-rules*)))
+ (cond (sop (prec:apply-or-cons
+ sop (prec:parse-delimited sep sep-lbp match)))
+ ((equal? (force prec:token) match)
+ (prec:warn 'expression-missing)
+ (prec:advance)
+ '?)
+ (else (let ((ans (prec:parse1 0))) ;just parenthesized expression
+ (cond ((equal? (force prec:token) match)
+ (prec:advance))
+ ((prec:delim? (force prec:token))
+ (prec:warn 'mismatched-delimiter)
+ (prec:advance))
+ (else (prec:warn 'delimiter-expected--ignoring-rest)
+ (do () ((prec:delim? (force prec:token)))
+ (prec:parse1 0))))
+ ans)))))
+
+(define (prec:inmatchfix tk sop sep match lbp . binds)
+ (define sep-lbp 0)
+ (prec:make-led tk lbp prec:parse-inmatchfix
+ sop sep-lbp sep match
+ (apply append (prec:delim match) binds)))
+(define (prec:parse-inmatchfix left self lbp sop sep-lbp sep match binds)
+ (fluid-let ((*syn-rules* (prec:process-binds binds *syn-rules*)))
+ (prec:apply-or-cons
+ sop (cons left (prec:parse-delimited sep sep-lbp match)))))
+
+;;;; Here is the code which actually parses.
+
+(define prec:bp #f) ;dynamically bound
+(define prec:token #f)
+(define (prec:advance)
+ (set! prec:token (delay (tokenize))))
+(define (prec:advance-return-last)
+ (let ((last (and prec:token (force prec:token))))
+ (prec:advance)
+ last))
+
+(define (prec:nudcall self)
+ (let ((pob (prec:nudf *syn-rules* self)))
+ (cond
+ (pob (let ((proc (car pob)))
+ (cond ((procedure? proc) (apply proc self (cdr pob)))
+ (proc (cons proc (cdr pob)))
+ (else '?))))
+ ((char? self) (prec:warn 'extra-separator)
+ (prec:advance)
+ (prec:nudcall (force prec:token)))
+ ((string? self) (string->symbol self))
+ (else self))))
+
+(define (prec:ledcall left self)
+ (let* ((pob (prec:ledf *syn-rules* self)))
+ (apply (cadr pob) left self (cdr pob))))
+
+;;; PREC:PARSE1 is the heart.
+(define (prec:parse1 bp)
+ (fluid-let ((prec:bp bp))
+ (do ((left (prec:nudcall (prec:advance-return-last))
+ (prec:ledcall left (prec:advance-return-last))))
+ ((or (>= bp 200) ;to avoid unneccesary lookahead
+ (>= bp (or (prec:lbp *syn-rules* (force prec:token)) 0))
+ (not left))
+ left))))
+
+(define (prec:delim? token)
+ (or (eof-object? token) (<= (or (prec:lbp *syn-rules* token) 220) 0)))
+
+(define (prec:parse-list sep bp)
+ (cond ((prec:delim? (force prec:token))
+ (prec:warn 'expression-missing)
+ '(?))
+ (else
+ (let ((f (prec:parse1 bp)))
+ (cons f (cond ((equal? (force prec:token) sep)
+ (prec:advance)
+ (cond ((equal? (force prec:token) sep)
+ (prec:warn 'expression-missing)
+ (prec:advance)
+ (cons '? (prec:parse-list sep bp)))
+ ((prec:delim? (force prec:token))
+ (prec:warn 'expression-missing)
+ '(?))
+ (else (prec:parse-list sep bp))))
+ ((prec:delim? (force prec:token)) '())
+ ((not sep) (prec:parse-list sep bp))
+ ((prec:delim? sep) (prec:warn 'separator-missing)
+ (prec:parse-list sep bp))
+ (else '())))))))
+
+(define (prec:parse-delimited sep bp delim)
+ (cond ((equal? (force prec:token) sep)
+ (prec:warn 'expression-missing)
+ (prec:advance)
+ (cons '? (prec:parse-delimited sep delim)))
+ ((prec:delim? (force prec:token))
+ (if (not (equal? (force prec:token) delim))
+ (prec:warn 'mismatched-delimiter))
+ (if (not sep) (prec:warn 'expression-missing))
+ (prec:advance)
+ (if sep '() '(?)))
+ (else (let ((ans (prec:parse-list sep bp)))
+ (cond ((equal? (force prec:token) delim))
+ ((prec:delim? (force prec:token))
+ (prec:warn 'mismatched-delimiter))
+ (else (prec:warn 'delimiter-expected--ignoring-rest)
+ (do () ((prec:delim? (force prec:token)))
+ (prec:parse1 bp))))
+ (prec:advance)
+ ans))))
+
+(define (prec:parse grammar delim . port)
+ (set! delim (prec:de-symbolfy delim))
+ (fluid-let ((*syn-rules* (append (prec:delim delim) grammar))
+ (*prec:port* (if (null? port) (current-input-port) (car port))))
+ (prec:advance) ; setup prec:token with first token
+ (cond ((eof-object? (force prec:token)) (force prec:token))
+ ((equal? (force prec:token) delim) #f)
+ (else
+ (let ((ans (prec:parse1 0)))
+ (cond ((eof-object? (force prec:token)))
+ ((equal? (force prec:token) delim))
+ (else (prec:warn 'delimiter-expected--ignoring-rest)
+ (do () ((or (equal? (force prec:token) delim)
+ (eof-object? (force prec:token))))
+ (prec:advance))))
+ ans)))))
+
+(define tok:decimal-digits "0123456789")
+(define tok:upper-case "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+(define tok:lower-case "abcdefghijklmnopqrstuvwxyz")
+(define tok:whitespaces
+ (do ((i (+ -1 (min 256 char-code-limit)) (+ -1 i))
+ (ws "" (if (char-whitespace? (integer->char i))
+ (string-append ws (string (integer->char i)))
+ ws)))
+ ((negative? i) ws)))
+
+;;;;The parse tables.
+;;; Definitions accumulate in top-level variable *SYN-DEFS*.
+(set! *syn-defs* '()) ;Make sure *SYN-DEFS* is empty.
+
+;;; Ignore Whitespace characters.
+(prec:define-grammar (tok:char-group 0 tok:whitespaces #f))
+
+;;; On MS-DOS systems, <ctrl>-Z (26) needs to be ignored in order to
+;;; avoid problems at end of files.
+(case (software-type)
+ ((MSDOS)
+ (if (not (char-whitespace? (integer->char 26)))
+ (prec:define-grammar (tok:char-group 0 (integer->char 26) #f))
+ )))
+
+;;; Save these convenient definitions.
+(define *syn-ignore-whitespace* *syn-defs*)
+(set! *syn-defs* '())
+
+(define (prec:trace)
+ (require 'trace)
+ (trace prec:parse prec:parse1
+ prec:parse-delimited prec:parse-list
+ prec:call-or-list prec:apply-or-cons
+ ;;tokenize prec:advance-return-last prec:advance
+ prec:nudcall prec:ledcall
+ prec:parse-nudcomment prec:parse-ledcomment
+ prec:parse-delimited prec:parse-list
+ prec:parse-nary prec:parse-rest
+ prec:parse-matchfix prec:parse-inmatchfix
+ prec:parse-prefix prec:parse-infix prec:parse-postfix
+ ;;prec:delim?
+ ;;prec:ledf prec:nudf prec:lbp
+ )
+ (set! *qp-width* 333))
+
+;;(begin (trace-all "prec.scm") (set! *qp-width* 333))
+;;(pretty-print (grammar-read-tab (get-grammar 'standard)))
+;;(prec:trace)
diff --git a/primes.scm b/primes.scm
index a27b240..769e2bc 100644
--- a/primes.scm
+++ b/primes.scm
@@ -90,7 +90,7 @@
(divisible #f)
)
(do ((i 0 (1+ i)))
- ((let* ((divisor (array-ref primes:small-primes i)))
+ ((let* ((divisor (vector-ref primes:small-primes i)))
(set! divisible (= (modulo n divisor) 0))
(or divisible (>= divisor limit)))
divisible)
@@ -156,23 +156,23 @@
(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 ))
+ '#( 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>)
diff --git a/printf.scm b/printf.scm
index dffe90d..aefab5c 100644
--- a/printf.scm
+++ b/printf.scm
@@ -56,7 +56,7 @@
(case fc
((#\n #\N) (out #\newline))
((#\t #\T) (out slib:tab))
- ((#\r #\R) (out #\return))
+ ;;((#\r #\R) (out #\return))
((#\f #\F) (out slib:form-feed))
((#\newline) #f)
(else (out fc)))
@@ -85,8 +85,12 @@
(string->number (string c)))))
((not (char-numeric? fc)) accum)
(must-advance)))))))
- (define integer-pad
+ (define integer-convert
(lambda (s radix)
+ (set! s (cond ((symbol? s) (symbol->string s))
+ ((number? s) (number->string s radix))
+ ((or (not s) (null? s)) "0")
+ (else "1")))
(cond ((not (negative? precision))
(set! leading-0s #f)))
(let* ((pre
@@ -216,24 +220,15 @@
(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))
+ (out (integer-convert (car args) 10))
(loop (cdr args)))
((#\o #\O)
- (out (integer-pad (number->string (car args) 8) 8))
+ (out (integer-convert (car args) 8))
(loop (cdr args)))
((#\x #\X)
- (out
- ((if (char-upper-case? fc) string-upcase string-downcase)
- (integer-pad (number->string (car args) 16) 16)))
+ (out ((if (char-upper-case? fc) string-upcase string-downcase)
+ (integer-convert (car args) 16)))
(loop (cdr args)))
((#\%) (out #\%)
(loop args))
diff --git a/priorque.scm b/priorque.scm
index 927ffbe..9002c01 100644
--- a/priorque.scm
+++ b/priorque.scm
@@ -1,5 +1,5 @@
;;;; "priorque.scm" priority queues for Scheme.
-;;; Copyright (C) 1992, 1993 Aubrey Jaffer.
+;;; Copyright (C) 1992, 1993, 1994, 1995, 1997 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
@@ -131,11 +131,6 @@
(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))))
+ (do ((i 7 (+ -1 i)))
+ ((negative? i))
+ (write (heap-extract-max! heap)) (newline))))
diff --git a/time.scm b/psxtime.scm
index 7ddf524..5322c44 100644
--- a/time.scm
+++ b/psxtime.scm
@@ -1,5 +1,5 @@
-;;;; "time.scm" Posix time conversion routines
-;;; Copyright (C) 1994 Aubrey Jaffer.
+;;;; "psxtime.scm" Posix time conversion routines
+;;; Copyright (C) 1994, 1997 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
@@ -17,49 +17,39 @@
;promotional, or sales literature without prior written consent in
;each case.
-(define time:daylight 0)
-(define *timezone* 0)
-(define time:tzname #("GMT" "GDT"))
+;;; No, it doesn't do leap seconds.
-(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.
+(define time: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)))
+(define (leap-year? year)
+ (and (zero? (remainder year 4))
+ (or (not (zero? (remainder year 100)))
+ (zero? (remainder year 400))))) ; Leap years.
;;; 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)
+ (let* ((secs (modulo t 86400)) ; SECS/DAY
+ (days (+ (quotient t 86400) ; SECS/DAY
(if (and (negative? t) (positive? secs)) -1 0))))
- (let ((tm_hour (quotient secs SECS/HOUR))
- (secs (remainder secs SECS/HOUR))
+ (let ((tm_hour (quotient secs 3600))
+ (secs (remainder secs 3600))
(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)))
+ (let ((diy (if (leap-year? tm_year) 366 365)))
(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))))
+ (let* ((mv (vector-ref time: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)
+ (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]
@@ -75,17 +65,17 @@
(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:localtime caltime . tz)
+ (require 'time-zone)
+ (set! tz (if (null? tz) (tzset) (car tz)))
+ (apply time:split caltime (tz:params caltime tz)))
(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))
+ (let* ((times '#(1 60 3600 86400 2678400 32140800))
(trough ; rough time for target
(do ((i 5 (+ i -1))
(trough time:year-70
@@ -123,14 +113,18 @@
(+ 1 j)
(decoder guess))))))))))
-(define (time:mktime time)
- (time:tzset)
- (time:invert localtime time))
+(define (time:mktime univtime . tz)
+ (require 'time-zone)
+ (set! tz (if (null? tz) (tzset) (car tz)))
+ (+ (gmktime univtime) (tz:std-offset tz)))
+
+(define (time:gmktime univtime)
+ (time:invert time:gmtime univtime))
(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"))
+ (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))
@@ -147,12 +141,15 @@
(number->string (+ 1900 (vector-ref decoded 5)))
(string #\newline))))
-(define (time:ctime time)
- (time:asctime (time:localtime time)))
+(define (time:ctime . args)
+ (time:asctime (apply time:localtime args)))
+
+(define (time:gtime time)
+ (time:asctime (time:gmtime time)))
+
+;;; GMT Local -- take optional 2nd TZ arg
+(define gmtime time:gmtime) (define localtime time:localtime)
+(define gmktime time:gmktime) (define mktime time:mktime)
+(define gtime time:gtime) (define ctime time:ctime)
-(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/rdms.scm b/rdms.scm
index 0fd4a2c..8c20362 100644
--- a/rdms.scm
+++ b/rdms.scm
@@ -1,5 +1,5 @@
;;; "rdms.scm" rewrite 6 - the saga continues
-; Copyright 1994 Aubrey Jaffer
+; Copyright 1994, 1995, 1997 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
@@ -85,8 +85,7 @@
(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:warn slib:warn)
(define rdms:error slib:error)
(define (make-relational-system base)
@@ -234,7 +233,9 @@
(define (open-table table-name writable)
(define cat:row (cat:get-row base:catalog table-name))
- (cond ((and writable (not mutable))
+ (cond ((not cat:row)
+ (rdms:error "can't open-table:" table-name))
+ ((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
@@ -319,21 +320,27 @@
((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))))))
+ (letrec ((export-method
+ (lambda (name proc)
+ (set! export-alist
+ (cons (cons name proc) export-alist))))
+ (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)))))
+ (accumulate-over-table
+ (lambda (operation)
+ (lambda mkeys (base:map-primary-key
+ base-table operation (norm-mkeys mkeys)))))
+ (norm-mkeys
+ (lambda (mkeys)
+ (define mlim (length mkeys))
+ (cond ((> mlim primary-limit)
+ (rdms:error "too many keys:" mkeys))
+ ((= mlim primary-limit) mkeys)
+ (else
+ (append mkeys
+ (make-list (- primary-limit mlim) #f)))))))
(export-method
'row:retrieve
(if (= primary-limit column-limit)
@@ -351,8 +358,10 @@
'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)))))))
+ (lambda (proc . mkeys)
+ (base:ordered-for-each-key
+ base-table (lambda (ckey) (proc (r ckey)))
+ (norm-mkeys mkeys)))))
(cond
((and mutable writable)
(letrec
@@ -427,6 +436,7 @@
(lambda (rows) (for-each row:update rows))))
(letrec ((base:delete (basic 'delete))
+ (base:delete* (basic 'delete*))
(ckey:remove (lambda (ckey)
(let ((r (ckey:retrieve ckey)))
(and r (base:delete base-table ckey))
@@ -442,8 +452,8 @@
(export-method 'row:remove*
(accumulate-over-table ckey:remove))
(export-method 'row:delete*
- (generalize-to-table
- (lambda (ckey) (base:delete base-table ckey))))
+ (lambda mkeys
+ (base:delete* base-table (norm-mkeys mkeys))))
(export-method 'close-table
(lambda () (set! base-table #f)
(set! desc-table #f)
@@ -468,7 +478,8 @@
column table-name)))))))
(lambda args
(cond
- ((null? args) #f)
+ ((null? args)
+ #f)
((null? (cdr args))
(let ((pp (assq (car args) export-alist)))
(and pp (cdr pp))))
@@ -485,10 +496,11 @@
((get) (lambda keys
(and (present? base-table (list->key keys))
(list-ref keys (+ -1 ci)))))
- ((get*) (lambda ()
+ ((get*) (lambda mkeys
(base:map-primary-key
base-table
- (lambda (ckey) (key-extractor ckey)))))
+ (lambda (ckey) (key-extractor ckey))
+ (norm-mkeys mkeys))))
(else #f))))
(else
(let ((index (- ci (+ 1 primary-limit))))
@@ -497,12 +509,13 @@
(let ((row (base:get base-table
(list->key keys))))
(and row (list-ref row index)))))
- ((get*) (lambda ()
+ ((get*) (lambda mkeys
(base:map-primary-key
base-table
(lambda (ckey)
(list-ref (base:get base-table ckey)
- index)))))
+ index))
+ (norm-mkeys mkeys))))
(else #f)))))))))))))
(define create-table
diff --git a/recobj.scm b/recobj.scm
deleted file mode 100644
index caf55a6..0000000
--- a/recobj.scm
+++ /dev/null
@@ -1,54 +0,0 @@
-;;; "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
index 555d3ea..b0cc755 100644
--- a/record.scm
+++ b/record.scm
@@ -1,6 +1,6 @@
; "record.scm" record data types
; Written by David Carlton, carlton@husc.harvard.edu.
-; Re-Written by Aubrey Jaffer, jaffer@ai.mit.edu
+; Re-Written by Aubrey Jaffer, jaffer@ai.mit.edu, 1996, 1997
;
; This code is in the public domain.
@@ -17,6 +17,8 @@
(define vector-set! vector-set!)
(define vector-fill! vector-fill!)
(define vector->list vector->list)
+(define display display)
+(define write write)
(define record-modifier #f)
(define record-accessor #f)
@@ -32,6 +34,8 @@
(vect? vector?)
(vect-ref vector-ref)
(vect->list vector->list)
+ (disp display)
+ (wri write)
;; Need to wrap these to protect record data from being corrupted.
(vect-set! vector-set!)
@@ -71,10 +75,15 @@
(rtd-length (lambda (rtd) (vect-ref rtd 4)))
(rec-rtd (lambda (x) (vect-ref x 0)))
+ (rec-disp-str
+ (lambda (x)
+ (let ((name (rtd-name (rec-rtd x))))
+ (string-append
+ "#<" (if (symbol? name) (symbol->string name) name) ">"))))
(make-rec-type
(lambda (type-name field-names)
- (if (not (string? type-name))
+ (if (not (or (symbol? type-name) (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))
@@ -182,17 +191,17 @@
(vect-set! x index y)))))
)
- (set! vector? (lambda (obj) (and (not (rec? obj)) (vector? obj))))
+ (set! vector? (lambda (obj) (and (not (rec? obj)) (vect? 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)
+ (lambda (vector)
(cond ((rec? vector)
(vec:error 'vector->list nvt vector))
- (else (vect->list vector k)))))
+ (else (vect->list vector)))))
(set! vector-set!
(lambda (vector k obj)
(cond ((rec? vector)
@@ -203,6 +212,14 @@
(cond ((rec? vector)
(vec:error 'vector-fill! nvt vector))
(else (vect-fill! vector fill)))))
+ (set! display
+ (lambda (obj . opt)
+ (apply disp (if (rec? obj) (rec-disp-str obj) obj) opt)))
+ (set! write
+ (lambda (obj . opt)
+ (if (rec? obj)
+ (apply disp (rec-disp-str obj) opt)
+ (apply wri obj opt))))
(set! record-modifier rec-modifier)
(set! record-accessor rec-accessor)
(set! record-constructor rec-constructor)
diff --git a/require.scm b/require.scm
index d1ebe9a..5b02ff6 100644
--- a/require.scm
+++ b/require.scm
@@ -1,5 +1,5 @@
;;;; Implementation of VICINITY and MODULES for Scheme
-;Copyright (C) 1991, 1992, 1993, 1994 Aubrey Jaffer
+;Copyright (C) 1991, 1992, 1993, 1994, 1997 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
@@ -17,7 +17,7 @@
;promotional, or sales literature without prior written consent in
;each case.
-(define *SLIB-VERSION* "2a6")
+(define *SLIB-VERSION* "2c0")
;;; Standardize msdos -> ms-dos.
(define software-type
@@ -30,6 +30,7 @@
((VMS) "[.]")
(else "")))
+(define *load-pathname* #f)
(define program-vicinity
(let ((*vicinity-suffix*
(case (software-type)
@@ -69,114 +70,6 @@
(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*))
@@ -192,38 +85,88 @@
;;;; MODULES
+(define *catalog* #f)
(define *modules* '())
+(define (require:version path)
+ (let ((expr (and (file-exists? path)
+ (call-with-input-file path (lambda (port) (read port))))))
+ (and (list? expr) (= 3 (length expr))
+ (eq? (car expr) 'define) (eq? (cadr expr) '*SLIB-VERSION*)
+ (string? (caddr expr)) (caddr expr))))
+
+(define (catalog/require-version-match? slibcat)
+ (let* ((apair (assq '*SLIB-VERSION* slibcat))
+ (req (in-vicinity (library-vicinity)
+ (string-append "require" (scheme-file-suffix))))
+ (reqvers (require:version req)))
+ (cond ((not (file-exists? req))
+ (slib:warn "can't find " req) #f)
+ ((not apair) #f)
+ ((not (equal? reqvers (cdr apair))) #f)
+ ((not (equal? reqvers *SLIB-VERSION*))
+ (slib:warn "The loaded " req " is stale.")
+ #t)
+ (else #t))))
+
+(define (catalog:try-read vicinity name)
+ (or (and vicinity name
+ (let ((path (in-vicinity vicinity name)))
+ (and (file-exists? path)
+ (call-with-input-file path
+ (lambda (port)
+ (do ((expr (read port) (read port))
+ (lst '() (cons expr lst)))
+ ((eof-object? expr)
+ (apply append lst))))))))
+ '()))
+
+(define (catalog:get feature)
+ (if (not *catalog*)
+ (let ((slibcat (catalog:try-read (implementation-vicinity) "slibcat")))
+ (cond ((not (catalog/require-version-match? slibcat))
+ (slib:load (in-vicinity (library-vicinity) "mklibcat"))
+ (set! slibcat
+ (catalog:try-read (implementation-vicinity) "slibcat"))))
+ (cond (slibcat
+ (set! *catalog* ((slib:eval
+ (cadr (or (assq 'catalog:filter slibcat)
+ '(#f identity))))
+ slibcat))))
+ (set! *catalog*
+ (append (catalog:try-read (home-vicinity) "homecat") *catalog*))
+ (set! *catalog*
+ (append (catalog:try-read (user-vicinity) "usercat") *catalog*))))
+ (and feature *catalog* (cdr (or (assq feature *catalog*) '(#f . #f)))))
+
(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))
+ (let ((path (catalog:get feature)))
+ (cond ((symbol? path) (require: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))
+ (and (symbol? feature)
+ (let ((path (catalog:get feature)))
+ (if (symbol? path) (require:feature->path path) path))))
(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)
+ (cond ((not feature) (set! *catalog* #f))
+ ((not path)
(slib:error ";required feature not supported: " feature))
((not (pair? path)) ;simple name
(slib:load path)
- (require:provide feature))
+ (and (not (eq? 'new-catalog feature)) (require:provide feature)))
(else ;special loads
- (require (car path))
+ (require:require (car path))
(apply (case (car path)
((macro) macro:load)
((syntactic-closures) synclo:load)
@@ -232,7 +175,8 @@
((macro-by-example) defmacro:load)
((defmacro) defmacro:load)
((source) slib:load-source)
- ((compiled) slib:load-compiled))
+ ((compiled) slib:load-compiled)
+ (else (slib:error "unknown package loader" path)))
(if (list? path) (cdr path) (list (cdr path))))
(require:provide feature))))))
@@ -249,24 +193,13 @@
(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))
+ (require:provide 'inexact))
+(if (rational? (string->number "1/19")) (require:provide 'rational))
+(if (real? (string->number "0.0")) (require:provide 'real))
+(if (complex? (string->number "1+i")) (require: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 +))
+ (if (and n (exact? n)) (require:provide 'bignum)))
(define report:print
(lambda args
@@ -294,7 +227,7 @@
(scheme-implementation-version) 'on (software-type))))
(define slib:report-locations
- (let ((features *features*) (catalog *catalog*))
+ (let ((features *features*))
(lambda args
(report:print '(IMPLEMENTATION-VICINITY) 'is (implementation-vicinity))
(report:print '(LIBRARY-VICINITY) 'is (library-vicinity))
@@ -317,23 +250,13 @@
(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 '...))))
+ (report:print 'Implementation '*CATALOG* ':)
+ (catalog:get #f)
+ (cond ((pair? args)
+ (for-each (lambda (x) (display slib:tab) (report:print x))
+ *catalog*))
+ (else (display slib:tab) (report:print (car *catalog*))
+ (display slib:tab) (report:print '...)))
(newline))))
(let ((sit (scheme-implementation-version)))
diff --git a/root.scm b/root.scm
index 5ba78c1..3c764a6 100644
--- a/root.scm
+++ b/root.scm
@@ -1,5 +1,5 @@
;;;"root.scm" Newton's and Laguerre's methods for finding roots.
-;Copyright (C) 1996 Aubrey Jaffer
+;Copyright (C) 1996, 1997 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
@@ -17,6 +17,8 @@
;promotional, or sales literature without prior written consent in
;each case.
+(require 'logical)
+
;;;; Newton's Method explained in:
;;; D. E. Knuth, "The Art of Computer Programming", Vol 2 /
;;; Seminumerical Algorithms, Reading Massachusetts, Addison-Wesley
@@ -95,7 +97,7 @@
(let* ((df (df/dz z))
(ddf (ddf/dz^2 z))
(disc (sqrt (- (* df df) (* fz ddf)))))
- (print 'disc disc)
+ ;;(print 'disc disc)
(if (zero? disc)
#f
(let* ((next-z
@@ -105,9 +107,9 @@
(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)
+ ;;(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
diff --git a/scainit.scm b/scainit.scm
index 1103bc6..93fed1e 100644
--- a/scainit.scm
+++ b/scainit.scm
@@ -86,7 +86,8 @@
(let ((here (lambda (file)
(in-vicinity (library-vicinity) file)))
(scmhere (lambda (file)
- (in-vicinity (library-vicinity) file (scheme-file-suffix)))))
+ (in-vicinity (library-vicinity)
+ (string-append file (scheme-file-suffix))))))
(for-each (lambda (file) (slib:load (here file)))
'("scaoutp"
"scaglob"
diff --git a/scanf.scm b/scanf.scm
index b1ae30a..e4fc919 100644
--- a/scanf.scm
+++ b/scanf.scm
@@ -1,5 +1,5 @@
;;;;"scanf.scm" implemenation of formated input
-;Copyright (C) 1996 Aubrey Jaffer
+;Copyright (C) 1996, 1997 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
@@ -54,7 +54,7 @@
(define (add-item report-field? next-item)
(cond (args
- (cond ((null? setters)
+ (cond ((and report-field? (null? setters))
(slib:error 'scanf "not enough variables for format"
format-string))
((not next-item) (return))
@@ -221,14 +221,12 @@
((#\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)))))))
+ (do ((i 0 (+ 1 i))
+ (c (peek-char input-port) (peek-char input-port)))
+ ((or (>= i width)
+ (eof-object? c))
+ (add-item report-field? (substring str 0 i)))
+ (string-set! str i (read-input-char)))))
((#\s #\S)
;;(flush-whitespace-input)
(add-item report-field? (read-word width char-whitespace?)))
@@ -292,7 +290,7 @@
(read-input-char)
(loop1))
(else (return))))
-
+ ;;(trace flush-whitespace-input flush-whitespace add-item return read-string read-word loop1)
(loop1))))
(args 0)
(else '())))
@@ -312,7 +310,8 @@
(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))))
+ (else (slib:error 'scanf-read-list "argument 2 not a port"
+ input-port))))
(define (stdio:setter-procedure sexp)
(let ((v (gentemp)))
diff --git a/scheme2c.init b/scheme2c.init
index cace8c0..7caf944 100644
--- a/scheme2c.init
+++ b/scheme2c.init
@@ -1,5 +1,5 @@
;"scheme2c.init" Initialisation for SLIB for Scheme->C on Sun -*-scheme-*-
-;Copyright 1991, 1992, 1993 Aubrey Jaffer
+;Copyright 1991, 1992, 1993, 1994, 1997 Aubrey Jaffer
;Copyright 1991 David Love
;
;Permission to copy this software, to redistribute it, and to use it
@@ -59,6 +59,14 @@
(else ""))))
(lambda () library-path)))
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-path)))
+
;;; *FEATURES* should be set to a list of symbols describing features
;;; of this implementation. See Template.scm for the list of feature
;;; names.
@@ -211,6 +219,12 @@
(evl o))
(set! *load-pathname* old-load-pathname)))))
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;; define an error procedure for the library
(define (slib:error . args)
(error 'slib-error: "~a"
diff --git a/scheme48.init b/scheme48.init
index 6e6b423..e65ae8e 100644
--- a/scheme48.init
+++ b/scheme48.init
@@ -1,5 +1,5 @@
;;;"scheme48.init" Initialisation for SLIB for Scheme48 -*-scheme-*-
-;;; Copyright (C) 1992, 1993, 1994, 1995 Aubrey Jaffer.
+;;; Copyright (C) 1992, 1993, 1994, 1995, 1997 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
@@ -33,24 +33,40 @@
(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")
+;;; the version of the scheme implementation loading this file.
+
+(define scheme-implementation-version
+ (cond ((= -86400 (modulo -2177452800 -86400))
+ (display "scheme48-0.36 has been superseded by")
+ (newline)
+ (display "ftp@ftp-swiss.ai.mit.edu:pub/s48/scheme48-0.46.tgz")
+ (newline)
+ (display "ftp://ftp-swiss.ai.mit.edu/pub/s48/scheme48-0.46.tgz")
+ (newline)
+ (lambda () "0.36"))
+ (else (lambda () "0.46"))))
;;; (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))))
+;;; [ defined from the Makefile ]
;;; (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/")
+;;; [ defined from the Makefile ]
+
+(define getenv s48-getenv)
+(define system s48-system)
+
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-path)))
;;; *FEATURES* should be set to a list of symbols describing features
;;; of this implementation. See Template.scm for the list of feature
@@ -76,6 +92,8 @@
dynamic-wind ;proposed dynamic-wind
full-continuation ;can return multiple times
macro ;R4RS appendix's DEFINE-SYNTAX
+ system ;posix (system <string>)
+ getenv ;posix (getenv <string>)
))
;;; (OUTPUT-PORT-WIDTH <port>)
@@ -85,8 +103,7 @@
(define (output-port-height . arg) 24)
;;; (CURRENT-ERROR-PORT)
-(define current-error-port
- (access-scheme-48 'error-output-port))
+(define current-error-port s48-current-error-port)
;;; (TMPNAM) makes a temporary file name.
(define tmpnam
@@ -96,20 +113,29 @@
(if (file-exists? tmp) (tmpnam) tmp)))))
;;; (FILE-EXISTS? <string>)
-(define (file-exists? f) #f)
+(define (file-exists? f)
+ (call-with-current-continuation
+ (lambda (k)
+ (s48-with-handler
+ (lambda (condition decline)
+ (k #f))
+ (lambda ()
+ (close-input-port (open-input-file f))
+ #t)))))
;;; (DELETE-FILE <string>)
-(define (delete-file f) #f)
+(define (delete-file file-name)
+ (s48-system (string-append "rm " file-name)))
;;; 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)
+ (s48-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 integer->char s48-ascii->char)
(define char->integer
(let ((char->integer char->integer)
(code0 (char->integer (integer->char 0))))
@@ -139,7 +165,10 @@
;;; If your implementation provides R4RS macros:
(define macro:eval slib:eval)
-(define macro:load load)
+(define (macro:load <pathname>)
+ (if (not (file-exists? <pathname>))
+ (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+ (load <pathname>))
(define *defmacros*
(list (cons 'defmacro
@@ -190,12 +219,18 @@
(evl o))
(set! *load-pathname* old-load-pathname)))))
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;;; define an error procedure for the library
-(define slib:error (access-scheme-48 'error))
+(define slib:error s48-error)
;;; define these as appropriate for your system.
-(define slib:tab (integer->char 9))
-(define slib:form-feed (integer->char 12))
+(define slib:tab (s48-ascii->char 9))
+(define slib:form-feed (s48-ascii->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))
@@ -236,4 +271,12 @@
(define slib:load slib:load-source)
+;;; Scheme48 complains that these are not defined (even though they
+;;; won't be called until they are).
+(define synclo:load #f)
+(define syncase:load #f)
+(define macwork:load #f)
+(define transcript-on #f)
+(define transcript-off #f)
+
(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/scm.init b/scm.init
new file mode 100644
index 0000000..39092b6
--- /dev/null
+++ b/scm.init
@@ -0,0 +1,6 @@
+;"scm.init" Configuration file for SLIB for SCM -*-scheme-*-
+
+;;; SCM supports SLIB natively; no initialization file is actually
+;;; required. So just stub this file:
+
+(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/scsh.init b/scsh.init
new file mode 100644
index 0000000..fcabadc
--- /dev/null
+++ b/scsh.init
@@ -0,0 +1,267 @@
+;"scsh.init" Initialisation for SLIB for Scsh 0.5.1 -*-scheme-*-
+
+;;; (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) 'Scsh)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "0.5.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)
+ "/home/tomas/src/scsh-0.5.1/")
+
+;;; (library-vicinity) should be defined to be the pathname of the
+;;; directory where files of Scheme library functions reside.
+
+(define (library-vicinity)
+ "/home/tomas/src/slib2b1/")
+
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-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 error-output-port)
+
+;;; (TMPNAM) makes a temporary file name.
+(define (tmpnam)
+ (create-temp-file "slib_"))
+
+;;; (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)
+
+
+; [s48 has two argument eval]
+(define (slib:eval 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 slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
+;;; define an error procedure for the library
+(define slib:error error)
+
+;;; define these as appropriate for your system.
+(define slib:tab (ascii->char 9))
+(define slib:form-feed (ascii->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 append! append)
+
+;;; 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)
+
+;;; Scheme48 complains that these are not defined (even though they
+;;; won't be called until they are).
+(define synclo:load #f)
+(define syncase:load #f)
+(define macwork:load #f)
+(define transcript-on #f)
+(define transcript-off #f)
+
+(define array? #f)
+(define record? #f)
+(define sort! #f)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
diff --git a/selfset.scm b/selfset.scm
new file mode 100644
index 0000000..14fcd20
--- /dev/null
+++ b/selfset.scm
@@ -0,0 +1,28 @@
+;;"selfset.scm" Set single letter identifiers to their symbols.
+
+ (define a 'a)
+ (define b 'b)
+ (define c 'c)
+ (define d 'd)
+ (define e 'e)
+ (define f 'f)
+ (define g 'g)
+ (define h 'h)
+ (define i 'i)
+ (define j 'j)
+ (define k 'k)
+ (define l 'l)
+ (define m 'm)
+ (define n 'n)
+ (define o 'o)
+ (define p 'p)
+ (define q 'q)
+ (define r 'r)
+ (define s 's)
+ (define t 't)
+ (define u 'u)
+ (define v 'v)
+ (define w 'w)
+ (define x 'x)
+ (define y 'y)
+ (define z 'z)
diff --git a/slib.info b/slib.info
deleted file mode 100644
index d8ec637..0000000
--- a/slib.info
+++ /dev/null
@@ -1,153 +0,0 @@
-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
deleted file mode 100644
index 89c4fce..0000000
--- a/slib.info-1
+++ /dev/null
@@ -1,1306 +0,0 @@
-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
deleted file mode 100644
index f1c31c5..0000000
--- a/slib.info-2
+++ /dev/null
@@ -1,1193 +0,0 @@
-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
deleted file mode 100644
index 7109890..0000000
--- a/slib.info-3
+++ /dev/null
@@ -1,859 +0,0 @@
-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
deleted file mode 100644
index 3d3da19..0000000
--- a/slib.info-4
+++ /dev/null
@@ -1,1248 +0,0 @@
-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
deleted file mode 100644
index 04d1b28..0000000
--- a/slib.info-5
+++ /dev/null
@@ -1,1536 +0,0 @@
-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
deleted file mode 100644
index 05d8377..0000000
--- a/slib.info-6
+++ /dev/null
@@ -1,1410 +0,0 @@
-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
deleted file mode 100644
index 2ed9fcd..0000000
--- a/slib.info-7
+++ /dev/null
@@ -1,615 +0,0 @@
-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
deleted file mode 100644
index 670e9c1..0000000
--- a/slib.info-8
+++ /dev/null
@@ -1,570 +0,0 @@
-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
index 1d41fdc..e9b1c10 100644
--- a/slib.texi
+++ b/slib.texi
@@ -5,6 +5,9 @@
@setchapternewpage on
@c Choices for setchapternewpage are {on,off,odd}.
@paragraphindent 2
+@defcodeindex ft
+@syncodeindex ft cp
+@syncodeindex tp cp
@c %**end of header
@iftex
@@ -17,8 +20,8 @@
@ifinfo
This file documents SLIB, the portable Scheme library.
-Copyright (C) 1993 Todd R. Eigenschink
-Copyright (C) 1993, 1994, 1995 Aubrey Jaffer
+Copyright (C) 1993 Todd R. Eigenschink@*
+Copyright (C) 1993, 1994, 1995, 1996, 1997 Aubrey Jaffer
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
@@ -45,13 +48,13 @@ by the author.
@titlepage
@title SLIB
@subtitle The Portable Scheme Library
-@subtitle Version 2a3
-@subtitle June 1995
-@author by Todd R. Eigenschink, Dave Love, and Aubrey Jaffer
+@subtitle Version 2c0
+@author by Aubrey Jaffer
@page
@vskip 0pt plus 1filll
-Copyright @copyright{} 1993, 1994, 1995 Todd R. Eigenschink and Aubrey Jaffer
+Copyright @copyright{} 1993 Todd R. Eigenschink@*
+Copyright @copyright{} 1993, 1994, 1995, 1996, 1997 Aubrey Jaffer
Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
@@ -69,1248 +72,3712 @@ by the author.
@end titlepage
+@node Top, The Library System, (dir), (dir)
+@ifinfo
+@cindex SLIB
+@dfn{SLIB} is a portable library for the programming language
+@cindex Scheme
+@dfn{Scheme}. It provides a platform independent framework for using
+@dfn{packages} of Scheme procedures and syntax.
+@cindex packages
+@cindex package
+As distributed, SLIB contains useful packages for all implementations.
+Its catalog can be transparently extended to accomodate packages
+specific to a site, implementation, user, or directory.
+@quotation
+Aubrey Jaffer <jaffer@@ai.mit.edu>@*
+@i{Hyperactive Software} -- The Maniac Inside!@*
+http://www-swiss.ai.mit.edu/~jaffer/SLIB.html
+@end quotation
+@end ifinfo
-@node Top, Overview, (dir), (dir)
-
-@ifinfo
-This file documents SLIB, the portable Scheme library.
+@menu
+* The Library System:: How to use and customize.
+* Scheme Syntax Extension Packages::
+* Textual Conversion Packages::
+* Mathematical Packages::
+* Database Packages::
+* Other Packages::
+* About SLIB:: Install, etc.
+* Index::
+@end menu
-@heading Good Engineering is 1% inspiration and 99% documentation.
+@node The Library System, Scheme Syntax Extension Packages, Top, Top
+@chapter The Library System
-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.
+@iftex
+@section Introduction
-Aubrey Jaffer
-jaffer@@ai.mit.edu
-@end ifinfo
+@noindent
+@cindex SLIB
+@dfn{SLIB} is a portable library for the programming language
+@cindex Scheme
+@dfn{Scheme}. It provides a platform independent framework for using
+@dfn{packages} of Scheme procedures and syntax.
+@cindex packages
+@cindex package
+As distributed, SLIB contains useful packages for all implementations.
+Its catalog can be transparently extended to accomodate packages
+specific to a site, implementation, user, or directory.
+@quotation
+Aubrey Jaffer <jaffer@@ai.mit.edu>@*
+@i{Hyperactive Software} -- The Maniac Inside!@*
+@ifset html
+<A HREF="http://www-swiss.ai.mit.edu/~jaffer/SLIB.html">
+@end ifset
+http://www-swiss.ai.mit.edu/~jaffer/SLIB.html
+@ifset html
+</A>
+@end ifset
+@end quotation
+@end iftex
@menu
-* Overview:: What is SLIB?
+* Feature:: SLIB names.
+* Requesting Features::
+* Library Catalogs::
+* Catalog Compilation::
+* Built-in Support::
+* About this manual::
+@end menu
-* 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 Feature, Requesting Features, The Library System, The Library System
+@section Feature
+@noindent
+@cindex feature
+SLIB denotes @dfn{features} by symbols. SLIB maintains a list of
+features supported by the Scheme @dfn{session}. The set of features
+@cindex session
+provided by a session may change over time. Some features are
+properties of the Scheme implementation being used. The following
+features detail what sort of numbers are available from an
+implementation.
-@node Overview, Data Structures, Top, Top
-@chapter Overview
+@itemize @bullet
+@item
+'inexact
+@item
+'rational
+@item
+'real
+@item
+'complex
+@item
+'bignum
+@end itemize
-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
+@noindent
+Other features correspond to the presence of sets of Scheme procedures
+or syntax (macros).
-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}.
+@defun provided? feature
+Returns @code{#t} if @var{feature} is supported by the current Scheme
+session.
+@end defun
-The maintainer can be reached as @samp{jaffer@@ai.mit.edu}.
+@deffn Procedure provide feature
+Informs SLIB that @var{feature} is supported. Henceforth
+@code{(provided? @var{feature})} will return @code{#t}.
+@end deffn
-@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
+@example
+(provided? 'foo) @result{} #f
+(provide 'foo)
+(provided? 'foo) @result{} #t
+@end example
-@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.
+@node Requesting Features, Library Catalogs, Feature, The Library System
+@section Requesting Features
-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}.
+@noindent
+@cindex catalog
+SLIB creates and maintains a @dfn{catalog} mapping features to locations
+of files introducing procedures and syntax denoted by those features.
-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.
+@noindent
+At the beginning of each section of this manual, there is a line like
+@code{(require '@var{feature})}.
+@ftindex feature
+The Scheme files comprising SLIB are cataloged so that these feature
+names map to the corresponding files.
-Once this is done you can modify the startup file for your Scheme
-implementation to @code{load} this initialization file. SLIB is then
-installed.
+@noindent
+SLIB provides a form, @code{require}, which loads the files providing
+the requested feature.
-Multiple implementations of Scheme can all use the same SLIB directory.
-Simply configure each implementation's initialization file as outlined
-above.
+@deffn Procedure require feature
+@itemize @bullet
+@item
+If @code{(provided? @var{feature})} is true,
+then @code{require} just returns an unspecified value.
+@item
+Otherwise, if @var{feature} is found in the catalog, then the
+corresponding files will be loaded and an unspecified value returned.
-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.
+Subsequently @code{(provided? @var{feature})} will return @code{#t}.
+@item
+Otherwise (@var{feature} not found in the catalog), an error is
+signaled.
+@end itemize
+@end deffn
-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.
+@noindent
+The catalog can also be queried using @code{require:feature->path}.
-@node Porting, Coding Standards, Installation, Overview
-@section Porting
+@defun require:feature->path feature
+@itemize @bullet
+@item
+If @var{feature} is already provided, then returns @code{#t}.
+@item
+Otherwise, if @var{feature} is in the catalog, the path or list of paths
+associated with @var{feature} is returned.
+@item
+Otherwise, returns @code{#f}.
+@end itemize
+@end defun
-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}.
+@node Library Catalogs, Catalog Compilation, Requesting Features, The Library System
+@section Library Catalogs
-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
+@noindent
+At the start of a session no catalog is present, but is created with the
+first catalog inquiry (such as @code{(require 'random)}). Several
+sources of catalog information are combined to produce the catalog:
-Please mail new working configuration files to @code{jaffer@@ai.mit.edu}
-so that they can be included in the SLIB distribution.@refill
+@itemize @bullet
+@item
+standard SLIB packages.
+@item
+additional packages of interest to this site.
+@item
+packages specifically for the variety of Scheme which this
+session is running.
+@item
+packages this user wants to always have available. This catalog is the
+file @file{homecat} in the user's @dfn{HOME} directory.
+@cindex HOME
+@item
+packages germane to working in this (current working) directory. This
+catalog is the file @file{usercat} in the directory to which it applies.
+One would typically @code{cd} to this directory before starting the
+Scheme session.
+@end itemize
-@node Coding Standards, Copyrights, Porting, Overview
-@section Coding Standards
+@noindent
+Catalog files consist of one or more @dfn{association list}s.
+@cindex Catalog File
+In the circumstance where a feature symbol appears in more than one
+list, the latter list's association is retrieved. Here are the
+supported formats for elements of catalog lists:
-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
+@table @code
+@item (@var{feature} . @i{<symbol>})
+Redirects to the feature named @i{<symbol>}.
+@item (@var{feature} . "@i{<path>}")
+Loads file @i{<path>}.
+@item (@var{feature} source "@i{<path>"})
+@code{slib:load}s the Scheme source file @i{<path>}.
+@item (@var{feature} compiled "@i{<path>"} @dots{})
+@code{slib:load-compiled}s the files @i{<path>} @dots{}.
+@end table
-@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
+@noindent
+The various macro styles first @code{require} the named macro package,
+then just load @i{<path>} or load-and-macro-expand @i{<path>} as
+appropriate for the implementation.
-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
+@table @code
+@item (@var{feature} defmacro "@i{<path>"})
+@code{defmacro:load}s the Scheme source file @i{<path>}.
+@item (@var{feature} macro-by-example "@i{<path>"})
+@code{defmacro:load}s the Scheme source file @i{<path>}.
+@end table
-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
+@table @code
+@item (@var{feature} macro "@i{<path>"})
+@code{macro:load}s the Scheme source file @i{<path>}.
+@item (@var{feature} macros-that-work "@i{<path>"})
+@code{macro:load}s the Scheme source file @i{<path>}.
+@item (@var{feature} syntax-case "@i{<path>"})
+@code{macro:load}s the Scheme source file @i{<path>}.
+@item (@var{feature} syntactic-closures "@i{<path>"})
+@code{macro:load}s the Scheme source file @i{<path>}.
+@end table
-Documentation should be provided in Emacs Texinfo format if possible,
-But documentation must be provided.
+@noindent
+Here is an example of a @file{usercat} catalog. A Program in this
+directory can invoke the @samp{run} feature with @code{(require 'run)}.
-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!
+@example
+;;; "usercat": SLIB catalog additions for SIMSYNCH. -*-scheme-*-
-@subheading Modifications
+(
+ (simsynch . "../synch/simsynch.scm")
+ (run . "../synch/run.scm")
+ (schlep . "schlep.scm")
+)
+@end example
-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.
+@node Catalog Compilation, Built-in Support, Library Catalogs, The Library System
+@section Catalog Compilation
-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
+@noindent
+SLIB combines the catalog information which doesn't vary per user into
+the file @file{slibcat} in the implementation-vicinity. Therefore
+@file{slibcat} needs change only when new software is installed or
+compiled. Because the actual pathnames of files can differ from
+installation to installation, SLIB builds a separate catalog for each
+implementation it is used with.
-This section has instructions for SLIB authors regarding copyrights.
+@noindent
+The definition of @code{*SLIB-VERSION*} in SLIB file @file{require.scm}
+is checked against the catalog association of @code{*SLIB-VERSION*} to
+ascertain when versions have changed. I recommend that the definition
+of @code{*SLIB-VERSION*} be changed whenever the library is changed. If
+multiple implementations of Scheme use SLIB, remember that recompiling
+one @file{slibcat} will fix only that implementation's catalog.
-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.
+@noindent
+The compilation scripts of Scheme implementations which work with SLIB
+can automatically trigger catalog compilation by deleting
+@file{slibcat} or by invoking a special form of @code{require}:
-If your code or changes amount to less than about 10 lines, you do not
-need to add your copyright or send a disclaimer.
+@deffn Procedure require @r{'new-catalog}
+This will load @file{mklibcat}, which compiles and writes a new
+@file{slibcat}.
+@end deffn
-@subheading Putting code into the Public Domain
+@noindent
+Another special form of @code{require} erases SLIB's catalog, forcing it
+to be reloaded the next time the catalog is queried.
-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.
+@deffn Procedure require @r{#f}
+Removes SLIB's catalog information. This should be done before saving
+an executable image so that, when restored, its catalog will be loaded
+afresh.
+@end deffn
-@quotation
-I, @var{name}, hereby affirm that I have placed the software package
-@var{name} in the public domain.
+@noindent
+Each file in the table below is descibed in terms of its
+file-system independent @dfn{vicinity} (@pxref{Vicinity}). The entries
+of a catalog in the table override those of catalogs above it in the
+table.
-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.
+@table @asis
-@flushright
- @var{signature and date}
-@end flushright
-@end quotation
+@item @code{implementation-vicinity} @file{slibcat}
+@cindex slibcat
+This file contains the associations for the packages comprising SLIB,
+the @file{implcat} and the @file{sitecat}s. The associations in the
+other catalogs override those of the standard catalog.
-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.
+@item @code{library-vicinity} @file{mklibcat.scm}
+@cindex mklibcat.scm
+creates @file{slibcat}.
-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.
+@item @code{library-vicinity} @file{sitecat}
+@cindex sitecat
+This file contains the associations specific to an SLIB installation.
-@subheading Explicit copying terms
+@item @code{implementation-vicinity} @file{implcat}
+@cindex implcat
+This file contains the associations specific to an implementation of
+Scheme. Different implementations of Scheme should have different
+@code{implementation-vicinity}.
+
+@item @code{implementation-vicinity} @file{mkimpcat.scm}
+@cindex mkimpcat.scm
+if present, creates @file{implcat}.
+
+@item @code{implementation-vicinity} @file{sitecat}
+@cindex sitecat
+This file contains the associations specific to a Scheme implementation
+installation.
+
+@item @code{home-vicinity} @file{homecat}
+@cindex homecat
+This file contains the associations specific to an SLIB user.
+
+@item @code{user-vicinity} @file{usercat}
+@cindex usercat
+This file contains associations effecting only those sessions whose
+@dfn{working directory} is @code{user-vicinity}.
+
+@end table
+
+@node Built-in Support, About this manual, Catalog Compilation, The Library System
+@section Built-in Support
@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:
+The procedures described in these sections are supported by all
+implementations as part of the @samp{*.init} files or by
+@file{require.scm}.
+
+@menu
+* 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 Require, Vicinity, Built-in Support, Built-in Support
+@subsection Require
+
+@defvar *features*
+Is a list of symbols denoting features supported in this implementation.
+@var{*features*} can grow as modules are @code{require}d.
+@var{*features*} must be defined by all implementations
+(@pxref{Porting}).
+
+Here are features which SLIB (@file{require.scm}) adds to
+@var{*features*} when appropriate.
@itemize @bullet
@item
-Arrange that your name appears in a copyright line for the appropriate
-year. Multiple copyright lines are acceptable.
+'inexact
@item
-With your copyright line, specify any terms you require to be different
-from those already in the file.
+'rational
@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.
+'real
+@item
+'complex
+@item
+'bignum
@end itemize
-@subheading Example: Company Copyright Disclaimer
+For each item, @code{(provided? '@var{feature})} will return @code{#t}
+if that feature is available, and @code{#f} if not.
+@end defvar
-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:
+@defvar *modules*
+Is a list of pathnames denoting files which have been loaded.
+@end defvar
-@quotation
-@var{employer} Corporation hereby disclaims all copyright
-interest in the program @var{program} written by @var{name}.
+@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
-@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.
+@noindent
+In the following functions if the argument @var{feature} is not a symbol
+it is assumed to be a pathname.@refill
-@flushleft
-@var{signature and date},
-@var{name}, @var{title}, @var{employer} Corporation
-@end flushleft
-@end quotation
+@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
+@var{feature} is a symbol. If @code{(provided? @var{feature})} is true
+@code{require} returns. Otherwise, if @code{(assq @var{feature}
+*catalog*)} is not @code{#f}, the associated files will be loaded and
+@code{(provided? @var{feature})} will henceforth return @code{#t}. An
+unspecified value is returned. If @var{feature} is not found in
+@code{*catalog*}, then an error is signaled.
+
+@deffnx Procedure require pathname
+@var{pathname} is a string. If @var{pathname} has not already been given as
+an argument to @code{require}, @var{pathname} is loaded.
+An unspecified value is returned.
+@end deffn
-@node Manual Conventions, , Copyrights, Overview
-@section Manual Conventions
+@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
-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)}.
+@node Vicinity, Configuration, Require, Built-in Support
+@subsection Vicinity
@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
+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.
+@noindent
+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 incorrect 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
-@node Data Structures, Macros, Overview, Top
-@chapter Data Structures
+@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
+@defun home-vicinity
+Returns the vicinity of the user's @dfn{HOME} directory, the directory
+@cindex HOME
+which typically contains files which customize a computer environment
+for a user. If scheme is running without a user (eg. a daemon) or if
+this concept is meaningless for the platform, then @code{home-vicinity}
+returns @code{#f}.
+@end defun
-@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
+@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 Arrays, Array Mapping, Data Structures, Data Structures
-@section Arrays
-@code{(require 'array)}
+@node Configuration, Input/Output, Vicinity, Built-in Support
+@subsection Configuration
-@defun array? obj
-Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not.
-@end defun
+@noindent
+These constants and procedures describe characteristics of the Scheme
+and underlying operating system. They are provided by all
+implementations.
-@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
+@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
-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 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.
-@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
+@example
+(slib:report-version) @result{} slib "2c0" on scm "5b1" on unix
+@end example
@end defun
-@defun array-rank obj
-Returns the number of dimensions of @var{obj}. If @var{obj} is not an
-array, 0 is returned.
+@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 "2c0" on scm "5b1" on unix
+(implementation-vicinity) is "/home/jaffer/scm/"
+(library-vicinity) is "/home/jaffer/slib/"
+(scheme-file-suffix) is ".scm"
+loaded *features* :
+ trace alist qp sort
+ common-list-functions macro values getopt
+ compiled
+implementation *features* :
+ bignum complex real rational
+ inexact vicinity ed getenv
+ tmpnam 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 current-time record
+ rev3-procedures rev2-procedures sun-dl string-case
+ array dump char-ready? full-continuation
+ system
+implementation *catalog* :
+ (i/o-extensions compiled "/home/jaffer/scm/ioext.so")
+ ...
+@end example
@end defun
-@defun array-shape array
-@code{array-shape} returns a list of inclusive bounds. So:
+@node Input/Output, Legacy, Configuration, Built-in Support
+@subsection Input/Output
+
+@noindent
+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, Built-in Support
+@subsection Legacy
+
+These procedures are provided by all implementations.
+
+@defun identity x
+@var{identity} returns its argument.
+
+Example:
@lisp
-(array-shape (make-array 'foo 3 5))
- @result{} ((0 2) (0 4))
+(identity 3)
+ @result{} 3
+(identity '(foo bar))
+ @result{} (foo bar)
+(map identity @var{lst})
+ @equiv{} (copy-list @var{lst})
@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:
+@noindent
+The following procedures were present in Scheme until R4RS
+(@pxref{Notes, , Language changes ,r4rs, Revised(4) Scheme}).
+They are provided by all SLIB implementations.
+
+@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
-(array-dimensions (make-array 'foo 3 5))
- @result{} (3 5)
+(last-pair (cons 1 2))
+ @result{} (1 . 2)
+(last-pair '(1 2))
+ @result{} (2)
+ @equiv{} (cons 2 '())
@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}.
+@node System, , Legacy, Built-in Support
+@subsection System
+
+@noindent
+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
-@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 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 array-set! array new-value index1 index2 @dots{}
+@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
-@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 slib:eval obj
+@code{eval} returns the value of @var{obj} evaluated in the current top
+level environment.@refill
+@end deffn
-@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
+@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
-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
+@deffn Procedure slib:warn arg1 arg2 @dots{}
+Outputs a warning message containing the arguments.
+@end deffn
-If you comment out the bounds checking code, this is about as efficient
-as you could ask for without help from the compiler.
+@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
-An exercise left to the reader: implement the rest of APL.
+@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 About this manual, , Built-in Support, The Library System
+@section About this manual
-@node Array Mapping, Association Lists, Arrays, Data Structures
-@section Array Mapping
+@itemize @bullet
+@item
+Entries that are labeled as Functions are called for their return
+values. Entries that are labeled as Procedures are called primarily for
+their side effects.
-@code{(require 'array-for-each)}
+@item
+Examples in this text were produced using the @code{scm} Scheme
+implementation.
-@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
+@item
+At the beginning of each section, there is a line that looks like
+@ftindex feature
+@code{(require 'feature)}. Include this line in your code prior to
+using the package.
+@end itemize
-@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
+@node Scheme Syntax Extension Packages, Textual Conversion Packages, The Library System, Top
+@chapter Scheme Syntax Extension Packages
-@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
+@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
-@node Association Lists, Collections, Array Mapping, Data Structures
-@section Association Lists
+Syntax extensions (macros) included with SLIB. Also @xref{Structures}.
-@code{(require 'alist)}
+* Fluid-Let:: 'fluid-let
+* Yasos:: 'yasos, 'oop, 'collect
+@end menu
-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.
+@node Defmacro, R4RS Macros, Scheme Syntax Extension Packages, Scheme Syntax Extension Packages
+@section Defmacro
-@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
+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 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
+@defun defmacro:eval e
+Returns the @code{slib:eval} of expanding all defmacros in scheme
+expression @var{e}.
@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
+@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 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
+@defun defmacro? sym
+Returns @code{#t} if @var{sym} has been defined by @code{defmacro},
+@code{#f} otherwise.
@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.
+@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
-@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.
+@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)}
+@ftindex 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, Scheme Syntax Extension Packages
+@section R4RS Macros
-@node Collections, Dynamic Data Type, Association Lists, Data Structures
-@section Collections
+@code{(require 'macro)} is the appropriate call if you want R4RS
+@ftindex macro
+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.
-@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!
+The SLIB R4RS macro implementations support the following uniform
+interface:
-@code{(require 'collect)}
+@defun macro:expand sexpression
+Takes an R4RS expression, macro-expands it, and returns the result of
+the macro expansion.
+@end defun
-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
+@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, Scheme Syntax Extension Packages
+@section Macro by Example
+
+@code{(require 'macro-by-example)}
+@ftindex macro-by-example
+
+A vanilla implementation of @cite{Macro by Example} (Eugene Kohlbecker,
+R4RS) by Dorai Sitaram, (dorai@@cs.rice.edu) using @code{defmacro}.
-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;
+generating hygienic global @code{define-syntax} Macro-by-Example macros
+@strong{cheaply}.
@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
+can define macros which use @code{...}.
@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
+needn't worry about a lexical variable in a macro definition
+clashing with a variable from the macro use context
@item
-@code{(gen-keys @var{self})} is like @code{gen-elts}, but yields the
-collection's keys in order.
+don't suffer the overhead of redefining the repl if @code{defmacro}
+natively supported (most implementations)
@end itemize
-They might support specialized @code{for-each-key} and
-@code{for-each-elt} operations.@refill
+@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}.
-@defun collection? obj
-A predicate, true initially of lists, vectors and strings. New sorts of
-collections must answer @code{#t} to @code{collection?}.@refill
+@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, Scheme Syntax Extension Packages
+@section Macros That Work
+
+@code{(require 'macros-that-work)}
+@ftindex 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
-@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
+@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
-Example:
+@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, Scheme Syntax Extension Packages
+@section Syntactic Closures
+
+@code{(require 'syntactic-closures)}
+@ftindex 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
-(map-elts + (list 1 2 3) (vector 1 2 3))
- @result{} #(2 4 6)
+make-syntactic-closure
+capture-syntactic-environment
+identifier?
+identifier=?
@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
+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
-Example:
+@subsubsection Terminology
+
+This section defines the concepts and data types used by the syntactic
+closures facility.
+
+@itemize @bullet
+
+@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
-(map-keys + (list 1 2 3) (vector 1 2 3))
- @result{} #(0 2 4)
+17
+#t
+car
+(+ x 4)
+(lambda (x) x)
+(define pi 3.14159)
+if
+define
@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.
+@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 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
+@defun make-syntactic-closure environment free-names form
-Examples:
+@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
-(reduce + 0 (vector 1 2 3))
- @result{} 6
-(reduce union '() '((a b c) (b c d) (d a)))
- @result{} (c b d a).
+(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 any? pred . collections
-A generalization of the list-based @code{some} (@xref{Lists as
-sequences}) to collections.@refill
+@defun capture-syntactic-environment procedure
-Example:
+@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
-(any? odd? (list 2 3 4 5))
- @result{} #t
+(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
-@defun every? pred . collections
-A generalization of the list-based @code{every} (@xref{Lists as
-sequences}) to collections.@refill
+@subsubsection Identifiers
-Example:
+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
-(every? collection? '((1 2) #(1 2)))
+(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 empty? collection
-Returns @code{#t} iff there are no elements in @var{collection}.
+@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
-@code{(empty? @var{collection}) @equiv{} (zero? (size @var{collection}))}
+@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
-@defun size collection
-Returns the number of elements in @var{collection}.
+@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, Scheme Syntax Extension Packages
+@section Syntax-Case Macros
+
+@code{(require 'syntax-case)}
+@ftindex 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 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
+@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
-Here is a sample collection: @code{simple-table} which is also a
-@code{table}.@refill
+@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
-(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
+(require 'syntax-case)
+@ftindex syntax-case
+(require 'repl)
+@ftindex repl
+(repl:top-level macro:eval)
+@end lisp
+See the section Repl (@xref{Repl}) for more information.
-(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)
- )
- ) ) )
+To check operation of syntax-case get
+@file{cs.indiana.edu:/pub/scheme/syntax-case}, and type
+@lisp
+(require 'syntax-case)
+@ftindex 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
-@node Dynamic Data Type, Hash Tables, Collections, Data Structures
-@section Dynamic Data Type
+@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
-@code{(require 'dynamic)}
+Several other top-level bindings not documented in TR356 are created:
+@itemize @bullet
+@item the ``hooks'' in @file{hooks.ss}
+@item the @code{build-} procedures in @file{output.ss}
+@item @code{expand-syntax} (the expander)
+@end itemize
-@defun make-dynamic obj
-Create and returns a new @dfn{dynamic} whose global value is @var{obj}.
-@end defun
+The syntax of define has been extended to allow @code{(define @var{id})},
+which assigns @var{id} to some unspecified value.@refill
-@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
+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
-@defun dynamic-ref dyn
-Return the value of the given dynamic in the current dynamic
-environment.
-@end defun
+Send bug reports, comments, suggestions, and questions to Kent Dybvig
+(dyb@@iuvax.cs.indiana.edu).
-@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
+@subsection Note from maintainer
-@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
+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.
-The @code{dynamic-bind} macro is not implemented.
+@node Fluid-Let, Yasos, Syntax-Case Macros, Scheme Syntax Extension Packages
+@section Fluid-Let
+@code{(require 'fluid-let)}
+@ftindex 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
-@node Hash Tables, Hashing, Dynamic Data Type, Data Structures
-@section Hash Tables
+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
-@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
+@node Yasos, , Fluid-Let, Scheme Syntax Extension Packages
+@section Yasos
-A hash table is a vector of association lists.
+@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!
-@defun make-hash-table k
-Returns a vector of @var{k} empty (association) lists.
-@end defun
+@code{(require 'oop)} or @code{(require 'yasos)}
+@ftindex oop
+@ftindex yasos
-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
+`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
-@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
+Another reference is:
-@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
+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.
-@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
+@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
-@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
+@node Yasos terms, Yasos interface, Yasos, Yasos
+@subsection Terms
-@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
+@table @asis
+@item @dfn{Object}
+Any Scheme data object.
-@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
+@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 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
+@node Yasos interface, Setters, Yasos terms, Yasos
+@subsection Interface
-For @code{hashq}, @code{(eq? obj1 obj2)} implies @code{(= (hashq obj1 k)
-(hashq obj2))}.@refill
+@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
-For @code{hashv}, @code{(eqv? obj1 obj2)} implies @code{(= (hashv obj1 k)
-(hashv obj2))}.@refill
+@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
-For @code{hash}, @code{(equal? obj1 obj2)} implies @code{(= (hash obj1 k)
-(hash obj2))}.@refill
+@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
-@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
+@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
-@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]:
+@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 space-key (make-sierpinski-indexer 100))
+(define foo "foo")
+((setter string-ref) foo 0 #\F) ; set element 0 of foo
+foo @result{} "Foo"
@end example
-Now let's compute the index of some points:
+@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
-(space-key 24 78) @result{} 9206
-(space-key 23 80) @result{} 9172
+(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
-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.
+@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
-Example applications:
-@table @asis
+@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
-@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.
+@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
-@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)}
+@node Yasos examples, , Setters, Yasos
+@subsection Examples
-@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.
+@lisp
+;;; These definitions for PRINT and SIZE are already supplied by
+(require 'yasos)
-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.
+(define-operation (print obj port)
+ (format port
+ (if (instance? obj) "#<instance>" "~s")
+ obj))
-See Knuth, Vol. 3 @cite{Sorting and searching}, pp 391--2
+(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))))
-To manage unusual inputs, @code{soundex} omits all non-alphabetic
-characters. Consequently, in this implementation:
+(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 Textual Conversion Packages, Mathematical Packages, Scheme Syntax Extension Packages, Top
+@chapter Textual Conversion Packages
+
+@menu
+* Precedence Parsing::
+* Format:: Common-Lisp Format
+* Standard Formatted I/O:: Posix printf and scanf
+* Program Arguments:: Commands and Options.
+* Printing Scheme:: Nicely
+* Time and Date::
+* Vector Graphics::
+@end menu
+
+
+@node Precedence Parsing, Format, Textual Conversion Packages, Textual Conversion Packages
+@section Precedence Parsing
+
+@code{(require 'precedence-parse)} or @code{(require 'parse)}
+@ftindex parse
+@ftindex precedence
+
+@noindent
+This package implements:
+
+@itemize @bullet
+@item
+a Pratt style precedence parser;
+@item
+a @dfn{tokenizer} which congeals tokens according to assigned classes of
+constituent characters;
+@item
+procedures giving direct control of parser rulesets;
+@item
+procedures for higher level specification of rulesets.
+@end itemize
+
+@menu
+* Precedence Parsing Overview::
+* Ruleset Definition and Use::
+* Token definition::
+* Nud and Led Definition::
+* Grammar Rule Definition::
+@end menu
+
+@node Precedence Parsing Overview, Ruleset Definition and Use, Precedence Parsing, Precedence Parsing
+@subsection Precedence Parsing Overview
+
+@noindent
+This package offers improvements over previous parsers.
+
+@itemize @bullet
+@item
+Common computer language constructs are concisely specified.
+@item
+Grammars can be changed dynamically. Operators can be assigned
+different meanings within a lexical context.
+@item
+Rulesets don't need compilation. Grammars can be changed incrementally.
+@item
+Operator precedence is specified by integers.
+@item
+All possibilities of bad input are handled @footnote{How do I know this?
+I parsed 250kbyte of random input (an e-mail file) with a non-trivial
+grammar utilizing all constructs.} and return as much structure as was
+parsed when the error occured; The symbol @code{?} is substituted for
+missing input.
+@end itemize
+
+@noindent
+Here are the higher-level syntax types and an example of each.
+Precedence considerations are omitted for clarity. @xref{Grammar
+Rule Definition} for full details.
+@deftp Grammar nofix bye exit
@example
-(soundex <string of blanks>) @result{} ""
-(soundex "") @result{} ""
+bye
+@end example
+calls the function @code{exit} with no arguments.
+@end deftp
+@deftp Grammar prefix - negate
+@example
+- 42
@end example
+Calls the function @code{negate} with the argument @code{42}.
+@end deftp
+@deftp Grammar infix - difference
+@example
+x - y
+@end example
+Calls the function @code{difference} with arguments @code{x} and @code{y}.
+@end deftp
+@deftp Grammar nary + sum
+@example
+x + y + z
+@end example
+Calls the function @code{sum} with arguments @code{x}, @code{y}, and
+@code{y}.
+@end deftp
+@deftp Grammar postfix ! factorial
+@example
+5 !
+@end example
+Calls the function @code{factorial} with the argument @code{5}.
+@end deftp
+@deftp Grammar prestfix set set!
+@example
+set foo bar
+@end example
+Calls the function @code{set!} with the arguments @code{foo} and
+@code{bar}.
+@end deftp
+@deftp Grammar commentfix /* */
+@example
+/* almost any text here */
+@end example
+Ignores the comment delimited by @code{/*} and @code{*/}.
+@end deftp
+@deftp Grammar matchfix @{ list @}
+@example
+@{0, 1, 2@}
+@end example
+Calls the function @code{list} with the arguments @code{0}, @code{1},
+and @code{2}.
+@end deftp
+@deftp Grammar inmatchfix ( funcall )
+@example
+f(x, y)
+@end example
+Calls the function @code{funcall} with the arguments @code{f}, @code{x},
+and @code{y}.
+@end deftp
+@deftp Grammar delim ;
+@example
+set foo bar;
+@end example
+delimits the extent of the restfix operator @code{set}.
+@end deftp
-Examples from Knuth:
+
+@node Ruleset Definition and Use, Token definition, Precedence Parsing Overview, Precedence Parsing
+@subsection Ruleset Definition and Use
+
+@defvar *syn-defs*
+A grammar is built by one or more calls to @code{prec:define-grammar}.
+The rules are appended to @var{*syn-defs*}. The value of
+@var{*syn-defs*} is the grammar suitable for passing as an argument to
+@code{prec:parse}.
+@end defvar
+
+@defvr Constant *syn-ignore-whitespace*
+Is a nearly empty grammar with whitespace characters set to group 0,
+which means they will not be made into tokens. Most rulesets will want
+to start with @code{*syn-ignore-whitespace*}
+@end defvr
+
+@noindent
+In order to start defining a grammar, either
@example
-(map soundex '("Euler" "Gauss" "Hilbert" "Knuth"
- "Lloyd" "Lukasiewicz"))
- @result{} ("E460" "G200" "H416" "K530" "L300" "L222")
+(set! *syn-defs* '())
+@end example
+@noindent
+or
-(map soundex '("Ellery" "Ghosh" "Heilbronn" "Kant"
- "Ladd" "Lissajous"))
- @result{} ("E460" "G200" "H416" "K530" "L300" "L222")
+@example
+(set! *syn-defs* *syn-ignore-whitespace*)
@end example
-Some cases in which the algorithm fails (Knuth):
+@defun prec:define-grammar rule1 @dots{}
+Appends @var{rule1} @dots{} to @var{*syn-defs*}.
+@code{prec:define-grammar} is used to define both the character classes
+and rules for tokens.
+@end defun
+
+@noindent
+Once your grammar is defined, save the value of @code{*syn-defs*} in a
+variable (for use when calling @code{prec:parse}).
@example
-(map soundex '("Rogers" "Rodgers")) @result{} ("R262" "R326")
+(define my-ruleset *syn-defs*)
+@end example
-(map soundex '("Sinclair" "St. Clair")) @result{} ("S524" "S324")
+@defun prec:parse ruleset delim
+@defunx prec:parse ruleset delim port
+The @var{ruleset} argument must be a list of rules as constructed by
+@code{prec:define-grammar} and extracted from @var{*syn-defs*}.
-(map soundex '("Tchebysheff" "Chebyshev")) @result{} ("T212" "C121")
-@end example
+The token @var{delim} may be a character, symbol, or string. A
+character @var{delim} argument will match only a character token; i.e. a
+character for which no token-group is assigned. A symbols or string
+will match only a token string; i.e. a token resulting from a token
+group.
+
+@code{prec:parse} reads a @var{ruleset} grammar expression delimited
+by @var{delim} from the given input @var{port}. @code{prec:parse}
+returns the next object parsable from the given input @var{port},
+updating @var{port} to point to the first character past the end of the
+external representation of the object.
+
+If an end of file is encountered in the input before any characters are
+found that can begin an object, then an end of file object is returned.
+If a delimiter (such as @var{delim}) is found before any characters are
+found that can begin an object, then @code{#f} is returned.
+
+The @var{port} argument may be omitted, in which case it defaults to the
+value returned by @code{current-input-port}. It is an error to parse
+from a closed port.
+@findex current-input-port
@end defun
-@node Chapter Ordering, Object, Hashing, Data Structures
-@section Chapter Ordering
+@node Token definition, Nud and Led Definition, Ruleset Definition and Use, Precedence Parsing
+@subsection Token definition
-@code{(require 'chapter-order)}
+@defun tok:char-group group chars chars-proc
+The argument @var{chars} may be a single character, a list of
+characters, or a string. Each character in @var{chars} is treated as
+though @code{tok:char-group} was called with that character alone.
-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.
+The argument @var{chars-proc} must be a procedure of one argument, a
+list of characters. After @code{tokenize} has finished
+accumulating the characters for a token, it calls @var{chars-proc} with
+the list of characters. The value returned is the token which
+@code{tokenize} returns.
-@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}.
+The argument @var{group} may be an exact integer or a procedure of one
+character argument. The following discussion concerns the treatment
+which the tokenizing routine, @code{tokenize}, will accord to characters
+on the basis of their groups.
-@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
+When @var{group} is a non-zero integer, characters whose group number is
+equal to or exactly one less than @var{group} will continue to
+accumulate. Any other character causes the accumulation to stop (until
+a new token is to be read).
-@defunx chap:string>? string1 string2
-@defunx chap:string<=? string1 string2
-@defunx chap:string>=? string1 string2
-Implement the corresponding chapter-order predicates.
+The @var{group} of zero is special. These characters are ignored when
+parsed pending a token, and stop the accumulation of token characters
+when the accumulation has already begun. Whitespace characters are
+usually put in group 0.
+
+If @var{group} is a procedure, then, when triggerd by the occurence of
+an initial (no accumulation) @var{chars} character, this procedure will
+be repeatedly called with each successive character from the input
+stream until the @var{group} procedure returns a non-false value.
@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.
+@noindent
+The following convenient constants are provided for use with
+@code{tok:char-group}.
-@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@}"
+@defvr Constant tok:decimal-digits
+Is the string @code{"0123456789"}.
+@end defvr
+@defvr Constant tok:upper-case
+Is the string consisting of all upper-case letters
+("ABCDEFGHIJKLMNOPQRSTUVWXYZ").
+@end defvr
+@defvr Constant tok:lower-case
+Is the string consisting of all lower-case letters
+("abcdefghijklmnopqrstuvwxyz").
+@end defvr
+@defvr Constant tok:whitespaces
+Is the string consisting of all characters between 0 and 255 for which
+@code{char-whitespace?} returns true.
+@end defvr
-@end example
+
+@node Nud and Led Definition, Grammar Rule Definition, Token definition, Precedence Parsing
+@subsection Nud and Led Definition
+
+This section describes advanced features. You can skip this section on
+first reading.
+
+@noindent
+The @dfn{Null Denotation} (or @dfn{nud})
+@cindex Null Denotation, nud
+of a token is the procedure and arguments applying for that token when
+@dfn{Left}, an unclaimed parsed expression is not extant.
+
+@noindent
+The @dfn{Left Denotation} (or @dfn{led})
+@cindex Left Denotation, led
+of a token is the procedure, arguments, and lbp applying for that token
+when there is a @dfn{Left}, an unclaimed parsed expression.
+
+@noindent
+In his paper,
+
+@quotation
+Pratt, V. R.
+Top Down Operator Precendence.
+@cite{SIGACT/SIGPLAN Symposium on Principles of Programming Languages},
+Boston, 1973, pages 41-51
+@end quotation
+
+the @dfn{left binding power} (or @dfn{lbp}) was an independent property
+of tokens. I think this was done in order to allow tokens with NUDs but
+not LEDs to also be used as delimiters, which was a problem for
+statically defined syntaxes. It turns out that @emph{dynamically
+binding} NUDs and LEDs allows them independence.
+
+@noindent
+For the rule-defining procedures that follow, the variable @var{tk} may
+be a character, string, or symbol, or a list composed of characters,
+strings, and symbols. Each element of @var{tk} is treated as though the
+procedure were called for each element.
+
+@noindent
+Character @var{tk} arguments will match only character tokens;
+i.e. characters for which no token-group is assigned. Symbols and
+strings will both match token strings; i.e. tokens resulting from token
+groups.
+
+@defun prec:make-nud tk sop arg1 @dots{}
+Returns a rule specifying that @var{sop} be called when @var{tk} is
+parsed. If @var{sop} is a procedure, it is called with @var{tk} and
+@var{arg1} @dots{} as its arguments; the resulting value is incorporated
+into the expression being built. Otherwise, @code{(list @var{sop}
+@var{arg1} @dots{})} is incorporated.
@end defun
-@node Object, Parameter lists, Chapter Ordering, Data Structures
-@section Macroless Object System
+@noindent
+If no NUD has been defined for a token; then if that token is a string,
+it is converted to a symbol and returned; if not a string, the token is
+returned.
-@code{(require 'object)}
+@defun prec:make-led tk sop arg1 @dots{}
+Returns a rule specifying that @var{sop} be called when @var{tk} is
+parsed and @var{left} has an unclaimed parsed expression. If @var{sop}
+is a procedure, it is called with @var{left}, @var{tk}, and @var{arg1}
+@dots{} as its arguments; the resulting value is incorporated into the
+expression being built. Otherwise, @var{left} is incorporated.
+@end defun
-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.
+@noindent
+If no LED has been defined for a token, and @var{left} is set, the
+parser issues a warning.
-@subsection Concepts
-@table @asis
+@node Grammar Rule Definition, , Nud and Led Definition, Precedence Parsing
+@subsection Grammar Rule Definition
-@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
+@noindent
+Here are procedures for defining rules for the syntax types introduced
+in @ref{Precedence Parsing Overview}.
-@subsection Procedures
+@noindent
+For the rule-defining procedures that follow, the variable @var{tk} may
+be a character, string, or symbol, or a list composed of characters,
+strings, and symbols. Each element of @var{tk} is treated as though the
+procedure were called for each element.
-@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}.
+@noindent
+For procedures prec:delim, @dots{}, prec:prestfix, if the @var{sop}
+argument is @code{#f}, then the token which triggered this rule is
+converted to a symbol and returned. A false @var{sop} argument to the
+procedures prec:commentfix, prec:matchfix, or prec:inmatchfix has a
+different meaning.
+
+@noindent
+Character @var{tk} arguments will match only character tokens;
+i.e. characters for which no token-group is assigned. Symbols and
+strings will both match token strings; i.e. tokens resulting from token
+groups.
+
+@defun prec:delim tk
+Returns a rule specifying that @var{tk} should not be returned from
+parsing; i.e. @var{tk}'s function is purely syntactic. The end-of-file
+is always treated as a delimiter.
@end defun
-@defun object? obj
-Returns boolean value whether @var{obj} was created by make-object.
+@defun prec:nofix tk sop
+Returns a rule specifying the following actions take place when @var{tk}
+is parsed:
+@itemize @bullet
+@item
+If @var{sop} is a procedure, it is called with no arguments; the
+resulting value is incorporated into the expression being built.
+Otherwise, the list of @var{sop} is incorporated.
+@end itemize
@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.
+@defun prec:prefix tk sop bp rule1 @dots{}
+Returns a rule specifying the following actions take place when @var{tk}
+is parsed:
+@itemize @bullet
+@item
+The rules @var{rule1} @dots{} augment and, in case of conflict, override
+rules currently in effect.
+@item
+@code{prec:parse1} is called with binding-power @var{bp}.
+@item
+If @var{sop} is a procedure, it is called with the expression returned
+from @code{prec:parse1}; the resulting value is incorporated into the
+expression being built. Otherwise, the list of @var{sop} and the
+expression returned from @code{prec:parse1} is incorporated.
+@item
+The ruleset in effect before @var{tk} was parsed is restored;
+@var{rule1} @dots{} are forgotten.
+@end itemize
@end defun
-@defun make-generic-predicate
-Returns a boolean procedure for any scheme object.
+@defun prec:infix tk sop lbp bp rule1 @dots{}
+Returns a rule declaring the left-binding-precedence of the token
+@var{tk} is @var{lbp} and specifying the following actions take place
+when @var{tk} is parsed:
+@itemize @bullet
+@item
+The rules @var{rule1} @dots{} augment and, in case of conflict, override
+rules currently in effect.
+@item
+One expression is parsed with binding-power @var{lbp}. If instead a delimiter
+is encountered, a warning is issued.
+@item
+If @var{sop} is a procedure, it is applied to the list of @var{left} and
+the parsed expression; the resulting value is incorporated into the
+expression being built. Otherwise, the list of @var{sop}, the
+@var{left} expression, and the parsed expression is incorporated.
+@item
+The ruleset in effect before @var{tk} was parsed is restored;
+@var{rule1} @dots{} are forgotten.
+@end itemize
@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.
+@defun prec:nary tk sop bp
+Returns a rule declaring the left-binding-precedence of the token
+@var{tk} is @var{bp} and specifying the following actions take place
+when @var{tk} is parsed:
+@itemize @bullet
+@item
+Expressions are parsed with binding-power @var{bp} as far as they are
+interleaved with the token @var{tk}.
+@item
+If @var{sop} is a procedure, it is applied to the list of @var{left} and
+the parsed expressions; the resulting value is incorporated into the
+expression being built. Otherwise, the list of @var{sop}, the
+@var{left} expression, and the parsed expressions is incorporated.
+@end itemize
@end defun
-@defun make-predicate! object generic-preciate
-Makes a predicate method associated with the @var{generic-predicate}.
+@defun prec:postfix tk sop lbp
+Returns a rule declaring the left-binding-precedence of the token
+@var{tk} is @var{lbp} and specifying the following actions take place
+when @var{tk} is parsed:
+@itemize @bullet
+@item
+If @var{sop} is a procedure, it is called with the @var{left} expression;
+the resulting value is incorporated into the expression being built.
+Otherwise, the list of @var{sop} and the @var{left} expression is
+incorporated.
+@end itemize
@end defun
-@defun unmake-method! object generic-method
-Removes an object's association with a @var{generic-method} .
+@defun prec:prestfix tk sop bp rule1 @dots{}
+Returns a rule specifying the following actions take place when @var{tk}
+is parsed:
+@itemize @bullet
+@item
+The rules @var{rule1} @dots{} augment and, in case of conflict, override
+rules currently in effect.
+@item
+Expressions are parsed with binding-power @var{bp} until a delimiter is
+reached.
+@item
+If @var{sop} is a procedure, it is applied to the list of parsed
+expressions; the resulting value is incorporated into the expression
+being built. Otherwise, the list of @var{sop} and the parsed
+expressions is incorporated.
+@item
+The ruleset in effect before @var{tk} was parsed is restored;
+@var{rule1} @dots{} are forgotten.
+@end itemize
@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.
+@defun prec:commentfix tk stp match rule1 @dots{}
+Returns rules specifying the following actions take place when @var{tk}
+is parsed:
+@itemize @bullet
+@item
+The rules @var{rule1} @dots{} augment and, in case of conflict, override
+rules currently in effect.
+@item
+Characters are read untile and end-of-file or a sequence of characters
+is read which matches the @emph{string} @var{match}.
+@item
+If @var{stp} is a procedure, it is called with the string of all that
+was read between the @var{tk} and @var{match} (exclusive).
+@item
+The ruleset in effect before @var{tk} was parsed is restored;
+@var{rule1} @dots{} are forgotten.
+@end itemize
+
+Parsing of commentfix syntax differs from the others in several ways.
+It reads directly from input without tokenizing; It calls @var{stp} but
+does not return its value; nay any value. I added the @var{stp}
+argument so that comment text could be echoed.
@end defun
-@subsection Examples
+@defun prec:matchfix tk sop sep match rule1 @dots{}
+Returns a rule specifying the following actions take place when @var{tk}
+is parsed:
+@itemize @bullet
+@item
+The rules @var{rule1} @dots{} augment and, in case of conflict, override
+rules currently in effect.
+@item
+A rule declaring the token @var{match} a delimiter takes effect.
+@item
+Expressions are parsed with binding-power @code{0} until the token
+@var{match} is reached. If the token @var{sep} does not appear between
+each pair of expressions parsed, a warning is issued.
+@item
+If @var{sop} is a procedure, it is applied to the list of parsed
+expressions; the resulting value is incorporated into the expression
+being built. Otherwise, the list of @var{sop} and the parsed
+expressions is incorporated.
+@item
+The ruleset in effect before @var{tk} was parsed is restored;
+@var{rule1} @dots{} are forgotten.
+@end itemize
+@end defun
+
+@defun prec:inmatchfix tk sop sep match lbp rule1 @dots{}
+Returns a rule declaring the left-binding-precedence of the token
+@var{tk} is @var{lbp} and specifying the following actions take place
+when @var{tk} is parsed:
+@itemize @bullet
+@item
+The rules @var{rule1} @dots{} augment and, in case of conflict, override
+rules currently in effect.
+@item
+A rule declaring the token @var{match} a delimiter takes effect.
+@item
+Expressions are parsed with binding-power @code{0} until the token
+@var{match} is reached. If the token @var{sep} does not appear between
+each pair of expressions parsed, a warning is issued.
+@item
+If @var{sop} is a procedure, it is applied to the list of @var{left} and
+the parsed expressions; the resulting value is incorporated into the
+expression being built. Otherwise, the list of @var{sop}, the
+@var{left} expression, and the parsed expressions is incorporated.
+@item
+The ruleset in effect before @var{tk} was parsed is restored;
+@var{rule1} @dots{} are forgotten.
+@end itemize
+@end defun
+
+
+@node Format, Standard Formatted I/O, Precedence Parsing, Textual Conversion Packages
+@section Format (version 3.0)
+
+@code{(require 'format)}
+@ftindex 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}@var{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 Standard Formatted I/O, Program Arguments, Format, Textual Conversion Packages
+@section Standard Formatted I/O
+
+@menu
+* Standard Formatted Output:: 'printf
+* Standard Formatted Input:: 'scanf
+@end menu
+
+@subsection stdio
+
+@code{(require 'stdio)}
+@ftindex 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)}
+@ftindex 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
-(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)
+% @r{[} @var{flags} @r{]} @r{[} @var{width} @r{]} @r{[} . @var{precision} @r{]} @r{[} @var{type} @r{]} @var{conversion}
@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
+An output conversion specifications consist of an initial @samp{%}
+character followed in sequence by:
-@subsubsection Number Documention
-Inheritance
-@lisp
- <number>::()
-@end lisp
-Slots
-@lisp
- <number>::<x>
-@end lisp
-Generic Methods
+@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)}
+@ftindex 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 Program Arguments, Printing Scheme, Standard Formatted I/O, Textual Conversion Packages
+@section Program Arguments
+
+@menu
+* Getopt:: Command Line option parsing
+* Command Line:: A command line reader for Scheme shells
+* Parameter lists:: 'parameters
+* Batch:: 'batch
+@end menu
+
+@node Getopt, Command Line, Program Arguments, Program Arguments
+@subsection Getopt
+
+@code{(require 'getopt)}
+@ftindex 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
- <number>::value
- <number>::set-value!
+#! /usr/local/bin/scm
+;;;This code is SCM specific.
+(define argv (program-arguments))
+(require 'getopt)
+@ftindex 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
+
+@subsection 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.
-@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
+(define opts ":-:b:")
+(define argc 5)
+(define argv '("foo" "-b9" "--f1" "--2=" "--g3=35234.342" "--"))
+(define *optind* 1)
+(define *optarg* #f)
+(require 'qp)
+@ftindex 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 Parameter lists, Priority Queues, Object, Data Structures
-@section Parameter lists
+@node Command Line, Parameter lists, Getopt, Program Arguments
+@subsection Command Line
+
+@code{(require 'read-command)}
+@ftindex read-command
+
+@defun read-command port
+@defunx read-command
+@code{read-command} converts a @dfn{command line} into a list of strings
+@cindex command line
+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
+
+@defun read-options-file filename
+@code{read-options-file} converts an @dfn{options file} into a list of
+@cindex options file
+strings suitable for parsing by @code{getopt}. The syntax of options
+files is the same as the syntax for command
+lines, except that @key{newline}s do not terminate reading (only @key{;}
+or end of file).
+
+If an end of file is encountered before any characters are found that
+can begin an object or comment, then an end of file object is returned.
+@end defun
+
+
+
+@node Parameter lists, Batch, Command Line, Program Arguments
+@subsection Parameter lists
@code{(require 'parameters)}
+@ftindex parameters
@noindent
Arguments to procedures in scheme are distinguished from each other by
@@ -1357,12 +3824,13 @@ 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}.
+@deffn Function fill-empty-parameters defaulters parameter-list
+@var{defaulters} 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{fill-empty-parameters}
+returns a new parameter-list with each empty parameter replaced with the
+list returned by calling the corresponding @var{defaulter} with
+@var{parameter-list} as its argument.
@end deffn
@deffn Function check-parameters checks parameter-list
@@ -1413,223 +3881,1661 @@ elements of @var{optnames}. Each of these strings which have length of
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
+@deffn Function getopt->arglist argc argv optnames positions arities types defaulters 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{arities}, @var{types}, @var{defaulters}, @var{checks}, and
@var{aliases}.
@end deffn
+@noindent
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
+@noindent
+If errors are encountered while processing options, directions for using
+the options are printed to @code{current-error-port}.
-@code{(require 'priority-queue)}
+@example
+(begin
+ (set! *optind* 1)
+ (getopt->parameter-list
+ 2
+ '("cmd" "-?")
+ '(flag number symbols symbols string flag2 flag3 num2 num3)
+ '(boolean optional nary1 nary single boolean boolean nary nary)
+ '(boolean integer symbol symbol string boolean boolean integer integer)
+ '(("flag" flag)
+ ("f" flag)
+ ("Flag" flag2)
+ ("B" flag3)
+ ("optional" number)
+ ("o" number)
+ ("nary1" symbols)
+ ("N" symbols)
+ ("nary" symbols)
+ ("n" symbols)
+ ("single" string)
+ ("s" string)
+ ("a" num2)
+ ("Abs" num3))))
+@print{}
+Usage: cmd [OPTION ARGUMENT ...] ...
+
+ -f, --flag
+ -o, --optional=<number>
+ -n, --nary=<symbols> ...
+ -N, --nary1=<symbols> ...
+ -s, --single=<string>
+ --Flag
+ -B
+ -a <num2> ...
+ --Abs=<num3> ...
+
+ERROR: getopt->parameter-list "unrecognized option" "-?"
+@end example
-@defun make-heap pred<?
-Returns a binary heap suitable which can be used for priority queue
-operations.
+
+@node Batch, , Parameter lists, Program Arguments
+@subsection Batch
+
+@code{(require 'batch)}
+@ftindex 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
-@defun heap-length heap
-Returns the number of elements in @var{heap}.@refill
+@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
-@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 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
-@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
+@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
-The algorithm for priority queues was taken from @cite{Introduction to
-Algorithms} by T. Cormen, C. Leiserson, R. Rivest. 1989 MIT Press.
+@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{}.
-@node Queues, Records, Priority Queues, Data Structures
-@section Queues
+@emph{Note:} @code{batch:run-script} and @code{batch:try-system} are not the
+same for some operating systems (VMS).
+@end defun
-@code{(require 'queue)}
+@defun batch:comment parms line1 @dots{}
+Writes comment lines @var{line1} @dots{} to the @code{batch-port} in
+@var{parms}.
+@end defun
-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 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 make-queue
-Returns a new, empty queue.
+@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 queue? obj
-Returns @code{#t} if @var{obj} is a queue.
+@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
-@defun queue-empty? q
-Returns @code{#t} if the queue @var{q} is empty.
+@noindent
+In addition, batch provides some small utilities very useful for writing
+scripts:
+
+@defun truncate-up-to path char
+@defunx truncate-up-to path string
+@defunx truncate-up-to path charlist
+@var{path} can be a string or a list of strings. Returns @var{path}
+sans any prefixes ending with a character of the second argument. This
+can be used to derive a filename moved locally from elsewhere.
+
+@example
+(truncate-up-to "/usr/local/lib/slib/batch.scm" "/")
+@result{} "batch.scm"
+@end example
@end defun
-@deffn Procedure queue-push! q datum
-Adds @var{datum} to the front of queue @var{q}.
+@defun replace-suffix str old new
+@var{str} can be a string or a list of strings. Returns a new string
+(or strings) 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.
+
+@example
+(replace-suffix "/usr/local/lib/slib/batch.scm" ".scm" ".c")
+@result{} "/usr/local/lib/slib/batch.c"
+@end example
+@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)
+@ftindex database-utilities
+(require 'parameters)
+@ftindex parameters
+(require 'batch)
+@ftindex 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 Printing Scheme, Time and Date, Program Arguments, Textual Conversion Packages
+@section Printing Scheme
+
+@menu
+* Generic-Write:: 'generic-write
+* Object-To-String:: 'object->string
+* Pretty-Print:: 'pretty-print, 'pprint-file
+@end menu
+
+
+@node Generic-Write, Object-To-String, Printing Scheme, Printing Scheme
+@subsection Generic-Write
+
+@code{(require 'generic-write)}
+@ftindex 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
-@deffn Procedure enquque! q datum
-Adds @var{datum} to the rear of queue @var{q}.
+
+
+@node Object-To-String, Pretty-Print, Generic-Write, Printing Scheme
+@subsection Object-To-String
+
+@code{(require 'object->string)}
+@ftindex object->string
+
+@defun object->string obj
+Returns the textual representation of @var{obj} as a string.
+@end defun
+
+
+
+
+@node Pretty-Print, , Object-To-String, Printing Scheme
+@subsection Pretty-Print
+
+@code{(require 'pretty-print)}
+@ftindex 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
-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}.
+@code{(require 'pprint-file)}
+@ftindex 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
-@defun queue-rear q
-Returns the datum at the rear of the queue @var{q}.
+@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)
+@ftindex pprint-file
+(require 'defmacroexpand)
+@ftindex defmacroexpand
+(defmacro:load "my-macros.scm")
+(pprint-filter-file "code.scm" defmacro:expand* "exp-code.scm")
+@end lisp
+
+@node Time and Date, Vector Graphics, Printing Scheme, Textual Conversion Packages
+@section Time and Date
+
+@menu
+* Posix Time:: 'posix-time
+* Common-Lisp Time:: 'common-lisp-time
+@end menu
+
+
+@node Posix Time, Common-Lisp Time, Time and Date, Time and Date
+@subsection Posix Time
+
+@example
+(require 'posix-time)
+@ftindex posix-time
+@end example
+
+@deftp {Data Type} {Calendar-Time}
+@cindex calendar time
+@cindex caltime
+is a datatype encapsulating time.
+@end deftp
+
+@deftp {Data Type} {Coordinated Universal Time}
+@cindex Coordinated Universal Time
+@cindex UTC
+(abbreviated @dfn{UTC}) is a vector of integers representing time:
+
+@enumerate 0
+@item
+ seconds (0 - 61)
+@item
+ minutes (0 - 59)
+@item
+ hours since midnight (0 - 23)
+@item
+ day of month (1 - 31)
+@item
+ month (0 - 11). Note difference from @code{decode-universal-time}.
+@item
+ the number of years since 1900. Note difference from
+@code{decode-universal-time}.
+@item
+ day of week (0 - 6)
+@item
+ day of year (0 - 365)
+@item
+ 1 for daylight savings, 0 for regular time
+@end enumerate
+@end deftp
+
+@defun gmtime caltime
+Converts the calendar time @var{caltime} to UTC and returns it.
+
+@defunx localtime caltime tz
+Returns @var{caltime} converted to UTC relative to timezone @var{tz}.
+
+@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
+(@pxref{Time Zone,tzset}).
+
@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
+@defun gmktime univtime
+Converts a vector of integers in GMT Coordinated Universal Time (UTC)
+format to a calendar time.
+
+@defunx mktime univtime
+Converts a vector of integers in local Coordinated Universal Time (UTC)
+format to a calendar time.
+
+@defunx mktime univtime tz
+Converts a vector of integers in Coordinated Universal Time (UTC) format
+(relative to time-zone @var{tz})
+to calendar time.
+@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 gtime caltime
+@defunx ctime caltime
+@defunx ctime caltime tz
+Equivalent to @code{(asctime (gmtime @var{caltime}))},
+@code{(asctime (localtime @var{caltime}))}, and
+@code{(asctime (localtime @var{caltime} @var{tz}))}, respectively.
+@end defun
+
+
+@node Common-Lisp Time, , Posix Time, Time and Date
+@subsection Common-Lisp Time
+
+@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.). Note difference from @code{gmtime} and @code{localtime}.
+@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 Vector Graphics, , Time and Date, Textual Conversion Packages
+@section Vector Graphics
+
+@menu
+* Tektronix Graphics Support::
+@end menu
+
+@node Tektronix Graphics Support, , Vector Graphics, Vector Graphics
+@subsection Tektronix Graphics Support
+
+@emph{Note:} The Tektronix graphics support files need more work, and
+are not complete.
+
+@subsubsection 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
-@node Records, Base Table, Queues, Data Structures
-@section Records
+@deffn Procedure tek40:reset
+@end deffn
-@code{(require 'record)}
-The Record package provides a facility for user to define their own
-record data types.
+@subsubsection Tektronix 4100 Series Graphics
-@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
+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 Mathematical Packages, Database Packages, Textual Conversion Packages, Top
+@chapter Mathematical Packages
+
+@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:: 'root
+* Commutative Rings:: 'commutative-ring
+* Determinant::
+@end menu
+
+
+@node Bit-Twiddling, Modular Arithmetic, Mathematical Packages, Mathematical Packages
+@section Bit-Twiddling
+
+@code{(require 'logical)}
+@ftindex 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
+@ftindex logical
+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
-@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 logior n1 n2
+Returns the integer which is the bit-wise OR of the two integer
+arguments.
-@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
+Example:
+@lisp
+(number->string (logior #b1100 #b1010) 2)
+ @result{} "1110"
+@end lisp
@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
+@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
-@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 lognot n
+Returns the integer which is the 2s-complement of the integer argument.
-@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
+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)))
-@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
+(logtest #b0100 #b1011) @result{} #f
+(logtest #b0100 #b0111) @result{} #t
+@end example
@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
+@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 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
+@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 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
+@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 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
+@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
-@node Base Table, Relational Database, Records, Data Structures
+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, Mathematical Packages
+@section Modular Arithmetic
+
+@code{(require 'modular)}
+@ftindex 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, Mathematical Packages
+@section Prime Testing and Generation
+
+@code{(require 'primes)}
+@ftindex primes
+
+This package tests and generates prime numbers. The strategy used is
+as follows:
+
+@itemize @bullet
+@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 @bullet
+
+@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, Mathematical Packages
+@section Prime Factorization
+
+@code{(require 'factor)}
+@ftindex 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, Mathematical Packages
+@section Random Numbers
+
+@code{(require 'random)}
+@ftindex 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, Mathematical Packages
+@section Cyclic Checksum
+
+@code{(require 'make-crc)}
+@ftindex 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)
+@ftindex 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, Mathematical Packages
+@section Plotting on Character Devices
+
+@code{(require 'charplot)}
+@ftindex 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
+@ftindex charplot
+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)
+@ftindex 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, Commutative Rings, Plotting, Mathematical Packages
+@section Root Finding
+
+@code{(require 'root)}
+@ftindex 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 Commutative Rings, Determinant, Root Finding, Mathematical Packages
+@section Commutative Rings
+
+Scheme provides a consistent and capable set of numeric functions.
+Inexacts implement a field; integers a commutative ring (and Euclidean
+domain). This package allows the user to use basic Scheme numeric
+functions with symbols and non-numeric elements of commutative rings.
+
+@code{(require 'commutative-ring)}
+@ftindex commutative-ring
+@cindex ring, commutative
+
+The @dfn{commutative-ring} package makes @code{+}, @code{-}, @code{*},
+@code{/}, and @code{^} @dfn{careful} in the sense that any non-numeric
+@cindex careful
+arguments which it cannot reduce appear in the expression output. In
+order to see what working with this package is like, self-set all the
+single letter identifiers (to their corresponding symbols).
+
+@example
+(define a 'a)
+@dots{}
+(define z 'z)
+@end example
+Or just @code{(require 'self-set)}. Now for some sample expressions:
+
+@example
+(* (+ a b) (+ a b)) @result{} (+ (* 2 a b) (^ a 2) (^ b 2))
+(* (+ a b) (- a b)) @result{} (- (^ a 2) (^ b 2))
+(* (- a b) (- a b)) @result{} (- (+ (^ a 2) (^ b 2)) (* 2 a b))
+(* (- a b) (+ a b)) @result{} (- (^ a 2) (^ b 2))
+(/ (+ a b) (+ c d)) @result{} (+ (/ a (+ c d)) (/ b (+ c d)))
+(/ (+ a b) (- c d)) @result{} (+ (/ a (- c d)) (/ b (- c d)))
+(/ (- a b) (- c d)) @result{} (- (/ a (- c d)) (/ b (- c d)))
+(/ (- a b) (+ c d)) @result{} (- (/ a (+ c d)) (/ b (+ c d)))
+(^ (+ a b) 3) @result{} (+ (* 3 a (^ b 2)) (* 3 b (^ a 2)) (^ a 3) (^ b 3))
+(^ (+ a 2) 3) @result{} (+ 8 (* a 12) (* (^ a 2) 6) (^ a 3))
+@end example
+
+Use of this package is not restricted to simple arithmetic expressions:
+
+@example
+(require 'determinant)
+
+(determinant '((a b c) (d e f) (g h i))) @result{}
+(- (+ (* a e i) (* b f g) (* c d h)) (* a f h) (* b d i) (* c e g))
+@end example
+
+The @dfn{commutative-ring} package differs from other extension
+mechanisms in that it automatically, using properties true of all
+commutative rings, simplifies sum and product expressions containing
+non-numeric elements. One need only specify behavior for @code{+} or
+@code{*} for cases where expressions involving objects reduce to numbers
+or to expressions involving different non-numeric elements.
+
+Currently, only @code{+}, @code{-}, @code{*}, @code{/}, and @code{^}
+support non-numeric elements. Expressions with @code{-} are converted
+to equivalent expressions without @code{-}, so behavior for @code{-} is
+not defined separately. @code{/} expressions are handled similarly.
+
+This list might be extended to include @code{quotient}, @code{modulo},
+@code{remainder}, @code{lcm}, and @code{gcd}; but these work only for
+the more restrictive Euclidean (Unique Factorization) Domain.
+@cindex Unique Factorization
+@cindex Euclidean Domain
+
+@defun cring:define-rule op sub-op1 sub-op2 reduction
+Defines a rule for the case when the operation represented by symbol
+@var{op} is applied to lists whose @code{car}s are @var{sub-op1} and
+@var{sub-op2}, respectively. The argument @var{reduction} is a
+procedure accepting 2 arguments which will be lists whose @code{car}s
+are @var{sub-op1} and @var{sub-op2}.
+
+@defunx cring:define-rule op sub-op1 'identity reduction
+Defines a rule for the case when the operation represented by symbol
+@var{op} is applied to a list whose @code{car} is @var{sub-op1}, and
+some other argument. @var{Reduction} will be called with the list whose
+@code{car} is @var{sub-op1} and some other argument.
+
+If @var{reduction} returns @code{#f}, the reduction has failed and other
+reductions will be tried. If @var{reduction} returns a non-false value,
+that value will replace the two arguments in arithmetic (@code{+},
+@code{-}, and @code{*}) calculations involving non-numeric elements.
+
+The operations @code{+} and @code{*} are assumed commutative; hence both
+orders of arguments to @var{reduction} will be tried if necessary.
+
+The following rule is the built-in definition for distributing @code{*}
+over @code{+}.
+
+@example
+(cring:define-rule
+ '* '+ 'identity
+ (lambda (exp1 exp2)
+ (apply + (map (lambda (trm) (* trm exp2)) (cdr exp1))))))
+@end example
+@end defun
+
+@heading How to Create a Commutative Ring
+
+The first step in creating your commutative ring is to write procedures
+to create elements of the ring. A non-numeric element of the ring must
+be represented as a list whose first element is a symbol or string.
+This first element identifies the type of the object. A convenient and
+clear convention is to make the type-identifying element be the same
+symbol whose top-level value is the procedure to create it.
+
+@example
+(define (n . list1)
+ (cond ((and (= 2 (length list1))
+ (eq? (car list1) (cadr list1)))
+ 0)
+ ((not (term< (first list1) (last1 list1)))
+ (apply n (reverse list1)))
+ (else (cons 'n list1))))
+
+(define (s x y) (n x y))
+
+(define (m . list1)
+ (cond ((neq? (first list1) (term_min list1))
+ (apply m (cyclicrotate list1)))
+ ((term< (last1 list1) (cadr list1))
+ (apply m (reverse (cyclicrotate list1))))
+ (else (cons 'm list1))))
+@end example
+
+Define a procedure to multiply 2 non-numeric elements of the ring.
+Other multiplicatons are handled automatically. Objects for which rules
+have @emph{not} been defined are not changed.
+
+@example
+(define (n*n ni nj)
+ (let ((list1 (cdr ni)) (list2 (cdr nj)))
+ (cond ((null? (intersection list1 list2)) #f)
+ ((and (eq? (last1 list1) (first list2))
+ (neq? (first list1) (last1 list2)))
+ (apply n (splice list1 list2)))
+ ((and (eq? (first list1) (first list2))
+ (neq? (last1 list1) (last1 list2)))
+ (apply n (splice (reverse list1) list2)))
+ ((and (eq? (last1 list1) (last1 list2))
+ (neq? (first list1) (first list2)))
+ (apply n (splice list1 (reverse list2))))
+ ((and (eq? (last1 list1) (first list2))
+ (eq? (first list1) (last1 list2)))
+ (apply m (cyclicsplice list1 list2)))
+ ((and (eq? (first list1) (first list2))
+ (eq? (last1 list1) (last1 list2)))
+ (apply m (cyclicsplice (reverse list1) list2)))
+ (else #f))))
+@end example
+
+Test the procedures to see if they work.
+
+@example
+;;; where cyclicrotate(list) is cyclic rotation of the list one step
+;;; by putting the first element at the end
+(define (cyclicrotate list1)
+ (append (rest list1) (list (first list1))))
+;;; and where term_min(list) is the element of the list which is
+;;; first in the term ordering.
+(define (term_min list1)
+ (car (sort list1 term<)))
+(define (term< sym1 sym2)
+ (string<? (symbol->string sym1) (symbol->string sym2)))
+(define first car)
+(define rest cdr)
+(define (last1 list1) (car (last-pair list1)))
+(define (neq? obj1 obj2) (not (eq? obj1 obj2)))
+;;; where splice is the concatenation of list1 and list2 except that their
+;;; common element is not repeated.
+(define (splice list1 list2)
+ (cond ((eq? (last1 list1) (first list2))
+ (append list1 (cdr list2)))
+ (else (error 'splice list1 list2))))
+;;; where cyclicsplice is the result of leaving off the last element of
+;;; splice(list1,list2).
+(define (cyclicsplice list1 list2)
+ (cond ((and (eq? (last1 list1) (first list2))
+ (eq? (first list1) (last1 list2)))
+ (butlast (splice list1 list2) 1))
+ (else (error 'cyclicsplice list1 list2))))
+
+(N*N (S a b) (S a b)) @result{} (m a b)
+@end example
+
+Then register the rule for multiplying type N objects by type N objects.
+
+@example
+(cring:define-rule '* 'N 'N N*N))
+@end example
+
+Now we are ready to compute!
+
+@example
+(define (t)
+ (define detM
+ (+ (* (S g b)
+ (+ (* (S f d)
+ (- (* (S a f) (S d g)) (* (S a g) (S d f))))
+ (* (S f f)
+ (- (* (S a g) (S d d)) (* (S a d) (S d g))))
+ (* (S f g)
+ (- (* (S a d) (S d f)) (* (S a f) (S d d))))))
+ (* (S g d)
+ (+ (* (S f b)
+ (- (* (S a g) (S d f)) (* (S a f) (S d g))))
+ (* (S f f)
+ (- (* (S a b) (S d g)) (* (S a g) (S d b))))
+ (* (S f g)
+ (- (* (S a f) (S d b)) (* (S a b) (S d f))))))
+ (* (S g f)
+ (+ (* (S f b)
+ (- (* (S a d) (S d g)) (* (S a g) (S d d))))
+ (* (S f d)
+ (- (* (S a g) (S d b)) (* (S a b) (S d g))))
+ (* (S f g)
+ (- (* (S a b) (S d d)) (* (S a d) (S d b))))))
+ (* (S g g)
+ (+ (* (S f b)
+ (- (* (S a f) (S d d)) (* (S a d) (S d f))))
+ (* (S f d)
+ (- (* (S a b) (S d f)) (* (S a f) (S d b))))
+ (* (S f f)
+ (- (* (S a d) (S d b)) (* (S a b) (S d d))))))))
+ (* (S b e) (S c a) (S e c)
+ detM
+ ))
+(pretty-print (t))
+@print{}
+(- (+ (m a c e b d f g)
+ (m a c e b d g f)
+ (m a c e b f d g)
+ (m a c e b f g d)
+ (m a c e b g d f)
+ (m a c e b g f d))
+ (* 2 (m a b e c) (m d f g))
+ (* (m a c e b d) (m f g))
+ (* (m a c e b f) (m d g))
+ (* (m a c e b g) (m d f)))
+@end example
+
+@node Determinant, , Commutative Rings, Mathematical Packages
+@section Determinant
+
+@example
+(require 'determinant)
+(determinant '((1 2) (3 4))) @result{} -2
+(determinant '((1 2 3) (4 5 6) (7 8 9))) @result{} 0
+(determinant '((1 2 3 4) (5 6 7 8) (9 10 11 12))) @result{} 0
+@end example
+
+
+@node Database Packages, Other Packages, Mathematical Packages, Top
+@chapter Database Packages
+
+@menu
+* Base Table::
+* Relational Database:: 'relational-database
+* Weight-Balanced Trees:: 'wt-tree
+@end menu
+
+@node Base Table, Relational Database, Database Packages, Database Packages
@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
+@code{(require 'alist-table)}
+@ftindex alist-table
Association list base tables are suitable for small databases and
@@ -1650,6 +5556,7 @@ otherwise. For example:
@example
@group
(require 'alist-table)
+@ftindex alist-table
(define open-base (alist-table 'make-base))
make-base @result{} *a procedure*
(define foo (alist-table 'foo))
@@ -1785,21 +5692,51 @@ This procedure returns a list of @var{key}s which are elementwise
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
+@noindent
+@cindex match-key
+@cindex match
+@cindex wild-card
+In contrast, a @var{match-key} argument is a list of length equal to the
+number of primary keys. The @var{match-key} restricts the actions of
+the table command to those records whose primary keys all satisfy the
+corresponding element of the @var{match-key} list.
+The elements and their actions are:
+
+@quotation
+@table @asis
+@item @code{#f}
+The false value matches any key in the corresponding position.
+@item an object of type procedure
+This procedure must take a single argument, the key in the corresponding
+position. Any key for which the procedure returns a non-false value is
+a match; Any key for which the procedure returns a @code{#f} is not.
+@item other values
+Any other value matches only those keys @code{equal?} to it.
+@end table
+@end quotation
+
+@defun for-each-key handle procedure match-key
Calls @var{procedure} once with each @var{key} in the table opened in
-@var{handle} in an unspecified order. An unspecified value is returned.
+@var{handle} which satisfies @var{match-key} in an unspecified order.
+An unspecified value is returned.
@end defun
-@defun map-key handle procedure
+@defun map-key handle procedure match-key
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.
+with each @var{key} in the table opened in @var{handle} which satisfies
+@var{match-key} in an unspecified order.
@end defun
-@defun ordered-for-each-key handle procedure
+@defun ordered-for-each-key handle procedure match-key
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.
+@var{handle} which satisfies @var{match-key} in the natural order for
+the types of the primary key fields of that table. An unspecified value
+is returned.
+@end defun
+
+@defun delete* handle match-key
+Removes all rows which satisfy @var{match-key} from the table opened in
+@var{handle}. An unspecified value is returned.
@end defun
@defun present? handle key
@@ -1852,10 +5789,11 @@ Objects suitable for passing as the @var{base-id} parameter to
@code{base-id}.
@end table
-@node Relational Database, Weight-Balanced Trees, Base Table, Data Structures
+@node Relational Database, Weight-Balanced Trees, Base Table, Database Packages
@section Relational Database
@code{(require 'relational-database)}
+@ftindex 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
@@ -1994,6 +5932,7 @@ could be created from the procedure returned by
@example
(require 'alist-table)
+@ftindex alist-table
(define relational-alist-system
(make-relational-system alist-table))
(define create-alist-database
@@ -2133,15 +6072,6 @@ the table with the symbol name of the operation. For example:
@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
@@ -2150,72 +6080,164 @@ 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
+table. Missing values appear as @code{#f}. Primary keys must 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.
+@defun get column-name
+Returns a procedure of arguments @var{key1} @var{key2} @dots{} which
+returns the value for the @var{column-name} column of the row associated
+with primary keys @var{key1}, @var{key2} @dots{} if that row exists in
+the table, or @code{#f} otherwise.
+
+@example
+((plat 'get 'processor) 'djgpp) @result{} i386
+((plat 'get 'processor) 'be-os) @result{} #f
+@end example
+
+@defunx get* column-name
+Returns a procedure of optional arguments @var{match-key1} @dots{} which
+returns a list of the values for the specified column for all rows in
+this table. The optional @var{match-key1} @dots{} arguments restrict
+actions to a subset of the table. See the match-key description below
+for details.
+
+@example
+((plat 'get* 'processor)) @result{}
+(i386 8086 i386 8086 i386 i386 8086 m68000
+ m68000 m68000 m68000 m68000 powerpc)
-@defunx get*
-Returns a list of the values for the specified column for all rows in
-this table.
+((plat 'get* 'processor) #f) @result{}
+(i386 8086 i386 8086 i386 i386 8086 m68000
+ m68000 m68000 m68000 m68000 powerpc)
-@defunx row:retrieve key1 key2 @dots{}
-Returns the row associated with primary keys @var{key1}, @var{key2}
+(define (a-key? key)
+ (char=? #\a (string-ref (symbol->string key) 0)))
+
+((plat 'get* 'processor) a-key?) @result{}
+(m68000 m68000 m68000 m68000 m68000 powerpc)
+
+((plat 'get* 'name) a-key?) @result{}
+(atari-st-turbo-c atari-st-gcc amiga-sas/c-5.10
+ amiga-aztec amiga-dice-c aix)
+@end example
+@end defun
+
+@defun row:retrieve
+Returns a procedure of arguments @var{key1} @var{key2} @dots{} which
+returns the row associated with primary keys @var{key1}, @var{key2}
@dots{} if it exists, or @code{#f} otherwise.
+@example
+((plat 'row:retrieve) 'linux) @result{} (linux i386 linux gcc)
+((plat 'row:retrieve) 'multics) @result{} #f
+@end example
+
@defunx row:retrieve*
-Returns a list of all rows in this table.
+Returns a procedure of optional arguments @var{match-key1} @dots{} which
+returns a list of all rows in this table. The optional @var{match-key1}
+@dots{} arguments restrict actions to a subset of the table. See the
+match-key description below for details.
@end defun
-@defun row:remove key1 key2 @dots{}
-Removes and returns the row associated with primary keys @var{key1},
+@example
+((plat 'row:retrieve*) a-key?) @result{}
+((atari-st-turbo-c m68000 atari turbo-c)
+ (atari-st-gcc m68000 atari gcc)
+ (amiga-sas/c-5.10 m68000 amiga sas/c)
+ (amiga-aztec m68000 amiga aztec)
+ (amiga-dice-c m68000 amiga dice-c)
+ (aix powerpc aix -))
+@end example
+
+@defun row:remove
+Returns a procedure of arguments @var{key1} @var{key2} @dots{} which
+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.
+Returns a procedure of optional arguments @var{match-key1} @dots{} which
+removes and returns a list of all rows in this table. The optional
+@var{match-key1} @dots{} arguments restrict actions to a subset of the
+table. See the match-key description below for details.
@end defun
-@defun row:delete key1 key2 @dots{}
-Deletes the row associated with primary keys @var{key1}, @var{key2}
+@defun row:delete
+Returns a procedure of arguments @var{key1} @var{key2} @dots{} which
+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.
+Returns a procedure of optional arguments @var{match-key1} @dots{} which
+Deletes all rows from this table. The optional @var{match-key1} @dots{}
+arguments restrict deletions to a subset of the table. See the
+match-key description below for details. 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.
+@defun row:update
+Returns a procedure of one argument, @var{row}, which 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.
+@defunx row:update*
+Returns a procedure of one argument, @var{rows}, which adds each row in
+the list of rows, @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
+@defun row:insert
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.
+@defunx row:insert*
+Returns a procedure of one argument, @var{rows}, which adds each row in
+the list of rows, @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.
+@defun for-each-row
+Returns a procedure of arguments @var{proc} @var{match-key1} @dots{}
+which calls @var{proc} with each @var{row} in this table in the
+(implementation-dependent) natural ordering for rows. The optional
+@var{match-key1} @dots{} arguments restrict actions to a subset of the
+table. See the match-key description below for details.
+
+@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
+@noindent
+@cindex match-keys
+The (optional) @var{match-key1} @dots{} arguments are used to restrict
+actions of a whole-table operation to a subset of that table. Those
+procedures (returned by methods) which accept match-key arguments will
+accept any number of match-key arguments between zero and the number of
+primary keys in the table. Any unspecified @var{match-key} arguments
+default to @code{#f}.
+
+@noindent
+The @var{match-key1} @dots{} restrict the actions of the table command
+to those records whose primary keys each satisfy the corresponding
+@var{match-key} argument. The arguments and their actions are:
+
+@quotation
+@table @asis
+@item @code{#f}
+The false value matches any key in the corresponding position.
+@item an object of type procedure
+This procedure must take a single argument, the key in the corresponding
+position. Any key for which the procedure returns a non-false value is
+a match; Any key for which the procedure returns a @code{#f} is not.
+@item other values
+Any other value matches only those keys @code{equal?} to it.
+@end table
+@end quotation
+
@defun close-table
Subsequent operations to this table will signal an error.
@end defun
@@ -2334,12 +6356,12 @@ The types for which support is planned are:
@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.
+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
@@ -2382,17 +6404,18 @@ 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.
+Pseudo-random number generators are not reentrant; thus they would
+require locks in order to operate properly in a multiprocess
+environment. Are all examples of utilities whose state should not be
+part of transactions also non-reentrant? If so, perhaps suspending
+transaction capture for the duration of locks would solve this problem.
@end table
@node Database Utilities, , Unresolved Issues, Relational Database
@subsection Database Utilities
@code{(require 'database-utilities)}
+@ftindex database-utilities
@noindent
This enhancement wraps a utility layer on @code{relational-database}
@@ -2465,7 +6488,8 @@ PRI index uint
name symbol
arity parameter-arity
domain domain
- default expression
+ defaulter expression
+ expander expression
documentation string
@end group
@end example
@@ -2494,13 +6518,12 @@ parameters.
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.
+The @code{defaulter} field is an expression whose value is either
+@code{#f} or a procedure of one argument (the parameter-list) which
+returns a @emph{list} of the default value or values as appropriate.
+Note that since the @code{defaulter} 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
@@ -2544,9 +6567,13 @@ the @code{index} field of the @var{command}'s parameter-table.
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 types
+A list of the type name of each parameter. Correspnds to the
+@code{type-id} field of the contents of the @code{domain} of the
+@var{command}'s parameter-table.
+@item defaulters
+A list of the defaulters for each parameter. Corresponds to
+the @code{defaulters} 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
@@ -2564,8 +6591,13 @@ arguments from a @code{getopt} style argument list (@pxref{Getopt}).
@example
(require 'database-utilities)
+@ftindex database-utilities
+(require 'fluid-let)
+@ftindex fluid-let
(require 'parameters)
+@ftindex parameters
(require 'getopt)
+@ftindex getopt
(define my-rdb (create-database #f 'alist-table))
@@ -2573,13 +6605,29 @@ arguments from a @code{getopt} style argument list (@pxref{Getopt}).
'(foo-params
*parameter-columns*
*parameter-columns*
- ((1 first-argument single string "hithere" "first argument")
- (2 flag boolean boolean #f "a flag")))
+ ((1 single-string single string
+ (lambda (pl) '("str")) #f "single string")
+ (2 nary-symbols nary symbol
+ (lambda (pl) '()) #f "zero or more symbols")
+ (3 nary1-symbols nary1 symbol
+ (lambda (pl) '(symb)) #f "one or more symbols")
+ (4 optional-number optional uint
+ (lambda (pl) '()) #f "zero or one number")
+ (5 flag boolean boolean
+ (lambda (pl) '(#f)) #f "a boolean flag")))
'(foo-pnames
((name string))
((parameter-index uint))
- (("l" 1)
- ("a" 2)))
+ (("s" 1)
+ ("single-string" 1)
+ ("n" 2)
+ ("nary-symbols" 2)
+ ("N" 3)
+ ("nary1-symbols" 3)
+ ("o" 4)
+ ("optional-number" 4)
+ ("f" 5)
+ ("flag" 5)))
'(my-commands
((name symbol))
((parameters parameter-list)
@@ -2589,7 +6637,7 @@ arguments from a @code{getopt} style argument list (@pxref{Getopt}).
((foo
foo-params
foo-pnames
- (lambda (rdb) (lambda (foo aflag) (print foo aflag)))
+ (lambda (rdb) (lambda args (print args)))
"test command arguments"))))
(define (dbutil:serve-command-line rdb command-table
@@ -2598,17 +6646,56 @@ arguments from a @code{getopt} style argument list (@pxref{Getopt}).
((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
+ arities types defaulters dirs aliases)
+ (apply comval (getopt->arglist
+ argc argv options positions
+ arities types defaulters dirs aliases)))))
+
+(define (cmd . opts)
+ (fluid-let ((*optind* 1))
+ (printf "%-34s @result{} "
+ (call-with-output-string (lambda (pt) (write (cons 'cmd opts) pt)))
+ ;;(apply string-append (map (lambda (x) (string-append x " ")) opts))
+ )
+ (set! opts (cons "cmd" opts))
+ (force-output)
+ (dbutil:serve-command-line
+ my-rdb 'my-commands 'foo (length opts) opts)))
+
+(cmd) @result{} ("str" () (symb) () #f)
+(cmd "-f") @result{} ("str" () (symb) () #t)
+(cmd "--flag") @result{} ("str" () (symb) () #t)
+(cmd "-o177") @result{} ("str" () (symb) (177) #f)
+(cmd "-o" "177") @result{} ("str" () (symb) (177) #f)
+(cmd "--optional" "621") @result{} ("str" () (symb) (621) #f)
+(cmd "--optional=621") @result{} ("str" () (symb) (621) #f)
+(cmd "-s" "speciality") @result{} ("speciality" () (symb) () #f)
+(cmd "-sspeciality") @result{} ("speciality" () (symb) () #f)
+(cmd "--single" "serendipity") @result{} ("serendipity" () (symb) () #f)
+(cmd "--single=serendipity") @result{} ("serendipity" () (symb) () #f)
+(cmd "-n" "gravity" "piety") @result{} ("str" () (piety gravity) () #f)
+(cmd "-ngravity" "piety") @result{} ("str" () (piety gravity) () #f)
+(cmd "--nary" "chastity") @result{} ("str" () (chastity) () #f)
+(cmd "--nary=chastity" "") @result{} ("str" () ( chastity) () #f)
+(cmd "-N" "calamity") @result{} ("str" () (calamity) () #f)
+(cmd "-Ncalamity") @result{} ("str" () (calamity) () #f)
+(cmd "--nary1" "surety") @result{} ("str" () (surety) () #f)
+(cmd "--nary1=surety") @result{} ("str" () (surety) () #f)
+(cmd "-N" "levity" "fealty") @result{} ("str" () (fealty levity) () #f)
+(cmd "-Nlevity" "fealty") @result{} ("str" () (fealty levity) () #f)
+(cmd "--nary1" "surety" "brevity") @result{} ("str" () (brevity surety) () #f)
+(cmd "--nary1=surety" "brevity") @result{} ("str" () (brevity surety) () #f)
+(cmd "-?")
+@print{}
+Usage: cmd [OPTION ARGUMENT ...] ...
+
+ -f, --flag
+ -o, --optional[=]<number>
+ -n, --nary[=]<symbols> ...
+ -N, --nary1[=]<symbols> ...
+ -s, --single[=]<string>
+
+ERROR: getopt->parameter-list "unrecognized option" "-?"
@end example
Some commands are defined in all extended relational-databases. The are
@@ -2620,7 +6707,33 @@ 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}
+Representation}. Currently, these fields are
+@itemize @bullet
+@item
+domain-name
+@item
+foreign-table
+@item
+domain-integrity-rule
+@item
+type-id
+@item
+type-param
+@end itemize
+
+The following example adds 3 domains to the @samp{build} database.
+@samp{Optstring} is either a string or @code{#f}. @code{filename} is a
+string and @code{build-whats} is a symbol.
+
+@example
+(for-each (build 'add-domain)
+ '((optstring #f
+ (lambda (x) (or (not x) (string? x)))
+ string
+ #f)
+ (filename #f #f string #f)
+ (build-whats #f #f symbol #f)))
+@end example
@end defun
@defun delete-domain domain-name
@@ -2633,7 +6746,7 @@ Returns a procedure to check an argument for conformance to domain
@var{domain}.
@end defun
-@subheading Defining Tables
+@subsubheading Defining Tables
@deffn Procedure define-tables rdb spec-0 @dots{}
Adds tables as specified in @var{spec-0} @dots{} to the open
@@ -2666,8 +6779,8 @@ or
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).
+value is a procedure of one argument (which returns @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
@@ -2723,7 +6836,7 @@ The procedure to call to actually print.
The report is prepared as follows:
-@itemize
+@itemize @bullet
@item
@code{Format} (@pxref{Format}) is called with the @code{header} field
and the (list of) @code{column-names} of the table.
@@ -2759,6 +6872,7 @@ database is then closed and reopened.
@example
(require 'database-utilities)
+@ftindex database-utilities
(define my-rdb (create-database "foo.db" 'alist-table))
(define-tables my-rdb
@@ -2814,10 +6928,12 @@ database is then closed and reopened.
Welcome
@end example
-@node Weight-Balanced Trees, Structures, Relational Database, Data Structures
+
+@node Weight-Balanced Trees, , Relational Database, Database Packages
@section Weight-Balanced Trees
@code{(require 'wt-tree)}
+@ftindex wt-tree
@cindex trees, balanced binary
@cindex balanced binary trees
@@ -3323,2278 +7439,1093 @@ operation is equivalent to
@end deffn
+@node Other Packages, About SLIB, Database Packages, Top
+@chapter Other Packages
-@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{}
+@menu
+* Data Structures:: Various data structures.
+* Procedures:: Miscellaneous utility procedures.
+* Standards Support:: Support for Scheme Standards.
+* Session Support:: REPL and Debugging.
+* Extra-SLIB Packages::
+@end menu
-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
+@node Data Structures, Procedures, Other Packages, Other Packages
+@section Data Structures
-@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
+* Arrays:: 'array
+* Array Mapping:: 'array-for-each
+* Association Lists:: 'alist
+* Byte:: 'byte
+* Collections:: 'collect
+* Dynamic Data Type:: 'dynamic
+* Hash Tables:: 'hash-table
+* Hashing:: 'hash, 'sierpinski, 'soundex
+* Priority Queues:: 'priority-queue
+* Queues:: 'queue
+* Records:: 'record
+* Structures:: 'struct, 'structure
@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
+@node Arrays, Array Mapping, Data Structures, Data Structures
+@subsection Arrays
-@defun defmacro:eval e
-Returns the @code{slib:eval} of expanding all defmacros in scheme
-expression @var{e}.
-@end defun
+@code{(require 'array)}
+@ftindex array
-@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
+@defun array? obj
+Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not.
@end defun
-@defun defmacro? sym
-Returns @code{#t} if @var{sym} has been defined by @code{defmacro},
-@code{#f} otherwise.
+@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
-@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.
+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
-@code{macroexpand} is similar to @code{macroexpand-1}, but repeatedly
-expands @var{form} until it is no longer a macro call.
+@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
-@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}.
+@defun array-rank obj
+Returns the number of dimensions of @var{obj}. If @var{obj} is not an
+array, 0 is returned.
@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.
+@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 macro:eval sexpression
-Takes an R4RS expression, macro-expands it, evals the result of the
-macro expansion, and returns the result of the evaluation.
+@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 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
+@deffn Procedure array-in-bounds? array index1 index2 @dots{}
+Returns @code{#t} if its arguments would be acceptable to
+@code{array-ref}.
@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}.
+@defun array-ref array index1 index2 @dots{}
+Returns the element at the @code{(@var{index1}, @var{index2})} element
+in @var{array}.@refill
+@end defun
-The top-level syntactic environment is extended by binding the
-@var{keyword} to the specified transformer.
+@deffn Procedure array-set! array new-value index1 index2 @dots{}
+@end deffn
-@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
+@defun array-1d-ref array index
+@defunx array-2d-ref array index index
+@defunx array-3d-ref array index index index
+@end defun
-@defmac syntax-rules literals syntax-rule @dots{}
-@var{literals} is a list of identifiers, and each @var{syntax-rule}
-should be of the form
+@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
-@code{(@var{pattern} @var{template})}
+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
-where the @var{pattern} and @var{template} are as in the grammar above.
+If you comment out the bounds checking code, this is about as efficient
+as you could ask for without help from the compiler.
-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.
+An exercise left to the reader: implement the rest of APL.
-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)}
+@node Array Mapping, Association Lists, Arrays, Data Structures
+@subsection Array Mapping
-@cite{Macros That Work} differs from the other R4RS macro
-implementations in that it does not expand derived expression types to
-primitive expression types.
+@code{(require 'array-for-each)}
+@ftindex array-for-each
-@defun macro:expand expression
-@defunx macwork:expand expression
-Takes an R4RS expression, macro-expands it, and returns the result of
-the macro expansion.
+@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 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
+@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
-@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.
+@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
-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.
+@defun array-index-map! array proc
+applies @var{proc} to the indices of each element of @var{array} in
+turn, storing the result in the corresponding element. The value
+returned and the order of application are unspecified.
+One can implement @var{array-indexes} as
@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)
+(define (array-indexes array)
+ (let ((ra (apply make-array #f (array-shape array))))
+ (array-index-map! ra (lambda x x))
+ ra))
@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
-
+Another example:
@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
+(define (apl:index-generator n)
+ (let ((v (make-uniform-vector n 1)))
+ (array-index-map! v (lambda (i) i))
+ v))
@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
+@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
-@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
+@node Association Lists, Byte, Array Mapping, Data Structures
+@subsection Association Lists
-@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
+@code{(require 'alist)}
+@ftindex alist
-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
+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
-@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
+Alist functions can be used with a secondary index method such as hash
+tables for improved performance.
-To obtain a syntactic environment other than the usage environment, use
-@code{capture-syntactic-environment}.@refill
+@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 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
+@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
-@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
+@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
-(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
+(define put (alist-associator string-ci=?))
+(define alist '())
+(set! alist (put alist "Foo" 9))
@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
-
+@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
-(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)
+(define rem (alist-remover string-ci=?))
+(set! alist (rem alist "foo"))
@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
+@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 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
+@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
-@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:
+@node Byte, Collections, Association Lists, Data Structures
+@subsection Byte
-@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{}
+@code{(require 'byte)}
-@item
-Removed a couple of Chez scheme dependencies.
+Some algorithms are expressed in terms of arrays of small integers.
+Using Scheme strings to implement these arrays is not portable vis-a-vis
+the correspondence between integers and characters and non-ascii
+character sets. These functions abstract the notion of a @dfn{byte}.
+@cindex byte
-@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}.
+@deffn Function byte-ref bytes k
+@var{k} must be a valid index of @var{bytes}. @code{byte-ref} returns
+byte @var{k} of @var{bytes} using zero-origin indexing.
+@findex byte-ref
+@end deffn
-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
+@deffn Procedure byte-set! bytes k byte
+@var{k} must be a valid index of @var{bytes}%, and @var{byte} must be a
+small integer. @code{Byte-set!} stores @var{byte} in element @var{k}
+of @var{bytes}
+@findex byte-set!
+and returns an unspecified value. @c <!>
-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.
+@end deffn
-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
+@deffn Function make-bytes k
+@deffnx Function make-bytes k byte
-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).
+@code{Make-bytes} returns a newly allocated byte-array of
+@findex make-bytes
+length @var{k}. If @var{byte} is given, then all elements of the
+byte-array are initialized to @var{byte}, otherwise the contents of the
+byte-array are unspecified.
-@subsection Notes
+@end deffn
-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
+@deffn Function write-byte byte
+@deffnx Function write-byte byte port
-@code{syntax-rules} and @code{with-syntax} (described in @cite{TR356})
-are defined.@refill
+Writes the byte @var{byte} (not an external representation of the
+byte) to the given @var{port} 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}.
+@findex current-output-port
-@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
+@end deffn
-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
+@deffn Function read-byte
+@deffnx Function read-byte port
-The syntax of define has been extended to allow @code{(define @var{id})},
-which assigns @var{id} to some unspecified value.@refill
+Returns the next byte available from the input @var{port}, updating
+the @var{port} to point to the following byte. If no more bytes
+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}.
+@findex current-input-port
-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
+@end deffn
-Send bug reports, comments, suggestions, and questions to Kent Dybvig
-(dyb@@iuvax.cs.indiana.edu).
+@deffn Function bytes byte @dots{}
-@subsection Note from maintainer
+Returns a newly allocated byte-array composed of the arguments.
-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.
+@end deffn
-@node Fluid-Let, Yasos, Syntax-Case Macros, Macros
-@section Fluid-Let
+@deffn Function bytes->list bytes
+@deffnx Function list->bytes bytes
-@code{(require 'fluid-let)}
+@code{Bytes->list} returns a newly allocated list of the
+@findex bytes->list
+bytes that make up the given byte-array. @code{List->bytes}
+@findex list->bytes
+returns a newly allocated byte-array formed from the small integers in
+the list @var{bytes}. @code{Bytes->list} and @code{list->bytes} are
+@findex list->bytes
+@findex bytes->list
+inverses so far as @code{equal?} is concerned.
+@findex equal?
-@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
+@node Collections, Dynamic Data Type, Byte, Data Structures
+@subsection 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 '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
+@code{(require 'collect)}
+@ftindex 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
-@node Setters, Yasos examples, Yasos interface, Yasos
-@subsection Setters
+@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
-@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!}.
+@item
+@code{(gen-keys @var{self})} is like @code{gen-elts}, but yields the
+collection's keys in order.
-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}.
+@end itemize
+They might support specialized @code{for-each-key} and
+@code{for-each-elt} operations.@refill
-@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
+@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 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
+@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
-(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
+(map-elts + (list 1 2 3) (vector 1 2 3))
+ @result{} #(2 4 6)
@end lisp
+@end deffn
-@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.
+@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
-(number->string (logand #b1100 #b1010) 2)
- @result{} "1000"
+(map-keys + (list 1 2 3) (vector 1 2 3))
+ @result{} #(0 2 4)
@end lisp
-@end defun
+@end deffn
-@defun logior n1 n2
-Returns the integer which is the bit-wise OR of the two integer
-arguments.
+@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
-Example:
+@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
+@ftindex collect
+@code{(require 'common-list-functions)} (@xref{Common List Functions}).@refill
+@ftindex common-list-functions
+
+Examples:
@lisp
-(number->string (logior #b1100 #b1010) 2)
- @result{} "1110"
+(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 logxor n1 n2
-Returns the integer which is the bit-wise XOR of the two integer
-arguments.
+@defun any? pred . collections
+A generalization of the list-based @code{some} (@xref{Lists as
+sequences}) to collections.@refill
Example:
@lisp
-(number->string (logxor #b1100 #b1010) 2)
- @result{} "110"
+(any? odd? (list 2 3 4 5))
+ @result{} #t
@end lisp
@end defun
-@defun lognot n
-Returns the integer which is the 2s-complement of the integer argument.
+@defun every? pred . collections
+A generalization of the list-based @code{every} (@xref{Lists as
+sequences}) to collections.@refill
Example:
@lisp
-(number->string (lognot #b10000000) 2)
- @result{} "-10000001"
-(number->string (lognot #b0) 2)
- @result{} "-1"
+(every? collection? '((1 2) #(1 2)))
+ @result{} #t
@end lisp
@end defun
-@defun logtest j k
-@example
-(logtest j k) @equiv{} (not (zero? (logand j k)))
+@defun empty? collection
+Returns @code{#t} iff there are no elements in @var{collection}.
-(logtest #b0100 #b1011) @result{} #f
-(logtest #b0100 #b0111) @result{} #t
-@end example
+@code{(empty? @var{collection}) @equiv{} (zero? (size @var{collection}))}
@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
+@defun size collection
+Returns the number of elements in @var{collection}.
@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
+@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
-@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:
+Here is a sample collection: @code{simple-table} which is also a
+@code{table}.@refill
@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}.
+(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
-Example:
-@lisp
-(integer-length #b10101010)
- @result{} 8
-(integer-length 0)
- @result{} 0
-(integer-length #b1111)
- @result{} 4
+(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
-@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
+@node Dynamic Data Type, Hash Tables, Collections, Data Structures
+@subsection Dynamic Data Type
-@code{(require 'modular)}
+@code{(require 'dynamic)}
+@ftindex dynamic
-@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
+@defun make-dynamic obj
+Create and returns a new @dfn{dynamic} whose global value is @var{obj}.
@end defun
-@defun symmetric:modulus n
-Returns @code{(quotient (+ -1 n) -2)} for positive odd integer @var{n}.
+@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 modulus->integer modulus
-Returns the non-negative integer characteristic of the ring formed when
-@var{modulus} is used with @code{modular:} procedures.
+@defun dynamic-ref dyn
+Return the value of the given dynamic in the current dynamic
+environment.
@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
+@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
-@noindent
-The rest of these functions assume normalized arguments; That is, the
-arguments are constrained by the following table:
+@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
-@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}.
+The @code{dynamic-bind} macro is not implemented.
-@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
+@node Hash Tables, Hashing, Dynamic Data Type, Data Structures
+@subsection Hash Tables
-@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
+@code{(require 'hash-table)}
+@ftindex hash-table
-@defun modular:negate modulus k2
-Returns (@minus{}@var{k2}) mod @var{modulus}.
+@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
-@defun modular:+ modulus k2 k3
-Returns (@var{k2} + @var{k3}) mod @var{modulus}.
-@end defun
+A hash table is a vector of association lists.
-@defun modular:@minus{} modulus k2 k3
-Returns (@var{k2} @minus{} @var{k3}) mod @var{modulus}.
+@defun make-hash-table k
+Returns a vector of @var{k} empty (association) lists.
@end defun
-@defun modular:* modulus k2 k3
-Returns (@var{k2} * @var{k3}) mod @var{modulus}.
+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
-The Scheme code for @code{modular:*} with negative @var{modulus} is not
-completed for fixnum-only implementations.
+@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 modular:expt modulus k2 k3
-Returns (@var{k2} ^ @var{k3}) mod @var{modulus}.
+@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
-
-@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.
-
+@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 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.
-
+@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
-@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.
+@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
-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.
+@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
-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)}
+@node Hashing, Priority Queues, Hash Tables, Data Structures
+@subsection Hashing
+@code{(require 'hash)}
+@ftindex hash
-@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
+These hashing functions are for use in quickly classifying objects.
+Hash tables use these functions.
-@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.
+@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
-See Robert Solovay and Volker Strassen, @cite{A Fast Monte-Carlo Test
-for Primality}, SIAM Journal on Computing, 1977, pp 84-85.
+For @code{hashq}, @code{(eq? obj1 obj2)} implies @code{(= (hashq obj1 k)
+(hashq obj2))}.@refill
-@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
+For @code{hashv}, @code{(eqv? obj1 obj2)} implies @code{(= (hashv obj1 k)
+(hashv obj2))}.@refill
-@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
+For @code{hash}, @code{(equal? obj1 obj2)} implies @code{(= (hash obj1 k)
+(hash obj2))}.@refill
-@defun prime:trials
-Is the maxinum number of iterations of Solovay-Strassen that will be
-done to test a number for primality.
+@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)}
+@ftindex sierpinski
-@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
+@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.
-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
+@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.)
-@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
+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
-@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
+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.
-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
+Example applications:
+@itemize @bullet
-@deffn Procedure random:uniform state
-Returns an uniformly distributed inexact real random number in the
-range between 0 and 1.
-@end deffn
+@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.
-@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
+@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.)
-@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
+@end itemize
+@end defun
-@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 'soundex)}
+@ftindex soundex
-@code{(require 'make-crc)}
+@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.
-@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.
+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.
-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.
+See Knuth, Vol. 3 @cite{Sorting and searching}, pp 391--2
-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:
+To manage unusual inputs, @code{soundex} omits all non-alphabetic
+characters. Consequently, in this implementation:
@example
-(make-port-crc 32 #b00000100110000010001110110110111)
+(soundex <string of blanks>) @result{} ""
+(soundex "") @result{} ""
@end example
-Creates a procedure to calculate the P1003.2/D11.2 (POSIX.2) 32-bit
-checksum from the polynomial:
+Examples from Knuth:
@example
- 32 26 23 22 16 12 11
- ( x + x + x + x + x + x + x +
+(map soundex '("Euler" "Gauss" "Hilbert" "Knuth"
+ "Lloyd" "Lukasiewicz"))
+ @result{} ("E460" "G200" "H416" "K530" "L300" "L222")
- 10 8 7 5 4 2 1
- x + x + x + x + x + x + x + 1 ) mod 2
+(map soundex '("Ellery" "Ghosh" "Heilbronn" "Kant"
+ "Ladd" "Lissajous"))
+ @result{} ("E460" "G200" "H416" "K530" "L300" "L222")
@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"))
+Some cases in which the algorithm fails (Knuth):
-@result{} 3553047446
-@end example
+@example
+(map soundex '("Rogers" "Rodgers")) @result{} ("R262" "R326")
-@node Plotting, Root Finding, Cyclic Checksum, Numerics
-@section Plotting on Character Devices
+(map soundex '("Sinclair" "St. Clair")) @result{} ("S524" "S324")
-@code{(require 'charplot)}
+(map soundex '("Tchebysheff" "Chebyshev")) @result{} ("T212" "C121")
+@end example
+@end defun
-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
+@node Priority Queues, Queues, Hashing, Data Structures
+@subsection Priority Queues
-@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
+@code{(require 'priority-queue)}
+@ftindex priority-queue
-Example:
-@example
-(require 'charplot)
-(set! charplot:height 19)
-(set! charplot:width 45)
+@defun make-heap pred<?
+Returns a binary heap suitable which can be used for priority queue
+operations.
+@end defun
-(define (make-points n)
- (if (zero? n)
- '()
- (cons (cons (/ n 6) (sin (/ n 6))) (make-points (1- n)))))
+@defun heap-length heap
+Returns the number of elements in @var{heap}.@refill
+@end defun
-(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
+@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
-@node Root Finding, , Plotting, Numerics
-@section Root Finding
+The algorithm for priority queues was taken from @cite{Introduction to
+Algorithms} by T. Cormen, C. Leiserson, R. Rivest. 1989 MIT Press.
-@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:
+@node Queues, Records, Priority Queues, Data Structures
+@subsection Queues
-@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))))
+@code{(require 'queue)}
+@ftindex queue
-(integer-sqrt 15) @result{} 4
-@end example
-@end defun
+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 integer-sqrt y
-Given a non-negative integer @var{y}, returns the rounded square-root of
-@var{y}.
+@defun make-queue
+Returns a new, empty queue.
@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.
+@defun queue? obj
+Returns @code{#t} if @var{obj} is a queue.
@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.
+@defun queue-empty? q
+Returns @code{#t} if the queue @var{q} is empty.
+@end defun
-@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
+@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
-@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.
+All of the following functions raise an error if the queue @var{q} is
+empty.@refill
-If @code{prec} is instead a negative integer, @code{laguerre:find-root}
-returns the result of -@var{prec} iterations.
+@defun queue-front q
+Returns the datum at the front of the queue @var{q}.
@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.
+@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 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:
+@node Records, Structures, Queues, Data Structures
+@subsection Records
-@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
+@code{(require 'record)}
+@ftindex record
-@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.
+The Record package provides a facility for user to define their own
+record data types.
-@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}.
+@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
-@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
+@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 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.
+@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 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.
+@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
-@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
+@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 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}.
+@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
-@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{}.
+@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 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{}.
+In May of 1996, as a product of discussion on the @code{rrrs-authors}
+mailing list, I rewrote @file{record.scm} to portably implement type
+disjointness for record data types.
-@emph{Note:} @code{batch:run-script} and @code{batch:try-system} are not the
-same for some operating systems (VMS).
-@end defun
+As long as an implementation's procedures are opaque and the
+@code{record} code is loaded before other programs, this will give
+disjoint record types which are unforgeable and incorruptible by R4RS
+procedures.
-@defun batch:comment parms line1 @dots{}
-Writes comment lines @var{line1} @dots{} to the @code{batch-port} in
-@var{parms}.
-@end defun
+As a consequence, the procedures @code{record?},
+@code{record-type-descriptor}, @code{record-type-name}.and
+@code{record-type-field-names} are no longer supported.
-@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{}.
+@ignore
+@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 batch:delete-file parms file
-Writes a command to the @code{batch-port} in @var{parms} which deletes
-the file named @var{file}.
+@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 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}.
+@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
-@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.
+@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
+@end ignore
-@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
+@node Structures, , Records, Data Structures
+@subsection Structures
-@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
+@code{(require 'struct)} (uses defmacros)
+@ftindex struct
-@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
+@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
-@noindent
-Here is an example of the use of most of batch's procedures:
+Matthew McDonald <mafm@@cs.uwa.edu.au> added field setters.
-@example
-(require 'database-utilities)
-(require 'parameters)
-(require 'batch)
+@defmac define-record tag (var1 var2 @dots{})
+Defines several functions pertaining to record-name @var{tag}:
-(define batch (create-database #f 'alist-table))
-(batch:initialize! batch)
+@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{tag}-var1! obj val
+@end defun
+@defun set-@var{tag}-var2! obj val
+@end defun
+@dots{}
-(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
+Here is an example of its use.
-(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")
- )))
+@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
-@noindent
-Produces the file @file{my-batch}:
+@defmac variant-case exp (tag (var1 var2 @dots{}) body) @dots{}
+executes the following for the matching clause:
@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
+((lambda (@var{var1} @var{var} @dots{}) @var{body})
+ (@var{tag->var1} @var{exp})
+ (@var{tag->var2} @var{exp}) @dots{})
@end example
+@end defmac
-@noindent
-When run, @file{my-batch} prints:
-@example
-bash$ my-batch
-mv: hello.c: No such file or directory
-hello world
-@end example
+@node Procedures, Standards Support, Data Structures, Other Packages
+@section Procedures
+
+Anything that doesn't fall neatly into any of the other categories winds
+up here.
+
+@menu
+* Common List Functions:: 'common-list-functions
+* Tree Operations:: 'tree
+* Chapter Ordering:: 'chapter-order
+* Sorting:: 'sort
+* Topological Sort:: Keep your socks on.
+* String-Case:: 'string-case
+* String Ports:: 'string-port
+* String Search:: Also Search from a Port.
+* Line I/O:: 'line-i/o
+* Multi-Processing:: 'process
+@end menu
-@node Common List Functions, Format, Batch, Procedures
-@section Common List Functions
+@node Common List Functions, Tree Operations, Procedures, Procedures
+@subsection Common List Functions
@code{(require 'common-list-functions)}
+@ftindex common-list-functions
The procedures below follow the Common LISP equivalents apart from
optional arguments in some cases.
@@ -5609,7 +8540,7 @@ optional arguments in some cases.
@node List construction, Lists as sets, Common List Functions, Common List Functions
-@subsection List construction
+@subsubsection List construction
@defun make-list k . init
@code{make-list} creates and returns a list of @var{k} elements. If
@@ -5674,7 +8605,7 @@ Example:
@node Lists as sets, Lists as sequences, List construction, Common List Functions
-@subsection Lists as sets
+@subsubsection Lists as sets
@code{eq?} is used to test for membership by all the procedures below
which treat lists as sets.@refill
@@ -5887,7 +8818,7 @@ Example:
@node Lists as sequences, Destructive list operations, Lists as sets, Common List Functions
-@subsection Lists as sequences
+@subsubsection Lists as sequences
@defun position obj lst
@code{position} returns the 0-based position of @var{obj} in @var{lst},
@@ -5948,7 +8879,7 @@ in terms of @code{reduce} and a combinator elsewhere called
(define reverse
(lambda (args)
- (reduce-init (commute cons) args)))
+ (reduce-init (commute cons) '() args)))
@end lisp
@end defun
@@ -6009,19 +8940,42 @@ Example:
@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
+
@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)
+(butlast '(a b c d) 3)
+ @result{} (a)
+(butlast '(a b c d) 4)
@result{} ()
@end lisp
@end defun
+@noindent
+@code{last} and @code{butlast} split a list into two parts when given
+identical arugments.
+@example
+(last '(a b c d e) 2)
+ @result{} (d e)
+(butlast '(a b c d e) 2)
+ @result{} (a b c)
+@end example
+
@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
@@ -6029,33 +8983,40 @@ result. Thus @code{(nthcdr 3 @var{lst})} @equiv{} @code{(cdddr
Example:
@lisp
-(nthcdr 2 '(1 2 3 4))
- @result{} (3 4)
-(nthcdr 0 '(1 2 3 4))
- @result{} (1 2 3 4)
+(nthcdr 2 '(a b c d))
+ @result{} (c d)
+(nthcdr 0 '(a b c d))
+ @result{} (a b c d)
@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.
+@defun butnthcdr n lst
+@code{butnthcdr} returns all but the nthcdr @var{n} elements of
+@var{lst}.@refill
Example:
@lisp
-(last '(foo bar baz bang) 2)
- @result{} (baz bang)
-(last '(1 2 3) 0)
- @result{} 0
+(butnthcdr 3 '(a b c d))
+ @result{} (a b c)
+(butnthcdr 4 '(a b c d))
+ @result{} ()
@end lisp
@end defun
-
-
+@noindent
+@code{nthcdr} and @code{butnthcdr} split a list into two parts when
+given identical arugments.
+@example
+(nthcdr 2 '(a b c d e))
+ @result{} (c d e)
+(butnthcdr 2 '(a b c d e))
+ @result{} (a b)
+@end example
@node Destructive list operations, Non-List functions, Lists as sequences, Common List Functions
-@subsection Destructive list operations
+@subsubsection Destructive list operations
These procedures may mutate the list they operate on, but any such
mutation is undefined.
@@ -6157,7 +9118,7 @@ The examples should suffice to show why this is the case.
@node Non-List functions, , Destructive list operations, Common List Functions
-@subsection Non-List functions
+@subsubsection Non-List functions
@defun and? . args
@code{and?} checks to see if all its arguments are true. If they are,
@@ -6211,637 +9172,105 @@ Converts and returns @var{object} of type @code{char}, @code{number},
@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
+@node Tree Operations, Chapter Ordering, Common List Functions, Procedures
+@subsection Tree operations
-@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{(require 'tree)}
+@ftindex tree
-@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
+These are operations that treat lists a representations of trees.
-@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
+@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
-The value returned by @code{generic-write} is undefined.
+@code{substq} and @code{substv} are similar, but test against @var{old}
+using @code{eq?} and @code{eqv?} respectively.@refill
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)
+(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 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
+@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
-
-
-@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.
+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 Chapter Ordering, Sorting, Tree Operations, Procedures
+@subsection Chapter Ordering
+@code{(require 'chapter-order)}
+@ftindex chapter-order
-@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
+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.
-@code{pretty-print}s @var{obj} on @var{port}. If @var{port} is not
-specified, @code{current-output-port} is used.
+@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:
@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
+(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
-@end deffn
+@defunx chap:string>? string1 string2
+@defunx chap:string<=? string1 string2
+@defunx chap:string>=? string1 string2
+Implement the corresponding chapter-order predicates.
+@end defun
-@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.
+@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.
-@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.
+@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@}"
-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 example
@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
+@node Sorting, Topological Sort, Chapter Ordering, Procedures
+@subsection Sorting
@code{(require 'sort)}
+@ftindex sort
Many Scheme systems provide some kind of sorting functions. They do
not, however, always provide the @emph{same} sorting functions, and
@@ -7016,10 +9445,12 @@ in Common LISP, just write
@noindent
in Scheme.
-@node Topological Sort, Standard Formatted I/O, Sorting, Procedures
-@section Topological Sort
+@node Topological Sort, String-Case, Sorting, Procedures
+@subsection Topological Sort
@code{(require 'topological-sort)} or @code{(require 'tsort)}
+@ftindex topological-sort
+@ftindex tsort
@noindent
The algorithm is inspired by Cormen, Leiserson and Rivest (1990)
@@ -7055,6 +9486,7 @@ tie or his belt.) `tsort' gives the correct order of dressing:
@example
(require 'tsort)
+@ftindex tsort
(tsort '((shirt tie belt)
(tie jacket)
(belt jacket)
@@ -7068,423 +9500,13 @@ tie or his belt.) `tsort' gives the correct order of dressing:
@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
+@node String-Case, String Ports, Topological Sort, Procedures
+@subsection String-Case
@code{(require 'string-case)}
+@ftindex string-case
@deffn Procedure string-upcase str
@deffnx Procedure string-downcase str
@@ -7503,9 +9525,10 @@ The destructive versions of the functions above.
@node String Ports, String Search, String-Case, Procedures
-@section String Ports
+@subsection String Ports
@code{(require 'string-port)}
+@ftindex string-port
@deffn Procedure call-with-output-string proc
@var{proc} must be a procedure of one argument. This procedure calls
@@ -7523,18 +9546,28 @@ returned.@refill
@end deffn
-@node String Search, Tektronix Graphics Support, String Ports, Procedures
-@section String Search
+@node String Search, Line I/O, String Ports, Procedures
+@subsection String Search
@code{(require 'string-search)}
+@ftindex string-search
@deffn Procedure string-index string char
+@deffnx Procedure string-index-ci 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 string-reverse-index string char
+@deffnx Procedure string-reverse-index-ci string char
+Returns the index of the last 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
+@deffnx procedure substring-ci? 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
@@ -7549,14 +9582,23 @@ character of the first substring of @var{string} that is equal to
@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.
+of the input port @var{in-port}.
+@deffnx Procedure find-string-from-port? str in-port
+When called with two arguments, the search span is limited by the end of
+the input stream.
+@deffnx Procedure find-string-from-port? str in-port char
+Searches up to the first occurrence of character @var{char} in
+@var{str}.
+@deffnx Procedure find-string-from-port? str in-port proc
+Searches up to the first occurrence of the procedure @var{proc}
+returning non-false when called with a character (from @var{in-port})
+argument.
+
+When the @var{str} is found, @code{find-string-from-port?} 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
@@ -7565,128 +9607,79 @@ 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.
+@node Line I/O, Multi-Processing, String Search, Procedures
+@subsection Line I/O
-@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
+@code{(require 'line-i/o)}
+@ftindex line-i
-@deffn Procedure tek40:reset
-@end deffn
+@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
-@subsection Tektronix 4100 Series Graphics
+@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
-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
+@node Multi-Processing, , Line I/O, Procedures
+@subsection Multi-Processing
-@deffn Procedure tek41:move x y
-@end deffn
+@code{(require 'process)}
+@ftindex process
-@deffn Procedure tek41:draw x y
-@end deffn
+This module implements asynchronous (non-polled) time-sliced
+multi-processing in the SCM Scheme implementation using procedures
+@code{alarm} and @code{alarm-interrupt}.
+@findex alarm
+@findex alarm-interrupt
+Until this is ported to another implementation, consider it an example
+of writing schedulers in Scheme.
-@deffn Procedure tek41:point x y number
+@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 tek41:encode-x-y x y
+@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 tek41:encode-int number
+@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 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
+@node Standards Support, Session Support, Procedures, Other Packages
+@section Standards Support
@@ -7701,14 +9694,13 @@ Example:
* 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
+@subsection With-File
@code{(require 'with-file)}
+@ftindex with-file
@defun with-input-from-file file thunk
@defunx with-output-to-file file thunk
@@ -7716,9 +9708,10 @@ Description found in R4RS.
@end defun
@node Transcripts, Rev2 Procedures, With-File, Standards Support
-@section Transcripts
+@subsection Transcripts
@code{(require 'transcript)}
+@ftindex transcript
@defun transcript-on filename
@defunx transcript-off filename
@@ -7731,9 +9724,10 @@ Redefines @code{read-char}, @code{read}, @code{write-char},
@node Rev2 Procedures, Rev4 Optional Procedures, Transcripts, Standards Support
-@section Rev2 Procedures
+@subsection Rev2 Procedures
@code{(require 'rev2-procedures)}
+@ftindex 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
@@ -7793,9 +9787,10 @@ trailing @samp{?}.
@node Rev4 Optional Procedures, Multi-argument / and -, Rev2 Procedures, Standards Support
-@section Rev4 Optional Procedures
+@subsection Rev4 Optional Procedures
@code{(require 'rev4-optional-procedures)}
+@ftindex rev4-optional-procedures
For the specification of these optional procedures,
@xref{Standard procedures, , ,r4rs, Revised(4) Scheme}.
@@ -7829,9 +9824,10 @@ For the specification of these optional procedures,
@node Multi-argument / and -, Multi-argument Apply, Rev4 Optional Procedures, Standards Support
-@section Multi-argument / and -
+@subsection Multi-argument / and -
@code{(require 'mutliarg/and-)}
+@ftindex mutliarg
For the specification of these optional forms, @xref{Numerical
operations, , ,r4rs, Revised(4) Scheme}. The @code{two-arg:}* forms are
@@ -7857,9 +9853,10 @@ The original two-argument version of @code{-}.
@node Multi-argument Apply, Rationalize, Multi-argument / and -, Standards Support
-@section Multi-argument Apply
+@subsection Multi-argument Apply
@code{(require 'multiarg-apply)}
+@ftindex multiarg-apply
@noindent
For the specification of this optional form,
@@ -7878,9 +9875,10 @@ implementations which don't support the many-argument version.
@node Rationalize, Promises, Multi-argument Apply, Standards Support
-@section Rationalize
+@subsection Rationalize
@code{(require 'rationalize)}
+@ftindex rationalize
The procedure rationalize is interesting because most programming
languages do not provide anything analogous to it. For simplicity, we
@@ -7898,9 +9896,10 @@ We thank Alan Bawden for contributing this algorithm.
@node Promises, Dynamic-Wind, Rationalize, Standards Support
-@section Promises
+@subsection Promises
@code{(require 'promise)}
+@ftindex promise
@defun make-promise proc
@end defun
@@ -7915,9 +9914,10 @@ doesn't support them
@node Dynamic-Wind, Values, Promises, Standards Support
-@section Dynamic-Wind
+@subsection Dynamic-Wind
@code{(require 'dynamic-wind)}
+@ftindex dynamic-wind
This facility is a generalization of Common LISP @code{unwind-protect},
designed to take into account the fact that continuations produced by
@@ -7945,10 +9945,11 @@ the time of the error or interrupt.@refill
-@node Values, Time, Dynamic-Wind, Standards Support
-@section Values
+@node Values, , Dynamic-Wind, Standards Support
+@subsection Values
@code{(require 'values)}
+@ftindex values
@defun values obj @dots{}
@code{values} takes any number of arguments, and passes (returns) them
@@ -7969,154 +9970,9 @@ 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
+@node Session Support, Extra-SLIB Packages, Standards Support, Other Packages
+@section Session Support
@menu
* Repl:: Macros at top-level
@@ -8124,31 +9980,16 @@ match the arguments to @code{encode-universal-time}.
* 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
+* Time Zone::
@end menu
-
@node Repl, Quick Print, Session Support, Session Support
-@section Repl
+@subsection Repl
@code{(require 'repl)}
+@ftindex repl
Here is a read-eval-print-loop which, given an eval, evaluates forms.
@@ -8178,14 +10019,17 @@ 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)
+@ftindex macro
(require 'repl)
+@ftindex repl
(repl:top-level macro:eval)
@end lisp
@node Quick Print, Debug, Repl, Session Support
-@section Quick Print
+@subsection Quick Print
@code{(require 'qp)}
+@ftindex qp
@noindent
When displaying error messages and warnings, it is paramount that the
@@ -8217,9 +10061,10 @@ should use.@refill
@end defvar
@node Debug, Breakpoints, Quick Print, Session Support
-@section Debug
+@subsection Debug
@code{(require 'debug)}
+@ftindex debug
@noindent
Requiring @code{debug} automatically requires @code{trace} and
@@ -8233,6 +10078,7 @@ printer for @code{qp}. This example shows how to do this:
(define qpn (lambda args) @dots{})
(provide 'qp)
(require 'debug)
+@ftindex debug
@end example
@deffn Procedure trace-all file
@@ -8246,14 +10092,17 @@ top-level in file @file{file}.
@end deffn
@node Breakpoints, Trace, Debug, Session Support
-@section Breakpoints
+@subsection Breakpoints
@code{(require 'break)}
+@ftindex 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
+@ftindex break
@code{(require 'debug)} telling you to type @code{(init-debug)}. This
+@ftindex debug
is in order to establish a top-level continuation. Typing
@code{(init-debug)} at top level sets up a continuation for
@code{break}.
@@ -8326,10 +10175,11 @@ To unbreak, type
@end lisp
@end defun
-@node Trace, Getopt, Breakpoints, Session Support
-@section Tracing
+@node Trace, System Interface, Breakpoints, Session Support
+@subsection Tracing
@code{(require 'trace)}
+@ftindex trace
@defmac trace proc1 @dots{}
Traces the top-level named procedures given as arguments.
@@ -8385,225 +10235,10 @@ To untrace, type
@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
+@node System Interface, Time Zone, Trace, Session Support
+@subsection System Interface
@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
@@ -8611,6 +10246,7 @@ 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
+@noindent
If @code{(provided? 'system)}:
@defun system command-string
@@ -8618,441 +10254,466 @@ Executes the @var{command-string} on the computer and returns the
integer status code.
@end defun
+@noindent
+If @code{(provided? 'current-time)}:
-@node Require, Vicinity, System Interface, Session Support
-@section Require
+@noindent
+The procedures @code{current-time}, @code{difftime}, and
+@code{offset-time} deal with a @dfn{calendar time} datatype
+@cindex time
+@cindex calendar time
+which may or may not be disjoint from other Scheme datatypes.
-These variables and procedures are provided by all implementations.
+@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{Common-Lisp Time}.
+@end defun
-@defvar *features*
-Is a list of symbols denoting features supported in this implementation.
-@end defvar
+@defun difftime caltime1 caltime0
+Returns the difference (number of seconds) between twe calendar times:
+@var{caltime1} - @var{caltime0}. @var{caltime0} may also be a number.
+@end defun
-@defvar *modules*
-Is a list of pathnames denoting files which have been loaded.
-@end defvar
+@defun offset-time caltime offset
+Returns the calendar time of @var{caltime} offset by @var{offset} number
+of seconds @code{(+ caltime offset)}.
+@end defun
-@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
+@node Time Zone, , System Interface, Session Support
+@subsection Time Zone
+
+(require 'time-zone)
+
+@deftp {Data Format} TZ-string
+
+POSIX standards specify several formats for encoding time-zone rules.
+
+@table @t
+@item :@i{<pathname>}
+If the first character of @i{<pathname>} is @samp{/}, then
+@i{<pathname>} specifies the absolute pathname of a tzfile(5) format
+time-zone file. Otherwise, @i{<pathname>} is interpreted as a pathname
+within @var{tzfile:vicinity} (/usr/lib/zoneinfo/) naming a tzfile(5)
+format time-zone file.
+@item @i{<std>}@i{<offset>}
+The string @i{<std>} consists of 3 or more alphabetic characters.
+@i{<offset>} specifies the time difference from GMT. The @i{<offset>}
+is positive if the local time zone is west of the Prime Meridian and
+negative if it is east. @i{<offset>} can be the number of hours or
+hours and minutes (and optionally seconds) separated by @samp{:}. For
+example, @code{-4:30}.
+@item @i{<std>}@i{<offset>}@i{<dst>}
+@i{<dst>} is the at least 3 alphabetic characters naming the local
+daylight-savings-time.
+@item @i{<std>}@i{<offset>}@i{<dst>}@i{<doffset>}
+@i{<doffset>} specifies the offset from the Prime Meridian when
+daylight-savings-time is in effect.
+@end table
-In the following three functions if @var{feature} is not a symbol it is
-assumed to be a pathname.@refill
+The non-tzfile formats can optionally be followed by transition times
+specifying the day and time when a zone changes from standard to
+daylight-savings and back again.
+
+@table @t
+@item ,@i{<date>}/@i{<time>},@i{<date>}/@i{<time>}
+The @i{<time>}s are specified like the @i{<offset>}s above, except that
+leading @samp{+} and @samp{-} are not allowed.
+
+Each @i{<date>} has one of the formats:
+
+@table @t
+@item J@i{<day>}
+specifies the Julian day with @i{<day>} between 1 and 365. February 29
+is never counted and cannot be referenced.
+@item @i{<day>}
+This specifies the Julian day with n between 0 and 365. February 29 is
+counted in leap years and can be specified.
+@item M@i{<month>}.@i{<week>}.@i{<day>}
+This specifies day @i{<day>} (0 <= @i{<day>} <= 6) of week @i{<week>} (1
+<= @i{<week>} <= 5) of month @i{<month>} (1 <= @i{<month>} <= 12). Week
+1 is the first week in which day d occurs and week 5 is the last week in
+which day @i{<day>} occurs. Day 0 is a Sunday.
+@end table
+@end table
-@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
+@end deftp
-@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
+@deftp {Data Type} time-zone
+is a datatype encoding how many hours from Greenwich Mean Time the local
+time is, and the @dfn{Daylight Savings Time} rules for changing it.
+@end deftp
-@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*.
+@defun time-zone TZ-string
+Creates and returns a time-zone object specified by the string
+@var{TZ-string}. If @code{time-zone} cannot interpret @var{TZ-string},
+@code{#f} is returned.
@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
+@defun tz:params caltime tz
+@var{tz} is a time-zone object. @code{tz:params} returns a list of
+three items:
+@enumerate 0
+@item
+An integer. 0 if standard time is in effect for timezone @var{tz} at
+@var{caltime}; 1 if daylight savings time is in effect for timezone
+@var{tz} at @var{caltime}.
@item
-'real
+The number of seconds west of the Prime Meridian timezone @var{tz} is at
+@var{caltime}.
@item
-'complex
-@item
-'bignum
-@end itemize
-
-
-
-
+The name for timezone @var{tz} at @var{caltime}.
+@end enumerate
-@node Vicinity, Configuration, Require, Session Support
-@section Vicinity
+@code{tz:params} is unaffected by the default timezone; inquiries can be
+made of any timezone at any calendar time.
-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.
+@end defun
-These procedures are provided by all implementations.
+@noindent
+The rest of these procedures and variables are provided for POSIX
+compatability. Because of shared state they are not thread-safe.
-@defun make-vicinity filename
-Returns the vicinity of @var{filename} for use by @code{in-vicinity}.
-@end defun
+@defun tzset
+Returns the default time-zone.
+@defunx tzset tz
+Sets (and returns) the default time-zone to @var{tz}.
+@defunx tzset TZ-string
+Sets (and returns) the default time-zone to that specified by
+@var{TZ-string}.
-@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
+@code{tzset} also sets the variables @var{*timezone*}, @var{daylight?},
+and @var{tzname}. This function is automatically called by the time
+conversion procedures which depend on the time zone (@pxref{Time and
+Date}).
@end defun
-@defun library-vicinity
-Returns the vicinity of the shared Scheme library.
-@end defun
+@defvar *timezone*
+Contains the difference, in seconds, between Greenwich Mean Time 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 implementation-vicinity
-Returns the vicinity of the underlying Scheme implementation. This
-vicinity will likely contain startup code and messages and a compiler.
-@end defun
+@defvar daylight?
+is @code{#t} if the default timezone has rules for @dfn{Daylight Savings
+Time}. @emph{Note:} @var{daylight?} does not tell you when Daylight
+Savings Time is in effect, just that the default zone sometimes has
+Daylight Savings Time.
+@end defvar
-@defun user-vicinity
-Returns the vicinity of the current directory of the user. On most
-systems this is @file{""} (the empty string).
-@end defun
+@defvar tzname
+is a vector of strings. Index 0 has the abbreviation for the standard
+timezone; If @var{daylight?}, then index 1 has the abbreviation for the
+Daylight Savings timezone.
+@end defvar
-@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
+@node Extra-SLIB Packages, , Session Support, Other Packages
+@section Extra-SLIB Packages
-@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
+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
-@node Configuration, Input/Output, Vicinity, Session Support
-@section Configuration
+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
+@ifset html
+<A HREF="http://www.cs.tut.fi/staff/pk/scheme/psd/article/article.html">
+@end ifset
+@lisp
+http://www.cs.tut.fi/staff/pk/scheme/psd/article/article.html
+@end lisp
+@ifset html
+</A>
+@end ifset
+@item SCHELOG is an embedding of Prolog in Scheme.
+@ifset html
+<A HREF="http://www.cs.rice.edu/CS/PLT/packages/schelog/">
+@end ifset
+@lisp
+http://www.cs.rice.edu/CS/PLT/packages/schelog/
+@end lisp
+@ifset html
+</A>
+@end ifset
+@end table
-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
+@node About SLIB, Index, Other Packages, Top
+@chapter About SLIB
-@defvr Constant most-positive-fixnum
-The immediate integer closest to positive infinity.
-@end defvr
+@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.
+@end menu
-@defvr Constant slib:tab
-The tab character.
-@end defvr
+@noindent
+More people than I can name have contributed to SLIB. Thanks to all of
+you.
-@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
+@node Installation, Porting, About SLIB, About SLIB
+@section Installation
-@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.
+Check the manifest in @file{/usr/doc/slib/README.gz} to find a
+configuration file for your Scheme implementation. Initialization files
+for most IEEE P1178 compliant Scheme Implementations are included with
+this distribution.
-@example
-(slib:report-version) @result{} slib "2a3" on scm "4e1" on unix
-@end example
-@end defun
+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}. Scheme48
+supports @code{getenv} but does not use it for determining
+@code{library-vicinity}. (That is done from the Makefile.)
-@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.
+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.
-@defunx slib:report #t
-provides a more verbose listing.
+Once this is done you can modify the startup file for your Scheme
+implementation to @code{load} this initialization file. SLIB is then
+installed. The startup files are located in
+@file{/usr/lib/slib/init/}.
-@defunx slib:report filename
-Writes the report to file @file{filename}.
+Multiple implementations of Scheme can all use the same SLIB directory.
+Simply configure each implementation's initialization file as outlined
+above.
-@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
+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.
-@node Input/Output, Legacy, Configuration, Session Support
-@section Input/Output
+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 for an
+installation under @code{<prefix>}, @code{cd} to the SLIB directory and
+type @code{make prefix=<prefix> slib48}. To install the image, type
+@code{make prefix=<prefix> install48}. This will also create a shell
+script with the name @code{slib48} which will invoke the saved image.
-These procedures are provided by all implementations.
+@node Porting, Coding Standards, Installation, About SLIB
+@section Porting
-@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
+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. @footnote{If you are
+porting a @cite{Revised^3 Report on the Algorithmic Language Scheme}
+implementation, then you will need to finish writing @file{sc4sc3.scm}
+and @code{load} it from your initialization file.}
-@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
+@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}.
-@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
+Your customized version should then be loaded as part of your scheme
+implementation's initialization. It will load @file{require.scm} from
+the library; this will allow the use of @code{provide},
+@code{provided?}, and @code{require} along with the @dfn{vicinity}
+functions (these functions are documented in the section
+@xref{Require}). The rest of the library will then be accessible in a
+system independent fashion.@refill
-@deffn Procedure current-error-port
-Returns the current port to which diagnostic and error output is
-directed.
-@end deffn
+Please mail new working configuration files to @code{jaffer@@ai.mit.edu}
+so that they can be included in the SLIB distribution.@refill
-@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
+@node Coding Standards, Copyrights, Porting, About SLIB
+@section Coding Standards
-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
+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
+@ftindex rev3-report
-@deffn Procedure output-port-height
-@deffnx Procedure output-port-height port
+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
-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
+Code submitted for inclusion in SLIB should not duplicate routines
+already in SLIB files. Use @code{require} to force those library
+routines to be used by 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
-@node Legacy, System, Input/Output, Session Support
-@section Legacy
+Documentation should be provided in Emacs Texinfo format if possible,
+But documentation must be provided.
-@defun identity x
-@var{identity} returns its argument.
+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!
-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
+@subheading Modifications
-These were present in Scheme until R4RS (@pxref{Notes, , Language
-changes ,r4rs, Revised(4) Scheme}).
+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).
-@defvr Constant t
-Derfined as @code{#t}.
-@end defvr
+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.
-@defvr Constant nil
-Defined as @code{#f}.
-@end defvr
+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.
-@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 Copyrights, , Coding Standards, About SLIB
+@section Copyrights
-@node System, , Legacy, Session Support
-@section System
+This section has instructions for SLIB authors regarding copyrights.
-These procedures are provided by all implementations.
+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.
-@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
+If your code or changes amount to less than about 10 lines, you do not
+need to add your copyright or send a disclaimer.
-@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
+@subheading Putting code into the Public Domain
-@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.
+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.
-If an implementation does not support compiled code then
-@code{slib:load} will be identical to @code{slib:load-source}.
-@end deffn
+@quotation
+I, @var{name}, hereby affirm that I have placed the software package
+@var{name} in the public domain.
-@deffn Procedure slib:eval obj
-@code{eval} returns the value of @var{obj} evaluated in the current top
-level environment.@refill
-@end deffn
+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.
-@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
+@flushright
+ @var{signature and date}
+@end flushright
+@end quotation
-@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
+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.
-@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
+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
-@node Optional SLIB Packages, Procedure and Macro Index, Session Support, Top
-@chapter Optional SLIB Packages
+@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:
-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.
+Arrange that your name appears in a copyright line for the appropriate
+year. Multiple copyright lines are acceptable.
@item
-Because it is an application program, rather than a library module.
+With your copyright line, specify any terms you require to be different
+from those already in the file.
@item
-Because I have been too busy to integrate it.
+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
-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:
+@subheading Example: Company Copyright Disclaimer
-@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
+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:
-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
+@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.
-@node Procedure and Macro Index, Variable Index, Optional SLIB Packages, Top
+@flushleft
+@var{signature and date},
+@var{name}, @var{title}, @var{employer} Corporation
+@end flushleft
+@end quotation
+
+@node Index, , About SLIB, Top
+@c @node Procedure and Macro Index, Variable Index, About SLIB, 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
+@c @node Variable Index, Concept Index, Procedure and Macro Index, Top
@unnumbered Variable Index
This is an alphabetical list of all the global variables in SLIB.
@printindex vr
+@c @node Concept Index, , Variable Index, Top
+@unnumbered Concept and Feature Index
+
+@printindex cp
+
@contents
@bye
diff --git a/stdio.scm b/stdio.scm
index bc4e914..2feb0df 100644
--- a/stdio.scm
+++ b/stdio.scm
@@ -1,3 +1,4 @@
+;; "stdio.scm" compatability stub
(require 'scanf)
(require 'printf)
diff --git a/strport.scm b/strport.scm
index 54d8d39..a75ab0a 100644
--- a/strport.scm
+++ b/strport.scm
@@ -33,7 +33,7 @@
(cond ((eof-object? c)
(set! s (string-append s (substring buf 0 i))))
((>= i 512)
- (set! s (string-append s buf))
+ (set! s (string-append s buf (string c)))
(loop 0))
(else
(string-set! buf i c)
diff --git a/strsrch.scm b/strsrch.scm
index a08510e..b25c229 100644
--- a/strsrch.scm
+++ b/strsrch.scm
@@ -1,6 +1,6 @@
;;; "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)
+; Modified 1996, 1997 by A. Jaffer (jaffer@ai.mit.edu)
;
; This code is in the public domain.
@@ -13,7 +13,27 @@
((char=? a-char (string-ref str pos)) pos)
(else (loop (+ 1 pos))))))
-(define (substring? pattern str)
+(define (string-index-ci str a-char)
+ (let loop ((pos 0))
+ (cond
+ ;; whole string has been searched, in vain
+ ((>= pos (string-length str)) #f)
+ ((char-ci=? a-char (string-ref str pos)) pos)
+ (else (loop (+ 1 pos))))))
+
+(define (string-reverse-index str a-char)
+ (let loop ((pos (- (string-length str) 1)))
+ (cond ((< pos 0) #f)
+ ((char=? (string-ref str pos) a-char) pos)
+ (else (loop (- pos 1))))))
+
+(define (string-reverse-index-ci str a-char)
+ (let loop ((pos (- (string-length str) 1)))
+ (cond ((< pos 0) #f)
+ ((char-ci=? (string-ref str pos) a-char) pos)
+ (else (loop (- pos 1))))))
+
+(define (miscio:substring? pattern str char=?)
(let* ((pat-len (string-length pattern))
(search-span (- (string-length str) pat-len))
(c1 (if (zero? pat-len) #f (string-ref pattern 0)))
@@ -39,24 +59,32 @@
;; mismatch after partial match
(outer (+ 1 pos))))))))))))
+(define (substring? pattern str) (miscio:substring? pattern str char=?))
+(define (substring-ci? pattern str) (miscio:substring? pattern str char-ci=?))
+
(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))
+ (lambda () (and (or (not (number? max-no-char))
+ (< no-chars-read max-no-char))
(let ((c (peek-char <input-port>)))
- (if (eof-object? c) #f c)))))
+ (and (not (eof-object? c))
+ (if (procedure? max-no-char)
+ (not (max-no-char c))
+ (not (eqv? max-no-char c)))
+ 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)))))))
+ (and c
+ (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
diff --git a/t3.init b/t3.init
index b9a0191..838d81b 100644
--- a/t3.init
+++ b/t3.init
@@ -1,7 +1,7 @@
;"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.
+;Copyright (C) 1991, 1992, 1993, 1994, 1997 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
@@ -52,6 +52,12 @@
(set (library-vicinity) "/usr/local/lib/slib/")
;;Obviously put your value here.
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define (home-vicinity) #f)
+
;;; *FEATURES* should be set to a list of symbols describing features
;;; of this implementation. See Template.scm for the list of feature
;;; names.
@@ -244,6 +250,12 @@
(evl o))
(set! *load-pathname* old-load-pathname)))))
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;;; define an error procedure for the library
(define slib:error error)
diff --git a/timezone.scm b/timezone.scm
new file mode 100644
index 0000000..8daa8fb
--- /dev/null
+++ b/timezone.scm
@@ -0,0 +1,257 @@
+;;;; "timezone.scm" Compute timezones and DST from TZ environment variable.
+;;; Copyright (C) 1994, 1996, 1997 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 C-library support for time in general and time-zones in particular
+;; stands as a fine example of how *not* to create interfaces.
+;;
+;; Functions are not consistently named. Support for GMT is offered in one
+;; direction only; The localtime function returns some timezone data in the
+;; structure which it returns, and some data in shared global variables.
+;; The structure which localtime returns is overwritten with each
+;; invocation. There is no way to find local time in zones other than GMT
+;; and the local timezone.
+;;
+;; The tzfile(5) format encodes only a single timezone per file. There is
+;; no dispatch on zone names, so multiple copies of a timezone file exist
+;; under different names. The TZ `:' specification is unix filesystem
+;; specific. The tzfile(5) format makes no provision for byte-order
+;; differences; It mixes 32-bit integer data with characters; specifying
+;; ASCII bytes, it is incompatible with different character sizes. The
+;; binary format makes it impossible to easily inspect a file for
+;; corruption.
+;;
+;; I have corrected most of the failings of the C-library time interface in
+;; SLIB while maintaining compatablility. I wrote support for Linux
+;; timezone files because on a system where TZ is not set, there is no
+;; other way to reveal this information. HP-UX appears to have a more
+;; sensible arrangement; I invite you to add support for it and other
+;; platforms.
+;;
+;; Writing this was a long, tedious, and unenlightening process. I hope it
+;; is useful.
+;;
+;; Sat Nov 15 00:15:33 1997 Aubrey Jaffer <jaffer@martigny.ai.mit.edu>
+
+(provide 'time-zone)
+(require 'scanf)
+
+(define daylight? #f)
+(define *timezone* 0)
+(define tzname '#("UTC" "???"))
+
+(define tz:default #f)
+
+;;; Parse Posix TZ string.
+
+(define (string->transition-day-time str)
+ (let ((month 0) (week 0) (day #f) (junk #f))
+ (or (case (sscanf str "J%u%s" day junk)
+ ((1) (and (<= 1 day 365)
+ (list #f #f day)))
+ (else #f))
+ (case (sscanf str "%u%s" day junk)
+ ((1) (and (<= 0 day 365)
+ (list #f #t day)))
+ (else #f))
+ (case (sscanf str "M%u.%u.%u%s" month week day junk)
+ ((3) (and (<= 1 month 12)
+ (<= 1 week 5)
+ (<= 0 day 6)
+ (list month week day)))
+ (else #f)))))
+
+(define (string->transition-time str)
+ (let ((date #f) (time "2") (junk #f))
+ (and (or (eqv? 2 (sscanf str "%[JM.0-9]/%[:0-9]%s" date time junk))
+ (eqv? 1 (sscanf str "%[JM.0-9]" date junk)))
+ (let ((day (string->transition-day-time date))
+ (tim (string->time-offset time)))
+ (and day tim (append day (list tim)))))))
+
+(define (string->time-offset str)
+ (and str (string? str) (positive? (string-length str))
+ (let ((hh #f) (mm 0) (ss 0) (junk #f))
+ (and (<= 1 (sscanf (if (memv (string-ref str 0) '(#\+ #\-))
+ (substring str 1 (string-length str))
+ str)
+ "%u:%u:%u%s" hh mm ss junk)
+ 3)
+ hh (<= 0 hh 23) (<= 0 mm 59) (<= 0 ss 59)
+ (* (if (char=? #\- (string-ref str 0)) -1 1)
+ (+ ss (* 60 (+ mm (* hh 60)))))))))
+
+(define (string->time-zone tz)
+ (let ((tzname #f) (offset #f) (dtzname #f) (doffset #f)
+ (start-str #f) (end-str #f) (junk #f))
+ (define found
+ (sscanf
+ tz "%[^0-9,+-]%[-:+0-9]%[^0-9,+-]%[-:+0-9],%[JM.0-9/:],%[JM.0-9/:]%s"
+ tzname offset dtzname doffset start-str end-str junk))
+ (set! offset (string->time-offset offset))
+ (set! doffset (string->time-offset doffset))
+ (cond
+ ((and offset (eqv? 3 found))
+ (set! doffset (+ -3600 offset))
+ (set! found
+ (+ 1
+ (sscanf
+ tz "%[^0-9,+-]%[-:+0-9]%[^0-9,+-],%[JM.0-9/:],%[JM.0-9/:]%s"
+ tzname offset dtzname start-str end-str junk)))
+ (set! offset (string->time-offset offset))))
+ (case found
+ ((2) (vector 'tz:fixed tz tzname offset))
+ ((4) (vector 'tz:rule tz tzname dtzname offset doffset
+ (list 4 1 0 7200) (list 10 5 0 7200)))
+ ((6) (let ((start (string->transition-time start-str))
+ (end (string->transition-time end-str)))
+ (and
+ start end
+ (vector 'tz:rule tz tzname dtzname offset doffset start end))))
+ (else #f))))
+
+(define (read-tzfile path)
+ (require 'tzfile)
+ (let ((realpath
+ (cond ((not path) (in-vicinity tzfile:vicinity "localtime"))
+ ((or (char-alphabetic? (string-ref path 0))
+ (char-numeric? (string-ref path 0)))
+ (in-vicinity tzfile:vicinity path))
+ (else path))))
+ (if (file-exists? realpath)
+ (let ((zone (tzfile:read realpath)))
+ (if zone (list->vector (cons 'tz:file zone))
+ (slib:error 'read-tzfile realpath)))
+ (slib:error 'read-tzfile "file not found:" realpath)
+ )))
+
+(define (time-zone tz)
+ (cond ((not tz) (read-tzfile #f))
+ ((vector? tz) tz)
+ ((eqv? #\: (string-ref tz 0))
+ (read-tzfile (substring tz 1 (string-length tz))))
+ (else (string->time-zone tz))))
+
+;;; Use the timezone
+
+(define (tzrule->caltime year previous-gmt-offset
+ tr-month tr-week tr-day tr-time)
+ (define leap? (leap-year? year))
+ (define gmmt
+ (time:invert time:gmtime
+ (vector 0 0 0 1 (if tr-month (+ -1 tr-month) 0) year #f #f 0)))
+ (offset-time
+ gmmt
+ (+ tr-time previous-gmt-offset
+ (* 3600 24
+ (if tr-month
+ (let* ((fdow (vector-ref (time:gmtime gmmt) 6)))
+ (case tr-week
+ ((1 2 3 4) (+ (modulo (- tr-day fdow) 7)
+ (* 7 (+ -1 tr-week))))
+ ((5)
+ (do ((mmax (vector-ref
+ (vector-ref time:days/month (if leap? 1 0))
+ (+ -1 tr-month)))
+ (d (modulo (- tr-day fdow) 7) (+ 7 d)))
+ ((>= d mmax) (+ -7 d))))
+ (else (slib:error 'tzrule->caltime
+ "week out of range" tr-week))))
+ (+ tr-day
+ (if (and (not tr-week) (>= tr-day 60) (leap-year? year))
+ 1 0)))))))
+
+(define (tz:params caltime tz)
+ (case (vector-ref tz 0)
+ ((tz:fixed) (list 0 (vector-ref tz 3) (vector-ref tz 2)))
+ ((tz:rule)
+ (let* ((year (vector-ref (time:gmtime caltime) 5))
+ (ttime0 (apply tzrule->caltime
+ year (vector-ref tz 4) (vector-ref tz 6)))
+ (ttime1 (apply tzrule->caltime
+ year (vector-ref tz 5) (vector-ref tz 7)))
+ (dst (if (and (not (negative? (difftime caltime ttime0)))
+ (negative? (difftime caltime ttime1)))
+ 1 0)))
+ (list dst (vector-ref tz (+ 4 dst)) (vector-ref tz (+ 2 dst)))
+ ;;(for-each display (list (gtime ttime0) (gtime caltime) (gtime ttime1)))
+ ))
+ ((tz:file) (let ((zone-spec (tzfile:get-zone-spec caltime tz)))
+ (list (if (vector-ref zone-spec 2) 1 0)
+ (- (vector-ref zone-spec 1))
+ (vector-ref zone-spec 0))))
+ (else (slib:error 'tz:params "unknown timezone type" tz))))
+
+(define (tz:std-offset zone)
+ (case (vector-ref zone 0)
+ ((tz:fixed) (vector-ref zone 3))
+ ((tz:rule) (vector-ref zone 4))
+ ((tz:file)
+ (let ((mode-table (vector-ref zone 2)))
+ (do ((type-idx 0 (+ 1 type-idx)))
+ ((or (>= type-idx (vector-length mode-table))
+ (not (vector-ref (vector-ref mode-table type-idx) 2)))
+ (if (>= type-idx (vector-length mode-table))
+ (vector-ref (vector-ref mode-table 0) 1)
+ (- (vector-ref (vector-ref mode-table type-idx) 1)))))))
+ (else (slib:error 'tz:std-offset "unknown timezone type" tz))))
+
+;;; Interpret the TZ envariable.
+(define (tzset . opt-tz)
+ (define tz (if (null? opt-tz)
+ (getenv "TZ")
+ (car opt-tz)))
+ (if (or (not tz:default)
+ (and (string? tz) (not (string-ci=? tz (vector-ref tz:default 1)))))
+ (set! tz:default (or (time-zone tz) '#(tz:fixed "UTC" "GMT" 0))))
+ (case (vector-ref tz:default 0)
+ ((tz:fixed)
+ (set! tzname (vector (vector-ref tz:default 2) "???"))
+ (set! daylight? #f)
+ (set! *timezone* (vector-ref tz:default 3)))
+ ((tz:rule)
+ (set! tzname (vector (vector-ref tz:default 2)
+ (vector-ref tz:default 3)))
+ (set! daylight? #t)
+ (set! *timezone* (vector-ref tz:default 4)))
+ ((tz:file)
+ (let ((mode-table (vector-ref tz:default 2))
+ (transition-types (vector-ref tz:default 5)))
+ (set! daylight? #f)
+ (set! *timezone* (vector-ref (vector-ref mode-table 0) 1))
+ (set! tzname (make-vector 2 #f))
+ (do ((type-idx 0 (+ 1 type-idx)))
+ ((>= type-idx (vector-length mode-table)))
+ (let ((rec (vector-ref mode-table type-idx)))
+ (if (vector-ref rec 2)
+ (set! daylight? #t)
+ (set! *timezone* (- (vector-ref rec 1))))))
+
+ (do ((transition-idx (+ -1 (vector-length transition-types))
+ (+ -1 transition-idx)))
+ ((or (negative? transition-idx)
+ (and (vector-ref tzname 0) (vector-ref tzname 1))))
+ (let ((rec (vector-ref mode-table
+ (vector-ref transition-types transition-idx))))
+ (if (vector-ref rec 2)
+ (if (not (vector-ref tzname 1))
+ (vector-set! tzname 1 (vector-ref rec 0)))
+ (if (not (vector-ref tzname 0))
+ (vector-set! tzname 0 (vector-ref rec 0))))))))
+ (else (slib:error 'tzset "unknown timezone type" tz)))
+ tz:default)
diff --git a/trace.scm b/trace.scm
index d595277..2ffeaed 100644
--- a/trace.scm
+++ b/trace.scm
@@ -25,7 +25,10 @@
(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))
+ (apply apply) (display display) (qpn qpn)
+
+ (CALL (string->symbol "CALL"))
+ (RETN (string->symbol "RETN")))
(lambda (function . optname)
(set! debug:indent 0)
(let ((name (if (null? optname) function (car optname))))
@@ -36,12 +39,12 @@
function)
(else
(do ((i debug:indent (+ -1 i))) ((zero? i)) (display #\ ))
- (apply qpn "CALLED" name args)
+ (apply qpn CALL 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)
+ (qpn RETN name ans)
ans))))))))
;;; the reason I use a symbol for debug:untrace-object is so
diff --git a/tzfile.scm b/tzfile.scm
new file mode 100644
index 0000000..2f3c2d0
--- /dev/null
+++ b/tzfile.scm
@@ -0,0 +1,140 @@
+; "tzfile.scm", Read sysV style (binary) timezone file.
+; Copyright (c) 1997 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 'byte)
+
+(define tzfile:vicinity (make-vicinity "/usr/lib/zoneinfo/"))
+
+(define (tzfile:read-long port)
+ (let ((hibyte (read-byte port)))
+ (do ((idx 3 (+ -1 idx))
+ (val (if (> hibyte 127) (+ #x-100 hibyte) hibyte)
+ (+ (ash val 8) (read-byte port))))
+ ((zero? idx) val))))
+(define (tzfile:read-longs len port)
+ (define ra (make-vector len 0))
+ (do ((idx 0 (+ 1 idx)))
+ ((>= idx len) ra)
+ (vector-set! ra idx (tzfile:read-long port))))
+
+(define (tzfile:read-bool port)
+ (let ((c (read-char port)))
+ (if (eof-object? c) c (if (zero? (char->integer c)) #f #t))))
+
+(define (tzfile:read path)
+ (define null (integer->char 0))
+ (call-with-input-file path
+ (lambda (port)
+ (do ((idx 0 (+ 1 idx))) ;reserved.
+ ((>= idx 20))
+ (read-char port))
+ (let* ((ttisgmtcnt (tzfile:read-long port))
+ (ttisstdcnt (tzfile:read-long port))
+ (leapcnt (tzfile:read-long port))
+ (timecnt (tzfile:read-long port))
+ (typecnt (tzfile:read-long port))
+ (charcnt (tzfile:read-long port))
+ (transition-times (tzfile:read-longs timecnt port))
+ (transition-types
+ (do ((ra (make-vector timecnt 0))
+ (idx 0 (+ 1 idx)))
+ ((>= idx timecnt) ra)
+ (vector-set! ra idx (read-byte port))))
+ ;;(printf " typecnt = %d\n" typecnt)
+ (mode-table (do ((tt (make-vector typecnt #f))
+ (idx 0 (+ 1 idx)))
+ ((>= idx typecnt) tt)
+ (let* ((gmt-offset (tzfile:read-long port))
+ (isdst (tzfile:read-bool port))
+ (abbrev-index (read-byte port)))
+ (vector-set! tt idx
+ (vector abbrev-index gmt-offset
+ isdst #f #f)))))
+ ;;(printf " %d bytes of abbreviations:\n" charcnt)
+ (abbrevs (do ((ra (make-bytes charcnt 0))
+ (idx 0 (+ 1 idx)))
+ ((>= idx charcnt) ra)
+ (string-set! ra idx (read-char port))))
+ (leap-seconds (tzfile:read-longs (* 2 leapcnt) port)))
+ (cond ((not (or (eqv? 0 ttisstdcnt) (eqv? typecnt ttisstdcnt)))
+ (slib:warn 'tzfile:read "format error" ttisstdcnt typecnt)))
+ (cond ((not (or (eqv? 0 ttisgmtcnt) (eqv? typecnt ttisgmtcnt)))
+ (slib:warn 'tzfile:read "format error" ttisgmtcnt typecnt)))
+ ;;(printf " reading %d transition attributes\n" ttisstdcnt)
+ (do ((idx 0 (+ 1 idx)))
+ ((>= idx ttisstdcnt))
+ (vector-set! (vector-ref mode-table idx) 3 (tzfile:read-bool port)))
+ ;;(printf " reading %d transition attributes\n" ttisgmtcnt)
+ (do ((idx 0 (+ 1 idx)))
+ ((>= idx ttisgmtcnt))
+ (vector-set! (vector-ref mode-table idx) 4 (tzfile:read-bool port)))
+ (cond ((not (eof-object? (peek-char port)))
+ (slib:warn 'tzfile:read "bytes left at end")))
+ (do ((idx 0 (+ 1 idx)))
+ ((>= idx ttisstdcnt))
+ (let ((rec (vector-ref mode-table idx)))
+ (vector-set!
+ rec 0 (let loop ((pos (vector-ref rec 0)))
+ (cond ((>= pos (string-length abbrevs))
+ (slib:warn 'tzfile:read "format error" abbrevs) #f)
+ ((char=? null (string-ref abbrevs pos))
+ (substring abbrevs (vector-ref rec 0) pos))
+ (else (loop (+ 1 pos))))))))
+ (list path mode-table leap-seconds transition-times transition-types)
+ ))))
+
+(define (tzfile:transition-index time zone)
+ (and zone
+ (apply
+ (lambda (path mode-table leap-seconds transition-times transition-types)
+ (let ((ntrns (vector-length transition-times)))
+ (if (zero? ntrns) -1
+ (let loop ((lidx (ash (+ 1 ntrns) -1))
+ (jmp (ash (+ 1 ntrns) -2)))
+ (let* ((idx (max 0 (min lidx (+ -1 ntrns))))
+ (idx-time (vector-ref transition-times idx)))
+ (cond ((<= jmp 0)
+ (+ idx (if (>= time idx-time) 0 -1)))
+ ((= time idx-time) idx)
+ ((and (zero? idx) (< time idx-time)) -1)
+ ((and (not (= idx lidx)) (not (< time idx-time))) idx)
+ (else
+ (loop ((if (< time idx-time) - +) idx jmp)
+ (if (= 1 jmp) 0 (ash (+ 1 jmp) -1))))))))))
+ (cdr (vector->list zone)))))
+
+(define (tzfile:get-std-spec mode-table)
+ (do ((type-idx 0 (+ 1 type-idx)))
+ ((or (>= type-idx (vector-length mode-table))
+ (not (vector-ref (vector-ref mode-table type-idx) 2)))
+ (if (>= type-idx (vector-length mode-table))
+ (vector-ref mode-table 0)
+ (vector-ref mode-table type-idx)))))
+
+(define (tzfile:get-zone-spec time zone)
+ (apply
+ (lambda (path mode-table leap-seconds transition-times transition-types)
+ (let* ((trans-idx (tzfile:transition-index time zone)))
+ (if (zero? (vector-length transition-types))
+ (vector-ref mode-table 0)
+ (if (negative? trans-idx)
+ (tzfile:get-std-spec mode-table)
+ (vector-ref mode-table
+ (vector-ref transition-types trans-idx))))))
+ (cdr (vector->list zone))))
diff --git a/vscm.init b/vscm.init
index 7d4661b..6868213 100644
--- a/vscm.init
+++ b/vscm.init
@@ -1,5 +1,5 @@
;;;"vscm.init" Configuration of *features* for VSCM -*-scheme-*-
-;Copyright (C) 1994 Aubrey Jaffer
+;Copyright (C) 1994, 1996, 1997 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
@@ -21,8 +21,6 @@
;;; 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
@@ -89,6 +87,14 @@
(else "")))))
(lambda () library-path)))
+;;; (home-vicinity) should return the vicinity of the user's HOME
+;;; directory, the directory which typically contains files which
+;;; customize a computer environment for a user.
+
+(define home-vicinity
+ (let ((home-path (getenv "HOME")))
+ (lambda () home-path)))
+
;;; *FEATURES* should be set to a list of symbols describing features
;;; of this implementation. Suggestions for features are:
@@ -120,7 +126,7 @@
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
+ string-port ;has CALL-WITH-INPUT-STRING and
;CALL-WITH-OUTPUT-STRING
; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF
; char-ready?
@@ -184,6 +190,75 @@
;;; 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 ((outsp (open-output-string)))
+ (proc outsp)
+ (close-output-port outsp)))
+
+(define (call-with-input-string string proc)
+ (let* ((insp (open-input-string string))
+ (res (proc insp)))
+ (close-input-port insp)
+ res))
+
+;;; Implementation of string ports using generic ports
+(define (open-input-string s)
+
+ (let ((l (string-length s))
+ (eof (call-with-values (lambda () (string-read "")) (lambda (x y) x))))
+
+ (define (read)
+ (call-with-values
+ (lambda ()
+ (string-read s))
+ (lambda (obj res)
+ (set! s res)
+ (set! l (string-length res))
+ obj)))
+
+ (define (read-char)
+ (if (zero? l)
+ eof
+ (let ((c (string-ref s 0)))
+ (set! s (substring s 1 l))
+ (set! l (- l 1))
+ c)))
+
+ (define (peek-char)
+ (if (zero? l) eof (string-ref s 0)))
+
+ (define (char-ready?) #t)
+
+ (define (close) s)
+
+ (open-input-generic read read-char peek-char char-ready? close)))
+
+(define (open-output-string)
+
+ (let ((s ""))
+
+ (define (write x)
+ (set! s (string-append s (string-write x)))
+ x)
+
+ (define (display x)
+ (set! s (string-append s (string-display x)))
+ x)
+
+ (define (write-char x)
+ (set! s (string-append s (string x)))
+ x)
+
+ (define (newline)
+ (set! s (string-append s "\n"))
+ #f)
+
+ (define (flush) #f)
+
+ (define (close) s)
+
+ (open-output-generic write display write-char newline flush close)))
+
;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
;;; be returned by CHAR->INTEGER.
(define char-code-limit 256)
@@ -251,6 +326,12 @@
(evl o))
(set! *load-pathname* old-load-pathname)))))
+(define slib:warn
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Warn: " port)
+ (for-each (lambda (x) (display x port)) args))))
+
;;; define an error procedure for the library
(define slib:error error)
diff --git a/wttree.scm b/wttree.scm
index 467aa86..7cfa85e 100644
--- a/wttree.scm
+++ b/wttree.scm
@@ -56,14 +56,6 @@
;;
;; 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.
;;
@@ -71,6 +63,20 @@
;;
;;(declare (usual-integrations))
+(define error
+ (case (scheme-implementation-type)
+ ((MITScheme) error)
+ (else slib:error)))
+(define error:wrong-type-argument
+ (case (scheme-implementation-type)
+ ((MITScheme) error:wrong-type-argument)
+ (else (lambda (arg1 arg2 arg3)
+ (slib:error 'wrong-type-argument arg1 arg2 arg3)))))
+(define error:bad-range-argument
+ (case (scheme-implementation-type)
+ ((MITScheme) error:bad-range-argument)
+ (else (lambda (arg1 arg2)
+ (slib:error 'bad-range-argument arg1 arg2)))))
;;;
;;; Interface to this package.
@@ -127,7 +133,7 @@
(define fix:+ +)
(define fix:- -)
(define fix:< <)
- (define fix:<= <)
+ (define fix:<= <=)
(define fix:> >)
(define fix:* *)
diff --git a/yasos.scm b/yasos.scm
new file mode 100644
index 0000000..cceea92
--- /dev/null
+++ b/yasos.scm
@@ -0,0 +1,299 @@
+; "YASOS.scm" Yet Another Scheme Object System
+; COPYRIGHT (c) Kenneth Dickey 1992
+;
+; This software may be used for any purpose whatever
+; without warrantee of any kind.
+; DATE 1992 March 1
+; LAST UPDATED 1992 September 1 -- misc optimizations
+; 1992 May 22 -- added SET and SETTER
+
+;; REQUIRES R^4RS Syntax System
+
+;; NOTES: 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].
+;
+;; Setters use space for speed {extra conses for O(1) lookup}.
+
+
+;;
+;; INTERFACE:
+;;
+;; (DEFINE-OPERATION (opname self arg ...) default-body)
+;;
+;; (DEFINE-PREDICATE opname)
+;;
+;; (OBJECT ((name self arg ...) body) ... )
+;;
+;; (OBJECT-WITH-ANCESTORS ( (ancestor1 init1) ...) operation ...)
+;;
+;; in an operation {a.k.a. send-to-super}
+;; (OPERATE-AS component operation self arg ...)
+;;
+
+;; (SET var new-vale) or (SET (access-proc index ...) new-value)
+;;
+;; (SETTER access-proc) -> setter-proc
+;; (DEFINE-ACCESS-OPERATION getter-name) -> operation
+;; (ADD-SETTER getter setter) ;; setter is a Scheme proc
+;; (REMOVE-SETTER-FOR getter)
+;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; IMPLEMENTATION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; INSTANCES
+
+; (define-predicate instance?)
+; (define (make-instance dispatcher)
+; (object
+; ((instance? self) #t)
+; ((instance-dispatcher self) dispatcher)
+; ) )
+
+(define yasos:make-instance 'bogus) ;; defined below
+(define yasos:instance? 'bogus)
+(define-syntax yasos:instance-dispatcher ;; alias so compiler can inline for speed
+ (syntax-rules () ((yasos:instance-dispatcher inst) (cdr inst)))
+)
+
+(let ( (instance-tag "instance") ) ;; Make a unique tag within a local scope.
+ ;; No other data object is EQ? to this tag.
+ (set! yasos:make-instance
+ (lambda (dispatcher) (cons instance-tag dispatcher)))
+
+ (set! yasos:instance?
+ (lambda (obj) (and (pair? obj) (eq? (car obj) instance-tag))))
+)
+
+;; DEFINE-OPERATION
+
+
+(define-syntax define-operation
+ (syntax-rules ()
+ ((define-operation (<name> <inst> <arg> ...) <exp1> <exp2> ...)
+ ;;=>
+ (define <name>
+ (letrec ( (former-inst #f) ;; simple caching -- for loops
+ (former-method #f)
+ (self
+ (lambda (<inst> <arg> ...)
+ (cond
+ ((eq? <inst> former-inst) ; check cache
+ (former-method <inst> <arg> ...)
+ )
+ ((and (yasos:instance? <inst>)
+ ((yasos:instance-dispatcher <inst>) self))
+ => (lambda (method)
+ (set! former-inst <inst>)
+ (set! former-method method)
+ (method <inst> <arg> ...))
+ )
+ (else <exp1> <exp2> ...)
+ ) ) ) )
+ self)
+ ))
+ ((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-operation (<name> obj) #f)
+ )
+) )
+
+
+;; OBJECT
+
+(define-syntax object
+ (syntax-rules ()
+ ((object ((<name> <self> <arg> ...) <exp1> <exp2> ...) ...)
+ ;;=>
+ (let ( (table
+ (list (cons <name>
+ (lambda (<self> <arg> ...) <exp1> <exp2> ...))
+ ...
+ ) )
+ )
+ (yasos:make-instance
+ (lambda (op)
+ (cond
+ ((assq op table) => cdr)
+ (else #f)
+) ) )))) )
+
+
+;; OBJECT with MULTIPLE INHERITANCE {First Found Rule}
+
+(define-syntax object-with-ancestors
+ (syntax-rules ()
+ ((object-with-ancestors ( (<ancestor1> <init1>) ... ) <operation> ...)
+ ;;=>
+ (let ( (<ancestor1> <init1>) ... )
+ (let ( (child (object <operation> ...)) )
+ (yasos:make-instance
+ (lambda (op)
+ (or ((yasos:instance-dispatcher child) op)
+ ((yasos:instance-dispatcher <ancestor1>) op) ...
+ ) ) )
+ )))
+) )
+
+
+;; OPERATE-AS {a.k.a. send-to-super}
+
+; used in operations/methods
+
+(define-syntax operate-as
+ (syntax-rules ()
+ ((operate-as <component> <op> <composit> <arg> ...)
+ ;;=>
+ (((yasos:instance-dispatcher <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)
+ ((yasos:instance-dispatcher inst) setter-dispatch))
+ => (lambda (method) (apply method inst args))
+ )
+ (else #f)))
+ )
+ (self
+ (lambda (inst . args)
+ (cond
+ ((eq? inst yasos:setter) setter-dispatch) ; for (setter self)
+ ((and (yasos:instance? inst)
+ ((yasos:instance-dispatcher inst) self))
+ => (lambda (method) (apply method 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.
+;; --- E O F "yasos.scm" --- ;;
diff --git a/yasyn.scm b/yasyn.scm
deleted file mode 100644
index 12228f4..0000000
--- a/yasyn.scm
+++ /dev/null
@@ -1,201 +0,0 @@
-;;"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)