diff options
| author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:26 -0800 |
|---|---|---|
| committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:26 -0800 |
| commit | f24b9140d6f74804d5599ec225717d38ca443813 (patch) | |
| tree | 0da952f1a5a7c0eacfc05c296766523e32c05fe2 | |
| parent | 8ffbc2df0fde83082610149d24e594c1cd879f4a (diff) | |
| download | slib-f24b9140d6f74804d5599ec225717d38ca443813.tar.gz slib-f24b9140d6f74804d5599ec225717d38ca443813.zip | |
Import Upstream version 2c0upstream/2c0
| -rw-r--r-- | ANNOUNCE | 91 | ||||
| -rw-r--r-- | ChangeLog | 314 | ||||
| -rw-r--r-- | FAQ | 45 | ||||
| -rw-r--r-- | Makefile | 138 | ||||
| -rw-r--r-- | README | 33 | ||||
| -rw-r--r-- | Template.scm | 18 | ||||
| -rw-r--r-- | alistab.scm | 317 | ||||
| -rw-r--r-- | array.scm | 2 | ||||
| -rw-r--r-- | arraymap.scm | 14 | ||||
| -rw-r--r-- | batch.scm | 67 | ||||
| -rw-r--r-- | byte.scm | 14 | ||||
| -rw-r--r-- | chez.init | 453 | ||||
| -rw-r--r-- | cltime.scm | 37 | ||||
| -rw-r--r-- | comlist.scm | 30 | ||||
| -rw-r--r-- | comparse.scm | 89 | ||||
| -rw-r--r-- | cring.scm | 480 | ||||
| -rw-r--r-- | dbutil.scm | 9 | ||||
| -rw-r--r-- | determ.scm | 14 | ||||
| -rw-r--r-- | elk.init | 36 | ||||
| -rw-r--r-- | factor.scm | 8 | ||||
| -rw-r--r-- | formatst.scm | 2 | ||||
| -rw-r--r-- | gambit.init | 174 | ||||
| -rw-r--r-- | macscheme.init | 14 | ||||
| -rw-r--r-- | makcrc.scm | 7 | ||||
| -rw-r--r-- | mbe.scm | 402 | ||||
| -rw-r--r-- | mitscheme.init | 21 | ||||
| -rw-r--r-- | mklibcat.scm | 175 | ||||
| -rw-r--r-- | mularg.scm | 2 | ||||
| -rw-r--r-- | object.scm | 97 | ||||
| -rw-r--r-- | paramlst.scm | 74 | ||||
| -rw-r--r-- | prec.scm | 438 | ||||
| -rw-r--r-- | primes.scm | 36 | ||||
| -rw-r--r-- | printf.scm | 25 | ||||
| -rw-r--r-- | priorque.scm | 13 | ||||
| -rw-r--r-- | psxtime.scm (renamed from time.scm) | 87 | ||||
| -rw-r--r-- | rdms.scm | 69 | ||||
| -rw-r--r-- | recobj.scm | 54 | ||||
| -rw-r--r-- | record.scm | 27 | ||||
| -rw-r--r-- | require.scm | 235 | ||||
| -rw-r--r-- | root.scm | 12 | ||||
| -rw-r--r-- | scainit.scm | 3 | ||||
| -rw-r--r-- | scanf.scm | 23 | ||||
| -rw-r--r-- | scheme2c.init | 16 | ||||
| -rw-r--r-- | scheme48.init | 83 | ||||
| -rw-r--r-- | scm.init | 6 | ||||
| -rw-r--r-- | scsh.init | 267 | ||||
| -rw-r--r-- | selfset.scm | 28 | ||||
| -rw-r--r-- | slib.info | 153 | ||||
| -rw-r--r-- | slib.info-1 | 1306 | ||||
| -rw-r--r-- | slib.info-2 | 1193 | ||||
| -rw-r--r-- | slib.info-3 | 859 | ||||
| -rw-r--r-- | slib.info-4 | 1248 | ||||
| -rw-r--r-- | slib.info-5 | 1536 | ||||
| -rw-r--r-- | slib.info-6 | 1410 | ||||
| -rw-r--r-- | slib.info-7 | 615 | ||||
| -rw-r--r-- | slib.info-8 | 570 | ||||
| -rw-r--r-- | slib.texi | 11737 | ||||
| -rw-r--r-- | stdio.scm | 1 | ||||
| -rw-r--r-- | strport.scm | 2 | ||||
| -rw-r--r-- | strsrch.scm | 46 | ||||
| -rw-r--r-- | t3.init | 14 | ||||
| -rw-r--r-- | timezone.scm | 257 | ||||
| -rw-r--r-- | trace.scm | 9 | ||||
| -rw-r--r-- | tzfile.scm | 140 | ||||
| -rw-r--r-- | vscm.init | 89 | ||||
| -rw-r--r-- | wttree.scm | 24 | ||||
| -rw-r--r-- | yasos.scm | 299 | ||||
| -rw-r--r-- | yasyn.scm | 201 |
68 files changed, 10924 insertions, 15384 deletions
@@ -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. @@ -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) @@ -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) @@ -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 @@ -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) @@ -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)) @@ -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))) @@ -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 @@ -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)) @@ -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/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)))) @@ -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) @@ -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 @@ -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) @@ -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) @@ -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) @@ -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>) @@ -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)))) @@ -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) @@ -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 @@ -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))) @@ -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" @@ -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. - - @@ -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 + +@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 -@node Manual Conventions, , Copyrights, Overview -@section Manual Conventions -Things that are labeled as Functions are called for their return values. -Things that are labeled as Procedures are called primarily for their -side effects. -All examples throughout this text were produced using the @code{scm} -Scheme implementation. -At the beginning of each section, there is a line that looks something -like +@node Vicinity, Configuration, Require, Built-in Support +@subsection Vicinity -@code{(require 'feature)}. +@noindent +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 -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 +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 +@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 -@node Data Structures, Macros, Overview, Top -@chapter Data Structures +@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 +@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 -@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 +@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 +@node Configuration, Input/Output, Vicinity, Built-in Support +@subsection Configuration -@code{(require 'array)} +@noindent +These constants and procedures describe characteristics of the Scheme +and underlying operating system. They are provided by all +implementations. -@defun array? obj -Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not. -@end defun +@defvr Constant char-code-limit +An integer 1 larger that the largest value which can be returned by +@code{char->integer}.@refill +@end defvr -@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 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 Command Line, Parameter lists, Getopt, Program Arguments +@subsection Command Line -@node Parameter lists, Priority Queues, Object, Data Structures -@section Parameter lists +@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 + +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 -@node Base Table, Relational Database, Records, Data Structures +@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 +@node Association Lists, Byte, Array Mapping, Data Structures +@subsection Association Lists -Additionally, the following procedures are added: -@lisp -make-syntactic-closure -capture-syntactic-environment -identifier? -identifier=? -@end lisp - -The description of the facility is divided into three parts. The first -part defines basic terminology. The second part describes how macro -transformers are defined. The third part describes the use of -@dfn{identifiers}, which extend the syntactic closure mechanism to be -compatible with @code{syntax-rules}.@refill - -@subsubsection Terminology - -This section defines the concepts and data types used by the syntactic -closures facility. - -@itemize - -@item @dfn{Forms} are the syntactic entities out of which programs are -recursively constructed. A form is any expression, any definition, any -syntactic keyword, or any syntactic closure. The variable name that -appears in a @code{set!} special form is also a form. Examples of -forms:@refill -@lisp -17 -#t -car -(+ x 4) -(lambda (x) x) -(define pi 3.14159) -if -define -@end lisp - -@item An @dfn{alias} is an alternate name for a given symbol. It can -appear anywhere in a form that the symbol could be used, and when quoted -it is replaced by the symbol; however, it does not satisfy the predicate -@code{symbol?}. Macro transformers rarely distinguish symbols from -aliases, referring to both as identifiers.@refill - -@item A @dfn{syntactic} environment maps identifiers to their -meanings. More precisely, it determines whether an identifier is a -syntactic keyword or a variable. If it is a keyword, the meaning is an -interpretation for the form in which that keyword appears. If it is a -variable, the meaning identifies which binding of that variable is -referenced. In short, syntactic environments contain all of the -contextual information necessary for interpreting the meaning of a -particular form.@refill - -@item A @dfn{syntactic closure} consists of a form, a syntactic -environment, and a list of identifiers. All identifiers in the form -take their meaning from the syntactic environment, except those in the -given list. The identifiers in the list are to have their meanings -determined later. A syntactic closure may be used in any context in -which its form could have been used. Since a syntactic closure is also -a form, it may not be used in contexts where a form would be illegal. -For example, a form may not appear as a clause in the cond special form. -A syntactic closure appearing in a quoted structure is replaced by its -form.@refill - -@end itemize - -@subsubsection Transformer Definition - -This section describes the @code{transformer} special form and the -procedures @code{make-syntactic-closure} and -@code{capture-syntactic-environment}.@refill - -@deffn Syntax transformer expression - -Syntax: It is an error if this syntax occurs except as a -@var{transformer spec}.@refill - -Semantics: The @var{expression} is evaluated in the standard transformer -environment to yield a macro transformer as described below. This macro -transformer is bound to a macro keyword by the special form in which the -@code{transformer} expression appears (for example, -@code{let-syntax}).@refill - -A @dfn{macro transformer} is a procedure that takes two arguments, a -form and a syntactic environment, and returns a new form. The first -argument, the @dfn{input form}, is the form in which the macro keyword -occurred. The second argument, the @dfn{usage environment}, is the -syntactic environment in which the input form occurred. The result of -the transformer, the @dfn{output form}, is automatically closed in the -@dfn{transformer environment}, which is the syntactic environment in -which the @code{transformer} expression occurred.@refill - -For example, here is a definition of a push macro using -@code{syntax-rules}:@refill -@lisp -(define-syntax push - (syntax-rules () - ((push item list) - (set! list (cons item list))))) -@end lisp - -Here is an equivalent definition using @code{transformer}: -@lisp -(define-syntax push - (transformer - (lambda (exp env) - (let ((item - (make-syntactic-closure env '() (cadr exp))) - (list - (make-syntactic-closure env '() (caddr exp)))) - `(set! ,list (cons ,item ,list)))))) -@end lisp - -In this example, the identifiers @code{set!} and @code{cons} are closed -in the transformer environment, and thus will not be affected by the -meanings of those identifiers in the usage environment -@code{env}.@refill - -Some macros may be non-hygienic by design. For example, the following -defines a loop macro that implicitly binds @code{exit} to an escape -procedure. The binding of @code{exit} is intended to capture free -references to @code{exit} in the body of the loop, so @code{exit} must -be left free when the body is closed:@refill -@lisp -(define-syntax loop - (transformer - (lambda (exp env) - (let ((body (cdr exp))) - `(call-with-current-continuation - (lambda (exit) - (let f () - ,@@(map (lambda (exp) - (make-syntactic-closure env '(exit) - exp)) - body) - (f)))))))) -@end lisp - -To assign meanings to the identifiers in a form, use -@code{make-syntactic-closure} to close the form in a syntactic -environment.@refill -@end deffn - -@defun make-syntactic-closure environment free-names form - -@var{environment} must be a syntactic environment, @var{free-names} must -be a list of identifiers, and @var{form} must be a form. -@code{make-syntactic-closure} constructs and returns a syntactic closure -of @var{form} in @var{environment}, which can be used anywhere that -@var{form} could have been used. All the identifiers used in -@var{form}, except those explicitly excepted by @var{free-names}, obtain -their meanings from @var{environment}.@refill +@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. +@node Tree Operations, Chapter Ordering, Common List Functions, Procedures +@subsection Tree operations -@table @asis -@item @code{~A} -Any (print as @code{display} does). -@table @asis -@item @code{~@@A} -left pad. -@item @code{~@var{mincol},@var{colinc},@var{minpad},@var{padchar}A} -full padding. -@end table -@item @code{~S} -S-expression (print as @code{write} does). -@table @asis -@item @code{~@@S} -left pad. -@item @code{~@var{mincol},@var{colinc},@var{minpad},@var{padchar}S} -full padding. -@end table -@item @code{~D} -Decimal. -@table @asis -@item @code{~@@D} -print number sign always. -@item @code{~:D} -print comma separated. -@item @code{~@var{mincol},@var{padchar},@var{commachar}D} -padding. -@end table -@item @code{~X} -Hexadecimal. -@table @asis -@item @code{~@@X} -print number sign always. -@item @code{~:X} -print comma separated. -@item @code{~@var{mincol},@var{padchar},@var{commachar}X} -padding. -@end table -@item @code{~O} -Octal. -@table @asis -@item @code{~@@O} -print number sign always. -@item @code{~:O} -print comma separated. -@item @code{~@var{mincol},@var{padchar},@var{commachar}O} -padding. -@end table -@item @code{~B} -Binary. -@table @asis -@item @code{~@@B} -print number sign always. -@item @code{~:B} -print comma separated. -@item @code{~@var{mincol},@var{padchar},@var{commachar}B} -padding. -@end table -@item @code{~@var{n}R} -Radix @var{n}. -@table @asis -@item @code{~@var{n},@var{mincol},@var{padchar},@var{commachar}R} -padding. -@end table -@item @code{~@@R} -print a number as a Roman numeral. -@item @code{~:R} -print a number as an ordinal English number. -@item @code{~:@@R} -print a number as a cardinal English number. -@item @code{~P} -Plural. -@table @asis -@item @code{~@@P} -prints @code{y} and @code{ies}. -@item @code{~:P} -as @code{~P but jumps 1 argument backward.} -@item @code{~:@@P} -as @code{~@@P but jumps 1 argument backward.} -@end table -@item @code{~C} -Character. -@table @asis -@item @code{~@@C} -prints a character as the reader can understand it (i.e. @code{#\} prefixing). -@item @code{~:C} -prints a character as emacs does (eg. @code{^C} for ASCII 03). -@end table -@item @code{~F} -Fixed-format floating-point (prints a flonum like @var{mmm.nnn}). -@table @asis -@item @code{~@var{width},@var{digits},@var{scale},@var{overflowchar},@var{padchar}F} -@item @code{~@@F} -If the number is positive a plus sign is printed. -@end table -@item @code{~E} -Exponential floating-point (prints a flonum like @var{mmm.nnn@code{E}ee}). -@table @asis -@item @code{~@var{width},@var{digits},@var{exponentdigits},@var{scale},@var{overflowchar},@var{padchar},@var{exponentchar}E} -@item @code{~@@E} -If the number is positive a plus sign is printed. -@end table -@item @code{~G} -General floating-point (prints a flonum either fixed or exponential). -@table @asis -@item @code{~@var{width},@var{digits},@var{exponentdigits},@var{scale},@var{overflowchar},@var{padchar},@var{exponentchar}G} -@item @code{~@@G} -If the number is positive a plus sign is printed. -@end table -@item @code{~$} -Dollars floating-point (prints a flonum in fixed with signs separated). -@table @asis -@item @code{~@var{digits},@var{scale},@var{width},@var{padchar}$} -@item @code{~@@$} -If the number is positive a plus sign is printed. -@item @code{~:@@$} -A sign is always printed and appears before the padding. -@item @code{~:$} -The sign appears before the padding. -@end table -@item @code{~%} -Newline. -@table @asis -@item @code{~@var{n}%} -print @var{n} newlines. -@end table -@item @code{~&} -print newline if not at the beginning of the output line. -@table @asis -@item @code{~@var{n}&} -prints @code{~&} and then @var{n-1} newlines. -@end table -@item @code{~|} -Page Separator. -@table @asis -@item @code{~@var{n}|} -print @var{n} page separators. -@end table -@item @code{~~} -Tilde. -@table @asis -@item @code{~@var{n}~} -print @var{n} tildes. -@end table -@item @code{~}<newline> -Continuation Line. -@table @asis -@item @code{~:}<newline> -newline is ignored, white space left. -@item @code{~@@}<newline> -newline is left, white space ignored. -@end table -@item @code{~T} -Tabulation. -@table @asis -@item @code{~@@T} -relative tabulation. -@item @code{~@var{colnum,colinc}T} -full tabulation. -@end table -@item @code{~?} -Indirection (expects indirect arguments as a list). -@table @asis -@item @code{~@@?} -extracts indirect arguments from format arguments. -@end table -@item @code{~(@var{str}~)} -Case conversion (converts by @code{string-downcase}). -@table @asis -@item @code{~:(@var{str}~)} -converts by @code{string-capitalize}. -@item @code{~@@(@var{str}~)} -converts by @code{string-capitalize-first}. -@item @code{~:@@(@var{str}~)} -converts by @code{string-upcase}. -@end table -@item @code{~*} -Argument Jumping (jumps 1 argument forward). -@table @asis -@item @code{~@var{n}*} -jumps @var{n} arguments forward. -@item @code{~:*} -jumps 1 argument backward. -@item @code{~@var{n}:*} -jumps @var{n} arguments backward. -@item @code{~@@*} -jumps to the 0th argument. -@item @code{~@var{n}@@*} -jumps to the @var{n}th argument (beginning from 0) -@end table -@item @code{~[@var{str0}~;@var{str1}~;...~;@var{strn}~]} -Conditional Expression (numerical clause conditional). -@table @asis -@item @code{~@var{n}[} -take argument from @var{n}. -@item @code{~@@[} -true test conditional. -@item @code{~:[} -if-else-then conditional. -@item @code{~;} -clause separator. -@item @code{~:;} -default clause follows. -@end table -@item @code{~@{@var{str}~@}} -Iteration (args come from the next argument (a list)). -@table @asis -@item @code{~@var{n}@{} -at most @var{n} iterations. -@item @code{~:@{} -args from next arg (a list of lists). -@item @code{~@@@{} -args from the rest of arguments. -@item @code{~:@@@{} -args from the rest args (lists). -@end table -@item @code{~^} -Up and out. -@table @asis -@item @code{~@var{n}^} -aborts if @var{n} = 0 -@item @code{~@var{n},@var{m}^} -aborts if @var{n} = @var{m} -@item @code{~@var{n},@var{m},@var{k}^} -aborts if @var{n} <= @var{m} <= @var{k} -@end table -@end table - - -@subsubsection Not Implemented CL Format Control Directives - -@table @asis -@item @code{~:A} -print @code{#f} as an empty list (see below). -@item @code{~:S} -print @code{#f} as an empty list (see below). -@item @code{~<~>} -Justification. -@item @code{~:^} -(sorry I don't understand its semantics completely) -@end table - - -@subsubsection Extended, Replaced and Additional Control Directives - -@table @asis -@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}D} -@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}X} -@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}O} -@item @code{~@var{mincol},@var{padchar},@var{commachar},@var{commawidth}B} -@item @code{~@var{n},@var{mincol},@var{padchar},@var{commachar},@var{commawidth}R} -@var{commawidth} is the number of characters between two comma characters. -@end table - -@table @asis -@item @code{~I} -print a R4RS complex number as @code{~F~@@Fi} with passed parameters for -@code{~F}. -@item @code{~Y} -Pretty print formatting of an argument for scheme code lists. -@item @code{~K} -Same as @code{~?.} -@item @code{~!} -Flushes the output if format @var{destination} is a port. -@item @code{~_} -Print a @code{#\space} character -@table @asis -@item @code{~@var{n}_} -print @var{n} @code{#\space} characters. -@end table -@item @code{~/} -Print a @code{#\tab} character -@table @asis -@item @code{~@var{n}/} -print @var{n} @code{#\tab} characters. -@end table -@item @code{~@var{n}C} -Takes @var{n} as an integer representation for a character. No arguments -are consumed. @var{n} is converted to a character by -@code{integer->char}. @var{n} must be a positive decimal number.@refill -@item @code{~:S} -Print out readproof. Prints out internal objects represented as -@code{#<...>} as strings @code{"#<...>"} so that the format output can always -be processed by @code{read}. -@refill -@item @code{~:A} -Print out readproof. Prints out internal objects represented as -@code{#<...>} as strings @code{"#<...>"} so that the format output can always -be processed by @code{read}. -@item @code{~Q} -Prints information and a copyright notice on the format implementation. -@table @asis -@item @code{~:Q} -prints format version. -@end table -@refill -@item @code{~F, ~E, ~G, ~$} -may also print number strings, i.e. passing a number as a string and -format it accordingly. -@end table - -@subsubsection Configuration Variables - -Format has some configuration variables at the beginning of -@file{format.scm} to suit the systems and users needs. There should be -no modification necessary for the configuration that comes with SLIB. -If modification is desired the variable should be set after the format -code is loaded. Format detects automatically if the running scheme -system implements floating point numbers and complex numbers. - -@table @asis - -@item @var{format:symbol-case-conv} -Symbols are converted by @code{symbol->string} so the case type of the -printed symbols is implementation dependent. -@code{format:symbol-case-conv} is a one arg closure which is either -@code{#f} (no conversion), @code{string-upcase}, @code{string-downcase} -or @code{string-capitalize}. (default @code{#f}) - -@item @var{format:iobj-case-conv} -As @var{format:symbol-case-conv} but applies for the representation of -implementation internal objects. (default @code{#f}) - -@item @var{format:expch} -The character prefixing the exponent value in @code{~E} printing. (default -@code{#\E}) - -@end table - -@subsubsection Compatibility With Other Format Implementations - -@table @asis -@item SLIB format 2.x: -See @file{format.doc}. - -@item SLIB format 1.4: -Downward compatible except for padding support and @code{~A}, @code{~S}, -@code{~P}, @code{~X} uppercase printing. SLIB format 1.4 uses C-style -@code{printf} padding support which is completely replaced by the CL -@code{format} padding style. - -@item MIT C-Scheme 7.1: -Downward compatible except for @code{~}, which is not documented -(ignores all characters inside the format string up to a newline -character). (7.1 implements @code{~a}, @code{~s}, -~@var{newline}, @code{~~}, @code{~%}, numerical and variable -parameters and @code{:/@@} modifiers in the CL sense).@refill - -@item Elk 1.5/2.0: -Downward compatible except for @code{~A} and @code{~S} which print in -uppercase. (Elk implements @code{~a}, @code{~s}, @code{~~}, and -@code{~%} (no directive parameters or modifiers)).@refill - -@item Scheme->C 01nov91: -Downward compatible except for an optional destination parameter: S2C -accepts a format call without a destination which returns a formatted -string. This is equivalent to a #f destination in S2C. (S2C implements -@code{~a}, @code{~s}, @code{~c}, @code{~%}, and @code{~~} (no directive -parameters or modifiers)).@refill - -@end table - -This implementation of format is solely useful in the SLIB context -because it requires other components provided by SLIB.@refill - - -@node Generic-Write, Line I/O, Format, Procedures -@section Generic-Write - -@code{(require 'generic-write)} +@code{(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 - - - - -@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 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 -@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 - - -@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 +@defunx chap:string>? string1 string2 +@defunx chap:string<=? string1 string2 +@defunx chap:string>=? string1 string2 +Implement the corresponding chapter-order predicates. +@end defun -@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. - -@subsection Tektronix 4000 Series Graphics +@node Line I/O, Multi-Processing, String Search, Procedures +@subsection Line I/O -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,464 @@ 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 - -These variables and procedures are provided by all implementations. +@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. -@defvar *features* -Is a list of symbols denoting features supported in this implementation. -@end defvar +@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 *modules* -Is a list of pathnames denoting files which have been loaded. -@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 *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 +@defun offset-time caltime offset +Returns the calendar time of @var{caltime} offset by @var{offset} number +of seconds @code{(+ caltime offset)}. +@end defun -In the following three functions if @var{feature} is not a symbol it is -assumed to be a pathname.@refill +@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 -@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 +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 -@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 +@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 +@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 -@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 -@item -'real +@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 -'complex +The number of seconds west of the Prime Meridian timezone @var{tz} is at +@var{caltime}. @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{README} 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. -@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 @@ -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 @@ -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) @@ -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)))) @@ -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) @@ -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) |