diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
commit | 5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch) | |
tree | 540afc30c51da085f5bd8ec3f4c89f6496e7900d | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-e9ef53a15959e8f1a51074a02da544f3af540c4a.tar.gz slib-e9ef53a15959e8f1a51074a02da544f3af540c4a.zip |
Import Upstream version 3a2upstream/3a2
-rw-r--r-- | ANNOUNCE | 99 | ||||
-rw-r--r-- | ChangeLog | 654 | ||||
-rw-r--r-- | DrScheme.init | 85 | ||||
-rw-r--r-- | FAQ | 22 | ||||
-rw-r--r-- | Makefile | 190 | ||||
-rw-r--r-- | README | 40 | ||||
-rw-r--r-- | RScheme.init | 163 | ||||
-rw-r--r-- | STk.init | 155 | ||||
-rw-r--r-- | Template.scm | 153 | ||||
-rw-r--r-- | alist.scm | 2 | ||||
-rw-r--r-- | alist.txi | 6 | ||||
-rw-r--r-- | array.scm | 528 | ||||
-rw-r--r-- | array.txi | 376 | ||||
-rw-r--r-- | arraymap.scm | 72 | ||||
-rw-r--r-- | arraymap.txi | 10 | ||||
-rw-r--r-- | batch.scm | 47 | ||||
-rw-r--r-- | bigloo.init | 294 | ||||
-rw-r--r-- | byte.scm | 6 | ||||
-rw-r--r-- | byte.txi | 16 | ||||
-rw-r--r-- | bytenumb.scm | 10 | ||||
-rw-r--r-- | bytenumb.txi | 12 | ||||
-rw-r--r-- | chap.scm | 1 | ||||
-rw-r--r-- | chap.txi | 3 | ||||
-rw-r--r-- | charplot.scm | 27 | ||||
-rw-r--r-- | chez.init | 143 | ||||
-rw-r--r-- | ciesia.dat | 110 | ||||
-rw-r--r-- | ciesid65.dat | 110 | ||||
-rw-r--r-- | clrnamdb.scm | 1745 | ||||
-rw-r--r-- | cltime.scm | 22 | ||||
-rw-r--r-- | coerce.scm | 6 | ||||
-rw-r--r-- | coerce.txi | 2 | ||||
-rw-r--r-- | color.scm | 36 | ||||
-rw-r--r-- | color.txi | 31 | ||||
-rw-r--r-- | colornam.txi | 6 | ||||
-rw-r--r-- | colorspc.scm | 43 | ||||
-rw-r--r-- | comlist.scm | 4 | ||||
-rw-r--r-- | comparse.txi | 2 | ||||
-rw-r--r-- | cring.scm | 3 | ||||
-rw-r--r-- | cvs.scm | 8 | ||||
-rw-r--r-- | cvs.txi | 14 | ||||
-rw-r--r-- | daylight.scm | 10 | ||||
-rw-r--r-- | daylight.txi | 15 | ||||
-rw-r--r-- | db2html.scm | 76 | ||||
-rw-r--r-- | db2html.txi | 20 | ||||
-rw-r--r-- | dbinterp.scm | 42 | ||||
-rw-r--r-- | dbsyn.scm | 68 | ||||
-rw-r--r-- | dbutil.scm | 26 | ||||
-rw-r--r-- | dbutil.txi | 14 | ||||
-rw-r--r-- | determ.scm | 32 | ||||
-rw-r--r-- | determ.txi | 8 | ||||
-rw-r--r-- | differ.scm | 331 | ||||
-rw-r--r-- | differ.txi | 60 | ||||
-rw-r--r-- | dirs.txi | 3 | ||||
-rw-r--r-- | elk.init | 160 | ||||
-rw-r--r-- | eval.scm | 2 | ||||
-rw-r--r-- | factor.txi | 5 | ||||
-rw-r--r-- | fft.scm | 6 | ||||
-rw-r--r-- | fft.txi | 2 | ||||
-rw-r--r-- | fluidlet.scm | 2 | ||||
-rw-r--r-- | format.scm | 1634 | ||||
-rw-r--r-- | format.texi | 451 | ||||
-rw-r--r-- | formatst.scm | 654 | ||||
-rw-r--r-- | gambit.init | 300 | ||||
-rw-r--r-- | getparam.scm | 1 | ||||
-rw-r--r-- | getparam.txi | 2 | ||||
-rw-r--r-- | glob.txi | 4 | ||||
-rw-r--r-- | grapheps.ps | 36 | ||||
-rw-r--r-- | grapheps.scm | 34 | ||||
-rw-r--r-- | grapheps.txi | 48 | ||||
-rw-r--r-- | guile.init | 392 | ||||
-rw-r--r-- | hash.scm | 46 | ||||
-rw-r--r-- | hashtab.scm | 2 | ||||
-rw-r--r-- | hashtab.txi | 9 | ||||
-rw-r--r-- | html4each.scm | 22 | ||||
-rw-r--r-- | html4each.txi | 3 | ||||
-rw-r--r-- | htmlform.scm | 8 | ||||
-rw-r--r-- | htmlform.txi | 24 | ||||
-rw-r--r-- | http-cgi.scm | 6 | ||||
-rw-r--r-- | http-cgi.txi | 13 | ||||
-rw-r--r-- | indexes.texi | 55 | ||||
-rw-r--r-- | jscheme.init | 478 | ||||
-rw-r--r-- | lineio.scm | 2 | ||||
-rw-r--r-- | lineio.txi | 4 | ||||
-rw-r--r-- | logical.scm | 185 | ||||
-rw-r--r-- | macscheme.init | 158 | ||||
-rw-r--r-- | manifest.scm | 102 | ||||
-rw-r--r-- | manifest.txi | 36 | ||||
-rw-r--r-- | matfile.scm | 27 | ||||
-rw-r--r-- | matfile.txi | 2 | ||||
-rw-r--r-- | minimize.txi | 1 | ||||
-rw-r--r-- | mitscheme.init | 150 | ||||
-rw-r--r-- | mkclrnam.scm | 22 | ||||
-rw-r--r-- | mkclrnam.txi | 13 | ||||
-rw-r--r-- | mklibcat.scm | 8 | ||||
-rw-r--r-- | modular.scm | 32 | ||||
-rw-r--r-- | modular.txi | 12 | ||||
-rw-r--r-- | nbs-iscc.txt | 295 | ||||
-rw-r--r-- | ncbi-dna.txi | 8 | ||||
-rw-r--r-- | obj2str.txi | 2 | ||||
-rw-r--r-- | peanosfc.scm | 109 | ||||
-rw-r--r-- | peanosfc.txi | 15 | ||||
-rw-r--r-- | phil-spc.scm | 242 | ||||
-rw-r--r-- | phil-spc.txi | 130 | ||||
-rw-r--r-- | pnm.scm | 88 | ||||
-rw-r--r-- | pnm.txi | 3 | ||||
-rw-r--r-- | ppfile.scm | 7 | ||||
-rw-r--r-- | printf.scm | 2 | ||||
-rw-r--r-- | priorque.txi | 4 | ||||
-rw-r--r-- | pscheme.init | 158 | ||||
-rw-r--r-- | psxtime.scm | 163 | ||||
-rw-r--r-- | qp.scm | 9 | ||||
-rw-r--r-- | queue.txi | 9 | ||||
-rw-r--r-- | randinex.txi | 6 | ||||
-rw-r--r-- | random.scm | 4 | ||||
-rw-r--r-- | random.txi | 4 | ||||
-rw-r--r-- | ratize.txi | 3 | ||||
-rw-r--r-- | rdms.scm | 24 | ||||
-rw-r--r-- | record.scm | 1 | ||||
-rw-r--r-- | repl.scm | 13 | ||||
-rw-r--r-- | require.scm | 97 | ||||
-rw-r--r-- | s48-0_57.init | 412 | ||||
-rw-r--r-- | saturate.txt | 1 | ||||
-rw-r--r-- | sc4opt.scm | 14 | ||||
-rw-r--r-- | scamacr.scm | 2 | ||||
-rw-r--r-- | scheme2c.init | 159 | ||||
-rw-r--r-- | scheme48.init | 316 | ||||
-rw-r--r-- | schmooz.scm | 1 | ||||
-rw-r--r-- | scsh.init | 192 | ||||
-rw-r--r-- | simetrix.scm | 2 | ||||
-rw-r--r-- | slib.1 | 45 | ||||
-rw-r--r-- | slib.doc | 47 | ||||
-rw-r--r-- | slib.info | 13110 | ||||
-rwxr-xr-x | slib.sh | 77 | ||||
-rw-r--r-- | slib.spec | 58 | ||||
-rw-r--r-- | slib.texi | 794 | ||||
-rw-r--r-- | solid.scm | 231 | ||||
-rw-r--r-- | solid.txi | 123 | ||||
-rw-r--r-- | sort.scm | 25 | ||||
-rw-r--r-- | soundex.scm | 56 | ||||
-rw-r--r-- | srfi-1.scm | 382 | ||||
-rw-r--r-- | srfi-1.txi | 262 | ||||
-rw-r--r-- | srfi-2.txi | 1 | ||||
-rw-r--r-- | srfi-8.txi | 1 | ||||
-rw-r--r-- | srfi.txi | 1 | ||||
-rw-r--r-- | strcase.scm | 2 | ||||
-rw-r--r-- | subarray.scm | 120 | ||||
-rw-r--r-- | subarray.txi | 42 | ||||
-rw-r--r-- | t3.init | 170 | ||||
-rw-r--r-- | timecore.scm | 202 | ||||
-rw-r--r-- | timezone.scm | 145 | ||||
-rw-r--r-- | top-refs.scm | 48 | ||||
-rw-r--r-- | top-refs.txi | 5 | ||||
-rw-r--r-- | trace.scm | 4 | ||||
-rw-r--r-- | transact.scm | 13 | ||||
-rw-r--r-- | transact.txi | 6 | ||||
-rw-r--r-- | tree.txi | 2 | ||||
-rw-r--r-- | tsort.txi | 1 | ||||
-rw-r--r-- | tzfile.scm | 49 | ||||
-rw-r--r-- | umbscheme.init | 196 | ||||
-rw-r--r-- | uri.scm | 16 | ||||
-rw-r--r-- | uri.txi | 18 | ||||
-rw-r--r-- | version.txi | 4 | ||||
-rw-r--r-- | vet.scm | 92 | ||||
-rw-r--r-- | vet.txi | 10 | ||||
-rw-r--r-- | vscm.init | 156 | ||||
-rw-r--r-- | wttree.scm | 31 |
166 files changed, 20288 insertions, 9866 deletions
@@ -1,54 +1,63 @@ -This message announces the availability of Scheme Library release slib3a1. +This message announces the availability of Scheme Library release slib3a2. -New in slib3a1: +It has been too long since the last release. Many bugs have been +fixed; and support for several implementations (especially Guile, +Scheme48) has been significantly improved. New in slib3a2: - SLIB 3 has undergone major development from SLIB2d6. + peanosfc.scm: Peano space filling curve. - Most noticeable is that SLIB now has a module system with documented - semantics and a suite of reflexive tools for deriving reference and - module dependencies from library code. The reflexive tools are - designed to support compiler-writer's needs as expressed in - discussions arising from comp.lang.scheme in July 2003. + logical.scm: (logand, logior, logxor): Take one or more arguments. + Refactored to match SRFI-60. - The module semantics are intended to be compatible both with - implementations having module systems and those lacking. Ivan - Shmakov has been striving to integrate SLIB's and Scheme48's module - systems. His efforts and SLIB's reflexive tools have found a great - many bugs, some of them present since SLIB's beginnings. + All uses of CREATE-ARRAY replaced by MAKE-ARRAY (SRFI-63). + All uses of ARRAY-SHAPE replaced with ARRAY-DIMENSIONS (SRFI-63). - "make install" now creates a "slib" shell script for running various - Schemes with SLIB initialization. Currently supported - implementations are gsi (Gambit), Guile, MzScheme, Scheme48, and - SCM. + * subarray.scm (subarray, array-trim): Rewrote for all arrays being + 0-based. - The byte-number module converts between byte-vectors, - twos-complement integers, and IEEE floating-point formats -- all in - R4RS-compliant Scheme code. It also converts byte-vectors to a form - whose lexicographic ordering matches the encoded number's ordering. + * arraymap.scm (array-map!, array-for-each, array-index-map!): + Use of ARRAY-DIMENSIONS replaces use of ARRAY-SHAPE. + (make-shared-array): converted. - The correctly ordered byte representations of numbers tie in with - SLIB's relational database being extended to include indexed - sequential access methods (ISAM). The Database-interpolation module - uses sequential methods to synthesize continuous functions from - discrete data tables. + * array.scm: Made compatible with SRFI-63. + (equal?): Replaces array=?. - These "continuous databases" are vital to my soon-to-be-released - optics program which calculates spectral responses of layered thin - films. + pnm.scm: Finished implementation; handles 16-bit color. - The character plotting utility has been improved, and is now - complemented by eps-graph, a very flexible graphing library for - producing encapsulated-PostScript files. + * colorspc.scm (read-normalized-illuminant, illuminant-map) + (illuminant-map->XYZ): Added. + (wavelength->CIEXYZ, XYZ:normalize, XYZ:normalize-colors) + (temperature->CIEXYZ, spectrum->CIEXYZ, wavelength->CIEXYZ): + Removed; use chromaticity functions instead. + (read-cie-illuminant): Added. - SRFI-2, SRFI-8, and SRFI-9 are added. + * ciesia.dat: Added CIE Standard Illuminant A relative spectral + power distribution 300 nm - 830 nm at 5 nm intervals. - Although I have endeavored to support legacy usage, some programs - will need modification to work with SLIB 3. Some issues that I know - of are: + * ciesid65.dat: Added CIE Standard Illuminant D65 relative + spectral power distribution 300 nm - 830 nm at 5 nm intervals. - * REQUIRE no longer accepts a string as its argument. - * The RANDOM module is split into RANDOM and RANDOM-INEXACT. - * Some refactoring among TRANSACT, GLOB, and LINE-I/O. + * daylight.scm (sunlight-chromaticity): Replaces sunlight-CIEXYZ. + + * solid.scm (scene:sun, scene:overcast): Use chromaticity to + normalize XYZ values. + (solid:polyline): Added. + (solid:cylinder): Negative radius for invisible side. + + * format.scm: Made reentrant; restored. Call slib:error for errors. + + * dbutil.scm (close-database): Don't lock immutable dbs. + + * transact.scm (word-lock:certificate): Test file's existence + before OPEN-FILE. + + vet.scm (vet-slib): Accept file arguments to include in vetting. + + * vscm.init, umbscheme.init, scsh.init, macscheme.init, + guile.init, gambit.init, elk.init, chez.init, STk.init, + RScheme.init, Template.scm, pscheme.init, t3.init, scheme48.init, + scheme2c.init, s48-0_57.init, mitscheme.init, bigloo.init + (*features*): Regularized order and content. -=-=- @@ -56,8 +65,8 @@ SLIB is a portable Scheme library providing compatibiliy and utility functions for all standard Scheme implementations. SLIB includes initialization files for Bigloo, Chez, DrScheme, ELK, -GAMBIT, MacScheme, MITScheme, PocketScheme, RScheme Scheme->C, -Scheme48, SCM, SCSH, T3.1, UMB-Scheme, and VSCM. +GAMBIT, Jscheme, MacScheme, MITScheme, PocketScheme, RScheme, +Scheme->C, Scheme48, SCM, SCSH, T3.1, UMB-Scheme, and VSCM. Documentation includes a manifest, installation instructions, and coding guidelines for the library. Documentation of each library @@ -66,10 +75,10 @@ package is supplied. SLIB Documentation is online at: http://swissnet.ai.mit.edu/~jaffer/SLIB.html SLIB is available from: - http://swissnet.ai.mit.edu/ftpdir/scm/slib3a1.zip - http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a1-1.noarch.rpm - swissnet.ai.mit.edu:/pub/scm/slib3a1.zip - swissnet.ai.mit.edu:/pub/scm/slib-3a1-1.noarch.rpm + http://swissnet.ai.mit.edu/ftpdir/scm/slib3a2.zip + http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a2-1.noarch.rpm + swissnet.ai.mit.edu:/pub/scm/slib3a2.zip + swissnet.ai.mit.edu:/pub/scm/slib-3a2-1.noarch.rpm SLIB-PSD is a portable debugger for Scheme (requires emacs editor): http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz @@ -1,3 +1,651 @@ +2005-06-22 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.spec (install): Make slib executable. + +2005-06-18 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (rpm): Program name changed to rpmbuild. + + * slib.spec: Fixed for rpmbuild version 4.3.1 + +2005-06-04 Aubrey Jaffer <jaffer@aubrey> + + * require.scm (*SLIB-VERSION*): Bumped from 3a1 to 3a2. + +2005-05-08 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (allfiles): Added clrnamdb.scm. + +2005-04-15 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Installation): Instructions to replace Guile's + built-in slib directory. + +2005-04-14 Aubrey Jaffer <agj@alum.mit.edu> + + * dynwind.scm (with-load-pathname): Redefinition removed. + + * slib.texi (Vicinity): with-load-pathname moved from System. + + * require.scm: Moved vicinity definitions to *.init. + + * Template.scm, *.init: Now contains all vicinity definitions. + + * pnm.scm (pnm:image-file->array, pnm:array-write): Support up to + 16-bit values. + + * slib.texi (Color Data-Type): Expanded make-color description. + + * color.scm (make-color): Apply conversion function. + +2005-04-11 Aubrey Jaffer <agj@alum.mit.edu> + + * timecore.scm (time:year-70): Fixed -- was very broken. + +2005-03-22 Aubrey Jaffer <agj@alum.mit.edu> + + * solid.scm (solid:polyline): Added. + +2005-03-20 Kevin Ryde + + * guile.init (<?, <=?, =?, >?, >=?): Added rev2-procedures. + (delete-file): Return #f for failure (not bomb). + (system, open-file): Made compatible with SLIB. + +2005-03-18 Reed Sheridan + + * uri.scm (uri:decode-authority, uri:split): Remove colon from end + of idx-: (renamed cdx) to work around Gambit keyword syntax. + +2005-03-18 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (install): Installs in $(libdir)slib/. + (uninstall): Fixed. + +2005-03-16 Aubrey Jaffer <agj@alum.mit.edu> + + * array.scm (array->vector): Return vector for rank-0 array. + +2005-03-13 Aubrey Jaffer <agj@alum.mit.edu> + + * solid.scm (solid:text, solid:font): Added. + (solid:extract-elevations): Rein in line length. + +2005-03-07 Aubrey Jaffer <agj@alum.mit.edu> + + * guile.init (a:*): Added case-insensitive aliases. + (random:chunk): Added. + +2005-03-06 Aubrey Jaffer <agj@alum.mit.edu> + + * differ.scm (diff:edit-length): Reconciled case for Guile. + + * solid.scm (solid:bry): Fixed scaling off-by-one error. + +2005-02-24 Aubrey Jaffer <agj@alum.mit.edu> + + * phil-spc.scm (delaminate-list): Added. + (integer->hilbert-coordinates, hilbert-coordinates->integer): Use + lists of integers instead of bignums for intermediate results. + +2005-02-23 Aubrey Jaffer <agj@alum.mit.edu> + + * phil-spc.scm (integer->hilbert-coordinates) + (hilbert-coordinates->integer): Distributed rank-bit flipping. + +2005-02-21 Aubrey Jaffer <agj@alum.mit.edu> + + * phil-spc.scm (hilbert-coordinates->integer) + (integer->hilbert-coordinates): Added optional width argument + treating integers as fractional bits. + +2005-02-18 Aubrey Jaffer <agj@alum.mit.edu> + + * grapheps.scm (set-margin-templates): Added. + +2005-02-06 Aubrey Jaffer <agj@alum.mit.edu> + + * peanosfc.scm: Peano space filling curve added. + +2005-01-27 Aubrey Jaffer <agj@alum.mit.edu> + + * logical.scm (any-bits-set?, first-set-bit, bitwise-merge): Added + remaining SRFI-33 aliases. + +2005-01-24 Aubrey Jaffer <agj@alum.mit.edu> + + * guile.init: Removed gray-code functions (for SRFI-60). + + * logical.scm: Moved gray-code to "phil-spc.scm" (for SRFI-60). + + * phil-spc.scm: Moved gray-code functions from "logical.scm". + +2005-01-23 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (The SLIB script): Added section. + + * Makefile (uninstall): Added. + (pinstall): Install slib.1 + +2005-01-20 Aubrey Jaffer <agj@alum.mit.edu> + + * gambit.init: Major update for Gambit-C 4.0b12. + + * slib.texi (Define-Structure): Documentation from Gambit-C 4.0. + + * timecore.scm (tzfile:transition-index, time:split): Cleaned to + work with Gambit-C time datatype. + + * Makefile (install): Include definition for S48_VICINITY. + +2005-01-19 Aubrey Jaffer <agj@alum.mit.edu> + + * http-cgi.scm (http:forwarding-page): Renamed DELAY argument. + + * htmlform.scm (html:meta-refresh): Renamed DELAY argument. + + * slib.sh (gsi): Gambit 4.0 doesn't allow input redirection; + foils --version test. + +2005-01-16 Aubrey Jaffer <agj@alum.mit.edu> + + * array.scm: Fixed documentation. + (make-array): Rank 0 arrays are box. + (array->vector, array->list): Added. + (list->array, vector->array): Added. + +2005-01-09 Aubrey Jaffer <agj@alum.mit.edu> + + * html4each.scm (htm-fields): Don't warn about empty ALT fields. + + * slib.texi (Bit-Twiddling): Updated for SRFI-60 changes. + + * phil-spc.scm: Updated for logical.scm changes. + (bitwise-delaminate, bitwise-laminate): Moved from logical.scm. + + * logical.scm (logical:reduce): Handle null arity. + (reverse-bit-field): Replaced bit-reverse export. + (rotate-bit-field): Replaced logical:rotate export. + (copy-bit-field): Chaned argument order. + Laminates moved to "phil-spc.scm". + ARITHMETIC-SHIFT replaces interal uses of ASH. + +2005-01-07 Aubrey Jaffer <agj@alum.mit.edu> + + * guile.init (expt): Workaround removed. LOGICAL: aliases + removed. + + * sort.scm, pnm.scm, matfile.scm, logical.scm, grapheps.scm, + fft.scm, differ.scm, determ.scm, charplot.scm, arraymap.scm: + MAKE-ARRAY replaced CREATE-ARRAY. + +2004-12-27 Aubrey Jaffer <agj@alum.mit.edu> + + * array.scm (Ac64, Ac32, Ar64, Ar32): Added word "inexact" to + descriptions. + +2004-12-22 Aubrey Jaffer <agj@alum.mit.edu> + + * vet.scm (vet-slib): Accept file arguments to include in vetting. + +2004-12-19 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Bit-Twiddling): Updated and shuffled. + + * logical.scm (logand, logior, logxor): Take one or more + arguments. + +2004-11-14 Aubrey Jaffer <agj@alum.mit.edu> + + * scheme48.init (inexact->exact, exact->inexact, atan, modulo): + Bugs have been fixed in 1.1 + +2004-11-13 Aubrey Jaffer <agj@alum.mit.edu> + + * scheme48.init: From s48-0_57.init, which works with Scheme48 1.1 + +2004-11-09 Aubrey Jaffer <agj@alum.mit.edu> + + * db2html.scm (table->linked-html): Chop tables into 50-row + chunks. + + * tzfile.scm (tzfile:read): Use bytes, not strings. + + * pnm.scm (pnm:write-bits): Added. + + * array.scm (make-shared-array): Recoded 3-arg -. + +2004-10-27 Aubrey Jaffer <agj@alum.mit.edu> + + * timezone.scm (read-tzfile): Check for "/etc/localtime". + + * psxtime.scm (tzset, daylight?, *timezone*, tzname): Moved from + "timezone.scm". + + * slib.texi (Time Infrastructure): Added. + + * Makefile (afiles): Added "timecore.scm". + + * timecore.scm: Core time conversion routines split from + "psxtime.scm". + +2004-10-16 Aubrey Jaffer <agj@alum.mit.edu> + + * html4each.scm (htm-fields): Handle field without value. + +2004-10-15 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Cyclic Checksum): Added citation for Philip Koopman + and his exhaustive analysis of CRC behavior. + +2004-10-13 Aubrey Jaffer <agj@alum.mit.edu> + + * byte.scm (bytes-reverse!): Was hosed for even number of bytes. + +2004-10-10 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (SRFI): SRFI-47 is the same as 'array. + + * colorspc.scm (read-normalized-illuminant, illuminant-map) + (illuminant-map->XYZ): Added. + (wavelength->CIEXYZ, XYZ:normalize, XYZ:normalize-colors) + (temperature->CIEXYZ, spectrum->CIEXYZ, wavelength->CIEXYZ): + Removed; use chromaticity functions instead. + + * daylight.scm (sunlight-chromaticity): Replaces sunlight-CIEXYZ. + + * solid.scm (scene:sun, scene:overcast): Use chromaticity to + normalize XYZ values. + + * subarray.scm (subarray, array-trim): Rewrote for all-0-based + arrays. + +2004-10-07 Aubrey Jaffer <agj@alum.mit.edu> + + * arraymap.scm (array-map!, array-for-each, array-index-map!): + Use of ARRAY-DIMENSIONS replaces use of ARRAY-SHAPE. + (make-shared-array): converted. + + * array.scm: Made compatible with SRFI-47. + (equal?): Replaces array=?. + (make-array): Restored. + + * schmooz.scm (schmooz-fun): Latest Texinfo needs additional blank + lines after @end statements converting to info. + +2004-10-03 Aubrey Jaffer <agj@alum.mit.edu> + + * colorspc.scm (read-cie-illuminant): Added. + + * ciesia.dat: Added CIE Standard Illuminant A relative spectral + power distribution 300 nm - 830 nm at 5 nm intervals. + + * ciesid65.dat: Added CIE Standard Illuminant D65 relative + spectral power distribution 300 nm - 830 nm at 5 nm intervals. + +2004-09-22 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Miscellany): Added EXPT for integers. + + * cring.scm (number^): Is EXPT. + + * modular.scm (modular:expt): EXPT replaces integer-expt. + + * bytenumb.scm (expt): Replaces BN:EXPT. + + * logical.scm (expt): Replaces INTEGER-EXPT. + + * Template.scm (expt): Define for exacts-only implementation. + +2004-09-14 Aubrey Jaffer <agj@alum.mit.edu> + + * arraymap.scm (array:copy!): Renamed from array-copy! and + argument order reversed. + +2004-09-04 Aubrey Jaffer <agj@alum.mit.edu> + + * batch.scm (batch:write-comment-line): Simplified. + (batch-line): Issue warning, but don't fail when line is too long. + +2004-08-21 Aubrey Jaffer <agj@alum.mit.edu> + + * format.scm (format:get-port-column, format:set-port-column!): + Added to track individual port columns. + + * FAQ (What happened to FORMAT?): Question removed. + + * format.scm: Tidied slib:error messages. + + * Makefile (texifiles, format.texi): Added. + + * format.texi, formatst.scm: Reinstated. + + * format.scm: Made reentrant; call slib:error for errors. + +2004-08-11 Aubrey Jaffer <agj@alum.mit.edu> + + * matfile.scm (unwritten-stubber): Place holder for VAX and Cray + floating conversions. + +2004-08-10 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Session Support): Documented 'abort feature. + + * determ.scm (matrix2array, matrix2lists): Changed to 0-base. + +2004-07-28 Aubrey Jaffer <agj@alum.mit.edu> + + * top-refs.scm (exports<-info-index): Adjusted for texinfo 4.7, + which breaks long index lines. + +2004-07-27 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (docfiles): Added indexs.texi. + + * slib.texi (Top, About SLIB): Changed conditional for texinfo 4.7. + + * indexs.texi (Index): Give each index its own node. Moved + index stuff here so it doesn't break texinfo-every-node-update. + +2004-06-17 Ivan Shmakov <ivan@theory.dcn-asu.ru> + + * coerce.scm (type-of): Removed RECORD. + + * hash.scm (hash): Removed obsolete support for RECORD types. + +2004-06-14 Aubrey Jaffer <agj@alum.mit.edu> + + * *.init (slib:eval-load): Moved to "require.scm". + + * require.scm (slib:eval-load): Definition moved here. + +2004-06-13 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (System): Added with-load-pathname. + + * dynwind.scm (with-load-pathname): Redefine using dynamic-wind. + + * require.scm (vicinity:suffix?): Flag unknown SOFTWARE-TYPE. + + * *.init (slib:eval-load): Converted to use with-load-pathname. + +2004-06-13 Ivan Shmakov <ivan@theory.dcn-asu.ru> + + * manifest.scm (file->loads, file->definitions, file->exports): + * top-refs.scm (top-refs:include): + * ppfile.scm (pprint-filter-file): + * Template.scm (slib:eval-load): + * repl.scm (repl:repl): Converted to use with-load-pathname. + + * require.scm (with-load-pathname): Added. + +2004-06-12 Aubrey Jaffer <agj@alum.mit.edu> + + * coerce.scm (type-of): Vector has priority over array. + +2004-06-10 Aubrey Jaffer <agj@alum.mit.edu> + + * trace.scm (debug:trace-procedure): Use 'call and 'retn instead + of (string->symbol "CALL") to avoid slashification. + + * qp.scm (qp): Put ellipsis (...) in middle of strings, symbols. + +2004-06-03 Aubrey Jaffer <agj%fun@gte.com> + + * slib.texi (Random Numbers): Don't change PRNG seed (URL). + +2004-05-23 Aubrey Jaffer <agj@alum.mit.edu> + + * dbutil.scm (close-database): Don't lock immutable dbs. + +2004-05-19 Aubrey Jaffer <agj@alum.mit.edu> + + * solid.scm (solid:cylinder): Negative radius for invisible side. + +2004-04-20 Aubrey Jaffer <agj@alum.mit.edu> + + * differ.scm (diff:mid-split): Removed unused M argument. + +2004-04-16 Aubrey Jaffer <agj@alum.mit.edu> + + * differ.scm: Removed equality predicate arguments. + +2004-04-14 Aubrey Jaffer <agj@alum.mit.edu> + + * differ.scm (diff2ez): Interleave insertions and deletions. + (diff2editlen, diff2edits!, edits2lcs!, diff:invert-edits!): + Derive lengths from array-dimensions. + (diff:edit-length, diff:edits, diff:longest-common-subsequence): + Moved all array creation to top-level API. + +2004-04-11 Aubrey Jaffer <agj@alum.mit.edu> + + * differ.scm (diff:negate-edits!): diff:fixup-edits Remnant. + (diff:fixup-edits): Removed unnecessary procedure. + (diff:longest-common-subsequence): Removed diff:order-edits call. + (sort): Feature no longer required. + +2004-03-20 Aubrey Jaffer <agj@alum.mit.edu> + + * transact.scm (file-lock!): Don't call EMACS:LOCK! unless + CURRENT-TIME is provided. + + * Makefile (S48INIT): Abstracted .init file. + (IMAGE48): Renamed from IMAGE. + +2004-03-20 Ivan Shmakov <ivan@theory.dcn-asu.ru> + + * s48-0_57.init (slib:warn, string-port): native functions based. + (slib-primitives): Makes transact.scm work with Scheme48 0.57. + +2004-03-19 Aubrey Jaffer <agj@alum.mit.edu> + + * transact.scm (word-lock:certificate): Test file's existence + before OPEN-FILE. + +2004-03-07 Aubrey Jaffer <agj@alum.mit.edu> + + * differ.scm (fp:run): Removed gratuitous variable KFPOFF. + (diff:mid-split): Removed unused definitions. + (diff:fixup-edits): Abstracted from DIFF:ORDER-EDITS. + Procedures grouped into API and supporting procedures. + +2004-03-01 Radey Shouman <shouman@comcast.net> + + * pnm.scm (pnm:type-dimensions): Allow comments beginning with + # and ending with newline in pnm file headers as required by + libppm documentation. + +2004-02-08 Aubrey Jaffer <agj@alum.mit.edu> + + * manifest.scm (file->requires): Don't squawk if feature not in + catalog. Read through non-lists at top level. + + * colorspc.scm (temperature->XYZ): Use blackbody-spectrum default + span. + +2004-02-01 Aubrey Jaffer <agj@alum.mit.edu> + + * manifest.scm (file->requires, file->loads, file->definitions) + (file->exports): Ignore first line if it begins with '#'. + (feature->requires*, file->requires*): Added transitive closures. + +2004-01-31 L.J. Buitinck + + * soundex.scm (soundex): Converted to use dotted pairs for CODES. + +2004-01-31 Aubrey Jaffer <agj@alum.mit.edu> + + * solid.scm (scene:viewpoint): Restored earlier code which works + with current freewrl. + (solid:bry, solid:extract-elevations, solid:extract-colors): + ARRAY-DIMENSIONS replaced ARRAY-SHAPE. + + * grapheps.scm (write-array-def): + ARRAY-DIMENSIONS replaced ARRAY-SHAPE. + + * charplot.scm (charplot:plot, charplot:data->lists): + ARRAY-DIMENSIONS replaced ARRAY-SHAPE. + + * sort.scm (sorted?, sort!, rank-1-array->list, sort): + ARRAY-DIMENSIONS replaced ARRAY-SHAPE. + +2004-01-20 Aubrey Jaffer <agj@alum.mit.edu> + + * bigloo.init (slib:load): Source or compiled. + +2004-01-16 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile ($(infodir)slib.info): "cp -a" ==> "cp -p". + + * slib.sh: grep -q is not universal. + +2004-01-14 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.sh: Separated shell assignments and exports. + + * Makefile (srcdir.mk): Include after target. + Separated shell assignments and exports. + +2004-01-13 Aubrey Jaffer <agj@alum.mit.edu> + + * DrScheme.init (slib:warn): Added newline. + +2004-01-11 Aubrey Jaffer <agj@alum.mit.edu> + + * differ.scm (diff2editlen, diff2edits): 0-based fp. + (fp:compare, fp:run, fp:init! diff:divide-and-conquer) + (diff2et, diff2ez): 0-based fp; added fpoff argument. + + * scamacr.scm (let*): Fixed syncase:andmap reference. + + * slib.texi (provided?): Add scheme-implementation-type footnote. + + * mitscheme.init (slib:error): Dispatch to special error routines. + + * wttree.scm (error:error, error:wrong-type-argument): + (error:bad-range-argument): Changed to SLIB:ERROR. + + * require.scm (provided?): Answer #t to + (scheme-implementation-type). + +2004-01-09 L.J. Buitinck + + * srfi-1.scm (filter!): Updated. + +2004-01-09 Ken Anderson + + * jscheme.init (scheme-implementation-version): 6.2. + (defmacro): Made native. + +2004-01-08 Aubrey Jaffer <agj@alum.mit.edu> + + * batch.scm (*operating-system*): SOFTWARE-TYPE symbols are + uppercase. + +2004-01-06 Ken Anderson + + * jscheme.init: Added. + +2004-01-04 Aubrey Jaffer <agj@alum.mit.edu> + + * vscm.init, umbscheme.init, scsh.init, macscheme.init, + guile.init, gambit.init, elk.init, chez.init, STk.init, + RScheme.init, Template.scm, pscheme.init, t3.init, scheme48.init, + scheme2c.init, s48-0_57.init, mitscheme.init, bigloo.init + (*features*): Regularized order and content. + + * slib.texi (Rev4 Optional Procedures): Removed R4RS essential + procedures string->list, list->string, vector->list, and + list->vector. + + * rdms.scm (make-relational-system): Recode 3-argument -. + +2004-01-04 Ivan Shmakov <ivan@theory.dcn-asu.ru> + + * transact.scm (word:lock!, word-lock:certificate): Modes are + symbols. + +2004-01-03 Aubrey Jaffer <agj@alum.mit.edu> + + * sc4opt.scm (string->list, list->string, vector->list): + (list->vector): Removed. These are R4RS essential procedures. + + * dbinterp.scm, rdms.scm : Require REV4-OPTIONAL-PROCEDURES for + LIST-TAIL. + + * byte.scm, chap.scm, getparam.scm, strcase.scm: Require + REV4-OPTIONAL-PROCEDURES for STRING-COPY. + + * vet.scm (r4rs-symbols): Removed optional procedures DENOMINATOR, + FORCE, LIST-TAIL, NUMERATOR, RATIONALIZE, STRING-COPY, + STRING-FILL!, TRANSCRIPT-OFF, TRANSCRIPT-ON, VECTOR-FILL!, + WITH-INPUT-FROM-FILE, and WITH-OUTPUT-TO-FILE. + +2003-12-19 Aubrey Jaffer <agj@alum.mit.edu> + + * grapheps.scm (create-postscript-graph): Push bounds on stack at + end of preamble. + + * grapheps.ps (wholepage): Bounds left on stack by preamble. + +2003-12-16 Aubrey Jaffer <agj@alum.mit.edu> + + * color.scm (string->color): Was spoofed by #00. + +2003-12-16 L.J. Buitinck + + * srfi-1.scm (take!, split-at, fold, fold-right, pair-fold) + (pair-fold-right, reduce, reduce-right, delete-duplicates) + (alist-cons, alist-copy, alist-delete, lset<=, lset=, lset-adjoin) + (lset-union, lset-intersection, lset-difference, lset-xor) + (lset-diff+intersection): Added. + +2003-12-14 Aubrey Jaffer <agj@alum.mit.edu> + + * mkclrnam.scm (make-slib-color-name-db): Added nbs-iscc. + + * Makefile (rfiles): Added nbs-iscc. + + * mklibcat.scm (nbs-iscc): Added. + + * nbs-iscc.txt: Added. + +2003-12-11 Aubrey Jaffer <agj@alum.mit.edu> + + * charplot.scm (charplot:array->list): Handle rank-1 arrays. + +2003-12-11 Ivan Shmakov <ivan@theory.dcn-asu.ru> + + * dbsyn.scm (within-database): Added define-macro syntax. + (add-macro-support): Added. + +2003-12-09 Aubrey Jaffer <agj@alum.mit.edu> + + * manifest.scm (file->exports, file->definitions): Added optional + arguments to allow selection for types of definitions. + +2003-12-06 Aubrey Jaffer <agj@alum.mit.edu> + + * grapheps.scm (in-graphic-context): Use gpush and gpop. + + * grapheps.ps (impulse, bargraph): Fixed. + (triup, tridown): Removed gratuitous 2 copy. + (gpush, gpop): Added for pointsize and glyphsize state. + +2003-12-05 Aubrey Jaffer <agj@alum.mit.edu> + + * dbinterp.scm (dbinterp:memoize): Speeds interpolate-from-table + by factor of 2. + +2003-12-02 Aubrey Jaffer <agj@alum.mit.edu> + + * printf.scm (stdio:iprintf): `K' put dot between number and unit. + + * rdms.scm (delete-table): Delete table only if TABLE-EXISTS? + + * dbutil.scm (mdbm:try-opens, mdbm:open-type): Unlock if fail. + 2003-11-30 Aubrey Jaffer <jaffer@scm.jaffer> * require.scm (*SLIB-VERSION*): Bumped from 2d6 to 3a1. @@ -1005,7 +1653,7 @@ * queue.scm (dequeue-all!): Added. -2003-01-05 L.J. Buitinck <L.J.Buitinck@student.rug.nl> +2003-01-05 L.J. Buitinck * comlist.scm (comlist:subset?): Added. @@ -1039,7 +1687,7 @@ * comlist.scm (comlist:list*): Make letrec top-level. -2002-12-25 "L.J. Buitinck" <L.J.Buitinck@let.rug.nl> +2002-12-25 L.J. Buitinck * comlist.scm (comlist:union): Make letrec top-level. @@ -1060,7 +1708,7 @@ * Makefile (catalogs): Make mzscheme new-catalog -g (case-sensitive) so *SLIB-VERSION* symbol upper-cased. -2002-12-08 L.J. Buitinck <L.J.Buitinck@let.rug.nl> +2002-12-08 L.J. Buitinck * slib.texi (Destructive list operations): Fixed SOME example. MAP instead of MAPCAR in nconc example. diff --git a/DrScheme.init b/DrScheme.init index 9942897..8cce2e9 100644 --- a/DrScheme.init +++ b/DrScheme.init @@ -3,6 +3,85 @@ ;;; ;;; This code is in the public domain. +;;; (software-type) should be set to the generic operating system type. +;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. + +;@ +(define (software-type) + (case (system-type) + [(unix macosx) 'UNIX] + [(windows) 'MS-DOS] + [(macos) 'MACOS] + [else (system-type)])) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + (define (make-exchanger obj) (lambda (rep) (let ((old obj)) (set! obj rep) old))) (define (open-file filename modes) @@ -41,6 +120,9 @@ (eval '(require (lib "defmacro.ss"))) (slib:provide 'defmacro))) +(provide 'vicinity) +(provide 'srfi-59) + ;;;The rest corrects mistakes in ;;;/usr/local/lib/plt/collects/slibinit/init.ss: @@ -51,7 +133,8 @@ (let ((cep (current-error-port))) (if (provided? 'trace) (print-call-stack cep)) (display "Warn: " cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) args)))) + (for-each (lambda (x) (display #\ cep) (write x cep)) args) + (newline cep)))) (define call-with-input-string (lambda (string thunk) @@ -1,4 +1,4 @@ -FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib3a1). +FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib3a2). Written by Aubrey Jaffer (http://swissnet.ai.mit.edu/~jaffer). INTRODUCTION AND GENERAL INFORMATION @@ -46,7 +46,7 @@ Several times a year. [] What is the latest version? -The version as of this writing is slib3a1. The latest documentation +The version as of this writing is slib3a2. The latest documentation is available online at: http://swissnet.ai.mit.edu/~jaffer/SLIB.html @@ -130,17 +130,6 @@ I find that I only type require statements at top level when debugging. I put require statements in my Scheme files so that the appropriate modules are loaded automatically. -[] What happened to FORMAT? - -In order for FORMAT to call itself for FORMAT error messages, the -original author made its code non-reentrant. For that reason and the -reasons below, FORMAT was removed; I saw little evidence of anyone -using it. - -If someone fixes FORMAT, I will put it back into SLIB. The last -versions of FORMAT are in "format.scm", "formatst.scm", and -"fmtdoc.txi" in http://swissnet.ai.mit.edu/ftpdir/scm/OLD/slib2d5.zip - [] Why does SLIB have PRINTF when it already has the more powerful (CommonLisp) FORMAT? @@ -162,19 +151,12 @@ again, printf gets it right: (printf "%.20s\n" "the quick brown fox jumped over the lazy dog") ==> the quick brown fox -FORMAT also lacks directives for formatting date and time. printf -does not handle these directly, but a related function strftime does. - [] Why doesn't SLIB:ERROR call FORMAT? Format does not provide a method to truncate fields. When an error message contains non-terminating or large expressions, the essential information of the message may be lost in the ensuing deluge. -FORMAT as currently written in SLIB is not reentrant. Until this is -fixed, exception handlers and errors which might occur while using -FORMAT cannot use it. - MACROS [] Why are there so many macro implementations in SLIB? @@ -11,12 +11,12 @@ intro: @echo -make slib.info -include srcdir.mk srcdir.mk: .. Makefile - echo -e "srcdir = `pwd`/\n" > srcdir.mk + echo "srcdir = `pwd`/" > srcdir.mk #srcdir=$(HOME)/slib/ +include srcdir.mk -VERSION = 3a1 +VERSION = 3a2 RELEASE = 1 rpm_prefix=/usr/src/redhat/ @@ -25,6 +25,10 @@ exec_prefix = $(prefix) # directory where `make install' will put executable. bindir = $(exec_prefix)bin/ libdir = $(exec_prefix)lib/ +libslibdir = $(libdir)slib/ +# directory where `make install' will put manual page. +mandir = $(prefix)man/ +man1dir = $(mandir)man1/ infodir = $(prefix)info/ PREVDOCS = prevdocs/ @@ -33,9 +37,10 @@ htmldir=../public_html/ dvidir=../dvi/ RUNNABLE = scheme48 +S48INIT = scheme48.init LIB = $(libdir)$(RUNNABLE)/ VM = scheme48vm -IMAGE = slib.image +IMAGE48 = slib.image INSTALL_DATA = install -c $(LIB)slibcat: @@ -45,66 +50,39 @@ catalogs: -if type scm; then scm -c "(require 'new-catalog)"; fi -if type guile; then guile -l guile.init -c\ "(use-modules (ice-9 slib)) (require 'new-catalog)"; fi - -if type umb-scheme; then export SCHEME_INIT=umbscheme.init;\ + -if type umb-scheme; then SCHEME_INIT=umbscheme.init;export SCHEME_INIT;\ echo "(require 'new-catalog)" | umb-scheme; fi - -if type mzscheme; then export SCHEME_LIBRARY_PATH=`pwd`/;\ + -if type mzscheme; then SCHEME_LIBRARY_PATH=`pwd`/;export SCHEME_LIBRARY_PATH;\ mzscheme -g -f DrScheme.init -e "(require 'new-catalog)" </dev/null; fi -if type scheme48; then make install48; fi MKNMDB = (require 'color-database) (make-slib-color-name-db) (slib:exit) clrnamdb: clrnamdb.scm -clrnamdb.scm: mkclrnam.scm Makefile +clrnamdb.scm: mkclrnam.scm color.scm resenecolours.txt saturate.txt nbs-iscc.txt if type scm; then scm -e"$(MKNMDB)";\ elif type guile; then guile -l guile.init -c\ "(use-modules (ice-9 slib)) $(MKNMDB)";\ elif type slib48; then echo -e "$(MKNMDB)\n,exit" | slib48 -h 3000000;\ - elif type umb-scheme; then export SCHEME_INIT=`pwd`/umbscheme.init;\ + elif type umb-scheme; then SCHEME_INIT=`pwd`/umbscheme.init;export SCHEME_INIT;\ echo "$(MKNMDB)" | umb-scheme;\ - elif type mzscheme; then export SCHEME_LIBRARY_PATH=`pwd`/;\ + elif type mzscheme; then SCHEME_LIBRARY_PATH=`pwd`/;export SCHEME_LIBRARY_PATH;\ echo "$(MKNMDB)" | mzscheme -f DrScheme.init;\ fi -slib48: $(IMAGE) -$(IMAGE): Makefile scheme48.init - export S48_VERSION="`echo ,exit | scheme48 | sed -n 's/Welcome to Scheme 48 //;s/ ([^)]*)[.]//;p;q'`";\ - export S48_VICINITY="$(LIB)";\ - export SCHEME_LIBRARY_PATH="`pwd`/";\ - scheme48 < scheme48.init -install48: $(IMAGE) - $(INSTALL_DATA) $(IMAGE) $(LIB) +slib48: $(IMAGE48) +$(IMAGE48): Makefile $(S48INIT) + S48_VERSION="`echo ,exit | $(RUNNABLE) | sed -n 's/Welcome to Scheme 48 //;s/ ([^)]*)[.]//;p;q'`";export S48_VERSION;\ + S48_VICINITY="$(LIB)";export S48_VICINITY;\ + SCHEME_LIBRARY_PATH="`pwd`/";export SCHEME_LIBRARY_PATH;\ + $(RUNNABLE) < $(S48INIT) +install48: $(IMAGE48) + $(INSTALL_DATA) $(IMAGE48) $(LIB) (echo '#! /bin/sh';\ - echo exec $(RUNNABLE) -i '$(LIB)$(IMAGE)' \"\$$\@\") \ + echo exec $(RUNNABLE) -i '$(LIB)$(IMAGE48)' \"\$$\@\") \ > $(bindir)slib48 chmod +x $(bindir)slib48 -install: - test -d $(bindir) || mkdir $(bindir) - echo '#! /bin/sh' > $(bindir)slib - echo export SCHEME_LIBRARY_PATH=$(libdir)slib/ >> $(bindir)slib - echo VERSION=$(VERSION) >> $(bindir)slib - cat slib.sh >> $(bindir)slib - chmod +x $(bindir)slib - -#### Stuff for maintaining SLIB below #### - -ver = $(VERSION) -version.txi: Makefile - echo @set SLIBVERSION $(ver) > version.txi - echo @set SLIBDATE `date +"%B %Y"` >> version.txi - -scheme = scm - -collect.sc: - echo "(require 'macros-that-work)" > collect.sc - echo "(require 'pprint-file)" >> collect.sc - echo "(require 'yasos)" >> collect.sc - echo "(pprint-filter-file \"collect.scm\" macwork:expand \"collectx.scm\")" >> collect.sc - echo "(slib:exit #t)" >> collect.sc - -collectx.scm: collect.scm macwork.scm collect.sc - $(scheme) < collect.sc - -ffiles = printf.scm genwrite.scm pp.scm \ +ffiles = format.scm printf.scm genwrite.scm pp.scm \ ppfile.scm strcase.scm debug.scm trace.scm \ strport.scm scanf.scm qp.scm break.scm stdio.scm \ strsrch.scm prec.scm schmooz.scm defmacex.scm mbe.scm @@ -112,8 +90,8 @@ lfiles = sort.scm comlist.scm logical.scm revfiles = sc4opt.scm sc4sc3.scm sc2.scm mularg.scm mulapply.scm \ trnscrpt.scm withfile.scm dynwind.scm promise.scm \ values.scm eval.scm null.scm -afiles = charplot.scm root.scm cring.scm \ - selfset.scm psxtime.scm cltime.scm timezone.scm tzfile.scm +afiles = charplot.scm root.scm cring.scm selfset.scm \ + timecore.scm psxtime.scm cltime.scm timezone.scm tzfile.scm bfiles = fluidlet.scm object.scm recobj.scm yasyn.scm collect.scm collectx.scm scfiles = r4rsyn.scm scmacro.scm synclo.scm synrul.scm synchk.scm \ repl.scm macwork.scm mwexpand.scm mwdenote.scm mwsynrul.scm @@ -125,7 +103,8 @@ efiles = record.scm dynamic.scm process.scm hash.scm \ rfiles = rdms.scm alistab.scm paramlst.scm \ batch.scm crc.scm dbrowse.scm getopt.scm dbinterp.scm \ dbcom.scm dbsyn.scm -gfiles = colorspc.scm cie1931.xyz cie1964.xyz resenecolours.txt saturate.txt +gfiles = colorspc.scm cie1931.xyz cie1964.xyz resenecolours.txt saturate.txt \ + nbs-iscc.txt ciesid65.dat ciesia.dat txiscms =grapheps.scm glob.scm getparam.scm \ vet.scm top-refs.scm hashtab.scm chap.scm comparse.scm\ @@ -136,7 +115,8 @@ txiscms =grapheps.scm glob.scm getparam.scm \ minimize.scm factor.scm determ.scm daylight.scm colornam.scm\ mkclrnam.scm color.scm subarray.scm dbutil.scm array.scm transact.scm\ arraymap.scm phil-spc.scm lineio.scm differ.scm cvs.scm tree.scm\ - coerce.scm byte.scm bytenumb.scm matfile.scm tsort.scm manifest.scm + coerce.scm byte.scm bytenumb.scm matfile.scm tsort.scm manifest.scm\ + peanosfc.scm txifiles =grapheps.txi glob.txi getparam.txi\ vet.txi top-refs.txi hashtab.txi chap.txi comparse.txi\ alist.txi ratize.txi modular.txi dirs.txi priorque.txi queue.txi\ @@ -146,47 +126,94 @@ txifiles =grapheps.txi glob.txi getparam.txi\ minimize.txi factor.txi determ.txi daylight.txi colornam.txi\ mkclrnam.txi color.txi subarray.txi dbutil.txi array.txi transact.txi\ arraymap.txi phil-spc.txi lineio.txi differ.txi cvs.txi tree.txi\ - coerce.txi byte.txi bytenumb.txi matfile.txi tsort.txi manifest.txi + coerce.txi byte.txi bytenumb.txi matfile.txi tsort.txi manifest.txi\ + peanosfc.txi % = `echo $(txiscms) | sed 's%.scm%.txi%g'` -docfiles = ANNOUNCE README COPYING FAQ slib.info slib.texi schmooz.texi\ - ChangeLog version.txi object.texi $(txifiles) +texifiles = schmooz.texi indexes.texi object.texi format.texi +docfiles = ANNOUNCE README COPYING FAQ slib.1 slib.info slib.texi version.txi\ + ChangeLog $(texifiles) $(txifiles) mkfiles = Makefile require.scm Template.scm syncase.sh mklibcat.scm \ Bev2slib.scm slib.spec slib.sh grapheps.ps ifiles = bigloo.init chez.init elk.init macscheme.init mitscheme.init \ - scheme2c.init scheme48.init s48-0_57.init gambit.init t3.init \ + scheme2c.init scheme48.init gambit.init t3.init \ vscm.init scm.init scsh.init pscheme.init STk.init \ - RScheme.init DrScheme.init umbscheme.init guile.init -tfiles = plottest.scm macrotst.scm dwindtst.scm + RScheme.init DrScheme.init umbscheme.init guile.init jscheme.init +tfiles = plottest.scm macrotst.scm dwindtst.scm formatst.scm sfiles = $(ffiles) $(lfiles) $(revfiles) $(afiles) $(scfiles) $(efiles) \ $(rfiles) $(gfiles) $(scafiles) $(txiscms) $(srfiles) -allfiles = $(docfiles) $(mkfiles) $(ifiles) $(sfiles) $(tfiles) $(bfiles) +allfiles = $(docfiles) $(mkfiles) $(ifiles) $(sfiles) $(tfiles) $(bfiles) \ + slib.doc clrnamdb.scm + +pinstall: slib.1 + test -d $(mandir) || mkdir $(mandir) + test -d $(man1dir) || mkdir $(man1dir) + -cp slib.1 $(man1dir) + +install: pinstall clrnamdb.scm + test -d $(libdir) || mkdir $(libdir) + test -d $(libslibdir) || mkdir $(libslibdir) + -cp $(ifiles) $(sfiles) $(bfiles) $(mkfiles) clrnamdb.scm $(libslibdir) + test -d $(bindir) || mkdir $(bindir) + echo '#! /bin/sh' > $(bindir)slib + echo SCHEME_LIBRARY_PATH=$(libslibdir) >> $(bindir)slib + echo export SCHEME_LIBRARY_PATH >> $(bindir)slib + echo VERSION=$(VERSION) >> $(bindir)slib + echo "S48_VICINITY=\"$(LIB)\";export S48_VICINITY" >> $(bindir)slib + cat slib.sh >> $(bindir)slib + chmod +x $(bindir)slib + +uninstall: + -(cd $(libslibdir); rm $(ifiles) $(sfiles) $(bfiles) $(mkfiles) clrnamdb.scm) + -rm $(bindir)slib + -rm $(man1dir)slib.1 + +slib.doc: slib.1 + nroff -man $< | ul -tunknown >$@ + +#### Stuff for maintaining SLIB below #### + +ver = $(VERSION) +version.txi: Makefile + echo @set SLIBVERSION $(ver) > version.txi + echo @set SLIBDATE `date +"%B %Y"` >> version.txi + +scheme = scm + +collect.sc: + echo "(require 'macros-that-work)" > collect.sc + echo "(require 'pprint-file)" >> collect.sc + echo "(require 'yasos)" >> collect.sc + echo "(pprint-filter-file \"collect.scm\" macwork:expand \"collectx.scm\")" >> collect.sc + echo "(slib:exit #t)" >> collect.sc + +collectx.scm: collect.scm macwork.scm collect.sc + $(scheme) < collect.sc $(txifiles): $(txiscms) schmooz.scm $(scheme) -rschmooz -e'(schmooz "slib.texi")' dvi: $(dvidir)slib.dvi -$(dvidir)slib.dvi: version.txi slib.texi $(dvidir)slib.fn \ - $(txifiles) object.texi schmooz.texi -# cd $(dvidir);export TEXINPUTS=$(srcdir):;texi2dvi $(srcdir)slib.texi - -(cd $(dvidir);export TEXINPUTS=$(srcdir):;texindex slib.??) - cd $(dvidir);export TEXINPUTS=$(srcdir):;tex $(srcdir)slib.texi +$(dvidir)slib.dvi: version.txi slib.texi $(dvidir)slib.fn $(txifiles) $(texifiles) +# cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;texi2dvi $(srcdir)slib.texi + -(cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;texindex slib.??) + cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)slib.texi $(dvidir)slib.fn: - cd $(dvidir);export TEXINPUTS=$(srcdir):;tex $(srcdir)slib.texi \ + cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)slib.texi \ $(srcdir)schmooz.texi xdvi: $(dvidir)slib.dvi xdvi -s 3 $(dvidir)slib.dvi pdf: $(htmldir)slib.pdf -$(htmldir)slib.pdf: version.txi slib.texi $(dvidir)slib.fn schmooz.texi +$(htmldir)slib.pdf: version.txi slib.texi $(dvidir)slib.fn $(txifiles) $(texifiles) # cd $(dvidir);dvipdf slib.dvi # doesn't have links! - cd $(dvidir);export TEXINPUTS=$(srcdir):;pdftex $(srcdir)slib.texi + cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;pdftex $(srcdir)slib.texi mv $(dvidir)slib.pdf $(htmldir) xpdf: $(htmldir)slib.pdf xpdf -z 3 $(htmldir)slib.pdf TEXI2HTML = /usr/local/bin/texi2html -split -verbose -slib_toc.html: $(txifiles) version.txi slib.texi schmooz.texi +slib_toc.html: version.txi slib.texi $(txifiles) $(texifiles) ${TEXI2HTML} slib.texi html: $(htmldir)slib_toc.html $(htmldir)slib_toc.html: slib_toc.html Makefile @@ -195,7 +222,7 @@ $(htmldir)slib_toc.html: slib_toc.html Makefile then hitch $(PREVDOCS)slib_\*.html slib_\*.html $(htmldir); \ else cp slib_*.html $(htmldir);fi -slib$(VERSION).info: $(txifiles) version.txi slib.texi schmooz.texi +slib$(VERSION).info: version.txi slib.texi $(txifiles) $(texifiles) makeinfo slib.texi --no-warn --no-split -o slib.info mv slib.info slib$(VERSION).info slib.info: slib$(VERSION).info @@ -205,7 +232,7 @@ slib.info: slib$(VERSION).info info: installinfo installinfo: $(infodir)slib.info $(infodir)slib.info: slib.info - cp -a slib.info $(infodir)slib.info + cp -p slib.info $(infodir)slib.info -install-info $(infodir)slib.info $(infodir)dir -rm $(infodir)slib.info.gz infoz: installinfoz @@ -215,9 +242,11 @@ $(infodir)slib.info.gz: $(infodir)slib.info makedev = make -f $(HOME)/makefile.dev CHPAT=$(HOME)/bin/chpat -RSYNC=rsync -avessh +RSYNC=rsync --rsync-path=bin/rsync -bav UPLOADEE=swissnet_upload dest = $(HOME)/dist/ +DOSCM = /misc/usb1/scm/ + temp/slib: $(allfiles) -rm -rf temp mkdir temp @@ -230,6 +259,7 @@ infotemp/slib: slib.info mkdir infotemp/slib ln slib.info slib.info-* infotemp/slib #For change-barred HTML. +prevdocs: $(PREVDOCS)slib_toc.html $(PREVDOCS)slib.info $(PREVDOCS)slib_toc.html: $(PREVDOCS)slib.info: srcdir.mk Makefile cd $(PREVDOCS); unzip -ao $(dest)slib*.zip @@ -282,7 +312,7 @@ $(dest)slib$(VERSION).tar.gz: temp/slib rpm: pubzip #$(dest)slib-$(VERSION)-$(RELEASE).noarch.rpm: $(dest)slib$(VERSION).zip cp $(HOME)/pub/slib.zip $(rpm_prefix)SOURCES/slib$(VERSION).zip - rpm -ba slib.spec # --clean + rpmbuild -ba slib.spec # --clean rm $(rpm_prefix)SOURCES/slib$(VERSION).zip mv $(rpm_prefix)RPMS/noarch/slib-$(VERSION)-$(RELEASE).noarch.rpm \ $(rpm_prefix)SRPMS/slib-$(VERSION)-$(RELEASE).src.rpm $(dest) @@ -297,10 +327,10 @@ slib.com: temp/slib zip: slib.zip slib.zip: temp/slib $(makedev) DEST=../ PROD=slib zip -doszip: /c/scm/dist/slib$(VERSION).zip -/c/scm/dist/slib$(VERSION).zip: temp/slib - $(makedev) DEST=/c/scm/dist/ PROD=slib ver=$(VERSION) zip - zip -d /c/scm/dist/slib$(VERSION).zip slib/slib.info +doszip: $(DOSCM)dist/slib$(VERSION).zip +$(DOSCM)dist/slib$(VERSION).zip: temp/slib + $(makedev) DEST=$(DOSCM)dist/ PROD=slib ver=$(VERSION) zip + zip -d $(DOSCM)dist/slib$(VERSION).zip slib/slib.info pubzip: temp/slib $(makedev) DEST=$(HOME)/pub/ PROD=slib zip @@ -343,8 +373,8 @@ new: $(htmldir)JACAL.html \ $(htmldir)SCM.html \ $(htmldir)SIMSYNCH.html ../scm/scm.texi \ - /c/scm/dist/install.bat /c/scm/dist/makefile \ - /c/scm/dist/mkdisk.bat + $(DOSCM)dist/install.bat $(DOSCM)dist/makefile \ + $(DOSCM)dist/mkdisk.bat $(CHPAT) slib-$(VERSION) slib-$(ver) ANNOUNCE FAQ ../scm/ANNOUNCE \ ../jacal/ANNOUNCE ../wb/README ../wb/ANNOUNCE \ ../synch/ANNOUNCE \ @@ -352,14 +382,14 @@ new: $(htmldir)JACAL.html \ $(htmldir)SCM.html \ $(htmldir)SIMSYNCH.html ../scm/scm.texi \ - /c/scm/dist/install.bat /c/scm/dist/makefile \ - /c/scm/dist/mkdisk.bat + $(DOSCM)dist/install.bat $(DOSCM)dist/makefile \ + $(DOSCM)dist/mkdisk.bat $(CHPAT) $(VERSION) $(ver) README slib.texi require.scm Makefile \ - $(htmldir)SLIB.html slib.spec scheme48.init s48-0_57.init + $(htmldir)SLIB.html slib.spec scheme48.init cvs commit -lm '(*SLIB-VERSION*): Bumped from $(VERSION) to $(ver).' cvs tag -lF slib$(ver) -tagfiles = README version.txi slib.texi \ +tagfiles = README version.txi slib.texi $(texifiles) \ $(mkfiles) $(sfiles) $(bfiles) $(tfiles) $(ifiles) # README and $(ifiles) cause semgentation faults in ETAGS for Emacs version 19. tags: $(tagfiles) @@ -1,10 +1,10 @@ -This directory contains the distribution of Scheme Library slib3a1. +This directory contains the distribution of Scheme Library slib3a2. Slib conforms to Revised^5 Report on the Algorithmic Language Scheme and the IEEE P1178 specification. Slib supports Unix and similar systems, VMS, and MS-DOS. The maintainer can be reached at agj @ alum.mit.edu. - http://swissnet.ai.mit.edu/~jaffer/SLIB.html + http://swiss.csail.mit.edu/~jaffer/SLIB.html MANIFEST @@ -27,7 +27,6 @@ The maintainer can be reached at agj @ alum.mit.edu. `RScheme.init' is a configuration file for RScheme. `scheme2c.init' is a configuration file for DEC's scheme->c. `scheme48.init' is a configuration file for Scheme48. - `s48-0_57.init is a configuration file for Scheme48-0.57. `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. @@ -35,6 +34,7 @@ The maintainer can be reached at agj @ alum.mit.edu. `umbscheme.init' is a configuration file for umb-scheme. `vscm.init' is a configuration file for VSCM. `guile.init' is a configuration file for guile. + `jscheme.init' is a configuration file for JScheme. `mklibcat.scm' builds the *catalog* cache. `require.scm' has code which allows system independent access to the library files. @@ -47,6 +47,8 @@ The maintainer can be reached at agj @ alum.mit.edu. `strcase.scm' has functions for manipulating the case of strings. `genwrite.scm' has a generic-write which is used by pp.scm, pp2str.scm and obj2str.scm + `format.scm' has Common-Lisp format. + `formatst.scm' tests format. `printf.scm' has printf, fprintf, and sprintf compatible with C. `scanf.scm' has scanf, fscanf, and sscanf compatible by C. `lineio' has line oriented input/output functions. @@ -62,7 +64,8 @@ The maintainer can be reached at agj @ alum.mit.edu. `hash.scm' defines hash, hashq, and hashv. `hashtab.scm' has hash tables. `sierpinski.scm' 2-dimensional coordinate hash. - `phil-spc.scm' Peano-Hilbert Space-Filling Curve. + `phil-spc.scm' Hilbert Space-Filling Curve. + `peanosfc.scm' Peano Space-Filling Curve. `soundex.scm' English name hash. `logical.scm' emulates 2's complement logical operations. `random.scm' has random number generator compatible with Common Lisp. @@ -86,8 +89,11 @@ The maintainer can be reached at agj @ alum.mit.edu. `color.scm' has color data-type. `cie1931.xyz' CIE XYZ(1931) Spectra from 380.nm to 780.nm. `cie1964.xyz' CIE XYZ(1964) Spectra from 380.nm to 780.nm. + `ciesia.dat' CIE Standard Illuminant A relative spectral power distribution + `ciesid65.dat' CIE Standard Illuminant D65 relative spectral power distribution `daylight.scm' Model of sky colors. `getopt.scm' has posix-like getopt for parsing command line arguments. + `timecore.scm' has shared 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. @@ -202,7 +208,7 @@ The maintainer can be reached at agj @ alum.mit.edu. Unpacking the SLIB Distribution ------------------------------- - If the SLIB distribution is a Linux RPM, it will create the SLIB +If the SLIB distribution is a Linux RPM, it will create the SLIB directory `/usr/share/slib'. If the SLIB distribution is a ZIP file, unzip the distribution to @@ -216,7 +222,7 @@ please inform agj @ alum.mit.edu. Configure Scheme Implementation to Locate SLIB ---------------------------------------------- - If the Scheme implementation supports `getenv', then the value of the +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'. Scheme48 @@ -229,7 +235,7 @@ initialization file or by implementation-specific means. Loading SLIB Initialization File -------------------------------- - Check the manifest in `README' to find a configuration file for your +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. @@ -244,9 +250,9 @@ implementation to `load' this initialization file. Build New SLIB Catalog for Implementation ----------------------------------------- - When SLIB is first used from an implementation, a file named -`slibcat' is written to the `implementation-vicinity' for that -implementation. Because users may lack permission to write in +When SLIB is first used from an implementation, a file named `slibcat' +is written to the `implementation-vicinity' for that implementation. +Because users may lack permission to write in `implementation-vicinity', it is good practice to build the new catalog when installing SLIB. @@ -265,9 +271,9 @@ SLIB-installed scheme implementation, type: Implementation-specific Instructions ------------------------------------ - Multiple implementations of Scheme can all use the same SLIB -directory. Simply configure each implementation's initialization file -as outlined above. +Multiple implementations of Scheme can all use the same SLIB directory. +Simply configure each implementation's initialization file as outlined +above. - Implementation: SCM The SCM implementation does not require any initialization file as @@ -328,7 +334,7 @@ as outlined above. PORTING INSTRUCTIONS - If there is no initialization file for your Scheme implementation, you +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', @@ -348,8 +354,8 @@ library; this will allow the use of `provide', `provided?', and `require' along with the "vicinity" functions. The rest of the library will then be accessible in a system independent fashion. - Please mail new working configuration files to `agj @ alum.mit.edu' so -that they can be included in the SLIB distribution. + Please mail new working configuration files to `agj @ alum.mit.edu' +so that they can be included in the SLIB distribution. USING SLIB @@ -361,4 +367,4 @@ as well by using, for example, `(provided? 'r3rs)' or `(require 'r3rs)'. The first chapter of the SLIB manual "The Library System" explains the mechanics of using SLIB modules. - http://swissnet.ai.mit.edu/~jaffer/slib_1 + http://swiss.csail.mit.edu/~jaffer/slib_1 diff --git a/RScheme.init b/RScheme.init index b9a7d84..d04e4dc 100644 --- a/RScheme.init +++ b/RScheme.init @@ -66,76 +66,146 @@ home (string-append home "/"))) (else home))))) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: - +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to -; eval ;R5RS two-argument eval -; values ;R5RS multiple values -; dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; r5rs ;conforms to +;;; eval ;R5RS two-argument eval +;;; values ;R5RS multiple values +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. char-ready? -; rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. +;;; rationalize +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to ieee-p1178 ;conforms to -; r3rs ;conforms to +;;; r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; ieee-floating-point ;conforms to IEEE Standard 754-1985 + full-continuation ;can return multiple times +;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. -; defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort -; pretty-print -; object->string -; format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor -; system ;posix (system <string>) +;;; sort +;;; pretty-print +;;; object->string +;;; format ;Common-lisp output formatting +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features @@ -254,18 +324,7 @@ (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))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -295,10 +354,8 @@ ;(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. +;;; return if exiting not supported. (define slib:exit (lambda args (process-exit 0))) ;;; Here for backward compatability @@ -47,75 +47,147 @@ home (string-append home "/"))) (else home))))) - -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") + ;(SLIB:LOAD-SOURCE "filename") compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to +;;; r5rs ;conforms to eval ;R5RS two-argument eval -; values ;R5RS multiple values +;;; values ;R5RS multiple values dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. -; char-ready? -; rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! +;;; char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. +;;; rationalize +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to ieee-p1178 ;conforms to -; r3rs ;conforms to +;;; r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + full-continuation ;can return multiple times ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. -; defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort -; pretty-print -; object->string -; format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) +;;; sort +;;; pretty-print +;;; object->string +;;; format ;Common-lisp output formatting +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features @@ -210,18 +282,7 @@ (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))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -244,10 +305,8 @@ ;;; they are not already defined. (define -1+ 1-) -(define in-vicinity string-append) - ;;; Define SLIB:EXIT to be the implementation procedure to exit or -;;; return if exitting not supported. +;;; return if exiting not supported. (define slib:exit exit) ;;; Here for backward compatability diff --git a/Template.scm b/Template.scm index 63c10c9..b35f8e5 100644 --- a/Template.scm +++ b/Template.scm @@ -58,16 +58,88 @@ (string-append home "/"))) (else home))))) -;;@ *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. r5rs ;conforms to eval ;R5RS two-argument eval @@ -77,55 +149,56 @@ delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + +;;; multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF +;;; with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to ieee-p1178 ;conforms to -; r3rs ;conforms to +;;; r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH -; multiarg/and- ;/ and - can take more than 2 args. -; with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + full-continuation ;can return multiple times ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. -; defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures -; string-port ;has CALL-WITH-INPUT-STRING and +;;; defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures +;;; string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort -; pretty-print -; object->string -; format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor -; system ;posix (system <string>) +;;; sort +;;; pretty-print +;;; object->string +;;; format ;Common-lisp output formatting +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features @@ -224,18 +297,7 @@ ;@ (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))))) +;; slib:eval-load definition moved to "require.scm" ;@ (define slib:warn (lambda args @@ -295,11 +357,8 @@ ;(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. +;;; return if exiting not supported. (define slib:exit (lambda args #f)) ;;@ Here for backward compatability @@ -1,5 +1,5 @@ ;;;"alist.scm", alist functions for Scheme. -;;;Copyright (c) 1992, 1993, 2003 Aubrey Jaffer +;;;Copyright (C) 1992, 1993, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -20,6 +20,7 @@ argument or @code{#f} if no key in the alist is @var{pred}-equal to the first argument. @end defun + @defun alist-inquirer pred Returns a procedure of 2 arguments, @var{alist} and @var{key}, which @@ -27,6 +28,7 @@ returns the value associated with @var{key} in @var{alist} or @code{#f} if @var{key} does not appear in @var{alist}. @end defun + @defun alist-associator pred Returns a procedure of 3 arguments, @var{alist}, @var{key}, and @@ -42,6 +44,7 @@ lost. This returned procedure may or may not have side effects on its @end lisp @end defun + @defun alist-remover pred Returns a procedure of 2 arguments, @var{alist} and @var{key}, which @@ -55,6 +58,7 @@ This returned procedure may or may not have side effects on its @end lisp @end defun + @defun alist-map proc alist Returns a new association list formed by mapping @var{proc} over the @@ -62,9 +66,11 @@ keys and values of @var{alist}. @var{proc} must be a function of 2 arguments which returns the new value part. @end defun + @defun alist-for-each proc alist Applies @var{proc} to each pair of keys and values of @var{alist}. @var{proc} must be a function of 2 arguments. The returned value is unspecified. @end defun + @@ -1,5 +1,5 @@ ;;;;"array.scm" Arrays for Scheme -; Copyright (C) 2001, 2003 Aubrey Jaffer +; Copyright (C) 2001, 2003, 2005 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -17,25 +17,25 @@ ;promotional, or sales literature without prior written consent in ;each case. -;;@code{(require 'array)} +;;@code{(require 'array)} or @code{(require 'srfi-63)} ;;@ftindex array (require 'record) (define array:rtd (make-record-type "array" - '(shape + '(dimensions scales ;list of dimension scales offset ;exact integer store ;data ))) -(define array:shape - (let ((shape (record-accessor array:rtd 'shape))) +(define array:dimensions + (let ((dimensions (record-accessor array:rtd 'dimensions))) (lambda (array) - (cond ((vector? array) (list (list 0 (+ -1 (vector-length array))))) - ((string? array) (list (list 0 (+ -1 (string-length array))))) - (else (shape array)))))) + (cond ((vector? array) (list (vector-length array))) + ((string? array) (list (string-length array))) + (else (dimensions array)))))) (define array:scales (let ((scales (record-accessor array:rtd 'scales))) @@ -59,7 +59,7 @@ (else (offset obj)))))) (define array:construct - (record-constructor array:rtd '(shape scales offset store))) + (record-constructor array:rtd '(dimensions scales offset store))) ;;@args obj ;;Returns @code{#t} if the @1 is an array, and @code{#f} if not. @@ -68,9 +68,9 @@ (lambda (obj) (or (string? obj) (vector? obj) (array:array? obj))))) ;;@noindent -;;@emph{Note:} Arrays are not disjoint from other Scheme types. Strings -;;and vectors also satisfy @code{array?}. A disjoint array predicate can -;;be written: +;;@emph{Note:} Arrays are not disjoint from other Scheme types. +;;Vectors and possibly strings also satisfy @code{array?}. +;;A disjoint array predicate can be written: ;; ;;@example ;;(define (strict-array? obj) @@ -78,159 +78,106 @@ ;;@end example ;;@body -;;Returns @code{#t} if @1 and @2 have the same rank and shape and the +;;Returns @code{#t} if @1 and @2 have the same rank and dimensions and the ;;corresponding elements of @1 and @2 are @code{equal?}. + +;;@body +;;@0 recursively compares the contents of pairs, vectors, strings, and +;;@emph{arrays}, applying @code{eqv?} on other objects such as numbers +;;and symbols. A rule of thumb is that objects are generally @0 if +;;they print the same. @0 may fail to terminate if its arguments are +;;circular data structures. ;; ;;@example -;;(array=? (create-array '#(foo) 3 3) -;; (create-array '#(foo) '(0 2) '(0 2))) -;; @result{} #t +;;(equal? 'a 'a) @result{} #t +;;(equal? '(a) '(a)) @result{} #t +;;(equal? '(a (b) c) +;; '(a (b) c)) @result{} #t +;;(equal? "abc" "abc") @result{} #t +;;(equal? 2 2) @result{} #t +;;(equal? (make-vector 5 'a) +;; (make-vector 5 'a)) @result{} #t +;;(equal? (make-array (A:fixN32b 4) 5 3) +;; (make-array (A:fixN32b 4) 5 3)) @result{} #t +;;(equal? (make-array '#(foo) 3 3) +;; (make-array '#(foo) 3 3)) @result{} #t +;;(equal? (lambda (x) x) +;; (lambda (y) y)) @result{} @emph{unspecified} ;;@end example -(define (array=? array1 array2) - (and (equal? (array:shape array1) (array:shape array2)) - (equal? (array:store array1) (array:store array2)))) +(define (equal? obj1 obj2) + (cond ((eqv? obj1 obj2) #t) + ((or (pair? obj1) (pair? obj2)) + (and (pair? obj1) (pair? obj2) + (equal? (car obj1) (car obj2)) + (equal? (cdr obj1) (cdr obj2)))) + ((or (string? obj1) (string? obj2)) + (and (string? obj1) (string? obj2) + (string=? obj1 obj2))) + ((or (vector? obj1) (vector? obj2)) + (and (vector? obj1) (vector? obj2) + (equal? (vector-length obj1) (vector-length obj2)) + (do ((idx (+ -1 (vector-length obj1)) (+ -1 idx))) + ((or (negative? idx) + (not (equal? (vector-ref obj1 idx) + (vector-ref obj2 idx)))) + (negative? idx))))) + ((or (array? obj1) (array? obj2)) + (and (array? obj1) (array? obj2) + (equal? (array:dimensions obj1) (array:dimensions obj2)) + (equal? (array:store obj1) (array:store obj2)))) + (else #f))) -(define (array:dimensions->shape dims) - (map (lambda (dim) (if (list? dim) dim (list 0 (+ -1 dim)))) dims)) +;;@body +;;Returns the number of dimensions of @1. If @1 is not an array, 0 is +;;returned. +(define (array-rank obj) + (if (array? obj) (length (array:dimensions obj)) 0)) + +;;@args array +;;Returns a list of dimensions. +;; +;;@example +;;(array-dimensions (make-array '#() 3 5)) +;; @result{} (3 5) +;;@end example +(define array-dimensions array:dimensions) -;;@args prototype bound1 bound2 @dots{} +;;@args prototype k1 @dots{} ;; -;;Creates and returns an array of type @1 with dimensions @2, @3, -;;@dots{} and filled with elements from @1. @1 must be an array, -;;vector, or string. The implementation-dependent type of the returned -;;array will be the same as the type of @1; except if that would be a -;;vector or string with non-zero origin, in which case some variety of +;;Creates and returns an array of type @1 with dimensions @2, @dots{} +;;and filled with elements from @1. @1 must be an array, vector, or +;;string. The implementation-dependent type of the returned array +;;will be the same as the type of @1; except if that would be a vector +;;or string with rank not equal to one, in which case some variety of ;;array will be returned. ;; ;;If the @1 has no elements, then the initial contents of the returned ;;array are unspecified. Otherwise, the returned array will be filled ;;with the element at the origin of @1. -(define (create-array prototype . dimensions) - (define range2length (lambda (bnd) (- 1 (apply - bnd)))) - ;;(if (not (array? prototype)) (set! prototype (vector prototype))) - (let* ((shape (array:dimensions->shape dimensions)) - (dims (map range2length shape)) - (scales - (do ((dims (reverse (cdr dims)) (cdr dims)) - (scls '(1) (cons (* (car dims) (car scls)) scls))) - ((null? dims) scls)))) - (array:construct - shape - scales - (- (apply + (map * (map car shape) scales))) - (if (string? prototype) - (case (string-length prototype) - ((0) (make-string (apply * dims))) - (else (make-string (apply * dims) - (string-ref prototype 0)))) - (let ((pshape (array:shape prototype))) - (case (apply * (map range2length pshape)) - ((0) (make-vector (apply * dims))) - (else (make-vector (apply * dims) - (apply array-ref prototype - (map car pshape)))))))))) - -;;@noindent -;;These functions return a prototypical uniform-array enclosing the -;;optional argument (which must be of the correct type). If the -;;uniform-array type is supported by the implementation, then it is -;;returned; defaulting to the next larger precision type; resorting -;;finally to vector. - -(define (make-prototype-checker name pred? creator) - (lambda args - (case (length args) - ((1) (if (pred? (car args)) - (creator (car args)) - (slib:error name 'incompatible 'type (car args)))) - ((0) (creator)) - (else (slib:error name 'wrong 'number 'of 'args args))))) - -(define (integer-bytes?? n) - (lambda (obj) - (and (integer? obj) - (exact? obj) - (or (negative? n) (not (negative? obj))) - (do ((num obj (quotient num 256)) - (n (+ -1 (abs n)) (+ -1 n))) - ((or (zero? num) (negative? n)) - (zero? num)))))) - -;;@args z -;;@args -;;Returns a high-precision complex uniform-array prototype. -(define Ac64 (make-prototype-checker 'Ac64 complex? vector)) -;;@args z -;;@args -;;Returns a complex uniform-array prototype. -(define Ac32 (make-prototype-checker 'Ac32 complex? vector)) - -;;@args x -;;@args -;;Returns a high-precision real uniform-array prototype. -(define Ar64 (make-prototype-checker 'Ar64 real? vector)) -;;@args x -;;@args -;;Returns a real uniform-array prototype. -(define Ar32 (make-prototype-checker 'Ar32 real? vector)) - -;;@args n -;;@args -;;Returns an exact signed integer uniform-array prototype with at least -;;64 bits of precision. -(define As64 (make-prototype-checker 'As64 (integer-bytes?? -8) vector)) -;;@args n -;;@args -;;Returns an exact signed integer uniform-array prototype with at least -;;32 bits of precision. -(define As32 (make-prototype-checker 'As32 (integer-bytes?? -4) vector)) -;;@args n -;;@args -;;Returns an exact signed integer uniform-array prototype with at least -;;16 bits of precision. -(define As16 (make-prototype-checker 'As16 (integer-bytes?? -2) vector)) -;;@args n -;;@args -;;Returns an exact signed integer uniform-array prototype with at least -;;8 bits of precision. -(define As8 (make-prototype-checker 'As8 (integer-bytes?? -1) vector)) - -;;@args k -;;@args -;;Returns an exact non-negative integer uniform-array prototype with at -;;least 64 bits of precision. -(define Au64 (make-prototype-checker 'Au64 (integer-bytes?? 8) vector)) -;;@args k -;;@args -;;Returns an exact non-negative integer uniform-array prototype with at -;;least 32 bits of precision. -(define Au32 (make-prototype-checker 'Au32 (integer-bytes?? 4) vector)) -;;@args k -;;@args -;;Returns an exact non-negative integer uniform-array prototype with at -;;least 16 bits of precision. -(define Au16 (make-prototype-checker 'Au16 (integer-bytes?? 2) vector)) -;;@args k -;;@args -;;Returns an exact non-negative integer uniform-array prototype with at -;;least 8 bits of precision. -(define Au8 (make-prototype-checker 'Au8 (integer-bytes?? 1) vector)) - -;;@args bool -;;@args -;;Returns a boolean uniform-array prototype. -(define At1 (make-prototype-checker 'At1 boolean? vector)) - -;;@noindent -;;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 -;; -;;@example -;;(create-array '#(foo) 3 3) @equiv{} (create-array '#(foo) '(0 2) '(0 2)) -;;@end example - -;;@args array mapper bound1 bound2 @dots{} +(define (make-array prototype . dimensions) + (define tcnt (apply * dimensions)) + (let ((store + (if (string? prototype) + (case (string-length prototype) + ((0) (make-string tcnt)) + (else (make-string tcnt + (string-ref prototype 0)))) + (let ((pdims (array:dimensions prototype))) + (case (apply * pdims) + ((0) (make-vector tcnt)) + (else (make-vector tcnt + (apply array-ref prototype + (map (lambda (x) 0) pdims))))))))) + (define (loop dims scales) + (if (null? dims) + (array:construct dimensions (cdr scales) 0 store) + (loop (cdr dims) (cons (* (car dims) (car scales)) scales)))) + (loop (reverse dimensions) '(1)))) +;;@args prototype k1 @dots{} +;;@0 is an alias for @code{make-array}. +(define create-array make-array) + +;;@args array mapper k1 @dots{} ;;@0 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 @@ -238,7 +185,7 @@ ;;it can be otherwise arbitrary. A simple example: ;; ;;@example -;;(define fred (create-array '#(#f) 8 8)) +;;(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) @@ -253,68 +200,149 @@ (define (make-shared-array array mapper . dimensions) (define odl (array:scales array)) (define rank (length dimensions)) - (define shape (array:dimensions->shape dimensions)) + (define shape + (map (lambda (dim) (if (list? dim) dim (list 0 (+ -1 dim)))) dimensions)) (do ((idx (+ -1 rank) (+ -1 idx)) (uvt (append (cdr (vector->list (make-vector rank 0))) '(1)) (append (cdr uvt) '(0))) (uvts '() (cons uvt uvts))) ((negative? idx) - (let* ((ker0 (apply + (map * odl (apply mapper uvt)))) - (scales (map (lambda (uvt) - (- (apply + (map * odl (apply mapper uvt))) ker0)) - uvts))) + (let ((ker0 (apply + (map * odl (apply mapper uvt))))) (array:construct - shape - scales - (- (apply + (array:offset array) - (map * odl (apply mapper (map car shape)))) - (apply + (map * (map car shape) scales))) + (map (lambda (dim) (+ 1 (- (cadr dim) (car dim)))) shape) + (map (lambda (uvt) (- (apply + (map * odl (apply mapper uvt))) ker0)) + uvts) + (apply + + (array:offset array) + (map * odl (apply mapper (map car shape)))) (array:store array)))))) -;;@body -;;Returns the number of dimensions of @1. If @1 is not an array, 0 is -;;returned. -(define (array-rank obj) - (if (array? obj) (length (array:shape obj)) 0)) +;;@args rank proto list +;;@3 must be a rank-nested list consisting of all the elements, in +;;row-major order, of the array to be created. +;; +;;@0 returns an array of rank @1 and type @2 consisting of all the +;;elements, in row-major order, of @3. When @1 is 0, @3 is the lone +;;array element; not necessarily a list. +;; +;;@example +;;(list->array 2 '#() '((1 2) (3 4))) +;; @result{} #2A((1 2) (3 4)) +;;(list->array 0 '#() 3) +;; @result{} #0A 3 +;;@end example +(define (list->array rank proto lst) + (define dimensions + (do ((shp '() (cons (length row) shp)) + (row lst (car lst)) + (rnk (+ -1 rank) (+ -1 rnk))) + ((negative? rnk) (reverse shp)))) + (let ((nra (apply make-array proto dimensions))) + (define (l2ra dims idxs row) + (cond ((null? dims) + (apply array-set! nra row (reverse idxs))) + ((if (not (eqv? (car dims) (length row))) + (slib:error 'list->array + 'non-rectangular 'array dims dimensions)) + (do ((idx 0 (+ 1 idx)) + (row row (cdr row))) + ((>= idx (car dims))) + (l2ra (cdr dims) (cons idx idxs) (car row)))))) + (l2ra dimensions '() lst) + nra)) ;;@args array -;;Returns a list of inclusive bounds. +;;Returns a rank-nested list consisting of all the elements, in +;;row-major order, of @1. In the case of a rank-0 array, @0 returns +;;the single element. +;; +;;@example +;;(array->list #2A((ho ho ho) (ho oh oh))) +;; @result{} ((ho ho ho) (ho oh oh)) +;;(array->list #0A ho) +;; @result{} ho +;;@end example +(define (array->list ra) + (define (ra2l dims idxs) + (if (null? dims) + (apply array-ref ra (reverse idxs)) + (do ((lst '() (cons (ra2l (cdr dims) (cons idx idxs)) lst)) + (idx (+ -1 (car dims)) (+ -1 idx))) + ((negative? idx) lst)))) + (ra2l (array-dimensions ra) '())) + +;;@args vect proto dim1 @dots{} +;;@1 must be a vector of length equal to the product of exact +;;nonnegative integers @3, @dots{}. +;; +;;@0 returns an array of type @2 consisting of all the elements, in +;;row-major order, of @1. In the case of a rank-0 array, @1 has a +;;single element. ;; ;;@example -;;(array-shape (create-array '#() 3 5)) -;; @result{} ((0 2) (0 4)) +;;(vector->array #(1 2 3 4) #() 2 2) +;; @result{} #2A((1 2) (3 4)) +;;(vector->array '#(3) '#()) +;; @result{} #0A 3 ;;@end example -(define array-shape array:shape) +(define (vector->array vect prototype . dimensions) + (define vdx (vector-length vect)) + (if (not (eqv? vdx (apply * dimensions))) + (slib:error 'vector->array vdx '<> (cons '* dimensions))) + (let ((ra (apply make-array prototype dimensions))) + (define (v2ra dims idxs) + (cond ((null? dims) + (set! vdx (+ -1 vdx)) + (apply array-set! ra (vector-ref vect vdx) (reverse idxs))) + (else + (do ((idx (+ -1 (car dims)) (+ -1 idx))) + ((negative? idx) vect) + (v2ra (cdr dims) (cons idx idxs)))))) + (v2ra dimensions '()) + ra)) -;;@body -;;@code{array-dimensions} is similar to @code{array-shape} but replaces -;;elements with a 0 minimum with one greater than the maximum. +;;@args array +;;Returns a new vector consisting of all the elements of @1 in +;;row-major order. ;; ;;@example -;;(array-dimensions (create-array '#() 3 5)) -;; @result{} (3 5) +;;(array->vector #2A ((1 2)( 3 4))) +;; @result{} #(1 2 3 4) +;;(array->vector #0A ho) +;; @result{} #(ho) ;;@end example -(define (array-dimensions array) - (map (lambda (bnd) (if (zero? (car bnd)) (+ 1 (cadr bnd)) bnd)) - (array:shape array))) +(define (array->vector ra) + (define dims (array-dimensions ra)) + (let* ((vdx (apply * dims)) + (vect (make-vector vdx))) + (define (ra2v dims idxs) + (if (null? dims) + (let ((val (apply array-ref ra (reverse idxs)))) + (set! vdx (+ -1 vdx)) + (vector-set! vect vdx val) + vect) + (do ((idx (+ -1 (car dims)) (+ -1 idx))) + ((negative? idx) vect) + (ra2v (cdr dims) (cons idx idxs))))) + (ra2v dims '()))) (define (array:in-bounds? array indices) - (do ((bnds (array:shape array) (cdr bnds)) + (do ((bnds (array:dimensions array) (cdr bnds)) (idxs indices (cdr idxs))) ((or (null? bnds) (null? idxs) (not (integer? (car idxs))) - (not (<= (caar bnds) (car idxs) (cadar bnds)))) + (not (< -1 (car idxs) (car bnds)))) (and (null? bnds) (null? idxs))))) -;;@args array index1 index2 @dots{} +;;@args array index1 @dots{} ;;Returns @code{#t} if its arguments would be acceptable to ;;@code{array-ref}. (define (array-in-bounds? array . indices) (array:in-bounds? array indices)) -;;@args array index1 index2 @dots{} -;;Returns the (@2, @3, @dots{}) element of @1. +;;@args array k1 @dots{} +;;Returns the (@2, @dots{}) element of @1. (define (array-ref array . indices) (define store (array:store array)) (or (array:in-bounds? array indices) @@ -322,8 +350,8 @@ ((if (string? store) string-ref vector-ref) store (apply + (array:offset array) (map * (array:scales array) indices)))) -;;@args array obj index1 index2 @dots{} -;;Stores @2 in the (@3, @4, @dots{}) element of @1. The value returned +;;@args array obj k1 @dots{} +;;Stores @2 in the (@3, @dots{}) element of @1. The value returned ;;by @0 is unspecified. (define (array-set! array obj . indices) (define store (array:store array)) @@ -333,10 +361,122 @@ store (apply + (array:offset array) (map * (array:scales array) indices)) obj)) -;;; Legacy functions +;;@noindent +;;These functions return a prototypical uniform-array enclosing the +;;optional argument (which must be of the correct type). If the +;;uniform-array type is supported by the implementation, then it is +;;returned; defaulting to the next larger precision type; resorting +;;finally to vector. + +(define (make-prototype-checker name pred? creator) + (lambda args + (case (length args) + ((1) (if (pred? (car args)) + (creator (car args)) + (slib:error name 'incompatible 'type (car args)))) + ((0) (creator)) + (else (slib:error name 'wrong 'number 'of 'args args))))) + +(define (integer-bytes?? n) + (lambda (obj) + (and (integer? obj) + (exact? obj) + (or (negative? n) (not (negative? obj))) + (do ((num obj (quotient num 256)) + (n (+ -1 (abs n)) (+ -1 n))) + ((or (zero? num) (negative? n)) + (zero? num)))))) + +;;@args z +;;@args +;;Returns an inexact 128.bit flonum complex uniform-array prototype. +(define A:floC128b (make-prototype-checker 'A:floC128b complex? vector)) +;;@args z +;;@args +;;Returns an inexact 64.bit flonum complex uniform-array prototype. +(define A:floC64b (make-prototype-checker 'A:floC64b complex? vector)) +;;@args z +;;@args +;;Returns an inexact 32.bit flonum complex uniform-array prototype. +(define A:floC32b (make-prototype-checker 'A:floC32b complex? vector)) +;;@args z +;;@args +;;Returns an inexact 16.bit flonum complex uniform-array prototype. +(define A:floC16b (make-prototype-checker 'A:floC16b complex? vector)) + +;;@args z +;;@args +;;Returns an inexact 128.bit flonum real uniform-array prototype. +(define A:floR128b (make-prototype-checker 'A:floR128b real? vector)) +;;@args z +;;@args +;;Returns an inexact 64.bit flonum real uniform-array prototype. +(define A:floR64b (make-prototype-checker 'A:floR64b real? vector)) +;;@args z +;;@args +;;Returns an inexact 32.bit flonum real uniform-array prototype. +(define A:floR32b (make-prototype-checker 'A:floR32b real? vector)) +;;@args z +;;@args +;;Returns an inexact 16.bit flonum real uniform-array prototype. +(define A:floR16b (make-prototype-checker 'A:floR16b real? vector)) + +;;@args z +;;@args +;;Returns an exact 128.bit decimal flonum rational uniform-array prototype. +(define A:floR128b (make-prototype-checker 'A:floR128b real? vector)) +;;@args z +;;@args +;;Returns an exact 64.bit decimal flonum rational uniform-array prototype. +(define A:floR64b (make-prototype-checker 'A:floR64b real? vector)) +;;@args z +;;@args +;;Returns an exact 32.bit decimal flonum rational uniform-array prototype. +(define A:floR32b (make-prototype-checker 'A:floR32b real? vector)) + +;;@args n +;;@args +;;Returns an exact binary fixnum uniform-array prototype with at least +;;64 bits of precision. +(define A:fixZ64b (make-prototype-checker 'A:fixZ64b (integer-bytes?? -8) vector)) +;;@args n +;;@args +;;Returns an exact binary fixnum uniform-array prototype with at least +;;32 bits of precision. +(define A:fixZ32b (make-prototype-checker 'A:fixZ32b (integer-bytes?? -4) vector)) +;;@args n +;;@args +;;Returns an exact binary fixnum uniform-array prototype with at least +;;16 bits of precision. +(define A:fixZ16b (make-prototype-checker 'A:fixZ16b (integer-bytes?? -2) vector)) +;;@args n +;;@args +;;Returns an exact binary fixnum uniform-array prototype with at least +;;8 bits of precision. +(define A:fixZ8b (make-prototype-checker 'A:fixZ8b (integer-bytes?? -1) vector)) + +;;@args k +;;@args +;;Returns an exact non-negative binary fixnum uniform-array prototype with at +;;least 64 bits of precision. +(define A:fixN64b (make-prototype-checker 'A:fixN64b (integer-bytes?? 8) vector)) +;;@args k +;;@args +;;Returns an exact non-negative binary fixnum uniform-array prototype with at +;;least 32 bits of precision. +(define A:fixN32b (make-prototype-checker 'A:fixN32b (integer-bytes?? 4) vector)) +;;@args k +;;@args +;;Returns an exact non-negative binary fixnum uniform-array prototype with at +;;least 16 bits of precision. +(define A:fixN16b (make-prototype-checker 'A:fixN16b (integer-bytes?? 2) vector)) +;;@args k +;;@args +;;Returns an exact non-negative binary fixnum uniform-array prototype with at +;;least 8 bits of precision. +(define A:fixN8b (make-prototype-checker 'A:fixN8b (integer-bytes?? 1) vector)) -;; ;;@args initial-value bound1 bound2 @dots{} -;; ;;Creates and returns an array with dimensions @2, -;; ;;@3, @dots{} and filled with @1. -;; (define (make-array initial-value . dimensions) -;; (apply create-array (vector initial-value) dimensions)) +;;@args bool +;;@args +;;Returns a boolean uniform-array prototype. +(define A:bool (make-prototype-checker 'A:bool boolean? vector)) @@ -1,4 +1,4 @@ -@code{(require 'array)} +@code{(require 'array)} or @code{(require 'srfi-63)} @ftindex array @@ -6,10 +6,11 @@ Returns @code{#t} if the @var{obj} is an array, and @code{#f} if not. @end defun + @noindent -@emph{Note:} Arrays are not disjoint from other Scheme types. Strings -and vectors also satisfy @code{array?}. A disjoint array predicate can -be written: +@emph{Note:} Arrays are not disjoint from other Scheme types. +Vectors and possibly strings also satisfy @code{array?}. +A disjoint array predicate can be written: @example (define (strict-array? obj) @@ -17,32 +18,184 @@ be written: @end example -@defun array=? array1 array2 +@defun equal? obj1 obj2 + +Returns @code{#t} if @var{obj1} and @var{obj2} have the same rank and dimensions and the +corresponding elements of @var{obj1} and @var{obj2} are @code{equal?}. -Returns @code{#t} if @var{array1} and @var{array2} have the same rank and shape and the -corresponding elements of @var{array1} and @var{array2} are @code{equal?}. +@code{equal?} recursively compares the contents of pairs, vectors, strings, and +@emph{arrays}, applying @code{eqv?} on other objects such as numbers +and symbols. A rule of thumb is that objects are generally @code{equal?} if +they print the same. @code{equal?} may fail to terminate if its arguments are +circular data structures. @example -(array=? (create-array '#(foo) 3 3) - (create-array '#(foo) '(0 2) '(0 2))) - @result{} #t +(equal? 'a 'a) @result{} #t +(equal? '(a) '(a)) @result{} #t +(equal? '(a (b) c) + '(a (b) c)) @result{} #t +(equal? "abc" "abc") @result{} #t +(equal? 2 2) @result{} #t +(equal? (make-vector 5 'a) + (make-vector 5 'a)) @result{} #t +(equal? (make-array (A:fixN32b 4) 5 3) + (make-array (A:fixN32b 4) 5 3)) @result{} #t +(equal? (make-array '#(foo) 3 3) + (make-array '#(foo) 3 3)) @result{} #t +(equal? (lambda (x) x) + (lambda (y) y)) @result{} @emph{unspecified} @end example @end defun -@defun create-array prototype bound1 bound2 @dots{} +@defun array-rank obj + +Returns the number of dimensions of @var{obj}. If @var{obj} is not an array, 0 is +returned. +@end defun + + +@defun array-dimensions array + +Returns a list of dimensions. -Creates and returns an array of type @var{prototype} with dimensions @var{bound1}, @var{bound2}, -@dots{} and filled with elements from @var{prototype}. @var{prototype} must be an array, -vector, or string. The implementation-dependent type of the returned -array will be the same as the type of @var{prototype}; except if that would be a -vector or string with non-zero origin, in which case some variety of +@example +(array-dimensions (make-array '#() 3 5)) + @result{} (3 5) +@end example +@end defun + + +@defun make-array prototype k1 @dots{} + + +Creates and returns an array of type @var{prototype} with dimensions @var{k1}, @dots{} +and filled with elements from @var{prototype}. @var{prototype} must be an array, vector, or +string. The implementation-dependent type of the returned array +will be the same as the type of @var{prototype}; except if that would be a vector +or string with rank not equal to one, in which case some variety of array will be returned. If the @var{prototype} has no elements, then the initial contents of the returned array are unspecified. Otherwise, the returned array will be filled with the element at the origin of @var{prototype}. @end defun + + +@defun create-array prototype k1 @dots{} + +@code{create-array} is an alias for @code{make-array}. +@end defun + + +@defun make-shared-array array mapper k1 @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: + +@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) + @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 example +@end defun + + +@defun list->array rank proto list + +@var{list} must be a rank-nested list consisting of all the elements, in +row-major order, of the array to be created. + +@code{list->array} returns an array of rank @var{rank} and type @var{proto} consisting of all the +elements, in row-major order, of @var{list}. When @var{rank} is 0, @var{list} is the lone +array element; not necessarily a list. + +@example +(list->array 2 '#() '((1 2) (3 4))) + @result{} #2A((1 2) (3 4)) +(list->array 0 '#() 3) + @result{} #0A 3 +@end example +@end defun + + +@defun array->list array + +Returns a rank-nested list consisting of all the elements, in +row-major order, of @var{array}. In the case of a rank-0 array, @code{array->list} returns +the single element. + +@example +(array->list #2A((ho ho ho) (ho oh oh))) + @result{} ((ho ho ho) (ho oh oh)) +(array->list #0A ho) + @result{} ho +@end example +@end defun + + +@defun vector->array vect proto dim1 @dots{} + +@var{vect} must be a vector of length equal to the product of exact +nonnegative integers @var{dim1}, @dots{}. + +@code{vector->array} returns an array of type @var{proto} consisting of all the elements, in +row-major order, of @var{vect}. In the case of a rank-0 array, @var{vect} has a +single element. + +@example +(vector->array #(1 2 3 4) #() 2 2) + @result{} #2A((1 2) (3 4)) +(vector->array '#(3) '#()) + @result{} #0A 3 +@end example +@end defun + + +@defun array->vector array + +Returns a new vector consisting of all the elements of @var{array} in +row-major order. + +@example +(array->vector #2A ((1 2)( 3 4))) + @result{} #(1 2 3 4) +(array->vector #0A ho) + @result{} #(ho) +@end example +@end defun + + +@defun array-in-bounds? array index1 @dots{} + +Returns @code{#t} if its arguments would be acceptable to +@code{array-ref}. +@end defun + + +@defun array-ref array k1 @dots{} + +Returns the (@var{k1}, @dots{}) element of @var{array}. +@end defun + + +@deffn {Procedure} array-set! array obj k1 @dots{} + +Stores @var{obj} in the (@var{k1}, @dots{}) element of @var{array}. The value returned +by @code{array-set!} is unspecified. +@end deffn + @noindent These functions return a prototypical uniform-array enclosing the optional argument (which must be of the correct type). If the @@ -51,177 +204,170 @@ returned; defaulting to the next larger precision type; resorting finally to vector. -@defun ac64 z +@defun a:floc128b z -@defunx ac64 -Returns a high-precision complex uniform-array prototype. +@defunx a:floc128b +Returns an inexact 128.bit flonum complex uniform-array prototype. @end defun -@defun ac32 z + +@defun a:floc64b z -@defunx ac32 -Returns a complex uniform-array prototype. +@defunx a:floc64b +Returns an inexact 64.bit flonum complex uniform-array prototype. @end defun -@defun ar64 x + +@defun a:floc32b z -@defunx ar64 -Returns a high-precision real uniform-array prototype. +@defunx a:floc32b +Returns an inexact 32.bit flonum complex uniform-array prototype. @end defun -@defun ar32 x +@defun a:floc16b z -@defunx ar32 -Returns a real uniform-array prototype. + +@defunx a:floc16b +Returns an inexact 16.bit flonum complex uniform-array prototype. @end defun -@defun as64 n +@defun a:flor128b z -@defunx as64 -Returns an exact signed integer uniform-array prototype with at least -64 bits of precision. + +@defunx a:flor128b +Returns an inexact 128.bit flonum real uniform-array prototype. @end defun -@defun as32 n +@defun a:flor64b z -@defunx as32 -Returns an exact signed integer uniform-array prototype with at least -32 bits of precision. + +@defunx a:flor64b +Returns an inexact 64.bit flonum real uniform-array prototype. @end defun -@defun as16 n +@defun a:flor32b z -@defunx as16 -Returns an exact signed integer uniform-array prototype with at least -16 bits of precision. + +@defunx a:flor32b +Returns an inexact 32.bit flonum real uniform-array prototype. @end defun -@defun as8 n +@defun a:flor16b z -@defunx as8 -Returns an exact signed integer uniform-array prototype with at least -8 bits of precision. + +@defunx a:flor16b +Returns an inexact 16.bit flonum real uniform-array prototype. @end defun -@defun au64 k +@defun a:flor128b z -@defunx au64 -Returns an exact non-negative integer uniform-array prototype with at -least 64 bits of precision. + +@defunx a:flor128b +Returns an exact 128.bit decimal flonum rational uniform-array prototype. @end defun -@defun au32 k +@defun a:flor64b z -@defunx au32 -Returns an exact non-negative integer uniform-array prototype with at -least 32 bits of precision. + +@defunx a:flor64b +Returns an exact 64.bit decimal flonum rational uniform-array prototype. @end defun -@defun au16 k +@defun a:flor32b z -@defunx au16 -Returns an exact non-negative integer uniform-array prototype with at -least 16 bits of precision. + +@defunx a:flor32b +Returns an exact 32.bit decimal flonum rational uniform-array prototype. @end defun -@defun au8 k +@defun a:fixz64b n -@defunx au8 -Returns an exact non-negative integer uniform-array prototype with at -least 8 bits of precision. + +@defunx a:fixz64b +Returns an exact binary fixnum uniform-array prototype with at least +64 bits of precision. @end defun -@defun at1 bool +@defun a:fixz32b n -@defunx at1 -Returns a boolean uniform-array prototype. -@end defun -@noindent -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 -@example -(create-array '#(foo) 3 3) @equiv{} (create-array '#(foo) '(0 2) '(0 2)) -@end example +@defunx a:fixz32b +Returns an exact binary fixnum uniform-array prototype with at least +32 bits of precision. +@end defun -@defun make-shared-array array mapper bound1 bound2 @dots{} +@defun a:fixz16b n -@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: -@example -(define fred (create-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 example +@defunx a:fixz16b +Returns an exact binary fixnum uniform-array prototype with at least +16 bits of precision. @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 a:fixz8b n + + +@defunx a:fixz8b +Returns an exact binary fixnum uniform-array prototype with at least +8 bits of precision. @end defun -@defun array-shape array -Returns a list of inclusive bounds. +@defun a:fixn64b k -@example -(array-shape (create-array '#() 3 5)) - @result{} ((0 2) (0 4)) -@end example + +@defunx a:fixn64b +Returns an exact non-negative binary fixnum uniform-array prototype with at +least 64 bits of precision. @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. +@defun a:fixn32b k -@example -(array-dimensions (create-array '#() 3 5)) - @result{} (3 5) -@end example + +@defunx a:fixn32b +Returns an exact non-negative binary fixnum uniform-array prototype with at +least 32 bits of precision. @end defun -@defun array-in-bounds? array index1 index2 @dots{} -Returns @code{#t} if its arguments would be acceptable to -@code{array-ref}. +@defun a:fixn16b k + + +@defunx a:fixn16b +Returns an exact non-negative binary fixnum uniform-array prototype with at +least 16 bits of precision. @end defun -@defun array-ref array index1 index2 @dots{} -Returns the (@var{index1}, @var{index2}, @dots{}) element of @var{array}. +@defun a:fixn8b k + + +@defunx a:fixn8b +Returns an exact non-negative binary fixnum uniform-array prototype with at +least 8 bits of precision. @end defun -@deffn {Procedure} array-set! array obj index1 index2 @dots{} -Stores @var{obj} in the (@var{index1}, @var{index2}, @dots{}) element of @var{array}. The value returned -by @code{array-set!} is unspecified. -@end deffn +@defun a:bool bool + + +@defunx a:bool +Returns a boolean uniform-array prototype. +@end defun + diff --git a/arraymap.scm b/arraymap.scm index 747962e..2c88eb8 100644 --- a/arraymap.scm +++ b/arraymap.scm @@ -1,5 +1,5 @@ ;;;; "arraymap.scm", applicative routines for arrays in Scheme. -;;; Copyright (c) 1993, 2003 Aubrey Jaffer +;;; Copyright (C) 1993, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -30,21 +30,20 @@ ;;as the corresponding element in @var{array0}. The value returned is ;;unspecified. The order of application is unspecified. (define (array-map! ra0 proc . ras) - (define (ramap rshape inds) - (if (null? (cdr rshape)) - (do ((i (cadar rshape) (+ -1 i)) - (is (cons (cadar rshape) inds) + (define (ramap rdims inds) + (if (null? (cdr rdims)) + (do ((i (+ -1 (car rdims)) (+ -1 i)) + (is (cons (+ -1 (car rdims)) inds) (cons (+ -1 i) inds))) - ((< i (caar rshape))) + ((negative? i)) (apply array-set! ra0 (apply proc (map (lambda (ra) (apply array-ref ra is)) ras)) is)) - (let ((crshape (cdr rshape)) - (ll (caar rshape))) - (do ((i (cadar rshape) (+ -1 i))) - ((< i ll)) - (ramap crshape (cons i inds)))))) - (ramap (reverse (array-shape ra0)) '())) + (let ((crdims (cdr rdims))) + (do ((i (+ -1 (car rdims)) (+ -1 i))) + ((negative? i)) + (ramap crdims (cons i inds)))))) + (ramap (reverse (array-dimensions ra0)) '())) ;;@args prototype proc array1 array2 @dots{} ;;@var{array2}, @dots{} must have the same number of dimensions as @@ -55,7 +54,7 @@ ;;new array of type @var{prototype}. The new array is returned. The ;;order of application is unspecified. (define (array-map prototype proc ra1 . ras) - (define nra (apply create-array prototype (array-shape ra1))) + (define nra (apply make-array prototype (array-dimensions ra1))) (apply array-map! nra proc ra1 ras) nra) @@ -63,20 +62,20 @@ ;;@var{proc} is applied to each tuple of elements of @var{array0} @dots{} ;;in row-major order. The value returned is unspecified. (define (array-for-each proc . ras) - (define (rafe rshape inds) - (if (null? (cdr rshape)) + (define (rafe rdims inds) + (if (null? (cdr rdims)) (let ((sdni (reverse (cons #f inds)))) (define lastpair (last-pair sdni)) - (do ((i (caar rshape) (+ 1 i))) - ((> i (cadar rshape))) + (do ((i 0 (+ 1 i))) + ((> i (+ -1 (car rdims)))) (set-car! lastpair i) (apply proc (map (lambda (ra) (apply array-ref ra sdni)) ras)))) - (let ((crshape (cdr rshape)) - (ll (cadar rshape))) - (do ((i (caar rshape) (+ 1 i))) + (let ((crdims (cdr rdims)) + (ll (+ -1 (car rdims)))) + (do ((i 0 (+ 1 i))) ((> i ll)) - (rafe crshape (cons i inds)))))) - (rafe (array-shape (car ras)) '())) + (rafe crdims (cons i inds)))))) + (rafe (array-dimensions (car ras)) '())) ;;@args array ;;Returns an array of lists of indexes for @var{array} such that, if @@ -84,7 +83,7 @@ ;;(equal? @var{li} (apply array-ref (array-indexes @var{array}) ;;@var{li})). (define (array-indexes ra) - (let ((ra0 (apply create-array '#() (array-shape ra)))) + (let ((ra0 (apply make-array '#() (array-dimensions ra)))) (array-index-map! ra0 list) ra0)) @@ -96,7 +95,7 @@ ;;One can implement @var{array-indexes} as ;;@example ;;(define (array-indexes array) -;; (let ((ra (apply create-array '#() (array-shape array)))) +;; (let ((ra (apply make-array '#() (array-dimensions array)))) ;; (array-index-map! ra (lambda x x)) ;; ra)) ;;@end example @@ -108,26 +107,25 @@ ;; v)) ;;@end example (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) + (define (ramap rdims inds) + (if (null? (cdr rdims)) + (do ((i (+ -1 (car rdims)) (+ -1 i)) + (is (cons (+ -1 (car rdims)) inds) (cons (+ -1 i) inds))) - ((< i (caar rshape))) + ((negative? i)) (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)))))) + (let ((crdims (cdr rdims))) + (do ((i (+ -1 (car rdims)) (+ -1 i))) + ((negative? i)) + (ramap crdims (cons i inds)))))) (if (zero? (array-rank ra)) (array-set! ra (fun)) - (ramap (reverse (array-shape ra)) '()))) + (ramap (reverse (array-dimensions ra)) '()))) -;;@args source destination +;;@args destination source ;;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. -(define (array-copy! source dest) +(define (array:copy! dest source) (array-map! dest identity source)) diff --git a/arraymap.txi b/arraymap.txi index f10ad65..2547eaf 100644 --- a/arraymap.txi +++ b/arraymap.txi @@ -12,6 +12,7 @@ as the corresponding element in @var{array0}. The value returned is unspecified. The order of application is unspecified. @end deffn + @defun array-map prototype proc array1 array2 @dots{} @var{array2}, @dots{} must have the same number of dimensions as @@ -23,12 +24,14 @@ new array of type @var{prototype}. The new array is returned. The order of application is unspecified. @end defun + @defun array-for-each proc 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 array Returns an array of lists of indexes for @var{array} such that, if @@ -37,6 +40,7 @@ Returns an array of lists of indexes for @var{array} such that, if @var{li})). @end defun + @deffn {Procedure} array-index-map! array proc applies @var{proc} to the indices of each element of @var{array} in @@ -46,7 +50,7 @@ returned and the order of application are unspecified. One can implement @var{array-indexes} as @example (define (array-indexes array) - (let ((ra (apply create-array '#() (array-shape array)))) + (let ((ra (apply make-array '#() (array-dimensions array)))) (array-index-map! ra (lambda x x)) ra)) @end example @@ -59,10 +63,12 @@ Another example: @end example @end deffn -@deffn {Procedure} array-copy! source destination + +@deffn {Procedure} array:copy! destination source 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 deffn + @@ -1,5 +1,5 @@ ;;; "batch.scm" Group and execute commands on various systems. -;Copyright (C) 1994, 1995, 1997 Aubrey Jaffer +;Copyright (C) 1994, 1995, 1997, 2004 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -49,14 +49,18 @@ (define (batch:operating-system parms) (car (parameter-list-ref parms 'operating-system))) -(define (write-batch-line str line-limit port) - (cond ((and line-limit (>= (string-length str) line-limit)) - (slib:warn 'write-batch-line 'too-long - (string-length str) '> line-limit) - #f) - (else (write-line str port) #t))) (define (batch-line parms str) - (write-batch-line str (batch:line-length-limit parms) (batch:port parms))) + (define line-limit (batch:line-length-limit parms)) + (define port (batch:port parms)) + (cond ((and line-limit (>= (string-length str) line-limit)) + (let ((msg (string-append "batch line is too long " + (number->string (string-length str)) + " > " + (number->string line-limit)))) + (batch:comment parms (string-append "WARN: " msg)) + (if (not (eq? port (current-output-port))) (slib:warn msg))))) + (write-line str port) + #t) ;;; add a Scheme batch-dialect? ;@ @@ -107,16 +111,19 @@ ((vms) (batch:command parms (string-append "@" name) strings)) (else (batch:command parms name strings)))) -(define (batch:write-comment-line dialect line port) +(define (batch:comment-prefix dialect) (case dialect - ((unix) (write-batch-line (string-append "# " line) #f port)) - ((dos) (write-batch-line (string-append "rem " line) #f port)) - ((vms) (write-batch-line (string-append "$! " line) #f port)) - ((amigaos) (write-batch-line (string-append "; " line) #f port)) - ((system) (write-batch-line (string-append "; " line) #f port)) - ((*unknown*) (write-batch-line (string-append ";;; " line) #f port) - ;;(newline port) - #f))) + ((unix) "# ") + ((dos) "rem ") + ((vms) "$! ") + ((amigaos) "; ") + ((system) "; ") + ((*unknown*) ";;; "))) + +;;; Comment lines usually don't have a length limit. +(define (batch:write-comment-line dialect line port) + (write-line (string-append (batch:comment-prefix dialect) line) port) + #t) ;@ (define (batch:comment parms . lines) (define port (batch:port parms)) @@ -464,7 +471,7 @@ ) ;@ (define *operating-system* - (cond ((and (eq? 'unix (software-type)) (provided? 'system)) + (cond ((and (eq? 'UNIX (software-type)) (provided? 'system)) (let* ((file-name (tmpnam)) (uname (and (system (string-append "uname > " file-name)) (call-with-input-file file-name read))) @@ -473,11 +480,11 @@ (cond ((and ustr (> (string-length ustr) 5) (string-ci=? "cygwin" (substring ustr 0 6))) - 'gnu-win32) + 'GNU-WIN32) ((and ustr (> (string-length ustr) 4) (string-ci=? "mingw" (substring ustr 0 5))) - 'gnu-win32) + 'GNU-WIN32) (ustr uname) (else (software-type))))) (else (software-type)))) diff --git a/bigloo.init b/bigloo.init index 9ded1a4..af34546 100644 --- a/bigloo.init +++ b/bigloo.init @@ -3,23 +3,25 @@ ;;; ;;; This code is in the public domain. +;;@ (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 +;;@ (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. (define (scheme-implementation-type) 'Bigloo) -;;; (scheme-implementation-home-page) should return a (string) URI +;;@ (scheme-implementation-home-page) should return a (string) URI ;;; (Uniform Resource Identifier) for this scheme implementation's home ;;; page; or false if there isn't one. (define (scheme-implementation-home-page) "http://www-sop.inria.fr/mimosa/fp/Bigloo/") -;;; (scheme-implementation-version) should return a string describing +;;@ (scheme-implementation-version) should return a string describing ;;; the version the scheme implementation loading this file. (define (scheme-implementation-version) *bigloo-version*) -;;; (implementation-vicinity) should be defined to be the pathname of +;;@ (implementation-vicinity) should be defined to be the pathname of ;;; the directory where any auxillary files to your Scheme ;;; implementation reside. (define (implementation-vicinity) @@ -28,7 +30,7 @@ ((MS-DOS) "C:\\scheme\\") (else ""))) -;;; (library-vicinity) should be defined to be the pathname of the +;;@ (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. (define library-vicinity (let ((library-path @@ -47,7 +49,7 @@ (else ""))))) (lambda () library-path))) -;;; (home-vicinity) should return the vicinity of the user's HOME +;;@ (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) @@ -59,32 +61,106 @@ home (string-append home "/"))) (else home))))) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. See Template.scm for the list of feature -;;; names. +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to +;;; r5rs ;conforms to eval ;R5RS two-argument eval -; values ;R5RS multiple values -; dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; values ;R5RS multiple values +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. -; char-ready? +;;; char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to @@ -92,43 +168,39 @@ r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE - transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF +;; full-continuation ;not without the -call/cc switch ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. -;; full-continuation ;not without the -call/cc switch ;; Other common features srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort +;;; sort pretty-print object->string -; format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; format ;Common-lisp output formatting +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features @@ -140,13 +212,13 @@ (define (object->string x) (obj->string x)) -;;; (OUTPUT-PORT-WIDTH <port>) +;;@ (OUTPUT-PORT-WIDTH <port>) (define (output-port-width . arg) 79) -;;; (OUTPUT-PORT-HEIGHT <port>) +;;@ (OUTPUT-PORT-HEIGHT <port>) (define (output-port-height . arg) 24) -;;; (TMPNAM) makes a temporary file name. +;;@ (TMPNAM) makes a temporary file name. (define tmpnam (let ((cntr 100)) (lambda () @@ -154,55 +226,23 @@ (let ((tmp (string-append "slib_" (number->string cntr)))) (if (file-exists? tmp) (tmpnam) tmp))))) -;;; FORCE-OUTPUT flushes any pending output on optional arg output port +;;@ 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 . args) (flush-output-port (if (pair? args) (car args) (current-output-port)))) -;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string +;;@ 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) (close-output-port outsp))) - (define (call-with-input-string s f) (let* ((insp (open-input-string s)) (res (f insp))) (close-input-port insp) res)) -(define (make-exchanger obj) - (lambda (rep) (let ((old obj)) (set! obj rep) old))) -(define (open-file filename modes) - (case modes - ((r rb) (open-input-file filename)) - ((w wb) (open-output-file filename)) - (else (slib:error 'open-file 'mode? modes)))) -;;(define (port? obj) (or (input-port? port) (output-port? port))) -(define (call-with-open-ports . ports) - (define proc (car ports)) - (cond ((procedure? proc) (set! ports (cdr ports))) - (else (set! ports (reverse ports)) - (set! proc (car ports)) - (set! ports (reverse (cdr ports))))) - (let ((ans (apply proc ports))) - (for-each close-port ports) - ans)) -(define (close-port port) - (cond ((input-port? port) - (close-input-port port) - (if (output-port? port) (close-output-port port))) - ((output-port? port) (close-output-port port)) - (else (slib:error 'close-port 'port? port)))) - -(define (browse-url url) - (define (try cmd end) (zero? (system (string-append cmd url end)))) - (or (try "netscape-remote -remote 'openURL(" ")'") - (try "netscape -remote 'openURL(" ")'") - (try "netscape '" "'&") - (try "netscape '" "'"))) - ;;; "rationalize" adjunct procedures. (define (find-ratio x e) (let ((rat (rationalize x e))) @@ -210,40 +250,42 @@ (define (find-ratio-between x y) (find-ratio (/ (+ x y) 2) (/ (- x y) 2))) -;;; CHAR-CODE-LIMIT is one greater than the largest integer which can +;;@ 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 +;;@ MOST-POSITIVE-FIXNUM is used in modular.scm (define most-positive-fixnum 536870911) -;;; Return argument +;;@ Return argument (define (identity x) x) -;;; SLIB:EVAL is single argument eval using the top-level (user) environment. +;;@ SLIB:EVAL is single argument eval using the top-level (user) environment. (define slib:eval eval) +;;; If your implementation provides R4RS macros: +;(define macro:eval slib:eval) +;(define macro:load load) + (define-macro (defmacro name . forms) `(define-macro (,name . ,(car forms)) ,@(cdr forms))) - +;@ (define (defmacro? m) (get-eval-expander m)) +;@ (define (macroexpand-1 body) (expand-once body)) +;@ (define (macroexpand body) (expand body)) - +;@ (define (gentemp) (gensym)) +;@ +(define defmacro: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))))) +;;(define (defmacro:expand* x) +;; (require 'defmacroexpand) (apply defmacro:expand* x '())) +;; slib:eval-load definition moved to "require.scm" + +;@ (define slib:warn (lambda args (let ((cep (current-error-port))) @@ -251,13 +293,43 @@ (display "Warn: " cep) (for-each (lambda (x) (display #\ cep) (write x cep)) args)))) - -;;; define an error procedure for the library +;;@ define an error procedure for the library (define (slib:error . args) (if (provided? 'trace) (print-call-stack (current-error-port))) (error 'slib:error "" args)) +;@ +(define (make-exchanger obj) + (lambda (rep) (let ((old obj)) (set! obj rep) old))) +(define (open-file filename modes) + (case modes + ((r rb) (open-input-file filename)) + ((w wb) (open-output-file filename)) + (else (slib:error 'open-file 'mode? modes)))) +;;(define (port? obj) (or (input-port? port) (output-port? port))) +(define (call-with-open-ports . ports) + (define proc (car ports)) + (cond ((procedure? proc) (set! ports (cdr ports))) + (else (set! ports (reverse ports)) + (set! proc (car ports)) + (set! ports (reverse (cdr ports))))) + (let ((ans (apply proc ports))) + (for-each close-port ports) + ans)) +(define (close-port port) + (cond ((input-port? port) + (close-input-port port) + (if (output-port? port) (close-output-port port))) + ((output-port? port) (close-output-port port)) + (else (slib:error 'close-port 'port? port)))) +;@ +(define (browse-url url) + (define (try cmd end) (zero? (system (string-append cmd url end)))) + (or (try "netscape-remote -remote 'openURL(" ")'") + (try "netscape -remote 'openURL(" ")'") + (try "netscape '" "'&") + (try "netscape '" "'"))) -;; define these as appropriate for your system. +;;@ define these as appropriate for your system. (define slib:tab (integer->char 9)) (define slib:form-feed (integer->char 12)) @@ -270,47 +342,39 @@ (define ,maker-name ,name)) )) - -;;(define force force) - -;;; Define these if your implementation's syntax can support it and if +;;@ 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 to be the implementation procedure to exit or +;;; return if exiting not supported. (define slib:exit (lambda args (exit 0))) -;;; Here for backward compatability +;;@ 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 +;;@ (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) (loadq (string-append f (scheme-file-suffix)))) -;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced +;;@ (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 loadq) -;;; At this point SLIB:LOAD must be able to load SLIB files. -(define slib:load slib:load-source) - -(define defmacro:eval slib:eval) -(define defmacro:load slib:load) - -;;; If your implementation provides R4RS macros: -;(define macro:eval slib:eval) -;(define macro:load load) +;;@ At this point SLIB:LOAD must be able to load SLIB files. +(define (slib:load file) + (define file.scm (string-append file (scheme-file-suffix))) + (if (file-exists? file.scm) + (slib:load-source file.scm) + (slib:load-compiled file))) +;@ +(define defmacro:load slib:load-source) (slib:load (in-vicinity (library-vicinity) "require")) -; eof @@ -1,5 +1,5 @@ ;;; "byte.scm" small integers, not necessarily chars. -; Copyright (c) 2001, 2002, 2003 Aubrey Jaffer +; Copyright (C) 2001, 2002, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -17,6 +17,8 @@ ;promotional, or sales literature without prior written consent in ;each case. +(require 'rev4-optional-procedures) ; string-copy + ;;@code{(require 'byte)} ;;@ftindex byte ;; @@ -80,7 +82,7 @@ (define (bytes-reverse! bytes) (do ((idx 0 (+ 1 idx)) (xdi (+ -1 (bytes-length bytes)) (+ -1 xdi))) - ((>= idx xdi) bytes) + ((> idx xdi) bytes) (let ((tmp (byte-ref bytes idx))) (byte-set! bytes idx (byte-ref bytes xdi)) (byte-set! bytes xdi tmp)))) @@ -16,6 +16,7 @@ character sets. These functions abstract the notion of a @dfn{byte}. zero-origin indexing. @end defun + @deffn {Procedure} byte-set! bytes k byte @var{k} must be a valid index of @var{bytes}, and @var{byte} must be a small @@ -23,6 +24,7 @@ nonnegative integer. @code{byte-set!} stores @var{byte} in element @var{k} of @ returns an unspecified value. @c <!> @end deffn + @defun make-bytes k byte @@ -32,28 +34,33 @@ given, then all elements of the byte-array are initialized to @var{byte}, otherwise the contents of the byte-array are unspecified. @end defun + @defun bytes-length bytes @code{bytes-length} returns length of byte-array @var{bytes}. @end defun + @defun bytes byte @dots{} Returns a newly allocated byte-array composed of the small nonnegative arguments. @end defun + @defun bytes->list bytes @code{bytes->list} returns a newly allocated list of the bytes that make up the given byte-array. @end defun + @defun list->bytes bytes @code{list->bytes} returns a newly allocated byte-array formed from the small nonnegative integers in the list @var{bytes}. @end defun + @noindent @code{Bytes->list} and @code{list->bytes} are inverses so far as @code{equal?} is concerned. @@ -65,16 +72,19 @@ nonnegative integers in the list @var{bytes}. Returns a newly allocated copy of the given @var{bytes}. @end defun + @deffn {Procedure} bytes-reverse! bytes Reverses the order of byte-array @var{bytes}. @end deffn + @defun bytes-reverse bytes Returns a newly allocated bytes-array consisting of the elements of @var{bytes} in reverse order. @end defun + @noindent @cindex binary Input and output of bytes should be with ports opened in @dfn{binary} @@ -96,6 +106,7 @@ be omitted, in which case it defaults to the value returned by @findex current-output-port @end defun + @defun read-byte port @@ -106,6 +117,7 @@ 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 @end defun + @noindent When reading and writing binary numbers with @code{read-bytes} and @code{write-bytes}, the sign of the length argument determines the @@ -135,6 +147,7 @@ end-of-file. by @code{current-input-port}. @end defun + @defun write-bytes bytes n port @@ -147,6 +160,7 @@ value. @var{port} may be omitted, in which case it defaults to the value returned by @code{current-output-port}. @end defun + @noindent @code{substring-read!} and @code{substring-write} provide lower-level procedures for reading and writing blocks of bytes. The @@ -166,6 +180,7 @@ read from @var{port}. The first byte read is stored at index @var{string}. by @code{current-input-port}. @end deffn + @defun substring-write string start end port @@ -177,3 +192,4 @@ returns the number of bytes written. @var{port} may be omitted, in which case it defaults to the value returned by @code{current-output-port}. @end defun + diff --git a/bytenumb.scm b/bytenumb.scm index 68ee748..7febf64 100644 --- a/bytenumb.scm +++ b/bytenumb.scm @@ -1,5 +1,5 @@ ;;; "bytenumb.scm" Byte integer and IEEE floating-point conversions. -; Copyright (c) 2003 Aubrey Jaffer +; Copyright (C) 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -20,10 +20,6 @@ (require 'byte) (require 'logical) -(define bn:expt - (if (provided? 'inexact) expt - (lambda (n k) (if (negative? k) 0 (integer-expt n k))))) - ;;@code{(require 'byte-number)} ;;@ftindex byte-number @@ -107,7 +103,7 @@ (idx (+ -2 len) (+ -1 idx))) ((<= idx 1) (set! F (/ (+ (logand #x7F (byte-ref bytes 1)) (/ F 256)) 128)) - (cond ((< 0 E 255) (* (if S -1 1) (bn:expt 2 (- E 127)) (+ 1 F))) + (cond ((< 0 E 255) (* (if S -1 1) (expt 2 (- E 127)) (+ 1 F))) ((zero? E) (if (zero? F) (if S (- zero) zero) @@ -151,7 +147,7 @@ (idx (+ -2 len) (+ -1 idx))) ((<= idx 1) (set! F (/ (+ (logand #x0F (byte-ref bytes 1)) (/ F 256)) 16)) - (cond ((< 0 E 2047) (* (if S -1 1) (bn:expt 2 (- E 1023)) (+ 1 F))) + (cond ((< 0 E 2047) (* (if S -1 1) (expt 2 (- E 1023)) (+ 1 F))) ((zero? E) (if (zero? F) (if S (- zero) zero) diff --git a/bytenumb.txi b/bytenumb.txi index 67c340b..9be7630 100644 --- a/bytenumb.txi +++ b/bytenumb.txi @@ -28,6 +28,7 @@ bytes are treated as two's-complement (can be negative). @end example @end defun + @defun integer->bytes n len Converts the integer @var{n} to a byte-array of @code{(abs @var{n})} @@ -44,11 +45,13 @@ returned array are coded two's-complement. @end example @end defun + @defun bytes->ieee-float bytes @var{bytes} must be a 4-element byte-array. @code{bytes->ieee-float} calculates and returns the value of @var{bytes} interpreted as a big-endian IEEE 4-byte (32-bit) number. @end defun + @example (bytes->ieee-float (bytes #x40 0 0 0)) @result{} 2.0 (bytes->ieee-float (bytes #x40 #xd0 0 0)) @result{} 6.5 @@ -69,6 +72,7 @@ value of @var{bytes} interpreted as a big-endian IEEE 4-byte (32-bit) number. @var{bytes} must be a 8-element byte-array. @code{bytes->ieee-double} calculates and returns the value of @var{bytes} interpreted as a big-endian IEEE 8-byte (64-bit) number. @end defun + @example (bytes->ieee-double (bytes 0 0 0 0 0 0 0 0)) @result{} 0.0 (bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) @result{} 2 @@ -90,6 +94,7 @@ value of @var{bytes} interpreted as a big-endian IEEE 8-byte (64-bit) number. Returns a 4-element byte-array encoding the IEEE single-precision floating-point of @var{x}. @end defun + @example (bytes->list (ieee-float->bytes 2.0)) @result{} (64 0 0 0) (bytes->list (ieee-float->bytes 6.5)) @result{} (64 208 0 0) @@ -110,6 +115,7 @@ floating-point of @var{x}. Returns a 8-element byte-array encoding the IEEE double-precision floating-point of @var{x}. @end defun + @example (bytes->list (ieee-double->bytes 2.0)) @result{} (64 0 0 0 0 0 0 0) (bytes->list (ieee-double->bytes 6.5)) @result{} (64 26 0 0 0 0 0 0) @@ -149,6 +155,7 @@ two's-complement byte-vectors matches numerical order. @code{integer-byte-colla @var{byte-vector} and is its own functional inverse. @end deffn + @defun integer-byte-collate byte-vector Returns copy of @var{byte-vector} with sign bit modified so that @code{string<?} @@ -156,26 +163,31 @@ ordering of two's-complement byte-vectors matches numerical order. @code{integer-byte-collate} is its own functional inverse. @end defun + @deffn {Procedure} ieee-byte-collate! byte-vector Modifies @var{byte-vector} so that @code{string<?} ordering of IEEE floating-point byte-vectors matches numerical order. @code{ieee-byte-collate!} returns @var{byte-vector}. @end deffn + @deffn {Procedure} ieee-byte-decollate! byte-vector Given @var{byte-vector} modified by @code{IEEE-byte-collate!}, reverses the @var{byte-vector} modifications. @end deffn + @defun ieee-byte-collate byte-vector Returns copy of @var{byte-vector} encoded so that @code{string<?} ordering of IEEE floating-point byte-vectors matches numerical order. @end defun + @defun ieee-byte-decollate byte-vector Given @var{byte-vector} returned by @code{IEEE-byte-collate}, reverses the @var{byte-vector} modifications. @end defun + @@ -22,6 +22,7 @@ ;;; section of the string consists of consecutive numeric or ;;; consecutive aphabetic characters. +(require 'rev4-optional-procedures) ; string-copy ;;@code{(require 'chapter-order)} ;;@ftindex chapter-order @@ -22,6 +22,7 @@ characters of @var{string2}. @end example @end defun + @defun chap:string>? string1 string2 @defunx chap:string<=? string1 string2 @defunx chap:string>=? string1 string2 @@ -29,6 +30,7 @@ characters of @var{string2}. Implement the corresponding chapter-order predicates. @end defun + @defun chap:next-string string Returns the next string in the @emph{chapter order}. If @var{string} @@ -44,3 +46,4 @@ chap:next-string will always be @code{chap:string<?} than the result. @end example @end defun + diff --git a/charplot.scm b/charplot.scm index 890fca0..31d0fea 100644 --- a/charplot.scm +++ b/charplot.scm @@ -85,7 +85,7 @@ (output-port-height (current-output-port)))) (width (or (and charplot:dimensions (cadr charplot:dimensions)) (output-port-width (current-output-port))))) - (define pra (create-array " " height width)) + (define pra (make-array " " height width)) ;;Put newlines on right edge (do ((idx (+ -1 height) (+ -1 idx))) ((negative? idx)) @@ -166,20 +166,24 @@ (define (charplot:array->list ra) (define dims (array-dimensions ra)) - (do ((idx (+ -1 (car dims)) (+ -1 idx)) - (cols '() (cons (do ((jdx (+ -1 (cadr dims)) (+ -1 jdx)) - (row '() (cons (array-ref ra idx jdx) row))) - ((negative? jdx) row)) - cols))) - ((negative? idx) cols))) + (if (= 2 (length dims)) + (do ((idx (+ -1 (car dims)) (+ -1 idx)) + (cols '() (cons (do ((jdx (+ -1 (cadr dims)) (+ -1 jdx)) + (row '() (cons (array-ref ra idx jdx) row))) + ((negative? jdx) row)) + cols))) + ((negative? idx) cols)) + (do ((idx (+ -1 (car dims)) (+ -1 idx)) + (cols '() (cons (array-ref ra idx) cols))) + ((negative? idx) cols)))) ;;;Converts data to list of coordinates (list). (define (charplot:data->lists data) (cond ((array? data) (case (array-rank data) ((1) (set! data (map list - (let ((ra (apply create-array '#() - (array-shape data)))) + (let ((ra (apply make-array '#() + (array-dimensions data)))) (array-index-map! ra identity) (charplot:array->list ra)) (charplot:array->list data)))) @@ -279,12 +283,13 @@ data) (array-for-each write-char pra) (if (not (eqv? #\newline (apply array-ref pra - (map cadr (array-shape pra))))) + (map (lambda (x) (+ -1 x)) + (array-dimensions pra))))) (newline)))) (define (charplot:plot-function func vlo vhi . npts) (set! npts (if (null? npts) 64 (car npts))) - (let ((dats (create-array (Ar64) npts 2))) + (let ((dats (make-array (A:floR64b) npts 2))) (array-index-map! (make-shared-array dats (lambda (idx) (list idx 0)) npts) (lambda (idx) (+ vlo (* (- vhi vlo) (/ idx (+ -1 npts)))))) @@ -58,17 +58,88 @@ home (string-append home "/"))) (else home))))) - -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") + ;(SLIB:LOAD-SOURCE "filename") compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. r5rs ;conforms to eval ;R5RS two-argument eval @@ -78,11 +149,16 @@ delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to @@ -90,43 +166,39 @@ r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE - transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; ieee-floating-point ;conforms to IEEE Standard 754-1985 + full-continuation ;can return multiple times +;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. -; defmacro ;has Common Lisp DEFMACRO +;;; defmacro ;has Common Lisp DEFMACRO record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING sort pretty-print -; object->string +;;; object->string format ;Common-lisp output formatting trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; compiler ;has (COMPILER) +;;; ed ;(ED) is editor system ;posix (system <string>) getenv ;posix (getenv <string>) -; program-arguments ;returns list of strings (argv) -; current-time ;returns time in seconds since 1/1/1970 +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features @@ -264,13 +336,8 @@ ;(define (-1+ n) (+ n -1)) ;(define 1- -1+) -;;; (IN-VICINITY <string>) 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 in-vicinity string-append) - ;;; Define SLIB:EXIT to be the implementation procedure to exit or -;;; return if exitting not supported. +;;; return if exiting not supported. (define slib:chez:quit (let ((arg (call-with-current-continuation identity))) (cond ((procedure? arg) arg) @@ -398,21 +465,9 @@ (define (defmacro:eval x) (base:eval (defmacro:expand* x))) (define (defmacro:expand* x) (require 'defmacroexpand) (apply defmacro:expand* x '())) - -(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 (defmacro:load <pathname>) (slib:eval-load <pathname> defmacro:eval)) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args diff --git a/ciesia.dat b/ciesia.dat new file mode 100644 index 0000000..2bcff04 --- /dev/null +++ b/ciesia.dat @@ -0,0 +1,110 @@ +;;; CIE 15.2-1986 Table 1.1 +;;; Part 1: CIE Standard Illuminant A relative spectral power distribution +;;; 300 nm - 830 nm at 5 nm intervals +0.930483 +1.128210 +1.357690 +1.622190 +1.925080 +2.269800 +2.659810 +3.098610 +3.589680 +4.136480 +4.742380 +5.410700 +6.144620 +6.947200 +7.821350 +8.769800 +9.795100 +10.899600 +12.085300 +13.354300 +14.708000 +16.148000 +17.675300 +19.290700 +20.995000 +22.788300 +24.670900 +26.642500 +28.702700 +30.850800 +33.085900 +35.406800 +37.812100 +40.300200 +42.869300 +45.517400 +48.242300 +51.041800 +53.913200 +56.853900 +59.861100 +62.932000 +66.063500 +69.252500 +72.495900 +75.790300 +79.132600 +82.519300 +85.947000 +89.412400 +92.912000 +96.442300 +100.000000 +103.582000 +107.184000 +110.803000 +114.436000 +118.080000 +121.731000 +125.386000 +129.043000 +132.697000 +136.346000 +139.988000 +143.618000 +147.235000 +150.836000 +154.418000 +157.979000 +161.516000 +165.028000 +168.510000 +171.963000 +175.383000 +178.769000 +182.118000 +185.429000 +188.701000 +191.931000 +195.118000 +198.261000 +201.359000 +204.409000 +207.411000 +210.365000 +213.268000 +216.120000 +218.920000 +221.667000 +224.361000 +227.000000 +229.585000 +232.115000 +234.589000 +237.008000 +239.370000 +241.675000 +243.924000 +246.116000 +248.251000 +250.329000 +252.350000 +254.314000 +256.221000 +258.071000 +259.865000 +261.602000 diff --git a/ciesid65.dat b/ciesid65.dat new file mode 100644 index 0000000..bc63299 --- /dev/null +++ b/ciesid65.dat @@ -0,0 +1,110 @@ +;;; CIE 15.2-1986 Table 1.1 +;;; Part 2: CIE Standard Illuminant D65 relative spectral power distribution +;;; 300 nm - 830 nm at 5 nm intervals +0.03410 +1.66430 +3.29450 +11.76520 +20.23600 +28.64470 +37.05350 +38.50110 +39.94880 +42.43020 +44.91170 +45.77500 +46.63830 +49.36370 +52.08910 +51.03230 +49.97550 +52.31180 +54.64820 +68.70150 +82.75490 +87.12040 +91.48600 +92.45890 +93.43180 +90.05700 +86.68230 +95.77360 +104.86500 +110.93600 +117.00800 +117.41000 +117.81200 +116.33600 +114.86100 +115.39200 +115.92300 +112.36700 +108.81100 +109.08200 +109.35400 +108.57800 +107.80200 +106.29600 +104.79000 +106.23900 +107.68900 +106.04700 +104.40500 +104.22500 +104.04600 +102.02300 +100.00000 +98.16710 +96.33420 +96.06110 +95.78800 +92.23680 +88.68560 +89.34590 +90.00620 +89.80260 +89.59910 +88.64890 +87.69870 +85.49360 +83.28860 +83.49390 +83.69920 +81.86300 +80.02680 +80.12070 +80.21460 +81.24620 +82.27780 +80.28100 +78.28420 +74.00270 +69.72130 +70.66520 +71.60910 +72.97900 +74.34900 +67.97650 +61.60400 +65.74480 +69.88560 +72.48630 +75.08700 +69.33980 +63.59270 +55.00540 +46.41820 +56.61180 +66.80540 +65.09410 +63.38280 +63.84340 +64.30400 +61.87790 +59.45190 +55.70540 +51.95900 +54.69980 +57.44060 +58.87650 +60.31250 diff --git a/clrnamdb.scm b/clrnamdb.scm new file mode 100644 index 0000000..68386c9 --- /dev/null +++ b/clrnamdb.scm @@ -0,0 +1,1745 @@ +;;; "/usr/local/lib/slib/clrnamdb.scm" SLIB 3a2 alist-table database -*-scheme-*- + +( + (10 + ("black" "sRGB:34/34/34" 267) + ("darkgray" "sRGB:85/85/85" 266) + ("mediumgray" "sRGB:132/132/130" 265) + ("lightgray" "sRGB:185/184/181" 264) + ("white" "sRGB:242/243/244" 263) + ("grayishpurplishred" "sRGB:145/95/109" 262) + ("lightgrayishpurplishred" "sRGB:175/134/142" 261) + ("verydarkpurplishred" "sRGB:56/21/44" 260) + ("darkpurplishred" "sRGB:103/49/71" 259) + ("moderatepurplishred" "sRGB:168/81/110" 258) + ("verydeeppurplishred" "sRGB:84/19/59" 257) + ("deeppurplishred" "sRGB:120/24/74" 256) + ("strongpurplishred" "sRGB:179/68/108" 255) + ("vividpurplishred" "sRGB:206/70/118" 254) + ("grayishpurplishpink" "sRGB:195/166/177" 253) + ("palepurplishpink" "sRGB:232/204/215" 252) + ("darkpurplishpink" "sRGB:193/126/145" 251) + ("moderatepurplishpink" "sRGB:213/151/174" 250) + ("lightpurplishpink" "sRGB:239/187/204" 249) + ("deeppurplishpink" "sRGB:222/111/161" 248) + ("strongpurplishpink" "sRGB:230/143/172" 247) + ("brilliantpurplishpink" "sRGB:255/200/214" 246) + ("grayishreddishpurple" "sRGB:131/100/121" 245) + ("palereddishpurple" "sRGB:170/138/158" 244) + ("verydarkreddishpurple" "sRGB:52/23/49" 243) + ("darkreddishpurple" "sRGB:93/57/84" 242) + ("moderatereddishpurple" "sRGB:145/92/131" 241) + ("lightreddishpurple" "sRGB:183/132/167" 240) + ("verydeepreddishpurple" "sRGB:84/25/78" 239) + ("deepreddishpurple" "sRGB:112/41/99" 238) + ("strongreddishpurple" "sRGB:158/79/136" 237) + ("vividreddishpurple" "sRGB:135/0/116" 236) + ("purplishblack" "sRGB:36/33/36" 235) + ("darkpurplishgray" "sRGB:93/85/91" 234) + ("purplishgray" "sRGB:139/133/137" 233) + ("lightpurplishgray" "sRGB:191/185/189" 232) + ("purplishwhite" "sRGB:232/227/229" 231) + ("blackishpurple" "sRGB:41/30/41" 230) + ("darkgrayishpurple" "sRGB:80/64/77" 229) + ("grayishpurple" "sRGB:121/104/120" 228) + ("palepurple" "sRGB:170/152/169" 227) + ("verypalepurple" "sRGB:214/202/221" 226) + ("verydarkpurple" "sRGB:48/25/52" 225) + ("darkpurple" "sRGB:86/60/92" 224) + ("moderatepurple" "sRGB:134/96/142" 223) + ("lightpurple" "sRGB:182/149/192" 222) + ("verylightpurple" "sRGB:213/186/219" 221) + ("verydeeppurple" "sRGB:64/26/76" 220) + ("deeppurple" "sRGB:96/47/107" 219) + ("strongpurple" "sRGB:135/86/146" 218) + ("brilliantpurple" "sRGB:211/153/230" 217) + ("vividpurple" "sRGB:154/78/174" 216) + ("grayishviolet" "sRGB:85/76/105" 215) + ("paleviolet" "sRGB:150/144/171" 214) + ("verypaleviolet" "sRGB:196/195/221" 213) + ("darkviolet" "sRGB:47/33/64" 212) + ("moderateviolet" "sRGB:96/78/129" 211) + ("lightviolet" "sRGB:140/130/182" 210) + ("verylightviolet" "sRGB:220/208/255" 209) + ("deepviolet" "sRGB:50/23/77" 208) + ("strongviolet" "sRGB:96/78/151" 207) + ("brilliantviolet" "sRGB:126/115/184" 206) + ("vividviolet" "sRGB:144/101/202" 205) + ("grayishpurplishblue" "sRGB:76/81/109" 204) + ("palepurplishblue" "sRGB:140/146/172" 203) + ("verypalepurplishblue" "sRGB:192/200/225" 202) + ("darkpurplishblue" "sRGB:37/36/64" 201) + ("moderatepurplishblue" "sRGB:78/81/128" 200) + ("lightpurplishblue" "sRGB:135/145/191" 199) + ("verylightpurplishblue" "sRGB:179/188/226" 198) + ("deeppurplishblue" "sRGB:39/36/88" 197) + ("strongpurplishblue" "sRGB:84/90/167" 196) + ("brilliantpurplishblue" "sRGB:108/121/184" 195) + ("vividpurplishblue" "sRGB:48/38/122" 194) + ("bluishblack" "sRGB:32/36/40" 193) + ("darkbluishgray" "sRGB:81/88/94" 192) + ("bluishgray" "sRGB:129/135/139" 191) + ("lightbluishgray" "sRGB:180/188/192" 190) + ("bluishwhite" "sRGB:233/233/237" 189) + ("blackishblue" "sRGB:32/40/48" 188) + ("darkgrayishblue" "sRGB:54/69/79" 187) + ("grayishblue" "sRGB:83/104/120" 186) + ("paleblue" "sRGB:145/163/176" 185) + ("verypaleblue" "sRGB:188/212/230" 184) + ("darkblue" "sRGB:0/48/78" 183) + ("moderateblue" "sRGB:67/107/149" 182) + ("lightblue" "sRGB:112/163/204" 181) + ("verylightblue" "sRGB:161/202/241" 180) + ("deepblue" "sRGB:0/65/106" 179) + ("strongblue" "sRGB:0/103/165" 178) + ("brilliantblue" "sRGB:73/151/208" 177) + ("vividblue" "sRGB:0/161/194" 176) + ("verydarkgreenishblue" "sRGB:0/46/59" 175) + ("darkgreenishblue" "sRGB:0/73/88" 174) + ("moderategreenishblue" "sRGB:54/117/136" 173) + ("lightgreenishblue" "sRGB:102/170/188" 172) + ("verylightgreenishblue" "sRGB:156/209/220" 171) + ("deepgreenishblue" "sRGB:46/132/149" 170) + ("stronggreenishblue" "sRGB:0/119/145" 169) + ("brilliantgreenishblue" "sRGB:35/158/186" 168) + ("vividgreenishblue" "sRGB:0/133/161" 167) + ("verydarkbluishgreen" "sRGB:0/42/41" 166) + ("darkbluishgreen" "sRGB:0/75/73" 165) + ("moderatebluishgreen" "sRGB:49/120/115" 164) + ("lightbluishgreen" "sRGB:102/173/164" 163) + ("verylightbluishgreen" "sRGB:150/222/209" 162) + ("deepbluishgreen" "sRGB:0/68/63" 161) + ("strongbluishgreen" "sRGB:0/122/116" 160) + ("brilliantbluishgreen" "sRGB:0/166/147" 159) + ("vividbluishgreen" "sRGB:0/136/130" 158) + ("greenishblack" "sRGB:30/35/33" 157) + ("darkgreenishgray" "sRGB:78/87/85" 156) + ("greenishgray" "sRGB:125/137/132" 155) + ("lightgreenishgray" "sRGB:178/190/181" 154) + ("greenishwhite" "sRGB:223/237/232" 153) + ("blackishgreen" "sRGB:26/36/33" 152) + ("darkgrayishgreen" "sRGB:58/75/71" 151) + ("grayishgreen" "sRGB:94/113/106" 150) + ("palegreen" "sRGB:141/163/153" 149) + ("verypalegreen" "sRGB:199/230/215" 148) + ("verydarkgreen" "sRGB:28/53/45" 147) + ("darkgreen" "sRGB:27/77/62" 146) + ("moderategreen" "sRGB:59/120/97" 145) + ("lightgreen" "sRGB:106/171/142" 144) + ("verylightgreen" "sRGB:142/209/178" 143) + ("deepgreen" "sRGB:0/84/61" 142) + ("stronggreen" "sRGB:0/121/89" 141) + ("brilliantgreen" "sRGB:62/180/137" 140) + ("vividgreen" "sRGB:0/136/86" 139) + ("verydarkyellowishgreen" "sRGB:23/54/32" 138) + ("darkyellowishgreen" "sRGB:53/94/59" 137) + ("moderateyellowishgreen" "sRGB:103/146/103" 136) + ("lightyellowishgreen" "sRGB:147/197/146" 135) + ("verylightyellowishgreen" "sRGB:182/229/175" 134) + ("verydeepyellowishgreen" "sRGB:0/49/24" 133) + ("deepyellowishgreen" "sRGB:0/98/45" 132) + ("strongyellowishgreen" "sRGB:68/148/74" 131) + ("brilliantyellowishgreen" "sRGB:131/211/125" 130) + ("vividyellowishgreen" "sRGB:39/166/76" 129) + ("darkgrayisholivegreen" "sRGB:49/54/43" 128) + ("grayisholivegreen" "sRGB:81/87/68" 127) + ("darkolivegreen" "sRGB:43/61/38" 126) + ("moderateolivegreen" "sRGB:74/93/35" 125) + ("deepolivegreen" "sRGB:35/47/0" 124) + ("strongolivegreen" "sRGB:64/79/0" 123) + ("grayishyellowgreen" "sRGB:143/151/121" 122) + ("paleyellowgreen" "sRGB:218/223/183" 121) + ("moderateyellowgreen" "sRGB:138/154/91" 120) + ("lightyellowgreen" "sRGB:201/220/137" 119) + ("deepyellowgreen" "sRGB:70/113/41" 118) + ("strongyellowgreen" "sRGB:126/159/46" 117) + ("brilliantyellowgreen" "sRGB:189/218/87" 116) + ("vividyellowgreen" "sRGB:141/182/0" 115) + ("oliveblack" "sRGB:37/36/29" 114) + ("olivegray" "sRGB:87/85/76" 113) + ("lightolivegray" "sRGB:138/135/118" 112) + ("darkgrayisholive" "sRGB:54/53/39" 111) + ("grayisholive" "sRGB:91/88/66" 110) + ("lightgrayisholive" "sRGB:140/135/103" 109) + ("darkolive" "sRGB:64/61/33" 108) + ("moderateolive" "sRGB:102/93/30" 107) + ("lightolive" "sRGB:134/126/54" 106) + ("grayishgreenishyellow" "sRGB:185/181/125" 105) + ("palegreenishyellow" "sRGB:235/232/164" 104) + ("darkgreenishyellow" "sRGB:152/148/62" 103) + ("moderategreenishyellow" "sRGB:185/180/89" 102) + ("lightgreenishyellow" "sRGB:234/230/121" 101) + ("deepgreenishyellow" "sRGB:155/148/0" 100) + ("stronggreenishyellow" "sRGB:190/183/46" 99) + ("brilliantgreenishyellow" "sRGB:233/228/80" 98) + ("vividgreenishyellow" "sRGB:220/211/0" 97) + ("darkolivebrown" "sRGB:59/49/33" 96) + ("moderateolivebrown" "sRGB:108/84/30" 95) + ("lightolivebrown" "sRGB:150/113/23" 94) + ("yellowishgray" "sRGB:191/184/165" 93) + ("yellowishwhite" "sRGB:240/234/214" 92) + ("darkgrayishyellow" "sRGB:161/143/96" 91) + ("grayishyellow" "sRGB:194/178/128" 90) + ("paleyellow" "sRGB:243/229/171" 89) + ("darkyellow" "sRGB:171/145/68" 88) + ("moderateyellow" "sRGB:201/174/93" 87) + ("lightyellow" "sRGB:248/222/126" 86) + ("deepyellow" "sRGB:175/141/19" 85) + ("strongyellow" "sRGB:212/175/55" 84) + ("brilliantyellow" "sRGB:250/218/94" 83) + ("vividyellow" "sRGB:243/195/0" 82) + ("darkgrayishyellowishbrown" "sRGB:72/60/50" 81) + ("grayishyellowishbrown" "sRGB:126/109/90" 80) + ("lightgrayishyellowishbrown" "sRGB:174/155/130" 79) + ("darkyellowishbrown" "sRGB:75/54/33" 78) + ("moderateyellowishbrown" "sRGB:130/102/68" 77) + ("lightyellowishbrown" "sRGB:193/154/107" 76) + ("deepyellowishbrown" "sRGB:101/69/34" 75) + ("strongyellowishbrown" "sRGB:153/101/21" 74) + ("paleorangeyellow" "sRGB:250/214/165" 73) + ("darkorangeyellow" "sRGB:190/138/61" 72) + ("moderateorangeyellow" "sRGB:227/168/87" 71) + ("lightorangeyellow" "sRGB:251/201/127" 70) + ("deeporangeyellow" "sRGB:201/133/0" 69) + ("strongorangeyellow" "sRGB:234/162/33" 68) + ("brilliantorangeyellow" "sRGB:255/193/79" 67) + ("vividorangeyellow" "sRGB:246/166/0" 66) + ("brownishblack" "sRGB:40/32/28" 65) + ("brownishgray" "sRGB:91/80/79" 64) + ("lightbrownishgray" "sRGB:142/130/121" 63) + ("darkgrayishbrown" "sRGB:62/50/44" 62) + ("grayishbrown" "sRGB:99/81/71" 61) + ("lightgrayishbrown" "sRGB:149/128/112" 60) + ("darkbrown" "sRGB:66/37/24" 59) + ("moderatebrown" "sRGB:111/78/55" 58) + ("lightbrown" "sRGB:166/123/91" 57) + ("deepbrown" "sRGB:89/51/25" 56) + ("strongbrown" "sRGB:128/70/27" 55) + ("brownishorange" "sRGB:174/105/56" 54) + ("moderateorange" "sRGB:217/144/88" 53) + ("lightorange" "sRGB:250/181/127" 52) + ("deeporange" "sRGB:190/101/22" 51) + ("strongorange" "sRGB:237/135/45" 50) + ("brilliantorange" "sRGB:253/148/63" 49) + ("vividorange" "sRGB:243/132/0" 48) + ("darkgrayishreddishbrown" "sRGB:67/48/46" 47) + ("grayishreddishbrown" "sRGB:103/76/71" 46) + ("lightgrayishreddishbrown" "sRGB:151/127/115" 45) + ("darkreddishbrown" "sRGB:62/29/30" 44) + ("moderatereddishbrown" "sRGB:121/68/59" 43) + ("lightreddishbrown" "sRGB:168/124/109" 42) + ("deepreddishbrown" "sRGB:86/7/12" 41) + ("strongreddishbrown" "sRGB:136/45/23" 40) + ("grayishreddishorange" "sRGB:180/116/94" 39) + ("darkreddishorange" "sRGB:158/71/50" 38) + ("moderatereddishorange" "sRGB:203/109/81" 37) + ("deepreddishorange" "sRGB:170/56/30" 36) + ("strongreddishorange" "sRGB:217/96/59" 35) + ("vividreddishorange" "sRGB:226/88/34" 34) + ("brownishpink" "sRGB:194/172/153" 33) + ("grayishyellowishpink" "sRGB:199/173/163" 32) + ("paleyellowishpink" "sRGB:236/213/197" 31) + ("darkyellowishpink" "sRGB:196/131/121" 30) + ("moderateyellowishpink" "sRGB:217/166/169" 29) + ("lightyellowishpink" "sRGB:244/194/194" 28) + ("deepyellowishpink" "sRGB:230/103/33" 27) + ("strongyellowishpink" "sRGB:249/147/121" 26) + ("vividyellowishpink" "sRGB:255/183/165" 25) + ("reddishblack" "sRGB:40/32/34" 24) + ("darkreddishgray" "sRGB:92/80/79" 23) + ("reddishgray" "sRGB:143/129/127" 22) + ("blackishred" "sRGB:46/29/33" 21) + ("darkgrayishred" "sRGB:84/61/63" 20) + ("grayishred" "sRGB:144/93/93" 19) + ("lightgrayishred" "sRGB:173/136/132" 18) + ("verydarkred" "sRGB:63/23/40" 17) + ("darkred" "sRGB:114/47/55" 16) + ("moderatered" "sRGB:171/78/82" 15) + ("verydeepred" "sRGB:92/9/35" 14) + ("deepred" "sRGB:132/27/45" 13) + ("strongred" "sRGB:188/63/74" 12) + ("vividred" "sRGB:190/0/50" 11) + ("pinkishgray" "sRGB:193/182/179" 10) + ("pinkishwhite" "sRGB:234/227/225" 9) + ("grayishpink" "sRGB:196/174/173" 8) + ("palepink" "sRGB:234/216/215" 7) + ("darkpink" "sRGB:192/128/129" 6) + ("moderatepink" "sRGB:222/165/164" 5) + ("lightpink" "sRGB:249/204/202" 4) + ("deeppink" "sRGB:228/113/122" 3) + ("strongpink" "sRGB:234/147/153" 2) + ("vividpink" "sRGB:255/181/186" 1) + ) + (9 + (3 #f order #f ordinal) + (2 #f color #f string) + (1 #t name #f string) + ) + (8 + ("zydeco" "sRGB:2/64/44" 1383) + ("zumthor" "sRGB:237/246/255" 1382) + ("zuccini" "sRGB:4/64/34" 1381) + ("zorba" "sRGB:165/155/145" 1380) + ("zombie" "sRGB:228/214/155" 1379) + ("zircon" "sRGB:244/248/255" 1378) + ("ziggurat" "sRGB:191/219/226" 1377) + ("zeus" "sRGB:41/35/25" 1376) + ("zest" "sRGB:229/132/27" 1375) + ("zanah" "sRGB:218/236/214" 1374) + ("zambezi" "sRGB:104/85/88" 1373) + ("yuma" "sRGB:206/194/145" 1372) + ("yukongold" "sRGB:123/102/8" 1371) + ("yourpink" "sRGB:255/195/192" 1370) + ("yellowsea" "sRGB:254/169/4" 1369) + ("yellowmetal" "sRGB:113/99/56" 1368) + ("xanadu" "sRGB:115/134/120" 1367) + ("woodybrown" "sRGB:72/49/49" 1366) + ("woodybay" "sRGB:41/33/48" 1365) + ("woodsmoke" "sRGB:12/13/15" 1364) + ("woodrush" "sRGB:48/42/15" 1363) + ("woodland" "sRGB:77/83/40" 1362) + ("woodburn" "sRGB:60/32/5" 1361) + ("woodbark" "sRGB:38/17/5" 1360) + ("witchhaze" "sRGB:255/252/153" 1359) + ("wistful" "sRGB:164/166/211" 1358) + ("wisteria" "sRGB:151/113/181" 1357) + ("wisppink" "sRGB:254/244/248" 1356) + ("winterhazel" "sRGB:213/209/149" 1355) + ("wineberry" "sRGB:89/29/53" 1354) + ("windsor" "sRGB:60/8/120" 1353) + ("willowgrove" "sRGB:101/116/93" 1352) + ("willowbrook" "sRGB:223/236/218" 1351) + ("william" "sRGB:58/104/108" 1350) + ("wildwillow" "sRGB:185/196/106" 1349) + ("wildsand" "sRGB:244/244/244" 1348) + ("wildrice" "sRGB:236/224/144" 1347) + ("whiterock" "sRGB:234/232/212" 1346) + ("whitepointer" "sRGB:254/248/255" 1345) + ("whitenectar" "sRGB:252/255/231" 1344) + ("whitelinen" "sRGB:248/240/232" 1343) + ("whitelilac" "sRGB:248/247/252" 1342) + ("whiteice" "sRGB:221/249/241" 1341) + ("whisper" "sRGB:247/245/250" 1340) + ("whiskeysour" "sRGB:219/153/94" 1339) + ("whiskey" "sRGB:213/154/111" 1338) + ("wheatfield" "sRGB:243/237/207" 1337) + ("wewak" "sRGB:241/155/171" 1336) + ("westernred" "sRGB:139/7/35" 1335) + ("westar" "sRGB:220/217/210" 1334) + ("westside" "sRGB:255/145/15" 1333) + ("westcoast" "sRGB:98/81/25" 1332) + ("wellread" "sRGB:180/51/50" 1331) + ("wedgewood" "sRGB:78/127/158" 1330) + ("wepeep" "sRGB:247/219/230" 1329) + ("waxflower" "sRGB:255/192/168" 1328) + ("watusi" "sRGB:255/221/207" 1327) + ("wattle" "sRGB:220/215/71" 1326) + ("waterloo" "sRGB:123/124/148" 1325) + ("watercourse" "sRGB:5/111/87" 1324) + ("waterleaf" "sRGB:161/233/222" 1323) + ("wasabi" "sRGB:120/138/37" 1322) + ("wanwhite" "sRGB:252/255/249" 1321) + ("walnut" "sRGB:119/63/26" 1320) + ("waiouru" "sRGB:54/60/13" 1319) + ("waikawagrey" "sRGB:90/110/156" 1318) + ("wafer" "sRGB:222/203/198" 1317) + ("vulcan" "sRGB:16/18/29" 1316) + ("voodoo" "sRGB:83/52/85" 1315) + ("volcano" "sRGB:101/26/20" 1314) + ("vistawhite" "sRGB:252/248/247" 1313) + ("vistablue" "sRGB:143/214/180" 1312) + ("visvis" "sRGB:255/239/161" 1311) + ("viridiangreen" "sRGB:103/137/117" 1310) + ("violet" "sRGB:36/10/64" 1309) + ("violentviolet" "sRGB:41/12/94" 1308) + ("viola" "sRGB:203/143/169" 1307) + ("vinrouge" "sRGB:152/61/97" 1306) + ("viking" "sRGB:100/204/219" 1305) + ("vidaloca" "sRGB:84/144/25" 1304) + ("victoria" "sRGB:83/68/145" 1303) + ("vesuvius" "sRGB:177/74/11" 1302) + ("verdungreen" "sRGB:73/84/0" 1301) + ("verdigris" "sRGB:93/94/55" 1300) + ("venus" "sRGB:146/133/144" 1299) + ("veniceblue" "sRGB:5/89/137" 1298) + ("venetianred" "sRGB:114/1/15" 1297) + ("varden" "sRGB:255/246/223" 1296) + ("vanillaice" "sRGB:243/217/223" 1295) + ("vanilla" "sRGB:209/190/168" 1294) + ("vancleef" "sRGB:73/23/12" 1293) + ("valhalla" "sRGB:43/25/79" 1292) + ("valentino" "sRGB:53/14/66" 1291) + ("valencia" "sRGB:216/68/55" 1290) + ("twine" "sRGB:194/149/93" 1289) + ("twilightblue" "sRGB:238/253/255" 1288) + ("twilight" "sRGB:228/207/222" 1287) + ("tutu" "sRGB:255/241/249" 1286) + ("tussock" "sRGB:197/153/75" 1285) + ("tusk" "sRGB:238/243/195" 1284) + ("tuscany" "sRGB:189/94/46" 1283) + ("turtlegreen" "sRGB:42/56/11" 1282) + ("turmeric" "sRGB:202/187/72" 1281) + ("turkishrose" "sRGB:181/114/129" 1280) + ("turbo" "sRGB:250/230/0" 1279) + ("tundora" "sRGB:74/66/68" 1278) + ("tuna" "sRGB:53/53/66" 1277) + ("tumbleweed" "sRGB:55/41/14" 1276) + ("tuliptree" "sRGB:234/179/59" 1275) + ("tuftbush" "sRGB:255/221/205" 1274) + ("tuatara" "sRGB:54/53/52" 1273) + ("truev" "sRGB:138/115/214" 1272) + ("trout" "sRGB:74/78/90" 1271) + ("tropicalblue" "sRGB:195/221/249" 1270) + ("trinidad" "sRGB:230/78/3" 1269) + ("trendypink" "sRGB:140/100/149" 1268) + ("trendygreen" "sRGB:124/136/26" 1267) + ("treehouse" "sRGB:59/40/32" 1266) + ("treepoppy" "sRGB:252/156/29" 1265) + ("travertine" "sRGB:255/253/232" 1264) + ("tranquil" "sRGB:230/255/255" 1263) + ("tradewind" "sRGB:95/179/172" 1262) + ("towergrey" "sRGB:169/189/191" 1261) + ("touchwood" "sRGB:55/48/33" 1260) + ("totempole" "sRGB:153/27/7" 1259) + ("tosca" "sRGB:141/63/63" 1258) + ("toryblue" "sRGB:20/80/170" 1257) + ("toreabay" "sRGB:15/45/158" 1256) + ("topaz" "sRGB:124/119/138" 1255) + ("tonyspink" "sRGB:231/159/140" 1254) + ("tomthumb" "sRGB:63/88/59" 1253) + ("tolopea" "sRGB:27/2/69" 1252) + ("toledo" "sRGB:58/0/32" 1251) + ("tobago" "sRGB:62/43/35" 1250) + ("tobaccobrown" "sRGB:113/93/71" 1249) + ("toast" "sRGB:154/110/97" 1248) + ("titanwhite" "sRGB:240/238/255" 1247) + ("timbergreen" "sRGB:22/50/44" 1246) + ("tide" "sRGB:191/184/176" 1245) + ("tidal" "sRGB:241/255/173" 1244) + ("tiber" "sRGB:6/53/55" 1243) + ("tiara" "sRGB:195/209/209" 1242) + ("tiamaria" "sRGB:193/68/14" 1241) + ("thunderbird" "sRGB:192/43/24" 1240) + ("thunder" "sRGB:51/41/47" 1239) + ("thistle" "sRGB:204/202/168" 1238) + ("thatchgreen" "sRGB:64/61/25" 1237) + ("thatch" "sRGB:182/157/152" 1236) + ("texasrose" "sRGB:255/181/85" 1235) + ("texas" "sRGB:248/249/156" 1234) + ("tequila" "sRGB:255/230/199" 1233) + ("temptress" "sRGB:59/0/11" 1232) + ("tealblue" "sRGB:4/66/89" 1231) + ("teakwoodfinish" "sRGB:107/42/20" 1230) + ("teak" "sRGB:177/148/97" 1229) + ("tea" "sRGB:193/186/176" 1228) + ("tepapagreen" "sRGB:30/67/60" 1227) + ("taxbreak" "sRGB:81/128/143" 1226) + ("tawnyport" "sRGB:105/37/69" 1225) + ("taupegrey" "sRGB:179/175/149" 1224) + ("tasman" "sRGB:207/220/207" 1223) + ("tarawera" "sRGB:7/58/80" 1222) + ("tara" "sRGB:225/246/232" 1221) + ("tapestry" "sRGB:176/94/129" 1220) + ("tapa" "sRGB:123/120/116" 1219) + ("tango" "sRGB:237/122/28" 1218) + ("tangerine" "sRGB:233/110/0" 1217) + ("tangaroa" "sRGB:3/22/60" 1216) + ("tana" "sRGB:217/220/193" 1215) + ("tamarind" "sRGB:52/21/21" 1214) + ("tamarillo" "sRGB:153/22/19" 1213) + ("tallow" "sRGB:168/165/137" 1212) + ("tallpoppy" "sRGB:179/45/41" 1211) + ("tahunasands" "sRGB:238/240/200" 1210) + ("tahitigold" "sRGB:233/124/7" 1209) + ("tacha" "sRGB:214/197/98" 1208) + ("tacao" "sRGB:237/179/129" 1207) + ("tabasco" "sRGB:160/39/18" 1206) + ("sycamore" "sRGB:144/141/57" 1205) + ("swisscoffee" "sRGB:221/214/213" 1204) + ("swirl" "sRGB:211/205/197" 1203) + ("sweetpink" "sRGB:253/159/162" 1202) + ("sweetcorn" "sRGB:251/234/140" 1201) + ("swansdown" "sRGB:220/240/234" 1200) + ("swamp" "sRGB:0/27/28" 1199) + ("suvagrey" "sRGB:136/131/135" 1198) + ("sushi" "sRGB:135/171/57" 1197) + ("surfiegreen" "sRGB:12/122/121" 1196) + ("surfcrest" "sRGB:207/229/210" 1195) + ("surf" "sRGB:187/215/193" 1194) + ("supernova" "sRGB:255/201/1" 1193) + ("sunshade" "sRGB:255/158/44" 1192) + ("sunset" "sRGB:220/67/51" 1191) + ("sunglo" "sRGB:225/104/101" 1190) + ("sunflower" "sRGB:228/212/34" 1189) + ("sundown" "sRGB:255/177/179" 1188) + ("sundance" "sRGB:201/179/91" 1187) + ("sun" "sRGB:251/172/19" 1186) + ("summergreen" "sRGB:150/187/171" 1185) + ("sulu" "sRGB:193/240/124" 1184) + ("sugarcane" "sRGB:249/255/246" 1183) + ("submarine" "sRGB:186/199/201" 1182) + ("studio" "sRGB:113/74/178" 1181) + ("stromboli" "sRGB:50/93/82" 1180) + ("strikemaster" "sRGB:149/99/135" 1179) + ("straw" "sRGB:212/191/141" 1178) + ("stratos" "sRGB:0/7/65" 1177) + ("stormgrey" "sRGB:113/116/134" 1176) + ("stormdust" "sRGB:100/100/99" 1175) + ("stonewall" "sRGB:146/133/115" 1174) + ("stinger" "sRGB:139/107/11" 1173) + ("stiletto" "sRGB:156/51/54" 1172) + ("steelgrey" "sRGB:38/35/53" 1171) + ("starship" "sRGB:236/242/69" 1170) + ("starkwhite" "sRGB:229/215/189" 1169) + ("stardust" "sRGB:159/159/156" 1168) + ("stack" "sRGB:138/143/138" 1167) + ("sttropaz" "sRGB:45/86/155" 1166) + ("squirrel" "sRGB:143/129/118" 1165) + ("spunpearl" "sRGB:170/171/183" 1164) + ("sprout" "sRGB:193/215/176" 1163) + ("springwood" "sRGB:248/246/241" 1162) + ("springsun" "sRGB:246/255/220" 1161) + ("springrain" "sRGB:172/203/177" 1160) + ("springgreen" "sRGB:87/131/99" 1159) + ("spray" "sRGB:121/222/236" 1158) + ("splash" "sRGB:255/239/193" 1157) + ("spindle" "sRGB:182/209/234" 1156) + ("spicypink" "sRGB:129/110/113" 1155) + ("spicymix" "sRGB:136/83/66" 1154) + ("spice" "sRGB:106/68/46" 1153) + ("spectra" "sRGB:47/90/87" 1152) + ("spanishwhite" "sRGB:244/235/211" 1151) + ("spanishgreen" "sRGB:129/152/133" 1150) + ("spaceshuttle" "sRGB:67/49/32" 1149) + ("soyabean" "sRGB:106/96/81" 1148) + ("sourdough" "sRGB:209/190/168" 1147) + ("sorrellbrown" "sRGB:206/185/143" 1146) + ("sorbus" "sRGB:253/124/7" 1145) + ("solitude" "sRGB:234/246/255" 1144) + ("solitaire" "sRGB:254/248/226" 1143) + ("solidpink" "sRGB:137/56/67" 1142) + ("softpeach" "sRGB:245/237/239" 1141) + ("softamber" "sRGB:209/198/180" 1140) + ("soapstone" "sRGB:255/251/249" 1139) + ("snuff" "sRGB:226/216/237" 1138) + ("snowymint" "sRGB:214/255/219" 1137) + ("snowflurry" "sRGB:228/255/209" 1136) + ("snowdrift" "sRGB:247/250/247" 1135) + ("smoky" "sRGB:96/91/115" 1134) + ("smokeyash" "sRGB:65/60/55" 1133) + ("smoketree" "sRGB:218/99/4" 1132) + ("smaltblue" "sRGB:81/128/143" 1131) + ("slugger" "sRGB:65/32/16" 1130) + ("skeptic" "sRGB:202/230/218" 1129) + ("sisal" "sRGB:211/203/186" 1128) + ("sirocco" "sRGB:113/128/128" 1127) + ("siren" "sRGB:122/1/58" 1126) + ("sinbad" "sRGB:159/215/211" 1125) + ("silvertree" "sRGB:102/181/143" 1124) + ("silversand" "sRGB:191/193/194" 1123) + ("silverchalice" "sRGB:172/172/172" 1122) + ("silk" "sRGB:189/177/168" 1121) + ("sidecar" "sRGB:243/231/187" 1120) + ("siam" "sRGB:100/106/84" 1119) + ("shuttlegrey" "sRGB:95/102/114" 1118) + ("shocking" "sRGB:226/146/192" 1117) + ("shiraz" "sRGB:178/9/49" 1116) + ("shipgrey" "sRGB:62/58/68" 1115) + ("shipcove" "sRGB:120/139/186" 1114) + ("shinglefawn" "sRGB:107/78/49" 1113) + ("shilo" "sRGB:232/185/179" 1112) + ("sherwoodgreen" "sRGB:2/64/44" 1111) + ("sherpablue" "sRGB:0/73/80" 1110) + ("shark" "sRGB:37/39/44" 1109) + ("shalimar" "sRGB:251/255/186" 1108) + ("shakespeare" "sRGB:78/171/209" 1107) + ("shadylady" "sRGB:170/165/169" 1106) + ("shadowgreen" "sRGB:154/194/184" 1105) + ("serenade" "sRGB:255/244/232" 1104) + ("sepia" "sRGB:43/2/2" 1103) + ("selago" "sRGB:240/238/253" 1102) + ("seaweed" "sRGB:27/47/17" 1101) + ("seashell" "sRGB:241/241/241" 1100) + ("seance" "sRGB:115/30/143" 1099) + ("seagull" "sRGB:128/204/234" 1098) + ("seapink" "sRGB:237/152/158" 1097) + ("seanymph" "sRGB:120/163/156" 1096) + ("seamist" "sRGB:197/219/202" 1095) + ("seagreen" "sRGB:9/88/89" 1094) + ("seafog" "sRGB:252/255/249" 1093) + ("seabuckthorn" "sRGB:251/161/41" 1092) + ("scrub" "sRGB:46/50/34" 1091) + ("scotchmist" "sRGB:255/251/220" 1090) + ("scorpion" "sRGB:105/95/98" 1089) + ("scooter" "sRGB:46/191/212" 1088) + ("schooner" "sRGB:139/132/126" 1087) + ("schist" "sRGB:169/180/151" 1086) + ("scarpaflow" "sRGB:88/85/98" 1085) + ("scarlett" "sRGB:149/0/21" 1084) + ("scarletgum" "sRGB:67/21/96" 1083) + ("scandal" "sRGB:207/250/244" 1082) + ("scampi" "sRGB:103/95/166" 1081) + ("sazerac" "sRGB:255/244/224" 1080) + ("sauvignon" "sRGB:255/245/243" 1079) + ("saratoga" "sRGB:85/91/16" 1078) + ("sapphire" "sRGB:47/81/158" 1077) + ("sapling" "sRGB:222/212/164" 1076) + ("santasgrey" "sRGB:159/160/177" 1075) + ("santafe" "sRGB:177/109/82" 1074) + ("sanguinebrown" "sRGB:141/61/56" 1073) + ("sangria" "sRGB:146/0/10" 1072) + ("sandybeach" "sRGB:255/234/200" 1071) + ("sandwisp" "sRGB:245/231/162" 1070) + ("sandstone" "sRGB:121/109/98" 1069) + ("sandrift" "sRGB:171/145/122" 1068) + ("sandal" "sRGB:170/141/111" 1067) + ("sanddune" "sRGB:130/111/101" 1066) + ("sanmarino" "sRGB:69/108/172" 1065) + ("sanjuan" "sRGB:48/75/106" 1064) + ("sanfelix" "sRGB:11/98/7" 1063) + ("sambuca" "sRGB:58/32/16" 1062) + ("saltpan" "sRGB:241/247/242" 1061) + ("saltbox" "sRGB:104/94/110" 1060) + ("salomie" "sRGB:254/219/141" 1059) + ("salem" "sRGB:9/127/75" 1058) + ("sail" "sRGB:184/224/249" 1057) + ("sahara" "sRGB:183/162/20" 1056) + ("sage" "sRGB:158/165/135" 1055) + ("saffron" "sRGB:249/191/88" 1054) + ("saddlebrown" "sRGB:88/52/1" 1053) + ("saddle" "sRGB:76/48/36" 1052) + ("rustynail" "sRGB:134/86/10" 1051) + ("rusticred" "sRGB:72/4/4" 1050) + ("russett" "sRGB:117/90/87" 1049) + ("rumswizzle" "sRGB:249/248/228" 1048) + ("rum" "sRGB:121/105/137" 1047) + ("royalheath" "sRGB:171/52/114" 1046) + ("rouge" "sRGB:162/59/108" 1045) + ("roti" "sRGB:198/168/75" 1044) + ("rosewood" "sRGB:101/0/11" 1043) + ("rosewhite" "sRGB:255/246/245" 1042) + ("roseofsharon" "sRGB:191/85/0" 1041) + ("rosebudcherry" "sRGB:128/11/71" 1040) + ("rosebud" "sRGB:251/178/163" 1039) + ("rose" "sRGB:231/188/180" 1038) + ("rope" "sRGB:142/77/30" 1037) + ("roofterracotta" "sRGB:166/47/32" 1036) + ("ronchi" "sRGB:236/197/78" 1035) + ("romantic" "sRGB:255/210/183" 1034) + ("romance" "sRGB:255/254/253" 1033) + ("romancoffee" "sRGB:121/93/76" 1032) + ("roman" "sRGB:222/99/96" 1031) + ("rollingstone" "sRGB:116/125/131" 1030) + ("rodeodust" "sRGB:201/178/155" 1029) + ("rockspray" "sRGB:186/69/12" 1028) + ("rocksalt" "sRGB:255/255/255" 1027) + ("rockblue" "sRGB:158/177/205" 1026) + ("rock" "sRGB:77/56/51" 1025) + ("robinseggblue" "sRGB:189/200/179" 1024) + ("robroy" "sRGB:234/198/116" 1023) + ("riverbed" "sRGB:67/76/89" 1022) + ("riptide" "sRGB:139/230/216" 1021) + ("riogrande" "sRGB:187/208/9" 1020) + ("richgold" "sRGB:168/83/7" 1019) + ("riceflower" "sRGB:238/255/226" 1018) + ("ricecake" "sRGB:255/254/240" 1017) + ("ribbon" "sRGB:102/0/69" 1016) + ("rhino" "sRGB:46/63/98" 1015) + ("revolver" "sRGB:44/22/50" 1014) + ("resolutionblue" "sRGB:0/35/135" 1013) + ("renosand" "sRGB:168/101/21" 1012) + ("remy" "sRGB:254/235/243" 1011) + ("regentstblue" "sRGB:170/214/230" 1010) + ("regentgrey" "sRGB:134/148/159" 1009) + ("regalblue" "sRGB:1/63/106" 1008) + ("reefgold" "sRGB:159/130/28" 1007) + ("reef" "sRGB:201/255/162" 1006) + ("redwood" "sRGB:93/30/15" 1005) + ("redstage" "sRGB:208/95/4" 1004) + ("redrobin" "sRGB:128/52/31" 1003) + ("redoxide" "sRGB:110/9/2" 1002) + ("reddevil" "sRGB:134/1/17" 1001) + ("reddamask" "sRGB:218/106/65" 1000) + ("redberry" "sRGB:142/0/0" 999) + ("redbeech" "sRGB:123/56/1" 998) + ("rebel" "sRGB:60/18/6" 997) + ("raven" "sRGB:114/123/137" 996) + ("rangoongreen" "sRGB:28/30/19" 995) + ("rangitoto" "sRGB:46/50/34" 994) + ("rajah" "sRGB:247/182/104" 993) + ("rainee" "sRGB:185/200/172" 992) + ("raincloud" "sRGB:123/124/148" 991) + ("rainforest" "sRGB:119/129/32" 990) + ("raffia" "sRGB:234/218/184" 989) + ("racinggreen" "sRGB:12/25/17" 988) + ("quincy" "sRGB:98/63/45" 987) + ("quillgrey" "sRGB:214/214/209" 986) + ("quicksand" "sRGB:189/151/142" 985) + ("quarterspanishwhite" "sRGB:247/242/225" 984) + ("quarterpearllusta" "sRGB:255/253/244" 983) + ("putty" "sRGB:231/205/140" 982) + ("punga" "sRGB:77/61/20" 981) + ("punch" "sRGB:220/67/51" 980) + ("pumpkin" "sRGB:177/97/11" 979) + ("pumice" "sRGB:194/202/196" 978) + ("puertorico" "sRGB:63/193/170" 977) + ("pueblo" "sRGB:125/44/20" 976) + ("prussianblue" "sRGB:0/49/83" 975) + ("provincialpink" "sRGB:254/245/241" 974) + ("promenade" "sRGB:252/255/231" 973) + ("primrose" "sRGB:237/234/153" 972) + ("prim" "sRGB:240/226/236" 971) + ("prelude" "sRGB:208/192/229" 970) + ("prairiesand" "sRGB:154/56/32" 969) + ("powderblue" "sRGB:188/201/194" 968) + ("pottersclay" "sRGB:140/87/56" 967) + ("potpourri" "sRGB:245/231/226" 966) + ("portica" "sRGB:249/230/99" 965) + ("portage" "sRGB:139/159/238" 964) + ("portafino" "sRGB:255/255/180" 963) + ("portgore" "sRGB:37/31/79" 962) + ("porsche" "sRGB:234/174/105" 961) + ("porcelain" "sRGB:239/242/243" 960) + ("pompadour" "sRGB:102/0/69" 959) + ("poloblue" "sRGB:141/168/204" 958) + ("polar" "sRGB:229/249/246" 957) + ("pohutukawa" "sRGB:143/2/28" 956) + ("plum" "sRGB:65/0/86" 955) + ("planter" "sRGB:97/93/48" 954) + ("plantation" "sRGB:39/80/75" 953) + ("pizza" "sRGB:201/148/21" 952) + ("pizazz" "sRGB:255/144/0" 951) + ("pixiegreen" "sRGB:192/216/182" 950) + ("pistachio" "sRGB:157/194/9" 949) + ("pirategold" "sRGB:186/127/3" 948) + ("pippin" "sRGB:255/225/223" 947) + ("pipi" "sRGB:254/244/204" 946) + ("piper" "sRGB:201/99/35" 945) + ("pinkswan" "sRGB:190/181/183" 944) + ("pinklady" "sRGB:255/241/216" 943) + ("pinklace" "sRGB:255/221/244" 942) + ("pinkflare" "sRGB:225/192/200" 941) + ("pinetree" "sRGB:23/31/4" 940) + ("pineglade" "sRGB:199/205/144" 939) + ("pinecone" "sRGB:109/94/84" 938) + ("pigeonpost" "sRGB:175/189/217" 937) + ("pictonblue" "sRGB:69/177/232" 936) + ("pickledbluewood" "sRGB:49/68/89" 935) + ("pickledbean" "sRGB:110/72/38" 934) + ("pickledaspen" "sRGB:63/76/58" 933) + ("picasso" "sRGB:255/243/157" 932) + ("pharlap" "sRGB:163/128/123" 931) + ("pewter" "sRGB:150/168/161" 930) + ("petiteorchid" "sRGB:219/150/144" 929) + ("pesto" "sRGB:124/118/49" 928) + ("perutan" "sRGB:127/58/2" 927) + ("persimmon" "sRGB:255/107/83" 926) + ("persianred" "sRGB:82/12/23" 925) + ("persianplum" "sRGB:112/28/28" 924) + ("periglacialblue" "sRGB:225/230/214" 923) + ("perfume" "sRGB:208/190/248" 922) + ("perano" "sRGB:169/190/242" 921) + ("peppermint" "sRGB:227/245/225" 920) + ("pelorous" "sRGB:62/171/191" 919) + ("peat" "sRGB:113/107/86" 918) + ("pearllusta" "sRGB:252/244/220" 917) + ("pearlbush" "sRGB:232/224/213" 916) + ("peanut" "sRGB:120/47/22" 915) + ("peachschnapps" "sRGB:255/220/214" 914) + ("peach" "sRGB:255/240/219" 913) + ("peasoup" "sRGB:207/229/210" 912) + ("pavlova" "sRGB:215/196/152" 911) + ("paua" "sRGB:38/3/104" 910) + ("pattensblue" "sRGB:222/245/255" 909) + ("patina" "sRGB:99/154/143" 908) + ("parsley" "sRGB:19/79/25" 907) + ("pariswhite" "sRGB:202/220/212" 906) + ("parism" "sRGB:38/5/106" 905) + ("parisdaisy" "sRGB:255/244/110" 904) + ("parchment" "sRGB:241/233/210" 903) + ("paradiso" "sRGB:49/125/130" 902) + ("paprika" "sRGB:141/2/38" 901) + ("panda" "sRGB:66/57/33" 900) + ("pancho" "sRGB:237/205/171" 899) + ("panache" "sRGB:234/246/238" 898) + ("pampas" "sRGB:244/242/238" 897) + ("palmleaf" "sRGB:25/51/14" 896) + ("palmgreen" "sRGB:9/35/15" 895) + ("paleslate" "sRGB:195/191/193" 894) + ("palesky" "sRGB:110/119/131" 893) + ("palerose" "sRGB:255/225/242" 892) + ("paleprim" "sRGB:253/254/184" 891) + ("paleoyster" "sRGB:152/141/119" 890) + ("paleleaf" "sRGB:192/211/185" 889) + ("padua" "sRGB:173/230/196" 888) + ("paco" "sRGB:65/31/16" 887) + ("pacifika" "sRGB:119/129/32" 886) + ("pablo" "sRGB:119/111/97" 885) + ("paarl" "sRGB:166/85/41" 884) + ("oysterpink" "sRGB:233/206/205" 883) + ("oysterbay" "sRGB:218/250/255" 882) + ("oxley" "sRGB:119/158/134" 881) + ("oxfordblue" "sRGB:56/69/85" 880) + ("outerspace" "sRGB:5/16/64" 879) + ("ottoman" "sRGB:233/248/237" 878) + ("oslogrey" "sRGB:135/141/145" 877) + ("orinoco" "sRGB:243/251/212" 876) + ("orientalpink" "sRGB:198/145/145" 875) + ("orient" "sRGB:1/94/133" 874) + ("oregon" "sRGB:155/71/3" 873) + ("orchidwhite" "sRGB:255/253/243" 872) + ("orangewhite" "sRGB:254/252/237" 871) + ("orangeroughy" "sRGB:196/87/25" 870) + ("oracle" "sRGB:55/116/117" 869) + ("opium" "sRGB:142/111/112" 868) + ("opal" "sRGB:169/198/194" 867) + ("onion" "sRGB:47/39/14" 866) + ("onahau" "sRGB:205/244/255" 865) + ("olivetone" "sRGB:113/110/16" 864) + ("olivehaze" "sRGB:139/132/112" 863) + ("olivegreen" "sRGB:36/46/22" 862) + ("oldcopper" "sRGB:114/74/47" 861) + ("oldbrick" "sRGB:144/30/30" 860) + ("oiledcedar" "sRGB:124/28/5" 859) + ("oil" "sRGB:40/30/21" 858) + ("offyellow" "sRGB:254/249/227" 857) + ("offgreen" "sRGB:230/248/243" 856) + ("oceangreen" "sRGB:65/170/120" 855) + ("observatory" "sRGB:2/134/111" 854) + ("oasis" "sRGB:254/239/206" 853) + ("nutmegwoodfinish" "sRGB:104/54/0" 852) + ("nutmeg" "sRGB:129/66/44" 851) + ("nugget" "sRGB:197/153/34" 850) + ("norway" "sRGB:168/189/159" 849) + ("nordic" "sRGB:1/39/49" 848) + ("nomad" "sRGB:186/177/162" 847) + ("nobel" "sRGB:183/177/177" 846) + ("nileblue" "sRGB:25/55/81" 845) + ("nightclub" "sRGB:102/0/69" 844) + ("nightshadz" "sRGB:170/55/90" 843) + ("nightrider" "sRGB:31/18/15" 842) + ("niagara" "sRGB:6/161/137" 841) + ("newyorkpink" "sRGB:215/131/127" 840) + ("neworleans" "sRGB:243/214/157" 839) + ("newamber" "sRGB:123/56/1" 838) + ("nevada" "sRGB:100/110/117" 837) + ("neutralgreen" "sRGB:172/165/134" 836) + ("nero" "sRGB:20/6/0" 835) + ("neptune" "sRGB:124/183/187" 834) + ("nepal" "sRGB:142/171/193" 833) + ("negroni" "sRGB:255/226/197" 832) + ("nebula" "sRGB:203/219/214" 831) + ("natural" "sRGB:134/86/10" 830) + ("narvik" "sRGB:237/249/241" 829) + ("napa" "sRGB:172/164/148" 828) + ("nandor" "sRGB:75/93/82" 827) + ("mystic" "sRGB:226/235/237" 826) + ("mysin" "sRGB:255/179/31" 825) + ("mypink" "sRGB:214/145/136" 824) + ("mustard" "sRGB:116/100/13" 823) + ("mulledwine" "sRGB:78/69/98" 822) + ("mulefawn" "sRGB:140/71/47" 821) + ("mulberry" "sRGB:92/5/54" 820) + ("muesli" "sRGB:170/139/91" 819) + ("muddywaters" "sRGB:183/142/92" 818) + ("mountainmist" "sRGB:149/147/150" 817) + ("mosque" "sRGB:3/106/110" 816) + ("mosaic" "sRGB:18/52/71" 815) + ("mortar" "sRGB:80/67/81" 814) + ("moroccobrown" "sRGB:68/29/0" 813) + ("morningglory" "sRGB:158/222/224" 812) + ("moonyellow" "sRGB:252/217/23" 811) + ("moonraker" "sRGB:214/206/246" 810) + ("moonmist" "sRGB:220/221/204" 809) + ("moonglow" "sRGB:252/254/218" 808) + ("moodyblue" "sRGB:127/118/211" 807) + ("monza" "sRGB:199/3/30" 806) + ("montecarlo" "sRGB:131/208/198" 805) + ("montana" "sRGB:41/30/48" 804) + ("monsoon" "sRGB:138/131/137" 803) + ("mongoose" "sRGB:181/162/127" 802) + ("mondo" "sRGB:74/60/48" 801) + ("monarch" "sRGB:139/7/35" 800) + ("monalisa" "sRGB:255/161/148" 799) + ("mojo" "sRGB:192/71/55" 798) + ("mocha" "sRGB:120/45/25" 797) + ("moccaccino" "sRGB:110/29/20" 796) + ("mobster" "sRGB:127/117/137" 795) + ("mistgrey" "sRGB:196/196/188" 794) + ("mischka" "sRGB:209/210/221" 793) + ("mirage" "sRGB:22/25/40" 792) + ("minttulip" "sRGB:196/244/235" 791) + ("mintjulep" "sRGB:241/238/193" 790) + ("minsk" "sRGB:63/48/127" 789) + ("ming" "sRGB:54/116/125" 788) + ("mineralgreen" "sRGB:63/93/83" 787) + ("mineshaft" "sRGB:50/50/50" 786) + ("mindaro" "sRGB:227/249/136" 785) + ("mimosa" "sRGB:248/253/211" 784) + ("millbrook" "sRGB:89/68/51" 783) + ("milkwhite" "sRGB:246/240/230" 782) + ("milkpunch" "sRGB:255/246/212" 781) + ("milanored" "sRGB:184/17/4" 780) + ("milan" "sRGB:250/255/164" 779) + ("mikado" "sRGB:45/37/16" 778) + ("midnightmoss" "sRGB:4/16/4" 777) + ("midnightexpress" "sRGB:0/7/65" 776) + ("midnight" "sRGB:1/22/53" 775) + ("midgrey" "sRGB:95/95/110" 774) + ("mexicanred" "sRGB:167/37/37" 773) + ("meteorite" "sRGB:60/31/118" 772) + ("meteor" "sRGB:208/125/18" 771) + ("metalliccopper" "sRGB:113/41/29" 770) + ("metallicbronze" "sRGB:73/55/27" 769) + ("merlot" "sRGB:131/25/35" 768) + ("merlin" "sRGB:65/60/55" 767) + ("merino" "sRGB:246/240/230" 766) + ("mercury" "sRGB:229/229/229" 765) + ("meranti" "sRGB:93/30/15" 764) + ("melrose" "sRGB:199/193/255" 763) + ("melanzane" "sRGB:48/5/41" 762) + ("melanie" "sRGB:228/194/213" 761) + ("mckenzie" "sRGB:175/135/81" 760) + ("maverick" "sRGB:216/194/213" 759) + ("matterhorn" "sRGB:78/59/65" 758) + ("matrix" "sRGB:176/93/84" 757) + ("matisse" "sRGB:27/101/157" 756) + ("mash" "sRGB:64/41/29" 755) + ("masala" "sRGB:64/59/56" 754) + ("marzipan" "sRGB:248/219/157" 753) + ("martinique" "sRGB:54/48/80" 752) + ("martini" "sRGB:175/160/158" 751) + ("marshland" "sRGB:11/15/8" 750) + ("maroon" "sRGB:66/3/3" 749) + ("marlin" "sRGB:42/20/14" 748) + ("mariner" "sRGB:40/106/205" 747) + ("marigold" "sRGB:185/141/40" 746) + ("mardigras" "sRGB:53/0/54" 745) + ("manz" "sRGB:238/239/120" 744) + ("mantle" "sRGB:139/156/144" 743) + ("mantis" "sRGB:116/195/101" 742) + ("manhattan" "sRGB:245/201/153" 741) + ("mandyspink" "sRGB:242/195/178" 740) + ("mandy" "sRGB:226/84/101" 739) + ("mandalay" "sRGB:173/120/27" 738) + ("mamba" "sRGB:142/129/144" 737) + ("malta" "sRGB:189/178/161" 736) + ("mallard" "sRGB:35/52/24" 735) + ("malibu" "sRGB:125/200/247" 734) + ("malachitegreen" "sRGB:136/141/101" 733) + ("mako" "sRGB:68/73/84" 732) + ("makara" "sRGB:137/125/109" 731) + ("maize" "sRGB:245/213/160" 730) + ("maire" "sRGB:19/10/6" 729) + ("maitai" "sRGB:176/102/8" 728) + ("mahogany" "sRGB:78/6/6" 727) + ("magnolia" "sRGB:248/244/255" 726) + ("madras" "sRGB:63/48/2" 725) + ("madison" "sRGB:9/37/93" 724) + ("madang" "sRGB:183/240/190" 723) + ("mabel" "sRGB:217/247/255" 722) + ("lynch" "sRGB:105/126/154" 721) + ("luxorgold" "sRGB:167/136/44" 720) + ("lusty" "sRGB:153/27/7" 719) + ("lunargreen" "sRGB:60/73/58" 718) + ("luckypoint" "sRGB:26/26/104" 717) + ("lucky" "sRGB:175/159/28" 716) + ("loulou" "sRGB:70/11/65" 715) + ("lotus" "sRGB:134/60/60" 714) + ("lonestar" "sRGB:109/1/1" 713) + ("londonhue" "sRGB:190/166/195" 712) + ("lola" "sRGB:223/207/219" 711) + ("logan" "sRGB:170/169/205" 710) + ("logcabin" "sRGB:36/42/29" 709) + ("locust" "sRGB:168/175/142" 708) + ("lochmara" "sRGB:0/126/199" 707) + ("lochinvar" "sRGB:44/140/132" 706) + ("loblolly" "sRGB:189/201/206" 705) + ("loafer" "sRGB:238/244/222" 704) + ("lividbrown" "sRGB:77/40/46" 703) + ("lisbonbrown" "sRGB:66/57/33" 702) + ("lipstick" "sRGB:171/5/99" 701) + ("linkwater" "sRGB:217/228/245" 700) + ("linen" "sRGB:230/228/212" 699) + ("limerick" "sRGB:157/194/9" 698) + ("limedspruce" "sRGB:57/72/81" 697) + ("limedoak" "sRGB:172/138/86" 696) + ("limedgum" "sRGB:66/57/33" 695) + ("limedash" "sRGB:116/125/99" 694) + ("limeade" "sRGB:111/157/2" 693) + ("lime" "sRGB:191/201/33" 692) + ("lima" "sRGB:118/189/23" 691) + ("lilywhite" "sRGB:231/248/255" 690) + ("lily" "sRGB:200/170/191" 689) + ("lilacbush" "sRGB:152/116/211" 688) + ("lightningyellow" "sRGB:252/192/30" 687) + ("licorice" "sRGB:9/34/86" 686) + ("lemongrass" "sRGB:155/158/143" 685) + ("lemonginger" "sRGB:172/158/34" 684) + ("lemon" "sRGB:244/216/28" 683) + ("leather" "sRGB:150/112/89" 682) + ("lavender" "sRGB:168/153/230" 681) + ("laurel" "sRGB:116/147/120" 680) + ("laser" "sRGB:200/181/104" 679) + ("laspalmas" "sRGB:198/230/16" 678) + ("larioja" "sRGB:179/193/16" 677) + ("lapalma" "sRGB:54/135/22" 676) + ("kumera" "sRGB:136/98/33" 675) + ("kournikova" "sRGB:255/231/114" 674) + ("koromiko" "sRGB:255/189/95" 673) + ("korma" "sRGB:143/75/14" 672) + ("kokoda" "sRGB:110/109/87" 671) + ("kobi" "sRGB:231/159/196" 670) + ("kingfisherdaisy" "sRGB:62/4/128" 669) + ("kimberly" "sRGB:115/108/159" 668) + ("killarney" "sRGB:58/106/71" 667) + ("kilamanjaro" "sRGB:36/12/2" 666) + ("kidnapper" "sRGB:225/234/212" 665) + ("keppel" "sRGB:58/176/158" 664) + ("kenyancopper" "sRGB:124/28/5" 663) + ("kelp" "sRGB:69/73/54" 662) + ("kashmirblue" "sRGB:80/112/150" 661) + ("karry" "sRGB:255/234/212" 660) + ("karaka" "sRGB:30/22/9" 659) + ("kangaroo" "sRGB:198/200/189" 658) + ("kaitokegreen" "sRGB:0/70/32" 657) + ("kabul" "sRGB:94/72/62" 656) + ("justright" "sRGB:236/205/185" 655) + ("juniper" "sRGB:109/146/146" 654) + ("junglemist" "sRGB:180/207/211" 653) + ("junglegreen" "sRGB:40/30/21" 652) + ("jumbo" "sRGB:124/123/130" 651) + ("judgegrey" "sRGB:84/67/51" 650) + ("jordyblue" "sRGB:138/185/241" 649) + ("jonquil" "sRGB:238/255/154" 648) + ("jon" "sRGB:59/31/31" 647) + ("joanna" "sRGB:245/243/229" 646) + ("jewel" "sRGB:18/107/64" 645) + ("jetstream" "sRGB:181/210/206" 644) + ("jellybean" "sRGB:41/123/154" 643) + ("jazz" "sRGB:120/1/9" 642) + ("java" "sRGB:31/194/194" 641) + ("jarrah" "sRGB:52/21/21" 640) + ("japonica" "sRGB:216/124/99" 639) + ("japanesemaple" "sRGB:120/1/9" 638) + ("japaneselaurel" "sRGB:10/105/6" 637) + ("janna" "sRGB:244/235/211" 636) + ("jambalaya" "sRGB:91/48/19" 635) + ("jaguar" "sRGB:8/1/16" 634) + ("jagger" "sRGB:53/14/87" 633) + ("jaggedice" "sRGB:194/232/229" 632) + ("jaffa" "sRGB:239/134/63" 631) + ("jade" "sRGB:66/121/119" 630) + ("jacksonspurple" "sRGB:32/32/141" 629) + ("jackobean" "sRGB:46/25/5" 628) + ("jacarta" "sRGB:58/42/106" 627) + ("jacaranda" "sRGB:46/3/41" 626) + ("islandspice" "sRGB:255/252/238" 625) + ("ironstone" "sRGB:134/72/60" 624) + ("ironsidegrey" "sRGB:103/102/98" 623) + ("ironbark" "sRGB:65/31/16" 622) + ("iron" "sRGB:212/215/217" 621) + ("iroko" "sRGB:67/49/32" 620) + ("irishcoffee" "sRGB:95/61/38" 619) + ("indochine" "sRGB:194/107/3" 618) + ("indiantan" "sRGB:77/30/1" 617) + ("illusion" "sRGB:246/164/201" 616) + ("iceberg" "sRGB:218/244/240" 615) + ("icecold" "sRGB:177/244/231" 614) + ("husk" "sRGB:183/164/88" 613) + ("hurricane" "sRGB:135/124/123" 612) + ("huntergreen" "sRGB:22/29/16" 611) + ("hummingbird" "sRGB:207/249/243" 610) + ("hottoddy" "sRGB:179/128/7" 609) + ("hotpurple" "sRGB:72/6/86" 608) + ("hotcurry" "sRGB:136/98/33" 607) + ("hotchile" "sRGB:139/7/35" 606) + ("horsesneck" "sRGB:96/73/19" 605) + ("horizon" "sRGB:90/135/160" 604) + ("hopbush" "sRGB:208/109/161" 603) + ("honeysuckle" "sRGB:237/252/132" 602) + ("honeyflower" "sRGB:79/28/112" 601) + ("holly" "sRGB:1/29/19" 600) + ("hoki" "sRGB:101/134/159" 599) + ("hokeypokey" "sRGB:200/165/40" 598) + ("hitpink" "sRGB:255/171/129" 597) + ("hitgrey" "sRGB:161/173/181" 596) + ("hippiepink" "sRGB:174/69/96" 595) + ("hippiegreen" "sRGB:83/130/75" 594) + ("hippieblue" "sRGB:88/154/175" 593) + ("hintofyellow" "sRGB:250/253/228" 592) + ("hintofred" "sRGB:249/249/249" 591) + ("hintofgrey" "sRGB:252/255/249" 590) + ("hintofgreen" "sRGB:230/255/233" 589) + ("himalaya" "sRGB:106/93/27" 588) + ("hillary" "sRGB:172/165/134" 587) + ("highland" "sRGB:111/142/99" 586) + ("highball" "sRGB:144/141/57" 585) + ("hibiscus" "sRGB:182/49/108" 584) + ("hemp" "sRGB:144/120/116" 583) + ("hemlock" "sRGB:94/93/59" 582) + ("heavymetal" "sRGB:43/50/40" 581) + ("heatheredgrey" "sRGB:182/176/149" 580) + ("heather" "sRGB:183/195/208" 579) + ("heath" "sRGB:84/16/18" 578) + ("hawkesblue" "sRGB:212/226/252" 577) + ("hawaiiantan" "sRGB:157/86/22" 576) + ("havelockblue" "sRGB:85/144/217" 575) + ("havana" "sRGB:52/21/21" 574) + ("harvestgold" "sRGB:224/185/116" 573) + ("harp" "sRGB:230/242/234" 572) + ("hampton" "sRGB:229/216/175" 571) + ("halfspanishwhite" "sRGB:254/244/219" 570) + ("halfpearllusta" "sRGB:255/252/234" 569) + ("halfdutchwhite" "sRGB:254/247/222" 568) + ("halfcolonialwhite" "sRGB:253/246/211" 567) + ("halfbaked" "sRGB:133/196/204" 566) + ("halfandhalf" "sRGB:255/254/225" 565) + ("haiti" "sRGB:27/16/53" 564) + ("hairyheath" "sRGB:107/42/20" 563) + ("hacienda" "sRGB:152/129/27" 562) + ("gurkha" "sRGB:154/149/119" 561) + ("gunsmoke" "sRGB:130/134/133" 560) + ("gunmetal" "sRGB:2/13/21" 559) + ("gunpowder" "sRGB:65/66/87" 558) + ("gumbo" "sRGB:124/161/166" 557) + ("gumleaf" "sRGB:182/211/191" 556) + ("gullgrey" "sRGB:157/172/183" 555) + ("gulfstream" "sRGB:128/179/174" 554) + ("gulfblue" "sRGB:5/22/87" 553) + ("guardsmanred" "sRGB:186/1/1" 552) + ("greysuit" "sRGB:193/190/205" 551) + ("greyolive" "sRGB:169/164/145" 550) + ("greynurse" "sRGB:231/236/230" 549) + ("greynickel" "sRGB:195/195/189" 548) + ("greygreen" "sRGB:69/73/54" 547) + ("greychateau" "sRGB:162/170/179" 546) + ("grenadier" "sRGB:213/70/0" 545) + ("greenstone" "sRGB:0/62/64" 544) + ("greenwhite" "sRGB:232/235/224" 543) + ("greenwaterloo" "sRGB:16/20/5" 542) + ("greenvogue" "sRGB:3/43/82" 541) + ("greenspring" "sRGB:184/193/177" 540) + ("greensmoke" "sRGB:164/175/110" 539) + ("greenpea" "sRGB:29/97/66" 538) + ("greenmist" "sRGB:203/211/176" 537) + ("greenleaf" "sRGB:67/106/13" 536) + ("greenkelp" "sRGB:37/49/28" 535) + ("greenhouse" "sRGB:36/80/15" 534) + ("gravel" "sRGB:74/68/75" 533) + ("grasshopper" "sRGB:124/118/49" 532) + ("graphite" "sRGB:37/22/7" 531) + ("grape" "sRGB:56/26/81" 530) + ("grannysmith" "sRGB:132/160/160" 529) + ("grannyapple" "sRGB:213/246/227" 528) + ("granitegreen" "sRGB:141/137/116" 527) + ("grandis" "sRGB:255/211/140" 526) + ("grainbrown" "sRGB:228/213/183" 525) + ("governorbay" "sRGB:47/60/179" 524) + ("gothic" "sRGB:109/146/161" 523) + ("gossip" "sRGB:210/248/176" 522) + ("gossamer" "sRGB:6/155/129" 521) + ("gorse" "sRGB:255/241/79" 520) + ("gordonsgreen" "sRGB:11/17/7" 519) + ("gondola" "sRGB:38/20/20" 518) + ("goldentainoi" "sRGB:255/204/92" 517) + ("goldensand" "sRGB:240/219/125" 516) + ("goldenglow" "sRGB:253/226/149" 515) + ("goldenfizz" "sRGB:245/251/61" 514) + ("goldendream" "sRGB:240/213/45" 513) + ("goldenbell" "sRGB:226/137/19" 512) + ("goldtips" "sRGB:222/186/19" 511) + ("golddrop" "sRGB:241/130/0" 510) + ("goblin" "sRGB:61/125/82" 509) + ("goben" "sRGB:114/109/78" 508) + ("gladegreen" "sRGB:97/132/95" 507) + ("glacier" "sRGB:128/179/196" 506) + ("givry" "sRGB:248/228/191" 505) + ("ginfizz" "sRGB:255/249/226" 504) + ("gin" "sRGB:232/242/235" 503) + ("gimblet" "sRGB:184/181/106" 502) + ("gigas" "sRGB:82/60/148" 501) + ("ghost" "sRGB:199/201/213" 500) + ("geyser" "sRGB:212/223/226" 499) + ("geraldine" "sRGB:251/137/137" 498) + ("genoa" "sRGB:21/115/107" 497) + ("geebung" "sRGB:209/143/27" 496) + ("galliano" "sRGB:220/178/12" 495) + ("gallery" "sRGB:239/239/239" 494) + ("gablegreen" "sRGB:22/53/49" 493) + ("fuscousgrey" "sRGB:84/83/77" 492) + ("fungreen" "sRGB:1/109/57" 491) + ("funblue" "sRGB:25/89/168" 490) + ("fuelyellow" "sRGB:236/169/39" 489) + ("fuego" "sRGB:190/222/13" 488) + ("fuchsia" "sRGB:122/88/193" 487) + ("fruitsalad" "sRGB:79/157/93" 486) + ("frostee" "sRGB:228/246/231" 485) + ("frostedmint" "sRGB:219/255/248" 484) + ("frost" "sRGB:237/245/221" 483) + ("froly" "sRGB:245/117/132" 482) + ("fringyflower" "sRGB:177/226/193" 481) + ("friargrey" "sRGB:128/126/121" 480) + ("frenchpass" "sRGB:189/237/253" 479) + ("frenchlilac" "sRGB:236/199/238" 478) + ("frenchgrey" "sRGB:189/189/198" 477) + ("frangipani" "sRGB:255/222/179" 476) + ("fountainblue" "sRGB:86/180/190" 475) + ("forgetmenot" "sRGB:255/241/238" 474) + ("forestgreen" "sRGB:24/45/9" 473) + ("foggygrey" "sRGB:203/202/182" 472) + ("fog" "sRGB:215/208/255" 471) + ("foam" "sRGB:216/252/250" 470) + ("flirt" "sRGB:162/0/109" 469) + ("flint" "sRGB:111/106/97" 468) + ("flax" "sRGB:123/130/101" 467) + ("flamingo" "sRGB:242/85/42" 466) + ("flamenco" "sRGB:255/125/7" 465) + ("flamered" "sRGB:199/3/30" 464) + ("flamepea" "sRGB:218/91/56" 463) + ("firefly" "sRGB:14/42/48" 462) + ("firebush" "sRGB:232/153/40" 461) + ("fire" "sRGB:170/66/3" 460) + ("fiord" "sRGB:64/81/105" 459) + ("finn" "sRGB:105/45/84" 458) + ("finlandia" "sRGB:85/109/86" 457) + ("finch" "sRGB:98/102/73" 456) + ("fijigreen" "sRGB:101/114/32" 455) + ("fieryorange" "sRGB:179/82/19" 454) + ("feta" "sRGB:240/252/234" 453) + ("festival" "sRGB:251/233/108" 452) + ("ferra" "sRGB:112/79/80" 451) + ("fernfrond" "sRGB:101/114/32" 450) + ("fern" "sRGB:10/72/13" 449) + ("feijoa" "sRGB:159/221/140" 448) + ("fedora" "sRGB:121/106/120" 447) + ("fantasy" "sRGB:250/243/240" 446) + ("falcon" "sRGB:127/98/109" 445) + ("fairpink" "sRGB:255/239/236" 444) + ("everglade" "sRGB:28/64/46" 443) + ("eveningsea" "sRGB:2/78/70" 442) + ("eunry" "sRGB:207/163/157" 441) + ("eucalyptus" "sRGB:39/138/91" 440) + ("eternity" "sRGB:33/26/14" 439) + ("espresso" "sRGB:97/39/24" 438) + ("equator" "sRGB:225/188/100" 437) + ("envy" "sRGB:139/166/144" 436) + ("englishwalnut" "sRGB:62/43/35" 435) + ("englishholly" "sRGB:2/45/21" 434) + ("energyyellow" "sRGB:248/221/92" 433) + ("endeavour" "sRGB:0/86/167" 432) + ("empress" "sRGB:129/115/119" 431) + ("emperor" "sRGB:81/70/73" 430) + ("eminence" "sRGB:108/48/130" 429) + ("embers" "sRGB:160/39/18" 428) + ("elm" "sRGB:28/124/125" 427) + ("elfgreen" "sRGB:8/131/112" 426) + ("elephant" "sRGB:18/52/71" 425) + ("elsalva" "sRGB:143/62/51" 424) + ("elpaso" "sRGB:30/23/8" 423) + ("eggwhite" "sRGB:255/239/193" 422) + ("eggsour" "sRGB:255/244/221" 421) + ("edward" "sRGB:162/174/171" 420) + ("edgewater" "sRGB:200/227/215" 419) + ("eden" "sRGB:16/88/82" 418) + ("ecstasy" "sRGB:250/120/20" 417) + ("ecruwhite" "sRGB:245/243/229" 416) + ("eclipse" "sRGB:49/28/23" 415) + ("echoblue" "sRGB:175/189/217" 414) + ("ebonyclay" "sRGB:38/40/59" 413) + ("ebony" "sRGB:12/11/29" 412) + ("ebb" "sRGB:233/227/227" 411) + ("easternblue" "sRGB:30/154/176" 410) + ("eastside" "sRGB:172/145/206" 409) + ("eastbay" "sRGB:65/76/125" 408) + ("earlydawn" "sRGB:255/249/230" 407) + ("earlsgreen" "sRGB:201/185/59" 406) + ("eagle" "sRGB:182/186/164" 405) + ("dutchwhite" "sRGB:255/248/209" 404) + ("dustygrey" "sRGB:168/152/155" 403) + ("duststorm" "sRGB:229/204/201" 402) + ("dune" "sRGB:56/53/51" 401) + ("drover" "sRGB:253/247/173" 400) + ("driftwood" "sRGB:175/135/81" 399) + ("downy" "sRGB:111/208/197" 398) + ("downriver" "sRGB:9/34/86" 397) + ("dovegrey" "sRGB:109/108/108" 396) + ("doublespanishwhite" "sRGB:230/215/185" 395) + ("doublepearllusta" "sRGB:252/244/208" 394) + ("doublecolonialwhite" "sRGB:238/227/173" 393) + ("dorado" "sRGB:107/87/85" 392) + ("donkeybrown" "sRGB:166/146/121" 391) + ("donjuan" "sRGB:93/76/81" 390) + ("domino" "sRGB:142/119/94" 389) + ("dolphin" "sRGB:100/96/119" 388) + ("dolly" "sRGB:249/255/139" 387) + ("dixie" "sRGB:226/148/24" 386) + ("disco" "sRGB:135/21/80" 385) + ("dingley" "sRGB:93/119/71" 384) + ("diesel" "sRGB:19/0/0" 383) + ("diserria" "sRGB:219/153/94" 382) + ("dew" "sRGB:234/255/254" 381) + ("desertstorm" "sRGB:248/248/247" 380) + ("desert" "sRGB:174/96/32" 379) + ("derby" "sRGB:255/238/216" 378) + ("deluge" "sRGB:117/99/168" 377) + ("delta" "sRGB:164/164/157" 376) + ("dell" "sRGB:57/100/19" 375) + ("delrio" "sRGB:176/154/149" 374) + ("deepteal" "sRGB:0/53/50" 373) + ("deepsea" "sRGB:1/130/107" 372) + ("deepoak" "sRGB:65/32/16" 371) + ("deepkoamaru" "sRGB:27/18/123" 370) + ("deepfir" "sRGB:0/41/0" 369) + ("deepcove" "sRGB:5/16/64" 368) + ("deepbronze" "sRGB:74/48/4" 367) + ("deepblush" "sRGB:228/118/152" 366) + ("deco" "sRGB:210/218/151" 365) + ("deyork" "sRGB:122/196/136" 364) + ("dawnpink" "sRGB:243/233/229" 363) + ("dawn" "sRGB:166/162/154" 362) + ("darktan" "sRGB:102/16/16" 361) + ("darkslate" "sRGB:57/72/81" 360) + ("darkrum" "sRGB:65/32/16" 359) + ("darkrimu" "sRGB:95/61/38" 358) + ("darkoak" "sRGB:97/39/24" 357) + ("darkebony" "sRGB:60/32/5" 356) + ("danube" "sRGB:96/147/209" 355) + ("dallas" "sRGB:110/75/38" 354) + ("daisybush" "sRGB:79/35/152" 353) + ("dairycream" "sRGB:249/228/188" 352) + ("daintree" "sRGB:1/39/49" 351) + ("cyprus" "sRGB:0/62/64" 350) + ("cuttysark" "sRGB:80/118/114" 349) + ("curiousblue" "sRGB:37/150/209" 348) + ("cupid" "sRGB:251/190/218" 347) + ("cumulus" "sRGB:253/255/213" 346) + ("cumin" "sRGB:146/67/33" 345) + ("cubantan" "sRGB:42/20/14" 344) + ("crusta" "sRGB:253/123/51" 343) + ("crusoe" "sRGB:0/72/22" 342) + ("cruise" "sRGB:181/236/223" 341) + ("crowshead" "sRGB:28/18/8" 340) + ("crownofthorns" "sRGB:119/31/31" 339) + ("crocodile" "sRGB:115/109/88" 338) + ("crete" "sRGB:115/120/41" 337) + ("creole" "sRGB:30/15/4" 336) + ("cremedebanane" "sRGB:255/252/153" 335) + ("creamcan" "sRGB:245/200/92" 334) + ("creambrulee" "sRGB:255/229/160" 333) + ("craterbrown" "sRGB:70/36/37" 332) + ("cranberry" "sRGB:182/49/108" 331) + ("crail" "sRGB:185/81/64" 330) + ("crabapple" "sRGB:160/39/18" 329) + ("cowboy" "sRGB:77/40/45" 328) + ("covegrey" "sRGB:5/22/87" 327) + ("countygreen" "sRGB:1/55/26" 326) + ("cottonseed" "sRGB:194/189/182" 325) + ("costadelsol" "sRGB:97/93/48" 324) + ("cosmos" "sRGB:255/216/217" 323) + ("cosmic" "sRGB:118/57/93" 322) + ("corvette" "sRGB:250/211/162" 321) + ("cornflower" "sRGB:255/176/172" 320) + ("cornharvest" "sRGB:139/107/11" 319) + ("cornfield" "sRGB:248/250/205" 318) + ("corn" "sRGB:231/191/5" 317) + ("cork" "sRGB:64/41/29" 316) + ("coriander" "sRGB:196/208/176" 315) + ("corduroy" "sRGB:96/110/104" 314) + ("coraltree" "sRGB:168/107/107" 313) + ("coralcandy" "sRGB:255/220/214" 312) + ("coral" "sRGB:199/188/162" 311) + ("copperrust" "sRGB:148/71/71" 310) + ("coppercanyon" "sRGB:126/58/21" 309) + ("contessa" "sRGB:198/114/107" 308) + ("conifer" "sRGB:172/221/77" 307) + ("congobrown" "sRGB:89/55/55" 306) + ("confetti" "sRGB:233/215/90" 305) + ("concrete" "sRGB:242/242/242" 304) + ("concord" "sRGB:124/123/122" 303) + ("conch" "sRGB:201/217/210" 302) + ("como" "sRGB:81/124/102" 301) + ("comet" "sRGB:92/93/117" 300) + ("colonialwhite" "sRGB:255/237/188" 299) + ("coldturkey" "sRGB:206/186/186" 298) + ("coldpurple" "sRGB:171/160/217" 297) + ("cola" "sRGB:63/37/0" 296) + ("cognac" "sRGB:159/56/29" 295) + ("coffeebean" "sRGB:42/20/14" 294) + ("coffee" "sRGB:112/101/85" 293) + ("codgrey" "sRGB:11/11/11" 292) + ("coconutcream" "sRGB:248/247/220" 291) + ("cocoabrown" "sRGB:48/31/30" 290) + ("cocoabean" "sRGB:72/28/28" 289) + ("cobalt" "sRGB:6/42/120" 288) + ("clover" "sRGB:56/73/16" 287) + ("cloudy" "sRGB:172/165/159" 286) + ("cloudburst" "sRGB:32/46/84" 285) + ("cloud" "sRGB:199/196/191" 284) + ("clinker" "sRGB:55/29/9" 283) + ("clementine" "sRGB:233/110/0" 282) + ("clearday" "sRGB:233/255/253" 281) + ("claycreek" "sRGB:138/131/96" 280) + ("classicrose" "sRGB:251/204/231" 279) + ("claret" "sRGB:127/23/52" 278) + ("clamshell" "sRGB:212/182/175" 277) + ("clairvoyant" "sRGB:72/6/86" 276) + ("citrus" "sRGB:161/197/10" 275) + ("citron" "sRGB:158/169/31" 274) + ("citrinewhite" "sRGB:250/247/214" 273) + ("cioccolato" "sRGB:85/40/12" 272) + ("cinnamon" "sRGB:123/63/0" 271) + ("cinderella" "sRGB:253/225/220" 270) + ("cinder" "sRGB:14/14/24" 269) + ("cigar" "sRGB:119/63/26" 268) + ("chromewhite" "sRGB:232/241/212" 267) + ("christine" "sRGB:231/115/10" 266) + ("christi" "sRGB:103/167/18" 265) + ("christalle" "sRGB:51/3/107" 264) + ("chocolate" "sRGB:55/2/2" 263) + ("chinook" "sRGB:168/227/189" 262) + ("chino" "sRGB:206/199/167" 261) + ("chinaivory" "sRGB:252/255/231" 260) + ("chileanheath" "sRGB:255/253/230" 259) + ("chileanfire" "sRGB:247/119/3" 258) + ("chiffon" "sRGB:241/255/200" 257) + ("chicago" "sRGB:93/92/88" 256) + ("chetwodeblue" "sRGB:133/129/217" 255) + ("cherub" "sRGB:248/217/233" 254) + ("cherrywood" "sRGB:101/26/20" 253) + ("cherrypie" "sRGB:42/3/89" 252) + ("cherokee" "sRGB:252/218/152" 251) + ("chenin" "sRGB:223/205/111" 250) + ("chelseagem" "sRGB:158/83/2" 249) + ("chelseacucumber" "sRGB:131/170/93" 248) + ("chathamsblue" "sRGB:23/85/121" 247) + ("chatelle" "sRGB:189/179/199" 246) + ("chateaugreen" "sRGB:64/168/96" 245) + ("charm" "sRGB:212/116/148" 244) + ("charlotte" "sRGB:186/238/249" 243) + ("chardonnay" "sRGB:255/205/140" 242) + ("chardon" "sRGB:255/243/241" 241) + ("charade" "sRGB:41/41/55" 240) + ("chantilly" "sRGB:248/195/223" 239) + ("champagne" "sRGB:250/236/204" 238) + ("chamois" "sRGB:237/220/177" 237) + ("chambray" "sRGB:53/78/140" 236) + ("chalky" "sRGB:238/215/148" 235) + ("chaletgreen" "sRGB:81/110/61" 234) + ("chablis" "sRGB:255/244/243" 233) + ("ceramic" "sRGB:252/255/249" 232) + ("cement" "sRGB:141/118/98" 231) + ("celtic" "sRGB:22/50/34" 230) + ("cello" "sRGB:30/56/91" 229) + ("celeste" "sRGB:209/210/202" 228) + ("celery" "sRGB:184/194/93" 227) + ("cedarwoodfinish" "sRGB:113/26/0" 226) + ("cedar" "sRGB:62/28/20" 225) + ("cesoir" "sRGB:151/113/181" 224) + ("cavernpink" "sRGB:227/190/190" 223) + ("catskillwhite" "sRGB:238/246/247" 222) + ("catalinablue" "sRGB:6/42/120" 221) + ("castro" "sRGB:82/0/31" 220) + ("casper" "sRGB:173/190/209" 219) + ("cashmere" "sRGB:230/190/165" 218) + ("cascade" "sRGB:139/169/165" 217) + ("casal" "sRGB:47/97/104" 216) + ("casablanca" "sRGB:248/184/83" 215) + ("carouselpink" "sRGB:249/224/237" 214) + ("carnabytan" "sRGB:92/46/1" 213) + ("carla" "sRGB:243/255/216" 212) + ("carissma" "sRGB:234/136/168" 211) + ("careyspink" "sRGB:210/158/170" 210) + ("cardinal" "sRGB:140/5/94" 209) + ("cardingreen" "sRGB:1/54/28" 208) + ("cararra" "sRGB:238/238/232" 207) + ("caramel" "sRGB:255/221/175" 206) + ("capri" "sRGB:6/42/120" 205) + ("caper" "sRGB:220/237/180" 204) + ("capepalliser" "sRGB:162/102/69" 203) + ("capehoney" "sRGB:254/229/172" 202) + ("capecod" "sRGB:60/68/67" 201) + ("canvas" "sRGB:168/165/137" 200) + ("cannonpink" "sRGB:137/67/103" 199) + ("cannonblack" "sRGB:37/23/6" 198) + ("candlelight" "sRGB:252/217/23" 197) + ("canary" "sRGB:243/251/98" 196) + ("cancan" "sRGB:213/145/164" 195) + ("camouflage" "sRGB:60/57/16" 194) + ("cameo" "sRGB:217/185/155" 193) + ("camelot" "sRGB:137/52/86" 192) + ("camarone" "sRGB:0/88/26" 191) + ("calypso" "sRGB:49/114/141" 190) + ("california" "sRGB:254/157/4" 189) + ("calico" "sRGB:224/192/149" 188) + ("caferoyale" "sRGB:111/68/12" 187) + ("cadillac" "sRGB:176/76/106" 186) + ("cactus" "sRGB:88/113/86" 185) + ("cabbagepont" "sRGB:63/76/58" 184) + ("cabaret" "sRGB:217/73/114" 183) + ("cabsav" "sRGB:77/10/24" 182) + ("butterywhite" "sRGB:255/252/234" 181) + ("buttermilk" "sRGB:255/241/181" 180) + ("butterflybush" "sRGB:98/78/154" 179) + ("butteredrum" "sRGB:161/117/13" 178) + ("buttercup" "sRGB:243/173/22" 177) + ("bush" "sRGB:13/46/28" 176) + ("burntcrimson" "sRGB:101/0/11" 175) + ("burningsand" "sRGB:217/147/118" 174) + ("burnham" "sRGB:0/46/32" 173) + ("burgundy" "sRGB:119/15/5" 172) + ("bunting" "sRGB:21/31/76" 171) + ("bunker" "sRGB:13/17/23" 170) + ("bullshot" "sRGB:134/77/30" 169) + ("bulgarianrose" "sRGB:72/6/7" 168) + ("buddhagold" "sRGB:193/160/4" 167) + ("bud" "sRGB:168/174/156" 166) + ("buccaneer" "sRGB:98/47/48" 165) + ("bubbles" "sRGB:231/254/255" 164) + ("brownpod" "sRGB:64/24/1" 163) + ("brownderby" "sRGB:73/38/21" 162) + ("brownbramble" "sRGB:89/40/4" 161) + ("broom" "sRGB:255/236/19" 160) + ("bronzetone" "sRGB:77/64/15" 159) + ("bronzeolive" "sRGB:78/66/12" 158) + ("bronze" "sRGB:63/33/9" 157) + ("bronco" "sRGB:171/161/150" 156) + ("brightsun" "sRGB:254/211/60" 155) + ("brightred" "sRGB:177/0/0" 154) + ("brightgrey" "sRGB:60/65/81" 153) + ("bridesmaid" "sRGB:254/240/236" 152) + ("bridalheath" "sRGB:255/250/244" 151) + ("breakerbay" "sRGB:93/161/159" 150) + ("brazil" "sRGB:136/98/33" 149) + ("brandyrose" "sRGB:187/137/131" 148) + ("brandypunch" "sRGB:205/132/41" 147) + ("brandy" "sRGB:222/193/150" 146) + ("bracken" "sRGB:74/42/4" 145) + ("bourbon" "sRGB:186/111/30" 144) + ("bouquet" "sRGB:174/128/158" 143) + ("boulder" "sRGB:122/122/122" 142) + ("bottlegreen" "sRGB:9/54/36" 141) + ("botticelli" "sRGB:199/221/229" 140) + ("bostonblue" "sRGB:59/145/180" 139) + ("bossanova" "sRGB:78/42/90" 138) + ("bordeaux" "sRGB:92/1/32" 137) + ("bone" "sRGB:228/209/192" 136) + ("bondiblue" "sRGB:2/71/142" 135) + ("bonjour" "sRGB:229/224/225" 134) + ("bombay" "sRGB:175/177/184" 133) + ("bokaragrey" "sRGB:28/18/8" 132) + ("blush" "sRGB:180/70/104" 131) + ("blumine" "sRGB:24/88/122" 130) + ("bluezodiac" "sRGB:19/38/77" 129) + ("bluewhale" "sRGB:4/46/76" 128) + ("bluestone" "sRGB:1/97/98" 127) + ("bluesmoke" "sRGB:116/136/129" 126) + ("blueromance" "sRGB:210/246/222" 125) + ("bluemarguerite" "sRGB:118/102/198" 124) + ("bluelagoon" "sRGB:1/121/135" 123) + ("bluehaze" "sRGB:191/190/216" 122) + ("bluegem" "sRGB:44/14/140" 121) + ("bluedianne" "sRGB:32/72/82" 120) + ("bluediamond" "sRGB:56/4/116" 119) + ("bluechill" "sRGB:12/137/144" 118) + ("bluecharcoal" "sRGB:1/13/26" 117) + ("bluechalk" "sRGB:241/233/255" 116) + ("bluebell" "sRGB:34/8/120" 115) + ("bluebayoux" "sRGB:73/102/121" 114) + ("bluebark" "sRGB:4/19/34" 113) + ("blossom" "sRGB:220/180/188" 112) + ("bleachedcedar" "sRGB:44/33/51" 111) + ("bleachwhite" "sRGB:254/243/216" 110) + ("blanc" "sRGB:245/233/211" 109) + ("blackwood" "sRGB:38/17/5" 108) + ("blackcurrant" "sRGB:50/41/58" 107) + ("blackberry" "sRGB:77/1/53" 106) + ("blackwhite" "sRGB:255/254/246" 105) + ("blacksqueeze" "sRGB:242/250/250" 104) + ("blackrussian" "sRGB:10/0/28" 103) + ("blackrose" "sRGB:103/3/45" 102) + ("blackrock" "sRGB:13/3/50" 101) + ("blackpepper" "sRGB:14/14/24" 100) + ("blackpearl" "sRGB:4/19/34" 99) + ("blackmarlin" "sRGB:62/44/28" 98) + ("blackmagic" "sRGB:37/23/6" 97) + ("blackhaze" "sRGB:246/247/247" 96) + ("blackforest" "sRGB:11/19/4" 95) + ("blackbean" "sRGB:8/25/16" 94) + ("bizarre" "sRGB:238/222/218" 93) + ("bitterlemon" "sRGB:202/224/13" 92) + ("bitter" "sRGB:134/137/116" 91) + ("bisonhide" "sRGB:193/183/164" 90) + ("bismark" "sRGB:73/113/131" 89) + ("biscay" "sRGB:27/49/98" 88) + ("birdflower" "sRGB:212/205/22" 87) + ("birch" "sRGB:55/48/33" 86) + ("bilobaflower" "sRGB:178/161/234" 85) + ("bilbao" "sRGB:50/124/20" 84) + ("bigstone" "sRGB:22/42/64" 83) + ("bianca" "sRGB:252/251/243" 82) + ("berylgreen" "sRGB:222/229/192" 81) + ("bermudagrey" "sRGB:107/139/162" 80) + ("bermuda" "sRGB:125/216/198" 79) + ("beeswax" "sRGB:254/242/199" 78) + ("beautybush" "sRGB:238/193/190" 77) + ("bean" "sRGB:61/12/2" 76) + ("bazaar" "sRGB:152/119/123" 75) + ("bayofmany" "sRGB:39/58/129" 74) + ("bayleaf" "sRGB:125/169/141" 73) + ("battleshipgrey" "sRGB:130/143/114" 72) + ("bastille" "sRGB:41/33/48" 71) + ("barossa" "sRGB:68/1/45" 70) + ("barleywhite" "sRGB:255/244/206" 69) + ("barleycorn" "sRGB:166/139/91" 68) + ("barberry" "sRGB:222/215/23" 67) + ("banjul" "sRGB:19/10/6" 66) + ("bandicoot" "sRGB:133/132/112" 65) + ("bamboo" "sRGB:218/99/4" 64) + ("balticsea" "sRGB:42/38/48" 63) + ("balihai" "sRGB:133/159/175" 62) + ("bajawhite" "sRGB:255/248/209" 61) + ("bahia" "sRGB:165/203/12" 60) + ("bahamablue" "sRGB:2/99/149" 59) + ("azure" "sRGB:49/91/161" 58) + ("aztec" "sRGB:13/28/25" 57) + ("azalea" "sRGB:247/200/218" 56) + ("axolotl" "sRGB:78/102/73" 55) + ("avocado" "sRGB:136/141/101" 54) + ("australianmint" "sRGB:245/255/190" 53) + ("aubergine" "sRGB:59/9/16" 52) + ("auchico" "sRGB:151/96/93" 51) + ("atomic" "sRGB:49/68/89" 50) + ("atoll" "sRGB:10/111/117" 49) + ("atlantis" "sRGB:151/205/45" 48) + ("athsspecial" "sRGB:236/235/206" 47) + ("athensgrey" "sRGB:238/240/243" 46) + ("astronautblue" "sRGB:1/62/98" 45) + ("astronaut" "sRGB:40/58/119" 44) + ("astral" "sRGB:50/125/160" 43) + ("astra" "sRGB:250/234/185" 42) + ("asphalt" "sRGB:19/10/6" 41) + ("ashbrown" "sRGB:46/25/5" 40) + ("ash" "sRGB:198/195/181" 39) + ("arrowtown" "sRGB:148/135/113" 38) + ("armadillo" "sRGB:67/62/55" 37) + ("arapawa" "sRGB:17/12/108" 36) + ("aquamarine" "sRGB:1/75/67" 35) + ("aquasqueeze" "sRGB:232/245/242" 34) + ("aquaspring" "sRGB:234/249/245" 33) + ("aquahaze" "sRGB:237/245/245" 32) + ("aqua" "sRGB:161/218/215" 31) + ("apricotwhite" "sRGB:255/254/236" 30) + ("apricot" "sRGB:235/147/115" 29) + ("applegreen" "sRGB:226/243/236" 28) + ("appleblossom" "sRGB:175/77/67" 27) + ("apple" "sRGB:79/168/61" 26) + ("apache" "sRGB:223/190/111" 25) + ("anzac" "sRGB:224/182/70" 24) + ("antiquebrass" "sRGB:112/74/7" 23) + ("anakiwa" "sRGB:157/229/255" 22) + ("amulet" "sRGB:123/159/128" 21) + ("amour" "sRGB:249/234/243" 20) + ("amethystsmoke" "sRGB:163/151/180" 19) + ("americano" "sRGB:135/117/110" 18) + ("amazon" "sRGB:59/122/87" 17) + ("aluminium" "sRGB:169/172/182" 16) + ("alto" "sRGB:219/219/219" 15) + ("alpine" "sRGB:175/143/44" 14) + ("almondfrost" "sRGB:144/123/113" 13) + ("allports" "sRGB:0/118/163" 12) + ("alerttan" "sRGB:155/71/3" 11) + ("albescentwhite" "sRGB:245/233/211" 10) + ("alabaster" "sRGB:255/255/255" 9) + ("akaroa" "sRGB:212/196/168" 8) + ("afghantan" "sRGB:134/86/10" 7) + ("affair" "sRGB:113/70/147" 6) + ("aeroblue" "sRGB:201/255/229" 5) + ("acorn" "sRGB:106/93/27" 4) + ("acapulco" "sRGB:124/176/161" 3) + ("acadia" "sRGB:27/20/4" 2) + ("abbey" "sRGB:76/79/86" 1) + ) + (7 + (3 #f order #f ordinal) + (2 #f color #f string) + (1 #t name #f string) + ) + (6 + ("red" "CIEXYZ:0.639974/0.219285/0.140741" 19) + ("purplishred" "CIEXYZ:0.292779/0.0595298/0.647691" 18) + ("redpurple" "CIEXYZ:0.224491/0.0281085/0.7474" 17) + ("reddishpurple" "CIEXYZ:0.195341/0.0146953/0.789964" 16) + ("purple" "CIEXYZ:0.180159/0.00770975/0.812132" 15) + ("bluishpurple" "CIEXYZ:0.174724/0.00520914/0.820067" 14) + ("purplishblue" "CIEXYZ:0.150985/0.0227402/0.826274" 13) + ("blue" "CIEXYZ:0.116102/0.0738583/0.81004" 12) + ("greenishblue" "CIEXYZ:0.0833989/0.156445/0.760156" 11) + ("bluegreen" "CIEXYZ:0.0234599/0.412703/0.563837" 10) + ("bluishgreen" "CIEXYZ:0.00816803/0.538423/0.453409" 9) + ("green" "CIEXYZ:0.0388518/0.812016/0.149132" 8) + ("yellowishgreen" "CIEXYZ:0.337396/0.658848/0.00375544" 7) + ("yellowgreen" "CIEXYZ:0.380466/0.617256/0.00227802" 6) + ("greenishyellow" "CIEXYZ:0.465098/0.5338/0.00110199" 5) + ("yellow" "CIEXYZ:0.505818/0.493217/0.000965024" 4) + ("yellowishorange" "CIEXYZ:0.531897/0.467256/0.000847751" 3) + ("orange" "CIEXYZ:0.602933/0.396497/0.000570581" 2) + ("reddishorange" "CIEXYZ:0.658471/0.341258/0.000271188" 1) + ) + (5 + (3 #f order #f ordinal) + (2 #f color #f string) + (1 #t name #f string) + ) + (4 + (uint #f (lambda (x) (and (integer? x) (not (negative? x)))) number #f) + (base-id #f number? ordinal #f) + (number #f number? number #f) + (domain *domains-data* #f atom #f) + (atom #f (lambda (x) (or (not x) (symbol? x))) atom #f) + (string #f string? string #f) + (symbol #f symbol? symbol #f) + (expression #f #f expression #f) + (boolean #f boolean? boolean #f) + (ordinal #f (lambda (x) (and (integer? x) (positive? x))) number #f) + (type #f symbol? symbol #f) + ) + (3 + (6 #f view-procedure #f expression) + (5 #f user-integrity-rule #f expression) + (4 #f bastab-id #f ordinal) + (3 #f coltab-name #f symbol) + (2 #f column-limit #f ordinal) + (1 #t table-name #f symbol) + ) + (2 + (5 #f type-param #f expression) + (4 #f type-id #f type) + (3 #f domain-integrity-rule #f expression) + (2 #f foreign-table #f atom) + (1 #t domain-name #f symbol) + ) + (1 + (5 #f domain-name #f domain) + (4 #f column-integrity-rule #f expression) + (3 #f column-name #f symbol) + (2 #f primary-key? #f boolean) + (1 #t column-number #f ordinal) + ) + (0 + (nbs-iscc 3 desc:nbs-iscc 10 #f #f) + (desc:nbs-iscc 5 *columns* 9 #f #f) + (resene 3 desc:resene 8 #f #f) + (desc:resene 5 *columns* 7 #f #f) + (saturate 3 desc:saturate 6 #f #f) + (desc:saturate 5 *columns* 5 #f #f) + (*columns* 5 *columns* 1 #f #f) + (*domains-data* 5 *domains-desc* 4 #f #f) + (*catalog-data* 6 *catalog-desc* 0 #f #f) + (*domains-desc* 5 *columns* 2 #f #f) + (*catalog-desc* 5 *columns* 3 #f #f) + ) + (*base-resources* + (free-id 11) + ) +) @@ -18,10 +18,12 @@ ;each case. (require 'values) +(require 'time-core) (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 time:1900 (time:invert + (lambda (tm) (time:split tm 0 0 "GMT")) ;time:gmtime + '#(0 0 0 1 0 0 #f #f 0 0 "GMT"))) ;@ (define (get-decoded-time) (decode-universal-time (get-universal-time))) @@ -33,7 +35,7 @@ (let ((tv (apply time:split (offset-time time:1900 utime) (if (null? tzarg) - (tz:params utime (tzset)) + (tz:params utime (time-zone (getenv "TZ"))) (list 0 (* 3600 (car tzarg)) "???"))))) (values (vector-ref tv 0) ;second [0..59] @@ -50,10 +52,10 @@ ))) ;@ (define (encode-universal-time second minute hour date month year . tzarg) - (let* ((tz (if (null? tzarg) - (tzset) - (time-zone (string-append - "???" (number->string (car tzarg)))))) + (let* ((tz (time-zone + (if (null? tzarg) + (getenv "TZ") + (string-append "???" (number->string (car tzarg)))))) (tv (vector second minute hour @@ -63,5 +65,7 @@ #f ;ignored #f ;ignored ))) - (difftime (time:invert localtime tv) time:1900))) - + (difftime (time:invert + (lambda (tm) (apply time:split tm (tz:params tm tz))) ;localtime + tv) + time:1900))) @@ -17,11 +17,12 @@ ;promotional, or sales literature without prior written consent in ;each case. +(require-if 'compiling 'array) + ;;@body ;;Returns a symbol name for the type of @1. (define (type-of obj) (cond - ;;((null? obj) 'null) ((boolean? obj) 'boolean) ((char? obj) 'char) ((number? obj) 'number) @@ -33,9 +34,8 @@ ((eof-object? obj) 'eof-object) ((list? obj) 'list) ((pair? obj) 'pair) - ((and (provided? 'array) (array? obj)) 'array) - ((and (provided? 'record) (record? obj)) 'record) ((vector? obj) 'vector) + ((and (provided? 'array) (array? obj)) 'array) (else '?))) ;;@body @@ -4,9 +4,11 @@ Returns a symbol name for the type of @var{obj}. @end defun + @defun coerce obj result-type Converts and returns @var{obj} of type @code{char}, @code{number}, @code{string}, @code{symbol}, @code{list}, or @code{vector} to @var{result-type} (which must be one of these symbols). @end defun + @@ -71,8 +71,8 @@ ;;@cindex tristimulus ;;The @dfn{tristimulus} color spaces are those whose component values ;;are proportional measurements of light intensity. The CIEXYZ(1931) -;;system provides 3 sets of spectra to convolve with a spectrum of -;;interest. The result of those convolutions is coordinates in CIEXYZ +;;system provides 3 sets of spectra to dot-product with a spectrum of +;;interest. The result of those dot-products is coordinates in CIEXYZ ;;space. All tristimuls color spaces are related to CIEXYZ by linear ;;transforms, namely matrix multiplication. Of the color spaces listed ;;here, CIEXYZ and RGB709 are tristimulus spaces. @@ -81,7 +81,7 @@ ;;The CIEXYZ color space covers the full @dfn{gamut}. ;;It is the basis for color-space conversions. ;; -;;CIEXYZ is a list of three inexact numbers between 0 and 1.1. +;;CIEXYZ is a list of three inexact numbers between 0.0 and 1.1. ;;'(0. 0. 0.) is black; '(1. 1. 1.) is white. ;;@end deftp @@ -129,7 +129,7 @@ ;;high definition television signals. ;; ;;An RGB709 color is represented by a list of three inexact numbers -;;between 0 and 1. '(0. 0. 0.) is black '(1. 1. 1.) is white. +;;between 0.0 and 1.0. '(0. 0. 0.) is black '(1. 1. 1.) is white. ;;@end deftp ;;@body @@ -168,7 +168,7 @@ ;;range of distances (6:1) in the L*a*b* and L*u*v* spaces than in ;;tristimulus spaces (80:1). For this reason, color distances are ;;computed in L*a*b* (or L*C*h). - + ;;@deftp {Color Space} L*a*b* ;;Is a CIE color space which better matches the human visual system's ;;perception of color. It is a list of three numbers: @@ -527,16 +527,17 @@ (else (eqv? (car typ) (color:encoding obj))))) ;@ (define (make-color space . args) - (case space - ((CIEXYZ) (CIEXYZ->color args)) - ((RGB709) (RGB709->color args)) - ((L*a*b*) (L*a*b*->color args)) - ((L*u*v*) (L*u*v*->color args)) - ((L*C*h) (L*C*h->color args)) - ((sRGB) (sRGB->color args)) - ((xRGB) (apply xRGB->color args)) - ((e-sRGB) (e-sRGB->color args)) - (else (slib:error 'make-color ': 'not 'space? space)))) + (apply (case space + ((CIEXYZ) CIEXYZ->color) + ((RGB709) RGB709->color) + ((L*a*b*) L*a*b*->color) + ((L*u*v*) L*u*v*->color) + ((L*C*h) L*C*h->color) + ((sRGB) sRGB->color) + ((xRGB) xRGB->color) + ((e-sRGB) e-sRGB->color) + (else (slib:error 'make-color ': 'not 'space? space))) + args)) ;@ (define color-space color:encoding) ;@ @@ -620,7 +621,7 @@ ((CIELab) (color:L*a*b* x y z)) ((CIELuv) (color:L*u*v* x y z)) ((CIELCh) (color:L*C*h x y z)) - ((RGBi ; Xlib - C Language X Interface + ((RGBi ; Xlib - C Language X Interface RGB709) (color:RGB709 x y z)) (else #f))) ((eqv? 4 (sscanf str " %[sRGBSrgb]:%d/%d/%d" coding x y z)) @@ -637,6 +638,9 @@ xRGB sRGBx) (xRGB->color x)) (else #f))) + ((and (eqv? 1 (sscanf str " #%6[0-9a-fA-F]%[0-9a-fA-F]" x y)) + (eqv? 6 (string-length x))) + (xRGB->color (string->number x 16))) ((and (eqv? 2 (sscanf str " %[#0xX]%6[0-9a-fA-F]%[0-9a-fA-F]" coding x y)) (eqv? 6 (string-length x)) @@ -5,8 +5,8 @@ The @dfn{tristimulus} color spaces are those whose component values @cindex tristimulus are proportional measurements of light intensity. The CIEXYZ(1931) -system provides 3 sets of spectra to convolve with a spectrum of -interest. The result of those convolutions is coordinates in CIEXYZ +system provides 3 sets of spectra to dot-product with a spectrum of +interest. The result of those dot-products is coordinates in CIEXYZ space. All tristimuls color spaces are related to CIEXYZ by linear transforms, namely matrix multiplication. Of the color spaces listed here, CIEXYZ and RGB709 are tristimulus spaces. @@ -16,7 +16,7 @@ The CIEXYZ color space covers the full @dfn{gamut}. @cindex gamut It is the basis for color-space conversions. -CIEXYZ is a list of three inexact numbers between 0 and 1.1. +CIEXYZ is a list of three inexact numbers between 0.0 and 1.1. '(0. 0. 0.) is black; '(1. 1. 1.) is white. @end deftp @@ -27,6 +27,7 @@ CIEXYZ is a list of three inexact numbers between 0 and 1.1. then @code{ciexyz->color} returns the color specified by @var{xyz}; otherwise returns #f. @end defun + @defun color:ciexyz x y z Returns the CIEXYZ color composed of @var{x}, @var{y}, @var{z}. If the @@ -34,9 +35,11 @@ coordinates do not encode a valid CIEXYZ color, then an error is signaled. @end defun + @defun color->ciexyz color Returns the list of 3 numbers encoding @var{color} in CIEXYZ. @end defun + @deftp {Color Space} RGB709 BT.709-4 (03/00) @cite{Parameter values for the HDTV standards for production and international programme exchange} specifies parameter @@ -44,7 +47,7 @@ values for chromaticity, sampling, signal format, frame rates, etc., of high definition television signals. An RGB709 color is represented by a list of three inexact numbers -between 0 and 1. '(0. 0. 0.) is black '(1. 1. 1.) is white. +between 0.0 and 1.0. '(0. 0. 0.) is black '(1. 1. 1.) is white. @end deftp @@ -54,6 +57,7 @@ between 0 and 1. '(0. 0. 0.) is black '(1. 1. 1.) is white. then @code{rgb709->color} returns the color specified by @var{rgb}; otherwise returns #f. @end defun + @defun color:rgb709 r g b Returns the RGB709 color composed of @var{r}, @var{g}, @var{b}. If the @@ -61,9 +65,11 @@ coordinates do not encode a valid RGB709 color, then an error is signaled. @end defun + @defun color->rgb709 color Returns the list of 3 numbers encoding @var{color} in RGB709. @end defun + @subsubheading Perceptual Uniformity @noindent @@ -97,6 +103,7 @@ perception of color. It is a list of three numbers: then @code{l*a*b*->color} returns the color specified by @var{L*a*b*}; otherwise returns #f. @end defun + @defun color:l*a*b* L* a* b* white-point Returns the L*a*b* color composed of @var{L*}, @var{a*}, @var{b*} with @var{white-point}. @@ -106,6 +113,7 @@ Returns the L*a*b* color composed of @var{L*}, @var{a*}, @var{b*}. If the coord do not encode a valid L*a*b* color, then an error is signaled. @end defun + @defun color->l*a*b* color white-point Returns the list of 3 numbers encoding @var{color} in L*a*b* with @var{white-point}. @@ -113,6 +121,7 @@ Returns the list of 3 numbers encoding @var{color} in L*a*b* with @var{white-poi @defunx color->l*a*b* color Returns the list of 3 numbers encoding @var{color} in L*a*b*. @end defun + @deftp {Color Space} L*u*v* Is another CIE encoding designed to better match the human visual system's perception of color. @@ -125,6 +134,7 @@ system's perception of color. then @code{l*u*v*->color} returns the color specified by @var{L*u*v*}; otherwise returns #f. @end defun + @defun color:l*u*v* L* u* v* white-point Returns the L*u*v* color composed of @var{L*}, @var{u*}, @var{v*} with @var{white-point}. @@ -134,6 +144,7 @@ Returns the L*u*v* color composed of @var{L*}, @var{u*}, @var{v*}. If the coord do not encode a valid L*u*v* color, then an error is signaled. @end defun + @defun color->l*u*v* color white-point Returns the list of 3 numbers encoding @var{color} in L*u*v* with @var{white-point}. @@ -141,6 +152,7 @@ Returns the list of 3 numbers encoding @var{color} in L*u*v* with @var{white-poi @defunx color->l*u*v* color Returns the list of 3 numbers encoding @var{color} in L*u*v*. @end defun + @subsubheading Cylindrical Coordinates @noindent @@ -190,6 +202,7 @@ The colors by quadrant of h are: then @code{l*c*h->color} returns the color specified by @var{L*C*h}; otherwise returns #f. @end defun + @defun color:l*c*h L* C* h white-point Returns the L*C*h color composed of @var{L*}, @var{C*}, @var{h} with @var{white-point}. @@ -199,6 +212,7 @@ Returns the L*C*h color composed of @var{L*}, @var{C*}, @var{h}. If the coordin do not encode a valid L*C*h color, then an error is signaled. @end defun + @defun color->l*c*h color white-point Returns the list of 3 numbers encoding @var{color} in L*C*h with @var{white-point}. @@ -206,6 +220,7 @@ Returns the list of 3 numbers encoding @var{color} in L*C*h with @var{white-poin @defunx color->l*c*h color Returns the list of 3 numbers encoding @var{color} in L*C*h. @end defun + @subsubheading Digital Color Spaces @noindent @@ -251,12 +266,14 @@ should work very well with sRGB. then @code{srgb->color} returns the color specified by @var{rgb}; otherwise returns #f. @end defun + @defun color:srgb r g b Returns the sRGB color composed of @var{r}, @var{g}, @var{b}. If the coordinates do not encode a valid sRGB color, then an error is signaled. @end defun + @deftp {Color Space} xRGB Represents the equivalent sRGB color with a single 24-bit integer. The most significant 8 bits encode red, the middle 8 bits blue, and the @@ -269,14 +286,17 @@ least significant 8 bits green. Returns the list of 3 integers encoding @var{color} in sRGB. @end defun + @defun color->xrgb color Returns the 24-bit integer encoding @var{color} in sRGB. @end defun + @defun xrgb->color k Returns the sRGB color composed of the 24-bit integer @var{k}. @end defun + @deftp {Color Space} e-sRGB Is "Photography - Electronic still picture imaging - Extended sRGB color encoding" (PIMA 7667:2001). It extends the gamut of sRGB; and its @@ -302,6 +322,7 @@ numbers. If @var{rgb} is valid e-sRGB coordinates, then @code{e-srgb->color} re specified by @var{rgb}; otherwise returns #f. @end defun + @defun color:e-srgb 10 r g b Returns the e-sRGB10 color composed of integers @var{r}, @var{g}, @var{b}. @@ -315,6 +336,7 @@ If the coordinates do not encode a valid e-sRGB color, then an error is signaled. @end defun + @defun color->e-srgb precision color @var{precision} must be the integer 10, 12, or 16. @code{color->e-srgb} returns the list of 3 integers encoding @var{color} in sRGB10, sRGB12, or sRGB16. @@ -343,3 +365,4 @@ integers encoding @var{color} in sRGB10, sRGB12, or sRGB16. + diff --git a/colornam.txi b/colornam.txi index f72167b..bc70632 100644 --- a/colornam.txi +++ b/colornam.txi @@ -12,6 +12,7 @@ through the @code{grey} procedure: Returns @code{(inexact->exact (round (* k 2.55)))}, the X11 color grey@i{<k>}. @end defun + @noindent A color dictionary is a database table relating @dfn{canonical} @cindex canonical @@ -28,6 +29,7 @@ Returns a downcased copy of the string or symbol @var{name} with @samp{_}, @samp{-}, and whitespace removed. @end defun + @defun color-name->color name table1 table2 @dots{} @@ -36,6 +38,7 @@ canonical form of @var{name} in @var{table1}, @var{table2}, @dots{} in order; re color-string of the first matching record; #f otherwise. @end defun + @defun color-dictionaries->lookup table1 table2 @dots{} @@ -45,6 +48,7 @@ in @var{table1}, @var{table2}, @dots{}; returning the color-string of the first record; and #f otherwise. @end defun + @defun color-dictionary name rdb base-table-type @@ -61,6 +65,7 @@ database file; and the symbol @var{name} a table therein. @code{color-dictionar read-only table @var{name} in database @var{name} if it exists; #f otherwise. @end defun + @defun load-color-dictionary name rdb base-table-type @@ -73,3 +78,4 @@ to a lookup procedure for the color dictionary @var{name} in @var{rdb}. The value returned by @code{load-color-dictionary} is unspecified. @end defun + diff --git a/colorspc.scm b/colorspc.scm index 3a88767..814149b 100644 --- a/colorspc.scm +++ b/colorspc.scm @@ -345,13 +345,6 @@ (or (color:process-params parametric-factors) '(2 1 1))))))) (map sqrt (map * lch1 lch2)))) -;@ -(define (XYZ:normalize-colors lst) - (define sum (apply max (map (lambda (XYZ) (apply + XYZ)) lst))) - (map (lambda (XYZ) (map (lambda (x) (/ x sum)) XYZ)) lst)) -;@ -(define (XYZ:normalize XYZ) - (car (XYZ:normalize-colors (list XYZ)))) ;;; Chromaticity ;@ @@ -440,6 +433,29 @@ (vector-set! cie:y-bar idx (read iprt)) (vector-set! cie:z-bar idx (read iprt)))))))) ;@ +(define (read-cie-illuminant path) + (define siv (make-vector 107)) + (call-with-input-file path + (lambda (iprt) + (do ((idx 0 (+ 1 idx))) + ((>= idx 107) siv) + (vector-set! siv idx (read iprt)))))) +;@ +(define (read-normalized-illuminant path) + (define siv (read-cie-illuminant path)) + (let ((yw (/ (cadr (spectrum->XYZ siv 300e-9 830e-9))))) + (illuminant-map (lambda (w x) (* x yw)) siv))) +;@ +(define (illuminant-map proc siv) + (define prod (make-vector 107)) + (do ((idx 106 (+ -1 idx)) + (w 830e-9 (+ -5e-9 w))) + ((negative? idx) prod) + (vector-set! prod idx (proc w (vector-ref siv idx))))) +;@ +(define (illuminant-map->XYZ proc siv) + (spectrum->XYZ (illuminant-map proc siv) 300e-9 830e-9)) +;@ (define (wavelength->XYZ wl) (if (not cie:y-bar) (require 'ciexyz)) (set! wl (- (/ wl 5.e-9) 380/5)) @@ -453,8 +469,6 @@ (interpolate cie:y-bar wlf res) (interpolate cie:z-bar wlf res))) (slib:error 'wavelength->XYZ 'out-of-range wl))) -(define (wavelength->CIEXYZ wl) - (XYZ:normalize (wavelength->XYZ wl))) (define (wavelength->chromaticity wl) (XYZ->chromaticity (wavelength->XYZ wl))) ;@ @@ -509,8 +523,6 @@ (set! y (+ y (* (vector-ref cie:y-bar kdx) inten))) (set! z (+ z (* (vector-ref cie:z-bar kdx) inten)))))))) (else (slib:error 'spectrum->XYZ 'wna args)))) -(define (spectrum->CIEXYZ . args) - (XYZ:normalize (apply spectrum->XYZ args))) (define (spectrum->chromaticity . args) (XYZ->chromaticity (apply spectrum->XYZ args))) ;@ @@ -522,15 +534,14 @@ (pi*2*h*c*c (* 2 pi h*c c))) (lambda (temp . span) (define h*c/kT (/ h*c k temp)) - (define pi*2*h*c*c*span (* pi*2*h*c*c (if (null? span) 1.e-9 (car span)))) + (define pi*2*h*c*c*span + (* pi*2*h*c*c (if (null? span) 1.e-9 (car span)))) (lambda (x) (/ pi*2*h*c*c*span (expt x 5) (- (exp (/ h*c/kT x)) 1)))))) ;@ -(define (temperature->XYZ temp) - (spectrum->XYZ (blackbody-spectrum temp 5.e-9))) -(define (temperature->CIEXYZ temp) - (XYZ:normalize (temperature->XYZ temp))) +(define (temperature->XYZ temp . span) + (spectrum->XYZ (apply blackbody-spectrum temp span))) ;was .5e-9 (define (temperature->chromaticity temp) (XYZ->chromaticity (temperature->XYZ temp))) diff --git a/comlist.scm b/comlist.scm index 2e3a6ef..3ca909f 100644 --- a/comlist.scm +++ b/comlist.scm @@ -30,9 +30,9 @@ ;;;@ From: hugh@ear.mit.edu (Hugh Secker-Walker) (define (make-list k . init) (set! init (if (pair? init) (car init))) - (do ((k k (+ -1 k)) + (do ((k (+ -1 k) (+ -1 k)) (result '() (cons init result))) - ((<= k 0) result))) + ((negative? k) result))) ;@ (define (copy-list lst) (append lst '())) ;@ diff --git a/comparse.txi b/comparse.txi index 3ebe785..7ae8e3b 100644 --- a/comparse.txi +++ b/comparse.txi @@ -66,6 +66,7 @@ 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 @@ -79,3 +80,4 @@ 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 + @@ -21,9 +21,8 @@ (require 'relational-database) (require 'databases) (require 'sort) -(require-if '(not inexact) 'logical) ;for integer-expt -(define number^ (if (provided? 'inexact) expt integer-expt)) +(define number^ expt) (define number* *) (define number+ +) (define number- -) @@ -106,7 +106,7 @@ (else (slib:error 'mismatched root repos))))))) ;;@body -;;Writes @1 to file CVS/Root of @2 and all its subdirectories. +;;Writes @1 to file CVS/Root of @2. (define (cvs-set-root! new-root directory/) (define root (cvs-root directory/)) (define repos (cvs-repository directory/)) @@ -124,6 +124,12 @@ port)))) ;;@body +;;Writes @1 to file CVS/Root of @2 and all its CVS subdirectories. +(define (cvs-set-roots! new-root directory/) + (for-each (lambda (dir/) (cvs-set-root! new-root dir/)) + (cvs-directories directory/))) + +;;@body ;;Signals an error if CVS/Repository or CVS/Root files in @1 or any ;;subdirectory do not match. (define (cvs-vet directory/) @@ -4,29 +4,41 @@ Returns a list of the local pathnames (with prefix @var{directory/}) of all CVS controlled files in @var{directory/} and in @var{directory/}'s subdirectories. @end defun + @defun cvs-directories directory/ Returns a list of all of @var{directory/} and all @var{directory/}'s CVS controlled subdirectories. @end defun + @defun cvs-root path/ Returns the (string) contents of @var{path/}CVS/Root; or @code{(getenv "CVSROOT")} if Root doesn't exist. @end defun + @defun cvs-repository directory/ Returns the (string) contents of @var{directory/}CVS/Root appended with @var{directory/}CVS/Repository; or #f if @var{directory/}CVS/Repository doesn't exist. @end defun + @deffn {Procedure} cvs-set-root! new-root directory/ -Writes @var{new-root} to file CVS/Root of @var{directory/} and all its subdirectories. +Writes @var{new-root} to file CVS/Root of @var{directory/}. +@end deffn + + +@deffn {Procedure} cvs-set-roots! new-root directory/ + +Writes @var{new-root} to file CVS/Root of @var{directory/} and all its CVS subdirectories. @end deffn + @defun cvs-vet directory/ Signals an error if CVS/Repository or CVS/Root files in @var{directory/} or any subdirectory do not match. @end defun + diff --git a/daylight.scm b/daylight.scm index 6c989b2..9151f99 100644 --- a/daylight.scm +++ b/daylight.scm @@ -245,17 +245,11 @@ (vector-set! data (quotient (- wl 380) 10) (* (solCurve wl) tauR tauA tauO tauG tauWA)))))) -;;@body Returns (unnormalized) XYZ values for color of sunlight for a -;;given @1 and @2. -(define (sunlight-XYZ turbidity theta_s) - (define spectrum (sunlight-spectrum turbidity theta_s)) - (and spectrum (spectrum->XYZ spectrum 380.e-9 780.e-9))) - ;;@body Given @1 and @2, @0 returns the CIEXYZ triple for color of ;;sunlight scaled to be just inside the RGB709 gamut. -(define (sunlight-CIEXYZ turbidity theta_s) +(define (sunlight-chromaticity turbidity theta_s) (define spectrum (sunlight-spectrum turbidity theta_s)) - (and spectrum (spectrum->CIEXYZ spectrum 380.e-9 780.e-9))) + (and spectrum (spectrum->chromaticity spectrum 380.e-9 780.e-9))) ;; Arguments and result in radians (define (angle-between theta phi theta_s phi_s) diff --git a/daylight.txi b/daylight.txi index fa24afc..2d921d2 100644 --- a/daylight.txi +++ b/daylight.txi @@ -21,16 +21,19 @@ To be meticulous, subtract 4 minutes for each degree of longitude west of the standard meridian of your time zone. @end defun + @defun solar-declination julian-day @end defun + @defun solar-polar declination latitude solar-hour Returns a list of @var{theta_s}, the solar angle from the zenith, and @var{phi_s}, the solar azimuth. 0 <= @var{theta_s} measured in degrees. @var{phi_s} is measured in degrees from due south; west of south being positive. @end defun + @noindent In the following procedures, the number 0 <= @var{theta_s} <= 90 is the solar angle from the zenith in degrees. @@ -76,21 +79,19 @@ Returns a vector of 41 values, the spectrum of sunlight from 380.nm to 790.nm for a given @var{turbidity} and @var{theta_s}. @end defun -@defun sunlight-xyz turbidity theta_s -Returns (unnormalized) XYZ values for color of sunlight for a -given @var{turbidity} and @var{theta_s}. -@end defun -@defun sunlight-ciexyz turbidity theta_s -Given @var{turbidity} and @var{theta_s}, @code{sunlight-ciexyz} returns the CIEXYZ triple for color of +@defun sunlight-chromaticity turbidity theta_s +Given @var{turbidity} and @var{theta_s}, @code{sunlight-chromaticity} returns the CIEXYZ triple for color of sunlight scaled to be just inside the RGB709 gamut. @end defun + @defun zenith-xyy turbidity theta_s Returns the xyY (chromaticity and luminance) at the zenith. The Luminance has units kcd/m^2. @end defun + @defun overcast-sky-color-xyy turbidity theta_s @var{turbidity} is a positive real number expressing the amount of light scattering. The real number @var{theta_s} is the solar angle from the zenith in @@ -101,6 +102,7 @@ zenith of the viewing direction (in degrees); and returning the xyY value for light coming from that elevation of the sky. @end defun + @defun clear-sky-color-xyy turbidity theta_s phi_s @defunx sky-color-xyy turbidity theta_s phi_s @var{turbidity} is a positive real number expressing the amount of light @@ -115,3 +117,4 @@ that direction of the sky. @code{sky-color-xyY} calls @code{overcast-sky-color-xyY} for @var{turbidity} <= 20; otherwise the @code{clear-sky-color-xyy} function. @end defun + diff --git a/db2html.scm b/db2html.scm index df34389..8ad97e1 100644 --- a/db2html.scm +++ b/db2html.scm @@ -52,10 +52,10 @@ ;;@body Outputs a heading row for the currently-started table. (define (html:heading columns) - (sprintf #f " <TR VALIGN=\"TOP\">\\n%s </TR>\\n" + (sprintf #f " <TR VALIGN=\"TOP\">\\n%s\\n" (apply string-append (map (lambda (datum) - (sprintf #f " <TH>%s</TH>\\n" (or datum ""))) + (sprintf #f " <TH>%s\\n" (or datum ""))) columns)))) ;;@body Outputs a heading row with column-names @1 linked to URIs @2. @@ -92,11 +92,11 @@ (cond ((eqv? (string-index str #\newline) len) (string-append "<TT>" (substring str 0 len) "</TT>")) (else (html:pre str)))))) - (sprintf #f " <TR VALIGN=TOP>\\n%s </TR>\\n" + (sprintf #f " <TR VALIGN=TOP>\\n%s\\n" (apply string-append (map (lambda (idx datum foreign) (sprintf - #f " <TD>%s%s</TD>\\n" + #f " <TD>%s%s\\n" (if (eqv? 1 idx) (row->anchor pkl row) "") (cond ((or (not datum) (null? datum)) "") ((not foreign) (present datum)) @@ -121,8 +121,9 @@ table-name)) ;;@args caption db table-name match-key1 @dots{} -;;Returns HTML string for @2 table @3. Every foreign-key value is -;;linked to the page (of the table) defining that key. +;;Returns HTML string for @2 table @3 chopped into 50-row HTML tables. +;;Every foreign-key value is linked to the page (of the table) +;;defining that key. ;; ;;The optional @4 @dots{} arguments restrict actions to a subset of ;;the table. @xref{Table Operations, match-key}. @@ -132,19 +133,42 @@ (tags (map table-name->filename foreigns)) (names (table 'column-names)) (primlim (table 'primary-limit))) - (apply html:table "CELLSPACING=0 BORDER=1" - (html:caption caption 'BOTTOM) - (html:href-heading - names - (append (make-list primlim - (table-name->filename - (table-name->column-table-name db table-name))) - (make-list (- (length names) primlim) #f))) - (html:heading (table 'column-domains)) - (html:href-heading foreigns tags) - (html:heading (table 'column-types)) - (map (html:linked-row-converter primlim tags) - (apply (table 'row:retrieve*) args))))) + (define tables '()) + (define rows '()) + (define cnt 0) + (define (make-table rows) + (apply html:table "CELLSPACING=0 BORDER=1" + (html:caption caption 'BOTTOM) + (html:href-heading + names + (append (make-list primlim + (table-name->filename + (table-name->column-table-name db table-name))) + (make-list (- (length names) primlim) #f))) + (html:heading (table 'column-domains)) + (html:href-heading foreigns tags) + (html:heading (table 'column-types)) + rows)) + (apply (table 'for-each-row) + (lambda (row) + (set! cnt (+ 1 cnt)) + (set! rows (cons row rows)) + (cond ((<= 50 cnt) + (set! tables + (cons (make-table + (map (html:linked-row-converter primlim tags) + (reverse rows))) + tables)) + (set! cnt 0) + (set! rows '())))) + args) + (apply string-append + (reverse (if (and (null? rows) (not (null? tables))) + tables + (cons (make-table + (map (html:linked-row-converter primlim tags) + (reverse rows))) + tables)))))) ;;@body ;;Returns a complete HTML page. The string @3 names the page which @@ -162,10 +186,10 @@ (html:body (apply table->linked-html table-name db table-name args)))) (define (html:catalog-row-converter row foreigns) - (sprintf #f " <TR VALIGN=TOP>\\n%s </TR>\\n" + (sprintf #f " <TR VALIGN=TOP>\\n%s\\n" (apply string-append (map (lambda (datum foreign) - (sprintf #f " <TD>%s%s</TD>\\n" + (sprintf #f " <TD>%s%s\\n" (html:anchor (sprintf #f "%s" datum)) (html:link (make-uri foreign #f #f) datum))) row foreigns)))) @@ -384,7 +408,7 @@ (else (list fld)))) row arities) foreign-choice-lists)) - (sprintf #f " <TR>\\n <TD>%s</TD>%s\\n </TR>\\n" + (sprintf #f " <TR>\\n <TD>%s%s\\n\\n" (string-append (html:hidden '*row-hash* (crc:hash-obj row)) (html:hidden '*keys* (uri:make-path (butnthcdr pkl row))) @@ -394,7 +418,7 @@ ;; (form:image "Modify Row" "/icons/bang.png") ) (apply string-append - (map (lambda (elt) (sprintf #f " <TD>%s</TD>\\n" elt)) + (map (lambda (elt) (sprintf #f " <TD>%s\\n" elt)) (cdr elements)))))))) ;;@args k names edit-point edit-converter @@ -427,11 +451,11 @@ (else (html:pre str)))))))) (lambda (row) (string-append - (sprintf #f " <TR VALIGN=TOP>\\n%s </TR>\\n" + (sprintf #f " <TR VALIGN=TOP>\\n%s\\n" (apply string-append (map (lambda (idx datum foreign) (sprintf - #f " <TD>%s%s</TD>\\n" + #f " <TD>%s%s\\n" (if (eqv? 1 idx) (row->anchor pkl row) "") (cond ((or (not datum) (null? datum)) "") ((<= idx pkl) @@ -487,7 +511,7 @@ (if (symbol? dir) (set! dir (symbol->string dir))) (if (not (file-exists? dir)) (make-directory dir)) (db->html-files db dir index-filename dir) - (path->uri (in-vicinity (sub-vicinity "" dir) index-filename))) + (path->uri (in-vicinity (sub-vicinity (user-vicinity) dir) index-filename))) ;;@args db dir index-filename ;;@args db dir diff --git a/db2html.txi b/db2html.txi index 3b47f31..6366f87 100644 --- a/db2html.txi +++ b/db2html.txi @@ -6,6 +6,7 @@ @end defun + @defun html:caption caption align @@ -13,14 +14,17 @@ @var{align} can be @samp{top} or @samp{bottom}. @end defun + @defun html:heading columns Outputs a heading row for the currently-started table. @end defun + @defun html:href-heading columns uris Outputs a heading row with column-names @var{columns} linked to URIs @var{uris}. @end defun + @defun html:linked-row-converter k foreigns @@ -32,20 +36,24 @@ foreign-key field pages and #f for non foreign-key fields. returned procedure returns the html string for that table row. @end defun + @defun table-name->filename table-name Returns the symbol @var{table-name} converted to a filename. @end defun + @defun table->linked-html caption db table-name match-key1 @dots{} -Returns HTML string for @var{db} table @var{table-name}. Every foreign-key value is -linked to the page (of the table) defining that key. +Returns HTML string for @var{db} table @var{table-name} chopped into 50-row HTML tables. +Every foreign-key value is linked to the page (of the table) +defining that key. The optional @var{match-key1} @dots{} arguments restrict actions to a subset of the table. @xref{Table Operations, match-key}. @end defun + @defun table->linked-page db table-name index-filename arg @dots{} Returns a complete HTML page. The string @var{index-filename} names the page which @@ -55,10 +63,12 @@ The optional @var{args} @dots{} arguments restrict actions to a subset of the table. @xref{Table Operations, match-key}. @end defun + @defun catalog->html db caption arg @dots{} Returns HTML string for the catalog table of @var{db}. @end defun + @subsection HTML editing tables @noindent A client can modify one row of an editable table at a time. @@ -113,6 +123,7 @@ Optional arguments @var{update}, @var{delete}, and @var{retrieve} default to the @code{row:delete}, and @code{row:retrieve} of @var{table-name} in @var{db}. @end defun + @defun command:make-editable-table rdb table-name arg @dots{} Given @var{table-name} in @var{rdb}, creates parameter and @code{*command*} tables for editing one row of @var{table-name} at a time. @code{command:make-editable-table} returns a procedure taking a @@ -132,6 +143,7 @@ have arity @samp{nary1}. @end table @end defun + @defun html:editable-row-converter k names edit-point edit-converter @@ -148,6 +160,7 @@ the primary key fields) of each row linked to a text encoding of these fields (the result of calling @code{row->anchor}). The page so referenced typically allows the user to edit fields of that row. @end defun + @subsection HTML databases @@ -162,6 +175,7 @@ top level page with the catalog of tables (captioned @var{caption}) is written to a file named @var{index-filename}. @end defun + @defun db->html-directory db dir index-filename @@ -176,6 +190,7 @@ top page, which defaults to @file{index.html}. returned. @end defun + @defun db->netscape db dir index-filename @@ -184,3 +199,4 @@ returned. @code{browse-url} with the uri for the top page after the pages are created. @end defun + diff --git a/dbinterp.scm b/dbinterp.scm index 8ccb1df..2bd4e20 100644 --- a/dbinterp.scm +++ b/dbinterp.scm @@ -17,18 +17,36 @@ ;promotional, or sales literature without prior written consent in ;each case. +(require 'rev4-optional-procedures) ; list-tail + +;;; The procedures returned by MEMOIZE are not reentrant! +(define (dbinterp:memoize proc k) + (define recent (vector->list (make-vector k '(#f)))) + (let ((tailr (list-tail recent (+ -1 k)))) + (lambda args + (define asp (assoc args recent)) + (if asp + (cdr asp) + (let ((val (apply proc args))) + (set-cdr! tailr (list (cons args val))) + (set! tailr (cdr tailr)) + (set! recent (cdr recent)) + val))))) + ;;@ This procedure works only for tables with a single primary key. (define (interpolate-from-table table column) - (define get (table 'get column)) - (define prev (table 'isam-prev)) + (define get (dbinterp:memoize (table 'get column) 3)) + (define prev (dbinterp:memoize (table 'isam-prev) 3)) (define next (table 'isam-next)) - (lambda (x) - (let ((nxt (next x))) - (if nxt (set! nxt (car nxt))) - (let ((prv (prev (or nxt x)))) - (if prv (set! prv (car prv))) - (cond ((not nxt) (get prv)) - ((not prv) (get nxt)) - (else (/ (+ (* (- x prv) (get nxt)) - (* (- nxt x) (get prv))) - (- nxt prv)))))))) + (dbinterp:memoize + (lambda (x) + (let ((nxt (next x))) + (if nxt (set! nxt (car nxt))) + (let ((prv (prev (or nxt x)))) + (if prv (set! prv (car prv))) + (cond ((not nxt) (get prv)) + ((not prv) (get nxt)) + (else (/ (+ (* (- x prv) (get nxt)) + (* (- nxt x) (get prv))) + (- nxt prv))))))) + 3)) @@ -1,5 +1,7 @@ -;;;; "dbsyn.scm" -- Syntactic extensions for RDMS (within-database) -;;; Copyright (C) 2002 Ivan Shmakov <ivan@theory.dcn-asu.ru> +;;; "dbsyn.scm" -- Syntactic extensions for RDMS -*- scheme -*- +;; Features: within-database + +;;; Copyright (C) 2002, 2003 Ivan Shmakov <ivan@theory.dcn-asu.ru> ;; ;; Permission to copy this software, to modify it, to redistribute it, ;; to distribute modified versions, and to use it for any purpose is @@ -31,24 +33,68 @@ ;; ... and get TAGS table with all of my database commands and tables. -(require 'relational-database) +;;; Code: (require 'database-commands) (require 'databases) +(require 'relational-database) + ;@ (define-syntax within-database - (syntax-rules (define-table define-command) - + (syntax-rules (define-table define-command define-macro) + ; ((within-database database) database) - + ; define-table ((within-database database - (define-table (name primary columns) row ...) - rest ...) + (define-table (name primary columns) row ...) + rest ...) (begin (define-tables database '(name primary columns (row ...))) (within-database database rest ...))) - + ; define-command ((within-database database - (define-command template arg-1 arg-2 ...) - rest ...) + (define-command template arg-1 arg-2 ...) + rest ...) (begin (define-*commands* database '(template arg-1 arg-2 ...)) + (within-database database rest ...))) + ; + ((within-database database + (command arg-1 ...) + rest ...) + (begin (cond ((let ((p (database '*macro*))) + (and p (slib:eval (p 'command)))) + => (lambda (proc) + (slib:eval + (apply proc database '(arg-1 ...))))) + (else + ((database 'command) arg-1 ...))) (within-database database rest ...))))) + +(define (define-*macros* rdb . specs) + (define defmac + (((rdb 'open-table) '*macros* #t) 'row:update)) + (for-each (lambda (spec) + (let* ((procname (caar spec)) + (args (cdar spec)) + (body-1 (cdr spec)) + (comment (and (string? (car body-1)) + (car body-1))) + (body (if comment (cdr body-1) body-1))) + (defmac (list procname + `(lambda ,args . ,body) + (or comment ""))))) + specs)) + +;@ +(define (add-macro-support rdb) + (define-tables rdb + '(*macros* + ((name symbol)) + ((procedure expression) + (documentation string)) + ((define-macro (lambda (db . args) + (define-*macros* db args) + #t) "")))) + (define-*commands* rdb + '((*macro* rdb) + (((rdb 'open-table) '*macros* #f) 'get 'procedure))) + rdb) @@ -113,11 +113,13 @@ (if (null? *base-table-implementations*) (require 'alist-table)) (cond ((and (not (and mutable? (not certificate))) (loop *base-table-implementations*))) - ((memq 'alist-table *base-table-implementations*) #f) - ((let () - (require 'alist-table) - (loop (list (car *base-table-implementations*))))) - (else #f))) + ((and (not (memq 'alist-table *base-table-implementations*)) + (let () + (require 'alist-table) + (loop (list (car *base-table-implementations*)))))) + (else + (and certificate (file-unlock! filename certificate)) + #f))) (define (mdbm:open-type filename type mutable?) (require type) @@ -126,7 +128,9 @@ (let* ((sys (cadr (assq type *base-table-implementations*))) (open (and sys (sys 'open-database))) (ndb (and open (open filename mutable?)))) - (and ndb (list ndb 1 type certificate)))))) + (cond (ndb (list ndb 1 type certificate)) + (else (and certificate (file-unlock! filename certificate)) + #f)))))) ;;@args filename base-table-type ;;@1 should be a string naming a file; or @code{#f}. @2 must be a @@ -302,14 +306,16 @@ (define certificate #f) (and entry (set! rdb (car entry))) (and (procedure? rdb) - (set! certificate (or (and entry (cadddr entry)) - (and (rdb 'filename) - (file-lock! (rdb 'filename)))))) + (set! certificate (and entry (cadddr entry)))) (cond ((and entry (not (eqv? 1 (cadr entry)))) (set-car! (cdr entry) (+ -1 (cadr entry))) #f) - ((or (not certificate) (not (procedure? rdb))) + ((not (procedure? rdb)) + (slib:warn 'close-database 'not 'procedure? rdb) #f) + ((not certificate) + (and dbs (set! dbs (mdbm:remove-entry dbs entry))) + #t) (else (let* ((filename (rdb 'filename)) (dbclose (rdb 'close-database)) @@ -65,6 +65,7 @@ alist-table is the default base-table type: (define my-rdb (create-database "my.db" 'alist-table)) @end example @end defun + @noindent Only @code{alist-table} and base-table modules which have been @code{require}d will dispatch correctly from the @@ -79,6 +80,7 @@ argument. Returns @emph{mutable} open relational database or #f. @end deffn + @defun open-database rdb base-table-type Returns an open relational database associated with @var{rdb}. The @@ -90,22 +92,26 @@ Returns an open relational database associated with @var{rdb}. @code{open-database} will attempt to deduce the correct base-table-type. @end defun + @defun write-database rdb filename Writes the mutable relational-database @var{rdb} to @var{filename}. @end defun + @defun sync-database rdb Writes the mutable relational-database @var{rdb} to the filename it was opened with. @end defun + @defun solidify-database rdb Syncs @var{rdb} and makes it immutable. @end defun + @defun close-database rdb @var{rdb} will only be closed when the count of @code{open-database} - @code{close-database} @@ -113,12 +119,14 @@ calls for @var{rdb} (and its filename) is 0. @code{close-database} returns #t i and #f otherwise. @end defun + @defun mdbm:report Prints a table of open database files. The columns are the base-table type, number of opens, @samp{!} for mutable, the filename, and the lock certificate (if locked). @end defun + @example (mdbm:report) @print{} @@ -138,6 +146,7 @@ filename, and the lock certificate (if locked). @code{#f}. @end defun + @deffn {Procedure} open-table! rdb table-name @var{rdb} must be a relational database and @var{table-name} a symbol. @@ -146,6 +155,7 @@ filename, and the lock certificate (if locked). @var{rdb} if it exists and can be opened in mutable mode, otherwise returns @code{#f}. @end deffn + @subsubheading Defining Tables @@ -160,11 +170,13 @@ Representation}. @end example @end defun + @defun add-domain rdb row5 Use @code{define-domains} instead. @end defun + @defun define-tables rdb spec-0 @dots{} Adds tables as specified in @var{spec-0} @dots{} to the open @@ -204,6 +216,7 @@ If @r{<domain>} is not a defined domain name and it matches the name of this table or an already defined (in one of @var{spec-0} @dots{}) single key field table, a foreign-key domain will be created for it. @end defun + @subsubheading Listing Tables @@ -217,3 +230,4 @@ and domains, its other key names and domains, and the table's records The list returned by @code{list-table-definition}, when passed as an argument to @code{define-tables}, will recreate the table. @end defun + @@ -1,5 +1,5 @@ ;;; "determ.scm" Matrix Algebra -;Copyright 2002 Aubrey Jaffer +;Copyright 2002, 2004 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -24,30 +24,30 @@ ;;@noindent ;;A Matrix can be either a list of lists (rows) or an array. -;;As with linear-algebra texts, this package uses 1-based coordinates. +;;Unlike linear-algebra texts, this package uses 0-based coordinates. ;;; Internal conversion routines (define (matrix2array matrix prototype) - (let* ((shp (list (list 1 (length matrix)) - (list 1 (length (car matrix))))) - (mat (apply create-array '#() shp))) - (do ((idx 1 (+ 1 idx)) + (let* ((dim1 (length matrix)) + (dim2 (length (car matrix))) + (mat (make-array '#() dim1 dim2))) + (do ((idx 0 (+ 1 idx)) (rows matrix (cdr rows))) - ((> idx (cadar shp)) rows) - (do ((jdx 1 (+ 1 jdx)) + ((>= idx dim1) rows) + (do ((jdx 0 (+ 1 jdx)) (row (car rows) (cdr row))) - ((> jdx (cadadr shp))) + ((>= jdx dim2)) (array-set! mat (car row) idx jdx))) - mat)) + mat)) (define (matrix2lists matrix) - (let ((shp (array-shape matrix))) - (do ((idx (cadar shp) (+ -1 idx)) - (rows '() - (cons (do ((jdx (cadadr shp) (+ -1 jdx)) + (let ((dims (array-dimensions matrix))) + (do ((idx (+ -1 (car dims)) (+ -1 idx)) + (rows '() + (cons (do ((jdx (+ -1 (cadr dims)) (+ -1 jdx)) (row '() (cons (array-ref matrix idx jdx) row))) - ((< jdx (caadr shp)) row)) + ((< jdx 0) row)) rows))) - ((< idx (caar shp)) rows)))) + ((< idx 0) rows)))) (define (coerce-like-arg matrix arg) (cond ((array? arg) (matrix2array matrix arg)) (else matrix))) @@ -3,7 +3,7 @@ @noindent A Matrix can be either a list of lists (rows) or an array. -As with linear-algebra texts, this package uses 1-based coordinates. +Unlike linear-algebra texts, this package uses 0-based coordinates. @defun matrix->lists matrix @@ -11,11 +11,13 @@ As with linear-algebra texts, this package uses 1-based coordinates. Returns the list-of-lists form of @var{matrix}. @end defun + @defun matrix->array matrix Returns the (ones-based) array form of @var{matrix}. @end defun + @defun determinant matrix @var{matrix} must be a square matrix. @@ -28,20 +30,24 @@ Returns the (ones-based) array form of @var{matrix}. @end example @end defun + @defun transpose matrix Returns a copy of @var{matrix} flipped over the diagonal containing the 1,1 element. @end defun + @defun matrix:product m1 m2 Returns the product of matrices @var{m1} and @var{m2}. @end defun + @defun matrix:inverse matrix @var{matrix} must be a square matrix. If @var{matrix} is singlar, then @code{matrix:inverse} returns #f; otherwise @code{matrix:inverse} returns the @code{matrix:product} inverse of @var{matrix}. @end defun + @@ -1,5 +1,5 @@ ;;;; "differ.scm" O(NP) Sequence Comparison Algorithm. -;;; Copyright (C) 2001, 2002, 2003 Aubrey Jaffer +;;; Copyright (C) 2001, 2002, 2003, 2004 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -25,14 +25,14 @@ ;;S. Wu, E. Myers, U. Manber, and W. Miller, ;; "An O(NP) Sequence Comparison Algorithm," ;; Information Processing Letters 35, 6 (1990), 317-323. -;; @url{http://www.cs.arizona.edu/people/gene/vita.html} +;; @url{http://www.cs.arizona.edu/people/gene/PAPERS/np_diff.ps} ;;@end example ;;@end ifinfo ;;@ifset html ;;S. Wu, <A HREF="http://www.cs.arizona.edu/people/gene/vita.html"> ;;E. Myers,</A> U. Manber, and W. Miller, ;;<A HREF="http://www.cs.arizona.edu/people/gene/PAPERS/np_diff.ps"> -;;"An O(NP) Sequence Comparison Algorithm,"</A> +;;"An O(NP) Sequence Comparison Algorithm"</A>, ;;Information Processing Letters 35, 6 (1990), 317-323. ;;@end ifset ;; @@ -41,12 +41,24 @@ ;;the degree of match between two sequences. ;; ;;@noindent -;;Surprisingly, "An O(NP) Sequence Comparison Algorithm" does not -;;derive the edit sequence; only the sequence length. Developing this -;;linear-space sub-quadratic-time algorithm for computing the edit -;;sequence required hundreds of hours of work. I have submitted a -;;paper describing the algorithm to the Journal of Computational -;;Biology. +;;@code{diff:edits} and @code{diff:longest-common-subsequence} combine +;;the algorithm with the divide-and-conquer method outlined in: +;; +;;@ifinfo +;;@example +;;E. Myers and W. Miller, +;; "Optimal alignments in linear space", +;; Computer Application in the Biosciences (CABIOS), 4(1):11-17, 1988. +;; @url{http://www.cs.arizona.edu/people/gene/PAPERS/linear.ps} +;;@end example +;;@end ifinfo +;;@ifset html +;;<A HREF="http://www.cs.arizona.edu/people/gene/vita.html"> +;;E. Myers,</A> and W. Miller, +;;<A HREF="http://www.cs.arizona.edu/people/gene/PAPERS/linear.ps"> +;;"Optimal alignments in linear space"</A>, +;;Computer Application in the Biosciences (CABIOS), 4(1):11-17, 1988. +;;@end ifset ;; ;;@noindent ;;If the items being sequenced are text lines, then the computed @@ -55,24 +67,23 @@ ;;lesser known @dfn{spiff} program. (require 'array) -(require 'sort) ;;; p-lim is half the number of gratuitous edits for strings of given ;;; lengths. ;;; When passed #f CC, fp:compare returns edit-distance if successful; ;;; #f otherwise (p > p-lim). When passed CC, fp:compare returns #f. -(define (fp:compare fp CC A M B N =? p-lim) +(define (fp:compare fp fpoff CC A M B N p-lim) (define Delta (- N M)) ;;(if (negative? Delta) (slib:error 'fp:compare (fp:subarray A 0 M) '> (fp:subarray B 0 N))) ;;(set! compares (+ 1 compares)) ;(print 'fp:compare M N p-lim) (let loop ((p 0)) (do ((k (- p) (+ 1 k))) ((>= k Delta)) - (fp:run fp k A M B N =? CC p)) + (fp:run fp fpoff k A M B N CC p)) (do ((k (+ Delta p) (+ -1 k))) ((<= k Delta)) - (fp:run fp k A M B N =? CC p)) - (let ((fpval (fp:run fp Delta A M B N =? CC p))) + (fp:run fp fpoff k A M B N CC p)) + (let ((fpval (fp:run fp fpoff Delta A M B N CC p))) ;; At this point, the cost to (fpval-Delta, fpval) is Delta + 2*p (cond ((and (not CC) (<= N fpval)) (+ Delta (* 2 p))) ((and (not (negative? p-lim)) (>= p p-lim)) #f) @@ -81,11 +92,11 @@ ;;; Traces runs of matches until they end; then set fp[k]=y. ;;; If CC is supplied, set each CC[y] = min(CC[y], cost) for run. ;;; Returns furthest y reached. -(define (fp:run fp k A M B N =? CC p) - (define y (max (+ 1 (array-ref fp (+ -1 k))) (array-ref fp (+ 1 k)))) +(define (fp:run fp fpoff k A M B N CC p) (define cost (+ k p p)) - (let snloop ((x (- y k)) - (y y)) + (let snloop ((y (max (+ (array-ref fp (+ -1 k fpoff)) 1) + (array-ref fp (+ 1 k fpoff))))) + (define x (- y k)) (and CC (<= y N) (let ((xcst (- M x))) (cond ((negative? xcst)) @@ -94,9 +105,9 @@ y))))) ;;(set! tick (+ 1 tick)) (cond ((and (< x M) (< y N) - (=? (array-ref A x) (array-ref B y))) - (snloop (+ 1 x) (+ 1 y))) - (else (array-set! fp y k) + (eqv? (array-ref A x) (array-ref B y))) + (snloop (+ 1 y))) + (else (array-set! fp y (+ fpoff k)) y)))) ;;; Check that only 1 and -1 steps between adjacent CC entries. @@ -126,10 +137,7 @@ ;; cdx)) ;; CC) -(define (diff:mid-split M N RR CC cost) - (define b-splt N) ;Default - (define bestrun 0) - (define thisrun 0) +(define (diff:mid-split N RR CC cost) ;; RR is not longer than CC. So do for each element of RR. (let loop ((cdx (+ 1 (quotient N 2))) (rdx (quotient N 2))) @@ -143,18 +151,19 @@ (define (fp:subarray RA start end) (define n-len (abs (- end start))) (if (< end start) - (make-shared-array RA (lambda (idx) (list (- start 1 idx))) n-len) + (make-shared-array RA (lambda (idx) (list (+ -1 (- start idx)))) n-len) (make-shared-array RA (lambda (idx) (list (+ start idx))) n-len))) -(define (fp:init! fp fill mindx maxdx) - (do ((idx maxdx (+ -1 idx))) - ((< idx mindx)) +(define (fp:init! fp fpoff fill mindx maxdx) + (define mlim (+ fpoff mindx)) + (do ((idx (+ fpoff maxdx) (+ -1 idx))) + ((< idx mlim)) (array-set! fp fill idx))) ;;; Split A[start-a..end-a] (shorter array) into smaller and smaller chunks. ;;; EDX is index into EDITS. ;;; EPO is insert/delete polarity (+1 or -1) -(define (diff:divide-and-conquer fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim) +(define (diff:divide-and-conquer fp fpoff CCRR A start-a end-a B start-b end-b edits edx epo p-lim) (define mid-a (quotient (+ start-a end-a) 2)) (define len-b (- end-b start-b)) (define len-a (- end-a start-a)) @@ -163,18 +172,20 @@ (define RR (fp:subarray CCRR (+ len-b 1) (* 2 (+ len-b 1)))) (define M2 (- end-a mid-a)) (define M1 (- mid-a start-a)) - (fp:init! CC (+ len-a len-b) 0 len-b) - (fp:init! fp -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M1))) - (fp:compare fp CC + (fp:init! CC 0 (+ len-a len-b) 0 len-b) + (fp:init! fp fpoff -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M1))) + (fp:compare fp fpoff CC (fp:subarray A start-a mid-a) M1 - (fp:subarray B start-b end-b) len-b =? (min p-lim len-a)) - (fp:init! RR (+ len-a len-b) 0 len-b) - (fp:init! fp -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M2))) - (fp:compare fp RR + (fp:subarray B start-b end-b) len-b + (min p-lim len-a)) + (fp:init! RR 0 (+ len-a len-b) 0 len-b) + (fp:init! fp fpoff -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M2))) + (fp:compare fp fpoff RR (fp:subarray A end-a mid-a) M2 - (fp:subarray B end-b start-b) len-b =? (min p-lim len-a)) + (fp:subarray B end-b start-b) len-b + (min p-lim len-a)) ;;(smooth-costs CC len-b) (smooth-costs RR len-b) - (let ((b-splt (diff:mid-split len-a len-b RR CC tcst))) + (let ((b-splt (diff:mid-split len-b RR CC tcst))) (define est-c (array-ref CC b-splt)) (define est-r (array-ref RR (- len-b b-splt))) ;;(set! splts (cons (/ b-splt (max .1 len-b)) splts)) @@ -183,49 +194,49 @@ ;;(print 'cc cc) (print 'rr (fp:subarray RR (+ 1 len-b) 0)) ;;(print (make-string (+ 7 (* 2 b-splt)) #\-) '^ (list b-splt)) (check-cost! 'CC est-c - (diff2et fp CCRR + (diff2et fp fpoff CCRR A start-a mid-a B start-b (+ start-b b-splt) - edits edx epo =? + edits edx epo (quotient (- est-c (- b-splt (- mid-a start-a))) 2))) (check-cost! 'RR est-r - (diff2et fp CCRR + (diff2et fp fpoff CCRR A mid-a end-a B (+ start-b b-splt) end-b - edits (+ est-c edx) epo =? + edits (+ est-c edx) epo (quotient (- est-r (- (- len-b b-splt) (- end-a mid-a))) 2))) (+ est-c est-r)))) ;;; Trim; then diff sub-arrays; either one longer. Returns edit-length -(define (diff2et fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim) +(define (diff2et fp fpoff CCRR A start-a end-a B start-b end-b edits edx epo p-lim) ;; (if (< (- end-a start-a) p-lim) (slib:warn 'diff2et 'len-a (- end-a start-a) 'len-b (- end-b start-b) 'p-lim p-lim)) (do ((bdx (+ -1 end-b) (+ -1 bdx)) (adx (+ -1 end-a) (+ -1 adx))) ((not (and (<= start-b bdx) (<= start-a adx) - (=? (array-ref A adx) (array-ref B bdx)))) + (eqv? (array-ref A adx) (array-ref B bdx)))) (do ((bsx start-b (+ 1 bsx)) (asx start-a (+ 1 asx))) ((not (and (< bsx bdx) (< asx adx) - (=? (array-ref A asx) (array-ref B bsx)))) + (eqv? (array-ref A asx) (array-ref B bsx)))) ;;(print 'trim-et (- asx start-a) '+ (- end-a adx)) (let ((delta (- (- bdx bsx) (- adx asx)))) (if (negative? delta) - (diff2ez fp CCRR B bsx (+ 1 bdx) A asx (+ 1 adx) - edits edx (- epo) =? (+ delta p-lim)) - (diff2ez fp CCRR A asx (+ 1 adx) B bsx (+ 1 bdx) - edits edx epo =? p-lim)))) + (diff2ez fp fpoff CCRR B bsx (+ 1 bdx) A asx (+ 1 adx) + edits edx (- epo) (+ delta p-lim)) + (diff2ez fp fpoff CCRR A asx (+ 1 adx) B bsx (+ 1 bdx) + edits edx epo p-lim)))) ;;(set! tick (+ 1 tick)) )) ;;(set! tick (+ 1 tick)) )) ;;; Diff sub-arrays, A not longer than B. Returns edit-length -(define (diff2ez fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim) +(define (diff2ez fp fpoff CCRR A start-a end-a B start-b end-b edits edx epo p-lim) (define len-a (- end-a start-a)) (define len-b (- end-b start-b)) ;;(if (> len-a len-b) (slib:error 'diff2ez len-a '> len-b)) @@ -241,7 +252,7 @@ (edx edx (+ 1 edx))) ((>= idx end-b) (- len-b len-a)) (array-set! edits (* epo (+ 1 idx)) edx))) - ((=? (array-ref A adx) (array-ref B bdx)) + ((eqv? (array-ref A adx) (array-ref B bdx)) ;;(set! tick (+ 1 tick)) (loop (+ 1 adx) (+ 1 bdx) edx)) (else (array-set! edits (* epo (+ 1 bdx)) edx) @@ -250,65 +261,39 @@ ((<= len-a p-lim) ; delete all A; insert all B ;;(if (< len-a p-lim) (slib:error 'diff2ez len-a len-b 'p-lim p-lim)) (do ((idx start-a (+ 1 idx)) - (edx edx (+ 1 edx))) - ((>= idx end-a) - (do ((jdx start-b (+ 1 jdx)) - (edx edx (+ 1 edx))) - ((>= jdx end-b)) - (array-set! edits (* epo (+ 1 jdx)) edx))) - (array-set! edits (* epo (- -1 idx)) edx)) - (+ len-a len-b)) + (jdx start-b (+ 1 jdx))) + ((and (>= idx end-a) (>= jdx end-b)) (+ len-a len-b)) + (cond ((< jdx end-b) + (array-set! edits (* epo (+ 1 jdx)) edx) + (set! edx (+ 1 edx)))) + (cond ((< idx end-a) + (array-set! edits (* epo (- -1 idx)) edx) + (set! edx (+ 1 edx)))))) (else (diff:divide-and-conquer - fp CCRR A start-a end-a B start-b end-b - edits edx epo =? p-lim)))) + fp fpoff CCRR A start-a end-a B start-b end-b + edits edx epo p-lim)))) -;;;Return new vector of edits in correct sequence -(define (diff:order-edits edits cost sign) - (if (negative? sign) - (do ((idx (+ -1 cost) (+ -1 idx))) - ((negative? idx)) - (array-set! edits (- (array-ref edits idx)) idx))) - (if (zero? cost) - edits - (let ((sedits (sort! edits <)) - (nedits (create-array (As32) cost))) - ;; Find -/+ boundary - (define len-a (max 0 (- (array-ref sedits 0)))) - (define len-b (array-ref sedits (+ -1 cost))) - (do ((idx 0 (+ 1 idx))) - ((or (>= idx cost) (positive? (array-ref sedits idx))) - (let loop ((ddx (+ -1 idx)) - (idx idx) - (ndx 0) - (adx 0) - (bdx 0)) - (define del (if (negative? ddx) 0 (array-ref sedits ddx))) - (define ins (if (>= idx cost) 0 (array-ref sedits idx))) - (cond ((and (>= bdx len-b) (>= adx len-a)) nedits) - ((and (negative? del) (>= adx (- -1 del)) - (positive? ins) (>= bdx (+ -1 ins))) - (array-set! nedits del ndx) - (array-set! nedits ins (+ 1 ndx)) - (loop (+ -1 ddx) (+ 1 idx) (+ 2 ndx) - (+ 1 adx) (+ 1 bdx))) - ((and (negative? del) (>= adx (- -1 del))) - (array-set! nedits del ndx) - (loop (+ -1 ddx) idx (+ 1 ndx) (+ 1 adx) bdx)) - ((and (positive? ins) (>= bdx (+ -1 ins))) - (array-set! nedits ins ndx) - (loop ddx (+ 1 idx) (+ 1 ndx) adx (+ 1 bdx))) - (else - (loop ddx idx ndx (+ 1 adx) (+ 1 bdx)))))))))) +(define (check-cost! name est cost) + (if (not (eqv? est cost)) + (slib:warn name "cost check failed" est '!= cost))) + +;;;; Routines interfacing API layer to algorithms. + +(define (diff:invert-edits! edits) + (define cost (car (array-dimensions edits))) + (do ((idx (+ -1 cost) (+ -1 idx))) + ((negative? idx)) + (array-set! edits (- (array-ref edits idx)) idx))) ;;; len-a < len-b -(define (edits2lcs lcs edits cost A len-a len-b) +(define (edits2lcs! lcs edits A) + (define cost (car (array-dimensions edits))) + (define len-a (car (array-dimensions A))) (let loop ((edx 0) (sdx 0) (adx 0)) - (let ((edit (if (< edx cost) - (array-ref edits edx) - 0))) - (cond ((>= adx len-a) lcs) + (let ((edit (if (< edx cost) (array-ref edits edx) 0))) + (cond ((>= adx len-a)) ((positive? edit) (loop (+ 1 edx) sdx adx)) ((zero? edit) @@ -321,67 +306,56 @@ (loop edx (+ 1 sdx) (+ 1 adx))))))) ;; A not longer than B (M <= N) -(define (diff2edits A M B N =? p-lim) - (define maxdx (if (negative? p-lim) (+ 2 N) (+ 1 p-lim (- N M)))) - (define mindx (if (negative? p-lim) (- (+ 1 M)) (- (+ 1 p-lim)))) - ;;(if (> M N) (slib:error 'diff2edits M '> N)) - (let ((fp (create-array (As32) (list mindx maxdx))) - (CCRR (create-array (As32) (* 2 (+ N 1))))) - (fp:init! fp -1 mindx maxdx) - (let ((est (fp:compare fp #f A M B N =? p-lim))) - (and est - (let ((edits (create-array (As32) est))) - (check-cost! 'diff2edits - est - (diff2et fp CCRR A 0 M B 0 N edits 0 1 =? - (quotient (- est (- N M)) 2))) - edits))))) +(define (diff2edits! edits fp CCRR A B) + (define N (car (array-dimensions B))) + (define M (car (array-dimensions A))) + (define est (car (array-dimensions edits))) + (let ((p-lim (quotient (- est (- N M)) 2))) + (check-cost! 'diff2edits! + est + (diff2et fp (+ 1 p-lim) + CCRR A 0 M B 0 N edits 0 1 p-lim)))) ;; A not longer than B (M <= N) -(define (diff2editlen A M B N =? p-lim) - (define maxdx (if (negative? p-lim) (+ 1 N) (+ 1 p-lim (- N M)))) - (define mindx (if (negative? p-lim) (- (+ 1 M)) (- (+ 1 p-lim)))) - (let ((fp (create-array (As32) (list mindx maxdx)))) - (fp:init! fp -1 mindx maxdx) - (fp:compare fp #f A M B N =? p-lim))) +(define (diff2editlen fp A B p-lim) + (define N (car (array-dimensions B))) + (define M (car (array-dimensions A))) + (let ((maxdx (if (negative? p-lim) (+ 1 N) (+ 1 p-lim (- N M)))) + (mindx (if (negative? p-lim) (- (+ 1 M)) (- (+ 1 p-lim))))) + (fp:init! fp (- mindx) -1 mindx maxdx) + (fp:compare fp (- mindx) #f A M B N p-lim))) -(define (check-cost! name est cost) - (if (not (eqv? est cost)) - (slib:warn "%s: cost check failed %d != %d\\n" name est cost))) +;;;; API -;;@args array1 array2 =? p-lim -;;@args array1 array2 =? -;;@1 and @2 are one-dimensional arrays. The procedure @3 is used -;;to compare sequence tokens for equality. +;;@args array1 array2 p-lim +;;@args array1 array2 +;;@1 and @2 are one-dimensional arrays. ;; -;;The non-negative integer @4, if provided, is maximum number of +;;The non-negative integer @3, if provided, is maximum number of ;;deletions of the shorter sequence to allow. @0 will return @code{#f} ;;if more deletions would be necessary. ;; ;;@0 returns a one-dimensional array of length @code{(quotient (- (+ ;;len1 len2) (diff:edit-length @1 @2)) 2)} holding the longest sequence ;;common to both @var{array}s. -(define (diff:longest-common-subsequence A B =? . p-lim) - (define len-a (car (array-dimensions a))) - (define len-b (car (array-dimensions b))) +(define (diff:longest-common-subsequence A B . p-lim) + (define M (car (array-dimensions A))) + (define N (car (array-dimensions B))) (set! p-lim (if (null? p-lim) -1 (car p-lim))) - (let ((edits (if (< len-b len-a) - (diff2edits B len-b A len-a =? p-lim) - (diff2edits A len-a B len-b =? p-lim)))) + (let ((edits (if (< N M) + (diff:edits B A p-lim) + (diff:edits A B p-lim)))) (and edits (let* ((cost (car (array-dimensions edits))) - (sedit (diff:order-edits edits cost (if (< len-b len-a) -1 1))) - (lcs (create-array A (/ (- (+ len-b len-a) cost) 2)))) - (if (< len-b len-a) - (edits2lcs lcs sedit cost B len-b len-a) - (edits2lcs lcs sedit cost A len-a len-b)))))) + (lcs (make-array A (/ (- (+ N M) cost) 2)))) + (edits2lcs! lcs edits (if (< N M) B A)) + lcs)))) -;;@args array1 array2 =? p-lim -;;@args array1 array2 =? -;;@1 and @2 are one-dimensional arrays. The procedure @3 is used -;;to compare sequence tokens for equality. +;;@args array1 array2 p-lim +;;@args array1 array2 +;;@1 and @2 are one-dimensional arrays. ;; -;;The non-negative integer @4, if provided, is maximum number of +;;The non-negative integer @3, if provided, is maximum number of ;;deletions of the shorter sequence to allow. @0 will return @code{#f} ;;if more deletions would be necessary. ;; @@ -395,44 +369,57 @@ ;;@item @var{k} < 0 ;;Deletes @code{(array-ref @2 (- -1 @var{k}))} from the sequence. ;;@end table -(define (diff:edits A B =? . p-lim) - (define len-a (car (array-dimensions a))) - (define len-b (car (array-dimensions b))) +(define (diff:edits A B . p-lim) + (define M (car (array-dimensions A))) + (define N (car (array-dimensions B))) (set! p-lim (if (null? p-lim) -1 (car p-lim))) - (let ((edits (if (< len-b len-a) - (diff2edits B len-b A len-a =? p-lim) - (diff2edits A len-a B len-b =? p-lim)))) - (and edits (diff:order-edits edits (car (array-dimensions edits)) - (if (< len-b len-a) -1 1))))) + (let ((fp (make-array (A:fixZ32b) (if (negative? p-lim) + (+ 3 M N) + (+ 3 (abs (- N M)) p-lim p-lim))))) + (define est (if (< N M) + (diff2editlen fp B A p-lim) + (diff2editlen fp A B p-lim))) + (and est + (let ((edits (make-array (A:fixZ32b) est)) + (CCRR (make-array (A:fixZ32b) (* 2 (+ (max M N) 1))))) + (cond ((< N M) + (diff2edits! edits fp CCRR B A) + (diff:invert-edits! edits)) + (else + (diff2edits! edits fp CCRR A B))) + ;;(diff:order-edits! edits est) + edits)))) -;;@args array1 array2 =? p-lim -;;@args array1 array2 =? -;;@1 and @2 are one-dimensional arrays. The procedure @3 is used -;;to compare sequence tokens for equality. +;;@args array1 array2 p-lim +;;@args array1 array2 +;;@1 and @2 are one-dimensional arrays. ;; -;;The non-negative integer @4, if provided, is maximum number of +;;The non-negative integer @3, if provided, is maximum number of ;;deletions of the shorter sequence to allow. @0 will return @code{#f} ;;if more deletions would be necessary. ;; ;;@0 returns the length of the shortest sequence of edits transformaing ;;@1 to @2. -(define (diff:edit-length A B =? . p-lim) - (define M (car (array-dimensions a))) - (define N (car (array-dimensions b))) +(define (diff:edit-length A B . p-lim) + (define M (car (array-dimensions A))) + (define N (car (array-dimensions B))) (set! p-lim (if (null? p-lim) -1 (car p-lim))) - (if (< N M) - (diff2editlen B N A M =? p-lim) - (diff2editlen A M B N =? p-lim))) + (let ((fp (make-array (A:fixZ32b) (if (negative? p-lim) + (+ 3 M N) + (+ 3 (abs (- N M)) p-lim p-lim))))) + (if (< N M) + (diff2editlen fp B A p-lim) + (diff2editlen fp A B p-lim)))) ;;@example -;;(diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm" eqv?) +;;(diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm") ;;@result{} "fghijklm" ;; -;;(diff:edit-length "fghiejcklm" "fgehijkpqrlm" eqv?) +;;(diff:edit-length "fghiejcklm" "fgehijkpqrlm") ;;@result{} 6 ;; -;;(diff:edits "fghiejcklm" "fgehijkpqrlm" eqv?) -;;@result{} #As32(3 -5 -7 8 9 10) +;;(diff:edits "fghiejcklm" "fgehijkpqrlm") +;;@result{} #A:fixZ32b(3 -5 -7 8 9 10) ;; ; e c h p q r ;;@end example @@ -6,14 +6,14 @@ S. Wu, E. Myers, U. Manber, and W. Miller, "An O(NP) Sequence Comparison Algorithm," Information Processing Letters 35, 6 (1990), 317-323. - @url{http://www.cs.arizona.edu/people/gene/vita.html} + @url{http://www.cs.arizona.edu/people/gene/PAPERS/np_diff.ps} @end example @end ifinfo @ifset html S. Wu, <A HREF="http://www.cs.arizona.edu/people/gene/vita.html"> E. Myers,</A> U. Manber, and W. Miller, <A HREF="http://www.cs.arizona.edu/people/gene/PAPERS/np_diff.ps"> -"An O(NP) Sequence Comparison Algorithm,"</A> +"An O(NP) Sequence Comparison Algorithm"</A>, Information Processing Letters 35, 6 (1990), 317-323. @end ifset @@ -22,12 +22,24 @@ The values returned by @code{diff:edit-length} can be used to gauge the degree of match between two sequences. @noindent -Surprisingly, "An O(NP) Sequence Comparison Algorithm" does not -derive the edit sequence; only the sequence length. Developing this -linear-space sub-quadratic-time algorithm for computing the edit -sequence required hundreds of hours of work. I have submitted a -paper describing the algorithm to the Journal of Computational -Biology. +@code{diff:edits} and @code{diff:longest-common-subsequence} combine +the algorithm with the divide-and-conquer method outlined in: + +@ifinfo +@example +E. Myers and W. Miller, + "Optimal alignments in linear space", + Computer Application in the Biosciences (CABIOS), 4(1):11-17, 1988. + @url{http://www.cs.arizona.edu/people/gene/PAPERS/linear.ps} +@end example +@end ifinfo +@ifset html +<A HREF="http://www.cs.arizona.edu/people/gene/vita.html"> +E. Myers,</A> and W. Miller, +<A HREF="http://www.cs.arizona.edu/people/gene/PAPERS/linear.ps"> +"Optimal alignments in linear space"</A>, +Computer Application in the Biosciences (CABIOS), 4(1):11-17, 1988. +@end ifset @noindent If the items being sequenced are text lines, then the computed @@ -38,12 +50,11 @@ lesser known @dfn{spiff} program. @cindex spiff -@defun diff:longest-common-subsequence array1 array2 =? p-lim +@defun diff:longest-common-subsequence array1 array2 p-lim -@defunx diff:longest-common-subsequence array1 array2 =? -@var{array1} and @var{array2} are one-dimensional arrays. The procedure @var{=?} is used -to compare sequence tokens for equality. +@defunx diff:longest-common-subsequence array1 array2 +@var{array1} and @var{array2} are one-dimensional arrays. The non-negative integer @var{p-lim}, if provided, is maximum number of deletions of the shorter sequence to allow. @code{diff:longest-common-subsequence} will return @code{#f} @@ -54,12 +65,12 @@ len1 len2) (diff:edit-length @var{array1} @var{array2})) 2)} holding the longest common to both @var{array}s. @end defun -@defun diff:edits array1 array2 =? p-lim + +@defun diff:edits array1 array2 p-lim -@defunx diff:edits array1 array2 =? -@var{array1} and @var{array2} are one-dimensional arrays. The procedure @var{=?} is used -to compare sequence tokens for equality. +@defunx diff:edits array1 array2 +@var{array1} and @var{array2} are one-dimensional arrays. The non-negative integer @var{p-lim}, if provided, is maximum number of deletions of the shorter sequence to allow. @code{diff:edits} will return @code{#f} @@ -77,12 +88,12 @@ Deletes @code{(array-ref @var{array2} (- -1 @var{k}))} from the sequence. @end table @end defun -@defun diff:edit-length array1 array2 =? p-lim +@defun diff:edit-length array1 array2 p-lim -@defunx diff:edit-length array1 array2 =? -@var{array1} and @var{array2} are one-dimensional arrays. The procedure @var{=?} is used -to compare sequence tokens for equality. + +@defunx diff:edit-length array1 array2 +@var{array1} and @var{array2} are one-dimensional arrays. The non-negative integer @var{p-lim}, if provided, is maximum number of deletions of the shorter sequence to allow. @code{diff:edit-length} will return @code{#f} @@ -91,15 +102,16 @@ if more deletions would be necessary. @code{diff:edit-length} returns the length of the shortest sequence of edits transformaing @var{array1} to @var{array2}. @end defun + @example -(diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm" eqv?) +(diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm") @result{} "fghijklm" -(diff:edit-length "fghiejcklm" "fgehijkpqrlm" eqv?) +(diff:edit-length "fghiejcklm" "fgehijkpqrlm") @result{} 6 -(diff:edits "fghiejcklm" "fgehijkpqrlm" eqv?) -@result{} #As32(3 -5 -7 8 9 10) +(diff:edits "fghiejcklm" "fgehijkpqrlm") +@result{} #A:fixZ32b(3 -5 -7 8 9 10) ; e c h p q r @end example @@ -11,12 +11,14 @@ cannot be obtained, #f is returned. If @code{current-directory} cannot be supported by the platform, then #f is returned. @end defun + @defun make-directory name Creates a sub-directory @var{name} of the current-directory. If successful, @code{make-directory} returns #t; otherwise #f. @end defun + @defun directory-for-each proc directory @var{proc} must be a procedure taking one argument. @@ -44,3 +46,4 @@ Applies @var{proc} only to those filenames for which "Template.scm" @end example @end defun + @@ -37,7 +37,7 @@ ;;; implementation reside. (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/local/lib/elk/runtime/scm/") + ((UNIX) "/usr/share/elk/") ((VMS) "scheme$src:") ((MS-DOS) "C:\\scheme\\"))) @@ -70,75 +70,149 @@ home (string-append home "/"))) (else home))))) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) -;;; *features* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") + ;(SLIB:LOAD-SOURCE "filename") compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to -; eval ;R5RS two-argument eval -; values ;R5RS multiple values -; dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; r5rs ;conforms to +;;; eval ;R5RS two-argument eval +;;; values ;R5RS multiple values +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. -; char-ready? -; rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! +;;; char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. +;;; rationalize + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF +;;; with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to ieee-p1178 ;conforms to -; r3rs ;conforms to +;;; r3rs ;conforms to rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. -; with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE - transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; ieee-floating-point ;conforms to IEEE Standard 754-1985 + full-continuation ;can return multiple times +;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. -; defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING sort -; pretty-print -; object->string +;;; pretty-print +;;; object->string format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + )) ;------------ @@ -278,18 +352,7 @@ ;;; If your implementation provides R4RS macros: ;(define macro:eval slib:eval) ;(define macro:load load) - -(define (slib:eval-load <pathname> evl) - (if (not (file-exists? <pathname>)) - (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) - (call-with-input-file <pathname> - (lambda (port) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* <pathname>) - (do ((o (read port) (read port))) - ((eof-object? o)) - (evl o)) - (set! *load-pathname* old-load-pathname))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -325,10 +388,8 @@ ;(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. +;;; return if exiting not supported. (define slib:exit (lambda args (exit (cond ((null? args) 0) @@ -355,7 +416,8 @@ (let ((primitive-load load)) (lambda (<pathname> . rest) (let ((env (if (null? rest) (list (global-environment)) rest))) - (apply primitive-load <pathname> env))))) + (apply primitive-load (string-append <pathname> (scheme-file-suffix)) + env))))) ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced ;;; by compiling "foo.scm" if this implementation can compile files. @@ -1,5 +1,5 @@ ; "eval.scm", Eval proposed by Guillermo (Bill) J. Rozas for R5RS. -; Copyright (c) 1997, 1998 Aubrey Jaffer +; Copyright (C) 1997, 1998 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -22,6 +22,7 @@ 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}. @end defun + @defvar prime:trials @var{prime:trials} the maxinum number of iterations of Solovay-Strassen that will @@ -35,6 +36,7 @@ There is a slight chance @code{(expt 2 (- prime:trials))} that a composite will return @code{#t}. @end defun + @defun primes< start count Returns a list of the first @var{count} prime numbers less than @@ -43,14 +45,17 @@ less than @var{start}, then the returned list will have fewer than @var{start} elements. @end defun + @defun primes> start count Returns a list of the first @var{count} prime numbers greater than @var{start}. @end defun + @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 @var{k}) <)}. @end defun + @@ -39,7 +39,7 @@ (slib:error 'fft "array length not power of 2" n)) (do ((k 0 (+ 1 k))) ((>= k n) new) - (array-set! new (* (array-ref ara k) scale) (bit-reverse lgn k)))) + (array-set! new (* (array-ref ara k) scale) (reverse-bit-field k 0 lgn)))) (define (dft! ara n dir) (define lgn (integer-length (+ -1 n))) @@ -66,7 +66,7 @@ ;;@dfn{Discrete Fourier Transform} of @var{array}. (define (fft ara) (define n (car (array-dimensions ara))) - (define new (apply create-array ara (array-dimensions ara))) + (define new (apply make-array ara (array-dimensions ara))) (dft! (fft:shuffle&scale new ara n 1) n 1)) ;;@args array @@ -74,7 +74,7 @@ ;;inverse Discrete Fourier Transform of @var{array}. (define (fft-1 ara) (define n (car (array-dimensions ara))) - (define new (apply create-array ara (array-dimensions ara))) + (define new (apply make-array ara (array-dimensions ara))) (dft! (fft:shuffle&scale new ara n (/ n)) n -1)) ;;@noindent @@ -10,11 +10,13 @@ returns an array of complex numbers comprising the @cindex Discrete Fourier Transform @end defun + @defun fft-1 array @code{fft-1} returns an array of complex numbers comprising the inverse Discrete Fourier Transform of @var{array}. @end defun + @noindent @code{(fft-1 (fft @var{array}))} will return an array of values close to @var{array}. diff --git a/fluidlet.scm b/fluidlet.scm index 06d4630..3b862c1 100644 --- a/fluidlet.scm +++ b/fluidlet.scm @@ -1,5 +1,5 @@ ; "fluidlet.scm", FLUID-LET for Scheme -; Copyright (c) 1998 Aubrey Jaffer +; Copyright (C) 1998 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is diff --git a/format.scm b/format.scm new file mode 100644 index 0000000..19c0dc5 --- /dev/null +++ b/format.scm @@ -0,0 +1,1634 @@ +;;; "format.scm" Common LISP text output formatter for SLIB +; Written 1992-1994 by Dirk Lutzebaeck (lutzeb@cs.tu-berlin.de) +; 2004 Aubrey Jaffer: made reentrant; call slib:error for errors. +; +; This code is in the public domain. + +; Authors of the original version (< 1.4) were Ken Dickey and Aubrey Jaffer. +; Please send error reports to the email address above. +; For documentation see slib.texi and format.doc. +; For testing load formatst.scm. +; +; Version 3.0 + +(require 'string-case) +(require 'string-port) +(require 'multiarg/and-) +(require 'rev4-optional-procedures) +(require-if 'compiling 'pretty-print) + +;;; Configuration ------------------------------------------------------------ + +(define format:symbol-case-conv #f) +;; Symbols are converted by symbol->string so the case of the printed +;; symbols is implementation dependent. format:symbol-case-conv is a +;; one arg closure which is either #f (no conversion), string-upcase!, +;; string-downcase! or string-capitalize!. + +(define format:iobj-case-conv #f) +;; As format:symbol-case-conv but applies for the representation of +;; implementation internal objects. + +(define format:expch #\E) +;; The character prefixing the exponent value in ~e printing. + +(define format:iteration-bounded #t) +;; If #t, "~{...~}" iterates no more than format:max-iterations times; +;; if #f, there is no bound. + +(define format:max-iterations 100) +;; Compatible with previous versions. + +(define format:floats (provided? 'inexact)) +;; Detects if the scheme system implements flonums (see at eof). + +(define format:complex-numbers (provided? 'complex)) +;; Detects if the scheme system implements complex numbers. + +(define format:radix-pref (char=? #\# (string-ref (number->string 8 8) 0))) +;; Detects if number->string adds a radix prefix. + +(define format:ascii-non-printable-charnames + '#("nul" "soh" "stx" "etx" "eot" "enq" "ack" "bel" + "bs" "ht" "nl" "vt" "np" "cr" "so" "si" + "dle" "dc1" "dc2" "dc3" "dc4" "nak" "syn" "etb" + "can" "em" "sub" "esc" "fs" "gs" "rs" "us" "space")) + +(define format:fn-max 200) ; max. number of number digits +(define format:en-max 10) ; max. number of exponent digits + +;;; End of configuration ---------------------------------------------------- + +(define format:version "3.1") + +(define format:space-ch (char->integer #\space)) +(define format:zero-ch (char->integer #\0)) + +(define format:parameter-characters + '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+ #\v #\# #\')) + +;; cardinals & ordinals (from dorai@cs.rice.edu) + +(define format:cardinal-thousand-block-list + '("" " thousand" " million" " billion" " trillion" " quadrillion" + " quintillion" " sextillion" " septillion" " octillion" " nonillion" + " decillion" " undecillion" " duodecillion" " tredecillion" + " quattuordecillion" " quindecillion" " sexdecillion" " septendecillion" + " octodecillion" " novemdecillion" " vigintillion")) + +(define format:cardinal-ones-list + '(#f "one" "two" "three" "four" "five" + "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" + "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" + "nineteen")) + +(define format:cardinal-tens-list + '(#f #f "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" + "ninety")) + +(define format:ordinal-ones-list + '(#f "first" "second" "third" "fourth" "fifth" + "sixth" "seventh" "eighth" "ninth" "tenth" "eleventh" "twelfth" + "thirteenth" "fourteenth" "fifteenth" "sixteenth" "seventeenth" + "eighteenth" "nineteenth")) + +(define format:ordinal-tens-list + '(#f #f "twentieth" "thirtieth" "fortieth" "fiftieth" "sixtieth" + "seventieth" "eightieth" "ninetieth")) + +;; roman numerals (from dorai@cs.rice.edu). + +(define format:roman-alist + '((1000 #\M) (500 #\D) (100 #\C) (50 #\L) + (10 #\X) (5 #\V) (1 #\I))) + +(define format:roman-boundary-values + '(100 100 10 10 1 1 #f)) + +;@ +(define (format . args) + (define format:port #f) ; curr. format output port + (define format:output-col 0) ; curr. format output tty column + (define format:flush-output #f) ; flush output at end of formatting + (define format:case-conversion #f) + (define format:pos 0) ; curr. format string parsing position + + ;; format string and char output routines on format:port + + (define (format:out-str str) + (if format:case-conversion + (display (format:case-conversion str) format:port) + (display str format:port)) + (set! format:output-col + (+ format:output-col (string-length str)))) + + (define (format:out-char ch) + (if format:case-conversion + (display (format:case-conversion (string ch)) format:port) + (write-char ch format:port)) + (set! format:output-col + (if (char=? ch #\newline) + 0 + (+ format:output-col 1)))) + + ;;(define (format:out-substr str i n) ; this allocates a new string + ;; (display (substring str i n) format:port) + ;; (set! format:output-col (+ format:output-col n))) + + (define (format:out-substr str i n) + (do ((k i (+ k 1))) + ((= k n)) + (write-char (string-ref str k) format:port)) + (set! format:output-col (+ format:output-col n))) + + ;;(define (format:out-fill n ch) ; this allocates a new string + ;; (format:out-str (make-string n ch))) + + (define (format:out-fill n ch) + (do ((i 0 (+ i 1))) + ((= i n)) + (write-char ch format:port)) + (set! format:output-col (+ format:output-col n))) + + (define (format:out-obj-padded pad-left obj slashify pars format:read-proof) + (if (null? pars) + (format:out-str (format:obj->str obj slashify format:read-proof)) + (let ((l (length pars))) + (let ((mincol (format:par pars l 0 0 "mincol")) + (colinc (format:par pars l 1 1 "colinc")) + (minpad (format:par pars l 2 0 "minpad")) + (padchar (integer->char + (format:par pars l 3 format:space-ch #f))) + (objstr (format:obj->str obj slashify format:read-proof))) + (if (not pad-left) + (format:out-str objstr)) + (do ((objstr-len (string-length objstr)) + (i minpad (+ i colinc))) + ((>= (+ objstr-len i) mincol) + (format:out-fill i padchar))) + (if pad-left + (format:out-str objstr)))))) + + (define (format:out-num-padded modifier number pars radix) + (if (not (integer? number)) + (slib:error 'format "argument not an integer" number)) + (let ((numstr (number->string number radix))) + (if (and format:radix-pref (not (= radix 10))) + (set! numstr (substring numstr 2 (string-length numstr)))) + (if (and (null? pars) (not modifier)) + (format:out-str numstr) + (let ((l (length pars)) + (numstr-len (string-length numstr))) + (let ((mincol (format:par pars l 0 #f "mincol")) + (padchar (integer->char + (format:par pars l 1 format:space-ch #f))) + (commachar (integer->char + (format:par pars l 2 (char->integer #\,) #f))) + (commawidth (format:par pars l 3 3 "commawidth"))) + (if mincol + (let ((numlen numstr-len)) ; calc. the output len of number + (if (and (memq modifier '(at colon-at)) (> number 0)) + (set! numlen (+ numlen 1))) + (if (memq modifier '(colon colon-at)) + (set! numlen (+ (quotient (- numstr-len + (if (< number 0) 2 1)) + commawidth) + numlen))) + (if (> mincol numlen) + (format:out-fill (- mincol numlen) padchar)))) + (if (and (memq modifier '(at colon-at)) + (> number 0)) + (format:out-char #\+)) + (if (memq modifier '(colon colon-at)) ; insert comma character + (let ((start (remainder numstr-len commawidth)) + (ns (if (< number 0) 1 0))) + (format:out-substr numstr 0 start) + (do ((i start (+ i commawidth))) + ((>= i numstr-len)) + (if (> i ns) + (format:out-char commachar)) + (format:out-substr numstr i (+ i commawidth)))) + (format:out-str numstr))))))) + + (define (format:tabulate modifier pars) + (let ((l (length pars))) + (let ((colnum (format:par pars l 0 1 "colnum")) + (colinc (format:par pars l 1 1 "colinc")) + (padch (integer->char (format:par pars l 2 format:space-ch #f)))) + (case modifier + ((colon colon-at) + (slib:error 'format "unsupported modifier for ~~t" modifier)) + ((at) ; relative tabulation + (format:out-fill + (if (= colinc 0) + colnum ; colnum = colrel + (do ((c 0 (+ c colinc)) + (col (+ format:output-col colnum))) + ((>= c col) + (- c format:output-col)))) + padch)) + (else ; absolute tabulation + (format:out-fill + (cond + ((< format:output-col colnum) + (- colnum format:output-col)) + ((= colinc 0) + 0) + (else + (do ((c colnum (+ c colinc))) + ((>= c format:output-col) + (- c format:output-col))))) + padch)))))) + + + (define format:num->old-roman + (lambda (n) + (if (and (integer? n) (>= n 1)) + (let loop ((n n) + (romans format:roman-alist) + (s '())) + (if (null? romans) (list->string (reverse s)) + (let ((roman-val (caar romans)) + (roman-dgt (cadar romans))) + (do ((q (quotient n roman-val) (- q 1)) + (s s (cons roman-dgt s))) + ((= q 0) + (loop (remainder n roman-val) + (cdr romans) s)))))) + (slib:error 'format "only positive integers can be romanized")))) + + (define format:num->roman + (lambda (n) + (if (and (integer? n) (> n 0)) + (let loop ((n n) + (romans format:roman-alist) + (boundaries format:roman-boundary-values) + (s '())) + (if (null? romans) + (list->string (reverse s)) + (let ((roman-val (caar romans)) + (roman-dgt (cadar romans)) + (bdry (car boundaries))) + (let loop2 ((q (quotient n roman-val)) + (r (remainder n roman-val)) + (s s)) + (if (= q 0) + (if (and bdry (>= r (- roman-val bdry))) + (loop (remainder r bdry) (cdr romans) + (cdr boundaries) + (cons roman-dgt + (append + (cdr (assv bdry romans)) + s))) + (loop r (cdr romans) (cdr boundaries) s)) + (loop2 (- q 1) r (cons roman-dgt s))))))) + (slib:error 'format "only positive integers can be romanized")))) + + (define format:num->cardinal999 + (lambda (n) + ;;this procedure is inspired by the Bruno Haible's CLisp + ;;function format-small-cardinal, which converts numbers + ;;in the range 1 to 999, and is used for converting each + ;;thousand-block in a larger number + (let* ((hundreds (quotient n 100)) + (tens+ones (remainder n 100)) + (tens (quotient tens+ones 10)) + (ones (remainder tens+ones 10))) + (append + (if (> hundreds 0) + (append + (string->list + (list-ref format:cardinal-ones-list hundreds)) + (string->list" hundred") + (if (> tens+ones 0) '(#\space) '())) + '()) + (if (< tens+ones 20) + (if (> tens+ones 0) + (string->list + (list-ref format:cardinal-ones-list tens+ones)) + '()) + (append + (string->list + (list-ref format:cardinal-tens-list tens)) + (if (> ones 0) + (cons #\- + (string->list + (list-ref format:cardinal-ones-list ones))) + '()))))))) + + (define format:num->cardinal + (lambda (n) + (cond ((not (integer? n)) + (slib:error 'format + "only integers can be converted to English cardinals")) + ((= n 0) "zero") + ((< n 0) (string-append "minus " (format:num->cardinal (- n)))) + (else + (let ((power3-word-limit + (length format:cardinal-thousand-block-list))) + (let loop ((n n) + (power3 0) + (s '())) + (if (= n 0) + (list->string s) + (let ((n-before-block (quotient n 1000)) + (n-after-block (remainder n 1000))) + (loop n-before-block + (+ power3 1) + (if (> n-after-block 0) + (append + (if (> n-before-block 0) + (string->list ", ") '()) + (format:num->cardinal999 n-after-block) + (if (< power3 power3-word-limit) + (string->list + (list-ref + format:cardinal-thousand-block-list + power3)) + (append + (string->list " times ten to the ") + (string->list + (format:num->ordinal + (* power3 3))) + (string->list " power"))) + s) + s)))))))))) + + (define format:num->ordinal + (lambda (n) + (cond ((not (integer? n)) + (slib:error 'format + "only integers can be converted to English ordinals")) + ((= n 0) "zeroth") + ((< n 0) (string-append "minus " (format:num->ordinal (- n)))) + (else + (let ((hundreds (quotient n 100)) + (tens+ones (remainder n 100))) + (string-append + (if (> hundreds 0) + (string-append + (format:num->cardinal (* hundreds 100)) + (if (= tens+ones 0) "th" " ")) + "") + (if (= tens+ones 0) "" + (if (< tens+ones 20) + (list-ref format:ordinal-ones-list tens+ones) + (let ((tens (quotient tens+ones 10)) + (ones (remainder tens+ones 10))) + (if (= ones 0) + (list-ref format:ordinal-tens-list tens) + (string-append + (list-ref format:cardinal-tens-list tens) + "-" + (list-ref format:ordinal-ones-list ones)))) + )))))))) + + ;; format fixed flonums (~F) + + (define (format:out-fixed modifier number pars) + (if (not (or (number? number) (string? number))) + (slib:error 'format "argument is not a number or a number string" + number)) + + (let ((l (length pars))) + (let ((width (format:par pars l 0 #f "width")) + (digits (format:par pars l 1 #f "digits")) + (scale (format:par pars l 2 0 #f)) + (overch (format:par pars l 3 #f #f)) + (padch (format:par pars l 4 format:space-ch #f))) + + (if digits + + (begin ; fixed precision + (format:parse-float + (if (string? number) number (number->string number)) #t scale) + (if (<= (- format:fn-len format:fn-dot) digits) + (format:fn-zfill #f (- digits (- format:fn-len format:fn-dot))) + (format:fn-round digits)) + (if width + (let ((numlen (+ format:fn-len 1))) + (if (or (not format:fn-pos?) (eq? modifier 'at)) + (set! numlen (+ numlen 1))) + (if (and (= format:fn-dot 0) (> width (+ digits 1))) + (set! numlen (+ numlen 1))) + (if (< numlen width) + (format:out-fill (- width numlen) (integer->char padch))) + (if (and overch (> numlen width)) + (format:out-fill width (integer->char overch)) + (format:fn-out modifier (> width (+ digits 1))))) + (format:fn-out modifier #t))) + + (begin ; free precision + (format:parse-float + (if (string? number) number (number->string number)) #t scale) + (format:fn-strip) + (if width + (let ((numlen (+ format:fn-len 1))) + (if (or (not format:fn-pos?) (eq? modifier 'at)) + (set! numlen (+ numlen 1))) + (if (= format:fn-dot 0) + (set! numlen (+ numlen 1))) + (if (< numlen width) + (format:out-fill (- width numlen) (integer->char padch))) + (if (> numlen width) ; adjust precision if possible + (let ((dot-index (- numlen + (- format:fn-len format:fn-dot)))) + (if (> dot-index width) + (if overch ; numstr too big for required width + (format:out-fill width (integer->char overch)) + (format:fn-out modifier #t)) + (begin + (format:fn-round (- width dot-index)) + (format:fn-out modifier #t)))) + (format:fn-out modifier #t))) + (format:fn-out modifier #t))))))) + + ;; format exponential flonums (~E) + + (define (format:out-expon modifier number pars) + (if (not (or (number? number) (string? number))) + (slib:error 'format "argument is not a number" number)) + + (let ((l (length pars))) + (let ((width (format:par pars l 0 #f "width")) + (digits (format:par pars l 1 #f "digits")) + (edigits (format:par pars l 2 #f "exponent digits")) + (scale (format:par pars l 3 1 #f)) + (overch (format:par pars l 4 #f #f)) + (padch (format:par pars l 5 format:space-ch #f)) + (expch (format:par pars l 6 #f #f))) + + (if digits ; fixed precision + + (let ((digits (if (> scale 0) + (if (< scale (+ digits 2)) + (+ (- digits scale) 1) + 0) + digits))) + (format:parse-float + (if (string? number) number (number->string number)) #f scale) + (if (<= (- format:fn-len format:fn-dot) digits) + (format:fn-zfill #f (- digits (- format:fn-len format:fn-dot))) + (format:fn-round digits)) + (if width + (if (and edigits overch (> format:en-len edigits)) + (format:out-fill width (integer->char overch)) + (let ((numlen (+ format:fn-len 3))) ; .E+ + (if (or (not format:fn-pos?) (eq? modifier 'at)) + (set! numlen (+ numlen 1))) + (if (and (= format:fn-dot 0) (> width (+ digits 1))) + (set! numlen (+ numlen 1))) + (set! numlen + (+ numlen + (if (and edigits (>= edigits format:en-len)) + edigits + format:en-len))) + (if (< numlen width) + (format:out-fill (- width numlen) + (integer->char padch))) + (if (and overch (> numlen width)) + (format:out-fill width (integer->char overch)) + (begin + (format:fn-out modifier (> width (- numlen 1))) + (format:en-out edigits expch))))) + (begin + (format:fn-out modifier #t) + (format:en-out edigits expch)))) + + (begin ; free precision + (format:parse-float + (if (string? number) number (number->string number)) #f scale) + (format:fn-strip) + (if width + (if (and edigits overch (> format:en-len edigits)) + (format:out-fill width (integer->char overch)) + (let ((numlen (+ format:fn-len 3))) ; .E+ + (if (or (not format:fn-pos?) (eq? modifier 'at)) + (set! numlen (+ numlen 1))) + (if (= format:fn-dot 0) + (set! numlen (+ numlen 1))) + (set! numlen + (+ numlen + (if (and edigits (>= edigits format:en-len)) + edigits + format:en-len))) + (if (< numlen width) + (format:out-fill (- width numlen) + (integer->char padch))) + (if (> numlen width) ; adjust precision if possible + (let ((f (- format:fn-len format:fn-dot))) ; fract len + (if (> (- numlen f) width) + (if overch ; numstr too big for required width + (format:out-fill width + (integer->char overch)) + (begin + (format:fn-out modifier #t) + (format:en-out edigits expch))) + (begin + (format:fn-round (+ (- f numlen) width)) + (format:fn-out modifier #t) + (format:en-out edigits expch)))) + (begin + (format:fn-out modifier #t) + (format:en-out edigits expch))))) + (begin + (format:fn-out modifier #t) + (format:en-out edigits expch)))))))) + + ;; format general flonums (~G) + + (define (format:out-general modifier number pars) + (if (not (or (number? number) (string? number))) + (slib:error 'format "argument is not a number or a number string" + number)) + + (let ((l (length pars))) + (let ((width (if (> l 0) (list-ref pars 0) #f)) + (digits (if (> l 1) (list-ref pars 1) #f)) + (edigits (if (> l 2) (list-ref pars 2) #f)) + (overch (if (> l 4) (list-ref pars 4) #f)) + (padch (if (> l 5) (list-ref pars 5) #f))) + (format:parse-float + (if (string? number) number (number->string number)) #t 0) + (format:fn-strip) + (let* ((ee (if edigits (+ edigits 2) 4)) ; for the following algorithm + (ww (if width (- width ee) #f)) ; see Steele's CL book p.395 + (n (if (= format:fn-dot 0) ; number less than (abs 1.0) ? + (- (format:fn-zlead)) + format:fn-dot)) + (d (if digits + digits + (max format:fn-len (min n 7)))) ; q = format:fn-len + (dd (- d n))) + (if (<= 0 dd d) + (begin + (format:out-fixed modifier number (list ww dd #f overch padch)) + (format:out-fill ee #\space)) ;~@T not implemented yet + (format:out-expon modifier number pars)))))) + + ;; format dollar flonums (~$) + + (define (format:out-dollar modifier number pars) + (if (not (or (number? number) (string? number))) + (slib:error 'format "argument is not a number or a number string" + number)) + + (let ((l (length pars))) + (let ((digits (format:par pars l 0 2 "digits")) + (mindig (format:par pars l 1 1 "mindig")) + (width (format:par pars l 2 0 "width")) + (padch (format:par pars l 3 format:space-ch #f))) + + (format:parse-float + (if (string? number) number (number->string number)) #t 0) + (if (<= (- format:fn-len format:fn-dot) digits) + (format:fn-zfill #f (- digits (- format:fn-len format:fn-dot))) + (format:fn-round digits)) + (let ((numlen (+ format:fn-len 1))) + (if (or (not format:fn-pos?) (memq modifier '(at colon-at))) + (set! numlen (+ numlen 1))) + (if (and mindig (> mindig format:fn-dot)) + (set! numlen (+ numlen (- mindig format:fn-dot)))) + (if (and (= format:fn-dot 0) (not mindig)) + (set! numlen (+ numlen 1))) + (if (< numlen width) + (case modifier + ((colon) + (if (not format:fn-pos?) + (format:out-char #\-)) + (format:out-fill (- width numlen) (integer->char padch))) + ((at) + (format:out-fill (- width numlen) (integer->char padch)) + (format:out-char (if format:fn-pos? #\+ #\-))) + ((colon-at) + (format:out-char (if format:fn-pos? #\+ #\-)) + (format:out-fill (- width numlen) (integer->char padch))) + (else + (format:out-fill (- width numlen) (integer->char padch)) + (if (not format:fn-pos?) + (format:out-char #\-)))) + (if format:fn-pos? + (if (memq modifier '(at colon-at)) (format:out-char #\+)) + (format:out-char #\-)))) + (if (and mindig (> mindig format:fn-dot)) + (format:out-fill (- mindig format:fn-dot) #\0)) + (if (and (= format:fn-dot 0) (not mindig)) + (format:out-char #\0)) + (format:out-substr format:fn-str 0 format:fn-dot) + (format:out-char #\.) + (format:out-substr format:fn-str format:fn-dot format:fn-len)))) + + ; the flonum buffers + + (define format:fn-str (make-string format:fn-max)) ; number buffer + (define format:fn-len 0) ; digit length of number + (define format:fn-dot #f) ; dot position of number + (define format:fn-pos? #t) ; number positive? + (define format:en-str (make-string format:en-max)) ; exponent buffer + (define format:en-len 0) ; digit length of exponent + (define format:en-pos? #t) ; exponent positive? + + (define (format:parse-float num-str fixed? scale) + (set! format:fn-pos? #t) + (set! format:fn-len 0) + (set! format:fn-dot #f) + (set! format:en-pos? #t) + (set! format:en-len 0) + (do ((i 0 (+ i 1)) + (left-zeros 0) + (mantissa? #t) + (all-zeros? #t) + (num-len (string-length num-str)) + (c #f)) ; current exam. character in num-str + ((= i num-len) + (if (not format:fn-dot) + (set! format:fn-dot format:fn-len)) + + (if all-zeros? + (begin + (set! left-zeros 0) + (set! format:fn-dot 0) + (set! format:fn-len 1))) + + ;; now format the parsed values according to format's need + + (if fixed? + + (begin ; fixed format m.nnn or .nnn + (if (and (> left-zeros 0) (> format:fn-dot 0)) + (if (> format:fn-dot left-zeros) + (begin ; norm 0{0}nn.mm to nn.mm + (format:fn-shiftleft left-zeros) + (set! left-zeros 0) + (set! format:fn-dot (- format:fn-dot left-zeros))) + (begin ; normalize 0{0}.nnn to .nnn + (format:fn-shiftleft format:fn-dot) + (set! left-zeros (- left-zeros format:fn-dot)) + (set! format:fn-dot 0)))) + (if (or (not (= scale 0)) (> format:en-len 0)) + (let ((shift (+ scale (format:en-int)))) + (cond + (all-zeros? #t) + ((> (+ format:fn-dot shift) format:fn-len) + (format:fn-zfill + #f (- shift (- format:fn-len format:fn-dot))) + (set! format:fn-dot format:fn-len)) + ((< (+ format:fn-dot shift) 0) + (format:fn-zfill #t (- (- shift) format:fn-dot)) + (set! format:fn-dot 0)) + (else + (if (> left-zeros 0) + (if (<= left-zeros shift) ; shift always > 0 here + (format:fn-shiftleft shift) ; shift out 0s + (begin + (format:fn-shiftleft left-zeros) + (set! format:fn-dot (- shift left-zeros)))) + (set! format:fn-dot (+ format:fn-dot shift)))))))) + + (let ((negexp ; expon format m.nnnEee + (if (> left-zeros 0) + (- left-zeros format:fn-dot -1) + (if (= format:fn-dot 0) 1 0)))) + (if (> left-zeros 0) + (begin ; normalize 0{0}.nnn to n.nn + (format:fn-shiftleft left-zeros) + (set! format:fn-dot 1)) + (if (= format:fn-dot 0) + (set! format:fn-dot 1))) + (format:en-set (- (+ (- format:fn-dot scale) (format:en-int)) + negexp)) + (cond + (all-zeros? + (format:en-set 0) + (set! format:fn-dot 1)) + ((< scale 0) ; leading zero + (format:fn-zfill #t (- scale)) + (set! format:fn-dot 0)) + ((> scale format:fn-dot) + (format:fn-zfill #f (- scale format:fn-dot)) + (set! format:fn-dot scale)) + (else + (set! format:fn-dot scale))))) + #t) + + ;; do body + (set! c (string-ref num-str i)) ; parse the output of number->string + (cond ; which can be any valid number + ((char-numeric? c) ; representation of R4RS except + (if mantissa? ; complex numbers + (begin + (if (char=? c #\0) + (if all-zeros? + (set! left-zeros (+ left-zeros 1))) + (begin + (set! all-zeros? #f))) + (string-set! format:fn-str format:fn-len c) + (set! format:fn-len (+ format:fn-len 1))) + (begin + (string-set! format:en-str format:en-len c) + (set! format:en-len (+ format:en-len 1))))) + ((or (char=? c #\-) (char=? c #\+)) + (if mantissa? + (set! format:fn-pos? (char=? c #\+)) + (set! format:en-pos? (char=? c #\+)))) + ((char=? c #\.) + (set! format:fn-dot format:fn-len)) + ((char=? c #\e) + (set! mantissa? #f)) + ((char=? c #\E) + (set! mantissa? #f)) + ((char-whitespace? c) #t) + ((char=? c #\d) #t) ; decimal radix prefix + ((char=? c #\#) #t) + (else + (slib:error 'format "illegal character in number->string" c))))) + + (define (format:en-int) ; convert exponent string to integer + (if (= format:en-len 0) + 0 + (do ((i 0 (+ i 1)) + (n 0)) + ((= i format:en-len) + (if format:en-pos? + n + (- n))) + (set! n (+ (* n 10) (- (char->integer (string-ref format:en-str i)) + format:zero-ch)))))) + + (define (format:en-set en) ; set exponent string number + (set! format:en-len 0) + (set! format:en-pos? (>= en 0)) + (let ((en-str (number->string en))) + (do ((i 0 (+ i 1)) + (en-len (string-length en-str)) + (c #f)) + ((= i en-len)) + (set! c (string-ref en-str i)) + (if (char-numeric? c) + (begin + (string-set! format:en-str format:en-len c) + (set! format:en-len (+ format:en-len 1))))))) + + (define (format:fn-zfill left? n) ; fill current number string with 0s + (if (> (+ n format:fn-len) format:fn-max) ; from the left or right + (slib:error 'format "number is too long to format (enlarge format:fn-max)")) + (set! format:fn-len (+ format:fn-len n)) + (if left? + (do ((i format:fn-len (- i 1))) ; fill n 0s to left + ((< i 0)) + (string-set! format:fn-str i + (if (< i n) + #\0 + (string-ref format:fn-str (- i n))))) + (do ((i (- format:fn-len n) (+ i 1))) ; fill n 0s to the right + ((= i format:fn-len)) + (string-set! format:fn-str i #\0)))) + + (define (format:fn-shiftleft n) ; shift left current number n positions + (if (> n format:fn-len) + (slib:error 'format "internal error in format:fn-shiftleft" + (list n format:fn-len))) + (do ((i n (+ i 1))) + ((= i format:fn-len) + (set! format:fn-len (- format:fn-len n))) + (string-set! format:fn-str (- i n) (string-ref format:fn-str i)))) + + (define (format:fn-round digits) ; round format:fn-str + (set! digits (+ digits format:fn-dot)) + (do ((i digits (- i 1)) ; "099",2 -> "10" + (c 5)) ; "023",2 -> "02" + ((or (= c 0) (< i 0)) ; "999",2 -> "100" + (if (= c 1) ; "005",2 -> "01" + (begin ; carry overflow + (set! format:fn-len digits) + (format:fn-zfill #t 1) ; add a 1 before fn-str + (string-set! format:fn-str 0 #\1) + (set! format:fn-dot (+ format:fn-dot 1))) + (set! format:fn-len digits))) + (set! c (+ (- (char->integer (string-ref format:fn-str i)) + format:zero-ch) c)) + (string-set! format:fn-str i (integer->char + (if (< c 10) + (+ c format:zero-ch) + (+ (- c 10) format:zero-ch)))) + (set! c (if (< c 10) 0 1)))) + + (define (format:fn-out modifier add-leading-zero?) + (if format:fn-pos? + (if (eq? modifier 'at) + (format:out-char #\+)) + (format:out-char #\-)) + (if (= format:fn-dot 0) + (if add-leading-zero? + (format:out-char #\0)) + (format:out-substr format:fn-str 0 format:fn-dot)) + (format:out-char #\.) + (format:out-substr format:fn-str format:fn-dot format:fn-len)) + + (define (format:en-out edigits expch) + (format:out-char (if expch (integer->char expch) format:expch)) + (format:out-char (if format:en-pos? #\+ #\-)) + (if edigits + (if (< format:en-len edigits) + (format:out-fill (- edigits format:en-len) #\0))) + (format:out-substr format:en-str 0 format:en-len)) + + (define (format:fn-strip) ; strip trailing zeros but one + (string-set! format:fn-str format:fn-len #\0) + (do ((i format:fn-len (- i 1))) + ((or (not (char=? (string-ref format:fn-str i) #\0)) + (<= i format:fn-dot)) + (set! format:fn-len (+ i 1))))) + + (define (format:fn-zlead) ; count leading zeros + (do ((i 0 (+ i 1))) + ((or (= i format:fn-len) + (not (char=? (string-ref format:fn-str i) #\0))) + (if (= i format:fn-len) ; found a real zero + 0 + i)))) + + (define (format:format-work format-string arglist) ; does the formatting work + (letrec + ((format-string-len (string-length format-string)) + (arg-pos 0) ; argument position in arglist + (arg-len (length arglist)) ; number of arguments + (modifier #f) ; 'colon | 'at | 'colon-at | #f + (params '()) ; directive parameter list + (param-value-found #f) ; a directive parameter value found + (conditional-nest 0) ; conditional nesting level + (clause-pos 0) ; last cond. clause beginning char pos + (clause-default #f) ; conditional default clause string + (clauses '()) ; conditional clause string list + (conditional-type #f) ; reflects the contional modifiers + (conditional-arg #f) ; argument to apply the conditional + (iteration-nest 0) ; iteration nesting level + (iteration-pos 0) ; iteration string beginning char pos + (iteration-type #f) ; reflects the iteration modifiers + (max-iterations #f) ; maximum number of iterations + (recursive-pos-save format:pos) + + (next-char ; gets the next char from format-string + (lambda () + (let ((ch (peek-next-char))) + (set! format:pos (+ 1 format:pos)) + ch))) + + (peek-next-char + (lambda () + (if (>= format:pos format-string-len) + (slib:error 'format "illegal format string") + (string-ref format-string format:pos)))) + + (one-positive-integer? + (lambda (params) + (cond + ((null? params) #f) + ((and (integer? (car params)) + (>= (car params) 0) + (= (length params) 1)) #t) + (else (slib:error 'format "one positive integer parameter expected"))))) + + (next-arg + (lambda () + (if (>= arg-pos arg-len) + (begin + (slib:error 'format "missing argument(s)"))) + (add-arg-pos 1) + (list-ref arglist (- arg-pos 1)))) + + (prev-arg + (lambda () + (add-arg-pos -1) + (if (negative? arg-pos) + (slib:error 'format "missing backward argument(s)")) + (list-ref arglist arg-pos))) + + (rest-args + (lambda () + (let loop ((l arglist) (k arg-pos)) ; list-tail definition + (if (= k 0) l (loop (cdr l) (- k 1)))))) + + (add-arg-pos + (lambda (n) + (set! arg-pos (+ n arg-pos)))) + + (anychar-dispatch ; dispatches the format-string + (lambda () + (if (>= format:pos format-string-len) + arg-pos ; used for ~? continuance + (let ((char (next-char))) + (cond + ((char=? char #\~) + (set! modifier #f) + (set! params '()) + (set! param-value-found #f) + (tilde-dispatch)) + (else + (if (and (zero? conditional-nest) + (zero? iteration-nest)) + (format:out-char char)) + (anychar-dispatch))))))) + + (tilde-dispatch + (lambda () + (cond + ((>= format:pos format-string-len) + (format:out-str "~") ; tilde at end of string is just output + arg-pos) ; used for ~? continuance + ((and (or (zero? conditional-nest) + (memv (peek-next-char) ; find conditional directives + (append '(#\[ #\] #\; #\: #\@ #\^) + format:parameter-characters))) + (or (zero? iteration-nest) + (memv (peek-next-char) ; find iteration directives + (append '(#\{ #\} #\: #\@ #\^) + format:parameter-characters)))) + (case (char-upcase (next-char)) + + ;; format directives + + ((#\A) ; Any -- for humans + (format:out-obj-padded (memq modifier '(at colon-at)) + (next-arg) #f params + (memq modifier '(colon colon-at))) + (anychar-dispatch)) + ((#\S) ; Slashified -- for parsers + (format:out-obj-padded (memq modifier '(at colon-at)) + (next-arg) #t params + (memq modifier '(colon colon-at))) + (anychar-dispatch)) + ((#\D) ; Decimal + (format:out-num-padded modifier (next-arg) params 10) + (anychar-dispatch)) + ((#\X) ; Hexadecimal + (format:out-num-padded modifier (next-arg) params 16) + (anychar-dispatch)) + ((#\O) ; Octal + (format:out-num-padded modifier (next-arg) params 8) + (anychar-dispatch)) + ((#\B) ; Binary + (format:out-num-padded modifier (next-arg) params 2) + (anychar-dispatch)) + ((#\R) + (if (null? params) + (format:out-obj-padded ; Roman, cardinal, ordinal numerals + #f + ((case modifier + ((at) format:num->roman) + ((colon-at) format:num->old-roman) + ((colon) format:num->ordinal) + (else format:num->cardinal)) + (next-arg)) + #f params #f) ;was format:read-proof + (format:out-num-padded ; any Radix + modifier (next-arg) (cdr params) (car params))) + (anychar-dispatch)) + ((#\F) ; Fixed-format floating-point + (if format:floats + (format:out-fixed modifier (next-arg) params) + (format:out-str (number->string (next-arg)))) + (anychar-dispatch)) + ((#\E) ; Exponential floating-point + (if format:floats + (format:out-expon modifier (next-arg) params) + (format:out-str (number->string (next-arg)))) + (anychar-dispatch)) + ((#\G) ; General floating-point + (if format:floats + (format:out-general modifier (next-arg) params) + (format:out-str (number->string (next-arg)))) + (anychar-dispatch)) + ((#\$) ; Dollars floating-point + (if format:floats + (format:out-dollar modifier (next-arg) params) + (format:out-str (number->string (next-arg)))) + (anychar-dispatch)) + ((#\I) ; Complex numbers + (if (not format:complex-numbers) + (slib:error 'format + "complex numbers not supported by this scheme system")) + (let ((z (next-arg))) + (if (not (complex? z)) + (slib:error 'format "argument not a complex number")) + (format:out-fixed modifier (real-part z) params) + (format:out-fixed 'at (imag-part z) params) + (format:out-char #\i)) + (anychar-dispatch)) + ((#\C) ; Character + (let ((ch (if (one-positive-integer? params) + (integer->char (car params)) + (next-arg)))) + (if (not (char? ch)) (slib:error 'format "~~c expects a character" ch)) + (case modifier + ((at) + (format:out-str (format:char->str ch))) + ((colon) + (let ((c (char->integer ch))) + (if (< c 0) + (set! c (+ c 256))) ; compensate complement impl. + (cond + ((< c #x20) ; assumes that control chars are < #x20 + (format:out-char #\^) + (format:out-char + (integer->char (+ c #x40)))) + ((>= c #x7f) + (format:out-str "#\\") + (format:out-str + (if format:radix-pref + (let ((s (number->string c 8))) + (substring s 2 (string-length s))) + (number->string c 8)))) + (else + (format:out-char ch))))) + (else (format:out-char ch)))) + (anychar-dispatch)) + ((#\P) ; Plural + (if (memq modifier '(colon colon-at)) + (prev-arg)) + (let ((arg (next-arg))) + (if (not (number? arg)) + (slib:error 'format "~~p expects a number argument" arg)) + (if (= arg 1) + (if (memq modifier '(at colon-at)) + (format:out-char #\y)) + (if (memq modifier '(at colon-at)) + (format:out-str "ies") + (format:out-char #\s)))) + (anychar-dispatch)) + ((#\~) ; Tilde + (if (one-positive-integer? params) + (format:out-fill (car params) #\~) + (format:out-char #\~)) + (anychar-dispatch)) + ((#\%) ; Newline + (if (one-positive-integer? params) + (format:out-fill (car params) #\newline) + (format:out-char #\newline)) + (set! format:output-col 0) + (anychar-dispatch)) + ((#\&) ; Fresh line + (if (one-positive-integer? params) + (begin + (if (> (car params) 0) + (format:out-fill (- (car params) + (if (> format:output-col 0) 0 1)) + #\newline)) + (set! format:output-col 0)) + (if (> format:output-col 0) + (format:out-char #\newline))) + (anychar-dispatch)) + ((#\_) ; Space character + (if (one-positive-integer? params) + (format:out-fill (car params) #\space) + (format:out-char #\space)) + (anychar-dispatch)) + ((#\/) ; Tabulator character + (if (one-positive-integer? params) + (format:out-fill (car params) slib:tab) + (format:out-char slib:tab)) + (anychar-dispatch)) + ((#\|) ; Page seperator + (if (one-positive-integer? params) + (format:out-fill (car params) slib:form-feed) + (format:out-char slib:form-feed)) + (set! format:output-col 0) + (anychar-dispatch)) + ((#\T) ; Tabulate + (format:tabulate modifier params) + (anychar-dispatch)) + ((#\Y) ; Pretty-print + (require 'pretty-print) + (pretty-print (next-arg) format:port) + (set! format:output-col 0) + (anychar-dispatch)) + ((#\? #\K) ; Indirection (is "~K" in T-Scheme) + (cond + ((memq modifier '(colon colon-at)) + (slib:error 'format "illegal modifier in ~~?" modifier)) + ((eq? modifier 'at) + (let* ((frmt (next-arg)) + (args (rest-args))) + (add-arg-pos (format:format-work frmt args)))) + (else + (let* ((frmt (next-arg)) + (args (next-arg))) + (format:format-work frmt args)))) + (anychar-dispatch)) + ((#\!) ; Flush output + (set! format:flush-output #t) + (anychar-dispatch)) + ((#\newline) ; Continuation lines + (if (eq? modifier 'at) + (format:out-char #\newline)) + (if (< format:pos format-string-len) + (do ((ch (peek-next-char) (peek-next-char))) + ((or (not (char-whitespace? ch)) + (= format:pos (- format-string-len 1)))) + (if (eq? modifier 'colon) + (format:out-char (next-char)) + (next-char)))) + (anychar-dispatch)) + ((#\*) ; Argument jumping + (case modifier + ((colon) ; jump backwards + (if (one-positive-integer? params) + (do ((i 0 (+ i 1))) + ((= i (car params))) + (prev-arg)) + (prev-arg))) + ((at) ; jump absolute + (set! arg-pos (if (one-positive-integer? params) + (car params) 0))) + ((colon-at) + (slib:error 'format "illegal modifier `:@' in ~~* directive")) + (else ; jump forward + (if (one-positive-integer? params) + (do ((i 0 (+ i 1))) + ((= i (car params))) + (next-arg)) + (next-arg)))) + (anychar-dispatch)) + ((#\() ; Case conversion begin + (set! format:case-conversion + (case modifier + ((at) format:string-capitalize-first) + ((colon) string-capitalize) + ((colon-at) string-upcase) + (else string-downcase))) + (anychar-dispatch)) + ((#\)) ; Case conversion end + (if (not format:case-conversion) + (slib:error 'format "missing ~~(")) + (set! format:case-conversion #f) + (anychar-dispatch)) + ((#\[) ; Conditional begin + (set! conditional-nest (+ conditional-nest 1)) + (cond + ((= conditional-nest 1) + (set! clause-pos format:pos) + (set! clause-default #f) + (set! clauses '()) + (set! conditional-type + (case modifier + ((at) 'if-then) + ((colon) 'if-else-then) + ((colon-at) (slib:error 'format "illegal modifier in ~~[")) + (else 'num-case))) + (set! conditional-arg + (if (one-positive-integer? params) + (car params) + (next-arg))))) + (anychar-dispatch)) + ((#\;) ; Conditional separator + (if (zero? conditional-nest) + (slib:error 'format "~~; not in ~~[~~] conditional")) + (if (not (null? params)) + (slib:error 'format "no parameter allowed in ~~;")) + (if (= conditional-nest 1) + (let ((clause-str + (cond + ((eq? modifier 'colon) + (set! clause-default #t) + (substring format-string clause-pos + (- format:pos 3))) + ((memq modifier '(at colon-at)) + (slib:error 'format "illegal modifier in ~~;")) + (else + (substring format-string clause-pos + (- format:pos 2)))))) + (set! clauses (append clauses (list clause-str))) + (set! clause-pos format:pos))) + (anychar-dispatch)) + ((#\]) ; Conditional end + (if (zero? conditional-nest) (slib:error 'format "missing ~~[")) + (set! conditional-nest (- conditional-nest 1)) + (if modifier + (slib:error 'format "no modifier allowed in ~~]")) + (if (not (null? params)) + (slib:error 'format "no parameter allowed in ~~]")) + (cond + ((zero? conditional-nest) + (let ((clause-str (substring format-string clause-pos + (- format:pos 2)))) + (if clause-default + (set! clause-default clause-str) + (set! clauses (append clauses (list clause-str))))) + (case conditional-type + ((if-then) + (if conditional-arg + (format:format-work (car clauses) + (list conditional-arg)))) + ((if-else-then) + (add-arg-pos + (format:format-work (if conditional-arg + (cadr clauses) + (car clauses)) + (rest-args)))) + ((num-case) + (if (or (not (integer? conditional-arg)) + (< conditional-arg 0)) + (slib:error 'format "argument not a positive integer")) + (if (not (and (>= conditional-arg (length clauses)) + (not clause-default))) + (add-arg-pos + (format:format-work + (if (>= conditional-arg (length clauses)) + clause-default + (list-ref clauses conditional-arg)) + (rest-args)))))))) + (anychar-dispatch)) + ((#\{) ; Iteration begin + (set! iteration-nest (+ iteration-nest 1)) + (cond + ((= iteration-nest 1) + (set! iteration-pos format:pos) + (set! iteration-type + (case modifier + ((at) 'rest-args) + ((colon) 'sublists) + ((colon-at) 'rest-sublists) + (else 'list))) + (set! max-iterations (if (one-positive-integer? params) + (car params) #f)))) + (anychar-dispatch)) + ((#\}) ; Iteration end + (if (zero? iteration-nest) (slib:error 'format "missing ~~{")) + (set! iteration-nest (- iteration-nest 1)) + (case modifier + ((colon) + (if (not max-iterations) (set! max-iterations 1))) + ((colon-at at) (slib:error 'format "illegal modifier" modifier)) + (else (if (not max-iterations) + (set! max-iterations format:max-iterations)))) + (if (not (null? params)) + (slib:error 'format "no parameters allowed in ~~}" params)) + (if (zero? iteration-nest) + (let ((iteration-str + (substring format-string iteration-pos + (- format:pos (if modifier 3 2))))) + (if (string=? iteration-str "") + (set! iteration-str (next-arg))) + (case iteration-type + ((list) + (let ((args (next-arg)) + (args-len 0)) + (if (not (list? args)) + (slib:error 'format "expected a list argument" args)) + (set! args-len (length args)) + (do ((arg-pos 0 (+ arg-pos + (format:format-work + iteration-str + (list-tail args arg-pos)))) + (i 0 (+ i 1))) + ((or (>= arg-pos args-len) + (and format:iteration-bounded + (>= i max-iterations))))))) + ((sublists) + (let ((args (next-arg)) + (args-len 0)) + (if (not (list? args)) + (slib:error 'format "expected a list argument" args)) + (set! args-len (length args)) + (do ((arg-pos 0 (+ arg-pos 1))) + ((or (>= arg-pos args-len) + (and format:iteration-bounded + (>= arg-pos max-iterations)))) + (let ((sublist (list-ref args arg-pos))) + (if (not (list? sublist)) + (slib:error 'format + "expected a list of lists argument" args)) + (format:format-work iteration-str sublist))))) + ((rest-args) + (let* ((args (rest-args)) + (args-len (length args)) + (usedup-args + (do ((arg-pos 0 (+ arg-pos + (format:format-work + iteration-str + (list-tail + args arg-pos)))) + (i 0 (+ i 1))) + ((or (>= arg-pos args-len) + (and format:iteration-bounded + (>= i max-iterations))) + arg-pos)))) + (add-arg-pos usedup-args))) + ((rest-sublists) + (let* ((args (rest-args)) + (args-len (length args)) + (usedup-args + (do ((arg-pos 0 (+ arg-pos 1))) + ((or (>= arg-pos args-len) + (and format:iteration-bounded + (>= arg-pos max-iterations))) + arg-pos) + (let ((sublist (list-ref args arg-pos))) + (if (not (list? sublist)) + (slib:error 'format "expected list arguments" args)) + (format:format-work iteration-str sublist))))) + (add-arg-pos usedup-args))) + (else (slib:error 'format "internal error in ~~}"))))) + (anychar-dispatch)) + ((#\^) ; Up and out + (let* ((continue + (cond + ((not (null? params)) + (not + (case (length params) + ((1) (zero? (car params))) + ((2) (= (list-ref params 0) (list-ref params 1))) + ((3) (<= (list-ref params 0) + (list-ref params 1) + (list-ref params 2))) + (else (slib:error 'format "too many parameters"))))) + (format:case-conversion ; if conversion stop conversion + (set! format:case-conversion string-copy) #t) + ((= iteration-nest 1) #t) + ((= conditional-nest 1) #t) + ((>= arg-pos arg-len) + (set! format:pos format-string-len) #f) + (else #t)))) + (if continue + (anychar-dispatch)))) + + ;; format directive modifiers and parameters + + ((#\@) ; `@' modifier + (if (memq modifier '(at colon-at)) + (slib:error 'format "double `@' modifier")) + (set! modifier (if (eq? modifier 'colon) 'colon-at 'at)) + (tilde-dispatch)) + ((#\:) ; `:' modifier + (if (memq modifier '(colon colon-at)) + (slib:error 'format "double `:' modifier")) + (set! modifier (if (eq? modifier 'at) 'colon-at 'colon)) + (tilde-dispatch)) + ((#\') ; Character parameter + (if modifier (slib:error 'format "misplaced modifier" modifier)) + (set! params (append params (list (char->integer (next-char))))) + (set! param-value-found #t) + (tilde-dispatch)) + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\- #\+) ; num. paramtr + (if modifier (slib:error 'format "misplaced modifier" modifier)) + (let ((num-str-beg (- format:pos 1)) + (num-str-end format:pos)) + (do ((ch (peek-next-char) (peek-next-char))) + ((not (char-numeric? ch))) + (next-char) + (set! num-str-end (+ 1 num-str-end))) + (set! params + (append params + (list (string->number + (substring format-string + num-str-beg + num-str-end)))))) + (set! param-value-found #t) + (tilde-dispatch)) + ((#\V) ; Variable parameter from next argum. + (if modifier (slib:error 'format "misplaced modifier" modifier)) + (set! params (append params (list (next-arg)))) + (set! param-value-found #t) + (tilde-dispatch)) + ((#\#) ; Parameter is number of remaining args + (if modifier (slib:error 'format "misplaced modifier" modifier)) + (set! params (append params (list (length (rest-args))))) + (set! param-value-found #t) + (tilde-dispatch)) + ((#\,) ; Parameter separators + (if modifier (slib:error 'format "misplaced modifier" modifier)) + (if (not param-value-found) + (set! params (append params '(#f)))) ; append empty paramtr + (set! param-value-found #f) + (tilde-dispatch)) + ((#\Q) ; Inquiry messages + (if (eq? modifier 'colon) + (format:out-str format:version) + (let ((nl (string #\newline))) + (format:out-str + (string-append + "SLIB Common LISP format version " format:version nl + " This code is in the public domain." nl + " Please send bug reports to `lutzeb@cs.tu-berlin.de'" + nl)))) + (anychar-dispatch)) + (else ; Unknown tilde directive + (slib:error 'format "unknown control character" + (string-ref format-string (- format:pos 1)))))) + (else (anychar-dispatch)))))) ; in case of conditional + + (set! format:pos 0) + (anychar-dispatch) ; start the formatting + (set! format:pos recursive-pos-save) + arg-pos)) + + (define (format:out fmt args) ; the output handler for a port + ;;(set! format:case-conversion #f) ; modifier case conversion procedure + ;;(set! format:flush-output #f) ; ~! reset + (let ((arg-pos (format:format-work fmt args)) + (arg-len (length args))) + (cond ((< arg-pos arg-len) + (set! format:pos (string-length fmt)) + (slib:error 'format (- arg-len arg-pos) "superfluous arguments")) + ((> arg-pos arg-len) + (slib:error 'format (- arg-pos arg-len) "missing arguments"))))) + + ;;(set! format:pos 0) + (if (< (length args) 1) (slib:error 'format "not enough arguments")) + + ;; If the first argument is a string, then that's the format string. + ;; (Scheme->C) + ;; In this case, put the argument list in canonical form. + (let ((args (if (string? (car args)) (cons #f args) args))) + (let ((destination (car args)) + (arglist (cdr args))) + (cond + ((or (and (boolean? destination) ; port output + destination) + (output-port? destination) + (number? destination)) + (let ((port (cond ((boolean? destination) (current-output-port)) + ((output-port? destination) destination) + ((number? destination) (current-error-port))))) + (set! format:port port) ; global port for output routines + (set! format:output-col (format:get-port-column port)) + (format:out (car arglist) (cdr arglist)) + (format:set-port-column! port format:output-col) + (if format:flush-output (force-output format:port)) + #t)) + ((and (boolean? destination) ; string output + (not destination)) + (call-with-output-string + (lambda (port) + (set! format:port port) + (format:out (car arglist) (cdr arglist))))) + (else + (slib:error 'format "illegal destination" destination)))))) + +;; format:obj->str returns a R4RS representation as a string of an +;; arbitrary scheme object. + +;; First parameter is the object, second parameter is a boolean if +;; the representation should be slashified as `write' does. + +;; It uses format:char->str which converts a character into a +;; slashified string as `write' does and which is implementation +;; dependent. + +;; It uses format:iobj->str to print out internal objects as quoted +;; strings so that the output can always be processed by (read) + +;; If format:read-proof is set to #t the resulting string is +;; additionally set into string quotes. + +(define (format:obj->str obj slashify format:read-proof) + (cond + ((string? obj) + (if slashify + (let ((obj-len (string-length obj))) + (string-append + "\"" + (let loop ((i 0) (j 0)) ; taken from Marc Feeley's pp.scm + (if (= j obj-len) + (string-append (substring obj i j) "\"") + (let ((c (string-ref obj j))) + (if (or (char=? c #\\) + (char=? c #\")) + (string-append (substring obj i j) "\\" + (loop j (+ j 1))) + (loop i (+ j 1)))))))) + obj)) + + ((boolean? obj) (if obj "#t" "#f")) + + ((number? obj) (number->string obj)) + + ((symbol? obj) + (if format:symbol-case-conv + (format:symbol-case-conv (symbol->string obj)) + (symbol->string obj))) + + ((char? obj) + (if slashify + (format:char->str obj) + (string obj))) + + ((null? obj) "()") + + ((input-port? obj) + (format:iobj->str obj format:read-proof)) + + ((output-port? obj) + (format:iobj->str obj format:read-proof)) + + ((list? obj) + (string-append "(" + (let loop ((obj-list obj)) + (if (null? (cdr obj-list)) + (format:obj->str (car obj-list) #t format:read-proof) + (string-append + (format:obj->str (car obj-list) #t format:read-proof) + " " + (loop (cdr obj-list))))) + ")")) + + ((pair? obj) + (string-append "(" + (format:obj->str (car obj) #t format:read-proof) + " . " + (format:obj->str (cdr obj) #t format:read-proof) + ")")) + + ((vector? obj) + (string-append "#" (format:obj->str (vector->list obj) #t format:read-proof))) + + (else ; only objects with an #<...> + (format:iobj->str obj format:read-proof)))) + ; representation should fall in here + +;; format:iobj->str reveals the implementation dependent +;; representation of #<...> objects with the use of display and +;; call-with-output-string. + +;; If format:read-proof is set to #t the resulting string is +;; additionally set into string quotes. + +(define (format:iobj->str iobj format:read-proof) + (if (or format:read-proof + format:iobj-case-conv) + (string-append + (if format:read-proof "\"" "") + (if format:iobj-case-conv + (format:iobj-case-conv + (call-with-output-string (lambda (p) (display iobj p)))) + (call-with-output-string (lambda (p) (display iobj p)))) + (if format:read-proof "\"" "")) + (call-with-output-string (lambda (p) (display iobj p))))) + +(define (format:par pars length index default name) + (if (> length index) + (let ((par (list-ref pars index))) + (if par + (if name + (if (< par 0) + (slib:error name "parameter must be a positive integer") + par) + par) + default)) + default)) + +;; format:char->str converts a character into a slashified string as +;; done by `write'. The procedure is dependent on the integer +;; representation of characters and assumes a character number +;; according to the ASCII character set. + +(define (format:char->str ch) + (let ((int-rep (char->integer ch))) + (if (< int-rep 0) ; if chars are [-128...+127] + (set! int-rep (+ int-rep 256))) + (string-append + "#\\" + (cond + ((char=? ch #\newline) "newline") + ((and (>= int-rep 0) (<= int-rep 32)) + (vector-ref format:ascii-non-printable-charnames int-rep)) + ((= int-rep 127) "del") + ((>= int-rep 128) ; octal representation + (if format:radix-pref + (let ((s (number->string int-rep 8))) + (substring s 2 (string-length s))) + (number->string int-rep 8))) + (else (string ch)))))) + +;;; We should keep separate track of columns for each port, but +;;; keeping pointers to ports will foil GC. Instead, keep +;;; associations indexed by the DISPLAYed representation of the ports. +(define *port-columns* '()) +(define (format:get-port-column port) + (define pair (assoc (call-with-output-string + (lambda (sport) (display port sport))) + *port-columns*)) + (if pair (cdr pair) 0)) +(define (format:set-port-column! port col) + (define pname (call-with-output-string + (lambda (sport) (display port sport)))) + (let ((pair (assoc pname *port-columns*))) + (if pair + (set-cdr! pair col) + (set! *port-columns* (cons (cons pname col) *port-columns*))))) + +;;; some global functions not found in SLIB + +(define (format:string-capitalize-first str) ; "hello" -> "Hello" + (let ((cap-str (string-copy str)) ; "hELLO" -> "Hello" + (non-first-alpha #f) ; "*hello" -> "*Hello" + (str-len (string-length str))) ; "hello you" -> "Hello you" + (do ((i 0 (+ i 1))) + ((= i str-len) cap-str) + (let ((c (string-ref str i))) + (if (char-alphabetic? c) + (if non-first-alpha + (string-set! cap-str i (char-downcase c)) + (begin + (set! non-first-alpha #t) + (string-set! cap-str i (char-upcase c))))))))) diff --git a/format.texi b/format.texi new file mode 100644 index 0000000..34d5e0a --- /dev/null +++ b/format.texi @@ -0,0 +1,451 @@ + +@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.1) + +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 ``old fashioned'' 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)). Iteration +bounding is controlled by configuration variables +@var{format:iteration-bounded} and @var{format:max-iterations}. +With both variables default, a maximum of 100 iterations will be +performed. +@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}) + +@item @var{format:iteration-bounded} +When @code{#t}, a @code{~@{...~@}} control will iterate no more than the +number of times specified by @var{format:max-iterations} regardless of +the number of iterations implied by modifiers and arguments. +When @code{#f}, a @code{~@{...~@}} control will iterate the number of +times implied by modifiers and arguments, unless termination is forced +by language or system limitations. (default @code{#t}) + +@item @var{format:max-iterations} +The maximum number of iterations performed by a @code{~@{...~@}} control. +Has effect only when @var{format:iteration-bounded} is @code{#t}. +(default 100) + +@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 diff --git a/formatst.scm b/formatst.scm new file mode 100644 index 0000000..28d656a --- /dev/null +++ b/formatst.scm @@ -0,0 +1,654 @@ +;; "formatst.scm" SLIB FORMAT Version 3.0 conformance test +; Written by Dirk Lutzebaeck (lutzeb@cs.tu-berlin.de) +; +; This code is in the public domain. + +;; Test run: (slib:load "formatst") + +; Failure reports for various scheme interpreters: +; +; SCM4d +; None. +; Elk 2.2: +; None. +; MIT C-Scheme 7.1: +; The empty list is always evaluated as a boolean and consequently +; represented as `#f'. +; Scheme->C 01nov91: +; None, if format:symbol-case-conv and format:iobj-case-conv are set +; to string-downcase. + +(require 'format) + +(if (not (string=? format:version "3.1")) + (begin + (display "You have format version ") + (display format:version) + (display ". This test is for format version 3.0!") + (newline) + (format:abort))) + +(define fails 0) +(define total 0) +(define test-verbose #f) ; shows each test performed + +(define (test format-args out-str) + (set! total (+ total 1)) + (if (not test-verbose) + (if (zero? (modulo total 10)) + (begin + (display total) + (display ",") + (force-output (current-output-port))))) + (let ((format-out (apply format `(#f ,@format-args)))) + (if (string=? out-str format-out) + (if test-verbose + (begin + (display "Verified ") + (write format-args) + (display " returns ") + (write out-str) + (newline))) + (begin + (set! fails (+ fails 1)) + (if (not test-verbose) (newline)) + (display "*Failed* ") + (write format-args) + (newline) + (display " returns ") + (write format-out) + (newline) + (display " expected ") + (write out-str) + (newline))))) + +; ensure format default configuration + +;;(set! format:symbol-case-conv #f) +;;(set! format:iobj-case-conv #f) +;;(set! format:iteration-bounded #t) +;;(set! format:max-iterations 100) + +(format #t "~q") + +(format #t "This implementation has~@[ no~] flonums ~ + ~:[but no~;and~] complex numbers~%" + (not format:floats) format:complex-numbers) + +; any object test + +(test '("abc") "abc") +(test '("~a" 10) "10") +(test '("~a" -1.2) "-1.2") +(test '("~a" a) "a") +(test '("~a" #t) "#t") +(test '("~a" #f) "#f") +(test '("~a" "abc") "abc") +(test '("~a" #(1 2 3)) "#(1 2 3)") +(test '("~a" ()) "()") +(test '("~a" (a)) "(a)") +(test '("~a" (a b)) "(a b)") +(test '("~a" (a (b c) d)) "(a (b c) d)") +(test '("~a" (a . b)) "(a . b)") +(test '("~a" (a (b c . d))) "(a (b . (c . d)))") ; this is ugly +(test `("~a" ,display) (format:iobj->str display #f)) +(test `("~a" ,(current-input-port)) (format:iobj->str (current-input-port) #f)) +(test `("~a" ,(current-output-port)) (format:iobj->str (current-output-port) #f)) + +; # argument test + +(test '("~a ~a" 10 20) "10 20") +(test '("~a abc ~a def" 10 20) "10 abc 20 def") + +; numerical test + +(test '("~d" 100) "100") +(test '("~x" 100) "64") +(test '("~o" 100) "144") +(test '("~b" 100) "1100100") +(test '("~@d" 100) "+100") +(test '("~@d" -100) "-100") +(test '("~@x" 100) "+64") +(test '("~@o" 100) "+144") +(test '("~@b" 100) "+1100100") +(test '("~10d" 100) " 100") +(test '("~:d" 123) "123") +(test '("~:d" 1234) "1,234") +(test '("~:d" 12345) "12,345") +(test '("~:d" 123456) "123,456") +(test '("~:d" 12345678) "12,345,678") +(test '("~:d" -123) "-123") +(test '("~:d" -1234) "-1,234") +(test '("~:d" -12345) "-12,345") +(test '("~:d" -123456) "-123,456") +(test '("~:d" -12345678) "-12,345,678") +(test '("~10:d" 1234) " 1,234") +(test '("~10:d" -1234) " -1,234") +(test '("~10,'*d" 100) "*******100") +(test '("~10,,'|:d" 12345678) "12|345|678") +(test '("~10,,,2:d" 12345678) "12,34,56,78") +(test '("~14,'*,'|,4:@d" 12345678) "****+1234|5678") +(test '("~10r" 100) "100") +(test '("~2r" 100) "1100100") +(test '("~8r" 100) "144") +(test '("~16r" 100) "64") +(test '("~16,10,'*r" 100) "********64") + +; roman numeral test + +(test '("~@r" 4) "IV") +(test '("~@r" 19) "XIX") +(test '("~@r" 50) "L") +(test '("~@r" 100) "C") +(test '("~@r" 1000) "M") +(test '("~@r" 99) "XCIX") +(test '("~@r" 1994) "MCMXCIV") + +; old roman numeral test + +(test '("~:@r" 4) "IIII") +(test '("~:@r" 5) "V") +(test '("~:@r" 10) "X") +(test '("~:@r" 9) "VIIII") + +; cardinal/ordinal English number test + +(test '("~r" 4) "four") +(test '("~r" 10) "ten") +(test '("~r" 19) "nineteen") +(test '("~r" 1984) "one thousand, nine hundred eighty-four") +(test '("~:r" -1984) "minus one thousand, nine hundred eighty-fourth") + +; character test + +(test '("~c" #\a) "a") +(test '("~@c" #\a) "#\\a") +(test `("~@c" ,(integer->char 32)) "#\\space") +(test `("~@c" ,(integer->char 0)) "#\\nul") +(test `("~@c" ,(integer->char 27)) "#\\esc") +(test `("~@c" ,(integer->char 127)) "#\\del") +(test `("~@c" ,(integer->char 128)) "#\\200") +(test `("~@c" ,(integer->char 255)) "#\\377") +(test '("~65c") "A") +(test '("~7@c") "#\\bel") +(test '("~:c" #\a) "a") +(test `("~:c" ,(integer->char 1)) "^A") +(test `("~:c" ,(integer->char 27)) "^[") +(test '("~7:c") "^G") +(test `("~:c" ,(integer->char 128)) "#\\200") +(test `("~:c" ,(integer->char 127)) "#\\177") +(test `("~:c" ,(integer->char 255)) "#\\377") + + +; plural test + +(test '("test~p" 1) "test") +(test '("test~p" 2) "tests") +(test '("test~p" 0) "tests") +(test '("tr~@p" 1) "try") +(test '("tr~@p" 2) "tries") +(test '("tr~@p" 0) "tries") +(test '("~a test~:p" 10) "10 tests") +(test '("~a test~:p" 1) "1 test") + +; tilde test + +(test '("~~~~") "~~") +(test '("~3~") "~~~") + +; whitespace character test + +(test '("~%") " +") +(test '("~3%") " + + +") +(test '("~&") "") +(test '("abc~&") "abc +") +(test '("abc~&def") "abc +def") +(test '("~&") " +") +(test '("~3&") " + +") +(test '("abc~3&") "abc + + +") +(test '("~|") (string slib:form-feed)) +(test '("~_~_~_") " ") +(test '("~3_") " ") +(test '("~/") (string slib:tab)) +(test '("~3/") (make-string 3 slib:tab)) + +; tabulate test + +(test '("~0&~3t") " ") +(test '("~0&~10t") " ") +(test '("~10t") "") +(test '("~0&1234567890~,8tABC") "1234567890 ABC") +(test '("~0&1234567890~0,8tABC") "1234567890 ABC") +(test '("~0&1234567890~1,8tABC") "1234567890 ABC") +(test '("~0&1234567890~2,8tABC") "1234567890ABC") +(test '("~0&1234567890~3,8tABC") "1234567890 ABC") +(test '("~0&1234567890~4,8tABC") "1234567890 ABC") +(test '("~0&1234567890~5,8tABC") "1234567890 ABC") +(test '("~0&1234567890~6,8tABC") "1234567890 ABC") +(test '("~0&1234567890~7,8tABC") "1234567890 ABC") +(test '("~0&1234567890~8,8tABC") "1234567890 ABC") +(test '("~0&1234567890~9,8tABC") "1234567890 ABC") +(test '("~0&1234567890~10,8tABC") "1234567890ABC") +(test '("~0&1234567890~11,8tABC") "1234567890 ABC") +(test '("~0&12345~,8tABCDE~,8tXYZ") "12345 ABCDE XYZ") +(test '("~,8t+++~,8t===") " +++ ===") +(test '("~0&ABC~,8,'.tDEF") "ABC......DEF") +(test '("~0&~3,8@tABC") " ABC") +(test '("~0&1234~3,8@tABC") "1234 ABC") +(test '("~0&12~3,8@tABC~3,8@tDEF") "12 ABC DEF") + +; indirection test + +(test '("~a ~? ~a" 10 "~a ~a" (20 30) 40) "10 20 30 40") +(test '("~a ~@? ~a" 10 "~a ~a" 20 30 40) "10 20 30 40") + +; field test + +(test '("~10a" "abc") "abc ") +(test '("~10@a" "abc") " abc") +(test '("~10a" "0123456789abc") "0123456789abc") +(test '("~10@a" "0123456789abc") "0123456789abc") + +; pad character test + +(test '("~10,,,'*a" "abc") "abc*******") +(test '("~10,,,'Xa" "abc") "abcXXXXXXX") +(test '("~10,,,42a" "abc") "abc*******") +(test '("~10,,,'*@a" "abc") "*******abc") +(test '("~10,,3,'*a" "abc") "abc*******") +(test '("~10,,3,'*a" "0123456789abc") "0123456789abc***") ; min. padchar length +(test '("~10,,3,'*@a" "0123456789abc") "***0123456789abc") + +; colinc, minpad padding test + +(test '("~10,8,0,'*a" 123) "123********") +(test '("~10,9,0,'*a" 123) "123*********") +(test '("~10,10,0,'*a" 123) "123**********") +(test '("~10,11,0,'*a" 123) "123***********") +(test '("~8,1,0,'*a" 123) "123*****") +(test '("~8,2,0,'*a" 123) "123******") +(test '("~8,3,0,'*a" 123) "123******") +(test '("~8,4,0,'*a" 123) "123********") +(test '("~8,5,0,'*a" 123) "123*****") +(test '("~8,1,3,'*a" 123) "123*****") +(test '("~8,1,5,'*a" 123) "123*****") +(test '("~8,1,6,'*a" 123) "123******") +(test '("~8,1,9,'*a" 123) "123*********") + +; slashify test + +(test '("~s" "abc") "\"abc\"") +(test '("~s" "abc \\ abc") "\"abc \\\\ abc\"") +(test '("~a" "abc \\ abc") "abc \\ abc") +(test '("~s" "abc \" abc") "\"abc \\\" abc\"") +(test '("~a" "abc \" abc") "abc \" abc") +(test '("~s" #\space) "#\\space") +(test '("~s" #\newline) "#\\newline") +(test `("~s" ,slib:tab) "#\\ht") +(test '("~s" #\a) "#\\a") +(test '("~a" (a "b" c)) "(a \"b\" c)") + +; symbol case force test + +(define format:old-scc format:symbol-case-conv) +(set! format:symbol-case-conv string-upcase) +(test '("~a" abc) "ABC") +(set! format:symbol-case-conv string-downcase) +(test '("~s" abc) "abc") +(set! format:symbol-case-conv string-capitalize) +(test '("~s" abc) "Abc") +(set! format:symbol-case-conv format:old-scc) + +; read proof test + +(test `("~:s" ,display) (format:iobj->str display #t)) +(test `("~:a" ,display) (format:iobj->str display #t)) +(test `("~:a" (1 2 ,display)) (string-append "(1 2 " (format:iobj->str display #t) ")")) +(test '("~:a" "abc") "abc") + +; internal object case type force test + +(set! format:iobj-case-conv string-upcase) +(test `("~a" ,display) (string-upcase (format:iobj->str display #f))) +(set! format:iobj-case-conv string-downcase) +(test `("~s" ,display) (string-downcase (format:iobj->str display #f))) +(set! format:iobj-case-conv string-capitalize) +(test `("~s" ,display) (string-capitalize (format:iobj->str display #f))) +(set! format:iobj-case-conv #f) + +; continuation line test + +(test '("abc~ + 123") "abc123") +(test '("abc~ +123") "abc123") +(test '("abc~ +") "abc") +(test '("abc~: + def") "abc def") +(test '("abc~@ + def") +"abc +def") + +; flush output (can't test it here really) + +(test '("abc ~! xyz") "abc xyz") + +; string case conversion + +(test '("~a ~(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc hello world xyz") +(test '("~a ~:(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc Hello World xyz") +(test '("~a ~@(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc Hello world xyz") +(test '("~a ~:@(~a~) ~a" "abc" "hello world" "xyz") "abc HELLO WORLD xyz") +(test '("~:@(~a~)" (a b c)) "(A B C)") +(test '("~:@(~x~)" 255) "FF") +(test '("~:@(~p~)" 2) "S") +(test `("~:@(~a~)" ,display) (string-upcase (format:iobj->str display #f))) +(test '("~:(~a ~a ~a~) ~a" "abc" "xyz" "123" "world") "Abc Xyz 123 world") + +; variable parameter + +(test '("~va" 10 "abc") "abc ") +(test '("~v,,,va" 10 42 "abc") "abc*******") + +; number of remaining arguments as parameter + +(test '("~#,,,'*@a ~a ~a ~a" 1 1 1 1) "***1 1 1 1") + +; argument jumping + +(test '("~a ~* ~a" 10 20 30) "10 30") +(test '("~a ~2* ~a" 10 20 30 40) "10 40") +(test '("~a ~:* ~a" 10) "10 10") +(test '("~a ~a ~2:* ~a ~a" 10 20) "10 20 10 20") +(test '("~a ~a ~@* ~a ~a" 10 20) "10 20 10 20") +(test '("~a ~a ~4@* ~a ~a" 10 20 30 40 50 60) "10 20 50 60") + +; conditionals + +(test '("~[abc~;xyz~]" 0) "abc") +(test '("~[abc~;xyz~]" 1) "xyz") +(test '("~[abc~;xyz~:;456~]" 99) "456") +(test '("~0[abc~;xyz~:;456~]") "abc") +(test '("~1[abc~;xyz~:;456~] ~a" 100) "xyz 100") +(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]") "no arg") +(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10) "10") +(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10 20) "10 and 20") +(test '("~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10 20 30) "10, 20 and 30") +(test '("~:[hello~;world~] ~a" #t 10) "world 10") +(test '("~:[hello~;world~] ~a" #f 10) "hello 10") +(test '("~@[~a tests~]" #f) "") +(test '("~@[~a tests~]" 10) "10 tests") +(test '("~@[~a test~:p~] ~a" 10 done) "10 tests done") +(test '("~@[~a test~:p~] ~a" 1 done) "1 test done") +(test '("~@[~a test~:p~] ~a" 0 done) "0 tests done") +(test '("~@[~a test~:p~] ~a" #f done) " done") +(test '("~@[ level = ~d~]~@[ length = ~d~]" #f 5) " length = 5") +(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 0) "abc") ; nested conditionals (irrghh) +(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 2) "xyz") +(test '("~[abc~;~[4~;5~;6~]~;xyz~]" 1 2) "6") + +; iteration + +(test '("~{ ~a ~}" (a b c)) " a b c ") +(test '("~{ ~a ~}" ()) "") +(test '("~{ ~a ~5,,,'*a~}" (a b c d)) " a b**** c d****") +(test '("~{ ~a,~a ~}" (a 1 b 2 c 3)) " a,1 b,2 c,3 ") +(test '("~2{ ~a,~a ~}" (a 1 b 2 c 3)) " a,1 b,2 ") +(test '("~3{~a ~} ~a" (a b c d e) 100) "a b c 100") +(test '("~0{~a ~} ~a" (a b c d e) 100) " 100") +(test '("~:{ ~a,~a ~}" ((a b) (c d e f) (g h))) " a,b c,d g,h ") +(test '("~2:{ ~a,~a ~}" ((a b) (c d e f) (g h))) " a,b c,d ") +(test '("~@{ ~a,~a ~}" a 1 b 2 c 3) " a,1 b,2 c,3 ") +(test '("~2@{ ~a,~a ~} <~a|~a>" a 1 b 2 c 3) " a,1 b,2 <c|3>") +(test '("~:@{ ~a,~a ~}" (a 1) (b 2) (c 3)) " a,1 b,2 c,3 ") +(test '("~2:@{ ~a,~a ~} ~a" (a 1) (b 2) (c 3)) " a,1 b,2 (c 3)") +(test '("~{~}" "<~a,~a>" (a 1 b 2 c 3)) "<a,1><b,2><c,3>") +(test '("~{ ~a ~{<~a>~}~} ~a" (a (1 2) b (3 4)) 10) " a <1><2> b <3><4> 10") +(let ((nums (let iter ((ns '()) (l 0)) + (if (> l 105) (reverse ns) (iter (cons l ns) (+ l 1)))))) + ;; Test default, only 100 items formatted out: + (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums)) + "0, 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, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100") + ;; Test control of number of items formatted out: + (set! format:max-iterations 90) + (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums)) + "0, 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, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90") + ;; Test control of imposing bound on number of items formatted out: + (set! format:iteration-bounded #f) + (test `("~D~{, ~D~}" ,(car nums) ,(cdr nums)) + "0, 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, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105") + ;; Restore defaults: + (set! format:iteration-bounded #t) + (set! format:max-iterations 100) + ) + +; up and out + +(test '("abc ~^ xyz") "abc ") +(test '("~@(abc ~^ xyz~) ~a" 10) "ABC xyz 10") +(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p.") "done. ") +(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p." 10) "done. 10 warnings. ") +(test '("done. ~^ ~d warning~:p. ~^ ~d error~:p." 10 1) + "done. 10 warnings. 1 error.") +(test '("~{ ~a ~^<~a>~} ~a" (a b c d e f) 10) " a <b> c <d> e <f> 10") +(test '("~{ ~a ~^<~a>~} ~a" (a b c d e) 10) " a <b> c <d> e 10") +(test '("abc~0^ xyz") "abc") +(test '("abc~9^ xyz") "abc xyz") +(test '("abc~7,4^ xyz") "abc xyz") +(test '("abc~7,7^ xyz") "abc") +(test '("abc~3,7,9^ xyz") "abc") +(test '("abc~8,7,9^ xyz") "abc xyz") +(test '("abc~3,7,5^ xyz") "abc xyz") + +; complexity tests (oh my god, I hardly understand them myself (see CL std)) + +(define fmt "Items:~#[ none~; ~a~; ~a and ~a~:;~@{~#[~; and~] ~a~^,~}~].") + +(test `(,fmt ) "Items: none.") +(test `(,fmt foo) "Items: foo.") +(test `(,fmt foo bar) "Items: foo and bar.") +(test `(,fmt foo bar baz) "Items: foo, bar, and baz.") +(test `(,fmt foo bar baz zok) "Items: foo, bar, baz, and zok.") + +; fixed floating points + +(cond + (format:floats + (test '("~6,2f" 3.14159) " 3.14") + (test '("~6,1f" 3.14159) " 3.1") + (test '("~6,0f" 3.14159) " 3.") + (test '("~5,1f" 0) " 0.0") + (test '("~10,7f" 3.14159) " 3.1415900") + (test '("~10,7f" -3.14159) "-3.1415900") + (test '("~10,7@f" 3.14159) "+3.1415900") + (test '("~6,3f" 0.0) " 0.000") + (test '("~6,4f" 0.007) "0.0070") + (test '("~6,3f" 0.007) " 0.007") + (test '("~6,2f" 0.007) " 0.01") + (test '("~3,2f" 0.007) ".01") + (test '("~3,2f" -0.007) "-.01") + (test '("~6,2,,,'*f" 3.14159) "**3.14") + (test '("~6,3,,'?f" 12345.56789) "??????") + (test '("~6,3f" 12345.6789) "12345.679") + (test '("~,3f" 12345.6789) "12345.679") + (test '("~,3f" 9.9999) "10.000") + (test '("~6f" 23.4) " 23.4") + (test '("~6f" 1234.5) "1234.5") + (test '("~6f" 12345678) "12345678.0") + (test '("~6,,,'?f" 12345678) "??????") + (test '("~6f" 123.56789) "123.57") + (test '("~6f" 123.0) " 123.0") + (test '("~6f" -123.0) "-123.0") + (test '("~6f" 0.0) " 0.0") + (test '("~3f" 3.141) "3.1") + (test '("~2f" 3.141) "3.") + (test '("~1f" 3.141) "3.141") + (test '("~f" 123.56789) "123.56789") + (test '("~f" -314.0) "-314.0") + (test '("~f" 1e4) "10000.0") + (test '("~f" -1.23e10) "-12300000000.0") + (test '("~f" 1e-4) "0.0001") + (test '("~f" -1.23e-10) "-0.000000000123") + (test '("~@f" 314.0) "+314.0") + (test '("~,,3f" 0.123456) "123.456") + (test '("~,,-3f" -123.456) "-0.123456") + (test '("~5,,3f" 0.123456) "123.5") +)) + +; exponent floating points + +(cond + (format:floats + (test '("~e" 3.14159) "3.14159E+0") + (test '("~e" 0.00001234) "1.234E-5") + (test '("~,,,0e" 0.00001234) "0.1234E-4") + (test '("~,3e" 3.14159) "3.142E+0") + (test '("~,3@e" 3.14159) "+3.142E+0") + (test '("~,3@e" 0.0) "+0.000E+0") + (test '("~,0e" 3.141) "3.E+0") + (test '("~,3,,0e" 3.14159) "0.314E+1") + (test '("~,5,3,-2e" 3.14159) "0.00314E+003") + (test '("~,5,3,-5e" -3.14159) "-0.00000E+006") + (test '("~,5,2,2e" 3.14159) "31.4159E-01") + (test '("~,5,2,,,,'ee" 0.0) "0.00000e+00") + (test '("~12,3e" -3.141) " -3.141E+0") + (test '("~12,3,,,,'#e" -3.141) "###-3.141E+0") + (test '("~10,2e" -1.236e-4) " -1.24E-4") + (test '("~5,3e" -3.141) "-3.141E+0") + (test '("~5,3,,,'*e" -3.141) "*****") + (test '("~3e" 3.14159) "3.14159E+0") + (test '("~4e" 3.14159) "3.14159E+0") + (test '("~5e" 3.14159) "3.E+0") + (test '("~5,,,,'*e" 3.14159) "3.E+0") + (test '("~6e" 3.14159) "3.1E+0") + (test '("~7e" 3.14159) "3.14E+0") + (test '("~7e" -3.14159) "-3.1E+0") + (test '("~8e" 3.14159) "3.142E+0") + (test '("~9e" 3.14159) "3.1416E+0") + (test '("~9,,,,,,'ee" 3.14159) "3.1416e+0") + (test '("~10e" 3.14159) "3.14159E+0") + (test '("~11e" 3.14159) " 3.14159E+0") + (test '("~12e" 3.14159) " 3.14159E+0") + (test '("~13,6,2,-5e" 3.14159) " 0.000003E+06") + (test '("~13,6,2,-4e" 3.14159) " 0.000031E+05") + (test '("~13,6,2,-3e" 3.14159) " 0.000314E+04") + (test '("~13,6,2,-2e" 3.14159) " 0.003142E+03") + (test '("~13,6,2,-1e" 3.14159) " 0.031416E+02") + (test '("~13,6,2,0e" 3.14159) " 0.314159E+01") + (test '("~13,6,2,1e" 3.14159) " 3.141590E+00") + (test '("~13,6,2,2e" 3.14159) " 31.41590E-01") + (test '("~13,6,2,3e" 3.14159) " 314.1590E-02") + (test '("~13,6,2,4e" 3.14159) " 3141.590E-03") + (test '("~13,6,2,5e" 3.14159) " 31415.90E-04") + (test '("~13,6,2,6e" 3.14159) " 314159.0E-05") + (test '("~13,6,2,7e" 3.14159) " 3141590.E-06") + (test '("~13,6,2,8e" 3.14159) "31415900.E-07") + (test '("~7,3,,-2e" 0.001) ".001E+0") + (test '("~8,3,,-2@e" 0.001) "+.001E+0") + (test '("~8,3,,-2@e" -0.001) "-.001E+0") + (test '("~8,3,,-2e" 0.001) "0.001E+0") + (test '("~7,,,-2e" 0.001) "0.00E+0") + (test '("~12,3,1e" 3.14159e12) " 3.142E+12") + (test '("~12,3,1,,'*e" 3.14159e12) "************") + (test '("~5,3,1e" 3.14159e12) "3.142E+12") +)) + +; general floating point (this test is from Steele's CL book) + +(cond + (format:floats + (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g" + 0.0314159 0.0314159 0.0314159 0.0314159) + " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2") + (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g" + 0.314159 0.314159 0.314159 0.314159) + " 0.31 |0.314 |0.314 | 0.31 ") + (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g" + 3.14159 3.14159 3.14159 3.14159) + " 3.1 | 3.14 | 3.14 | 3.1 ") + (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g" + 31.4159 31.4159 31.4159 31.4159) + " 31. | 31.4 | 31.4 | 31. ") + (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g" + 314.159 314.159 314.159 314.159) + " 3.14E+2| 314. | 314. | 3.14E+2") + (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g" + 3141.59 3141.59 3141.59 3141.59) + " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3") + (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g" + 3.14E12 3.14E12 3.14E12 3.14E12) + "*********|314.0$+10|0.314E+13| 3.14E+12") + (test '("~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g" + 3.14E120 3.14E120 3.14E120 3.14E120) + "*********|?????????|%%%%%%%%%|3.14E+120") + + (test '("~g" 0.0) "0.0 ") ; further ~g tests + (test '("~g" 0.1) "0.1 ") + (test '("~g" 0.01) "1.0E-2") + (test '("~g" 123.456) "123.456 ") + (test '("~g" 123456.7) "123456.7 ") + (test '("~g" 123456.78) "123456.78 ") + (test '("~g" 0.9282) "0.9282 ") + (test '("~g" 0.09282) "9.282E-2") + (test '("~g" 1) "1.0 ") + (test '("~g" 12) "12.0 ") + )) + +; dollar floating point + +(cond + (format:floats + (test '("~$" 1.23) "1.23") + (test '("~$" 1.2) "1.20") + (test '("~$" 0.0) "0.00") + (test '("~$" 9.999) "10.00") + (test '("~3$" 9.9999) "10.000") + (test '("~,4$" 3.2) "0003.20") + (test '("~,4$" 10000.2) "10000.20") + (test '("~,4,10$" 3.2) " 0003.20") + (test '("~,4,10@$" 3.2) " +0003.20") + (test '("~,4,10:@$" 3.2) "+ 0003.20") + (test '("~,4,10:$" -3.2) "- 0003.20") + (test '("~,4,10$" -3.2) " -0003.20") + (test '("~,,10@$" 3.2) " +3.20") + (test '("~,,10:@$" 3.2) "+ 3.20") + (test '("~,,10:@$" -3.2) "- 3.20") + (test '("~,,10,'_@$" 3.2) "_____+3.20") + (test '("~,,4$" 1234.4) "1234.40") +)) + +; complex numbers + +(cond + (format:complex-numbers + (test '("~i" 3.0) "3.0+0.0i") + (test '("~,3i" 3.0) "3.000+0.000i") + (test `("~7,2i" ,(string->number "3.0+5.0i")) " 3.00 +5.00i") + (test `("~7,2,1i" ,(string->number "3.0+5.0i")) " 30.00 +50.00i") + (test `("~7,2@i" ,(string->number "3.0+5.0i")) " +3.00 +5.00i") + (test `("~7,2,,,'*@i" ,(string->number "3.0+5.0i")) "**+3.00**+5.00i") + )) ; note: some parsers choke syntactically on reading a complex + ; number though format:complex is #f; this is why we put them in + ; strings + +; inquiry test + +(test '("~:q") format:version) + +(if (not test-verbose) (display "done.")) + +(format #t "~%~a Test~:p completed. (~a failure~:p)~2%" total fails) diff --git a/gambit.init b/gambit.init index 2e8a10d..d50edae 100644 --- a/gambit.init +++ b/gambit.init @@ -3,14 +3,16 @@ ;;; ;;; This code is in the public domain. -;;; Ignore case when reading symbols (per R5RS). -(set-case-conversion! #t) - ;;; Updated 1992 February 1 for Gambit v1.71 -- by Ken Dickey ;;; Date: Wed, 12 Jan 1994 15:03:12 -0500 ;;; From: barnett@armadillo.urich.edu (Lewis Barnett) ;;; Relative pathnames for Slib in MacGambit ;;; Hacked yet again for Gambit v2.4, Jan 1997, by Mike Pope +;;; Updated for Gambit v3.0, 2001-01 AGJ. + +;;; gsi should be invoked with -:s option to Ignore case when reading +;;; symbols (per R5RS). + (define (software-type) 'MACOS) ; for MacGambit. (define (software-type) 'UNIX) ; for Unix platforms. @@ -22,13 +24,11 @@ (define (scheme-implementation-home-page) "http://www.iro.umontreal.ca/~gambit/index.html") -(define (scheme-implementation-version) "3.0") -;;; Jefferson R. Lowrey reports that in Gambit Version 3.0 -;;; (argv) returns '(""). -(define argv - (if (equal? '("") (argv)) ;Fix only if it is broken. - (lambda () '("Lowrey HD:Development:MacGambit 3.0:Interpreter")) - argv)) +(define (scheme-implementation-version) (system-version-string)) + +(define getenv + (let ((ge getenv)) + (lambda (str) (ge str #f)))) ;;; (implementation-vicinity) should be defined to be the pathname of ;;; the directory where any auxillary files to your Scheme @@ -55,85 +55,196 @@ ;;; called slib in the same directory as the MacGambit Interpreter. (define library-vicinity (let ((library-path - (case (software-type) - ((UNIX) "/usr/local/lib/slib/") - ((MACOS) (string-append (implementation-vicinity) "slib:")) - ((AMIGA) "dh0:scm/Library/") - ((VMS) "lib$scheme:") - ((WINDOWS MS-DOS) "C:\\SLIB\\") - (else "")))) + (or + ;; Use this getenv if your implementation supports it. + (getenv "SCHEME_LIBRARY_PATH") + ;; Use this path if your scheme does not support GETENV + ;; or if SCHEME_LIBRARY_PATH is not set. + (case (software-type) + ((UNIX) "/usr/local/lib/slib/") + ((MACOS) (string-append (implementation-vicinity) "slib:")) + ((AMIGA) "dh0:scm/Library/") + ((VMS) "lib$scheme:") + ((WINDOWS MS-DOS) "C:\\SLIB\\") + (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 +(define (home-vicinity) + (let ((home (getenv "HOME"))) + (if home + (case (software-type) + ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) + home + (string-append home "/"))) + (else home)) + (case (software-type) + ((VMS) "~:") + ((WINDOWS) "~/") + ((MACOS) "~:") + (else #f))))) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) (case (software-type) - ((UNIX) (lambda () "~/")) - ((VMS) (lambda () "~:")) - ((MS-DOS) (lambda () "~\\")) - ((WINDOWS) (lambda () "~/")) - ((MACOS) (lambda () "~:")))) - -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") + ;(SLIB:LOAD-SOURCE "filename") compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 + + ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. + +;;; r5rs ;conforms to +;;; eval ;R5RS two-argument eval + values ;R5RS multiple values + dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros + delay ;has DELAY and FORCE + multiarg-apply ;APPLY can take more than 2 args. + char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. + rationalize + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE + r4rs ;conforms to -; r3rs ;conforms to + ieee-p1178 ;conforms to -; srfi ;srfi-0, COND-EXPAND finds all srfi-* - 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!, + +;;; r3rs ;conforms to + +;;; 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-TO-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 -; record ;has user defined data structures -; values ;proposed multiple values -; dynamic-wind ;proposed dynamic-wind - ieee-floating-point ;conforms to +;;; object-hash ;has OBJECT-HASH + full-continuation ;can return multiple times -; object-hash ;has OBJECT-HASH + ieee-floating-point ;conforms to IEEE Standard 754-1985 + ;IEEE Standard for Binary + ;Floating-Point Arithmetic. -; sort + ;; Other common features + + srfi ;srfi-0, COND-EXPAND finds all srfi-* + sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. + defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures + structure ;DEFINE-STRUCTURE macro + string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING +;;; sort pretty-print -; object->string -; format + object->string +;;; format trace ;has macros: TRACE and UNTRACE - break -; compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; compiler ;has (COMPILER) +;;; ed ;(ED) is editor system ;posix (system <string>) -; getenv ;posix (getenv <string>) - program-arguments ;returns list of strings (argv) -; current-time ;returns time in seconds since 1/1/1970 - )) + getenv ;posix (getenv <string>) +;;; program-arguments ;returns list of strings (argv) + current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + + break + + )) + +(define object->limited-string object->string) + +(define (difftime caltime1 caltime0) + (- (time->seconds caltime1) + (if (number? caltime0) caltime0 (time->seconds caltime0)))) +(define (offset-time caltime offset) + (seconds->time (+ (time->seconds caltime) offset))) ;;; (OUTPUT-PORT-WIDTH <port>) -(define (output-port-width . arg) 79) +;; (define (output-port-width . arg) 79) ;;; (OUTPUT-PORT-HEIGHT <port>) (define (output-port-height . arg) 24) @@ -151,27 +262,22 @@ ;;; 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 flush-output) - -;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string -;;; port versions of CALL-WITH-*PUT-FILE. +;;; CALL-WITH-INPUT-STRING is good as is. Gambit's +;;; CALL-WITH-OUTPUT-STRING lengthens the string first argument. +(define call-with-output-string + (let ((cwos call-with-output-string)) + (lambda (proc) (cwos "" proc)))) (define (make-exchanger obj) (lambda (rep) (let ((old obj)) (set! obj rep) old))) -(define (open-file filename modes) - (case modes - ((r rb) (open-input-file filename)) - ((w wb) (open-output-file filename)) - (else (slib:error 'open-file 'mode? modes)))) -(define (port? obj) (or (input-port? port) (output-port? port))) +(define open-file + (let ((open-both open-file)) + (lambda (filename modes) + (case modes + ((r rb) (open-input-file filename)) + ((w wb) (open-output-file filename)) + ((rw rwb) (open-both filename)) + (else (slib:error 'open-file 'mode? modes)))))) (define (call-with-open-ports . ports) (define proc (car ports)) (cond ((procedure? proc) (set! ports (cdr ports))) @@ -181,12 +287,6 @@ (let ((ans (apply proc ports))) (for-each close-port ports) ans)) -(define (close-port port) - (cond ((input-port? port) - (close-input-port port) - (if (output-port? port) (close-output-port port))) - ((output-port? port) (close-output-port port)) - (else (slib:error 'close-port 'port? port)))) (define (browse-url url) (define (try cmd) (eqv? 0 (system (sprintf #f cmd url)))) @@ -215,9 +315,6 @@ ;;; SLIB:EVAL is single argument eval using the top-level (user) environment. (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) @@ -256,18 +353,7 @@ (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))))) +;; slib:eval-load definition moved to "require.scm" (define print-call-stack identity) ;noop @@ -298,10 +384,8 @@ (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. +;;; return if exiting not supported. (define slib:exit (lambda args (exit))) ;;; Here for backward compatability diff --git a/getparam.scm b/getparam.scm index 1e7b7c0..da8ce04 100644 --- a/getparam.scm +++ b/getparam.scm @@ -20,6 +20,7 @@ (require 'getopt) (require 'coerce) (require 'parameters) +(require 'rev4-optional-procedures) ; string-copy (require-if 'compiling 'printf) (require-if 'compiling 'common-list-functions) diff --git a/getparam.txi b/getparam.txi index 3d2594c..58acbaf 100644 --- a/getparam.txi +++ b/getparam.txi @@ -29,6 +29,7 @@ In all cases, if unclaimed arguments remain after processing, a warning is signaled and #f is returned. @end defun + @defun getopt->arglist optnames positions arities types defaulters checks aliases desc @dots{} Like @code{getopt->parameter-list}, but converts @var{*argv*} to an @@ -37,6 +38,7 @@ argument-list as specified by @var{optnames}, @var{positions}, @var{aliases}. If the options supplied violate the @var{arities} or @var{checks} constraints, then a warning is signaled and #f is returned. @end defun + @noindent These @code{getopt} functions can be used with SLIB relational databases. For an example, @xref{Using Databases, make-command-server}. @@ -32,6 +32,7 @@ matched by including it as the first or last character in the set. @end table @end defun + @defun filename:substitute?? pattern template @defunx filename:substitute-ci?? pattern template @@ -53,6 +54,7 @@ the case of a match the result of applying @var{template} to a list of the substrings matched by wildcard specifications will be returned, otherwise @var{template} will not be called and @code{#f} will be returned. @end defun + @example ((filename:substitute?? "scm_[0-9]*.html" "scm5c4_??.htm") "scm_10.html") @@ -74,6 +76,7 @@ otherwise @var{template} will not be called and @code{#f} will be returned. removed and the suffix string @var{new} appended. If the end of @var{str} does not match @var{old}, an error is signaled. @end defun + @example (replace-suffix "/usr/local/lib/slib/batch.scm" ".scm" ".c") @result{} "/usr/local/lib/slib/batch.c" @@ -98,3 +101,4 @@ If @var{proc} returns, then any files named by the arguments to @var{proc} are deleted automatically and the value(s) yielded by the @var{proc} is(are) returned. @end defun + diff --git a/grapheps.ps b/grapheps.ps index 87658dd..95f200e 100644 --- a/grapheps.ps +++ b/grapheps.ps @@ -1,7 +1,9 @@ -%%EndComments /plotdict 100 dict def plotdict begin +% Get dimensions the preamble left on the stack. +4 array astore /whole-page exch def + % Definitions so that internal assignments are bound before setting. /DATA 0 def /DEN 0 def @@ -68,8 +70,11 @@ plotdict begin {lineto} {currentpoint pop topedge lineto closepath fill}] bind def % Render lines from x-axis to points -/impulse [{} {moveto currentpoint pop 0 lineto} {}] bind def -/bargraph [{} {exch GR sub exch 0 exch GD exch rectstroke} {}] bind def +/impulse [{} {moveto XRNG 0 get 0 gtrans exch pop + currentpoint pop exch lineto} {}] bind def +/bargraph [{} {exch GR sub exch dup + XRNG 0 get 0 gtrans exch pop % y=0 + exch sub GD exch rectstroke} {}] bind def % Solid round dot. /disc [{GD setlinewidth 1 setlinecap} @@ -97,14 +102,14 @@ plotdict begin {}] bind def % Triangle pointing upward /triup [{} - {2 copy GR 1.12 mul add moveto GR neg GR -1.62 mul rlineto - GR 2 mul 0 rlineto GR neg GR 1.62 mul rlineto + {GR 1.12 mul add moveto GR neg GR -1.62 mul rlineto + GR 2 mul 0 rlineto GR neg GR 1.62 mul rlineto closepath} {}] bind def % Triangle pointing downward /tridown [{} - {2 copy GR 1.12 mul sub moveto GR neg GR 1.62 mul rlineto - GR 2 mul 0 rlineto GR neg GR -1.62 mul rlineto + {GR 1.12 mul sub moveto GR neg GR 1.62 mul rlineto + GR 2 mul 0 rlineto GR neg GR -1.62 mul rlineto closepath} {}] bind def /pentagon [{} @@ -148,9 +153,6 @@ plotdict begin grestore } bind def -/whole-page -{clippath pathbbox 2 index sub exch 3 index sub exch 4 array astore} bind def - /partition-page { /YPARTS exch def /XPARTS exch def /WPAGE exch def /XWID WPAGE 2 get XPARTS div def /YHIT WPAGE 3 get YPARTS div def @@ -172,8 +174,8 @@ plotdict begin { /YRNG exch def /XRNG exch def /graphrect exch def /PLOT-bmargin pointsize 2.4 mul def /PLOT-tmargin pointsize 2.4 mul def - /PLOT-lmargin (-.0123456789) stringwidth pop pointsize 1.2 mul add def - /PLOT-rmargin (-.0123456789) stringwidth pop pointsize 1.2 mul add def + /PLOT-lmargin lmargin-template stringwidth pop pointsize 1.2 mul add def + /PLOT-rmargin rmargin-template stringwidth pop pointsize 1.2 mul add def /plotrect [ graphrect 0 get PLOT-lmargin add graphrect 1 get PLOT-bmargin add graphrect 2 get PLOT-lmargin sub PLOT-rmargin sub @@ -186,7 +188,7 @@ plotdict begin /YTSCL plotrect 3 get YRNG aload pop exch sub find-tick-scale def /YSTEP YTSCL 0 get 3 mod 0 eq {6} {8} ifelse 5 mul yuntrans def /XTSCL plotrect 2 get XRNG aload pop exch sub find-tick-scale def - /XSTEP XTSCL 0 get 3 mod 0 eq {6} {8} ifelse 10 mul xuntrans def + /XSTEP XTSCL 0 get 3 mod 0 eq {12} {10} ifelse 5 mul xuntrans def /YSTEPH YSTEP 2 div def /XSTEPH XSTEP 2 div def } bind def @@ -329,8 +331,16 @@ bind def /fill-rect {aload pop rectfill} bind def /clip-to-rect {aload pop rectclip} bind def +/gstack [] def +/gpush {gsave /gstack [ gstack pointsize glyphsize ] def} bind def +/gpop {/gstack gstack aload pop /glyphsize exch def /pointsize exch def def grestore} bind def + % Default parameters +% The legend-templates are strings used to reserve horizontal space +/lmargin-template (-.0123456789) def +/rmargin-template (-.0123456789) def + % glyphsize is the graphic-glyph size; GR, graphic radius, is % glyphsize/2. Line width, set by "setlinewidth", must be much less % than glyphsize for readable glyphs. diff --git a/grapheps.scm b/grapheps.scm index 0f11a6d..677ae34 100644 --- a/grapheps.scm +++ b/grapheps.scm @@ -30,7 +30,7 @@ ;;@noindent ;;This is a graphing package creating encapsulated-PostScript files. ;;Its motivations and design choice are described in -;;@url{http://swissnet.ai.mit.edu/~jaffer/Docupage/grapheps} +;;@url{http://swiss.csail.mit.edu/~jaffer/Docupage/grapheps} ;; ;;@noindent ;;A dataset to be plotted is taken from a 2-dimensional array. @@ -91,6 +91,8 @@ (write-line "%!PS-Adobe-3.0 EPSF-3.0" oprt) (write-line (scheme->ps "%%BoundingBox: 0 0 " xsize " " ysize) oprt) (write-line (scheme->ps "%%Title: " (or *plot-title* filename)) oprt) + (write-line (scheme->ps "%%EndComments: ") oprt) + (write-line (scheme->ps "0 0 " xsize " " ysize) oprt) (call-with-input-file (in-vicinity (library-vicinity) "grapheps.ps") (lambda (iprt) (do ((line (read-line iprt) (read-line iprt))) @@ -107,7 +109,7 @@ (set! *plot-arrays* '()))) (define (write-array-def name array oprt) - (define row-length (+ 1 (cadadr (array-shape array)))) + (define row-length (cadr (array-dimensions array))) (define idx 0) (set! idx row-length) (write-line (scheme->ps "/" name) oprt) @@ -145,10 +147,10 @@ (define (whole-page) 'whole-page) ;;@menu -;;* Column Ranges:: -;;* Drawing the Graph:: -;;* Graphics Context:: -;;* Rectangles:: +;;* Column Ranges:: +;;* Drawing the Graph:: +;;* Graphics Context:: +;;* Rectangles:: ;;* Legending:: ;;* Legacy Plotting:: ;;* Example Graph:: @@ -264,9 +266,7 @@ ;;Saves the current graphics state, executes @1, then restores ;;to saved graphics state. (define (in-graphic-context . args) - (append '("gsave pointsize glyphsize") - args - '("/glyphsize exch def /pointsize exch def grestore"))) + (append '("gpush") args '("gpop"))) ;;@args color ;;@1 should be a string naming a Resene color, a saturate color, or a @@ -301,7 +301,7 @@ ;;@0 Changes the current PostScript font to @1 with height equal to ;;@2. The default font is Helvetica (12pt). (define (set-font name fontheight) - (scheme->ps "/pointsize " fontheight " def /" name " pointsize selectfont")) + (scheme->ps "/fontsize " fontheight " def /" name " fontsize selectfont")) ;;@noindent ;;The base set of PostScript fonts is: @@ -420,6 +420,14 @@ (define rightedge 'rightedge) ;;@body +;;The margin-templates are strings whose displayed width is used to +;;reserve space for the left and right side numerical legends. +;;The default values are "-.0123456789". +(define (set-margin-templates left right) + (scheme->ps "/lmargin-template (" left ") def " + "/rmargin-template (" right ") def")) + +;;@body ;;Draws a vertical ruler with X coordinate @1 and labeled with string ;;@2. If @3 is positive, then the ticks are @3 long on the right side ;;of @1; and @2 and numeric legends are on the left. If @3 is @@ -459,7 +467,7 @@ (set! histogram? (if (null? histogram?) #f (car histogram?))) (if (list? data) (let ((len (length data)) - (nra (create-array (Ar64) (length data) 2))) + (nra (make-array (A:floR64b) (length data) 2))) (do ((idx 0 (+ 1 idx)) (lst data (cdr lst))) ((>= idx len) @@ -478,7 +486,7 @@ (define (graph:plot-function tmp func vlo vhi . npts) (set! npts (if (null? npts) 200 (car npts))) - (let ((dats (create-array (Ar64) npts 2))) + (let ((dats (make-array (A:floR64b) npts 2))) (array-index-map! (make-shared-array dats (lambda (idx) (list idx 0)) npts) (lambda (idx) (+ vlo (* (- vhi vlo) (/ idx (+ -1 npts)))))) @@ -570,7 +578,7 @@ ;; (define lines '()) ;; (do ((line (read-line iprt) (read-line iprt))) ;; ((eof-object? line) -;; (let ((nra (create-array (Ar64) +;; (let ((nra (make-array (A:floR64b) ;; (length lines) ;; (length (car lines))))) ;; (do ((lns lines (cdr lns)) diff --git a/grapheps.txi b/grapheps.txi index d587107..b0acc81 100644 --- a/grapheps.txi +++ b/grapheps.txi @@ -3,7 +3,7 @@ @noindent This is a graphing package creating encapsulated-PostScript files. Its motivations and design choice are described in -@url{http://swissnet.ai.mit.edu/~jaffer/Docupage/grapheps} +@url{http://swiss.csail.mit.edu/~jaffer/Docupage/grapheps} @noindent A dataset to be plotted is taken from a 2-dimensional array. @@ -26,6 +26,7 @@ of two integers, they specify the width and height. If one integer, then that integer is the width and the height is 3/4 of the width. If #f, the graph will be 800 by 600. @end defun + @noindent These graphing procedures should be called as arguments to @code{create-postscript-graph}. The order of these arguments is @@ -39,11 +40,12 @@ Pushes a rectangle for the whole encapsulated page onto the PostScript stack. This pushed rectangle is an implicit argument to @code{partition-page} or @code{setup-plot}. @end defun + @menu -* Column Ranges:: -* Drawing the Graph:: -* Graphics Context:: -* Rectangles:: +* Column Ranges:: +* Drawing the Graph:: +* Graphics Context:: +* Rectangles:: * Legending:: * Legacy Plotting:: * Example Graph:: @@ -65,21 +67,25 @@ Ranges can be given explicity or computed in PostScript by Returns the range of values in 2-dimensional @var{array} column @var{k}. @end defun + @defun pad-range range p Expands @var{range} by @var{p}/100 on each end. @end defun + @defun snap-range range Expands @var{range} to round number of ticks. @end defun + @defun combine-ranges range1 range2 @dots{} Returns the minimal range covering all @var{range1}, @var{range2}, ... @end defun + @defun setup-plot x-range y-range pagerect @@ -100,6 +106,7 @@ The region where data points will be plotted. The @var{pagerect} argument to @code{setup-plot}. Includes plotrect, legends, etc. @end table @end defun + @node Drawing the Graph, Graphics Context, Column Ranges, PostScript Graphing @subsubsection Drawing the Graph @@ -110,6 +117,7 @@ Plots points with x coordinate in @var{x-column} of @var{array} and y coordinate @var{array}. The symbol @var{proc3s} specifies the type of glyph or drawing style for presenting these coordinates. @end defun + @noindent The glyphs and drawing styles available are: @@ -156,6 +164,7 @@ Saves the current graphics state, executes @var{args}, then restores to saved graphics state. @end defun + @defun set-color color @var{color} should be a string naming a Resene color, a saturate color, or a @@ -165,6 +174,7 @@ number between 0 and 100. grey value between black (0) and white (100). @end defun + @defun set-font name fontheight @var{name} should be a (case-sensitive) string naming a PostScript font. @@ -173,6 +183,7 @@ grey value between black (0) and white (100). @code{set-font} Changes the current PostScript font to @var{name} with height equal to @var{fontheight}. The default font is Helvetica (12pt). @end defun + @noindent The base set of PostScript fonts is: @@ -194,6 +205,7 @@ as skinny as possible. Linewidth must be much smaller than glyphsize for readable glyphs. @end defun + @defun set-linedash j k Lines are drawn @var{j}-on @var{k}-off. @@ -205,11 +217,13 @@ Lines are drawn @var{j}-on @var{j}-off. Turns off dashing. @end defun + @defun set-glyphsize w Sets the (PostScript) variable glyphsize to @var{w}. The default glyphsize is 6. @end defun + @noindent The effects of @code{clip-to-rect} are also part of the graphic context. @@ -231,6 +245,7 @@ PostScript stack. This pushed rectangle is an implicit argument to @code{partition-page} or @code{setup-plot}. @end defun + @defun partition-page xparts yparts Pops the rectangle currently on top of the stack and pushes @var{xparts} * @var{yparts} @@ -238,6 +253,7 @@ sub-rectangles onto the stack in decreasing y and increasing x order. If you are drawing just one graph, then you don't need @code{partition-page}. @end defun + @defvar plotrect The rectangle where data points should be plotted. @var{plotrect} is set by @@ -255,17 +271,20 @@ The @var{pagerect} argument of the most recent call to fills @var{rect} with the current color. @end defun + @defun outline-rect rect Draws the perimiter of @var{rect} in the current color. @end defun + @defun clip-to-rect rect Modifies the current graphics-state so that nothing will be drawn outside of the rectangle @var{rect}. Use @code{in-graphic-context} to limit the extent of @code{clip-to-rect}. @end defun + @node Legending, Legacy Plotting, Rectangles, PostScript Graphing @subsubsection Legending @@ -277,6 +296,7 @@ the extent of @code{clip-to-rect}. Puts a @var{title} line and an optional @var{subtitle} line above the @code{graphrect}. @end defun + @defun title-bottom title subtitle @@ -284,6 +304,7 @@ Puts a @var{title} line and an optional @var{subtitle} line above the @code{grap Puts a @var{title} line and an optional @var{subtitle} line below the @code{graphrect}. @end defun + @defvar topedge @defvarx bottomedge @@ -298,6 +319,14 @@ These edge coordinates of @code{graphrect} are suitable for passing as the first argument to @code{rule-vertical}. @end defvar +@defun set-margin-templates left right + +The margin-templates are strings whose displayed width is used to +reserve space for the left and right side numerical legends. +The default values are "-.0123456789". +@end defun + + @defun rule-vertical x-coord text tick-width Draws a vertical ruler with X coordinate @var{x-coord} and labeled with string @@ -307,6 +336,7 @@ negative, then the ticks are -@var{tick-width} long on the left side of @var{x-c and numeric legends are on the right. @end defun + @defun rule-horizontal x-coord text tick-height Draws a horizontal ruler with X coordinate @var{x-coord} and labeled with @@ -316,27 +346,32 @@ is negative, then the ticks are -@var{tick-height} long on the left side of @var @var{text} and numeric legends are on the right. @end defun + @defun y-axis Draws the y-axis. @end defun + @defun x-axis Draws the x-axis. @end defun + @defun grid-verticals Draws vertical lines through @code{graphrect} at each tick on the vertical ruler. @end defun + @defun grid-horizontals Draws horizontal lines through @code{graphrect} at each tick on the horizontal ruler. @end defun + @node Legacy Plotting, Example Graph, Legending, PostScript Graphing @subsubsection Legacy Plotting @@ -361,6 +396,7 @@ supplied, it specifies the number of points to evaluate @var{func} at. coordinates. @var{x-label} and @var{y-label} are strings with which to label the x and y axes. @end defun + @node Example Graph, , Legacy Plotting, PostScript Graphing @subsubsection Example Graph @@ -418,7 +454,7 @@ disambiguate the scales. (define lines '()) (do ((line (read-line iprt) (read-line iprt))) ((eof-object? line) - (let ((nra (create-array (Ar64) + (let ((nra (make-array (A:floR64b) (length lines) (length (car lines))))) (do ((lns lines (cdr lns)) @@ -22,7 +22,10 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'unix) +(define software-type + (if (string<? (version) "1.6") + (lambda () 'UNIX) + (lambda () 'unix))) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -38,8 +41,6 @@ ;;; the version the scheme implementation loading this file. (define scheme-implementation-version version) -(define in-vicinity string-append) - ;;; (implementation-vicinity) should be defined to be the pathname of ;;; the directory where any auxillary files to your Scheme ;;; implementation reside. @@ -73,72 +74,155 @@ home (string-append home "/"))) (else home))))) - -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) + (else + (warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +;@ +(define (program-vicinity) + (define clp (current-load-port)) + (if clp + (pathname->vicinity (port-filename clp)) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old program-vicinity)) + (set! program-vicinity new) + old)))) + (lambda (path thunk) + (define old #f) + (define vic (pathname->vicinity path)) + (dynamic-wind + (lambda () (set! old (exchange (lambda () vic)))) + thunk + (lambda () (exchange old)))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* (append '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to +;;; r5rs ;conforms to eval ;R5RS two-argument eval -; values ;R5RS multiple values + values ;R5RS multiple values dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. -; rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! +;;; char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! -; r4rs ;conforms to + ;; These four features are optional in both R4RS and R5RS -; ieee-p1178 ;conforms to + multiarg/and- ;/ and - can take more than 2 args. +;;; rationalize +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE + +;;; r4rs ;conforms to -; r3rs ;conforms to +;;; ieee-p1178 ;conforms to + +;;; r3rs ;conforms to rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; ieee-floating-point ;conforms to IEEE Standard 754-1985 + full-continuation ;can return multiple times +;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort -; pretty-print -; object->string -; format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor - random +;;; sort +;;; pretty-print +;;; object->string +;;; format ;Common-lisp output formatting +;;; 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) +;;; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + + logical + random ;Random numbers + ) (if (defined? 'getenv) @@ -178,6 +262,21 @@ ;; (let ((port (current-output-port))) ;; (lambda () port))) +;; If the program is killed by a signal, /bin/sh normally gives an +;; exit code of 128+signum. If /bin/sh itself is killed by a signal +;; then we do the same 128+signum here. +;; +;; "status:stop-sig" shouldn't arise here, since system shouldn't be +;; calling waitpid with WUNTRACED, but allow for it anyway, just in +;; case. +(define system + (let ((guile-core-system system)) + (lambda (str) + (define st (guile-core-system str)) + (or (status:exit-val st) + (+ 128 (or (status:term-sig st) + (status:stop-sig st))))))) + ;;; (TMPNAM) makes a temporary file name. ;;(define tmpnam (let ((cntr 100)) ;; (lambda () (set! cntr (+ 1 cntr)) @@ -188,6 +287,12 @@ ;;; (DELETE-FILE <string>) ;;(define (delete-file f) #f) +(define delete-file + (let ((guile-core-delete-file delete-file)) + (lambda (filename) + (catch 'system-error + (lambda () (guile-core-delete-file filename) #t) + (lambda args #f))))) ;;; FORCE-OUTPUT flushes any pending output on optional arg output port ;;; use this definition if your system doesn't have such a procedure. @@ -198,7 +303,13 @@ (define (make-exchanger obj) (lambda (rep) (let ((old obj)) (set! obj rep) old))) - +(define open-file + (let ((guile-core-open-file open-file)) + (lambda (filename modes) + (guile-core-open-file filename + (if (symbol? modes) + (symbol->string modes) + modes))))) (define (port? obj) (or (input-port? obj) (output-port? obj))) (define (call-with-open-ports . ports) (define proc (car ports)) @@ -234,9 +345,10 @@ (let ((ie (interaction-environment))) (lambda (expression) (eval expression ie))))) +;; slib:eval-load definition moved to "require.scm" ;;; Define SLIB:EXIT to be the implementation procedure to exit or -;;; return if exitting not supported. +;;; return if exiting not supported. (define slib:exit quit) ;;; Here for backward compatability @@ -246,18 +358,6 @@ ;; (else ".scm")))) ;; (lambda () suffix))) -(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 (guile:wrap-case-insensitive proc) (lambda args (save-module-excursion @@ -307,75 +407,97 @@ (define offset-time +) ;;; Early version of 'logical is built-in -(define logical:logand logand) -(define logical:logior logior) -;;(define logical:logxor logxor) -;;(define logical:lognot lognot) -;;(define logical:logtest logtest) -;;(define logical:logbit? logbit?) (define (copy-bit index to bool) (if bool - (logical:logior to (logical:ash 1 index)) - (logical:logand to (logical:lognot (logical:ash 1 index))))) -;;(define copy-bit logical:copy-bit) -;;(define logical:ash ash) -;;(define logical:logcount logcount) -;;(define logical:integer-length integer-length) -(define (logical:bit-field n start end) - (logical:logand (- (logical:integer-expt 2 (- end start)) 1) - (logical:ash n (- start)))) -;;(define bit-field logical:bit-field) + (logior to (arithmetic-shift 1 index)) + (logand to (lognot (arithmetic-shift 1 index))))) +(define (bit-field n start end) + (logand (- (expt 2 (- end start)) 1) + (arithmetic-shift n (- start)))) (define (bitwise-if mask n0 n1) - (logical:logior (logical:logand mask n0) - (logical:logand (logical:lognot mask) n1))) -(define logical:bitwise-if bitwise-if) -;;(define logical:bit-extract bit-extract) -(define (copy-bit-field to start end from) - (logical:bitwise-if - (logical:ash (- (logical:integer-expt 2 (- end start)) 1) start) - (logical:ash from start) - to)) -;;(define copy-bit-field logical:copy-bit-field) -(define logical:integer-expt integer-expt) -;;(define logical:ipow-by-squaring ipow-by-squaring) - -;;guile> (expt 2 -1) -;;ERROR: In procedure integer-expt: -;;ERROR: Argument out of range: -1 -;;ABORT: (out-of-range) -(define expt - (let ((integer-expt integer-expt)) - (lambda (z1 z2) - (cond ((zero? z1) (if (zero? z2) 1 0)) - ((and (exact? z2) (not (negative? z2))) - (integer-expt z1 z2)) - ((and (real? z2) (real? z1) (>= z1 0)) - ($expt z1 z2)) - (else - (exp (* z2 (log z1)))))))) + (logior (logand mask n0) + (logand (lognot mask) n1))) +(define (copy-bit-field to from start end) + (bitwise-if (arithmetic-shift (lognot (ash -1 (- end start))) start) + (arithmetic-shift from start) + to)) +(define (rotate-bit-field n count start end) + (define width (- end start)) + (set! count (modulo count width)) + (let ((mask (lognot (ash -1 width)))) + (define azn (logand mask (arithmetic-shift n (- start)))) + (logior (arithmetic-shift + (logior (logand mask (arithmetic-shift azn count)) + (arithmetic-shift azn (- count width))) + start) + (logand (lognot (ash mask start)) n)))) +(define (log2-binary-factors n) + (+ -1 (integer-length (logand n (- n))))) +(define (bit-reverse k n) + (do ((m (if (negative? n) (lognot n) n) (arithmetic-shift m -1)) + (k (+ -1 k) (+ -1 k)) + (rvs 0 (logior (arithmetic-shift rvs 1) (logand 1 m)))) + ((negative? k) (if (negative? n) (lognot rvs) rvs)))) +(define (reverse-bit-field n start end) + (define width (- end start)) + (let ((mask (lognot (ash -1 width)))) + (define zn (logand mask (arithmetic-shift n (- start)))) + (logior (arithmetic-shift (bit-reverse width zn) start) + (logand (lognot (ash mask start)) n)))) + +(define (integer->list k . len) + (if (null? len) + (do ((k k (arithmetic-shift k -1)) + (lst '() (cons (odd? k) lst))) + ((<= k 0) lst)) + (do ((idx (+ -1 (car len)) (+ -1 idx)) + (k k (arithmetic-shift k -1)) + (lst '() (cons (odd? k) lst))) + ((negative? idx) lst)))) +(define (list->integer bools) + (do ((bs bools (cdr bs)) + (acc 0 (+ acc acc (if (car bs) 1 0)))) + ((null? bs) acc))) +(define (booleans->integer . bools) + (list->integer bools)) + +;;;; SRFI-60 aliases +(define arithmetic-shift ash) +(define bitwise-ior logior) +(define bitwise-xor logxor) +(define bitwise-and logand) +(define bitwise-not lognot) +(define bit-count logcount) +(define bit-set? logbit?) +(define any-bits-set? logtest) +(define first-set-bit log2-binary-factors) +(define bitwise-merge bitwise-if) ;;; array-for-each (define (array-indexes ra) - (let ((ra0 (apply create-array '#() (array-shape ra)))) + (let ((ra0 (apply make-array '#() (array-shape ra)))) (array-index-map! ra0 list) ra0)) -(define (array-copy! source dest) +(define (array:copy! dest source) (array-map! dest identity source)) (define (array-null? array) (zero? (apply * (map (lambda (bnd) (- 1 (apply - bnd))) (array-shape array))))) -(define (create-array prot . args) +;; DIMENSIONS->UNIFORM-ARRAY and list->uniform-array in Guile-1.6.4 +;; cannot make empty arrays. +(define (make-array prot . args) (if (array-null? prot) (dimensions->uniform-array args (array-prototype prot)) (dimensions->uniform-array args (array-prototype prot) (apply array-ref prot (map car (array-shape prot)))))) +(define create-array make-array) (define (make-uniform-wrapper prot) (if (string? prot) (set! prot (string->number prot))) (if prot (lambda opt (if (null? opt) - (list->uniform-array 1 prot '()) - (list->uniform-array 1 prot opt))) + (list->uniform-array 1 prot (list prot)) + (list->uniform-array 0 prot opt))) vector)) (define ac64 (make-uniform-wrapper "+i")) (define ac32 ac64) @@ -391,6 +513,56 @@ (define au8 au32) (define at1 (make-uniform-wrapper #t)) +;;; New SRFI-58 names +;; flonums +(define A:floC128b ac64) +(define A:floC64b ac64) +(define A:floC32b ac32) +(define A:floC16b ac32) +(define A:floR128b ar64) +(define A:floR64b ar64) +(define A:floR32b ar32) +(define A:floR16b ar32) +;; decimal flonums +(define A:flor128d ar64) +(define A:flor64d ar64) +(define A:flor32d ar32) +;; fixnums +(define A:fixZ64b as64) +(define A:fixZ32b as32) +(define A:fixZ16b as16) +(define A:fixZ8b as8) +(define A:fixN64b au64) +(define A:fixN32b au32) +(define A:fixN16b au16) +(define A:fixN8b au8) +(define A:bool at1) + +;;; And case-insensitive versions +;; flonums +(define a:floc128b ac64) +(define a:floc64b ac64) +(define a:floc32b ac32) +(define a:floc16b ac32) +(define a:flor128b ar64) +(define a:flor64b ar64) +(define a:flor32b ar32) +(define a:flor16b ar32) +;; decimal flonums +(define a:flor128d ar64) +(define a:flor64d ar64) +(define a:flor32d ar32) +;; fixnums +(define a:fixz64b as64) +(define a:fixz32b as32) +(define a:fixz16b as16) +(define a:fixz8b as8) +(define a:fixn64b au64) +(define a:fixn32b au32) +(define a:fixn16b au16) +(define a:fixn8b au8) +(define a:bool at1) + ;;; {Random numbers} (define (make-random-state . args) (let ((seed (if (null? args) *random-state* (car args)))) @@ -400,19 +572,27 @@ (require 'object->string) (set! seed (object->limited-string seed 50))))) (seed->random-state seed))) +(if (not (defined? 'random:chunk)) + (define (random:chunk sta) (random 256 sta))) ;;; 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)) ;;; Guile has nil and t as self-sets -;;(define t #t) -;;(define nil #f) +(define t #t) +(define nil #f) ;;; Define these if your implementation's syntax can support it and if ;;; they are not already defined. - -;;(define (1+ n) (+ n 1)) -;;(define (-1+ n) (+ n -1)) -;;(define 1- -1+) +(define (1+ n) (+ n 1)) +(define (-1+ n) (+ n -1)) +(define 1- -1+) + +;;; rev2-procedures +(define <? <) +(define <=? <=) +(define =? =) +(define >? >) +(define >=? >=) (slib:load (in-vicinity (library-vicinity) "require")) @@ -1,5 +1,5 @@ ; "hash.scm", hashing functions for Scheme. -; Copyright (c) 1992, 1993, 1995, 2003 Aubrey Jaffer +; Copyright (C) 1992, 1993, 1995, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -96,52 +96,20 @@ ((input-port? obj) 260) ((output-port? obj) 261) ((procedure? obj) 262) - ((and (provided? 'RECORD) (record? obj)) - (let* ((rtd (record-type-descriptor obj)) - (fns (record-type-field-names rtd)) - (len (length fns))) - (if (> len 5) - (let lp ((h (modulo 266 n)) (i (quotient d 2))) - (if (positive? i) - (lp (modulo - (+ (* h 256) - (hs 2 ((record-accessor - rtd (list-ref fns (modulo h len))) - obj))) - n) - (- i 1)) - h)) - (let loop ((h (- n 1)) (i (- len 1))) - (if (>= i 0) - (loop (modulo - (+ (* h 256) - (hs (quotient d len) - ((record-accessor - rtd (list-ref fns (modulo h len))) - obj))) - n) - (- i 1)) - h))))) (else 263)) n))))) (define hash:hash hash) ;;; Object-hash is somewhat expensive on copying GC systems (like -;;; PC-Scheme and MITScheme). We use it only on strings, pairs, -;;; vectors, and records. This also allows us to use it for both -;;; hashq and hashv. +;;; PC-Scheme and MITScheme). We use it only on strings, pairs, and +;;; vectors. This also allows us to use it for both hashq and hashv. ;@ (define hashv (if (provided? 'object-hash) - (if (provided? 'record) - (lambda (obj k) - (if (or (string? obj) (pair? obj) (vector? obj) (record? obj)) - (modulo (object-hash obj) k) - (hash:hash obj k))) - (lambda (obj k) - (if (or (string? obj) (pair? obj) (vector? obj)) - (modulo (object-hash obj) k) - (hash:hash obj k)))) + (lambda (obj k) + (if (or (string? obj) (pair? obj) (vector? obj)) + (modulo (object-hash obj) k) + (hash:hash obj k))) hash)) (define hashq hashv) diff --git a/hashtab.scm b/hashtab.scm index 6656ca4..a42e473 100644 --- a/hashtab.scm +++ b/hashtab.scm @@ -1,5 +1,5 @@ ; "hashtab.scm", hash tables for Scheme. -; Copyright (c) 1992, 1993, 2003 Aubrey Jaffer +; Copyright (C) 1992, 1993, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is diff --git a/hashtab.txi b/hashtab.txi index b2a7a0e..572b452 100644 --- a/hashtab.txi +++ b/hashtab.txi @@ -10,6 +10,7 @@ Returns a hash function (like @code{hashq}, @code{hashv}, or @code{char=?}, @code{char-ci=?}, @code{string=?}, or @code{string-ci=?}. @end defun + @noindent A hash table is a vector of association lists. @@ -18,6 +19,7 @@ A hash table is a vector of association lists. Returns a vector of @var{k} empty (association) lists. @end defun + @noindent Hash table functions provide utilities for an associative database. These functions take an equality predicate, @var{pred}, as an argument. @@ -35,6 +37,7 @@ argument or @code{#f} if no key in @var{hashtab} is @var{pred}-equal to the first argument. @end defun + @defun hash-inquirer pred Returns a procedure of 2 arguments, @var{hashtab} and @var{key}, which @@ -42,6 +45,7 @@ returns the value associated with @var{key} in @var{hashtab} or @code{#f} if @var{key} does not appear in @var{hashtab}. @end defun + @defun hash-associator pred Returns a procedure of 3 arguments, @var{hashtab}, @var{key}, and @@ -50,6 +54,7 @@ Returns a procedure of 3 arguments, @var{hashtab}, @var{key}, and will be lost. @end defun + @defun hash-remover pred Returns a procedure of 2 arguments, @var{hashtab} and @var{key}, which @@ -57,6 +62,7 @@ modifies @var{hashtab} so that the association whose key is @var{key} is removed. @end defun + @defun hash-map proc hash-table Returns a new hash table formed by mapping @var{proc} over the @@ -64,6 +70,7 @@ keys and values of @var{hash-table}. @var{proc} must be a function of 2 arguments which returns the new value part. @end defun + @defun hash-for-each proc hash-table Applies @var{proc} to each pair of keys and values of @var{hash-table}. @@ -71,6 +78,7 @@ Applies @var{proc} to each pair of keys and values of @var{hash-table}. unspecified. @end defun + @defun hash-rehasher pred @code{hash-rehasher} accepts a hash table predicate and returns a function of two @@ -82,3 +90,4 @@ This function is used for nondestrutively resizing a hash table. is the size of a new hash table to be returned. The new hash table will have all of the associations of the old hash table. @end defun + diff --git a/html4each.scm b/html4each.scm index 02e666e..f115616 100644 --- a/html4each.scm +++ b/html4each.scm @@ -225,16 +225,28 @@ (reverse fields)) ((eqv? #\> chr) (cons element (reverse fields))) ((char-whitespace? chr) (read-char port) (loop (peek-char port))) - ((case (fscanf port "%[a-zA-Z0-9]%[=]%[-.a-zA-Z0-9]" name junk value) + ((case (fscanf port "%[a-zA-Z0-9]%[=]%[-.a-zA-Z0-9]" + name junk value) ((3 1) #t) ((2) (case (peek-char port) - ((#\") (eqv? 1 (fscanf port "\"%[^\"]\"" value))) - ((#\') (eqv? 1 (fscanf port "'%[^']'" value))) + ((#\") (cond ((eqv? 1 (fscanf port "\"%[^\"]\"" value))) + ((eqv? #\" (peek-char port)) + (read-char port) + (set! value "")) + (else #f))) + ((#\') (cond ((eqv? 1 (fscanf port "'%[^']'" value))) + ((eqv? #\' (peek-char port)) + (read-char port) + (set! value "")) + (else #f))) (else #f))) (else #f)) (set! fields (cons (cons (string-ci->symbol name) - (or (string->number value) value)) + (if (string? value) + (or (string->number value) value) + value)) fields)) (loop (peek-char port))) - (else (slib:warn 'htm-fields 'bad 'field htm) (reverse fields)))))))) + (else (slib:warn 'htm-fields 'bad 'field htm) + (reverse fields)))))))) diff --git a/html4each.txi b/html4each.txi index d331b25..0c47227 100644 --- a/html4each.txi +++ b/html4each.txi @@ -42,6 +42,7 @@ markup or comment}. @code{html-for-each} returns an unspecified value. @end defun + @defun html:read-title file limit @@ -58,6 +59,7 @@ character read from @var{file} is not @samp{#\<}, or if the end of title is not found within the first (approximately) @var{limit} words. @end defun + @defun htm-fields htm @var{htm} is a hypertext markup string. @@ -68,3 +70,4 @@ Otherwise @code{htm-fields} returns the hypertext element symbol (created by attribute name-symbols and values. Each value is a number or string; or #t if the name had no value assigned within the markup. @end defun + diff --git a/htmlform.scm b/htmlform.scm index d659aeb..143eccc 100644 --- a/htmlform.scm +++ b/htmlform.scm @@ -80,11 +80,11 @@ ;;displaying the page with this tag, Netscape or IE browsers will fetch ;;and display @2. Otherwise, @1 seconds after displaying the page with ;;this tag, Netscape or IE browsers will fetch and redisplay this page. -(define (html:meta-refresh delay . uri) +(define (html:meta-refresh dly . uri) (if (null? uri) - (sprintf #f "\\n<META HTTP-EQUIV=\"Refresh\" CONTENT=\"%d\">" delay) + (sprintf #f "\\n<META HTTP-EQUIV=\"Refresh\" CONTENT=\"%d\">" dly) (sprintf #f "\\n<META HTTP-EQUIV=\"Refresh\" CONTENT=\"%d;URL=%s\">" - delay (car uri)))) + dly (car uri)))) ;;@args title backlink tags ... ;;@args title backlink @@ -102,7 +102,7 @@ (sprintf #f "<HTML>\\n") (sprintf #f "%s" (html:comment "HTML by SLIB" - "http://swissnet.ai.mit.edu/~jaffer/SLIB")) + "http://swiss.csail.mit.edu/~jaffer/SLIB")) (sprintf #f " <HEAD>\\n <TITLE>%s</TITLE>\\n %s\\n </HEAD>\\n" (html:plain title) (apply string-append args)) (if (and backlink (substring-ci? "<H1>" backlink)) diff --git a/htmlform.txi b/htmlform.txi index e960984..77704ff 100644 --- a/htmlform.txi +++ b/htmlform.txi @@ -8,12 +8,14 @@ send @var{txt} as an @dfn{attribute-value}. @cindex attribute-value @end defun + @defun html:plain txt Returns a string with character substitutions appropriate to send @var{txt} as an @dfn{plain-text}. @cindex plain-text @end defun + @defun html:meta name content Returns a tag of meta-information suitable for passing as the third argument to @code{html:head}. The tag produced is @samp{<META @@ -22,6 +24,7 @@ NAME="@var{name}" CONTENT="@var{content}">}. The string or symbol @var{name} ca @samp{date}, @samp{robots}, @dots{}. @end defun + @defun html:http-equiv name content Returns a tag of HTTP information suitable for passing as the third argument to @code{html:head}. The tag produced is @samp{<META @@ -30,6 +33,7 @@ HTTP-EQUIV="@var{name}" CONTENT="@var{content}">}. The string or symbol @var{na @samp{Refresh}, @dots{}. @end defun + @defun html:meta-refresh delay uri @@ -42,6 +46,7 @@ and display @var{uri}. Otherwise, @var{delay} seconds after displaying the page this tag, Netscape or IE browsers will fetch and redisplay this page. @end defun + @defun html:head title backlink tags @dots{} @@ -55,10 +60,12 @@ used. If string arguments @var{tags} ... are supplied, then they are included verbatim within the @t{<HEAD>} section. @end defun + @defun html:body body @dots{} Returns HTML string to end a page. @end defun + @defun html:pre line1 line @dots{} Returns the strings @var{line1}, @var{lines} as @dfn{PRE}formmated plain text @cindex PRE @@ -66,9 +73,11 @@ Returns the strings @var{line1}, @var{lines} as @dfn{PRE}formmated plain text @var{lines}. HTML tags (@samp{<tag>}) within @var{lines} will be visible verbatim. @end defun + @defun html:comment line1 line @dots{} Returns the strings @var{line1} as HTML comments. @end defun + @section HTML Forms @@ -79,30 +88,37 @@ form. @code{html:form} returns the HTML @dfn{form}. @cindex form @end defun + @defun html:hidden name value Returns HTML string which will cause @var{name}=@var{value} in form. @end defun + @defun html:checkbox pname default Returns HTML string for check box. @end defun + @defun html:text pname default size @dots{} Returns HTML string for one-line text box. @end defun + @defun html:text-area pname default-list Returns HTML string for multi-line text box. @end defun + @defun html:select pname arity default-list foreign-values Returns HTML string for pull-down menu selector. @end defun + @defun html:buttons pname arity default-list foreign-values Returns HTML string for any-of selector. @end defun + @defun form:submit submit-label command @@ -114,15 +130,18 @@ and @code{*button*=@var{submit-label}} are set in the query. Otherwise, @code{*command*=@var{submit-label}} is set in the query. @end defun + @defun form:image submit-label image-src The @var{image-src} appears on the button which submits the form. @end defun + @defun form:reset Returns a string which generates a @dfn{reset} button. @cindex reset @end defun + @defun form:element pname arity default-list foreign-values Returns a string which generates an INPUT element for the field named @var{pname}. The element appears in the created form with its @@ -160,6 +179,7 @@ text area @end table @end defun + @defun form:delimited pname doc aliat arity default-list foreign-values @@ -168,15 +188,18 @@ delimited list. Apply map @code{form:delimited} to the list returned by @code{command->p-specs}. @end defun + @defun html:delimited-list row @dots{} Wraps its arguments with delimited-list (@samp{DL} command. @end defun + @defun get-foreign-choices tab Returns a list of the @samp{visible-name} or first fields of table @var{tab}. @end defun + @defun command->p-specs rdb command-table command @@ -212,3 +235,4 @@ command. port))) @end example @end defun + diff --git a/http-cgi.scm b/http-cgi.scm index 517e312..1dd1c07 100644 --- a/http-cgi.scm +++ b/http-cgi.scm @@ -125,7 +125,7 @@ *http:byline* (sprintf #f - "<A HREF=http://swissnet.ai.mit.edu/~jaffer/SLIB.html>SLIB</A> %s server" + "<A HREF=http://swiss.csail.mit.edu/~jaffer/SLIB.html>SLIB</A> %s server" (if (getenv "SERVER_PROTOCOL") "CGI/1.1" "HTTP/1.1")))) (string-append (http:status-line status-code reason-phrase) (http:content @@ -143,9 +143,9 @@ ;;@3 after @2 seconds. The returned page (string) contains any @4 ;;@dots{} followed by a manual link to @3, in case the browser does not ;;forward automatically. -(define (http:forwarding-page title delay uri . html-strings) +(define (http:forwarding-page title dly uri . html-strings) (string-append - (html:head title #f (html:meta-refresh delay uri)) + (html:head title #f (html:meta-refresh dly uri)) (apply html:body (append html-strings (list (sprintf #f "\\n\\n<HR>\\nReturn to %s.\\n" diff --git a/http-cgi.txi b/http-cgi.txi index 67be216..0e57933 100644 --- a/http-cgi.txi +++ b/http-cgi.txi @@ -8,11 +8,13 @@ Returns a string containing lines for each element of @var{alist}; the @code{car} of which is followed by @samp{: }, then the @code{cdr}. @end defun + @defun http:content alist body @dots{} Returns the concatenation of strings @var{body} with the @code{(http:header @var{alist})} and the @samp{Content-Length} prepended. @end defun + @defvar *http:byline* String appearing at the bottom of error pages. @end defvar @@ -24,17 +26,19 @@ and any additional @var{html-strings} @dots{}; with @var{*http:byline*} or SLIB' default at the bottom. @end defun -@defun http:forwarding-page title delay uri html-string @dots{} -The string or symbol @var{title} is the page title. @var{delay} is a non-negative + +@defun http:forwarding-page title dly uri html-string @dots{} +The string or symbol @var{title} is the page title. @var{dly} is a non-negative integer. The @var{html-strings} @dots{} are typically used to explain to the user why this page is being forwarded. @code{http:forwarding-page} returns an HTML string for a page which automatically forwards to -@var{uri} after @var{delay} seconds. The returned page (string) contains any @var{html-strings} +@var{uri} after @var{dly} seconds. The returned page (string) contains any @var{html-strings} @dots{} followed by a manual link to @var{uri}, in case the browser does not forward automatically. @end defun + @defun http:serve-query serve-proc input-port output-port reads the @dfn{URI} and @dfn{query-string} from @var{input-port}. If the @cindex URI @@ -53,6 +57,7 @@ problem. @end defun + This example services HTTP queries from @var{port-number}: @example @@ -93,6 +98,7 @@ Otherwise, @code{cgi:serve-query} replies (to @code{(current-input-port)}) with appropriate HTML describing the problem. @end defun + @defun make-query-alist-command-server rdb command-table @@ -110,3 +116,4 @@ If optional third argument is non-false, then the command is called with just the parameter-list; otherwise, command is called with the arguments described in its table. @end defun + diff --git a/indexes.texi b/indexes.texi new file mode 100644 index 0000000..8733a05 --- /dev/null +++ b/indexes.texi @@ -0,0 +1,55 @@ + +@ifhtml +@node Index, Procedure and Macro Index, About SLIB, Top +@unnumbered Index +@end ifhtml + +@ifnotinfo +@menu +* Procedure and Macro Index:: +* Variable Index:: +* Concept Index:: +@ifhtml +* SLIB:: Full Table of Contents +@end ifhtml +@end menu +@end ifnotinfo + +@ifnotinfo +@node Procedure and Macro Index, Variable Index, Index, Index +@end ifnotinfo +@unnumbered Procedure and Macro Index + +This is an alphabetical list of all the procedures and macros in SLIB. + +@printindex fn + +@ifnotinfo +@node Variable Index, Concept Index, Procedure and Macro Index, Index +@end ifnotinfo +@unnumbered Variable Index + +This is an alphabetical list of all the global variables in SLIB. + +@printindex vr + +@ifnotinfo +@node Concept Index, , Variable Index, Index +@end ifnotinfo +@unnumbered Concept and Feature Index + +@printindex cp + +@ifhtml +@node SLIB, , , Index +@unnumbered SLIB +@noindent +@dfn{SLIB} is a portable library for the programming language +@dfn{Scheme}. It provides a platform independent framework for using +@dfn{packages} of Scheme procedures and syntax. As distributed, SLIB +contains useful packages for all Scheme implementations. Its catalog +can be transparently extended to accomodate packages specific to a site, +implementation, user, or directory. +@end ifhtml + +@contents diff --git a/jscheme.init b/jscheme.init new file mode 100644 index 0000000..88c1623 --- /dev/null +++ b/jscheme.init @@ -0,0 +1,478 @@ +;;; "jscheme.init" SLIB Initialization for JScheme -*-scheme-*- +;;; Author: Aubrey Jaffer +;;; Additions by Ken Anderson. +;;; This code is in the public domain. + +;;; JScheme support of for the SLIB Scheme library. + +;;; The easiest way to get things going is to download the slib.zip to +;;; the lib directory and invoke JScheme with a script like this (UNIX): + +;;; java -classpath "lib/jscheme.jar:lib/slib.zip" jscheme.REPL slib/jscheme.init "$@" + +;;; AGJ: This line works on my RedHat-9.0 system: +;;; java -cp src:/usr/local/share/java/jscheme.jar:/usr/local/lib/slib jscheme.REPL jscheme.init + +;;; Alternatively, set the location of the slib directory using the +;;; -D SCHEME_LIBRARY_PATH=... system property. + +;;; Let me know, if there is a problem with a module you'd like to use +;;; (kanderson@bbn.com). + +;;@ (software-type) should be set to the generic operating system type. +;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. +;; (define (software-type) 'UNIX) +(define (software-type) + (if (.startsWith (System.getProperty "os.name") "Windows") + 'MS-DOS + 'UNIX)) + +;;@ (scheme-implementation-type) should return the name of the scheme +;;; implementation loading this file. +(define (scheme-implementation-type) 'JScheme) + +;;@ (scheme-implementation-home-page) should return a (string) URI +;;; (Uniform Resource Identifier) for this scheme implementation's home +;;; page; or false if there isn't one. +(define (scheme-implementation-home-page) "http://jscheme.sourceforge.net") + +;;@ (scheme-implementation-version) should return a string describing +;;; the version the scheme implementation loading this file. +(define (scheme-implementation-version) "6.2") + +;;@ (implementation-vicinity) should be defined to be the pathname of +;;; the directory where any auxillary files to your Scheme +;;; implementation reside. +(define implementation-vicinity + (let ((implvic (case (software-type) + ((MS-DOS) "C:\\TEMP\\") + (else "/tmp/")))) + (lambda () implvic))) + +(define (getenv path) + (define prop (System.getProperty path)) + (and (not (eq? prop #null)) prop)) + +(define (slib.zip-on-classpath?) + (let loop ((urls (vector->list (.getURLs (Import.getClassLoader))))) + (if (null? urls) #f + (or (.endsWith (.getFile (car urls)) "slib.zip") + (loop (cdr urls)))))) + +;;@ (library-vicinity) should be defined to be the pathname of the +;;; directory where files of Scheme library functions reside. +(define library-vicinity + (let ((library-path + (or + ;; Use this getenv if your implementation supports it. + (getenv "SCHEME_LIBRARY_PATH") + (and (or (slib.zip-on-classpath?) + (not (eq? #null (Scheme.openResource "slib/require.scm")))) + "slib/") + ;; Use this path if your scheme does not support GETENV + ;; or if SCHEME_LIBRARY_PATH is not set. + (case (software-type) + ((UNIX) "/usr/local/lib/slib/") + ((VMS) "lib$scheme:") + ((MS-DOS) "C:\\SLIB\\") + (else ""))))) + (lambda () library-path))) + +;;@ (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) + (define home (or (getenv "HOME") (getenv "user.home"))) + (and home + (case (software-type) + ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) + home + (string-append home "/"))) + (else home)))) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *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") + vicinity + srfi-59 + + ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. + +;;; r5rs ;conforms to + eval ;R5RS two-argument eval + values ;R5RS multiple values +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros + delay ;has DELAY and FORCE + multiarg-apply ;APPLY can take more than 2 args. +;;; char-ready? +;;; KRA 23DEC03: JScheme is missing: vector-fill! string-copy string-fill! +;;; rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + +;;; multiarg/and- ;/ and - can take more than 2 args. +;;; rationalize +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF +;;; with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE + + r4rs ;conforms to + +;;; ieee-p1178 ;conforms to + +;;; r3rs ;conforms to + +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, + ;SUBSTRING-MOVE-RIGHT!, + ;SUBSTRING-FILL!, + ;STRING-NULL?, APPEND!, 1+, + ;-1+, <?, <=?, =?, >?, >=? +;;; object-hash ;has OBJECT-HASH + +;;; full-continuation ;can return multiple times + ieee-floating-point ;conforms to IEEE Standard 754-1985 + ;IEEE Standard for Binary + ;Floating-Point Arithmetic. + + ;; Other common features + +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. + defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures +;;; string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING +;;; sort +;;; pretty-print +;;; object->string +;;; format ;Common-lisp output formatting +;;; 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) + current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + + )) + +;;@ (OUTPUT-PORT-WIDTH <port>) +(define (output-port-width . arg) 79) + +;;@ (OUTPUT-PORT-HEIGHT <port>) +(define (output-port-height . arg) 24) + +;;@ (CURRENT-ERROR-PORT) +(define current-error-port + (let ((port (current-output-port))) + (lambda () port))) + +;;@ (TMPNAM) makes a temporary file name. +(define tmpnam (let ((cntr 100)) + (lambda () (set! cntr (+ 1 cntr)) + (string-append "slib_" (number->string cntr))))) + +;;@ (FILE-EXISTS? <string>) +;;; KRA 24DEC03: This allows load to find a file, resource or URL, but +;;; the rest of SLIB assumes f names a file. +(define (file-exists? f) (not (eq? (Scheme.open f) #null))) +;;;(define (file-exists? f) (.exists (java.io.File. f))) + +;;@ (DELETE-FILE <string>) +(define (delete-file f) (.delete (java.io.File. 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) + (.flush (if (pair? arg) (car args) + (current-output-port)))) + +;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string +;;; port versions of CALL-WITH-*PUT-FILE. + +;;@ "rationalize" adjunct procedures. +;;(define (find-ratio x e) +;; (let ((rat (rationalize x e))) +;; (list (numerator rat) (denominator rat)))) +;;(define (find-ratio-between x y) +;; (find-ratio (/ (+ x y) 2) (/ (- x y) 2))) + +;;@ CHAR-CODE-LIMIT is one greater than the largest integer which can +;;; be returned by CHAR->INTEGER. +(define char-code-limit (char->integer Character.MAX_VALUE$)) + +;;@ MOST-POSITIVE-FIXNUM is used in modular.scm +(define most-positive-fixnum Integer.MAX_VALUE$) + +;;@ Return argument +(define (identity x) x) + +;;@ SLIB:EVAL is single argument eval using the top-level (user) environment. +(define slib:eval eval) + +;; If your implementation provides R4RS macros: +;(define macro:eval slib:eval) +;(define macro:load load) + +(define (constant? exp) + (if (pair? exp) (eq? (car exp) 'quote) (not (symbol? exp)))) + +(define (combine-skeletons left right exp) + (cond + ((and (constant? left) (constant? right)) + (if (and (eqv? (eval left) (car exp)) + (eqv? (eval right) (cdr exp))) + (list 'quote exp) + (list 'quote (cons (eval left) (eval right))))) + ((null? right) (list 'list left)) + ((and (pair? right) (eq? (car right) 'list)) + (cons 'list (cons left (cdr right)))) + (else (list 'cons left right)))) + +(define (expand-quasiquote exp nesting) + (cond + ((vector? exp) + (list 'apply 'vector (expand-quasiquote (vector->list exp) nesting))) + ((not (pair? exp)) + (if (constant? exp) exp (list 'quote exp))) + ((and (eq? (car exp) 'unquote) (= (length exp) 2)) + (if (= nesting 0) + (second exp) + (combine-skeletons ''unquote + (expand-quasiquote (cdr exp) (- nesting 1)) + exp))) + ((and (eq? (car exp) 'quasiquote) (= (length exp) 2)) + (combine-skeletons ''quasiquote + (expand-quasiquote (cdr exp) (+ nesting 1)) + exp)) + ((and (pair? (car exp)) + (eq? (caar exp) 'unquote-splicing) + (= (length (car exp)) 2)) + (if (= nesting 0) + (list 'append (second (first exp)) + (expand-quasiquote (cdr exp) nesting)) + (combine-skeletons (expand-quasiquote (car exp) (- nesting 1)) + (expand-quasiquote (cdr exp) nesting) + exp))) + (else (combine-skeletons (expand-quasiquote (car exp) nesting) + (expand-quasiquote (cdr exp) nesting) + exp)))) + +(define quasiquote + (set-procedure-name! + (macro (x) + (expand-quasiquote x 0)) + 'quasiquote)) + +(define-macro (defmacro name args . body) + `(define-macro ,(cons name args) ,@body)) +;@ +(define (defmacro? m) + (and (.isDefined m) (eq? (.getClass (eval m)) Macro.class))) +;@ + +(tryCatch ; once-only + macroexpand-1 + (lambda (e) (set! macroexpand-1 macroexpand))) + +;@ +(define (macroexpand e) + (if (pair? e) + (let ((a (car e))) + (cond ((and (symbol? a) (defmacro? a)) + (macroexpand (macroexpand-1 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:eval base:eval) + +(define (defmacro:expand* x) + (require 'defmacroexpand) (apply defmacro:expand* x '())) +;@ +(define (defmacro:load <pathname>) + (slib:eval-load <pathname> defmacro:eval)) +;; slib:eval-load definition moved to "require.scm" + +;@ +(define slib:warn + (lambda args + (let ((cep (current-error-port))) + (if (provided? 'trace) (print-call-stack cep)) + (display "Warn: " cep) + (for-each (lambda (x) (display #\ cep) (write x cep)) args)))) + +;;@ define an error procedure for the library +(define (slib:error . args) + (if (provided? 'trace) (print-call-stack (current-error-port))) + (apply error args)) +;@ +(define (make-exchanger obj) + (lambda (rep) (let ((old obj)) (set! obj rep) old))) +(define (open-file filename modes) + (case modes + ((r rb) (open-input-file filename)) + ((w wb) (open-output-file filename)) + (else (slib:error 'open-file 'mode? modes)))) +(define (port? obj) (or (input-port? port) (output-port? port))) +(define (call-with-open-ports . ports) + (define proc (car ports)) + (cond ((procedure? proc) (set! ports (cdr ports))) + (else (set! ports (reverse ports)) + (set! proc (car ports)) + (set! ports (reverse (cdr ports))))) + (let ((ans (apply proc ports))) + (for-each close-port ports) + ans)) +(define (close-port port) + (cond ((input-port? port) + (close-input-port port) + (if (output-port? port) (close-output-port port))) + ((output-port? port) (close-output-port port)) + (else (slib:error 'close-port 'port? port)))) +;@ +(define (browse-url url) + (define (try cmd end) (zero? (system (string-append cmd url end)))) + (or (try "netscape-remote -remote 'openURL(" ")'") + (try "netscape -remote 'openURL(" ")'") + (try "netscape '" "'&") + (try "netscape '" "'"))) + +;;@ define these as appropriate for your system. +(define slib:tab (integer->char 9)) +(define slib:form-feed (integer->char 12)) + +;;@ Support for older versions of Scheme. Not enough code for its own file. +(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)) +(define t #t) +(define nil #f) + +;;@ Define these if your implementation's syntax can support it and if +;;; they are not already defined. +(define (1+ n) (+ n 1)) +(define (-1+ n) (+ n -1)) +(define 1- -1+) + +;;@ Define SLIB:EXIT to be the implementation procedure to exit or +;;; return if exiting not supported. +(define (slib:exit) (System.exit 0)) + +;;@ Here for backward compatability +(define (scheme-file-suffix) ".scm") + + +;;@ (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever +;;; suffix all the module files in SLIB have. See feature 'SOURCE. +(define (slib:load-source f) (load (string-append f ".scm"))) + +;;@ (SLIB:LOAD-COMPILED "foo") should load the file that was produced +;;; by compiling "foo.scm" if this implementation can compile files. +;;; See feature 'COMPILED. +(define slib:load-compiled load) + +;;@ At this point SLIB:LOAD must be able to load SLIB files. +(define slib:load slib:load-source) + +(slib:load (in-vicinity (library-vicinity) "require")) + +(define (current-time) (/ (System.currentTimeMillis) 1000)) + +(if (not (.isDefined 'old-require)) + (begin + (set! old-require require) + (set! require + (lambda (feature) + (let ((jsyntax U.useJavaSyntax$)) + (set! U.useJavaSyntax$ #f) + (Procedure.tryFinally + (lambda () (old-require feature)) + (lambda () (set! U.useJavaSyntax$ jsyntax)))))))) @@ -1,5 +1,5 @@ ; "lineio.scm", line oriented input/output functions for Scheme. -; Copyright (c) 1992, 1993 Aubrey Jaffer +; Copyright (C) 1992, 1993 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -11,6 +11,7 @@ omitted, in which case it defaults to the value returned by @code{current-input-port}. @end defun + @deffn {Procedure} read-line! string @@ -25,6 +26,7 @@ omitted, in which case it defaults to the value returned by @code{current-input-port}. @end deffn + @defun write-line string @@ -35,6 +37,7 @@ which case it defaults to the value returned by @code{current-input-port}. @end defun + @defun system->line command tmp @@ -44,3 +47,4 @@ a temporary file. @code{system->line} calls @code{system} with @var{command} as redirecting stdout to file @var{tmp}. @code{system->line} returns a string containing the first line of output from @var{tmp}. @end defun + diff --git a/logical.scm b/logical.scm index 90808e6..5ea47f5 100644 --- a/logical.scm +++ b/logical.scm @@ -1,5 +1,5 @@ ;;;; "logical.scm", bit access and operations for integers for Scheme -;;; Copyright (C) 1991, 1993, 2001, 2003 Aubrey Jaffer +;;; Copyright (C) 1991, 1993, 2001, 2003, 2005 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -17,20 +17,6 @@ ;promotional, or sales literature without prior written consent in ;each case. -;@ -(define integer-expt - (if (provided? 'inexact) - expt - (lambda (n k) - (do ((x n (* x x)) - (j k (quotient j 2)) - (acc 1 (if (even? j) acc (* x acc)))) - ((<= j 1) - (case j - ((0) acc) - ((1) (* x acc)) - (else (slib:error 'integer-expt n k)))))))) - (define logical:boole-xor '#(#(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15) #(1 0 3 2 5 4 7 6 9 8 11 10 13 12 15 14) @@ -71,6 +57,13 @@ (if (negative? x) (+ -1 (quotient (+ 1 x) 16)) (quotient x 16))) + +(define (logical:reduce op4 ident) + (lambda args + (do ((res ident (op4 res (car rgs) 1 0)) + (rgs args (cdr rgs))) + ((null? rgs) res)))) + ;@ (define logand (letrec @@ -87,7 +80,7 @@ (modulo n2 16)) scl) acc))))))) - (lambda (n1 n2) (lgand n2 n1 1 0)))) + (logical:reduce lgand -1))) ;@ (define logior (letrec @@ -105,7 +98,7 @@ (- 15 (modulo n2 16)))) scl) acc))))))) - (lambda (n1 n2) (lgior n2 n1 1 0)))) + (logical:reduce lgior 0))) ;@ (define logxor (letrec @@ -122,46 +115,52 @@ (modulo n2 16)) scl) acc))))))) - (lambda (n1 n2) (lgxor n2 n1 1 0)))) + (logical:reduce lgxor 0))) ;@ (define (lognot n) (- -1 n)) ;@ (define (logtest n1 n2) - (not (zero? (logical:logand n1 n2)))) + (not (zero? (logand n1 n2)))) ;@ (define (logbit? index n) - (logical:logtest (logical:integer-expt 2 index) n)) + (logtest (expt 2 index) n)) ;@ (define (copy-bit index to bool) (if bool - (logical:logior to (logical:ash 1 index)) - (logical:logand to (logical:lognot (logical:ash 1 index))))) - -;;@ This procedure is careful not to use more than DEG bits in -;; computing (- (expt 2 DEG) 1) -(define (logical:ones deg) - (if (zero? deg) 0 (+ (* 2 (+ -1 (logical:integer-expt 2 (- deg 1)))) 1))) -;@ -(define (bit-field n start end) - (logical:logand (logical:ones (- end start)) - (logical:ash n (- start)))) + (logior to (arithmetic-shift 1 index)) + (logand to (lognot (arithmetic-shift 1 index))))) ;@ (define (bitwise-if mask n0 n1) - (logical:logior (logical:logand mask n0) - (logical:logand (logical:lognot mask) n1))) -;@ -(define (copy-bit-field to start end from) - (logical:bitwise-if (logical:ash (logical:ones (- end start)) start) - (logical:ash from start) - to)) + (logior (logand mask n0) + (logand (lognot mask) n1))) ;@ -(define (ash n count) +(define (bit-field n start end) + (logand (lognot (ash -1 (- end start))) + (arithmetic-shift n (- start)))) +;@ +(define (copy-bit-field to from start end) + (bitwise-if (arithmetic-shift (lognot (ash -1 (- end start))) start) + (arithmetic-shift from start) + to)) +;@ +(define (rotate-bit-field n count start end) + (define width (- end start)) + (set! count (modulo count width)) + (let ((mask (lognot (ash -1 width)))) + (define zn (logand mask (arithmetic-shift n (- start)))) + (logior (arithmetic-shift + (logior (logand mask (arithmetic-shift zn count)) + (arithmetic-shift zn (- count width))) + start) + (logand (lognot (ash mask start)) n)))) +;@ +(define (arithmetic-shift n count) (if (negative? count) - (let ((k (logical:integer-expt 2 (- count)))) + (let ((k (expt 2 (- count)))) (if (negative? n) (+ -1 (quotient (+ 1 n) k)) (quotient n k))) - (* (logical:integer-expt 2 count) n))) + (* (expt 2 count) n))) ;@ (define integer-length (letrec ((intlen (lambda (n tot) @@ -183,30 +182,33 @@ (modulo n 16)) tot)))))) (lambda (n) - (cond ((negative? n) (logcnt (logical:lognot n) 0)) + (cond ((negative? n) (logcnt (lognot n) 0)) ((positive? n) (logcnt n 0)) (else 0))))) - -;;;; Bit order and lamination -;@ -(define (logical:rotate k count len) - (set! count (modulo count len)) - (logical:logior (logical:logand (ash k count) (logical:ones len)) - (logical:ash k (- count len)))) ;@ +(define (log2-binary-factors n) + (+ -1 (integer-length (logand n (- n))))) + (define (bit-reverse k n) - (do ((m (if (negative? n) (lognot n) n) (ash m -1)) + (do ((m (if (negative? n) (lognot n) n) (arithmetic-shift m -1)) (k (+ -1 k) (+ -1 k)) - (rvs 0 (logior (ash rvs 1) (logand 1 m)))) + (rvs 0 (logior (arithmetic-shift rvs 1) (logand 1 m)))) ((negative? k) (if (negative? n) (lognot rvs) rvs)))) ;@ +(define (reverse-bit-field n start end) + (define width (- end start)) + (let ((mask (lognot (ash -1 width)))) + (define zn (logand mask (arithmetic-shift n (- start)))) + (logior (arithmetic-shift (bit-reverse width zn) start) + (logand (lognot (ash mask start)) n)))) +;@ (define (integer->list k . len) (if (null? len) - (do ((k k (ash k -1)) + (do ((k k (arithmetic-shift k -1)) (lst '() (cons (odd? k) lst))) ((<= k 0) lst)) (do ((idx (+ -1 (car len)) (+ -1 idx)) - (k k (ash k -1)) + (k k (arithmetic-shift k -1)) (lst '() (cons (odd? k) lst))) ((negative? idx) lst)))) ;@ @@ -216,66 +218,21 @@ ((null? bs) acc))) (define (booleans->integer . bools) (list->integer bools)) -;@ -(define (bitwise:laminate . ks) - (define nks (length ks)) - (define nbs (apply max (map integer-length ks))) - (do ((kdx (+ -1 nbs) (+ -1 kdx)) - (ibs 0 (+ (list->integer (map (lambda (k) (logbit? kdx k)) ks)) - (ash ibs nks)))) - ((negative? kdx) ibs))) -;@ -(define (bitwise:delaminate count k) - (define nbs (* count (+ 1 (quotient (integer-length k) count)))) - (do ((kdx (- nbs count) (- kdx count)) - (lst (vector->list (make-vector count 0)) - (map (lambda (k bool) (+ (if bool 1 0) (ash k 1))) - lst - (integer->list (ash k (- kdx)) count)))) - ((negative? kdx) lst))) -;;;; Gray-code -;@ -(define (integer->gray-code k) - (logxor k (ash k -1))) -;@ -(define (gray-code->integer k) - (if (negative? k) - (slib:error 'gray-code->integer 'negative? k) - (let ((kln (integer-length k))) - (do ((d 1 (* d 2)) - (ans (logxor k (ash k -1)) ; == (integer->gray-code k) - (logxor ans (ash ans (* d -2))))) - ((>= (* 2 d) kln) ans))))) - -(define (grayter k1 k2) - (define kl1 (integer-length k1)) - (define kl2 (integer-length k2)) - (if (eqv? kl1 kl2) - (> (gray-code->integer k1) (gray-code->integer k2)) - (> kl1 kl2))) -;@ -(define (gray-code<? k1 k2) - (not (or (eqv? k1 k2) (grayter k1 k2)))) -(define (gray-code<=? k1 k2) - (or (eqv? k1 k2) (not (grayter k1 k2)))) -(define (gray-code>? k1 k2) - (and (not (eqv? k1 k2)) (grayter k1 k2))) -(define (gray-code>=? k1 k2) - (or (eqv? k1 k2) (grayter k1 k2))) +;;;;@ SRFI-60 aliases +(define ash arithmetic-shift) +(define bitwise-ior logior) +(define bitwise-xor logxor) +(define bitwise-and logand) +(define bitwise-not lognot) +(define bit-count logcount) +(define bit-set? logbit?) +(define any-bits-set? logtest) +(define first-set-bit log2-binary-factors) +(define bitwise-merge bitwise-if) +(provide 'srfi-60) -(define logical:logand logand) -(define logical:logior logior) -;;(define logical:logxor logxor) -(define logical:lognot lognot) -(define logical:logtest logtest) -;;(define logical:logbit? logbit?) -;;(define logical:copy-bit copy-bit) -(define logical:ash ash) -;;(define logical:logcount logcount) -;;(define logical:integer-length integer-length) -;;(define logical:bit-field bit-field) -;;(define bit-extract bit-field) -(define logical:bitwise-if bitwise-if) -;;(define logical:copy-bit-field copy-bit-field) -(define logical:integer-expt integer-expt) +;;; Legacy +;;(define (logical:rotate k count len) (rotate-bit-field k count 0 len)) +;;(define (logical:ones deg) (lognot (ash -1 deg))) +;;(define integer-expt expt) ; legacy name diff --git a/macscheme.init b/macscheme.init index 152d456..60ee387 100644 --- a/macscheme.init +++ b/macscheme.init @@ -35,31 +35,106 @@ ;;; 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 in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") + ;(SLIB:LOAD-SOURCE "filename") compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to -; eval ;R5RS two-argument eval -; values ;R5RS multiple values -; dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; r5rs ;conforms to +;;; eval ;R5RS two-argument eval +;;; values ;R5RS multiple values +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. -; char-ready? +;;; char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to @@ -67,43 +142,39 @@ r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + full-continuation ;can return multiple times ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. -; defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort +;;; sort pretty-print -; object->string -; format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE +;;; object->string +;;; format ;Common-lisp output formatting +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; ed ;(ED) is editor +;;; system ;posix (system <string>) +;;; getenv ;posix (getenv <string>) +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features @@ -237,18 +308,7 @@ (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))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -274,10 +334,8 @@ ;(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. +;;; return if exiting not supported. ; MacScheme does not return a value when it exits, ; so simply invoke system procedure exit with 0 args. (define slib:exit (lambda args (exit))) diff --git a/manifest.scm b/manifest.scm index 77d6f1b..be55ea7 100644 --- a/manifest.scm +++ b/manifest.scm @@ -39,15 +39,15 @@ (lambda (port) (define requires '()) (define (add-require feature) - (if (and (not (provided? (cadr feature))) - (not (assq (cadr feature) catalog))) - (slib:warn file 'unknown 'feature feature)) +;;; (if (and (not (provided? (cadr feature))) +;;; (not (assq (cadr feature) catalog))) +;;; (slib:warn file 'unknown 'feature feature)) (if (not (memq (cadr feature) requires)) (set! requires (cons (cadr feature) requires)))) + (if (eqv? #\# (peek-char port)) (read-line port)) (let loop ((sexp (read port))) - (cond ((or (eof-object? sexp) (not (pair? sexp)) (not (list? sexp))) - (reverse requires)) - (else + (cond ((eof-object? sexp) (reverse requires)) + ((pair? sexp) (case (car sexp) ((require) (cond ((not (= 2 (length sexp))) @@ -72,7 +72,8 @@ (else #f)))))) (add-require (caddr sexp)))) (loop (read port))) - (else (reverse requires))))))))) + (else (reverse requires)))) + (else (loop (read port)))))))) ;;@example ;;(define (provided+? . features) ;; (lambda (feature) @@ -95,10 +96,9 @@ (file->requires (string-append path (scheme-file-suffix)) provided? catalog)) (cond ((not path) #f) - ((string? path) - (return path)) - ((not (pair? path)) - (slib:error feature 'path? path)) + ((string? path) (return path)) + ((symbol? path) (f2r path)) + ((not (pair? path)) (slib:error feature 'path? path)) (else (case (car path) ((source defmacro macro-by-example macro macros-that-work syntax-case syntactic-closures) @@ -124,6 +124,33 @@ ;; pretty-print common-list-functions) ;;@end example +(define (features->requires* features provided? catalog) + (and + features + (let loop ((new features) + (done '())) + (cond + ((null? new) done) + ((memq (car new) done) (loop (cdr new) done)) + (else + (loop (append (or (feature->requires (car new) provided? catalog) '()) + (cdr new)) + (cons (car new) done))))))) + +;;@body +;;Returns a list of the features transitively @code{require}d by @1 +;;assuming the predicate @2 and association-list @3. +(define (feature->requires* feature provided? catalog) + (features->requires* (or (feature->requires feature provided? catalog) '()) + provided? catalog)) + +;;@body +;;Returns a list of the features transitively @code{require}d by @1 +;;assuming the predicate @2 and association-list @3. +(define (file->requires* file provided? catalog) + (features->requires* (file->requires file provided? catalog) + provided? catalog)) + ;;@body ;;Returns a list of strings naming existing files loaded (load ;;slib:load slib:load-source macro:load defmacro:load syncase:load @@ -147,11 +174,11 @@ (sxp (read port)))) ((eq? 'begin (car o)) (for-each sxp (cdr o))) (else (sxp (read port))))) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* file) - (sxp (read port)) - (set! *load-pathname* old-load-pathname) - loads)))) + (with-load-pathname file + (lambda () + (if (eqv? #\# (peek-char port)) (read-line port)) + (sxp (read port)) + loads))))) (f2l file)) ;;@example ;;(file->loads (in-vicinity (library-vicinity) "scainit.scm")) @@ -192,8 +219,13 @@ ;;@body ;;Returns a list of the identifier symbols defined by SLIB (or -;;SLIB-style) file @1. -(define (file->definitions file) +;;SLIB-style) file @1. The optional arguments @2 should be symbols +;;signifying a defining form. If none are supplied, then the symbols +;;@code{define-operation}, @code{define}, @code{define-syntax}, and +;;@code{defmacro} are captured. +(define (file->definitions file . definers) + (if (null? definers) + (set! definers '(define-operation define define-syntax defmacro))) (call-with-input-file file (lambda (port) (define defs '()) @@ -203,19 +235,18 @@ ((< (length o) 2)) ((eq? 'begin (car o)) (for-each sxp (cdr o))) ((< (length o) 3)) - ((not (memq (car o) - '(define-operation define define-syntax defmacro)))) + ((not (memq (car o) definers))) ((symbol? (cadr o)) (set! defs (cons (cadr o) defs))) ((not (pair? (cadr o)))) ((not (symbol? (caadr o)))) (else (set! defs (cons (caadr o) defs)))) (cond ((eof-object? o) defs) (else (sxp (read port))))) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* file) - (sxp (read port)) - (set! *load-pathname* old-load-pathname) - defs)))) + (with-load-pathname file + (lambda () + (if (eqv? #\# (peek-char port)) (read-line port)) + (sxp (read port)) + defs))))) ;;@example ;;(file->definitions "random.scm") ;; @result{} (*random-state* make-random-state @@ -225,8 +256,13 @@ ;;@body ;;Returns a list of the identifier symbols exported (advertised) by -;;SLIB (or SLIB-style) file @1. -(define (file->exports file) +;;SLIB (or SLIB-style) file @1. The optional arguments @2 should be +;;symbols signifying a defining form. If none are supplied, then the +;;symbols @code{define-operation}, @code{define}, +;;@code{define-syntax}, and @code{defmacro} are captured. +(define (file->exports file . definers) + (if (null? definers) + (set! definers '(define-operation define define-syntax defmacro))) (call-with-input-file file (lambda (port) (define exports '()) @@ -267,16 +303,16 @@ ((< (length o) 2)) ((eq? 'begin (car o)) (for-each sxp (cdr o))) ((< (length o) 3)) - ((not (memq (car o) '(define define-syntax defmacro)))) + ((not (memq (car o) definers))) ((symbol? (cadr o)) (set! exports (cons (cadr o) exports))) ((not (pair? (cadr o)))) ((not (symbol? (caadr o)))) (else (set! exports (cons (caadr o) exports))))) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* file) - (top) - (set! *load-pathname* old-load-pathname) - exports)))) + (with-load-pathname file + (lambda () + (if (eqv? #\# (peek-char port)) (read-line port)) + (top) + exports))))) ;;@example ;;(file->exports "random.scm") ;; @result{} (make-random-state seed->random-state diff --git a/manifest.txi b/manifest.txi index e9fe3ee..daa776d 100644 --- a/manifest.txi +++ b/manifest.txi @@ -16,6 +16,7 @@ entries. It would be defined by: Returns a list of the features @code{require}d by @var{file} assuming the predicate @var{provided?} and association-list @var{catalog}. @end defun + @example (define (provided+? . features) (lambda (feature) @@ -34,6 +35,7 @@ predicate @var{provided?} and association-list @var{catalog}. Returns a list of the features @code{require}d by @var{feature} assuming the predicate @var{provided?} and association-list @var{catalog}. @end defun + @example (feature->requires 'batch (provided+? 'compiling) *catalog*) @result{} (tree line-i/o databases parameters string-port @@ -49,12 +51,27 @@ predicate @var{provided?} and association-list @var{catalog}. @end example +@defun feature->requires* feature provided? catalog + +Returns a list of the features transitively @code{require}d by @var{feature} +assuming the predicate @var{provided?} and association-list @var{catalog}. +@end defun + + +@defun file->requires* file provided? catalog + +Returns a list of the features transitively @code{require}d by @var{file} +assuming the predicate @var{provided?} and association-list @var{catalog}. +@end defun + + @defun file->loads file Returns a list of strings naming existing files loaded (load slib:load slib:load-source macro:load defmacro:load syncase:load synclo:load macwork:load) by @var{file} or any of the files it loads. @end defun + @example (file->loads (in-vicinity (library-vicinity) "scainit.scm")) @result{} ("/usr/local/lib/slib/scaexpp.scm" @@ -69,17 +86,22 @@ Given a @code{(load '<expr>)}, where <expr> is a string or vicinity stuff), @code{(load->path <expr>)} figures a path to the file. @code{load->path} returns that path if it names an existing file; otherwise #f. @end defun + @example (load->path '(in-vicinity (library-vicinity) "mklibcat")) @result{} "/usr/local/lib/slib/mklibcat.scm" @end example -@defun file->definitions file +@defun file->definitions file definer @dots{} Returns a list of the identifier symbols defined by SLIB (or -SLIB-style) file @var{file}. +SLIB-style) file @var{file}. The optional arguments @var{definers} should be symbols +signifying a defining form. If none are supplied, then the symbols +@code{define-operation}, @code{define}, @code{define-syntax}, and +@code{defmacro} are captured. @end defun + @example (file->definitions "random.scm") @result{} (*random-state* make-random-state @@ -88,11 +110,15 @@ SLIB-style) file @var{file}. @end example -@defun file->exports file +@defun file->exports file definer @dots{} Returns a list of the identifier symbols exported (advertised) by -SLIB (or SLIB-style) file @var{file}. +SLIB (or SLIB-style) file @var{file}. The optional arguments @var{definers} should be +symbols signifying a defining form. If none are supplied, then the +symbols @code{define-operation}, @code{define}, +@code{define-syntax}, and @code{defmacro} are captured. @end defun + @example (file->exports "random.scm") @result{} (make-random-state seed->random-state @@ -112,10 +138,12 @@ implementing @var{feature}, and the identifier symbols exported (advertised) by SLIB (or SLIB-style) feature @var{feature}, in @var{catalog}. @end defun + @defun feature->exports feature catalog Returns a list of all exports of @var{feature}. @end defun + @noindent In the case of @code{aggregate} features, more than one file may have export lists to report: diff --git a/matfile.scm b/matfile.scm index 2e3ff15..a7a96a6 100644 --- a/matfile.scm +++ b/matfile.scm @@ -1,5 +1,5 @@ ; "matfile.scm", Read MAT-File Format version 4 (MATLAB) -; Copyright (c) 2001, 2002, 2003 Aubrey Jaffer +; Copyright (C) 2001, 2002, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -22,6 +22,15 @@ (require 'byte-number) (require-if 'compiling 'string-case) ; string-ci->symbol used by matfile:load +(define (unwritten-stubber name) + (lambda (arg) (slib:error 'name 'not 'written "matfile.scm"))) +(define bytes->vax-d-double (unwritten-stubber 'bytes->vax-d-double)) +(define bytes->vax-g-double (unwritten-stubber 'bytes->vax-g-double)) +(define bytes->cray-double (unwritten-stubber 'bytes->cray-double)) +(define bytes->vax-d-float (unwritten-stubber 'bytes->vax-d-float)) +(define bytes->vax-g-float (unwritten-stubber 'bytes->vax-g-float)) +(define bytes->cray-float (unwritten-stubber 'bytes->cray-float)) + ;;@code{(require 'matfile)} ;;@ftindex matfile ;;@ftindex matlab @@ -102,17 +111,17 @@ (set! imagf (case imagf ((0) #f) ((1) #t))) (let ((namstr (make-string namlen)) (mat (case m-type - ((numeric) (create-array + ((numeric) (make-array (case d-prot - ((0) ((if imagf Ac64 Ar64))) - ((1) ((if imagf Ac32 Ar32))) - ((2) (As32)) - ((3) (As16)) - ((4) (Au16)) - ((5) (Au8)) + ((0) ((if imagf A:floC64b A:floR64b))) + ((1) ((if imagf A:floC32b A:floR32b))) + ((2) (A:fixZ32b)) + ((3) (A:fixZ16b)) + ((4) (A:fixN16b)) + ((5) (A:fixN8b)) (else (slib:error 'p 'type d-prot))) mrows ncols)) - ((text) (create-array "." mrows ncols)) + ((text) (make-array "." mrows ncols)) ((sparse) (slib:error 'sparse '?))))) (do ((idx 0 (+ 1 idx))) ((>= idx namlen)) diff --git a/matfile.txi b/matfile.txi index 394ddbd..a4f2e53 100644 --- a/matfile.txi +++ b/matfile.txi @@ -23,9 +23,11 @@ file and returns a list of the results; a list of the name string and array for each matrix. @end defun + @defun matfile:load filename @var{filename} should be a string naming an existing file containing a MATLAB Version 4 MAT-File. The @code{matfile:load} procedure reads matrices from the file and defines the @code{string-ci->symbol} for each matrix to its corresponding array. @code{matfile:load} returns a list of the symbols defined. @end defun + diff --git a/minimize.txi b/minimize.txi index 785be35..3e1a8a6 100644 --- a/minimize.txi +++ b/minimize.txi @@ -46,3 +46,4 @@ Analytically, the minimum of x^3-2x-5 is 0.816497. ==> (816.4965933140557e-3 . -6.088662107903635) @end example @end defun + diff --git a/mitscheme.init b/mitscheme.init index 934de62..9768155 100644 --- a/mitscheme.init +++ b/mitscheme.init @@ -19,7 +19,7 @@ ;;; (Uniform Resource Identifier) for this scheme implementation's home ;;; page; or false if there isn't one. (define (scheme-implementation-home-page) - "http://www.swiss.ai.mit.edu/projects/scheme/") + "http://swiss.csail.mit.edu/projects/scheme/") ;;; (scheme-implementation-version) should return a string describing ;;; the version the scheme implementation loading this file. @@ -66,42 +66,116 @@ ;;; customize a computer environment for a user. (define (home-vicinity) (->namestring (user-homedir-pathname))) - -;;; *features* should be set to a list of symbols describing features -;;; of this implementation. See Template.scm for the list of feature -;;; names. +;@ +(define (in-vicinity vicinity file-name) + (->namestring (merge-pathnames file-name vicinity))) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") + ;(SLIB:LOAD-SOURCE "filename") compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features ; **** no, for several reasons -; r5rs ;conforms to +;;; r5rs ;conforms to ; **** no -- special arguments not supported -; eval ;R5RS two-argument eval +;;; eval ;R5RS two-argument eval ; **** sort of -- not integrated with continuations values ;R5RS multiple values dynamic-wind ;R5RS dynamic-wind - fluid-let +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to - ; **** no -- #F and '() are identical -; ieee-p1178 ;conforms to +;;; ieee-p1178 ;conforms to -; r3rs ;conforms to +;;; r3rs ;conforms to rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, @@ -110,18 +184,17 @@ ;-1+, <?, <=?, =?, >?, >=? object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE - transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + full-continuation ;can return multiple times ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. defmacro ;has Common Lisp DEFMACRO record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and @@ -130,17 +203,18 @@ pretty-print object->string ; **** limited subset with (load-option 'format) -; format ;Common-lisp output formatting +;;; format ;Common-lisp output formatting trace ;has macros: TRACE and UNTRACE compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; ed ;(ED) is editor system ;posix (system <string>) getenv ;posix (getenv <string>) -; program-arguments ;returns list of strings (argv) +;;; program-arguments ;returns list of strings (argv) current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features + fluid-let queue Xwindows )) @@ -328,17 +402,7 @@ (begin (environment-define (the-environment) 'macro:eval slib:eval) (environment-define (the-environment) 'macro:load load))) - -(define (slib:eval-load <pathname> evl) - (if (not (file-exists? <pathname>)) - (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) - (call-with-input-file <pathname> - (lambda (port) - (let ((old-load-pathname *load-pathname*)) - (fluid-let ((*load-pathname* <pathname>)) - (do ((o (read port) (read port))) - ((eof-object? o)) - (evl o))))))) +;; slib:eval-load definition moved to "require.scm" ;; Older implementations need this definition. (if (lexical-unreferenceable? (the-environment) 'record-modifier) @@ -349,19 +413,19 @@ (apply warn args)) ;; define an error procedure for the library -(define (slib:error . args) +(define (slib:error first . args) (if (provided? 'trace) (print-call-stack (current-error-port))) - (apply error args)) + (case first + ((wrong-type-argument) (apply error:wrong-type-argument args)) + ((bad-range-argument) (apply error:bad-range-argument args)) + (else (apply error first args)))) ;; define these as appropriate for your system. (define slib:tab (name->char "tab")) (define slib:form-feed (name->char "page")) -(define (in-vicinity vicinity file-name) - (->namestring (merge-pathnames file-name vicinity))) - ;;; Define SLIB:EXIT to be the implementation procedure to exit or -;;; return if exitting not supported. +;;; return if exiting not supported. (define slib:exit (lambda args (cond ((null? args) (exit)) diff --git a/mkclrnam.scm b/mkclrnam.scm index 7377f37..3e0c553 100644 --- a/mkclrnam.scm +++ b/mkclrnam.scm @@ -198,7 +198,7 @@ (define *rcs-header* (read-line port)) (do ((line (read-line port) (read-line port))) ((eof-object? line) - (display "Inserted ") (display *idx*) (display "colors") (newline) + (display "Inserted ") (display *idx*) (display " colors") (newline) *rcs-header*) (let ((colin (parse-rgb-line line))) (cond ((equal? "" line)) @@ -222,7 +222,7 @@ ;;This section has detailed the procedures for creating and loading ;;color dictionaries. So where are the dictionaries to load? ;; -;;@uref{http://swissnet.ai.mit.edu/~jaffer/Color/Dictionaries.html} +;;@uref{http://swiss.csail.mit.edu/~jaffer/Color/Dictionaries.html} ;; ;;@noindent ;;Describes and evaluates several color-name dictionaries on the web. @@ -234,13 +234,14 @@ ;;containing the @dfn{Resene} and @dfn{saturate} color-name ;;dictionaries. ;; -;;If the files @file{resenecolours.txt} and @file{saturate.txt} exist in -;;the @r{library-vicinity}, then they used as the source of color-name -;;data. Otherwise, @0 calls url->color-dictionary with the URLs of -;;appropriate source files. +;;If the files @file{resenecolours.txt}, @file{nbs-iscc.txt}, and +;;@file{saturate.txt} exist in the @r{library-vicinity}, then they +;;used as the source of color-name data. Otherwise, @0 calls +;;url->color-dictionary with the URLs of appropriate source files. (define (make-slib-color-name-db) (define cndb (create-database (in-vicinity (library-vicinity) "clrnamdb.scm") 'alist-table)) + (or cndb (slib:error 'cannot 'create 'database "clrnamdb.scm")) (for-each (lambda (lst) (apply @@ -250,10 +251,13 @@ (file->color-dictionary filename name cndb) (url->color-dictionary url name cndb))) lst)) - '(("http://swissnet.ai.mit.edu/~jaffer/Color/saturate.txt" + '(("http://swiss.csail.mit.edu/~jaffer/Color/saturate.txt" "saturate.txt" saturate) - ("http://swissnet.ai.mit.edu/~jaffer/Color/resenecolours.txt" + ("http://swiss.csail.mit.edu/~jaffer/Color/resenecolours.txt" "resenecolours.txt" - resene))) + resene) + ("http://swiss.csail.mit.edu/~jaffer/Color/nbs-iscc.txt" + "nbs-iscc.txt" + nbs-iscc))) (close-database cndb)) diff --git a/mkclrnam.txi b/mkclrnam.txi index 3eeb892..f2a0c14 100644 --- a/mkclrnam.txi +++ b/mkclrnam.txi @@ -16,6 +16,7 @@ values. @code{file->color-dictionary} creates a table @var{table-name} in @var{ in @var{file} into it. @end defun + @defun url->color-dictionary url table-name rdb base-table-type @@ -27,11 +28,12 @@ string @var{url} using the @dfn{wget} program; then calls @cindex wget @code{file->color-dictionary} to enter its associations in @var{table-name} in @var{url}. @end defun + @noindent This section has detailed the procedures for creating and loading color dictionaries. So where are the dictionaries to load? -@uref{http://swissnet.ai.mit.edu/~jaffer/Color/Dictionaries.html} +@uref{http://swiss.csail.mit.edu/~jaffer/Color/Dictionaries.html} @noindent Describes and evaluates several color-name dictionaries on the web. @@ -47,8 +49,9 @@ containing the @dfn{Resene} and @dfn{saturate} color-name @cindex saturate dictionaries. -If the files @file{resenecolours.txt} and @file{saturate.txt} exist in -the @r{library-vicinity}, then they used as the source of color-name -data. Otherwise, @code{make-slib-color-name-db} calls url->color-dictionary with the URLs of -appropriate source files. +If the files @file{resenecolours.txt}, @file{nbs-iscc.txt}, and +@file{saturate.txt} exist in the @r{library-vicinity}, then they +used as the source of color-name data. Otherwise, @code{make-slib-color-name-db} calls +url->color-dictionary with the URLs of appropriate source files. @end defun + diff --git a/mklibcat.scm b/mklibcat.scm index e6a0321..2047f86 100644 --- a/mklibcat.scm +++ b/mklibcat.scm @@ -71,6 +71,7 @@ (hash "hash") (sierpinski "sierpinski") (hilbert-fill "phil-spc") + (peano-fill "peanosfc") (soundex "soundex") (hash-table "hashtab") (logical "logical") @@ -87,7 +88,7 @@ (common-list-functions "comlist") (tree "tree") (coerce "coerce") - ;;(format "format") + (format "format") (generic-write "genwrite") (pretty-print "pp") (pprint-file "ppfile") @@ -137,6 +138,7 @@ (chapter-order "chap") (posix-time "psxtime") (common-lisp-time "cltime") + (time-core "timecore") (time-zone defmacro "timezone") (relational-database "rdms") (databases "dbutil") @@ -188,6 +190,7 @@ (color-database defmacro "mkclrnam") (resene color-names "clrnamdb.scm") (saturate color-names "clrnamdb.scm") + (nbs-iscc color-names "clrnamdb.scm") (daylight "daylight") (matfile "matfile") (mat-file matfile) @@ -208,6 +211,9 @@ (srfi-2 defmacro "srfi-2") (srfi-8 macro "srfi-8") (srfi-9 macro "srfi-9") + (srfi-47 array) + (srfi-63 array) + (srfi-60 logical) (new-catalog "mklibcat") )))) (let* ((req (in-vicinity (library-vicinity) diff --git a/modular.scm b/modular.scm index e836100..052bf92 100644 --- a/modular.scm +++ b/modular.scm @@ -245,20 +245,18 @@ ;;@args modulus n2 n3 ;;Returns (@var{n2} ^ @var{n3}) mod @var{modulus}. -(define modular:expt - (let ((integer-expt (and (provided? 'inexact) expt))) - (lambda (m n xpn) - (cond ((= n 1) 1) - ((= n (- m 1)) (if (odd? xpn) n 1)) - ((and (zero? m) integer-expt) (integer-expt n xpn)) - ((negative? xpn) - (modular:expt m (modular:invert m n) (- xpn))) - ((zero? n) 0) - (else - (do ((x n (modular:* m x x)) - (j xpn (quotient j 2)) - (acc 1 (if (even? j) acc (modular:* m x acc)))) - ((<= j 1) - (case j - ((0) acc) - ((1) (modular:* m x acc)))))))))) +(define (modular:expt m n xpn) + (cond ((= n 1) 1) + ((= n (- m 1)) (if (odd? xpn) n 1)) + ((zero? m) (expt n xpn)) + ((negative? xpn) + (modular:expt m (modular:invert m n) (- xpn))) + ((zero? n) 0) + (else + (do ((x n (modular:* m x x)) + (j xpn (quotient j 2)) + (acc 1 (if (even? j) acc (modular:* m x acc)))) + ((<= j 1) + (case j + ((0) acc) + ((1) (modular:* m x acc)))))))) diff --git a/modular.txi b/modular.txi index d947b35..bf2cd52 100644 --- a/modular.txi +++ b/modular.txi @@ -26,28 +26,33 @@ If @var{x1} and @var{x2} are integers, then @code{mod} behaves like @end format @end defun + @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. @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: @@ -79,27 +84,32 @@ 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 n2 Returns an integer n such that 1 = (n * @var{n2}) mod @var{modulus}. If @var{n2} has no inverse mod @var{modulus} an error is signaled. @end defun + @defun modular:negate modulus n2 Returns (@minus{}@var{n2}) mod @var{modulus}. @end defun + @defun modular:+ modulus n2 n3 Returns (@var{n2} + @var{n3}) mod @var{modulus}. @end defun + @defun modular:- modulus n2 n3 Returns (@var{n2} @minus{} @var{n3}) mod @var{modulus}. @end defun + @defun modular:* modulus n2 n3 Returns (@var{n2} * @var{n3}) mod @var{modulus}. @@ -108,7 +118,9 @@ The Scheme code for @code{modular:*} with negative @var{modulus} is not completed for fixnum-only implementations. @end defun + @defun modular:expt modulus n2 n3 Returns (@var{n2} ^ @var{n3}) mod @var{modulus}. @end defun + diff --git a/nbs-iscc.txt b/nbs-iscc.txt new file mode 100644 index 0000000..a02368e --- /dev/null +++ b/nbs-iscc.txt @@ -0,0 +1,295 @@ +; http://tx4.us/nbs-iscc.htm +; NBS/ISCC Color System +; +;Copyright © 2003 Voluntocracy. Permission is granted to copy and +;distribute modified or unmodified versions of this color dictionary +;provided the copyright notice and this permission notice are preserved +;on all copies and the entire such work is distributed under the terms +;of a permission notice identical to this one. +; +;"Pink" and "brown" are used instead of the more logical "pale red" and +;"dark orange". +; +;http://www.anthus.com/Colors/Cent.html by David A. Mundie, converted +;the NBS Centroid colors from Munsell to CIE XYZ, then converted to Mac +;QuickDraw RGB. The colors were visibly biased towards pink and had +;duplications. +; +;John Foster reconverted supplied Munsell values via Munsell software +;downloaded from www.gretagmacbeth.com <http://www.gretagmacbeth.com> +;directly to RGB, and tried to resolve some duplicates. Some of these +;don't even look right, because some of the bright colors are on the +;dark fringes with less chroma and are not centered and high up on the +;hue curves. Many of the original Munsell values (noted) are outside +;the RGB gamut, and have been adjusted to the closest brightest RGB +;value by changing chroma until 0 or 255 is reached in one out of +;bounds RGB component. Guesses were made in a few cases (noted) where +;the color was still illogical compared to the name. + +"Vivid Pink" sRGB:FFB5BA +"Strong Pink" sRGB:EA9399 +"Deep Pink" sRGB:E4717A +"Light Pink" sRGB:F9CCCA +"Moderate Pink" sRGB:DEA5A4 +"Dark Pink" sRGB:C08081 +"Pale Pink" sRGB:EAD8D7 +"Grayish Pink" sRGB:C4AEAD +"Pinkish White" sRGB:EAE3E1 +"Pinkish Gray" sRGB:C1B6B3 +"Vivid Red" sRGB:BE0032 +"Strong Red" sRGB:BC3F4A +"Deep Red" sRGB:841B2D +"Very Deep Red" sRGB:5C0923 +"Moderate Red" sRGB:AB4E52 +"Dark Red" sRGB:722F37 +"Very Dark Red" sRGB:3F1728 +"Light Grayish Red" sRGB:AD8884 +"Grayish Red" sRGB:905D5D +"Dark Grayish Red" sRGB:543D3F +"Blackish Red" sRGB:2E1D21 +"Reddish Gray" sRGB:8F817F +"Dark Reddish Gray" sRGB:5C504F +"Reddish Black" sRGB:282022 +"Vivid Yellowish Pink" sRGB:FFB7A5 +"Strong Yellowish Pink" sRGB:F99379 +"Deep Yellowish Pink" sRGB:E66721 +"Light Yellowish Pink" sRGB:F4C2C2 +"Moderate Yellowish Pink" sRGB:D9A6A9 +"Dark Yellowish Pink" sRGB:C48379 +"Pale Yellowish Pink" sRGB:ECD5C5 +"Grayish Yellowish Pink" sRGB:C7ADA3 +"Brownish Pink" sRGB:C2AC99 +"Vivid Reddish Orange" sRGB:E25822 +"Strong Reddish Orange" sRGB:D9603B +"Deep Reddish Orange" sRGB:AA381E +"Moderate Reddish Orange" sRGB:CB6D51 +"Dark Reddish Orange" sRGB:9E4732 +"Grayish Reddish Orange" sRGB:B4745E +"Strong Reddish Brown" sRGB:882D17 +"Deep Reddish Brown" sRGB:56070C +"Light Reddish Brown" sRGB:A87C6D +"Moderate Reddish Brown" sRGB:79443B +"Dark Reddish Brown" sRGB:3E1D1E +"Light Grayish Reddish Brown" sRGB:977F73 +"Grayish Reddish Brown" sRGB:674C47 +"Dark Grayish Reddish Brown" sRGB:43302E +"Vivid Orange" sRGB:F38400 +"Brilliant Orange" sRGB:FD943F +"Strong Orange" sRGB:ED872D +"Deep Orange" sRGB:BE6516 +"Light Orange" sRGB:FAB57F +"Moderate Orange" sRGB:D99058 +"Brownish Orange" sRGB:AE6938 +"Strong Brown" sRGB:80461B +"Deep Brown" sRGB:593319 +"Light Brown" sRGB:A67B5B +"Moderate Brown" sRGB:6F4E37 +"Dark Brown" sRGB:422518 +"Light Grayish Brown" sRGB:958070 +"Grayish Brown" sRGB:635147 +"Dark Grayish Brown" sRGB:3E322C +"Light Brownish Gray" sRGB:8E8279 +"Brownish Gray" sRGB:5B504F +"Brownish Black" sRGB:28201C +"Vivid Orange Yellow" sRGB:F6A600 +"Brilliant Orange Yellow" sRGB:FFC14F +"Strong Orange Yellow" sRGB:EAA221 +"Deep Orange Yellow" sRGB:C98500 +"Light Orange Yellow" sRGB:FBC97F +"Moderate Orange Yellow" sRGB:E3A857 +"Dark Orange Yellow" sRGB:BE8A3D +"Pale Orange Yellow" sRGB:FAD6A5 +"Strong Yellowish Brown" sRGB:996515 +"Deep Yellowish Brown" sRGB:654522 +"Light Yellowish Brown" sRGB:C19A6B +"Moderate Yellowish Brown" sRGB:826644 +"Dark Yellowish Brown" sRGB:4B3621 +"Light Grayish Yellowish Brown" sRGB:AE9B82 +"Grayish Yellowish Brown" sRGB:7E6D5A +"Dark Grayish Yellowish Brown" sRGB:483C32 +"Vivid Yellow" sRGB:F3C300 +"Brilliant Yellow" sRGB:FADA5E +"Strong Yellow" sRGB:D4AF37 +"Deep Yellow" sRGB:AF8D13 +"Light Yellow" sRGB:F8DE7E +"Moderate Yellow" sRGB:C9AE5D +"Dark Yellow" sRGB:AB9144 +"Pale Yellow" sRGB:F3E5AB +"Grayish Yellow" sRGB:C2B280 +"Dark Grayish Yellow" sRGB:A18F60 +"Yellowish White" sRGB:F0EAD6 +"Yellowish Gray" sRGB:BFB8A5 +"Light Olive Brown" sRGB:967117 +"Moderate Olive Brown" sRGB:6C541E +"Dark Olive Brown" sRGB:3B3121 +"Vivid Greenish Yellow" sRGB:DCD300 +"Brilliant Greenish Yellow" sRGB:E9E450 +"Strong Greenish Yellow" sRGB:BEB72E +"Deep Greenish Yellow" sRGB:9B9400 +"Light Greenish Yellow" sRGB:EAE679 +"Moderate Greenish Yellow" sRGB:B9B459 +"Dark Greenish Yellow" sRGB:98943E +"Pale Greenish Yellow" sRGB:EBE8A4 +"Grayish Greenish Yellow" sRGB:B9B57D +"Light Olive" sRGB:867E36 +"Moderate Olive" sRGB:665D1E +"Dark Olive" sRGB:403D21 +"Light Grayish Olive" sRGB:8C8767 +"Grayish Olive" sRGB:5B5842 +"Dark Grayish Olive" sRGB:363527 +"Light Olive Gray" sRGB:8A8776 +"Olive Gray" sRGB:57554C +"Olive Black" sRGB:25241D +"Vivid Yellow Green" sRGB:8DB600 +"Brilliant Yellow Green" sRGB:BDDA57 +"Strong Yellow Green" sRGB:7E9F2E +"Deep Yellow Green" sRGB:467129 +"Light Yellow Green" sRGB:C9DC89 +"Moderate Yellow Green" sRGB:8A9A5B +"Pale Yellow Green" sRGB:DADFB7 +"Grayish Yellow Green" sRGB:8F9779 +"Strong Olive Green" sRGB:404F00 +"Deep Olive Green" sRGB:232F00 +"Moderate Olive Green" sRGB:4A5D23 +"Dark Olive Green" sRGB:2B3D26 +"Grayish Olive Green" sRGB:515744 +"Dark Grayish Olive Green" sRGB:31362B +"Vivid Yellowish Green" sRGB:27A64C +"Brilliant Yellowish Green" sRGB:83D37D +"Strong Yellowish Green" sRGB:44944A +"Deep Yellowish Green" sRGB:00622D +"Very Deep Yellowish Green" sRGB:003118 +"Very Light Yellowish Green" sRGB:B6E5AF +"Light Yellowish Green" sRGB:93C592 +"Moderate Yellowish Green" sRGB:679267 +"Dark Yellowish Green" sRGB:355E3B +"Very Dark Yellowish Green" sRGB:173620 +"Vivid Green" sRGB:008856 +"Brilliant Green" sRGB:3EB489 +"Strong Green" sRGB:007959 +"Deep Green" sRGB:00543D +"Very Light Green" sRGB:8ED1B2 +"Light Green" sRGB:6AAB8E +"Moderate Green" sRGB:3B7861 +"Dark Green" sRGB:1B4D3E +"Very Dark Green" sRGB:1C352D +"Very Pale Green" sRGB:C7E6D7 +"Pale Green" sRGB:8DA399 +"Grayish Green" sRGB:5E716A +"Dark Grayish Green" sRGB:3A4B47 +"Blackish Green" sRGB:1A2421 +"Greenish White" sRGB:DFEDE8 +"Light Greenish Gray" sRGB:B2BEB5 +"Greenish Gray" sRGB:7D8984 +"Dark Greenish Gray" sRGB:4E5755 +"Greenish Black" sRGB:1E2321 +"Vivid Bluish Green" sRGB:008882 +"Brilliant Bluish Green" sRGB:00A693 +"Strong Bluish Green" sRGB:007A74 +"Deep Bluish Green" sRGB:00443F +"Very Light Bluish Green" sRGB:96DED1 +"Light Bluish Green" sRGB:66ADA4 +"Moderate Bluish Green" sRGB:317873 +"Dark Bluish Green" sRGB:004B49 +"Very Dark Bluish Green" sRGB:002A29 +"Vivid Greenish Blue" sRGB:0085A1 +"Brilliant Greenish Blue" sRGB:239EBA +"Strong Greenish Blue" sRGB:007791 +"Deep Greenish Blue" sRGB:2E8495 +"Very Light Greenish Blue" sRGB:9CD1DC +"Light Greenish Blue" sRGB:66AABC +"Moderate Greenish Blue" sRGB:367588 +"Dark Greenish Blue" sRGB:004958 +"Very Dark Greenish Blue" sRGB:002E3B +"Vivid Blue" sRGB:00A1C2 +"Brilliant Blue" sRGB:4997D0 +"Strong Blue" sRGB:0067A5 +"Deep Blue" sRGB:00416A +"Very Light Blue" sRGB:A1CAF1 +"Light Blue" sRGB:70A3CC +"Moderate Blue" sRGB:436B95 +"Dark Blue" sRGB:00304E +"Very Pale Blue" sRGB:BCD4E6 +"Pale Blue" sRGB:91A3B0 +"Grayish Blue" sRGB:536878 +"Dark Grayish Blue" sRGB:36454F +"Blackish Blue" sRGB:202830 +"Bluish White" sRGB:E9E9ED +"Light Bluish Gray" sRGB:B4BCC0 +"Bluish Gray" sRGB:81878B +"Dark Bluish Gray" sRGB:51585E +"Bluish Black" sRGB:202428 +"Vivid Purplish Blue" sRGB:30267A +"Brilliant Purplish Blue" sRGB:6C79B8 +"Strong Purplish Blue" sRGB:545AA7 +"Deep Purplish Blue" sRGB:272458 +"Very Light Purplish Blue" sRGB:B3BCE2 +"Light Purplish Blue" sRGB:8791BF +"Moderate Purplish Blue" sRGB:4E5180 +"Dark Purplish Blue" sRGB:252440 +"Very Pale Purplish Blue" sRGB:C0C8E1 +"Pale Purplish Blue" sRGB:8C92AC +"Grayish Purplish Blue" sRGB:4C516D +"Vivid Violet" sRGB:9065CA +"Brilliant Violet" sRGB:7E73B8 +"Strong Violet" sRGB:604E97 +"Deep Violet" sRGB:32174D +"Very Light Violet" sRGB:DCD0FF +"Light Violet" sRGB:8C82B6 +"Moderate Violet" sRGB:604E81 +"Dark Violet" sRGB:2F2140 +"Very Pale Violet" sRGB:C4C3DD +"Pale Violet" sRGB:9690AB +"Grayish Violet" sRGB:554C69 +"Vivid Purple" sRGB:9A4EAE +"Brilliant Purple" sRGB:D399E6 +"Strong Purple" sRGB:875692 +"Deep Purple" sRGB:602F6B +"Very Deep Purple" sRGB:401A4C +"Very Light Purple" sRGB:D5BADB +"Light Purple" sRGB:B695C0 +"Moderate Purple" sRGB:86608E +"Dark Purple" sRGB:563C5C +"Very Dark Purple" sRGB:301934 +"Very Pale Purple" sRGB:D6CADD +"Pale Purple" sRGB:AA98A9 +"Grayish Purple" sRGB:796878 +"Dark Grayish Purple" sRGB:50404D +"Blackish Purple" sRGB:291E29 +"Purplish White" sRGB:E8E3E5 +"Light Purplish Gray" sRGB:BFB9BD +"Purplish Gray" sRGB:8B8589 +"Dark Purplish Gray" sRGB:5D555B +"Purplish Black" sRGB:242124 +"Vivid Reddish Purple" sRGB:870074 +"Strong Reddish Purple" sRGB:9E4F88 +"Deep Reddish Purple" sRGB:702963 +"Very Deep Reddish Purple" sRGB:54194E +"Light Reddish Purple" sRGB:B784A7 +"Moderate Reddish Purple" sRGB:915C83 +"Dark Reddish Purple" sRGB:5D3954 +"Very Dark Reddish Purple" sRGB:341731 +"Pale Reddish Purple" sRGB:AA8A9E +"Grayish Reddish Purple" sRGB:836479 +"Brilliant Purplish Pink" sRGB:FFC8D6 +"Strong Purplish Pink" sRGB:E68FAC +"Deep Purplish Pink" sRGB:DE6FA1 +"Light Purplish Pink" sRGB:EFBBCC +"Moderate Purplish Pink" sRGB:D597AE +"Dark Purplish Pink" sRGB:C17E91 +"Pale Purplish Pink" sRGB:E8CCD7 +"Grayish Purplish Pink" sRGB:C3A6B1 +"Vivid Purplish Red" sRGB:CE4676 +"Strong Purplish Red" sRGB:B3446C +"Deep Purplish Red" sRGB:78184A +"Very Deep Purplish Red" sRGB:54133B +"Moderate Purplish Red" sRGB:A8516E +"Dark Purplish Red" sRGB:673147 +"Very Dark Purplish Red" sRGB:38152C +"Light Grayish Purplish Red" sRGB:AF868E +"Grayish Purplish Red" sRGB:915F6D +"White" sRGB:F2F3F4 +"Light Gray" sRGB:B9B8B5 +"Medium Gray" sRGB:848482 +"Dark Gray" sRGB:555555 +"Black" sRGB:222222 diff --git a/ncbi-dna.txi b/ncbi-dna.txi index 9a5babc..160b9ee 100644 --- a/ncbi-dna.txi +++ b/ncbi-dna.txi @@ -5,17 +5,20 @@ Reads the NCBI-format DNA sequence following the word @samp{ORIGIN} from @var{port}. @end defun + @defun ncbi:read-file file Reads the NCBI-format DNA sequence following the word @samp{ORIGIN} from @var{file}. @end defun + @defun mrna<-cdna str Replaces @samp{T} with @samp{U} in @var{str} @end defun + @defun codons<-cdna cdna Returns a list of three-letter symbol codons comprising the protein @@ -23,12 +26,14 @@ sequence encoded by @var{cdna} starting with its first occurence of @samp{atg}. @end defun + @defun protein<-cdna cdna Returns a list of three-letter symbols for the protein sequence encoded by @var{cdna} starting with its first occurence of @samp{atg}. @end defun + @defun p<-cdna cdna Returns a string of one-letter amino acid codes for the protein @@ -36,6 +41,7 @@ sequence encoded by @var{cdna} starting with its first occurence of @samp{atg}. @end defun + These cDNA count routines provide a means to check the nucleotide sequence with the @samp{BASE COUNT} line preceding the sequence from NCBI. @@ -47,8 +53,10 @@ Returns a list of counts of @samp{a}, @samp{c}, @samp{g}, and @samp{t} occurrencing in @var{cdna}. @end defun + @defun cdna:report-base-count cdna Prints the counts of @samp{a}, @samp{c}, @samp{g}, and @samp{t} occurrencing in @var{cdna}. @end defun + diff --git a/obj2str.txi b/obj2str.txi index 83e8b1b..9b19f46 100644 --- a/obj2str.txi +++ b/obj2str.txi @@ -3,7 +3,9 @@ Returns the textual representation of @var{obj} as a string. @end defun + @defun object->limited-string obj limit Returns the textual representation of @var{obj} as a string of length at most @var{limit}. @end defun + diff --git a/peanosfc.scm b/peanosfc.scm new file mode 100644 index 0000000..4a4039a --- /dev/null +++ b/peanosfc.scm @@ -0,0 +1,109 @@ +; "peanospc.scm": Peano space filling mapping +; Copyright (C) 2005 Aubrey Jaffer +; +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, 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 warranty or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +(require 'array) + +;;; A. R. Butz. +;;; Space filling curves and mathematical programming. +;;; Information and Control, 12:314-330, 1968. + +(define (integer->tet-array scalar rank) + (do ((tets '() (cons (modulo scl 3) tets)) + (scl scalar (quotient scl 3))) + ((zero? scl) + (let* ((len (length tets)) + (depth (quotient (+ len rank -1) rank))) + (define tra (make-array (A:fixN8b 0) rank depth)) + (set! tets (reverse tets)) + (do ((idx (+ -1 depth) (+ -1 idx))) + ((negative? idx)) + (do ((rdx 0 (+ 1 rdx))) + ((>= rdx rank)) + (cond ((null? tets)) + (else (array-set! tra (car tets) rdx idx) + (set! tets (cdr tets)))))) + tra)))) + +(define (tet-array->integer tra) + (define rank (car (array-dimensions tra))) + (define depth (cadr (array-dimensions tra))) + (define val 0) + (do ((idx 0 (+ 1 idx))) + ((>= idx depth) val) + (do ((rdx (+ -1 rank) (+ -1 rdx))) + ((negative? rdx)) + (set! val (+ (array-ref tra rdx idx) (* 3 val)))))) + +(define (tet-array->coordinates tra) + (define rank (car (array-dimensions tra))) + (define depth (cadr (array-dimensions tra))) + (do ((rdx (+ -1 rank) (+ -1 rdx)) + (lst '() (cons (do ((idx 0 (+ 1 idx)) + (val 0 (+ (array-ref tra rdx idx) (* 3 val)))) + ((>= idx depth) val)) + lst))) + ((negative? rdx) lst))) + +(define (coordinates->tet-array coords) + (define depth (do ((scl (apply max coords) (quotient scl 3)) + (dpt 0 (+ 1 dpt))) + ((zero? scl) dpt))) + (define rank (length coords)) + (let ((tra (make-array (A:fixN8b 0) rank depth))) + (do ((rdx 0 (+ 1 rdx)) + (cds coords (cdr cds))) + ((null? cds)) + (do ((idx (+ -1 depth) (+ -1 idx)) + (scl (car cds) (quotient scl 3))) + ((negative? idx)) + (array-set! tra (modulo scl 3) rdx idx))) + tra)) + +(define (peano-flip! tra) + (define parity 0) + (define rank (car (array-dimensions tra))) + (define depth (cadr (array-dimensions tra))) + (do ((idx 0 (+ 1 idx))) + ((>= idx depth)) + (do ((rdx (+ -1 rank) (+ -1 rdx))) + ((negative? rdx)) + (let ((v_ij (array-ref tra rdx idx)) + (tpar parity)) + (do ((idx (+ -1 idx) (+ -1 idx))) + ((negative? idx)) + (set! tpar (+ (array-ref tra rdx idx) tpar))) + (array-set! tra (if (odd? tpar) (- 2 v_ij) v_ij) rdx idx) + (set! parity (modulo (+ parity v_ij) 2)))))) + +;;@body +;;Returns a list of @2 nonnegative integer coordinates corresponding +;;to exact nonnegative integer @1. The lists returned by @0 for @1 +;;arguments 0 and 1 will differ in the first element. +(define (integer->peano-coordinates scalar rank) + (define tra (integer->tet-array scalar rank)) + (peano-flip! tra) + (tet-array->coordinates tra)) + +;;@body +;;Returns an exact nonnegative integer corresponding to @1, a list of +;;nonnegative integer coordinates. +(define (peano-coordinates->integer coords) + (define tra (coordinates->tet-array coords)) + (peano-flip! tra) + (tet-array->integer tra)) diff --git a/peanosfc.txi b/peanosfc.txi new file mode 100644 index 0000000..10cc256 --- /dev/null +++ b/peanosfc.txi @@ -0,0 +1,15 @@ + +@defun integer->peano-coordinates scalar rank + +Returns a list of @var{rank} nonnegative integer coordinates corresponding +to exact nonnegative integer @var{scalar}. The lists returned by @code{integer->peano-coordinates} for @var{scalar} +arguments 0 and 1 will differ in the first element. +@end defun + + +@defun peano-coordinates->integer coords + +Returns an exact nonnegative integer corresponding to @var{coords}, a list of +nonnegative integer coordinates. +@end defun + diff --git a/phil-spc.scm b/phil-spc.scm index 3372ce6..65863da 100644 --- a/phil-spc.scm +++ b/phil-spc.scm @@ -1,5 +1,5 @@ -; "phil-spc.scm": Peano-Hilbert space filling mapping -; Copyright (c) 2003 Aubrey Jaffer +; "phil-spc.scm": Hilbert space filling mapping +; Copyright (C) 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -23,11 +23,12 @@ ;;@ftindex hilbert-fill ;; ;;@noindent -;;@cindex Peano ;;@cindex Hilbert ;;@cindex Space-Filling -;;The @dfn{Peano-Hilbert Space-Filling Curve} is a one-to-one mapping +;;The @dfn{Hilbert Space-Filling Curve} is a one-to-one mapping ;;between a unit line segment and an @var{n}-dimensional unit cube. +;;This implementation treats the nonnegative integers either as +;;fractional bits of a given width or as nonnegative integers. ;; ;;@noindent ;;The integer procedures map the non-negative integers to an @@ -35,60 +36,211 @@ ;;origin and all coordinates are non-negative. ;; ;;@noindent -;;For any exact nonnegative integers @var{scalar} and @var{rank}, +;;For any exact nonnegative integer @var{scalar} and exact integer +;;@var{rank} > 2, ;; ;;@example ;;(= @var{scalar} (hilbert-coordinates->integer ;; (integer->hilbert-coordinates @var{scalar} @var{rank}))) ;; @result{} #t ;;@end example +;; +;;When treating integers as @var{k} fractional bits, +;; +;;@example +;;(= @var{scalar} (hilbert-coordinates->integer +;; (integer->hilbert-coordinates @var{scalar} @var{rank} @var{k})) @var{k}) +;; @result{} #t +;;@end example -;;@body + + +;;@args scalar rank ;;Returns a list of @2 integer coordinates corresponding to exact ;;non-negative integer @1. The lists returned by @0 for @1 arguments ;;0 and 1 will differ in the first element. -(define (integer->hilbert-coordinates scalar rank) - (define ndones (logical:ones rank)) +;; +;;@args scalar rank k +;; +;;@1 must be a nonnegative integer of no more than +;;@code{@2*@var{k}} bits. +;; +;;@0 Returns a list of @2 @var{k}-bit nonnegative integer +;;coordinates corresponding to exact non-negative integer @1. The +;;curves generated by @0 have the same alignment independent of +;;@var{k}. +(define (integer->hilbert-coordinates scalar rank . nbits) + (define igry (integer->gray-code scalar)) + (define rnkmsk (lognot (ash -1 rank))) + (define rnkhib (ash 1 (+ -1 rank))) (define rank*nbits - (let ((rank^2 (* rank rank))) - (* (quotient (+ -1 rank^2 (integer-length scalar)) rank^2) - rank^2))) - (let ((nthbits (quotient (logical:ones rank*nbits) ndones))) - (define igry (logxor (integer->gray-code scalar) (ash nthbits -1))) - (do ((bdxn (- rank rank*nbits) (+ rank bdxn)) - (chnk (logand (ash igry (- rank rank*nbits)) ndones) - (logand (ash igry (+ rank bdxn)) ndones)) - (rotation 0 (modulo (+ (integer-length (logand (- chnk) chnk)) - 1 rotation) - rank)) - (flipbit 0 (ash 1 rotation)) - (bignum 0 (+ (logxor flipbit (logical:rotate chnk rotation rank)) - (ash bignum rank)))) - ((positive? bdxn) - (map gray-code->integer (bitwise:delaminate rank bignum)))))) + (if (null? nbits) + (let ((rank^2 (* rank rank))) + (* (quotient (+ -1 rank^2 (integer-length scalar)) rank^2) + rank^2)) + (* rank (car nbits)))) + (do ((bdxn (- rank rank*nbits) (+ rank bdxn)) + (chnk (ash igry (- rank rank*nbits)) + (logxor rnkhib (logand (ash igry (+ rank bdxn)) rnkmsk))) + (rotation 0 (modulo (+ (log2-binary-factors chnk) 2 rotation) rank)) + (flipbit 0 (ash 1 rotation)) + (lst '() (cons (logxor flipbit (rotate-bit-field chnk rotation 0 rank)) + lst))) + ((positive? bdxn) + (map gray-code->integer (delaminate-list rank (reverse lst)))))) -;;@body +;;@args coords +;;@args coords k ;;Returns an exact non-negative integer corresponding to @1, a list ;;of non-negative integer coordinates. -(define (hilbert-coordinates->integer coords) +(define (hilbert-coordinates->integer coords . nbits) (define rank (length coords)) - (define bignum (apply bitwise:laminate (map integer->gray-code coords))) - (let ((rank*nbits - (* (quotient (+ -1 rank (integer-length (apply max coords))) rank) - rank rank)) - (ndones (logical:ones rank))) - (define nthbits (quotient (logical:ones rank*nbits) ndones)) - (define (loop bdxn rotation flipbit scalar) - (if (positive? bdxn) - (gray-code->integer (logxor scalar (ash nthbits -1))) - (let ((chnk (logical:rotate - (logxor flipbit (logand ndones (ash bignum bdxn))) - (- rotation) - rank))) - (loop (+ rank bdxn) - (modulo (+ (integer-length (logand (- chnk) chnk)) - 1 rotation) - rank) + (let ((lst (delaminate-list rank (map integer->gray-code coords))) + (rnkhib (ash 1 (+ -1 rank)))) + (define (loop lst rotation flipbit scalar) + (if (null? lst) + (gray-code->integer scalar) + (let ((chnk (rotate-bit-field (logxor flipbit (car lst)) + (- rotation) 0 rank))) + (loop (cdr lst) + (modulo (+ (log2-binary-factors chnk) 2 rotation) rank) (ash 1 rotation) - (+ chnk (ash scalar rank)))))) - (loop (- rank rank*nbits) 0 0 0))) + (logior (logxor rnkhib chnk) (ash scalar rank)))))) + (loop (cdr lst) + (modulo (+ (log2-binary-factors (car lst)) 2) rank) + 1 + (car lst)))) + +;;@subsubsection Gray code +;; +;;@cindex Gray code +;;@noindent +;;A @dfn{Gray code} is an ordering of non-negative integers in which +;;exactly one bit differs between each pair of successive elements. There +;;are multiple Gray codings. An n-bit Gray code corresponds to a +;;Hamiltonian cycle on an n-dimensional hypercube. +;; +;;@noindent +;;Gray codes find use communicating incrementally changing values between +;;asynchronous agents. De-laminated Gray codes comprise the coordinates +;;of Hilbert space-filling curves. +;; +;; +;;@defun integer->gray-code k +;;Converts @var{k} to a Gray code of the same @code{integer-length} as +;;@var{k}. +;; +;;@defunx gray-code->integer k +;;Converts the Gray code @var{k} to an integer of the same +;;@code{integer-length} as @var{k}. +;; +;;For any non-negative integer @var{k}, +;;@example +;;(eqv? k (gray-code->integer (integer->gray-code k))) +;;@end example +;;@end defun +(define (integer->gray-code k) + (logxor k (arithmetic-shift k -1))) +(define (gray-code->integer k) + (if (negative? k) + (slib:error 'gray-code->integer 'negative? k) + (let ((kln (integer-length k))) + (do ((d 1 (* d 2)) + (ans (logxor k (arithmetic-shift k -1)) ; == (integer->gray-code k) + (logxor ans (arithmetic-shift ans (* d -2))))) + ((>= (* 2 d) kln) ans))))) + +(define (grayter k1 k2) + (define kl1 (integer-length k1)) + (define kl2 (integer-length k2)) + (if (eqv? kl1 kl2) + (> (gray-code->integer k1) (gray-code->integer k2)) + (> kl1 kl2))) + +;;@defun = k1 k2 +;;@defunx gray-code<? k1 k2 +;;@defunx gray-code>? k1 k2 +;;@defunx gray-code<=? k1 k2 +;;@defunx gray-code>=? k1 k2 +;;These procedures return #t if their Gray code arguments are +;;(respectively): equal, monotonically increasing, monotonically +;;decreasing, monotonically nondecreasing, or monotonically nonincreasing. +;; +;;For any non-negative integers @var{k1} and @var{k2}, the Gray code +;;predicate of @code{(integer->gray-code k1)} and +;;@code{(integer->gray-code k2)} will return the same value as the +;;corresponding predicate of @var{k1} and @var{k2}. +;;@end defun +(define (gray-code<? k1 k2) + (not (or (eqv? k1 k2) (grayter k1 k2)))) +(define (gray-code<=? k1 k2) + (or (eqv? k1 k2) (not (grayter k1 k2)))) +(define (gray-code>? k1 k2) + (and (not (eqv? k1 k2)) (grayter k1 k2))) +(define (gray-code>=? k1 k2) + (or (eqv? k1 k2) (grayter k1 k2))) + +;;@subsubsection Bitwise Lamination +;;@cindex lamination + +;;@args k1 @dots{} +;;Returns an integer composed of the bits of @var{k1} @dots{} interlaced +;;in argument order. Given @var{k1}, @dots{} @var{kn}, the n low-order +;;bits of the returned value will be the lowest-order bit of each +;;argument. +;; +;;@args count k +;;Returns a list of @var{count} integers comprised of every @var{count}h +;;bit of the integer @var{k}. +;; +;;@example +;;(map (lambda (k) (number->string k 2)) +;; (bitwise-delaminate 4 #x7654)) +;; @result{} ("0" "1111" "1100" "1010") +;;(number->string (bitwise-laminate 0 #b1111 #b1100 #b1010) 16) +;; @result{} "7654" +;@end example +;; +;;For any non-negative integers @var{k} and @var{count}: +;;@example +;;(eqv? k (bitwise-laminate (bitwise-delaminate count k))) +;;@end example +(define (bitwise-laminate . ks) + (define nks (length ks)) + (define nbs (apply max (map integer-length ks))) + (do ((kdx (+ -1 nbs) (+ -1 kdx)) + (ibs 0 (+ (list->integer (map (lambda (k) (logbit? kdx k)) ks)) + (arithmetic-shift ibs nks)))) + ((negative? kdx) ibs))) +(define (bitwise-delaminate count k) + (define nbs (* count (+ 1 (quotient (integer-length k) count)))) + (do ((kdx (- nbs count) (- kdx count)) + (lst (vector->list (make-vector count 0)) + (map (lambda (k bool) (+ (if bool 1 0) (arithmetic-shift k 1))) + lst + (integer->list (arithmetic-shift k (- kdx)) count)))) + ((negative? kdx) lst))) + +;;@body +;; +;;Returns a list of @var{count} integers comprised of the @var{j}th +;;bit of the integers @var{ks} where @var{j} ranges from @var{count}-1 +;;to 0. +;; +;;@example +;;(map (lambda (k) (number->string k 2)) +;; (delaminate-list 4 '(7 6 5 4 0 0 0 0))) +;; @result{} ("0" "11110000" "11000000" "10100000") +;;@end example +;; +;;@0 is its own inverse: +;;@example +;;(delaminate-list 8 (delaminate-list 4 '(7 6 5 4 0 0 0 0))) +;; @result{} (7 6 5 4 0 0 0 0) +;;@end example +(define (delaminate-list count ks) + (define nks (length ks)) + (do ((kdx 0 (+ 1 kdx)) + (lst '() (cons (list->integer (map (lambda (k) (logbit? kdx k)) ks)) + lst))) + ((>= kdx count) lst))) diff --git a/phil-spc.txi b/phil-spc.txi index 1193c6c..ac1743c 100644 --- a/phil-spc.txi +++ b/phil-spc.txi @@ -2,12 +2,13 @@ @ftindex hilbert-fill @noindent -@cindex Peano @cindex Hilbert @cindex Space-Filling -The @dfn{Peano-Hilbert Space-Filling Curve} is a one-to-one mapping -@cindex Peano-Hilbert Space-Filling Curve +The @dfn{Hilbert Space-Filling Curve} is a one-to-one mapping +@cindex Hilbert Space-Filling Curve between a unit line segment and an @var{n}-dimensional unit cube. +This implementation treats the nonnegative integers either as +fractional bits of a given width or as nonnegative integers. @noindent The integer procedures map the non-negative integers to an @@ -15,7 +16,8 @@ arbitrarily large @var{n}-dimensional cube with its corner at the origin and all coordinates are non-negative. @noindent -For any exact nonnegative integers @var{scalar} and @var{rank}, +For any exact nonnegative integer @var{scalar} and exact integer +@var{rank} > 2, @example (= @var{scalar} (hilbert-coordinates->integer @@ -23,16 +25,136 @@ For any exact nonnegative integers @var{scalar} and @var{rank}, @result{} #t @end example +When treating integers as @var{k} fractional bits, + +@example +(= @var{scalar} (hilbert-coordinates->integer + (integer->hilbert-coordinates @var{scalar} @var{rank} @var{k})) @var{k}) + @result{} #t +@end example + @defun integer->hilbert-coordinates scalar rank Returns a list of @var{rank} integer coordinates corresponding to exact non-negative integer @var{scalar}. The lists returned by @code{integer->hilbert-coordinates} for @var{scalar} arguments 0 and 1 will differ in the first element. + + +@defunx integer->hilbert-coordinates scalar rank k + +@var{scalar} must be a nonnegative integer of no more than +@code{@var{rank}*@var{k}} bits. + +@code{integer->hilbert-coordinates} Returns a list of @var{rank} @var{k}-bit nonnegative integer +coordinates corresponding to exact non-negative integer @var{scalar}. The +curves generated by @code{integer->hilbert-coordinates} have the same alignment independent of +@var{k}. @end defun + @defun hilbert-coordinates->integer coords + +@defunx hilbert-coordinates->integer coords k Returns an exact non-negative integer corresponding to @var{coords}, a list of non-negative integer coordinates. @end defun + +@subsubsection Gray code + +@cindex Gray code +@noindent +A @dfn{Gray code} is an ordering of non-negative integers in which +@cindex Gray code +exactly one bit differs between each pair of successive elements. There +are multiple Gray codings. An n-bit Gray code corresponds to a +Hamiltonian cycle on an n-dimensional hypercube. + +@noindent +Gray codes find use communicating incrementally changing values between +asynchronous agents. De-laminated Gray codes comprise the coordinates +of Hilbert space-filling curves. + + +@defun integer->gray-code k +Converts @var{k} to a Gray code of the same @code{integer-length} as +@var{k}. + +@defunx gray-code->integer k +Converts the Gray code @var{k} to an integer of the same +@code{integer-length} as @var{k}. + +For any non-negative integer @var{k}, +@example +(eqv? k (gray-code->integer (integer->gray-code k))) +@end example +@end defun + +@defun = k1 k2 +@defunx gray-code<? k1 k2 +@defunx gray-code>? k1 k2 +@defunx gray-code<=? k1 k2 +@defunx gray-code>=? k1 k2 +These procedures return #t if their Gray code arguments are +(respectively): equal, monotonically increasing, monotonically +decreasing, monotonically nondecreasing, or monotonically nonincreasing. + +For any non-negative integers @var{k1} and @var{k2}, the Gray code +predicate of @code{(integer->gray-code k1)} and +@code{(integer->gray-code k2)} will return the same value as the +corresponding predicate of @var{k1} and @var{k2}. +@end defun + +@subsubsection Bitwise Lamination +@cindex lamination + + +@defun bitwise-laminate k1 @dots{} +@defunx bitwise-delaminate count k + +Returns an integer composed of the bits of @var{k1} @dots{} interlaced +in argument order. Given @var{k1}, @dots{} @var{kn}, the n low-order +bits of the returned value will be the lowest-order bit of each +argument. + + +@defunx bitwise-laminate count k +Returns a list of @var{count} integers comprised of every @var{count}h +bit of the integer @var{k}. + +@example +(map (lambda (k) (number->string k 2)) + (bitwise-delaminate 4 #x7654)) + @result{} ("0" "1111" "1100" "1010") +(number->string (bitwise-laminate 0 #b1111 #b1100 #b1010) 16) + @result{} "7654" +@end example + +For any non-negative integers @var{k} and @var{count}: +@example +(eqv? k (bitwise-laminate (bitwise-delaminate count k))) +@end example +@end defun + + +@defun delaminate-list count ks + + +Returns a list of @var{count} integers comprised of the @var{j}th +bit of the integers @var{ks} where @var{j} ranges from @var{count}-1 +to 0. + +@example +(map (lambda (k) (number->string k 2)) + (delaminate-list 4 '(7 6 5 4 0 0 0 0))) + @result{} ("0" "11110000" "11000000" "10100000") +@end example + +@code{delaminate-list} is its own inverse: +@example +(delaminate-list 8 (delaminate-list 4 '(7 6 5 4 0 0 0 0))) + @result{} (7 6 5 4 0 0 0 0) +@end example +@end defun + @@ -40,6 +40,21 @@ (loop (read-char port)) (slib:error chr 'unexpected 'character)))))) +;; Comments beginning with "#" and ending with newline are permitted in +;; the header of a pnm file. +(define (pnm:read-value port) + (let loop () + (let ((chr (peek-char port))) + (cond ((eof-object? chr) + (slib:error 'unexpected 'eof port)) + ((char-whitespace? chr) + (read-char port) + (loop)) + ((char=? chr #\#) + (read-line port) + (loop)) + (else (read port)))))) + ;;@args path ;;The string @1 must name a @dfn{portable bitmap graphics} file. ;;@0 returns a list of 4 items: @@ -84,22 +99,44 @@ (char-numeric? c2) (char-whitespace? (peek-char port))) (let* ((format (string->symbol (string #\p c2))) - (width (read port)) - (height (read port)) + (width (pnm:read-value port)) + (height (pnm:read-value port)) (ret (case format ((p1) (list 'pbm width height 1)) ((p4) (list 'pbm-raw width height 1)) - ((p2) (list 'pgm width height (read port))) - ((p5) (list 'pgm-raw width height (read port))) - ((p3) (list 'ppm width height (read port))) - ((p6) (list 'ppm-raw width height (read port))) + ((p2) (list 'pgm width height (pnm:read-value port))) + ((p5) (list 'pgm-raw width height (pnm:read-value port))) + ((p3) (list 'ppm width height (pnm:read-value port))) + ((p6) (list 'ppm-raw width height (pnm:read-value port))) (else #f)))) (and (char-whitespace? (read-char port)) ret))) (else #f))) (call-with-open-ports (open-file port 'rb) pnm:type-dimensions))) -(define (pnm:read-bit-vector! array port) +(define (pnm:write-bits array port) + (define dims (array-dimensions array)) + (let* ((height (car (array-dimensions array))) + (width (cadr (array-dimensions array))) + (wid8 (logand -8 width))) + (do ((jdx 0 (+ 1 jdx))) + ((>= jdx height)) + (let ((row (subarray array jdx))) + (do ((idx 0 (+ 8 idx))) + ((>= idx wid8) + (if (< idx width) + (do ((idx idx (+ 1 idx)) + (bdx 7 (+ -1 bdx)) + (bts 0 (+ bts (ash (if (array-ref row idx) 1 0) bdx)))) + ((>= idx width) + (write-byte bts port))))) + (do ((idx idx (+ 1 idx)) + (bdx 7 (+ -1 bdx)) + (bts 0 (+ bts bts (if (array-ref row idx) 1 0)))) + ((negative? bdx) + (write-byte bts port)))))))) + +(define (pnm:read-bits! array port) (define dims (array-dimensions array)) (let* ((height (car (array-dimensions array))) (width (cadr (array-dimensions array))) @@ -147,7 +184,11 @@ (lambda (port) (apply (lambda (type width height max-pixel) (define (read-binary) - (array-map! array (lambda () (read-byte port))) + (array-map! array + (if (<= max-pixel 256) + (lambda () (read-byte port)) + (lambda () (define hib (read-byte port)) + (+ (* 256 hib) (read-byte port))))) (if (eof-object? (peek-char port)) array (slib:error type 'not 'at 'file 'end))) (define (read-text) @@ -163,36 +204,34 @@ (case type ((pbm) (or array - (set! array (create-array (At1) height width))) + (set! array (make-array (A:bool) height width))) (read-pbm)) ((pgm) (or array - (set! array (create-array - ((if (<= max-pixel 256) Au8 Au16)) + (set! array (make-array + ((if (<= max-pixel 256) A:fixN8b A:fixN16b)) height width))) (read-text)) ((ppm) (or array - (set! array (create-array - ((if (<= max-pixel 256) Au8 Au16)) + (set! array (make-array + ((if (<= max-pixel 256) A:fixN8b A:fixN16b)) height width 3))) (read-text)) ((pbm-raw) (or array - (set! array (create-array (At1) height width))) - (pnm:read-bit-vector! array port)) + (set! array (make-array (A:bool) height width))) + (pnm:read-bits! array port)) ((pgm-raw) (or array - (set! array (create-array (Au8) height width))) + (set! array (make-array (A:fixN8b) height width))) (read-binary)) ((ppm-raw) (or array - (set! array (create-array (Au8) height width 3))) + (set! array (make-array (A:fixN8b) height width 3))) (read-binary)))) (pnm:type-dimensions port))))) -;; ARRAY is required to be zero-based. - ;;@args type array maxval path comment @dots{} ;; ;;Writes the contents of @2 to a @1 image file named @4. The file @@ -225,12 +264,15 @@ (newline port) (if (not (boolean? (array-ref array 0 0))) (slib:error 'pnm:array-write "expected bit-array" array)) - (uniform-array-write array port)) + (pnm:write-bits array port)) ((pgm-raw ppm-raw) (newline port) - ;;(uniform-array-write array port) - (array-for-each (lambda (byt) (write-byte byt port)) array) - ) + (array-for-each (if (<= maxval 256) + (lambda (byt) (write-byte byt port)) + (lambda (byt) + (write-byte (quotient byt 256) port) + (write-byte (modulo byt 256) port))) + array)) ((pbm) (do ((i 0 (+ i 1))) ((>= i height)) @@ -40,6 +40,7 @@ are from 0 to @var{maxval} @end table @end defun + @defun pnm:image-file->array path array @@ -56,6 +57,7 @@ Reads the @dfn{portable bitmap graphics} file named by @var{path} into @cindex portable bitmap graphics @end defun + @defun pnm:array-write type array maxval path comment @dots{} @@ -64,3 +66,4 @@ will have pixel values between 0 and @var{maxval}, which must be compatible with @var{type}. For @samp{pbm} files, @var{maxval} must be @samp{1}. @var{comment}s are included in the file header. @end defun + @@ -33,8 +33,7 @@ (fun outport) (call-with-output-file outport fun)))) (lambda (export) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* inport) + (with-load-pathname inport (letrec ((lp (lambda (c) (cond ((eof-object? c)) ((char-whitespace? c) @@ -62,8 +61,8 @@ (read-char port) (set! c (peek-char port)))) (lp c)))))))) - (lp (peek-char port))) - (set! *load-pathname* old-load-pathname))))))) + (lambda () + (lp (peek-char port)))))))))) ;@ (define (pprint-file ifile . optarg) (pprint-filter-file ifile @@ -393,7 +393,7 @@ ((#\f #\F) (f digs exp #f)) ((#\g #\G) (g digs exp)) ((#\k) (k digs exp "")) - ((#\K) (k digs exp " ")))) + ((#\K) (k digs exp ".")))) (append (format-real signed? sgn digs exp) (apply format-real #t rest) '("i")))) diff --git a/priorque.txi b/priorque.txi index a1cd195..9306a89 100644 --- a/priorque.txi +++ b/priorque.txi @@ -14,20 +14,24 @@ Returns a binary heap suitable which can be used for priority queue operations. @end defun + @defun heap-length heap Returns the number of elements in @var{heap}. @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. @end deffn + @deffn {Procedure} 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. @end deffn + diff --git a/pscheme.init b/pscheme.init index b791df6..a4012d2 100644 --- a/pscheme.init +++ b/pscheme.init @@ -18,9 +18,6 @@ (number->string (caddr v))))) (define (scheme-implementation-home-page) "http://www.mazama.net/scheme/pscheme.htm") - -(define in-vicinity string-append) - (define (implementation-vicinity) "\\Program Files\\Pocket Scheme\\") (define (library-vicinity) (in-vicinity (implementation-vicinity) "slib\\")) (define (home-vicinity) "\\My Documents\\") @@ -28,74 +25,148 @@ ;(define (implementation-vicinity) "D:\\SRC\\PSCHEME\\BUILD\\TARGET\\X86\\NT\\DBG\\") ;(define (library-vicinity) "D:\\SRC\\SLIB\\") ;(define (home-vicinity) "D:\\SRC\\PSCHEME\\") - +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to +;;; r5rs ;conforms to eval ;R5RS two-argument eval -; values ;R5RS multiple values +;;; values ;R5RS multiple values dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to ieee-p1178 ;conforms to -; r3rs ;conforms to +;;; r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; ieee-floating-point ;conforms to IEEE Standard 754-1985 + full-continuation ;can return multiple times +;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort -; pretty-print -; object->string -; format ;Common-lisp output formatting +;;; sort +;;; pretty-print +;;; object->string +;;; format ;Common-lisp output formatting ; Undef this to get the SLIB TRACE macros -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; getenv ;posix (getenv <string>) +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features @@ -194,18 +265,7 @@ (define base:eval slib:eval) (define defmacro: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))))) +;; slib:eval-load definition moved to "require.scm" (define (defmacro:load <pathname>) (slib:eval-load <pathname> defmacro:eval)) @@ -250,7 +310,7 @@ (define 1- -1+) ;;; Define SLIB:EXIT to be the implementation procedure to exit or -;;; return if exitting not supported. +;;; return if exiting not supported. (define slib:exit exit) ;;; Here for backward compatability diff --git a/psxtime.scm b/psxtime.scm index 753e81f..fed0707 100644 --- a/psxtime.scm +++ b/psxtime.scm @@ -19,106 +19,32 @@ ;;; No, it doesn't do leap seconds. +(require 'time-core) (require-if 'compiling 'time-zone) - -(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* ((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 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 (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 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) - (quotient secs 60) ; Minutes. [0-59] - tm_hour ; Hours. [0-23] - (+ tm_mday 1) ; Day. [1-31] - tm_mon ; Month. [0-11] - (- tm_year 1900) ; Year - 1900. - tm_wday ; Day of week. [0-6] - tm_yday ; Days in year. [0-365] - tm_isdst ; DST. [-1/0/1] - tm_gmtoff ; Seconds west of UTC. - tm_zone ; Timezone abbreviation. - ))))))))))) ;@ -(define (gmtime t) - (time:split t 0 0 "GMT")) +(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" zone)))) ;@ (define (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)) - (trough ; rough time for target - (do ((i 5 (+ i -1)) - (trough time:year-70 - (offset-time trough (* (vector-ref target i) - (vector-ref times i))))) - ((negative? i) trough)))) -;;; (print 'trough trough 'target target) - (let loop ((guess trough) - (j 0) - (guess-tm (decoder trough))) -;;; (print 'guess guess 'guess-tm guess-tm) - (do ((i 5 (+ i -1)) - (rough time:year-70 - (offset-time rough (* (vector-ref guess-tm i) - (vector-ref times i)))) - (sign (let ((d (- (vector-ref target 5) - (vector-ref guess-tm 5)))) - (and (not (zero? d)) d)) - (or sign - (let ((d (- (vector-ref target i) - (vector-ref guess-tm i)))) - (and (not (zero? d)) d))))) - ((negative? i) - (let* ((distance (abs (- trough rough)))) - (cond ((and (zero? distance) sign) -;;; (print "trying to jump") - (set! distance (if (negative? sign) -86400 86400))) - ((and sign (negative? sign)) (set! distance (- distance)))) - (set! guess (offset-time guess distance)) -;;; (print 'distance distance 'sign sign) - (cond ((zero? distance) guess) - ((> j 5) #f) ;to prevent inf loops. - (else - (loop guess - (+ 1 j) - (decoder guess)))))))))) ;@ (define (mktime univtime . tz) (require 'time-zone) (set! tz (if (null? tz) (tzset) (car tz))) - (+ (gmktime univtime) (tz:std-offset tz))) + (offset-time (gmktime univtime) (tz:std-offset tz))) ;@ (define (gmktime univtime) (time:invert time:gmtime univtime)) @@ -150,8 +76,65 @@ (time:asctime (time:gmtime time))) ;;; GMT Local -- take optional 2nd TZ arg -(define time:gmtime gmtime) (define time:localtime localtime) +;;@ +(define gmtime time:gmtime) + +(define time:localtime localtime) ;;(define time:gmktime gmktime) (define time:mktime mktime) ;;(define time:gtime gtime) (define time:ctime ctime) (define time:asctime asctime) + +;@ +(define daylight? #f) +(define *timezone* 0) +(define tzname '#("UTC" "???")) + +(define tz:default #f) + +;;;@ 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))))) + (let () + (require 'time-zone) + (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) @@ -80,14 +80,17 @@ (qp-string (lambda (str room) + (define len (string-length str)) + (define mid (quotient (- room 3) 2)) (cond - ((>= (string-length str) room 3) - (display (substring str 0 (- room 3))) + ((>= len room 3) + (display (substring str 0 (- room 3 mid))) (display "...") + (display (substring str (- len mid) len)) room) (else (display str) - (string-length str))))) + len)))) (qp-obj (lambda (obj room) @@ -13,26 +13,31 @@ called @dfn{dequeues}). A queue may also be used like a stack. Returns a new, empty queue. @end defun + @defun queue? obj Returns @code{#t} if @var{obj} is a queue. @end defun + @defun queue-empty? q Returns @code{#t} if the queue @var{q} is empty. @end defun + @deffn {Procedure} queue-push! q datum Adds @var{datum} to the front of queue @var{q}. @end deffn + @deffn {Procedure} enqueue! q datum Adds @var{datum} to the rear of queue @var{q}. @end deffn + @deffn {Procedure} dequeue! q @deffnx {Procedure} queue-pop! q @@ -40,6 +45,7 @@ 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. @end deffn + All of the following functions raise an error if the queue @var{q} is empty. @@ -49,12 +55,15 @@ is empty. Removes and returns (the list) of all contents of queue @var{q}. @end deffn + @defun queue-front q Returns the datum at the front of the queue @var{q}. @end defun + @defun queue-rear q Returns the datum at the rear of the queue @var{q}. @end defun + diff --git a/randinex.txi b/randinex.txi index b73f983..88dff74 100644 --- a/randinex.txi +++ b/randinex.txi @@ -10,6 +10,7 @@ Returns an uniformly distributed inexact real random number in the range between 0 and 1. @end defun + @defun random:exp @@ -19,6 +20,7 @@ an exponential distribution with mean @var{u} use @w{@code{(* @var{u} (random:exp))}}. @end defun + @defun random:normal @@ -29,6 +31,7 @@ standard deviation @var{d} use @w{@code{(+ @var{m} (* @var{d} (random:normal)))}}. @end defun + @deffn {Procedure} random:normal-vector! vect @@ -37,6 +40,7 @@ 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:hollow-sphere! vect @@ -47,6 +51,7 @@ of dimension n = @code{(vector-length @var{vect})}, the coordinates are uniformly distributed over the surface of the unit n-shere. @end deffn + @deffn {Procedure} random:solid-sphere! vect @@ -57,3 +62,4 @@ 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. @end deffn + @@ -62,10 +62,10 @@ (define bitlen (integer-length (+ -1 modu))) (define (rnd) (do ((bln bitlen (+ -8 bln)) - (rbs 0 (+ (ash rbs 8) (random:chunk state)))) + (rbs 0 (+ (arithmetic-shift rbs 8) (random:chunk state)))) ((<= bln 7) (if (positive? bln) - (set! rbs (logxor (ash rbs bln) + (set! rbs (logxor (arithmetic-shift rbs bln) (random:chunk state)))) (if (< rbs modu) rbs (rnd))))) (rnd)) @@ -19,6 +19,7 @@ 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 calls to @code{random}. @end defun + @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 @@ -37,6 +38,7 @@ Returns a new copy of argument @var{state}. Returns a new copy of @code{*random-state*}. @end defun + @defun seed->random-state seed Returns a new object of type suitable for use as the value of the @@ -48,6 +50,7 @@ Calling @code{seed->random-state} with unequal arguments will nearly always return unequal states. @end defun + @defun make-random-state @@ -61,3 +64,4 @@ is used as the seed. @end defun + @@ -10,6 +10,7 @@ and produces a reasonable answer for inexact arguments when inexact arithmetic is implemented using floating-point. @end defun + @code{Rationalize} has limited use in implementations lacking exact (non-integer) rational numbers. The following procedures return a list of the numerator and denominator. @@ -28,6 +29,7 @@ than @var{e}. @end format @end defun + @defun find-ratio-between x y @code{find-ratio-between} returns the list of the @emph{simplest} @@ -39,3 +41,4 @@ numerator and denominator between @var{x} and @var{y}. } @end format @end defun + @@ -17,6 +17,8 @@ ;promotional, or sales literature without prior written consent in ;each case. +(require 'rev4-optional-procedures) ;list-tail + (define rdms:catalog-name '*catalog-data*) (define rdms:domains-name '*domains-data*) (define rdms:columns-name '*columns*) @@ -493,7 +495,6 @@ (let ((translate-column (lambda (column) - ;;(print 'translate-column column column-name-alist) (let ((colp (assq column column-name-alist))) (cond (colp (cdr colp)) ((and (integer? column) @@ -540,7 +541,7 @@ (norm-mkeys mkeys))))) (else #f))) (else - (let ((index (- ci primary-limit 1)) + (let ((index (- ci (+ primary-limit 1))) (get-1 (base 'make-getter-1))) (cond (get-1 @@ -635,15 +636,16 @@ (define delete-table (and mutable (lambda (table-name) - ;;(or rdms:catalog (set! rdms:catalog (open-table rdms:catalog-name #t))) - (let* ((table (open-table table-name #t)) - (row ((rdms:catalog 'row:remove) table-name))) - (and row (base:kill-table - lldb - (list-ref row (+ -1 catalog:bastab-id-pos)) - (table 'primary-limit) - (table 'column-type-list)) - row))))) + (or rdms:catalog (set! rdms:catalog (open-table rdms:catalog-name #t))) + (and (table-exists? table-name) + (let ((table (open-table table-name #t)) + (row ((rdms:catalog 'row:remove) table-name))) + (and row (base:kill-table + lldb + (list-ref row (+ -1 catalog:bastab-id-pos)) + (table 'primary-limit) + (table 'column-type-list)) + row)))))) (lambda (operation-name) (case operation-name @@ -14,6 +14,7 @@ ;; changed identifiers containing VECTOR to VECT or VCT. (require 'common-list-functions) +(require 'rev4-optional-procedures) (define vector? vector?) (define vector-ref vector-ref) @@ -1,5 +1,5 @@ ; "repl.scm", read-eval-print-loop for Scheme -; Copyright (c) 1993, 2003 Aubrey Jaffer +; Copyright (C) 1993, 2003 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -46,12 +46,11 @@ (repl:load (lambda (<pathname>) (call-with-input-file <pathname> (lambda (port) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* <pathname>) - (do ((o (read port) (read port))) - ((eof-object? o)) - (repl:eval o)) - (set! *load-pathname* old-load-pathname)))))) + (with-load-pathname <pathname> + (lambda () + (do ((o (read port) (read port))) + ((eof-object? o)) + (repl:eval o)))))))) (repl:restart #f) (has-char-ready? (provided? 'char-ready?)) (repl:error (lambda args (require 'debug) (apply qpn args) diff --git a/require.scm b/require.scm index a11cbf5..ec97d7a 100644 --- a/require.scm +++ b/require.scm @@ -1,5 +1,5 @@ ;;;; Implementation of VICINITY and MODULES for Scheme -;Copyright (C) 1991, 1992, 1993, 1994, 1997, 2002, 2003 Aubrey Jaffer +;Copyright (C) 1991, 1992, 1993, 1994, 1997, 2002, 2003, 2005 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -17,69 +17,7 @@ ;promotional, or sales literature without prior written consent in ;each case. ;@ -(define *SLIB-VERSION* "3a1") -;@ -(define (user-vicinity) - (case (software-type) - ((VMS) "[.]") - (else ""))) -;@ -(define *load-pathname* #f) -;@ -(define vicinity:suffix? - (let ((suffi - (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\]))))) - (lambda (chr) (and (memv chr suffi) #t)))) -;@ -(define (pathname->vicinity pathname) - (let loop ((i (- (string-length pathname) 1))) - (cond ((negative? i) "") - ((vicinity:suffix? (string-ref pathname i)) - (substring pathname 0 (+ i 1))) - (else (loop (- i 1)))))) -(define (program-vicinity) - (if *load-pathname* - (pathname->vicinity *load-pathname*) - (slib:error 'program-vicinity " called; use slib:load to load"))) -;@ -(define sub-vicinity - (case (software-type) - ((VMS) (lambda - (vic name) - (let ((l (string-length vic))) - (if (or (zero? (string-length vic)) - (not (char=? #\] (string-ref vic (- l 1))))) - (string-append vic "[" name "]") - (string-append (substring vic 0 (- l 1)) - "." name "]"))))) - (else (let ((*vicinity-suffix* - (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) - (lambda (vic name) - (string-append vic name *vicinity-suffix*)))))) -;@ -(define (make-vicinity <pathname>) <pathname>) - -(define (slib:pathnameize-load *old-load*) - (lambda (<pathname> . extra) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* <pathname>) - (apply *old-load* (cons <pathname> extra)) - (set! *load-pathname* old-load-pathname)))) - -(set! slib:load-source - (slib:pathnameize-load slib:load-source)) -(set! slib:load - (slib:pathnameize-load slib:load)) +(define *SLIB-VERSION* "3a2") ;;;; MODULES ;@ @@ -183,7 +121,8 @@ (feval expression)) ;@ (define (provided? expression) - (define feature-list (cons (software-type) *features*)) + (define feature-list (cons (scheme-implementation-type) + (cons (software-type) *features*))) (define (provided? expression) (if (memq expression feature-list) #t (and *catalog* @@ -242,7 +181,6 @@ (define require:provided? provided?) (define require:require require) -(slib:provide 'vicinity) (if (and (string->number "0.0") (inexact? (string->number "0.0"))) (slib:provide 'inexact)) (if (rational? (string->number "1/19")) (slib:provide 'rational)) @@ -253,6 +191,7 @@ (cond ((slib:provided? 'srfi) + (slib:provide 'srfi-59) (do ((idx 0 (+ 1 idx)) (srfis (symbol->string 'srfi-))) ((> idx 100)) @@ -260,11 +199,33 @@ (if (slib:eval `(cond-expand (,srfi #t) (else #f))) (slib:provide srfi)))))) +(define (slib:pathnameize-load *old-load*) + (lambda (<pathname> . extra) + (with-load-pathname <pathname> + (lambda () + (apply *old-load* (cons <pathname> extra)))))) + +(set! slib:load-source + (slib:pathnameize-load slib:load-source)) +(set! slib:load + (slib:pathnameize-load slib:load)) + +;@ +(define (slib:eval-load <pathname> evl) + (if (not (file-exists? <pathname>)) + (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) + (call-with-input-file <pathname> + (lambda (port) + (with-load-pathname <pathname> + (lambda () + (do ((o (read port) (read port))) + ((eof-object? o)) + (evl o))))))) + (define report:print (lambda args (for-each (lambda (x) (write x) (display #\ )) args) (newline))) - ;@ (define slib:report (let ((slib:report (lambda () (slib:report-version) (slib:report-locations)))) @@ -295,8 +256,6 @@ (report:print '(IMPLEMENTATION-VICINITY) 'is (implementation-vicinity)) (report:print '(LIBRARY-VICINITY) 'is (library-vicinity)) (report:print '(SCHEME-FILE-SUFFIX) 'is (scheme-file-suffix)) - (cond (*load-pathname* - (report:print '*LOAD-PATHNAME* 'is *load-pathname*))) (let* ((i (+ -1 5))) (cond ((eq? (car features) (car *features*))) (else (report:print 'loaded '*FEATURES* ':) (display slib:tab))) diff --git a/s48-0_57.init b/s48-0_57.init deleted file mode 100644 index 672d559..0000000 --- a/s48-0_57.init +++ /dev/null @@ -1,412 +0,0 @@ -;;;"scheme48.init" Initialisation for SLIB for Scheme48-0.57 -*-scheme-*- -;;; Author: Aubrey Jaffer -;;; -;;; This code is in the public domain. - -,batch on -,load-package floatnums -,config -,load =scheme48/misc/packages.scm -(define-structure slib-primitives - (export s48-getenv - s48-system - s48-current-error-port - s48-force-output - s48-with-handler - s48-ascii->char - s48-error) - (open scheme signals ascii extended-ports i/o primitives handle - posix c-system-function) - (begin - (define s48-getenv lookup-environment-variable) - (define s48-system system) - (define s48-current-error-port current-error-port) - (define s48-force-output force-output) - (define s48-with-handler with-handler) - (define s48-ascii->char ascii->char) - (define s48-error error))) -,user -,open slib-primitives - -(define getenv s48-getenv) -(define system s48-system) - -;;; (software-type) should be set to the generic operating system type. -;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) - -;;; (scheme-implementation-type) should return the name of the scheme -;;; implementation loading this file. -(define (scheme-implementation-type) 'Scheme48) - -;;; (scheme-implementation-home-page) should return a (string) URI -;;; (Uniform Resource Identifier) for this scheme implementation's home -;;; page; or false if there isn't one. -(define (scheme-implementation-home-page) "http://s48.org/") - -;;; (scheme-implementation-version) should return a string describing -;;; the version of the scheme implementation loading this file. -(define scheme-implementation-version - (let ((version (getenv "S48_VERSION"))) - (lambda () version))) - -;;; (implementation-vicinity) should be defined to be the pathname of -;;; the directory where any auxiliary files to your Scheme -;;; implementation reside. -(define implementation-vicinity - (let ((vic (getenv "S48_VICINITY"))) - (lambda () vic))) - -;;; (library-vicinity) should be defined to be the pathname of the -;;; directory where files of Scheme library functions reside. -(define library-vicinity - (let ((vic (getenv "SCHEME_LIBRARY_PATH"))) - (lambda () vic))) - -;;; (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. -;;; -;;; Ivan Shmakov points out that evaluating (getenv "HOME") when -;;; compiling captures the installer's home directory. So delay until -;;; HOME-VICINITY is called. -(define (home-vicinity) - (let ((home (getenv "HOME"))) - (and home - (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) - home - (string-append home "/"))))) - -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. See Template.scm for the list of feature -;;; names. -(define *features* - '( - source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") - - ;; Scheme report features - - r5rs ;conforms to - eval ;R5RS two-argument eval - values ;R5RS multiple values - dynamic-wind ;R5RS dynamic-wind - macro ;R5RS high level macros - delay ;has DELAY and FORCE - multiarg-apply ;APPLY can take more than 2 args. - char-ready? - rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! - - r4rs ;conforms to - - ieee-p1178 ;conforms to - -; r3rs ;conforms to - -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, - ;SUBSTRING-MOVE-RIGHT!, - ;SUBSTRING-FILL!, - ;STRING-NULL?, APPEND!, 1+, - ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH - -; multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; ieee-floating-point ;conforms to IEEE Standard 754-1985 - ;IEEE Standard for Binary - ;Floating-Point Arithmetic. - full-continuation ;can return multiple times - - ;; Other common features - -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and - ;Interpretation of Computer - ;Programs by Abelson and Sussman. - defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures -; string-port ;has CALL-WITH-INPUT-STRING and - ;CALL-WITH-OUTPUT-STRING -; sort -; pretty-print -; object->string -; format ;Common-lisp output formatting -; 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) -; current-time ;returns time in seconds since 1/1/1970 - ;; Implementation Specific features - )) - -;;; (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 s48-current-error-port) - -;;; (TMPNAM) makes a temporary file name. -(define tmpnam - (let ((cntr 100)) - (lambda () (set! cntr (+ 1 cntr)) - (let ((tmp (string-append "slib_" (number->string cntr)))) - (if (file-exists? tmp) (tmpnam) tmp))))) - -;;; (FILE-EXISTS? <string>) -(define (file-exists? f) - (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 file-name) - (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) - (s48-force-output - (if (null? arg) (current-output-port) (car arg)))) - -(define (make-exchanger obj) - (lambda (rep) (let ((old obj)) (set! obj rep) old))) -(define (open-file filename modes) - (case modes - ((r rb) (open-input-file filename)) - ((w wb) (open-output-file filename)) - (else (slib:error 'open-file 'mode? modes)))) -(define (port? obj) (or (input-port? port) (output-port? port))) -(define (call-with-open-ports . ports) - (define proc (car ports)) - (cond ((procedure? proc) (set! ports (cdr ports))) - (else (set! ports (reverse ports)) - (set! proc (car ports)) - (set! ports (reverse (cdr ports))))) - (let ((ans (apply proc ports))) - (for-each close-port ports) - ans)) -(define (close-port port) - (cond ((input-port? port) - (close-input-port port) - (if (output-port? port) (close-output-port port))) - ((output-port? port) (close-output-port port)) - (else (slib:error 'close-port 'port? port)))) - -(define (browse-url url) - (define (try cmd) (eqv? 0 (system (sprintf #f cmd url)))) - (or (try "netscape-remote -remote 'openURL(%s)'") - (try "netscape -remote 'openURL(%s)'") - (try "netscape '%s'&") - (try "netscape '%s'"))) - -;;; "rationalize" adjunct procedures. -(define (find-ratio x e) - (let ((rat (rationalize x e))) - (list (numerator rat) (denominator rat)))) -(define (find-ratio-between x y) - (find-ratio (/ (+ x y) 2) (/ (- x y) 2))) - -;;; CHAR-CODE-LIMIT is one greater than the largest integer which can -;;; be returned by CHAR->INTEGER. -(define integer->char s48-ascii->char) -(define char->integer - (let ((char->integer char->integer) - (code0 (char->integer (integer->char 0)))) - (lambda (char) (- (char->integer char) code0)))) -(define char-code-limit 256) - -;;; Workaround MODULO bug -(define modulo - (let ((modulo modulo)) - (lambda (n1 n2) - (let ((ans (modulo n1 n2))) - (if (= ans n2) (- ans ans) ans))))) - -;;; Workaround atan bug -(define two-arg:atan atan) -(define (atan y . x) - (if (null? x) (two-arg:atan y 1) (two-arg:atan y (car x)))) - -;;; Workaround inexact->exact and exact->inexact bugs. -(define inexact->exact - (let ((i->e inexact->exact)) - (lambda (z) - (if (exact? z) z (i->e z))))) -(define exact->inexact - (let ((e->i exact->inexact)) - (lambda (z) - (if (inexact? z) z (e->i z))))) - -;;; MOST-POSITIVE-FIXNUM is used in modular.scm -(define most-positive-fixnum #x1FFFFFFF) - -;;; Return argument -(define identity values) - -;;; SLIB:EVAL is single argument eval using the top-level (user) environment. -(define slib:eval - (let ((eval eval) - (interaction-environment interaction-environment)) - (lambda (form) - (eval form (interaction-environment))))) - -;;; If your implementation provides R4RS macros: -(define macro:eval slib:eval) -(define (macro:load <pathname>) - (if (not (file-exists? <pathname>)) - (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) - (load <pathname>)) - -(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:load macro:load) - -(define (slib:eval-load <pathname> evl) - (if (not (file-exists? <pathname>)) - (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) - (call-with-input-file <pathname> - (lambda (port) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* <pathname>) - (do ((o (read port) (read port))) - ((eof-object? o)) - (evl o)) - (set! *load-pathname* old-load-pathname))))) - -(define slib:warn - (lambda args - (let ((cep (current-error-port))) - ;;(if (provided? 'trace) (print-call-stack cep)) - (display "Warn: " cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) args)))) - -;;; define an error procedure for the library -(define (slib:error . args) - ;;(if (provided? 'trace) (print-call-stack (current-error-port))) - (apply s48-error args)) - -;;; define these as appropriate for your system. -(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)) -(define t #t) -(define nil #f) - -;;; Define these if your implementation's syntax can support them and if -;;; they are not already defined. - -(define (1+ n) (+ n 1)) -(define (-1+ n) (+ n -1)) -;(define 1- -1+) - -(define in-vicinity string-append) - -;;; Define SLIB:EXIT to be the implementation procedure to exit or -;;; return if exitting not supported. -(define slib:exit (lambda args #f)) - -;;; Here for backward compatability -(define scheme-file-suffix - (case (software-type) - ((NOSVE) (lambda () "_scm")) - (else (lambda () ".scm")))) - -;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever -;;; suffix all the module files in SLIB have. See feature 'SOURCE. -(define (slib:load-source f) (load (string-append f (scheme-file-suffix)))) - -;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced -;;; by compiling "foo.scm" if this implementation can compile files. -;;; See feature 'COMPILED. -(define slib:load-compiled load) - -;;; At this point SLIB:LOAD must be able to load SLIB files. -(define slib:load slib:load-source) - -;;; 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) - -;;; Jacques Mequin wins the Spring 2001 SLIB extreme cleverness award: -(define-syntax defmacro - (lambda (e r c) - (let* ((e-fields (cdr e)) - (macro-name (car e-fields)) - (macro-args (cdr e-fields)) - (slib-store (eval 'defmacro:eval (interaction-environment)))) - (slib-store `(defmacro ,macro-name ,@macro-args))) - `(define-syntax ,(cadr e) - (lambda (em rm cm) - (let ((macro-name ',(cadr e)) - (macro-args (cdr em)) - (slib-eval (eval 'macroexpand-1 (interaction-environment)))) - (slib-eval `(,macro-name ,@macro-args))))))) - -(slib:load (in-vicinity (library-vicinity) "require")) - -;;; Needed to support defmacro -(require 'defmacroexpand) -(define *args* '()) -(define (program-arguments) (cons "scheme48" *args*)) -(set! *catalog* #f) - -,collect -,batch off -,dump slib.image "(slib 3a1)" -,exit diff --git a/saturate.txt b/saturate.txt index 63aa693..4d73f79 100644 --- a/saturate.txt +++ b/saturate.txt @@ -17,6 +17,7 @@ ;sales literature without prior written consent in each case. ;Saturated colors from "Approximate Colors on CIE Chromaticity Diagram" +;Francis S. Hill, "Computer Graphics" Macmillan, 1990, pg. 572 "reddish orange" CIEXYZ:0.658471/0.341258/0.000271188 "orange" CIEXYZ:0.602933/0.396497/0.000570581 @@ -27,13 +27,6 @@ (define (list-tail l p) (if (< p 1) l (list-tail (cdr l) (- p 1)))) ;@ -(define (string->list s) - (do ((i (- (string-length s) 1) (- i 1)) - (l '() (cons (string-ref s i) l))) - ((< i 0) l))) -;@ -(define (list->string l) (apply string l)) -;@ (define string-copy string-append) ;@ (define (string-fill! s obj) @@ -41,13 +34,6 @@ ((< i 0)) (string-set! s i obj))) ;@ -(define (list->vector l) (apply vector l)) -;@ -(define (vector->list s) - (do ((i (- (vector-length s) 1) (- i 1)) - (l '() (cons (vector-ref s i) l))) - ((< i 0) l))) -;@ (define (vector-fill! s obj) (do ((i (- (vector-length s) 1) (- i 1))) ((< i 0)) diff --git a/scamacr.scm b/scamacr.scm index d7db6c8..9f7300a 100644 --- a/scamacr.scm +++ b/scamacr.scm @@ -79,7 +79,7 @@ ((let* () e1 e2 ...) (syntax (let () e1 e2 ...))) ((let* ((x1 v1) (x2 v2) ...) e1 e2 ...) - (syncase:every identifier? (syntax (x1 x2 ...))) + (syncase:andmap identifier? (syntax (x1 x2 ...))) (syntax (let ((x1 v1)) (let* ((x2 v2) ...) e1 e2 ...))))))) (define-syntax case diff --git a/scheme2c.init b/scheme2c.init index a9dbab9..057dc76 100644 --- a/scheme2c.init +++ b/scheme2c.init @@ -58,79 +58,152 @@ home (string-append home "/"))) (else home))))) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. See Template.scm for the list of feature -;;; names. +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to -; eval ;R5RS two-argument eval -; values ;R5RS multiple values -; dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; r5rs ;conforms to +;;; eval ;R5RS two-argument eval +;;; values ;R5RS multiple values +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to ;; Follows rev4 as far as I can tell, modulo '() being false, ;; number syntax (see doc), incomplete tail recursion (see ;; docs) and a couple of bugs in some versions -- see below. -; ieee-p1178 ;conforms to +;;; ieee-p1178 ;conforms to r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE - transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + full-continuation ;can return multiple times ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. -; defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort +;;; sort pretty-print -; object->string +;;; object->string format ;Common-lisp output formatting trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; compiler ;has (COMPILER) +;;; ed ;(ED) is editor system ;posix (system <string>) -; getenv ;posix (getenv <string>) -; program-arguments ;returns list of strings (argv) -; current-time ;returns time in seconds since 1/1/1970 +;;; getenv ;posix (getenv <string>) +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + )) (define pretty-print pp) @@ -267,18 +340,7 @@ ;;; If your implementation provides R4RS macros: ;(define macro:eval slib:eval) ;(define macro:load load) - -(define (slib:eval-load <pathname> evl) - (if (not (file-exists? <pathname>)) - (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) - (call-with-input-file <pathname> - (lambda (port) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* <pathname>) - (do ((o (read port) (read port))) - ((eof-object? o)) - (evl o)) - (set! *load-pathname* old-load-pathname))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -331,13 +393,8 @@ ;;(define force force) -;;; (implementation-vicinity) should be defined to be the pathname of -;;; the directory where any auxillary files to your Scheme -;;; implementation reside. -(define in-vicinity string-append) - ;;; Define SLIB:EXIT to be the implementation procedure to exit or -;;; return if exitting not supported. +;;; return if exiting not supported. (define slib:exit (lambda args (exit))) ;;; Here for backward compatability diff --git a/scheme48.init b/scheme48.init index 0640120..8f91d54 100644 --- a/scheme48.init +++ b/scheme48.init @@ -8,28 +8,42 @@ ,config ,load =scheme48/misc/packages.scm (define-structure slib-primitives - (export s48-getenv + (export s48-modulo s48-atan s48-char->integer + s48-getenv s48-current-time s48-time-seconds s48-system s48-current-error-port s48-force-output s48-with-handler s48-ascii->char - s48-error) - (open scheme signals ascii extended-ports i/o primitives handle - unix-getenv ;Comment out for versions >= 0.54 -;;; posix ;Comment out for versions < 0.54 - ) - (begin - (define s48-getenv - getenv ;Comment out for versions >= 0.54 -;;; lookup-environment-variable ;Comment out for versions < 0.54 - ) - (define s48-system (lambda (c) (vm-extension 96 c))) - (define s48-current-error-port current-error-port) - (define s48-force-output force-output) - (define s48-with-handler with-handler) - (define s48-ascii->char ascii->char) - (define s48-error error))) + s48-error s48-warn + s48-make-string-input-port + s48-make-string-output-port + s48-string-output-port-output + s48-exit) + (open (modify scheme + (rename (modulo s48-modulo) (atan s48-atan) + (char->integer s48-char->integer))) + ; primitives + (modify posix + (rename (current-time s48-current-time) + (time-seconds s48-time-seconds) + (lookup-environment-variable s48-getenv))) + (modify c-system-function (rename (system s48-system))) + (modify i/o + (rename (current-error-port s48-current-error-port) + (force-output s48-force-output))) + (modify handle (rename (with-handler s48-with-handler))) + (modify ascii (rename (ascii->char s48-ascii->char))) + (modify signals (rename (error s48-error) (warn s48-warn))) + (modify root-scheduler (rename (scheme-exit-now s48-exit))) + (modify extended-ports + (rename (make-string-input-port + s48-make-string-input-port) + (make-string-output-port + s48-make-string-output-port) + (string-output-port-output + s48-string-output-port-output)))) + (begin #t)) ,user ,open slib-primitives @@ -71,33 +85,98 @@ ;;; (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. +;;; +;;; Ivan Shmakov points out that evaluating (getenv "HOME") when +;;; compiling captures the installer's home directory. So delay until +;;; HOME-VICINITY is called. (define (home-vicinity) (let ((home (getenv "HOME"))) (and home + (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) + home + (string-append home "/"))))) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME - (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) - home - (string-append home "/"))) - (else home))))) - -(let* ((siv (scheme-implementation-version)) - (num-ver (and siv (string->number siv)))) - (cond ((not num-ver)) - ((>= num-ver 0.54) - (set! system #f)))) - -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. See Template.scm for the list of feature -;;; names. + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. r5rs ;conforms to eval ;R5RS two-argument eval @@ -107,59 +186,60 @@ delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + +;;; multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to ieee-p1178 ;conforms to -; r3rs ;conforms to +;;; r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH -; multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; ieee-floating-point ;conforms to IEEE Standard 754-1985 + full-continuation ;can return multiple times +;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures -; string-port ;has CALL-WITH-INPUT-STRING and +;;; record ;has user defined data structures + string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort -; pretty-print -; object->string -; format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; sort +;;; pretty-print +;;; object->string +;;; format ;Common-lisp output formatting +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; program-arguments ;returns list of strings (argv) + current-time ;returns time in seconds since 1/1/1970 + ;; Implementation Specific features - )) -(if system ;posix (system <string>) - (set! *features* (cons 'system *features*))) + )) ;;; (OUTPUT-PORT-WIDTH <port>) (define (output-port-width . arg) 79) @@ -190,7 +270,7 @@ ;;; (DELETE-FILE <string>) (define (delete-file file-name) - (s48-system (string-append "rm " file-name))) + (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. @@ -200,11 +280,19 @@ (define (make-exchanger obj) (lambda (rep) (let ((old obj)) (set! obj rep) old))) + +;@ (define (open-file filename modes) - (case modes - ((r rb) (open-input-file filename)) - ((w wb) (open-output-file filename)) - (else (slib:error 'open-file 'mode? modes)))) + (call-with-current-continuation + (lambda (k) + (s48-with-handler + (lambda (condition decline) + (k #f)) + (case modes + ((r rb) (lambda () (open-input-file filename))) + ((w wb) (lambda () (open-output-file filename))) + (else (slib:error 'open-file 'mode? modes))))))) + (define (port? obj) (or (input-port? port) (output-port? port))) (define (call-with-open-ports . ports) (define proc (car ports)) @@ -238,36 +326,11 @@ ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can ;;; be returned by CHAR->INTEGER. +(define char-code-limit 256) (define integer->char s48-ascii->char) (define char->integer - (let ((char->integer char->integer) - (code0 (char->integer (integer->char 0)))) - (lambda (char) (- (char->integer char) code0)))) -(define char-code-limit 256) - -;;; Workaround MODULO bug -(define modulo - (let ((modulo modulo)) - (lambda (n1 n2) - (let ((ans (modulo n1 n2))) - (if (= ans n2) (- ans ans) ans))))) - -;;; Workaround atan bug -(define two-arg:atan atan) -(define (atan y . x) - (if (null? x) (two-arg:atan y 1) (two-arg:atan y (car x)))) -;;; asin is totally busted -(define (asin y) (two-arg:atan y (sqrt (- 1 (* y y))))) - -;;; Workaround inexact->exact and exact->inexact bugs. -(define inexact->exact - (let ((i->e inexact->exact)) - (lambda (z) - (if (exact? z) z (i->e z))))) -(define exact->inexact - (let ((e->i exact->inexact)) - (lambda (z) - (if (inexact? z) z (e->i z))))) + (let ((code0 (s48-char->integer (integer->char 0)))) + (lambda (char) (- (s48-char->integer char) code0)))) ;;; MOST-POSITIVE-FIXNUM is used in modular.scm (define most-positive-fixnum #x1FFFFFFF) @@ -324,35 +387,15 @@ (define (defmacro:eval x) (base:eval (defmacro:expand* x))) (define defmacro:load macro:load) +;; slib:eval-load definition moved to "require.scm" -(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 ((cep (current-error-port))) - (if (provided? 'trace) (print-call-stack cep)) - (display "Warn: " cep) - (write (car args) cep) - (newline cep) - (for-each (lambda (x) - (display " " cep) - (write x cep) - (newline cep)) - (cdr args))))) +(define (slib:warn . args) + ;;(if (provided? 'trace) (print-call-stack cep)) + (apply s48-warn args)) ;;; define an error procedure for the library (define (slib:error . args) - (if (provided? 'trace) (print-call-stack (current-error-port))) + ;;(if (provided? 'trace) (print-call-stack (current-error-port))) (apply s48-error args)) ;;; define these as appropriate for your system. @@ -371,11 +414,10 @@ (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)) +;;; return if exiting not supported. +(define (slib:exit . opt) + (s48-exit (if (pair? opt) (car opt) 0))) ;;; Here for backward compatability (define scheme-file-suffix @@ -385,7 +427,6 @@ ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever ;;; suffix all the module files in SLIB have. See feature 'SOURCE. - (define (slib:load-source f) (load (string-append f (scheme-file-suffix)))) ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced @@ -425,9 +466,26 @@ (require 'defmacroexpand) (define *args* '()) (define (program-arguments) (cons "scheme48" *args*)) -(set! *catalog* #f) + +;@ +(define (call-with-output-string proc) + (let ((port (s48-make-string-output-port))) + (proc port) + (s48-string-output-port-output port))) +(define (call-with-input-string string proc) + (proc (s48-make-string-input-port string))) + +;@ +(define (current-time) + (s48-time-seconds (s48-current-time))) +(define (difftime caltime1 caltime0) + (- caltime1 caltime0)) +(define (offset-time caltime offset) + (+ caltime offset)) + +(require #f) ,collect ,batch off -,dump slib.image "(slib 3a1)" +,dump slib.image "(slib 3a2)" ,exit diff --git a/schmooz.scm b/schmooz.scm index f50a397..9755260 100644 --- a/schmooz.scm +++ b/schmooz.scm @@ -326,6 +326,7 @@ (substitute-macs bl mac-list)) body)) (out 0 "@end " (caddr ops)) + (out 0) (out 0))) (define (schmooz-var defop name body xdefs) @@ -44,62 +44,150 @@ home (string-append home "/"))) (else home))))) - -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let ((old #f)) + (dynamic-wind + (lambda () (set! old (exchange path))) + thunk + (lambda () (exchange old))))))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 + + ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. + +;;; r5rs ;conforms to + eval ;R5RS two-argument eval + values ;R5RS multiple values + dynamic-wind ;R5RS dynamic-wind + macro ;R5RS high level macros + delay ;has DELAY and FORCE + multiarg-apply ;APPLY can take more than 2 args. + char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. + rationalize +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE + r4rs ;conforms to -; r3rs ;conforms to + ieee-p1178 ;conforms to -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; 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!, + +;;; r3rs ;conforms to + +;;; 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-TO-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 ;proposed 2-arugment eval -; record ;has user defined data structures - values ;proposed multiple values - dynamic-wind ;proposed dynamic-wind -; ieee-floating-point ;conforms to +;;; object-hash ;has OBJECT-HASH + full-continuation ;can return multiple times -; object-hash ;has OBJECT-HASH +;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 + ;IEEE Standard for Binary + ;Floating-Point Arithmetic. -; sort -; pretty-print -; object->string + ;; Other common features + +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. +;;; defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures +;;; string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING +;;; sort +;;; pretty-print +;;; object->string format -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor -; system ;posix (system <string>) +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + )) ;;; (OUTPUT-PORT-WIDTH <port>) @@ -219,18 +307,7 @@ (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))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -261,10 +338,8 @@ (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. +;;; return if exiting not supported. (define slib:exit (lambda args #f)) ;;; Here for backward compatability @@ -295,7 +370,6 @@ (define transcript-off #f) (define array? #f) -(define record? #f) (define sort! #f) (slib:load (in-vicinity (library-vicinity) "require")) diff --git a/simetrix.scm b/simetrix.scm index e187dd2..caf858e 100644 --- a/simetrix.scm +++ b/simetrix.scm @@ -19,7 +19,7 @@ ;; Implements "Representation of numerical values and SI units in ;; character strings for information interchanges" -;; http://swissnet.ai.mit.edu/~jaffer/MIXF.html +;; http://swiss.csail.mit.edu/~jaffer/MIXF (require 'precedence-parse) (require 'string-port) @@ -0,0 +1,45 @@ +.\" dummy line +.TH SLIB "Jan 22 2005" +.UC 4 +.SH NAME +SLIB \- Scheme Library +.SH SYNOPSIS +.B slib +[ scm | gsi | mzscheme | guile | slib48 | scheme48 | scmlit ] +.br +.sp 0.3 +.SH DESCRIPTION +"SLIB" is a portable library for the programming language "Scheme". +It provides a platform independent framework for using "packages" of +Scheme procedures and syntax. As distributed, SLIB contains many +useful packages. Its catalog can be transparently extended to +accomodate packages specific to a site, implementation, user, or +directory. +.SH OPTIONS +The optional argument to the +.I slib +script is the Scheme implementation to run. Absent the argument, it +searches for implementations in the above order. +.SH ENVIRONMENT VARIABLES +.TP +.B SCHEME_LIBRARY_PATH +is the SLIB Scheme library directory (with a trailing "/"). +.SH FILES +.TP +slib.info +.br +Texinfo documentation of +.I slib. +.SH AUTHORS +Aubrey Jaffer (agj @ alum.mit.edu) +and scores of others. +.SH SEE ALSO +The SLIB home-page: +.br +http://swissnet.ai.mit.edu/~jaffer/SLIB.html +.TP +The full documentation for slib is maintained as a Texinfo manual. If the info and slib programs are properly installed at your site, the command +.br +info slib +.TP +should give you access to the complete manual. diff --git a/slib.doc b/slib.doc new file mode 100644 index 0000000..b8701e4 --- /dev/null +++ b/slib.doc @@ -0,0 +1,47 @@ +SLIB(Jan 22 2005) SLIB(Jan 22 2005) + + + +NAME + SLIB - Scheme Library + +SYNOPSIS + slib [ scm | gsi | mzscheme | guile | slib48 | scheme48 | scmlit ] + +DESCRIPTION + "SLIB" is a portable library for the programming language "Scheme". It + provides a platform independent framework for using "packages" of + Scheme procedures and syntax. As distributed, SLIB contains many use- + ful packages. Its catalog can be transparently extended to accomodate + packages specific to a site, implementation, user, or directory. + +OPTIONS + The optional argument to the slib script is the Scheme implementation + to run. Absent the argument, it searches for implementations in the + above order. + +ENVIRONMENT VARIABLES + SCHEME_LIBRARY_PATH + is the SLIB Scheme library directory (with a trailing "/"). + +FILES + slib.info + Texinfo documentation of slib. + +AUTHORS + Aubrey Jaffer (agj @ alum.mit.edu) and scores of others. + +SEE ALSO + The SLIB home-page: + http://swissnet.ai.mit.edu/~jaffer/SLIB.html + + The full documentation for slib is maintained as a Texinfo manual. If + the info and slib programs are properly installed at your site, the + command + info slib + + should give you access to the complete manual. + + + +4th Berkeley Distribution SLIB(Jan 22 2005) @@ -1,4 +1,4 @@ -This is slib.info, produced by makeinfo version 4.6 from slib.texi. +This is slib.info, produced by makeinfo version 4.7 from slib.texi. | INFO-DIR-SECTION The Algorithmic Language Scheme START-INFO-DIR-ENTRY @@ -38,7 +38,7 @@ implementation, user, or directory. * Menu: * The Library System:: How to use and customize. -* Universal SLIB Procedures:: Provided for all implementations. | +* Universal SLIB Procedures:: Provided for all implementations. * Scheme Syntax Extension Packages:: * Textual Conversion Packages:: * Mathematical Packages:: @@ -49,31 +49,31 @@ implementation, user, or directory. File: slib.info, Node: The Library System, Next: Universal SLIB Procedures, Prev: Top, Up: Top - | -The Library System -****************** + +1 The Library System | +******************** | * Menu: * Feature:: SLIB names. -* Require:: | +* Require:: * Library Catalogs:: -* Catalog Creation:: | -* Catalog Vicinities:: | -* Compiling Scheme:: | +* Catalog Creation:: +* Catalog Vicinities:: +* Compiling Scheme:: File: slib.info, Node: Feature, Next: Require, Prev: The Library System, Up: The Library System - | -Feature -======= + +1.1 Feature | +=========== | SLIB denotes "features" by symbols. SLIB maintains a list of features -supported by a Scheme "session". The set of features provided by a | -session may change during that session. Some features are properties | -of the Scheme implementation being used. The following "intrinsic | -feature"s detail what sort of numbers are available from an | -implementation: | +supported by a Scheme "session". The set of features provided by a +session may change during that session. Some features are properties +of the Scheme implementation being used. The following "intrinsic +feature"s detail what sort of numbers are available from an +implementation: * 'inexact @@ -85,63 +85,72 @@ implementation: | * 'bignum -SLIB initialization (in `require.scm') tests and "provide"s any of | -these numeric features which are appropriate. | - | -Other features correspond to the presence of packages of Scheme | -procedures or syntax (macros). | +SLIB initialization (in `require.scm') tests and "provide"s any of +these numeric features which are appropriate. - - Function: provided? feature - Returns `#t' if FEATURE is present in the current Scheme session; | - otherwise `#f'. More specifically, `provided?' returns `#t' if | - the symbol FEATURE is the `software-type' or if FEATURE has been | - provided by a module already loaded; and `#f' otherwise. | - | - In some implementations `provided?' tests whether a module has | - been `require'd by any module or in any thread; other | - implementations will have `provided?' reflect only the modules | - `require'd by that particular session or thread. | - | - To work portably in both scenarios, use `provided?' only to test | - whether intrinsic properties (like those above) are present. | - | - The FEATURE argument can also be an expression calling `and', | - `or', and `not' of features. The boolean result of the logical | - question asked by FEATURE is returned. | - | -The generalization of `provided?' for arbitrary features and catalog is | -`feature-eval': | - | - - Function: feature-eval expression provided? | - Evaluates `and', `or', and `not' forms in EXPRESSION, using the | - values returned by calling PROVIDED? on the leaf symbols. | - `feature-eval' returns the boolean result of the logical | - combinations. | +Other features correspond to the presence of packages of Scheme +procedures or syntax (macros). + + -- Function: provided? feature | + Returns `#t' if FEATURE is present in the current Scheme session; + otherwise `#f'. More specifically, `provided?' returns `#t' if + the symbol FEATURE is the `software-type', the | + `scheme-implementation-type' (1), or if FEATURE has been provided | + by a module already loaded; and `#f' otherwise. | + + In some implementations `provided?' tests whether a module has + been `require'd by any module or in any thread; other + implementations will have `provided?' reflect only the modules + `require'd by that particular session or thread. + + To work portably in both scenarios, use `provided?' only to test + whether intrinsic properties (like those above) are present. - - Procedure: provide feature - Informs SLIB that FEATURE is supported in this session. | + The FEATURE argument can also be an expression calling `and', + `or', and `not' of features. The boolean result of the logical + question asked by FEATURE is returned. + +The generalization of `provided?' for arbitrary features and catalog is +`feature-eval': + + -- Function: feature-eval expression provided? | + Evaluates `and', `or', and `not' forms in EXPRESSION, using the + values returned by calling PROVIDED? on the leaf symbols. + `feature-eval' returns the boolean result of the logical + combinations. + + -- Procedure: provide feature | + Informs SLIB that FEATURE is supported in this session. (provided? 'foo) => #f (provide 'foo) (provided? 'foo) => #t + ---------- Footnotes ---------- | + | + (1) scheme-implementation-type is the name symbol of the running | +Scheme implementation (RScheme, |STk|, Bigloo, chez, Elk, gambit, | +guile, JScheme, MacScheme, MITScheme, Pocket-Scheme, Scheme48, | +Scheme->C, Scheme48, Scsh, T, umb-scheme, or Vscm). Dependence on | +scheme-implementation-type is almost always the wrong way to do things. | + | File: slib.info, Node: Require, Next: Library Catalogs, Prev: Feature, Up: The Library System - | -Require | -======= | + +1.2 Require | +=========== | SLIB creates and maintains a "catalog" mapping features to locations of files introducing procedures and syntax denoted by those features. - - 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', `compiled', or one of the other | - cases described in *Note Library Catalogs::. The cdr of the | - pathname should be either a string or a list. | - | + -- 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', `compiled', or one of the other + cases described in *Note Library Catalogs::. The cdr of the + pathname should be either a string or a list. + At the beginning of each section of this manual, there is a line like `(require 'FEATURE)'. The Scheme files comprising SLIB are cataloged so that these feature names map to the corresponding files. @@ -149,56 +158,49 @@ so that these feature names map to the corresponding files. SLIB provides a form, `require', which loads the files providing the requested feature. - - Procedure: require feature - * If `(provided? FEATURE)' is true, then `require' just returns. | + -- Procedure: require feature | + * If `(provided? FEATURE)' is true, then `require' just returns. * Otherwise, if FEATURE is found in the catalog, then the - corresponding files will be loaded and `(provided? FEATURE)' | - will henceforth return `#t'. That FEATURE is thereafter | - `provided'. | + corresponding files will be loaded and `(provided? FEATURE)' + will henceforth return `#t'. That FEATURE is thereafter + `provided'. * Otherwise (FEATURE not found in the catalog), an error is signaled. -There is a related form `require-if', used primarily for enabling | -compilers to statically include modules which would be dynamically | -loaded by interpreters. | - - - Procedure: require-if condition feature | - Requires FEATURE if CONDITION is true. | - -The `random' module uses `require-if' to flag `object->string' as a | -(dynamic) required module. | - - (require 'byte) | - (require 'logical) | - (require-if 'compiling 'object->string) | +There is a related form `require-if', used primarily for enabling +compilers to statically include modules which would be dynamically +loaded by interpreters. -The `batch' module uses `require-if' to flag `posix-time' as a module | -to load if the implementation supports large precision exact integers. | + -- Procedure: require-if condition feature | + Requires FEATURE if CONDITION is true. - (require-if '(and bignum compiling) 'posix-time) | +The `random' module uses `require-if' to flag `object->string' as a +(dynamic) required module. -The `commutative-ring' module uses `require-if' to ensure that it has | -an exponentiation routine, regardless of whether the implementation | -supports inexact numbers: | + (require 'byte) + (require 'logical) + (require-if 'compiling 'object->string) - (require-if '(not inexact) 'logical) ;for integer-expt | - (define number^ (if (provided? 'inexact) expt integer-expt)) | +The `batch' module uses `require-if' to flag `posix-time' as a module +to load if the implementation supports large precision exact integers. -The catalog can also be queried using `slib:in-catalog?'. | + (require-if '(and bignum compiling) 'posix-time) + | +The catalog can also be queried using `slib:in-catalog?'. - - Function: slib:in-catalog? feature | - Returns a `CDR' of the catalog entry if one was found for the | - symbol FEATURE in the alist `*catalog*' (and transitively through | - any symbol aliases encountered). Otherwise, returns `#f'. The | - format of catalog entries is explained in *Note Library Catalogs::. | + -- Function: slib:in-catalog? feature | + Returns a `CDR' of the catalog entry if one was found for the + symbol FEATURE in the alist `*catalog*' (and transitively through + any symbol aliases encountered). Otherwise, returns `#f'. The + format of catalog entries is explained in *Note Library Catalogs::. File: slib.info, Node: Library Catalogs, Next: Catalog Creation, Prev: Require, Up: The Library System - | -Library Catalogs | -================ | + +1.3 Library Catalogs | +==================== | Catalog files consist of one or more "association list"s. In the circumstance where a feature symbol appears in more than one list, the @@ -218,7 +220,7 @@ for elements of catalog lists: `slib:load-compiled's the files <path> .... `(FEATURE aggregate <symbol> ...)' - `slib:require's the features <symbol> .... | + `require's the features <symbol> .... | The various macro styles first `require' the named macro package, then just load <path> or load-and-macro-expand <path> as appropriate for the @@ -244,31 +246,31 @@ implementation. File: slib.info, Node: Catalog Creation, Next: Catalog Vicinities, Prev: Library Catalogs, Up: The Library System - | -Catalog Creation | -================ | -At the start of an interactive session no catalog is present, but is | -created with the first catalog inquiry (such as `(require 'random)'). | -Several sources of catalog information are combined to produce the | -catalog: | +1.4 Catalog Creation | +==================== | - * standard SLIB packages. | +At the start of an interactive session no catalog is present, but is +created with the first catalog inquiry (such as `(require 'random)'). +Several sources of catalog information are combined to produce the +catalog: - * additional packages of interest to this site. | - | - * packages specifically for the variety of Scheme which this session | - is running. | - | - * packages this user wants to always have available. This catalog | - is the file `homecat' in the user's "HOME" directory. | - | - * packages germane to working in this (current working) directory. | - This catalog is the file `usercat' in the directory to which it | - applies. One would typically `cd' to this directory before | - starting the Scheme session. | - | - * packages which are part of an application program. | + * standard SLIB packages. + + * additional packages of interest to this site. + + * packages specifically for the variety of Scheme which this session + is running. + + * packages this user wants to always have available. This catalog + is the file `homecat' in the user's "HOME" directory. + + * packages germane to working in this (current working) directory. + This catalog is the file `usercat' in the directory to which it + applies. One would typically `cd' to this directory before + starting the Scheme session. + + * packages which are part of an application program. SLIB combines the catalog information which doesn't vary per user into the file `slibcat' in the implementation-vicinity. Therefore `slibcat' @@ -279,34 +281,34 @@ is used with. The definition of `*SLIB-VERSION*' in SLIB file `require.scm' is checked against the catalog association of `*SLIB-VERSION*' to -ascertain when versions have changed. It is a reasonable practice to | -change the definition of `*SLIB-VERSION*' whenever the library is | -changed. If multiple implementations of Scheme use SLIB, remember that | -recompiling one `slibcat' will update only that implementation's | -catalog. | +ascertain when versions have changed. It is a reasonable practice to +change the definition of `*SLIB-VERSION*' whenever the library is +changed. If multiple implementations of Scheme use SLIB, remember that +recompiling one `slibcat' will update only that implementation's +catalog. The compilation scripts of Scheme implementations which work with SLIB can automatically trigger catalog compilation by deleting `slibcat' or -by invoking `require' of a special feature: | +by invoking `require' of a special feature: - - Procedure: require 'new-catalog + -- Procedure: require 'new-catalog | This will load `mklibcat', which compiles and writes a new `slibcat'. -Another special feature of `require' erases SLIB's catalog, forcing it | -to be reloaded the next time the catalog is queried. | +Another special feature of `require' erases SLIB's catalog, forcing it +to be reloaded the next time the catalog is queried. - - Procedure: require #f + -- Procedure: require #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. File: slib.info, Node: Catalog Vicinities, Next: Compiling Scheme, Prev: Catalog Creation, Up: The Library System - | -Catalog Vicinities | -================== | - | + +1.5 Catalog Vicinities | +====================== | + Each file in the table below is descibed in terms of its file-system independent "vicinity" (*note Vicinity::). The entries of a catalog in the table override those of catalogs above it in the table. @@ -339,381 +341,398 @@ the table override those of catalogs above it in the table. This file contains the associations specific to an SLIB user. `user-vicinity' `usercat' - This file contains associations affecting only those sessions whose | + This file contains associations affecting only those sessions whose "working directory" is `user-vicinity'. -Here is an example of a `usercat' catalog. A program in this directory | -can invoke the `run' feature with `(require 'run)'. | - | - ;;; "usercat": SLIB catalog additions for SIMSYNCH. -*-scheme-*- | - ( | - (simsynch . "../synch/simsynch.scm") | - (run . "../synch/run.scm") | - (schlep . "schlep.scm") | - ) | - | -Copying `usercat' to many directories is inconvenient. Application | -programs which aren't always run in specially prepared directories can | -nonetheless register their features during initialization. | - | - - Procedure: catalog:read vicinity catalog | - Reads file named by string CATALOG in VICINITY, resolving all | - paths relative to VICINITY, and adds those feature associations to | - *CATALOG*. | - | - `catalog:read' would typically be used by an application program | - having dynamically loadable modules. For instance, to register | - factoring and other modules in *CATALOG*, JACAL does: | - | - (catalog:read (program-vicinity) "jacalcat") | - | - | -For an application program there are three appropriate venues for | -registering its catalog associations: | - | - * in a `usercat' file in the directory where the program runs; or | - | - * in an `implcat' file in the `implementation-vicinity'; or | - | - * in an application program directory; loaded by calling | - `catalog:read'. | - | +Here is an example of a `usercat' catalog. A program in this directory +can invoke the `run' feature with `(require 'run)'. + + ;;; "usercat": SLIB catalog additions for SIMSYNCH. -*-scheme-*- + ( + (simsynch . "../synch/simsynch.scm") + (run . "../synch/run.scm") + (schlep . "schlep.scm") + ) + +Copying `usercat' to many directories is inconvenient. Application +programs which aren't always run in specially prepared directories can +nonetheless register their features during initialization. + + -- Procedure: catalog:read vicinity catalog | + Reads file named by string CATALOG in VICINITY, resolving all + paths relative to VICINITY, and adds those feature associations to + *CATALOG*. + + `catalog:read' would typically be used by an application program + having dynamically loadable modules. For instance, to register + factoring and other modules in *CATALOG*, JACAL does: + + (catalog:read (program-vicinity) "jacalcat") + + +For an application program there are three appropriate venues for +registering its catalog associations: + + * in a `usercat' file in the directory where the program runs; or + + * in an `implcat' file in the `implementation-vicinity'; or + + * in an application program directory; loaded by calling + `catalog:read'. + File: slib.info, Node: Compiling Scheme, Prev: Catalog Vicinities, Up: The Library System - | -Compiling Scheme | -================ -To use Scheme compilers effectively with SLIB the compiler needs to | -know which SLIB modules are to be compiled and which symbols are | -exported from those modules. | - | - The procedures in this section automate the extraction of this | -information from SLIB modules. They are guaranteed to work on SLIB | -modules; to use them on other sources, those sources should follow SLIB | -conventions. | +1.6 Compiling Scheme | +==================== | + +To use Scheme compilers effectively with SLIB the compiler needs to +know which SLIB modules are to be compiled and which symbols are +exported from those modules. + + The procedures in this section automate the extraction of this +information from SLIB modules. They are guaranteed to work on SLIB +modules; to use them on other sources, those sources should follow SLIB +conventions. * Menu: -* Module Conventions:: | -* Module Manifests:: | -* Module Semantics:: | -* Top-level Variable References:: | -* Module Analysis:: | +* Module Conventions:: +* Module Manifests:: +* Module Semantics:: +* Top-level Variable References:: +* Module Analysis:: File: slib.info, Node: Module Conventions, Next: Module Manifests, Prev: Compiling Scheme, Up: Compiling Scheme - | -Module Conventions | ------------------- | - * All the top-level `require' commands have one quoted argument and | - are positioned before other Scheme definitions and expressions in | - the file. | +1.6.1 Module Conventions | +------------------------ | - * Any conditionally `require'd SLIB modules (1) also appear at the | - beginning of their files conditioned on the feature `compiling' | - using `require-if' (*note require-if: Require.). | + * All the top-level `require' commands have one quoted argument and + are positioned before other Scheme definitions and expressions in + the file. - (require 'logical) | - (require 'multiarg/and-) | - (require-if 'compiling 'sort) | - (require-if 'compiling 'ciexyz) | + * Any conditionally `require'd SLIB modules (1) also appear at the + beginning of their files conditioned on the feature `compiling' + using `require-if' (*note require-if: Require.). - * Schmooz-style comments preceding a definition, identify that | - definition as an exported identifier (*note Schmooz::). For | - non-schmooz files, putting `;@' at the beginning of the line | - immediately preceding the definition (`define', `define-syntax', | - or `defmacro') suffices. | + (require 'logical) + (require 'multiarg/and-) + (require-if 'compiling 'sort) + (require-if 'compiling 'ciexyz) - ;@ | - (define (make-vicinity <pathname>) <pathname>) | + * Schmooz-style comments preceding a definition, identify that + definition as an exported identifier (*note Schmooz::). For + non-schmooz files, putting `;@' at the beginning of the line + immediately preceding the definition (`define', `define-syntax', + or `defmacro') suffices. - * Syntax (macro) definitions are grouped at the end of a module file. | + ;@ + (define (identity <obj>) <obj>) | - * Modules defining macros do not invoke those macros. SLIB macro | - implementations are exempt from this rule. | + * Syntax (macro) definitions are grouped at the end of a module file. - An example of how to expand macro invocations is: | + * Modules defining macros do not invoke those macros. SLIB macro + implementations are exempt from this rule. - (require 'macros-that-work) | - (require 'yasos) | - (require 'pprint-file) | - (pprint-filter-file "collect.scm" macwork:expand) | - | + An example of how to expand macro invocations is: + + (require 'macros-that-work) + (require 'yasos) + (require 'pprint-file) + (pprint-filter-file "collect.scm" macwork:expand) - ---------- Footnotes ---------- | - (1) There are some functions with internal `require' calls to delay | -loading modules until they are needed. While this reduces startup | -latency for interpreters, it can produce headaches for compilers. | + ---------- Footnotes ---------- + + (1) There are some functions with internal `require' calls to delay +loading modules until they are needed. While this reduces startup +latency for interpreters, it can produce headaches for compilers. File: slib.info, Node: Module Manifests, Next: Module Semantics, Prev: Module Conventions, Up: Compiling Scheme - | -Module Manifests | ----------------- | -`(require 'manifest)' | +1.6.2 Module Manifests | +---------------------- | -In some of these examples, SLIB:CATALOG is the SLIB part of the | -catalog; it is free of compiled and implementation-specific entries. | -It would be defined by: | - | - (define slib:catalog (cdr (member (assq 'null *catalog*) *catalog*))) | - | - - Function: file->requires file provided? catalog | - Returns a list of the features `require'd by FILE assuming the | - predicate PROVIDED? and association-list CATALOG. | - | - (define (provided+? . features) | - (lambda (feature) | - (or (memq feature features) (provided? feature)))) | - | - (file->requires "obj2str.scm" (provided+? 'compiling) '()) | - => (string-port generic-write) | - | - (file->requires "obj2str.scm" provided? '()) | - => (string-port) | - | - - Function: feature->requires feature provided? catalog | - Returns a list of the features `require'd by FEATURE assuming the | - predicate PROVIDED? and association-list CATALOG. | - | - (feature->requires 'batch (provided+? 'compiling) *catalog*) | - => (tree line-i/o databases parameters string-port | - pretty-print common-list-functions posix-time) | - | - (feature->requires 'batch provided? *catalog*) | - => (tree line-i/o databases parameters string-port | - pretty-print common-list-functions) | - | - (feature->requires 'batch provided? '((batch . "batch"))) | - => (tree line-i/o databases parameters string-port | - pretty-print common-list-functions) | - | - - Function: file->loads file | - Returns a list of strings naming existing files loaded (load | - slib:load slib:load-source macro:load defmacro:load syncase:load | - synclo:load macwork:load) by FILE or any of the files it loads. | - | - (file->loads (in-vicinity (library-vicinity) "scainit.scm")) | - => ("/usr/local/lib/slib/scaexpp.scm" | - "/usr/local/lib/slib/scaglob.scm" | - "/usr/local/lib/slib/scaoutp.scm") | - | - - Function: load->path exp | - Given a `(load '<expr>)', where <expr> is a string or vicinity | - stuff), `(load->path <expr>)' figures a path to the file. | - `load->path' returns that path if it names an existing file; | - otherwise #f. | - | - (load->path '(in-vicinity (library-vicinity) "mklibcat")) | - => "/usr/local/lib/slib/mklibcat.scm" | - | - - Function: file->definitions file | - Returns a list of the identifier symbols defined by SLIB (or | - SLIB-style) file FILE. | - | - (file->definitions "random.scm") | - => (*random-state* make-random-state | - seed->random-state copy-random-state random | - random:chunk) | - | - - Function: file->exports file | - Returns a list of the identifier symbols exported (advertised) by | - SLIB (or SLIB-style) file FILE. | - | - (file->exports "random.scm") | - => (make-random-state seed->random-state | - copy-random-state random) | - | - (file->exports "randinex.scm") | - => (random:solid-sphere! random:hollow-sphere! | - random:normal-vector! random:normal | - random:exp random:uniform) | - | - - Function: feature->export-alist feature catalog | - Returns a list of lists; each sublist holding the name of the file | - implementing FEATURE, and the identifier symbols exported | - (advertised) by SLIB (or SLIB-style) feature FEATURE, in CATALOG. | - | - - Function: feature->exports feature catalog | - Returns a list of all exports of FEATURE. | - | -In the case of `aggregate' features, more than one file may have export | -lists to report: | - | - (feature->export-alist 'r5rs slib:catalog)) | - => (("/usr/local/lib/slib/values.scm" | - call-with-values values) | - ("/usr/local/lib/slib/mbe.scm" | - define-syntax macro:expand | - macro:load macro:eval) | - ("/usr/local/lib/slib/eval.scm" | - eval scheme-report-environment | - null-environment interaction-environment)) | - | - (feature->export-alist 'stdio *catalog*) | - => (("/usr/local/lib/slib/scanf.scm" | - fscanf sscanf scanf scanf-read-list) | - ("/usr/local/lib/slib/printf.scm" | - sprintf printf fprintf) | - ("/usr/local/lib/slib/stdio.scm" | - stderr stdout stdin)) | - | - (feature->exports 'stdio slib:catalog) | - => (fscanf sscanf scanf scanf-read-list | - sprintf printf fprintf stderr stdout stdin) | +`(require 'manifest)' + +In some of these examples, SLIB:CATALOG is the SLIB part of the +catalog; it is free of compiled and implementation-specific entries. +It would be defined by: + + (define slib:catalog (cdr (member (assq 'null *catalog*) *catalog*))) + + -- Function: file->requires file provided? catalog | + Returns a list of the features `require'd by FILE assuming the + predicate PROVIDED? and association-list CATALOG. + + (define (provided+? . features) + (lambda (feature) + (or (memq feature features) (provided? feature)))) + + (file->requires "obj2str.scm" (provided+? 'compiling) '()) + => (string-port generic-write) + + (file->requires "obj2str.scm" provided? '()) + => (string-port) + + -- Function: feature->requires feature provided? catalog | + Returns a list of the features `require'd by FEATURE assuming the + predicate PROVIDED? and association-list CATALOG. + + (feature->requires 'batch (provided+? 'compiling) *catalog*) + => (tree line-i/o databases parameters string-port + pretty-print common-list-functions posix-time) + + (feature->requires 'batch provided? *catalog*) + => (tree line-i/o databases parameters string-port + pretty-print common-list-functions) + + (feature->requires 'batch provided? '((batch . "batch"))) + => (tree line-i/o databases parameters string-port + pretty-print common-list-functions) + + -- Function: feature->requires* feature provided? catalog | + Returns a list of the features transitively `require'd by FEATURE | + assuming the predicate PROVIDED? and association-list CATALOG. | + | + -- Function: file->requires* file provided? catalog | + Returns a list of the features transitively `require'd by FILE | + assuming the predicate PROVIDED? and association-list CATALOG. | + | + -- Function: file->loads file | + Returns a list of strings naming existing files loaded (load + slib:load slib:load-source macro:load defmacro:load syncase:load + synclo:load macwork:load) by FILE or any of the files it loads. + + (file->loads (in-vicinity (library-vicinity) "scainit.scm")) + => ("/usr/local/lib/slib/scaexpp.scm" + "/usr/local/lib/slib/scaglob.scm" + "/usr/local/lib/slib/scaoutp.scm") + + -- Function: load->path exp | + Given a `(load '<expr>)', where <expr> is a string or vicinity + stuff), `(load->path <expr>)' figures a path to the file. + `load->path' returns that path if it names an existing file; + otherwise #f. + + (load->path '(in-vicinity (library-vicinity) "mklibcat")) + => "/usr/local/lib/slib/mklibcat.scm" + + -- Function: file->definitions file definer ... | + Returns a list of the identifier symbols defined by SLIB (or + SLIB-style) file FILE. The optional arguments DEFINERS should be | + symbols signifying a defining form. If none are supplied, then | + the symbols `define-operation', `define', `define-syntax', and | + `defmacro' are captured. | + + (file->definitions "random.scm") + => (*random-state* make-random-state + seed->random-state copy-random-state random + random:chunk) + + -- Function: file->exports file definer ... | + Returns a list of the identifier symbols exported (advertised) by + SLIB (or SLIB-style) file FILE. The optional arguments DEFINERS | + should be symbols signifying a defining form. If none are | + supplied, then the symbols `define-operation', `define', | + `define-syntax', and `defmacro' are captured. | + + (file->exports "random.scm") + => (make-random-state seed->random-state + copy-random-state random) + + (file->exports "randinex.scm") + => (random:solid-sphere! random:hollow-sphere! + random:normal-vector! random:normal + random:exp random:uniform) + + -- Function: feature->export-alist feature catalog | + Returns a list of lists; each sublist holding the name of the file + implementing FEATURE, and the identifier symbols exported + (advertised) by SLIB (or SLIB-style) feature FEATURE, in CATALOG. + + -- Function: feature->exports feature catalog | + Returns a list of all exports of FEATURE. + +In the case of `aggregate' features, more than one file may have export +lists to report: + + (feature->export-alist 'r5rs slib:catalog)) + => (("/usr/local/lib/slib/values.scm" + call-with-values values) + ("/usr/local/lib/slib/mbe.scm" + define-syntax macro:expand + macro:load macro:eval) + ("/usr/local/lib/slib/eval.scm" + eval scheme-report-environment + null-environment interaction-environment)) + + (feature->export-alist 'stdio *catalog*) + => (("/usr/local/lib/slib/scanf.scm" + fscanf sscanf scanf scanf-read-list) + ("/usr/local/lib/slib/printf.scm" + sprintf printf fprintf) + ("/usr/local/lib/slib/stdio.scm" + stderr stdout stdin)) + + (feature->exports 'stdio slib:catalog) + => (fscanf sscanf scanf scanf-read-list + sprintf printf fprintf stderr stdout stdin) File: slib.info, Node: Module Semantics, Next: Top-level Variable References, Prev: Module Manifests, Up: Compiling Scheme - | -Module Semantics | ----------------- | - | -For the purpose of compiling Scheme code, each top-level `require' | -makes the identifiers exported by its feature's module `defined' (or | -defmacroed or defined-syntaxed) within the file (being compiled) headed | -with those requires. | - | - Top-level occurrences of `require-if' make defined the exports from | -the module named by the second argument _if_ the FEATURE-EXPRESSION | -first argument is true in the target environment. The target feature | -`compiling' should be provided during this phase of compilation. | - | - Non-top-level SLIB occurences of `require' and `require-if' of quoted | -features can be ignored by compilers. The SLIB modules will all have | -top-level constructs for those features. | - | - Note that aggregate catalog entries import more than one module. | -Implementations of `require' may or may _not_ be transitive; code which | -uses module exports without requiring the providing module is in error. | - | - In the SLIB modules `modular', `batch', `hash', `common-lisp-time', | -`commutative-ring', `charplot', `logical', `common-list-functions', | -`coerce' and `break' there is code conditional on features being | -`provided?'. Most are testing for the presence of features which are | -intrinsic to implementations (inexacts, bignums, ...). | - | - In all cases these `provided?' tests can be evaluated at compile-time | -using `feature-eval' (*note feature-eval: Feature.). The simplest way | -to compile these constructs may be to treat `provided?' as a macro. | - | + +1.6.3 Module Semantics | +---------------------- | + +For the purpose of compiling Scheme code, each top-level `require' +makes the identifiers exported by its feature's module `defined' (or +defmacroed or defined-syntaxed) within the file (being compiled) headed +with those requires. + + Top-level occurrences of `require-if' make defined the exports from +the module named by the second argument _if_ the FEATURE-EXPRESSION +first argument is true in the target environment. The target feature +`compiling' should be provided during this phase of compilation. + + Non-top-level SLIB occurences of `require' and `require-if' of quoted +features can be ignored by compilers. The SLIB modules will all have +top-level constructs for those features. + + Note that aggregate catalog entries import more than one module. +Implementations of `require' may or may _not_ be transitive; code which +uses module exports without requiring the providing module is in error. + + In the SLIB modules `modular', `batch', `hash', `common-lisp-time', +`commutative-ring', `charplot', `logical', `common-list-functions', +`coerce' and `break' there is code conditional on features being +`provided?'. Most are testing for the presence of features which are +intrinsic to implementations (inexacts, bignums, ...). + + In all cases these `provided?' tests can be evaluated at compile-time +using `feature-eval' (*note feature-eval: Feature.). The simplest way +to compile these constructs may be to treat `provided?' as a macro. + File: slib.info, Node: Top-level Variable References, Next: Module Analysis, Prev: Module Semantics, Up: Compiling Scheme - | -Top-level Variable References | ------------------------------ | - | -`(require 'top-refs)' | - | -These procedures complement those in *Note Module Manifests:: by | -finding the top-level variable references in Scheme source code. They | -work by traversing expressions and definitions, keeping track of | -bindings encountered. It is certainly possible to foil these | -functions, but they return useful information about SLIB source code. | - | - - Function: top-refs obj | - Returns a list of the top-level variables referenced by the Scheme | - expression OBJ. | - | - - Function: top-refs<-file filename | - FILENAME should be a string naming an existing file containing | - Scheme source code. `top-refs<-file' returns a list of the | - top-level variable references made by expressions in the file | - named by FILENAME. | - | - Code in modules which FILENAME `require's is not traversed. Code | - in files loaded from top-level _is_ traversed if the expression | - argument to `load', `slib:load', `slib:load-source', `macro:load', | - `defmacro:load', `synclo:load', `syncase:load', or `macwork:load' | - is a literal string constant or composed of combinations of | - vicinity functions and string literal constants; and the resulting | - file exists (possibly with ".scm" appended). | - | -The following function parses an "Info" Index. (1) | - | - - Function: exports<-info-index file n ... | - N ... must be an increasing series of positive integers. | - `exports<-info-index' returns a list of all the identifiers | - appearing in the Nth ... (info) indexes of FILE. The identifiers | - have the case that the implementation's `read' uses for symbols. | - Identifiers containing spaces (eg. `close-base on base-table') are | - _not_ included. | - | - Each info index is headed by a `* Menu:' line. To list the | - symbols in the first and third info indexes do: | - | - (exports<-info-index "slib.info" 1 3) | - | - ---------- Footnotes ---------- | - | - (1) Although it will work on large info files, feeding it an excerpt | -is much faster; and has less chance of being confused by unusual text | -in the info file. This command excerpts the SLIB index into | -`slib-index.info': | - | - info -f slib2d6.info -n "Index" -o slib-index.info | - | + +1.6.4 Top-level Variable References | +----------------------------------- | + +`(require 'top-refs)' + +These procedures complement those in *Note Module Manifests:: by +finding the top-level variable references in Scheme source code. They +work by traversing expressions and definitions, keeping track of +bindings encountered. It is certainly possible to foil these +functions, but they return useful information about SLIB source code. + + -- Function: top-refs obj | + Returns a list of the top-level variables referenced by the Scheme + expression OBJ. + + -- Function: top-refs<-file filename | + FILENAME should be a string naming an existing file containing + Scheme source code. `top-refs<-file' returns a list of the + top-level variable references made by expressions in the file + named by FILENAME. + + Code in modules which FILENAME `require's is not traversed. Code + in files loaded from top-level _is_ traversed if the expression + argument to `load', `slib:load', `slib:load-source', `macro:load', + `defmacro:load', `synclo:load', `syncase:load', or `macwork:load' + is a literal string constant or composed of combinations of + vicinity functions and string literal constants; and the resulting + file exists (possibly with ".scm" appended). + +The following function parses an "Info" Index. (1) + + -- Function: exports<-info-index file n ... | + N ... must be an increasing series of positive integers. + `exports<-info-index' returns a list of all the identifiers + appearing in the Nth ... (info) indexes of FILE. The identifiers + have the case that the implementation's `read' uses for symbols. + Identifiers containing spaces (eg. `close-base on base-table') are + _not_ included. #f is returned if the index is not found. | + + Each info index is headed by a `* Menu:' line. To list the + symbols in the first and third info indexes do: + + (exports<-info-index "slib.info" 1 3) + + ---------- Footnotes ---------- + + (1) Although it will work on large info files, feeding it an excerpt +is much faster; and has less chance of being confused by unusual text +in the info file. This command excerpts the SLIB index into +`slib-index.info': + + info -f slib2d6.info -n "Index" -o slib-index.info + File: slib.info, Node: Module Analysis, Prev: Top-level Variable References, Up: Compiling Scheme - | -Module Analysis | ---------------- | - | -`(require 'vet)' | - | - - Function: vet-slib | - Using the procedures in the `top-refs' and `manifest' modules, | - `vet-slib' analyzes each SLIB module, reporting about any | - procedure or macro defined whether it is: | - | - orphaned | - defined, not called, not exported; | - | - missing | - called, not defined, and not exported by its `require'd | - modules; | - | - undocumented-export | - Exported by module, but no index entry in `slib.info'; | - | - | - And for the library as a whole: | - | - documented-unexport | - Index entry in `slib.info', but no module exports it. | - | - | - This straightforward analysis caught three full days worth of | - never-executed branches, transitive require assumptions, spelling | - errors, undocumented procedures, missing procedures, and cyclic | - dependencies in SLIB. | + +1.6.5 Module Analysis | +--------------------- | + +`(require 'vet)' + + -- Function: vet-slib file1 ... | + Using the procedures in the `top-refs' and `manifest' modules, + `vet-slib' analyzes each SLIB module and FILE1, ..., reporting | + about any procedure or macro defined whether it is: | + + orphaned + defined, not called, not exported; + + missing + called, not defined, and not exported by its `require'd + modules; + + undocumented-export + Exported by module, but no index entry in `slib.info'; + + + And for the library as a whole: + + documented-unexport + Index entry in `slib.info', but no module exports it. + + + This straightforward analysis caught three full days worth of + never-executed branches, transitive require assumptions, spelling + errors, undocumented procedures, missing procedures, and cyclic + dependencies in SLIB. + + The optional arguments FILE1, ... provide a simple way to vet | + prospective SLIB modules. | | File: slib.info, Node: Universal SLIB Procedures, Next: Scheme Syntax Extension Packages, Prev: The Library System, Up: Top - | -Universal SLIB Procedures | -************************* | - | -The procedures described in these sections are supported by all | -implementations as part of the `*.init' files or by `require.scm'. | - | -* Menu: | - | -* Vicinity:: Pathname Management | -* Configuration:: Characteristics of Scheme Implementation | -* Input/Output:: Things not provided by the Scheme specs. | -* System:: LOADing, EVALing, ERRORing, and EXITing | -* Miscellany:: | - | + +2 Universal SLIB Procedures | +*************************** | + +The procedures described in these sections are supported by all +implementations as part of the `*.init' files or by `require.scm'. + +* Menu: + +* Vicinity:: Pathname Management +* Configuration:: Characteristics of Scheme Implementation +* Input/Output:: Things not provided by the Scheme specs. +* System:: LOADing, EVALing, ERRORing, and EXITing +* Miscellany:: + File: slib.info, Node: Vicinity, Next: Configuration, Prev: Universal SLIB Procedures, Up: Universal SLIB Procedures - | -Vicinity -======== | + +2.1 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 @@ -721,53 +740,56 @@ 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. +the file name. | -These procedures are provided by all implementations. + All of these procedures are file-system dependent. Use of these | +vicinity procedures can make programs file-system _in_dependent. | - - Function: make-vicinity dirpath +These procedures are provided by all implementations. On most systems | +a vicinity is a string. | + | + -- Function: make-vicinity dirpath | Returns DIRPATH as a vicinity for use as first argument to `in-vicinity'. - - Function: pathname->vicinity path + -- Function: pathname->vicinity path | Returns the vicinity containing PATH. (pathname->vicinity "/usr/local/lib/scm/Link.scm") => "/usr/local/lib/scm/" - - Function: program-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:* + currently loading, then the result is undefined. *Warning:* | `program-vicinity' can return incorrect values if your program - escapes back into a `load'. + escapes back into a `load' continuation. | - - Function: library-vicinity + -- Function: library-vicinity | Returns the vicinity of the shared Scheme library. - - Function: implementation-vicinity + -- 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 + -- Function: user-vicinity | Returns the vicinity of the current directory of the user. On most systems this is `""' (the empty string). - - Function: home-vicinity - Returns the vicinity of the user's "HOME" directory, the directory - 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 + -- Function: home-vicinity | + Returns the vicinity of the user's "HOME" directory, the directory 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 | `home-vicinity' returns `#f'. - - Function: vicinity:suffix? chr | - Returns the `#t' if CHR is a vicinity suffix character; and `#f' | - otherwise. Typical vicinity suffixes are `/', `:', and `\', | - | - - Function: in-vicinity vicinity filename + -- Function: vicinity:suffix? chr | + Returns the `#t' if CHR is a vicinity suffix character; and `#f' + otherwise. Typical vicinity suffixes are `/', `:', and `\', + + -- 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 @@ -778,27 +800,34 @@ These procedures are provided by all implementations. to the value of `(user-vicinity)' is unspecified. For most systems `in-vicinity' can be `string-append'. - - Function: sub-vicinity vicinity name + -- 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. + -- Function: with-load-pathname path thunk | + PATH should be a string naming a file being read or loaded. | + `with-load-pathname' evaluates THUNK in a dynamic scope where an | + internal variable is bound to PATH; the internal variable is used | + for messages and `program-vicinity'. `with-load-pathname' returns | + the value returned by THUNK. | + | File: slib.info, Node: Configuration, Next: Input/Output, Prev: Vicinity, Up: Universal SLIB Procedures - | -Configuration -============= | + +2.2 Configuration | +================= | These constants and procedures describe characteristics of the Scheme and underlying operating system. They are provided by all implementations. - - Constant: char-code-limit + -- Constant: char-code-limit | An integer 1 larger that the largest value which can be returned by `char->integer'. - - Constant: most-positive-fixnum + -- Constant: most-positive-fixnum | In implementations which support integers of practically unlimited size, MOST-POSITIVE-FIXNUM is a large exact integer within the range of exact integers that may result from computing the length @@ -809,39 +838,39 @@ implementations. that may result from computing the length of a list, vector, or string. - - Constant: slib:tab + -- Constant: slib:tab | The tab character. - - Constant: slib:form-feed + -- Constant: slib:form-feed | The form-feed character. - - Function: software-type + -- 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 + -- 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 "3a1" on scm "5b1" on unix | + (slib:report-version) => slib "3a2" on scm "5b1" on unix | - - Function: slib:report + -- 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 + -- Function: slib:report #t | provides a more verbose listing. - - Function: slib:report filename + -- Function: slib:report filename | Writes the report to file `filename'. (slib:report) => - slib "3a1" on scm "5b1" on unix | - (implementation-vicinity) is "/usr/local/lib/scm/" | - (library-vicinity) is "/usr/local/lib/slib/" | + slib "3a2" on scm "5b1" on unix | + (implementation-vicinity) is "/usr/local/lib/scm/" + (library-vicinity) is "/usr/local/lib/slib/" (scheme-file-suffix) is ".scm" loaded *features* : trace alist qp sort @@ -851,7 +880,7 @@ implementations. bignum complex real rational inexact vicinity ed getenv tmpnam abort transcript with-file - ieee-p1178 r4rs rev4-optional-procedures hash | + ieee-p1178 r4rs rev4-optional-procedures hash object-hash delay eval dynamic-wind multiarg-apply multiarg/and- logical defmacro string-port source current-time record @@ -859,27 +888,27 @@ implementations. array dump char-ready? full-continuation system implementation *catalog* : - (i/o-extensions compiled "/usr/local/lib/scm/ioext.so") | + (i/o-extensions compiled "/usr/local/lib/scm/ioext.so") ... File: slib.info, Node: Input/Output, Next: System, Prev: Configuration, Up: Universal SLIB Procedures - | -Input/Output -============ | + +2.3 Input/Output | +================ | These procedures are provided by all implementations. - - Function: file-exists? filename + -- Function: 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. - - Function: delete-file filename + -- Function: delete-file filename | Deletes the file specified by FILENAME. If FILENAME can not be deleted, `#f' is returned. Otherwise, `#t' is returned. - - Function: open-file filename modes + -- Function: open-file filename modes | FILENAME should be a string naming a file. `open-file' returns a port depending on the symbol MODES: @@ -905,18 +934,18 @@ These procedures are provided by all implementations. signalled. For output, if a file with the given name already exists, the effect is unspecified. - - Function: port? obj + -- Function: port? obj | Returns #t if OBJ is an input or output port, otherwise returns #f. - - Procedure: close-port port + -- Procedure: close-port port | Closes the file associated with PORT, rendering the PORT incapable of delivering or accepting characters. `close-file' has no effect if the file has already been closed. The value returned is unspecified. - - Function: call-with-open-ports proc ports ... - - Function: call-with-open-ports ports ... proc + -- Function: call-with-open-ports proc ports ... | + -- Function: call-with-open-ports ports ... proc | PROC should be a procedure that accepts as many arguments as there are PORTS passed to `call-with-open-ports'. `call-with-open-ports' calls PROC with PORTS .... If PROC @@ -926,54 +955,54 @@ These procedures are provided by all implementations. to prove that the ports will never again be used for a read or write operation. - - Function: tmpnam + -- Function: 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. - - Function: current-error-port + -- Function: current-error-port | Returns the current port to which diagnostic and error output is directed. - - Procedure: force-output - - Procedure: force-output port + -- 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)'. - - Function: output-port-width - - Function: output-port-width port + -- Function: output-port-width | + -- Function: 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. - - Function: output-port-height - - Function: output-port-height port + -- Function: output-port-height | + -- Function: 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: System, Next: Miscellany, Prev: Input/Output, Up: Universal SLIB Procedures - | -System -====== | + +2.4 System | +========== | These procedures are provided by all implementations. - - Procedure: slib:load-source name + -- 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 + -- 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 + -- 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 @@ -983,29 +1012,29 @@ These procedures are provided by all implementations. If an implementation does not support compiled code then `slib:load' will be identical to `slib:load-source'. - - Procedure: slib:eval obj + -- Procedure: slib:eval obj | `eval' returns the value of OBJ evaluated in the current top level environment. *Note Eval:: provides a more general evaluation facility. - - Procedure: slib:eval-load filename eval + -- 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:warn arg1 arg2 ... + -- Procedure: slib:warn arg1 arg2 ... | Outputs a warning message containing the arguments. - - Procedure: slib:error arg1 arg2 ... + -- 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 + -- 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 @@ -1013,7 +1042,7 @@ These procedures are provided by all implementations. the system (if possible). If the Scheme session cannot exit an unspecified value is returned from `slib:exit'. - - Function: browse-url url + -- Function: browse-url url | Web browsers have become so ubiquitous that programming languagues should support a uniform interface to them. @@ -1028,13 +1057,13 @@ These procedures are provided by all implementations. File: slib.info, Node: Miscellany, Prev: System, Up: Universal SLIB Procedures - | -Miscellany -========== | + +2.5 Miscellany | +============== | These procedures are provided by all implementations. - - Function: identity x + -- Function: identity x | IDENTITY returns its argument. Example: @@ -1045,15 +1074,24 @@ These procedures are provided by all implementations. (map identity LST) == (copy-list LST) -Mutual Exclusion ----------------- | + -- Function: expt n k | + Returns N raised to the non-negative integer exponent K. | -An "exchanger" is a procedure of one argument regulating mutually -exclusive access to a resource. When a exchanger is called, its current -content is returned, while being replaced by its argument in an atomic + Example: | + (expt 2 5) | + => 32 | + (expt -3 3) | + => -27 | + | +2.5.1 Mutual Exclusion | +---------------------- | + | +An "exchanger" is a procedure of one argument regulating mutually exclusive | +access to a resource. When a exchanger is called, its current content | +is returned, while being replaced by its argument in an atomic | operation. - - Function: make-exchanger obj + -- Function: make-exchanger obj | Returns a new exchanger with the argument OBJ as its initial content. @@ -1071,25 +1109,25 @@ operation. (set! lst (cdr lst)) ret))) (lambda () (and lst (queue lst)))))) - + (pop queue) => a - + (pop queue) => #f -Legacy ------- | +2.5.2 Legacy | +------------ | The following procedures were present in Scheme until R4RS (*note Language changes: (r4rs)Notes.). They are provided by all SLIB implementations. - - Constant: t + -- Constant: t | Derfined as `#t'. - - Constant: nil + -- Constant: nil | Defined as `#f'. - - Function: last-pair l + -- Function: last-pair l | Returns the last pair in the list L. Example: (last-pair (cons 1 2)) => (1 . 2) @@ -1099,9 +1137,9 @@ implementations. File: slib.info, Node: Scheme Syntax Extension Packages, Next: Textual Conversion Packages, Prev: Universal SLIB Procedures, Up: Top - | -Scheme Syntax Extension Packages -******************************** + +3 Scheme Syntax Extension Packages | +********************************** | * Menu: @@ -1115,28 +1153,29 @@ Scheme Syntax Extension Packages Syntax extensions (macros) included with SLIB. +* Define-Structure:: 'structure | * Fluid-Let:: 'fluid-let * Yasos:: 'yasos, 'oop, 'collect File: slib.info, Node: Defmacro, Next: R4RS Macros, Prev: Scheme Syntax Extension Packages, Up: Scheme Syntax Extension Packages -Defmacro -======== +3.1 Defmacro | +============ | Defmacros are supported by all implementations. - - Function: gentemp + -- 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 + -- Function: defmacro:eval e | Returns the `slib:eval' of expanding all defmacros in scheme expression E. - - Function: defmacro:load filename + -- 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. @@ -1144,11 +1183,11 @@ Defmacros are supported by all implementations. definitions. The `macro:load' procedure does not affect the values returned by `current-input-port' and `current-output-port'. - - Function: defmacro? sym + -- Function: defmacro? sym | Returns `#t' if SYM has been defined by `defmacro', `#f' otherwise. - - Function: macroexpand-1 form - - Function: macroexpand form + -- 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 @@ -1157,26 +1196,26 @@ Defmacros are supported by all implementations. `macroexpand' is similar to `macroexpand-1', but repeatedly expands FORM until it is no longer a macro call. - - Macro: defmacro name lambda-list form ... + -- 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 --------------- +3.1.1 Defmacroexpand | +-------------------- | -`(require 'defmacroexpand)' +`(require 'defmacroexpand)' - - Function: defmacro:expand* e + -- 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: Scheme Syntax Extension Packages -R4RS Macros -=========== +3.2 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 @@ -1186,15 +1225,15 @@ Otherwise, one of the R4RS macros implemetations is loaded. The SLIB R4RS macro implementations support the following uniform interface: - - Function: macro:expand sexpression + -- Function: macro:expand sexpression | Takes an R4RS expression, macro-expands it, and returns the result of the macro expansion. - - Function: macro:eval sexpression + -- 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 + -- 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 @@ -1205,10 +1244,10 @@ interface: File: slib.info, Node: Macro by Example, Next: Macros That Work, Prev: R4RS Macros, Up: Scheme Syntax Extension Packages -Macro by Example -================ +3.3 Macro by Example | +==================== | -`(require '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'. @@ -1225,8 +1264,8 @@ R4RS) by Dorai Sitaram, (dorai @ cs.rice.edu) using `defmacro'. natively supported (most implementations) -Caveat ------- +3.3.1 Caveat | +------------ | These macros are not referentially transparent (*note Macros: (r4rs)Macros.). Lexically scoped macros (i.e., `let-syntax' and @@ -1240,7 +1279,7 @@ 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 + -- Macro: define-syntax keyword transformer-spec | The KEYWORD is an identifier, and the TRANSFORMER-SPEC should be an instance of `syntax-rules'. @@ -1257,7 +1296,7 @@ Syntax-Case Macros::. (let* (( name2 val2) ...) body1 body2 ...))))) - - Macro: syntax-rules literals syntax-rule ... + -- Macro: syntax-rules literals syntax-rule ... | LITERALS is a list of identifiers, and each SYNTAX-RULE should be of the form @@ -1280,28 +1319,28 @@ Syntax-Case Macros::. File: slib.info, Node: Macros That Work, Next: Syntactic Closures, Prev: Macro by Example, Up: Scheme Syntax Extension Packages -Macros That Work -================ +3.4 Macros That Work | +==================== | -`(require '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 + -- 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 + -- 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 + -- 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 @@ -1316,17 +1355,18 @@ 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. + | + 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 | () @@ -1335,33 +1375,33 @@ templates and are not allowed as pattern or template data. | #(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 ------------ +3.4.1 Definitions | +----------------- | Scope of an ellipsis Within a pattern or template, the scope of an ellipsis (`...') is @@ -1393,8 +1433,8 @@ Variables opened by an ellipsis template ellipsis template. -Restrictions ------------- +3.4.2 Restrictions | +------------------ | No pattern variable appears more than once within a pattern. @@ -1410,7 +1450,7 @@ 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 | () @@ -1418,34 +1458,34 @@ template must all be bound to sequences of the same length. | 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. @@ -1462,24 +1502,24 @@ unnecessarily. That shouldn't matter very often. File: slib.info, Node: Syntactic Closures, Next: Syntax-Case Macros, Prev: Macros That Work, Up: Scheme Syntax Extension Packages -Syntactic Closures -================== +3.5 Syntactic Closures | +====================== | -`(require 'syntactic-closures)' +`(require 'syntactic-closures)' - - Function: macro:expand expression - - Function: synclo:expand expression + -- 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 + -- 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 + -- 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 @@ -1487,19 +1527,19 @@ Syntactic Closures definitions. The `macro:load' procedure does not affect the values returned by `current-input-port' and `current-output-port'. -Syntactic Closure Macro Facility --------------------------------- +3.5.1 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. + | + 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 + The syntactic closures facility extends the BNF rule for TRANSFORMER SPEC to allow a new keyword that introduces a low-level macro transformer: @@ -1517,8 +1557,8 @@ 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 -........... +3.5.1.1 Terminology | +................... | This section defines the concepts and data types used by the syntactic closures facility. @@ -1565,13 +1605,13 @@ closures facility. structure is replaced by its form. -Transformer Definition -...................... +3.5.1.2 Transformer Definition | +.............................. | This section describes the `transformer' special form and the procedures `make-syntactic-closure' and `capture-syntactic-environment'. - - Syntax: transformer expression + -- Syntax: transformer expression | Syntax: It is an error if this syntax occurs except as a TRANSFORMER SPEC. @@ -1635,7 +1675,7 @@ procedures `make-syntactic-closure' and `capture-syntactic-environment'. `make-syntactic-closure' to close the form in a syntactic environment. - - Function: make-syntactic-closure environment free-names form + -- 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 @@ -1669,7 +1709,7 @@ procedures `make-syntactic-closure' and `capture-syntactic-environment'. To obtain a syntactic environment other than the usage environment, use `capture-syntactic-environment'. - - Function: capture-syntactic-environment procedure + -- 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, @@ -1759,8 +1799,8 @@ procedures `make-syntactic-closure' and `capture-syntactic-environment'. (lambda (transformer-env) ...)))) -Identifiers -........... +3.5.1.3 Identifiers | +................... | This section describes the procedures that create and manipulate identifiers. Previous syntactic closure proposals did not have an @@ -1792,7 +1832,7 @@ 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 + -- Function: identifier? object | Returns `#t' if OBJECT is an identifier, otherwise returns `#f'. Examples: @@ -1826,7 +1866,7 @@ roles of the substituted input subforms. environment as the symbol `else' means in the transformer environment. - - Function: identifier=? environment1 identifier1 environment2 + -- Function: identifier=? environment1 identifier1 environment2 | identifier2 ENVIRONMENT1 and ENVIRONMENT2 must be syntactic environments, and IDENTIFIER1 and IDENTIFIER2 must be identifiers. `identifier=?' @@ -1859,8 +1899,8 @@ roles of the substituted input subforms. (foobar)))) => (#f #t) -Acknowledgements -................ +3.5.1.4 Acknowledgements | +........................ | The syntactic closures facility was invented by Alan Bawden and Jonathan Rees. The use of aliases to implement `syntax-rules' was invented by @@ -1868,26 +1908,26 @@ 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: Scheme Syntax Extension Packages - -Syntax-Case Macros -================== +File: slib.info, Node: Syntax-Case Macros, Next: Define-Structure, Prev: Syntactic Closures, Up: Scheme Syntax Extension Packages + | +3.6 Syntax-Case Macros | +====================== | -`(require 'syntax-case)' +`(require 'syntax-case)' - - Function: macro:expand expression - - Function: syncase:expand expression + -- 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 + -- 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 + -- 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 @@ -1940,8 +1980,8 @@ distribution by anonymous FTP in SPARCstation SLC (with SCM) and about 90s on a Macintosh SE/30 (with Gambit). -Notes ------ +3.6.1 Notes | +----------- | All R4RS syntactic forms are defined, including `delay'. Along with `delay' are simple definitions for `make-promise' (into which `delay' @@ -1970,24 +2010,68 @@ 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 SLIB maintainer | -------------------------- | + +File: slib.info, Node: Define-Structure, Next: Fluid-Let, Prev: Syntax-Case Macros, Up: Scheme Syntax Extension Packages + | +3.7 Define-Structure | +==================== | + +`(require 'structure)' -`(require 'structure)' | +Included with the `syntax-case' files was `structure.scm' which defines | +a macro `define-structure'. Here is its documentation from Gambit 4.0: | + | + -- special form: define-structure NAME FIELD... | + Record data types similar to Pascal records and C `struct' types | + can be defined using the `define-structure' special form. The | + identifier NAME specifies the name of the new data type. The | + structure name is followed by K identifiers naming each field of | + the record. The `define-structure' expands into a set of | + definitions of the following procedures: | + | + * `make-NAME' - A K argument procedure which constructs a new | + record from the value of its K fields. | + | + * `NAME?' - A procedure which tests if its single argument is | + of the given record type. | + | + * `NAME-FIELD' - For each field, a procedure taking as its | + single argument a value of the given record type and returning | + the content of the corresponding field of the record. | + | + * `NAME-FIELD-set!' - For each field, a two argument procedure | + taking as its first argument a value of the given record | + type. The second argument gets assigned to the corresponding | + field of the record and the void object is returned. | + | + | + Gambit record data types have a printed representation that | + includes the name of the type and the name and value of each field. | + | + For example: | + | + > (define-structure point x y color) | + > (define p (make-point 3 5 'red)) | + > p | + #<point #3 x: 3 y: 5 color: red> | + > (point-x p) | + 3 | + > (point-color p) | + red | + > (point-color-set! p 'black) | + > p | + #<point #3 x: 3 y: 5 color: black> | | - Included with the `syntax-case' files was `structure.scm' which | -defines a macro `define-structure'. I have no documentation for this | -macro; it is not used by any other code in SLIB. | -File: slib.info, Node: Fluid-Let, Next: Yasos, Prev: Syntax-Case Macros, Up: Scheme Syntax Extension Packages - -Fluid-Let -========= +File: slib.info, Node: Fluid-Let, Next: Yasos, Prev: Define-Structure, Up: Scheme Syntax Extension Packages + | +3.8 Fluid-Let | +============= | -`(require 'fluid-let)' +`(require 'fluid-let)' - - Syntax: fluid-let `(BINDINGS ...)' FORMS... + -- Syntax: fluid-let `(BINDINGS ...)' FORMS... | (fluid-let ((VARIABLE INIT) ...) EXPRESSION EXPRESSION ...) @@ -2007,10 +2091,10 @@ of its corresponding VARIABLE. File: slib.info, Node: Yasos, Prev: Fluid-Let, Up: Scheme Syntax Extension Packages -Yasos -===== +3.9 Yasos | +========= | -`(require 'oop)' or `(require '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 @@ -2032,8 +2116,8 @@ on LISP and Functional Programming, July 1988 [ACM #552880]. File: slib.info, Node: Yasos terms, Next: Yasos interface, Prev: Yasos, Up: Yasos -Terms ------ +3.9.1 Terms | +----------- | "Object" Any Scheme data object. @@ -2063,25 +2147,25 @@ _Disclaimer:_ File: slib.info, Node: Yasos interface, Next: Setters, Prev: Yasos terms, Up: Yasos -Interface ---------- +3.9.2 Interface | +--------------- | - - Syntax: define-operation `('opname self arg ...`)' DEFAULT-BODY + -- Syntax: define-operation `('opname self arg ...`)' DEFAULT-BODY | Defines a default behavior for data objects which don't handle the operation OPNAME. The default behavior (for an empty DEFAULT-BODY) is to generate an error. - - Syntax: define-predicate opname? + -- 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)' ... + -- 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`)' ...`)' + -- 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 @@ -2090,17 +2174,17 @@ Interface 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 ... + -- 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 + -- 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 + -- 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 @@ -2109,8 +2193,8 @@ Interface File: slib.info, Node: Setters, Next: Yasos examples, Prev: Yasos interface, Up: Yasos -Setters -------- +3.9.3 Setters | +------------- | "Setters" implement "generalized locations" for objects associated with some sort of mutable state. A "getter" operation retrieves a value @@ -2127,7 +2211,7 @@ are predefined, corresponding to getters `car', `cdr', `string-ref' and Research and Technology). Common LISP provides similar facilities through `setf'. - - Function: setter getter + -- 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!': @@ -2135,7 +2219,7 @@ through `setf'. ((setter string-ref) foo 0 #\F) ; set element 0 of foo foo => "Foo" - - Syntax: set place new-value + -- 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 @@ -2148,17 +2232,17 @@ through `setf'. (set foo "foo") ; like set! foo => "foo" - - Procedure: add-setter getter setter + -- 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 + -- 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 + -- 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 @@ -2167,18 +2251,18 @@ through `setf'. File: slib.info, Node: Yasos examples, Prev: Setters, Up: Yasos -Examples --------- +3.9.4 Examples | +-------------- | ;;; These definitions for PRINT and SIZE are ;;; already supplied by (require 'yasos) - + (define-operation (print obj port) (format port (if (instance? obj) "#<instance>" "~s") obj)) - + (define-operation (size obj) (cond ((vector? obj) (vector-length obj)) @@ -2188,11 +2272,11 @@ Examples ((char? obj) 1) (else (slib: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) @@ -2203,10 +2287,10 @@ Examples ((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))) @@ -2214,11 +2298,11 @@ Examples (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 @@ -2230,10 +2314,10 @@ Examples (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 @@ -2251,7 +2335,7 @@ Examples ((print self port) (format port "#<Cell-with-history ~s>" (fetch self)))))) - + (define-access-operation fetch) (add-setter fetch store!) (define foo (make-cell 1)) @@ -2267,8 +2351,8 @@ Examples File: slib.info, Node: Textual Conversion Packages, Next: Mathematical Packages, Prev: Scheme Syntax Extension Packages, Up: Top -Textual Conversion Packages -*************************** +4 Textual Conversion Packages | +***************************** | * Menu: @@ -2289,10 +2373,10 @@ Textual Conversion Packages File: slib.info, Node: Precedence Parsing, Next: Format, Prev: Textual Conversion Packages, Up: Textual Conversion Packages -Precedence Parsing -================== +4.1 Precedence Parsing | +====================== | -`(require 'precedence-parse)' or `(require 'parse)' +`(require 'precedence-parse)' or `(require 'parse)' This package implements: @@ -2317,8 +2401,8 @@ This package implements: File: slib.info, Node: Precedence Parsing Overview, Next: Rule Types, Prev: Precedence Parsing, Up: Precedence Parsing -Precedence Parsing Overview ---------------------------- +4.1.1 Precedence Parsing Overview | +--------------------------------- | This package offers improvements over previous parsers. @@ -2350,7 +2434,7 @@ A syntax tree is not built unless the rules explicitly do so. The call graph of grammar rules effectively instantiate the sytnax tree. The JACAL symbolic math system -(<http://swissnet.ai.mit.edu/~jaffer/JACAL.html>) uses +(`http://swiss.csail.mit.edu/~jaffer/JACAL.html') uses | precedence-parse. Its grammar definitions in the file `jacal/English.scm' can serve as examples of use. @@ -2362,65 +2446,65 @@ file) with a non-trivial grammar utilizing all constructs. File: slib.info, Node: Rule Types, Next: Ruleset Definition and Use, Prev: Precedence Parsing Overview, Up: Precedence Parsing -Rule Types ----------- +4.1.2 Rule Types | +---------------- | Here are the higher-level syntax types and an example of each. Precedence considerations are omitted for clarity. See *Note Grammar Rule Definition:: for full details. - - Grammar: nofix bye exit + -- Grammar: nofix bye exit | bye calls the function `exit' with no arguments. - - Grammar: prefix - negate + -- Grammar: prefix - negate | - 42 Calls the function `negate' with the argument `42'. - - Grammar: infix - difference + -- Grammar: infix - difference | x - y Calls the function `difference' with arguments `x' and `y'. - - Grammar: nary + sum + -- Grammar: nary + sum | x + y + z Calls the function `sum' with arguments `x', `y', and `y'. - - Grammar: postfix ! factorial + -- Grammar: postfix ! factorial | 5 ! Calls the function `factorial' with the argument `5'. - - Grammar: prestfix set set! + -- Grammar: prestfix set set! | set foo bar Calls the function `set!' with the arguments `foo' and `bar'. - - Grammar: commentfix /* */ + -- Grammar: commentfix /* */ | /* almost any text here */ Ignores the comment delimited by `/*' and `*/'. - - Grammar: matchfix { list } + -- Grammar: matchfix { list } | {0, 1, 2} Calls the function `list' with the arguments `0', `1', and `2'. - - Grammar: inmatchfix ( funcall ) + -- Grammar: inmatchfix ( funcall ) | f(x, y) Calls the function `funcall' with the arguments `f', `x', and `y'. - - Grammar: delim ; + -- Grammar: delim ; | set foo bar; delimits the extent of the restfix operator `set'. File: slib.info, Node: Ruleset Definition and Use, Next: Token definition, Prev: Rule Types, Up: Precedence Parsing -Ruleset Definition and Use --------------------------- +4.1.3 Ruleset Definition and Use | +-------------------------------- | - - Variable: *syn-defs* + -- Variable: *syn-defs* | A grammar is built by one or more calls to `prec:define-grammar'. The rules are appended to *SYN-DEFS*. The value of *SYN-DEFS* is the grammar suitable for passing as an argument to `prec:parse'. - - Constant: *syn-ignore-whitespace* + -- 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 `*syn-ignore-whitespace*' @@ -2428,12 +2512,11 @@ Ruleset Definition and Use In order to start defining a grammar, either (set! *syn-defs* '()) - -or + or (set! *syn-defs* *syn-ignore-whitespace*) - - Function: prec:define-grammar rule1 ... + -- Function: prec:define-grammar rule1 ... | Appends RULE1 ... to *SYN-DEFS*. `prec:define-grammar' is used to define both the character classes and rules for tokens. @@ -2442,8 +2525,8 @@ variable (for use when calling `prec:parse'). (define my-ruleset *syn-defs*) - - Function: prec:parse ruleset delim - - Function: prec:parse ruleset delim port + -- Function: prec:parse ruleset delim | + -- Function: prec:parse ruleset delim port | The RULESET argument must be a list of rules as constructed by `prec:define-grammar' and extracted from *SYN-DEFS*. @@ -2467,15 +2550,15 @@ variable (for use when calling `prec:parse'). The PORT argument may be omitted, in which case it defaults to the value returned by `current-input-port'. It is an error to parse - from a closed port. + from a closed port. File: slib.info, Node: Token definition, Next: Nud and Led Definition, Prev: Ruleset Definition and Use, Up: Precedence Parsing -Token definition ----------------- +4.1.4 Token definition | +---------------------- | - - Function: tok:char-group group chars chars-proc + -- Function: tok:char-group group chars chars-proc | The argument CHARS may be a single character, a list of characters, or a string. Each character in CHARS is treated as though `tok:char-group' was called with that character alone. @@ -2509,34 +2592,34 @@ Token definition The following convenient constants are provided for use with `tok:char-group'. - - Constant: tok:decimal-digits + -- Constant: tok:decimal-digits | Is the string `"0123456789"'. - - Constant: tok:upper-case + -- Constant: tok:upper-case | Is the string consisting of all upper-case letters ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"). - - Constant: tok:lower-case + -- Constant: tok:lower-case | Is the string consisting of all lower-case letters ("abcdefghijklmnopqrstuvwxyz"). - - Constant: tok:whitespaces + -- Constant: tok:whitespaces | Is the string consisting of all characters between 0 and 255 for which `char-whitespace?' returns true. -For the purpose of reporting problems in error messages, this package | -keeps track of the "current column". When the column does not simply | -track input characters, `tok:bump-column' can be used to adjust the | -current-column. | - | - - Function: tok:bump-column pos port | - Adds POS to the current-column for input-port PORT. | - | +For the purpose of reporting problems in error messages, this package +keeps track of the "current column". When the column does not simply +track input characters, `tok:bump-column' can be used to adjust the +current-column. + + -- Function: tok:bump-column pos port | + Adds POS to the current-column for input-port PORT. + File: slib.info, Node: Nud and Led Definition, Next: Grammar Rule Definition, Prev: Token definition, Up: Precedence Parsing -Nud and Led Definition ----------------------- +4.1.5 Nud and Led Definition | +---------------------------- | This section describes advanced features. You can skip this section on first reading. @@ -2570,7 +2653,7 @@ Character 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. - - Function: prec:make-nud tk sop arg1 ... + -- Function: prec:make-nud tk sop arg1 ... | Returns a rule specifying that SOP be called when TK is parsed. If SOP is a procedure, it is called with TK and ARG1 ... as its arguments; the resulting value is incorporated into the expression @@ -2580,7 +2663,7 @@ 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. - - Function: prec:make-led tk sop arg1 ... + -- Function: prec:make-led tk sop arg1 ... | Returns a rule specifying that SOP be called when TK is parsed and LEFT has an unclaimed parsed expression. If SOP is a procedure, it is called with LEFT, TK, and ARG1 ... as its arguments; the @@ -2593,8 +2676,8 @@ issues a warning. File: slib.info, Node: Grammar Rule Definition, Prev: Nud and Led Definition, Up: Precedence Parsing -Grammar Rule Definition ------------------------ +4.1.6 Grammar Rule Definition | +----------------------------- | Here are procedures for defining rules for the syntax types introduced in *Note Precedence Parsing Overview::. @@ -2613,19 +2696,19 @@ Character 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. - - Function: prec:delim tk + -- Function: prec:delim tk | Returns a rule specifying that TK should not be returned from parsing; i.e. TK's function is purely syntactic. The end-of-file is always treated as a delimiter. - - Function: prec:nofix tk sop + -- Function: prec:nofix tk sop | Returns a rule specifying the following actions take place when TK is parsed: * If SOP is a procedure, it is called with no arguments; the resulting value is incorporated into the expression being built. Otherwise, the list of SOP is incorporated. - - Function: prec:prefix tk sop bp rule1 ... + -- Function: prec:prefix tk sop bp rule1 ... | Returns a rule specifying the following actions take place when TK is parsed: * The rules RULE1 ... augment and, in case of conflict, override @@ -2642,7 +2725,7 @@ will both match token strings; i.e. tokens resulting from token groups. * The ruleset in effect before TK was parsed is restored; RULE1 ... are forgotten. - - Function: prec:infix tk sop lbp bp rule1 ... + -- Function: prec:infix tk sop lbp bp rule1 ... | Returns a rule declaring the left-binding-precedence of the token TK is LBP and specifying the following actions take place when TK is parsed: @@ -2661,7 +2744,7 @@ will both match token strings; i.e. tokens resulting from token groups. * The ruleset in effect before TK was parsed is restored; RULE1 ... are forgotten. - - Function: prec:nary tk sop bp + -- Function: prec:nary tk sop bp | Returns a rule declaring the left-binding-precedence of the token TK is BP and specifying the following actions take place when TK is parsed: @@ -2674,7 +2757,7 @@ will both match token strings; i.e. tokens resulting from token groups. the LEFT expression, and the parsed expressions is incorporated. - - Function: prec:postfix tk sop lbp + -- Function: prec:postfix tk sop lbp | Returns a rule declaring the left-binding-precedence of the token TK is LBP and specifying the following actions take place when TK is parsed: @@ -2683,7 +2766,7 @@ will both match token strings; i.e. tokens resulting from token groups. built. Otherwise, the list of SOP and the LEFT expression is incorporated. - - Function: prec:prestfix tk sop bp rule1 ... + -- Function: prec:prestfix tk sop bp rule1 ... | Returns a rule specifying the following actions take place when TK is parsed: * The rules RULE1 ... augment and, in case of conflict, override @@ -2700,7 +2783,7 @@ will both match token strings; i.e. tokens resulting from token groups. * The ruleset in effect before TK was parsed is restored; RULE1 ... are forgotten. - - Function: prec:commentfix tk stp match rule1 ... + -- Function: prec:commentfix tk stp match rule1 ... | Returns rules specifying the following actions take place when TK is parsed: * The rules RULE1 ... augment and, in case of conflict, override @@ -2720,7 +2803,7 @@ will both match token strings; i.e. tokens resulting from token groups. STP but does not return its value; nay any value. I added the STP argument so that comment text could be echoed. - - Function: prec:matchfix tk sop sep match rule1 ... + -- Function: prec:matchfix tk sop sep match rule1 ... | Returns a rule specifying the following actions take place when TK is parsed: * The rules RULE1 ... augment and, in case of conflict, override @@ -2740,7 +2823,7 @@ will both match token strings; i.e. tokens resulting from token groups. * The ruleset in effect before TK was parsed is restored; RULE1 ... are forgotten. - - Function: prec:inmatchfix tk sop sep match lbp rule1 ... + -- Function: prec:inmatchfix tk sop sep match lbp rule1 ... | Returns a rule declaring the left-binding-precedence of the token TK is LBP and specifying the following actions take place when TK is parsed: @@ -2765,53 +2848,520 @@ will both match token strings; i.e. tokens resulting from token groups. File: slib.info, Node: Format, Next: Standard Formatted I/O, Prev: Precedence Parsing, Up: Textual Conversion Packages -Format (version 3.0) -==================== +4.2 Format (version 3.1) | +======================== | -The `format.scm' package was removed because it was not reentrant. | -<http://swissnet.ai.mit.edu/~jaffer/SLIB.FAQ> explains more about | -FORMAT's woes. | +`(require 'format)' | + | +* Menu: | + | +* Format Interface:: | +* Format Specification:: | + | + +File: slib.info, Node: Format Interface, Next: Format Specification, Prev: Format, Up: Format + | +4.2.1 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 + | +4.2.2 Format Specification (Format version 3.1) | +----------------------------------------------- | + | +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 | # ] | + | +4.2.2.1 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 "old fashioned" 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)). Iteration | + bounding is controlled by configuration variables | + FORMAT:ITERATION-BOUNDED and FORMAT:MAX-ITERATIONS. With both | + variables default, a maximum of 100 iterations will be performed. | + `~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 | + | +4.2.2.2 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) | + | +4.2.2.3 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. | + | +4.2.2.4 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') | + | +FORMAT:ITERATION-BOUNDED | + When `#t', a `~{...~}' control will iterate no more than the | + number of times specified by FORMAT:MAX-ITERATIONS regardless of | + the number of iterations implied by modifiers and arguments. When | + `#f', a `~{...~}' control will iterate the number of times implied | + by modifiers and arguments, unless termination is forced by | + language or system limitations. (default `#t') | + | +FORMAT:MAX-ITERATIONS | + The maximum number of iterations performed by a `~{...~}' control. | + Has effect only when FORMAT:ITERATION-BOUNDED is `#t'. (default | + 100) | + | + | +4.2.2.5 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: Standard Formatted I/O, Next: Programs and Arguments, Prev: Format, Up: Textual Conversion Packages -Standard Formatted I/O -====================== +4.3 Standard Formatted I/O | +========================== | * Menu: * Standard Formatted Output:: 'printf * Standard Formatted Input:: 'scanf -stdio ------ +4.3.1 stdio | +----------- | -`(require 'stdio)' +`(require 'stdio)' `require's `printf' and `scanf' and additionally defines the symbols: - - Variable: stdin + -- Variable: stdin | Defined to be `(current-input-port)'. - - Variable: stdout + -- Variable: stdout | Defined to be `(current-output-port)'. - - Variable: stderr + -- 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 -------------------------- +4.3.2 Standard Formatted Output | +------------------------------- | -`(require 'printf)' +`(require 'printf)' - - Procedure: printf format arg1 ... - - Procedure: fprintf port format arg1 ... - - Procedure: sprintf str format arg1 ... - - Procedure: sprintf #f format arg1 ... - - Procedure: sprintf k format arg1 ... + -- Procedure: printf format arg1 ... | + -- Procedure: fprintf port format arg1 ... | + -- Procedure: sprintf str format arg1 ... | + -- Procedure: sprintf #f format arg1 ... | + -- Procedure: sprintf k 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. @@ -2887,7 +3437,7 @@ Standard Formatted Output 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. + 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) @@ -2900,7 +3450,7 @@ Standard Formatted Output 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). + 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 @@ -2937,8 +3487,8 @@ Standard Formatted Output * A character that specifies the conversion to be applied. -Exact Conversions -................. +4.3.2.1 Exact Conversions | +......................... | `b', `B' Print an integer as an unsigned binary number. @@ -2961,8 +3511,8 @@ Exact Conversions prints using the digits `0123456789abcdef'. `%X' prints using the digits `0123456789ABCDEF'. -Inexact Conversions -................... +4.3.2.2 Inexact Conversions | +........................... | `f' Print a floating-point number in fixed-point notation. @@ -2982,12 +3532,12 @@ Inexact Conversions `k', `K' Print a number like `%g', except that an SI prefix is output - after the number, which is scaled accordingly. `%K' outputs - a space between number and prefix, `%k' does not. + after the number, which is scaled accordingly. `%K' outputs a | + dot between number and prefix, `%k' does not. | -Other Conversions -................. +4.3.2.3 Other Conversions | +......................... | `c' Print a single character. The `-' flag is the only one which @@ -3017,18 +3567,18 @@ Other Conversions File: slib.info, Node: Standard Formatted Input, Prev: Standard Formatted Output, Up: Standard Formatted I/O -Standard Formatted Input ------------------------- +4.3.3 Standard Formatted Input | +------------------------------ | -`(require 'scanf)' +`(require 'scanf)' - - Function: scanf-read-list format - - Function: scanf-read-list format port - - Function: scanf-read-list format string + -- 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 ... + -- 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. @@ -3176,8 +3726,8 @@ Standard Formatted Input File: slib.info, Node: Programs and Arguments, Next: HTML, Prev: Standard Formatted I/O, Up: Textual Conversion Packages -Program and Arguments -===================== +4.4 Program and Arguments | +========================= | * Menu: @@ -3191,10 +3741,10 @@ Program and Arguments File: slib.info, Node: Getopt, Next: Command Line, Prev: Programs and Arguments, Up: Programs and Arguments -Getopt ------- +4.4.1 Getopt | +------------ | -`(require 'getopt)' +`(require 'getopt)' This routine implements Posix command line argument parsing. Notice that returning values through global variables means that `getopt' is @@ -3212,21 +3762,21 @@ mismatch existed for years in a SLIB `getopt--' example. I have removed the ARGC and ARGV arguments to getopt procedures; and replaced them with a global variable: - - Variable: *argv* + -- Variable: *argv* | Define *ARGV* with a list of arguments before calling getopt procedures. If you don't want the first (0th) element to be ignored, set *OPTIND* to 0 (after requiring getopt). - - Variable: *optind* + -- 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, *OPTIND* must be reset. - - Variable: *optarg* + -- Variable: *optarg* | Is set by getopt to the (string) option-argument of the current option. - - Function: getopt optstring | + -- Function: getopt 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 @@ -3306,13 +3856,13 @@ replaced them with a global variable: (set! *optind* (+ *optind* 1)))) (if (< *optind* (length argv)) (loop (getopt (length argv) argv opts)))) - + (slib:exit) -Getopt-- --------- +4.4.2 Getopt-- | +-------------- | - - Function: `getopt--' optstring | + -- Function: `getopt--' 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' @@ -3348,18 +3898,17 @@ Getopt-- File: slib.info, Node: Command Line, Next: Parameter lists, Prev: Getopt, Up: Programs and Arguments -Command Line ------------- +4.4.3 Command Line | +------------------ | -`(require 'read-command)' +`(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. + -- 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 @@ -3410,11 +3959,11 @@ Command Line treated as whitespace by `read-dommand-line' and backslashes before <newline>s in comments are also ignored. - - Function: read-options-file filename - `read-options-file' converts an "options file" into a list of - strings suitable for parsing by `getopt'. The syntax of options - files is the same as the syntax for command lines, except that - <newline>s do not terminate reading (only <;> or end of file). + -- Function: read-options-file filename | + `read-options-file' converts an "options file" into a list of strings | + suitable for parsing by `getopt'. The syntax of options files is | + the same as the syntax for command lines, except that <newline>s | + do not terminate reading (only <;> 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 @@ -3423,10 +3972,10 @@ Command Line File: slib.info, Node: Parameter lists, Next: Getopt Parameter lists, Prev: Command Line, Up: Programs and Arguments -Parameter lists ---------------- +4.4.4 Parameter lists | +--------------------- | -`(require 'parameters)' +`(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 @@ -3442,25 +3991,25 @@ 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 + -- Function: make-parameter-list parameter-names | Returns an empty parameter-list with slots for PARAMETER-NAMES. - - Function: parameter-list-ref parameter-list parameter-name + -- 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. - - Function: remove-parameter parameter-name parameter-list + -- Function: remove-parameter parameter-name parameter-list | Removes the parameter PARAMETER-NAME from PARAMETER-LIST. `remove-parameter' does not alter the argument PARAMETER-LIST. If there are more than one PARAMETER-NAME parameters, an error is signaled. - - Procedure: adjoin-parameters! parameter-list parameter1 ... + -- Procedure: adjoin-parameters! parameter-list parameter1 ... | Returns PARAMETER-LIST with PARAMETER1 ... merged in. - - Procedure: parameter-list-expand expanders parameter-list + -- 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 @@ -3470,7 +4019,7 @@ PARAMETER-NAME. This process is repeated until PARAMETER-LIST stops growing. The value returned from `parameter-list-expand' is unspecified. - - Function: fill-empty-parameters defaulters parameter-list + -- Function: fill-empty-parameters defaulters parameter-list | DEFAULTERS 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. `fill-empty-parameters' returns a new @@ -3478,7 +4027,7 @@ PARAMETER-NAME. returned by calling the corresponding DEFAULTER with PARAMETER-LIST as its argument. - - Function: check-parameters checks parameter-list + -- 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. @@ -3505,7 +4054,7 @@ of `arities' can be: `nary1' One or more of parameters are acceptable. - - Function: parameter-list->arglist positions arities parameter-list + -- Function: parameter-list->arglist positions arities 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 @@ -3519,13 +4068,13 @@ of `arities' can be: File: slib.info, Node: Getopt Parameter lists, Next: Filenames, Prev: Parameter lists, Up: Programs and Arguments -Getopt Parameter lists ----------------------- +4.4.5 Getopt Parameter lists | +---------------------------- | -`(require 'getopt-parameters)' +`(require 'getopt-parameters)' - - Function: getopt->parameter-list optnames arities types aliases desc - ... + -- Function: getopt->parameter-list optnames arities types aliases | + desc ... | Returns *ARGV* converted to a parameter-list. OPTNAMES are the parameter-names. ARITIES and TYPES are lists of symbols corresponding to OPTNAMES. @@ -3551,7 +4100,7 @@ Getopt Parameter lists In all cases, if unclaimed arguments remain after processing, a warning is signaled and #f is returned. - - Function: getopt->arglist optnames positions arities types + -- Function: getopt->arglist optnames positions arities types | defaulters checks aliases desc ... Like `getopt->parameter-list', but converts *ARGV* to an argument-list as specified by OPTNAMES, POSITIONS, ARITIES, TYPES, @@ -3589,7 +4138,7 @@ the options (and argument strings DESC ...) are printed to ("Abs" num3)))) -| Usage: cmd [OPTION ARGUMENT ...] ... - + -f, --flag -o, --optional=<number> -n, --nary=<symbols> ... @@ -3599,19 +4148,19 @@ the options (and argument strings DESC ...) are printed to -B -a <num2> ... --Abs=<num3> ... - + ERROR: getopt->parameter-list "unrecognized option" "-?" File: slib.info, Node: Filenames, Next: Batch, Prev: Getopt Parameter lists, Up: Programs and Arguments -Filenames ---------- +4.4.6 Filenames | +--------------- | -`(require 'filename)' or `(require 'glob)' +`(require 'filename)' or `(require 'glob)' - - Function: filename:match?? pattern - - Function: filename:match-ci?? pattern + -- Function: filename:match?? pattern | + -- Function: filename:match-ci?? pattern | Returns a predicate which returns a non-false value if its string argument matches (the string) PATTERN, false otherwise. Filename matching is like "glob" expansion described the bash manpage, @@ -3635,8 +4184,8 @@ Filenames `-' or `]' may be matched by including it as the first or last character in the set. - - Function: filename:substitute?? pattern template - - Function: filename:substitute-ci?? pattern template + -- Function: filename:substitute?? pattern template | + -- Function: filename:substitute-ci?? pattern template | Returns a function transforming a single string argument according to glob patterns PATTERN and TEMPLATE. PATTERN and TEMPLATE must have the same number of wildcard specifications, which need not be @@ -3662,11 +4211,11 @@ Filenames => "begAmidZend" ((filename:substitute?? "*na*" "?NA?") "banana") => "banaNA" - ((filename:substitute?? "?*?" (lambda (s1 s2 s3) (string-append s3 s1))) | - "ABZ") | + ((filename:substitute?? "?*?" (lambda (s1 s2 s3) (string-append s3 s1))) + "ABZ") => "ZA" - - Function: replace-suffix str old new + -- Function: replace-suffix str old new | STR can be a string or a list of strings. Returns a new string (or strings) similar to `str' but with the suffix string OLD removed and the suffix string NEW appended. If the end of STR @@ -3675,28 +4224,28 @@ Filenames (replace-suffix "/usr/local/lib/slib/batch.scm" ".scm" ".c") => "/usr/local/lib/slib/batch.c" - - Function: call-with-tmpnam proc k | - - Function: call-with-tmpnam proc | - Calls PROC with K arguments, strings returned by successive calls | - to `tmpnam'. If PROC returns, then any files named by the | - arguments to PROC are deleted automatically and the value(s) | - yielded by the PROC is(are) returned. K may be ommited, in which | - case it defaults to `1'. | - | - - Function: call-with-tmpnam proc suffix1 ... | - Calls PROC with strings returned by successive calls to `tmpnam', | - each with the corresponding SUFFIX string appended. If PROC | - returns, then any files named by the arguments to PROC are deleted | - automatically and the value(s) yielded by the PROC is(are) | - returned. | - | + -- Function: call-with-tmpnam proc k | + -- Function: call-with-tmpnam proc | + Calls PROC with K arguments, strings returned by successive calls + to `tmpnam'. If PROC returns, then any files named by the + arguments to PROC are deleted automatically and the value(s) + yielded by the PROC is(are) returned. K may be ommited, in which + case it defaults to `1'. + + -- Function: call-with-tmpnam proc suffix1 ... | + Calls PROC with strings returned by successive calls to `tmpnam', + each with the corresponding SUFFIX string appended. If PROC + returns, then any files named by the arguments to PROC are deleted + automatically and the value(s) yielded by the PROC is(are) + returned. + File: slib.info, Node: Batch, Prev: Filenames, Up: Programs and Arguments -Batch ------ +4.4.7 Batch | +----------- | -`(require '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 @@ -3725,18 +4274,18 @@ currently uses 2 of these: to store information linking the names of `operating-system's to `batch-dialect'es. - - Function: batch:initialize! database + -- Function: batch:initialize! database | Defines `operating-system' and `batch-dialect' tables and adds the domain `operating-system' to the enhanced relational database DATABASE. - - Variable: *operating-system* + -- Variable: *operating-system* | Is batch's best guess as to which operating-system it is running under. `*operating-system*' 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 + -- 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. @@ -3753,7 +4302,7 @@ added to PARMS or `(copy-tree PARMS)' by the code: (adjoin-parameters! PARMS (list 'batch-port PORT)) - - Function: batch:command parms string1 string2 ... + -- Function: batch:command parms string1 string2 ... | Calls `batch:try-command' (below) with arguments, but signals an error if `batch:try-command' returns `#f'. @@ -3761,11 +4310,11 @@ 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-command parms string1 string2 ... + -- Function: batch:try-command parms string1 string2 ... | Writes a command to the `batch-port' in PARMS which executes the program named STRING1 with arguments STRING2 .... - - Function: batch:try-chopped-command parms arg1 arg2 ... list + -- Function: batch:try-chopped-command parms arg1 arg2 ... list | breaks the last argument LIST into chunks small enough so that the command: @@ -3777,34 +4326,34 @@ translated into the batch dialect and `#f' if not. In the case of the command and returns non-false only if the commands all fit and `batch:try-command' of each command line returned non-false. - - Function: batch:run-script parms string1 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-command' are not the same for some operating systems (VMS). - - Function: batch:comment parms line1 ... + -- Function: batch:comment parms line1 ... | Writes comment lines LINE1 ... to the `batch-port' in PARMS. - - Function: batch:lines->file parms file line1 ... + -- 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 + -- 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 + -- 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: truncate-up-to path char - - Function: truncate-up-to path string - - Function: truncate-up-to path charlist + -- Function: truncate-up-to path char | + -- Function: truncate-up-to path string | + -- Function: truncate-up-to path charlist | PATH can be a string or a list of strings. Returns PATH sans any prefixes ending with a character of the second argument. This can be used to derive a filename moved locally from elsewhere. @@ -3812,22 +4361,22 @@ scripts: (truncate-up-to "/usr/local/lib/slib/batch.scm" "/") => "batch.scm" - - Function: string-join joiner string1 ... + -- 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 + -- 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 + -- 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 + -- 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!'. @@ -3841,12 +4390,12 @@ Here is an example of the use of most of batch's procedures: (define batch (create-database #f 'alist-table)) (batch:initialize! batch) - + (define my-parameters (list (list 'batch-dialect (os->batch-dialect *operating-system*)) (list 'operating-system *operating-system*) (list 'batch-port (current-output-port)))) ;gets filled in later - + (batch:call-with-output-script my-parameters "my-batch" @@ -3903,34 +4452,34 @@ When run, `my-batch' prints: File: slib.info, Node: HTML, Next: HTML Tables, Prev: Programs and Arguments, Up: Textual Conversion Packages -HTML -==== +4.5 HTML | +======== | -`(require 'html-form)' +`(require 'html-form)' - - Function: html:atval txt + -- Function: html:atval txt | Returns a string with character substitutions appropriate to send - TXT as an "attribute-value". + TXT as an "attribute-value". - - Function: html:plain txt + -- Function: html:plain txt | Returns a string with character substitutions appropriate to send - TXT as an "plain-text". + TXT as an "plain-text". - - Function: html:meta name content + -- Function: html:meta name content | Returns a tag of meta-information suitable for passing as the third argument to `html:head'. The tag produced is `<META NAME="NAME" CONTENT="CONTENT">'. The string or symbol NAME can be `author', `copyright', `keywords', `description', `date', `robots', .... - - Function: html:http-equiv name content + -- Function: html:http-equiv name content | Returns a tag of HTTP information suitable for passing as the third argument to `html:head'. The tag produced is `<META HTTP-EQUIV="NAME" CONTENT="CONTENT">'. The string or symbol NAME can be `Expires', `PICS-Label', `Content-Type', `Refresh', .... - - Function: html:meta-refresh delay uri - - Function: html:meta-refresh delay + -- Function: html:meta-refresh delay uri | + -- Function: html:meta-refresh delay | Returns a tag suitable for passing as the third argument to `html:head'. If URI argument is supplied, then DELAY seconds after displaying the page with this tag, Netscape or IE browsers will @@ -3938,67 +4487,66 @@ HTML the page with this tag, Netscape or IE browsers will fetch and redisplay this page. - - Function: html:head title backlink tags ... - - Function: html:head title backlink - - Function: html:head title + -- Function: html:head title backlink tags ... | + -- Function: html:head title backlink | + -- Function: html:head title | Returns header string for an HTML page named TITLE. If BACKLINK is a string, it is used verbatim between the `H1' tags; otherwise TITLE is used. If string arguments TAGS ... are supplied, then they are included verbatim within the <HEAD> section. - - Function: html:body body ... + -- Function: html:body body ... | Returns HTML string to end a page. - - Function: html:pre line1 line ... - Returns the strings LINE1, LINES as "PRE"formmated plain text - (rendered in fixed-width font). Newlines are inserted between - LINE1, LINES. HTML tags (`<tag>') within LINES will be visible - verbatim. + -- Function: html:pre line1 line ... | + Returns the strings LINE1, LINES as "PRE"formmated plain text (rendered | + in fixed-width font). Newlines are inserted between LINE1, LINES. | + HTML tags (`<tag>') within LINES will be visible verbatim. | - - Function: html:comment line1 line ... + -- Function: html:comment line1 line ... | Returns the strings LINE1 as HTML comments. -HTML Forms -========== +4.6 HTML Forms | +============== | - - Function: html:form method action body ... + -- Function: html:form method action body ... | The symbol METHOD is either `get', `head', `post', `put', or `delete'. The strings BODY form the body of the form. - `html:form' returns the HTML "form". + `html:form' returns the HTML "form". - - Function: html:hidden name value + -- Function: html:hidden name value | Returns HTML string which will cause NAME=VALUE in form. - - Function: html:checkbox pname default + -- Function: html:checkbox pname default | Returns HTML string for check box. - - Function: html:text pname default size ... + -- Function: html:text pname default size ... | Returns HTML string for one-line text box. - - Function: html:text-area pname default-list + -- Function: html:text-area pname default-list | Returns HTML string for multi-line text box. - - Function: html:select pname arity default-list foreign-values + -- Function: html:select pname arity default-list foreign-values | Returns HTML string for pull-down menu selector. - - Function: html:buttons pname arity default-list foreign-values + -- Function: html:buttons pname arity default-list foreign-values | Returns HTML string for any-of selector. - - Function: form:submit submit-label command - - Function: form:submit submit-label + -- Function: form:submit submit-label command | + -- Function: form:submit submit-label | The string or symbol SUBMIT-LABEL appears on the button which submits the form. If the optional second argument COMMAND is given, then `*command*=COMMAND' and `*button*=SUBMIT-LABEL' are set in the query. Otherwise, `*command*=SUBMIT-LABEL' is set in the query. - - Function: form:image submit-label image-src + -- Function: form:image submit-label image-src | The IMAGE-SRC appears on the button which submits the form. - - Function: form:reset - Returns a string which generates a "reset" button. + -- Function: form:reset | + Returns a string which generates a "reset" button. - - Function: form:element pname arity default-list foreign-values + -- Function: form:element pname arity default-list foreign-values | Returns a string which generates an INPUT element for the field named PNAME. The element appears in the created form with its representation determined by its ARITY and domain. For domains @@ -4037,19 +4585,19 @@ HTML Forms `nary1' text area - - Function: form:delimited pname doc aliat arity default-list + -- Function: form:delimited pname doc aliat arity default-list | foreign-values Returns a HTML string for a form element embedded in a line of a delimited list. Apply map `form:delimited' to the list returned by `command->p-specs'. - - Function: html:delimited-list row ... | - Wraps its arguments with delimited-list (`DL' command. | - | - - Function: get-foreign-choices tab | - Returns a list of the `visible-name' or first fields of table TAB. | - | - - Function: command->p-specs rdb command-table command + -- Function: html:delimited-list row ... | + Wraps its arguments with delimited-list (`DL' command. + + -- Function: get-foreign-choices tab | + Returns a list of the `visible-name' or first fields of table TAB. + + -- Function: command->p-specs rdb command-table command | The symbol COMMAND-TABLE names a command table in the RDB relational database. The symbol COMMAND names a key in COMMAND-TABLE. @@ -4084,25 +4632,25 @@ HTML Forms File: slib.info, Node: HTML Tables, Next: HTTP and CGI, Prev: HTML, Up: Textual Conversion Packages -HTML Tables -=========== +4.7 HTML Tables | +=============== | -`(require 'db->html)' +`(require 'db->html)' - - Function: html:table options row ... + -- Function: html:table options row ... | - - Function: html:caption caption align - - Function: html:caption caption + -- Function: html:caption caption align | + -- Function: html:caption caption | ALIGN can be `top' or `bottom'. - - Function: html:heading columns + -- Function: html:heading columns | Outputs a heading row for the currently-started table. - - Function: html:href-heading columns uris + -- Function: html:href-heading columns uris | Outputs a heading row with column-names COLUMNS linked to URIs URIS. - - Function: html:linked-row-converter k foreigns + -- Function: html:linked-row-converter k foreigns | The positive integer K is the primary-key-limit (number of primary-keys) of the table. FOREIGNS is a list of the filenames of foreign-key field pages and #f for non foreign-key fields. @@ -4111,28 +4659,29 @@ HTML Tables its single argument. This returned procedure returns the html string for that table row. - - Function: table-name->filename table-name + -- Function: table-name->filename table-name | Returns the symbol TABLE-NAME converted to a filename. - - Function: table->linked-html caption db table-name match-key1 ... - Returns HTML string for DB table TABLE-NAME. Every foreign-key - value is linked to the page (of the table) defining that key. + -- Function: table->linked-html caption db table-name match-key1 ... | + Returns HTML string for DB table TABLE-NAME chopped into 50-row | + HTML tables. Every foreign-key value is linked to the page (of | + the table) defining that key. | The optional MATCH-KEY1 ... arguments restrict actions to a subset of the table. *Note match-key: Table Operations. - - Function: table->linked-page db table-name index-filename arg ... + -- Function: table->linked-page db table-name index-filename arg ... | Returns a complete HTML page. The string INDEX-FILENAME names the page which refers to this one. The optional ARGS ... arguments restrict actions to a subset of the table. *Note match-key: Table Operations. - - Function: catalog->html db caption arg ... + -- Function: catalog->html db caption arg ... | Returns HTML string for the catalog table of DB. -HTML editing tables -------------------- +4.7.1 HTML editing tables | +------------------------- | A client can modify one row of an editable table at a time. For any change submitted, these routines check if that row has been modified @@ -4165,11 +4714,11 @@ The behavior of edited rows is: After any change to the table, a `sync-database' of the database is performed. - - Function: command:modify-table table-name null-keys update delete + -- Function: command:modify-table table-name null-keys update delete | retrieve - - Function: command:modify-table table-name null-keys update delete - - Function: command:modify-table table-name null-keys update - - Function: command:modify-table table-name null-keys + -- Function: command:modify-table table-name null-keys update delete | + -- Function: command:modify-table table-name null-keys update | + -- Function: command:modify-table table-name null-keys | Returns procedure (of DB) which returns procedure to modify row of TABLE-NAME. NULL-KEYS is the list of "null" keys indicating the row is to be deleted when any matches its corresponding primary @@ -4177,7 +4726,7 @@ performed. the `row:update', `row:delete', and `row:retrieve' of TABLE-NAME in DB. - - Function: command:make-editable-table rdb table-name arg ... + -- Function: command:make-editable-table rdb table-name arg ... | Given TABLE-NAME in RDB, creates parameter and `*command*' tables for editing one row of TABLE-NAME at a time. `command:make-editable-table' returns a procedure taking a row @@ -4195,7 +4744,7 @@ performed. `+' have arity `nary1'. - - Function: html:editable-row-converter k names edit-point + -- Function: html:editable-row-converter k names edit-point | edit-converter The positive integer K is the primary-key-limit (number of primary-keys) of the table. NAMES is a list of the field-names. @@ -4213,10 +4762,10 @@ performed. `row->anchor'). The page so referenced typically allows the user to edit fields of that row. -HTML databases --------------- +4.7.2 HTML databases | +-------------------- | - - Function: db->html-files db dir index-filename caption + -- Function: db->html-files db dir index-filename caption | DB must be a relational database. DIR must be #f or a non-empty string naming an existing sub-directory of the current directory. @@ -4226,8 +4775,8 @@ HTML databases tables (captioned CAPTION) is written to a file named INDEX-FILENAME. - - Function: db->html-directory db dir index-filename - - Function: db->html-directory db dir + -- Function: db->html-directory db dir index-filename | + -- Function: db->html-directory db dir | DB must be a relational database. DIR must be a non-empty string naming an existing sub-directory of the current directory or one to be created. The optional string INDEX-FILENAME names the @@ -4237,8 +4786,8 @@ HTML databases calls `(db->html-files DB DIR INDEX-FILENAME DIR)'. The `file:' URI of INDEX-FILENAME is returned. - - Function: db->netscape db dir index-filename - - Function: db->netscape db dir + -- Function: db->netscape db dir index-filename | + -- Function: db->netscape db dir | `db->netscape' is just like `db->html-directory', but calls `browse-url' with the uri for the top page after the pages are created. @@ -4246,39 +4795,39 @@ HTML databases File: slib.info, Node: HTTP and CGI, Next: Parsing HTML, Prev: HTML Tables, Up: Textual Conversion Packages -HTTP and CGI -============ +4.8 HTTP and CGI | +================ | -`(require 'http)' or `(require 'cgi)' +`(require 'http)' or `(require 'cgi)' - - Function: http:header alist + -- Function: http:header alist | Returns a string containing lines for each element of ALIST; the `car' of which is followed by `: ', then the `cdr'. - - Function: http:content alist body ... + -- Function: http:content alist body ... | Returns the concatenation of strings BODY with the `(http:header ALIST)' and the `Content-Length' prepended. - - Variable: *http:byline* + -- Variable: *http:byline* | String appearing at the bottom of error pages. - - Function: http:error-page status-code reason-phrase html-string ... + -- Function: http:error-page status-code reason-phrase html-string ... | STATUS-CODE and REASON-PHRASE should be an integer and string as specified in `RFC 2068'. The returned page (string) will show the STATUS-CODE and REASON-PHRASE and any additional HTML-STRINGS ...; with *HTTP:BYLINE* or SLIB's default at the bottom. - - Function: http:forwarding-page title delay uri html-string ... - The string or symbol TITLE is the page title. DELAY is a + -- Function: http:forwarding-page title dly uri html-string ... | + The string or symbol TITLE is the page title. DLY is a | non-negative integer. The HTML-STRINGS ... are typically used to explain to the user why this page is being forwarded. `http:forwarding-page' returns an HTML string for a page which - automatically forwards to URI after DELAY seconds. The returned + automatically forwards to URI after DLY seconds. The returned | page (string) contains any HTML-STRINGS ... followed by a manual link to URI, in case the browser does not forward automatically. - - Function: http:serve-query serve-proc input-port output-port + -- Function: http:serve-query serve-proc input-port output-port | reads the "URI" and "query-string" from INPUT-PORT. If the query is a valid `"POST"' or `"GET"' query, then `http:serve-query' calls SERVE-PROC with three arguments, the REQUEST-LINE, QUERY-STRING, @@ -4311,7 +4860,7 @@ HTTP and CGI (close-port port))) (lambda () (close-port socket)))) - - Function: cgi:serve-query serve-proc + -- Function: cgi:serve-query serve-proc | reads the "URI" and "query-string" from `(current-input-port)'. If the query is a valid `"POST"' or `"GET"' query, then `cgi:serve-query' calls SERVE-PROC with three arguments, the @@ -4328,8 +4877,8 @@ HTTP and CGI Otherwise, `cgi:serve-query' replies (to `(current-input-port)') with appropriate HTML describing the problem. - - Function: make-query-alist-command-server rdb command-table - - Function: make-query-alist-command-server rdb command-table #t + -- Function: make-query-alist-command-server rdb command-table | + -- Function: make-query-alist-command-server rdb command-table #t | Returns a procedure of one argument. When that procedure is called with a QUERY-ALIST (as returned by `uri:decode-query', the value of the `*command*' association will be the command invoked in @@ -4345,12 +4894,12 @@ HTTP and CGI File: slib.info, Node: Parsing HTML, Next: URI, Prev: HTTP and CGI, Up: Textual Conversion Packages -Parsing HTML -============ +4.9 Parsing HTML | +================ | -`(require 'html-for-each)' +`(require 'html-for-each)' - - Function: html-for-each file word-proc markup-proc white-proc + -- Function: html-for-each file word-proc markup-proc white-proc | newline-proc FILE is an input port or a string naming an existing file containing HTML text. WORD-PROC is a procedure of one argument or @@ -4385,8 +4934,8 @@ Parsing HTML `html-for-each' returns an unspecified value. - - Function: html:read-title file limit - - Function: html:read-title file + -- Function: html:read-title file limit | + -- Function: html:read-title file | FILE is an input port or a string naming an existing file containing HTML text. If supplied, LIMIT must be an integer. LIMIT defaults to 1000. @@ -4399,7 +4948,7 @@ Parsing HTML from FILE is not `#\<', or if the end of title is not found within the first (approximately) LIMIT words. - - Function: htm-fields htm + -- Function: htm-fields htm | HTM is a hypertext markup string. If HTM is a (hypertext) comment, then `htm-fields' returns #f. @@ -4412,27 +4961,27 @@ Parsing HTML File: slib.info, Node: URI, Next: Printing Scheme, Prev: Parsing HTML, Up: Textual Conversion Packages -URI -=== +4.10 URI | +======== | -`(require 'uri)' +`(require 'uri)' Implements "Uniform Resource Identifiers" (URI) as described in RFC 2396. - - Function: make-uri - - Function: make-uri fragment - - Function: make-uri query fragment - - Function: make-uri path query fragment - - Function: make-uri authority path query fragment - - Function: make-uri scheme authority path query fragment + -- Function: make-uri | + -- Function: make-uri fragment | + -- Function: make-uri query fragment | + -- Function: make-uri path query fragment | + -- Function: make-uri authority path query fragment | + -- Function: make-uri scheme authority path query fragment | Returns a Uniform Resource Identifier string from component arguments. - - Function: uri:make-path path | - Returns a URI string combining the components of list PATH. | - | - - Function: html:anchor name + -- Function: uri:make-path path | + Returns a URI string combining the components of list PATH. + + -- Function: html:anchor name | Returns a string which defines this location in the (HTML) file as NAME. The hypertext `<A HREF="#NAME">' will link to this point. @@ -4440,23 +4989,23 @@ Implements "Uniform Resource Identifiers" (URI) as described in RFC => "<A NAME=\"(section%207)\"></A>" - - Function: html:link uri highlighted + -- Function: html:link uri highlighted | Returns a string which links the HIGHLIGHTED text to URI. (html:link (make-uri "(section 7)") "section 7") => "<A HREF=\"#(section%207)\">section 7</A>" - - Function: html:base uri - Returns a string specifying the "base" URI of a document, for - inclusion in the HEAD of the document (*note head: HTML.). + -- Function: html:base uri | + Returns a string specifying the "base" URI of a document, for inclusion | + in the HEAD of the document (*note head: HTML.). | - - Function: html:isindex prompt + -- Function: html:isindex prompt | Returns a string specifying the search PROMPT of a document, for inclusion in the HEAD of the document (*note head: HTML.). - - Function: uri->tree uri-reference base-tree - - Function: uri->tree uri-reference + -- Function: uri->tree uri-reference base-tree | + -- Function: uri->tree uri-reference | Returns a list of 5 elements corresponding to the parts (SCHEME AUTHORITY PATH QUERY FRAGMENT) of string URI-REFERENCE. Elements corresponding to absent parts are #f. @@ -4475,57 +5024,57 @@ Implements "Uniform Resource Identifiers" (URI) as described in RFC => (http "www.ics.uci.edu" ("" "pub" "ietf" "uri" "") #f "Related") - - Function: uri:split-fields txt chr | - Returns a list of TXT split at each occurrence of CHR. CHR does | - not appear in the returned list of strings. | - | - - Function: uri:decode-query query-string - Converts a "URI" encoded QUERY-STRING to a query-alist. + -- Function: uri:split-fields txt chr | + Returns a list of TXT split at each occurrence of CHR. CHR does + not appear in the returned list of strings. + + -- Function: uri:decode-query query-string | + Converts a "URI" encoded QUERY-STRING to a query-alist. `uric:' prefixes indicate procedures dealing with URI-components. - - Function: uric:encode uri-component allows + -- Function: uric:encode uri-component allows | Returns a copy of the string URI-COMPONENT in which all "unsafe" - octets (as defined in RFC 2396) have been `%' "escaped". - `uric:decode' decodes strings encoded by `uric:encode'. + octets (as defined in RFC 2396) have been `%' "escaped". `uric:decode' | + decodes strings encoded by `uric:encode'. | - - Function: uric:decode uri-component + -- Function: uric:decode uri-component | Returns a copy of the string URI-COMPONENT in which each `%' escaped characters in URI-COMPONENT is replaced with the character it encodes. This routine is useful for showing URI contents on error pages. - - Function: uri:path->keys path-list ptypes | - PATH-LIST is a path-list as returned by `uri:split-fields'. | - `uri:path->keys' returns a list of items returned by | - `uri:decode-path', coerced to types PTYPES. | - | + -- Function: uri:path->keys path-list ptypes | + PATH-LIST is a path-list as returned by `uri:split-fields'. + `uri:path->keys' returns a list of items returned by + `uri:decode-path', coerced to types PTYPES. + File-system Locators and Predicates ----------------------------------- - - Function: path->uri path + -- Function: path->uri path | Returns a URI-string for PATH on the local host. - - Function: absolute-uri? str + -- Function: absolute-uri? str | Returns #t if STR is an absolute-URI as indicated by a syntactically valid (per RFC 2396) "scheme"; otherwise returns #f. - - Function: absolute-path? file-name + -- Function: absolute-path? file-name | Returns #t if FILE-NAME is a fully specified pathname (does not depend on the current working directory); otherwise returns #f. - - Function: null-directory? str + -- Function: null-directory? str | Returns #t if changing directory to STR would leave the current directory unchanged; otherwise returns #f. - - Function: glob-pattern? str + -- Function: glob-pattern? str | Returns #t if the string STR contains characters used for specifying glob patterns, namely `*', `?', or `['. Before RFC 2396, the "File Transfer Protocol" (FTP) served a similar purpose. - - Function: parse-ftp-address uri + -- Function: parse-ftp-address uri | Returns a list of the decoded FTP URI; or #f if indecipherable. FTP "Uniform Resource Locator", "ange-ftp", and "getit" formats are handled. The returned list has four elements which are @@ -4542,8 +5091,8 @@ purpose. File: slib.info, Node: Printing Scheme, Next: Time and Date, Prev: URI, Up: Textual Conversion Packages -Printing Scheme -=============== +4.11 Printing Scheme | +==================== | * Menu: @@ -4554,10 +5103,10 @@ Printing Scheme File: slib.info, Node: Generic-Write, Next: Object-To-String, Prev: Printing Scheme, Up: Printing Scheme -Generic-Write -------------- +4.11.1 Generic-Write | +-------------------- | -`(require '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 @@ -4565,7 +5114,7 @@ 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 + -- Procedure: generic-write obj display? width output | OBJ Scheme data value to transform. @@ -4590,7 +5139,6 @@ printing, output to a string and truncated output. 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) @@ -4598,28 +5146,28 @@ printing, output to a string and truncated output. File: slib.info, Node: Object-To-String, Next: Pretty-Print, Prev: Generic-Write, Up: Printing Scheme -Object-To-String ----------------- +4.11.2 Object-To-String | +----------------------- | -`(require 'object->string)' +`(require 'object->string)' - - Function: object->string obj + -- Function: object->string obj | Returns the textual representation of OBJ as a string. - - Function: object->limited-string obj limit + -- Function: object->limited-string obj limit | Returns the textual representation of OBJ as a string of length at most LIMIT. File: slib.info, Node: Pretty-Print, Prev: Object-To-String, Up: Printing Scheme -Pretty-Print ------------- +4.11.3 Pretty-Print | +------------------- | -`(require 'pretty-print)' +`(require 'pretty-print)' - - Procedure: pretty-print obj - - Procedure: pretty-print obj port + -- 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. @@ -4632,8 +5180,8 @@ Pretty-Print -| (16 17 18 19 20) -| (21 22 23 24 25)) - - Procedure: pretty-print->string obj - - Procedure: pretty-print->string obj width + -- Procedure: pretty-print->string obj | + -- Procedure: pretty-print->string obj width | Returns the string of OBJ `pretty-print'ed in WIDTH columns. If WIDTH is not specified, `(output-port-width)' is used. @@ -4670,16 +5218,16 @@ Pretty-Print 25)) " - `(require 'pprint-file)' + `(require 'pprint-file)' - - Procedure: pprint-file infile - - Procedure: pprint-file infile outfile + -- 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 + -- 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. @@ -4704,14 +5252,15 @@ thus can reduce loading time. The following will write into File: slib.info, Node: Time and Date, Next: NCBI-DNA, Prev: Printing Scheme, Up: Textual Conversion Packages -Time and Date -============= +4.12 Time and Date | +================== | * Menu: * Time Zone:: * Posix Time:: 'posix-time * Common-Lisp Time:: 'common-lisp-time +* Time Infrastructure:: | If `(provided? 'current-time)': @@ -4719,29 +5268,29 @@ The procedures `current-time', `difftime', and `offset-time' deal with a "calendar time" datatype which may or may not be disjoint from other Scheme datatypes. - - Function: current-time + -- 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 Common-Lisp Time::. - - Function: difftime caltime1 caltime0 + -- Function: difftime caltime1 caltime0 | Returns the difference (number of seconds) between twe calendar times: CALTIME1 - CALTIME0. CALTIME0 may also be a number. - - Function: offset-time caltime offset + -- Function: offset-time caltime offset | Returns the calendar time of CALTIME offset by OFFSET number of seconds `(+ caltime offset)'. File: slib.info, Node: Time Zone, Next: Posix Time, Prev: Time and Date, Up: Time and Date -Time Zone ---------- +4.12.1 Time Zone | +---------------- | (require 'time-zone) - - Data Format: TZ-string + -- Data Format: TZ-string | POSIX standards specify several formats for encoding time-zone rules. @@ -4795,17 +5344,17 @@ Time Zone Day 0 is a Sunday. - - Data Type: time-zone + -- Data Type: time-zone | is a datatype encoding how many hours from Greenwich Mean Time the local time is, and the "Daylight Savings Time" rules for changing it. - - Function: time-zone TZ-string + -- Function: time-zone TZ-string | Creates and returns a time-zone object specified by the string TZ-STRING. If `time-zone' cannot interpret TZ-STRING, `#f' is returned. - - Function: tz:params caltime tz + -- Function: tz:params caltime tz | TZ is a time-zone object. `tz:params' returns a list of three items: 0. An integer. 0 if standard time is in effect for timezone TZ @@ -4821,21 +5370,21 @@ Time Zone made of any timezone at any calendar time. - - Function: tz:std-offset tz | - TZ is a time-zone object. `tz:std-offset' returns the number of | - seconds west of the Prime Meridian timezone TZ is. | - | - | + -- Function: tz:std-offset tz | + TZ is a time-zone object. `tz:std-offset' returns the number of + seconds west of the Prime Meridian timezone TZ is. + + The rest of these procedures and variables are provided for POSIX compatability. Because of shared state they are not thread-safe. - - Function: tzset + -- Function: tzset | Returns the default time-zone. - - Function: tzset tz + -- Function: tzset tz | Sets (and returns) the default time-zone to TZ. - - Function: tzset TZ-string + -- Function: tzset TZ-string | Sets (and returns) the default time-zone to that specified by TZ-STRING. @@ -4843,19 +5392,19 @@ compatability. Because of shared state they are not thread-safe. This function is automatically called by the time conversion procedures which depend on the time zone (*note Time and Date::). - - Variable: *timezone* + -- Variable: *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). `*timezone*' is initialized by `tzset'. - - Variable: daylight? + -- Variable: daylight? | is `#t' if the default timezone has rules for "Daylight Savings Time". _Note:_ DAYLIGHT? does not tell you when Daylight Savings Time is in effect, just that the default zone sometimes has Daylight Savings Time. - - Variable: tzname + -- Variable: tzname | is a vector of strings. Index 0 has the abbreviation for the standard timezone; If DAYLIGHT?, then index 1 has the abbreviation for the Daylight Savings timezone. @@ -4863,15 +5412,16 @@ compatability. Because of shared state they are not thread-safe. File: slib.info, Node: Posix Time, Next: Common-Lisp Time, Prev: Time Zone, Up: Time and Date -Posix Time ----------- +4.12.2 Posix Time | +----------------- | (require 'posix-time) - - - Data Type: Calendar-Time + + | + -- Data Type: Calendar-Time | is a datatype encapsulating time. - - Data Type: Coordinated Universal Time + -- Data Type: Coordinated Universal Time | (abbreviated "UTC") is a vector of integers representing time: 0. seconds (0 - 61) @@ -4894,13 +5444,13 @@ Posix Time 8. 1 for daylight savings, 0 for regular time - - Function: gmtime caltime + -- Function: gmtime caltime | Converts the calendar time CALTIME to UTC and returns it. - - Function: localtime caltime tz + -- Function: localtime caltime tz | Returns CALTIME converted to UTC relative to timezone TZ. - - Function: localtime caltime + -- 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 @@ -4908,44 +5458,44 @@ Posix Time tzset: Time Zone.). - - Function: gmktime univtime + -- Function: gmktime univtime | Converts a vector of integers in GMT Coordinated Universal Time (UTC) format to a calendar time. - - Function: mktime univtime + -- Function: mktime univtime | Converts a vector of integers in local Coordinated Universal Time (UTC) format to a calendar time. - - Function: mktime univtime tz + -- Function: mktime univtime tz | Converts a vector of integers in Coordinated Universal Time (UTC) format (relative to time-zone TZ) to calendar time. - - Function: asctime univtime + -- 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: gtime caltime - - Function: ctime caltime - - Function: ctime caltime tz + -- Function: gtime caltime | + -- Function: ctime caltime | + -- Function: ctime caltime tz | Equivalent to `(asctime (gmtime CALTIME))', `(asctime (localtime CALTIME))', and `(asctime (localtime CALTIME TZ))', respectively. -File: slib.info, Node: Common-Lisp Time, Prev: Posix Time, Up: Time and Date - -Common-Lisp Time ----------------- +File: slib.info, Node: Common-Lisp Time, Next: Time Infrastructure, Prev: Posix Time, Up: Time and Date + | +4.12.3 Common-Lisp Time | +----------------------- | - - Function: get-decoded-time + -- Function: get-decoded-time | Equivalent to `(decode-universal-time (get-universal-time))'. - - Function: 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 + -- Function: decode-universal-time univtime | Converts UNIVTIME to "Decoded Time" format. Nine values are returned: 0. seconds (0 - 61) @@ -4970,8 +5520,8 @@ Common-Lisp Time 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 + -- 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 @@ -4982,32 +5532,48 @@ Common-Lisp Time match the arguments to `encode-universal-time'. +File: slib.info, Node: Time Infrastructure, Prev: Common-Lisp Time, Up: Time and Date + | +4.12.4 Time Infrastructure | +-------------------------- | + | +`(require 'time-core)' | + | + -- Function: time:gmtime tm | + -- Function: time:invert decoder target | + -- Function: time:split t tm_isdst tm_gmtoff tm_zone | + | + `(require 'tzfile)' | + | + -- Function: tzfile:read path | + | + File: slib.info, Node: NCBI-DNA, Next: Schmooz, Prev: Time and Date, Up: Textual Conversion Packages + | +4.13 NCBI-DNA | +============= | -NCBI-DNA -======== - - - Function: ncbi:read-dna-sequence port + -- Function: ncbi:read-dna-sequence port | Reads the NCBI-format DNA sequence following the word `ORIGIN' from PORT. - - Function: ncbi:read-file file + -- Function: ncbi:read-file file | Reads the NCBI-format DNA sequence following the word `ORIGIN' from FILE. - - Function: mrna<-cdna str + -- Function: mrna<-cdna str | Replaces `T' with `U' in STR - - Function: codons<-cdna cdna + -- Function: codons<-cdna cdna | Returns a list of three-letter symbol codons comprising the protein sequence encoded by CDNA starting with its first occurence of `atg'. - - Function: protein<-cdna cdna + -- Function: protein<-cdna cdna | Returns a list of three-letter symbols for the protein sequence encoded by CDNA starting with its first occurence of `atg'. - - Function: p<-cdna cdna + -- Function: p<-cdna cdna | Returns a string of one-letter amino acid codes for the protein sequence encoded by CDNA starting with its first occurence of `atg'. @@ -5015,18 +5581,18 @@ NCBI-DNA These cDNA count routines provide a means to check the nucleotide sequence with the `BASE COUNT' line preceding the sequence from NCBI. - - Function: cdna:base-count cdna + -- Function: cdna:base-count cdna | Returns a list of counts of `a', `c', `g', and `t' occurrencing in CDNA. - - Function: cdna:report-base-count cdna + -- Function: cdna:report-base-count cdna | Prints the counts of `a', `c', `g', and `t' occurrencing in CDNA. File: slib.info, Node: Schmooz, Prev: NCBI-DNA, Up: Textual Conversion Packages -Schmooz -======= +4.14 Schmooz | +============ | "Schmooz" is a simple, lightweight markup language for interspersing Texinfo documentation with Scheme source code. Schmooz does not create @@ -5037,16 +5603,16 @@ imported into the documentation using the Texinfo command `@include'. process files. Files containing schmooz documentation should not contain `(require 'schmooz)'. - - Procedure: schmooz filename.scm ... + -- Procedure: schmooz filename.scm ... | FILENAME.scm should be a string ending with `.scm' naming an existing file containing Scheme source code. `schmooz' extracts top-level comments containing schmooz commands from FILENAME.scm and writes the converted Texinfo source to a file named FILENAME.txi. - - Procedure: schmooz filename.texi ... - - Procedure: schmooz filename.tex ... - - Procedure: schmooz filename.txi ... + -- Procedure: schmooz filename.texi ... | + -- Procedure: schmooz filename.tex ... | + -- Procedure: schmooz filename.txi ... | FILENAME should be a string naming an existing file containing Texinfo source code. For every occurrence of the string `@include FILENAME.txi' within that file, `schmooz' calls itself with the @@ -5105,7 +5671,7 @@ remainder of the line, separated by whitespace. Will result in: @defun myfun arg1 args @dots{} - + @code{myfun} takes argument @var{arg1} and any number of @var{args} @end defun @@ -5124,8 +5690,8 @@ directives in schmooz comments. File: slib.info, Node: Mathematical Packages, Next: Database Packages, Prev: Textual Conversion Packages, Up: Top -Mathematical Packages -********************* +5 Mathematical Packages | +*********************** | * Menu: @@ -5135,7 +5701,7 @@ Mathematical Packages * Random Numbers:: 'random * Fast Fourier Transform:: 'fft * Cyclic Checksum:: 'crc -* Graphing:: | +* Graphing:: * Solid Modeling:: VRML97 * Color:: * Root Finding:: 'root @@ -5146,10 +5712,10 @@ Mathematical Packages File: slib.info, Node: Bit-Twiddling, Next: Modular Arithmetic, Prev: Mathematical Packages, Up: Mathematical Packages -Bit-Twiddling -============= +5.1 Bit-Twiddling | +================= | -`(require 'logical)' +`(require 'logical)' The bit-twiddling functions are made available through the use of the `logical' package. `logical' is loaded by inserting `(require @@ -5157,35 +5723,39 @@ The bit-twiddling functions are made available through the use of the behave as though operating on integers in two's-complement representation. -Bitwise Operations ------------------- +5.1.1 Bitwise Operations | +------------------------ | - - Function: logand n1 n1 - Returns the integer which is the bit-wise AND of the two integer + -- Function: logand n1 ... | + -- Function: bitwise-and n1 ... | + Returns the integer which is the bit-wise AND of the 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 + -- Function: logior n1 ... | + -- Function: bitwise-ior n1 ... | + Returns the integer which is the bit-wise OR of the 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 + -- Function: logxor n1 ... | + -- Function: bitwise-xor n1 ... | + Returns the integer which is the bit-wise XOR of the integer | arguments. Example: (number->string (logxor #b1100 #b1010) 2) => "110" - - Function: lognot n - Returns the integer which is the 2s-complement of the integer + -- Function: lognot n | + -- Function: bitwise-not n | + Returns the integer which is the one's-complement of the integer | argument. Example: @@ -5194,19 +5764,25 @@ Bitwise Operations (number->string (lognot #b0) 2) => "-1" - - Function: bitwise-if mask n0 n1 + -- Function: bitwise-if mask n0 n1 | + -- Function: bitwise-merge mask n0 n1 | Returns an integer composed of some bits from integer N0 and some from integer N1. A bit of the result is taken from N0 if the corresponding bit of integer MASK is 1 and from N1 if that bit of MASK is 0. - - Function: logtest j k + -- Function: logtest j k | + -- Function: any-bits-set? j k | (logtest j k) == (not (zero? (logand j k))) - + (logtest #b0100 #b1011) => #f (logtest #b0100 #b0111) => #t - - Function: logcount n +5.1.2 Integer Properties | +------------------------ | + | + -- Function: logcount n | + -- Function: bit-count 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 @@ -5220,19 +5796,63 @@ Bitwise Operations (logcount -2) => 1 -Bit Within Word ---------------- + -- 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: log2-binary-factors n | + -- Function: first-set-bit n | + Returns the number of factors of two of integer N. This value is | + also the bit-index of the least-significant `1' bit in N. | + | + (require 'printf) | + (do ((idx 0 (+ 1 idx))) | + ((> idx 16)) | + (printf "%s(%3d) ==> %-5d %s(%2d) ==> %-5d\n" | + 'log2-binary-factors | + (- idx) (log2-binary-factors (- idx)) | + 'log2-binary-factors | + idx (log2-binary-factors idx))) | + -| | + log2-binary-factors( 0) ==> -1 log2-binary-factors( 0) ==> -1 | + log2-binary-factors( -1) ==> 0 log2-binary-factors( 1) ==> 0 | + log2-binary-factors( -2) ==> 1 log2-binary-factors( 2) ==> 1 | + log2-binary-factors( -3) ==> 0 log2-binary-factors( 3) ==> 0 | + log2-binary-factors( -4) ==> 2 log2-binary-factors( 4) ==> 2 | + log2-binary-factors( -5) ==> 0 log2-binary-factors( 5) ==> 0 | + log2-binary-factors( -6) ==> 1 log2-binary-factors( 6) ==> 1 | + log2-binary-factors( -7) ==> 0 log2-binary-factors( 7) ==> 0 | + log2-binary-factors( -8) ==> 3 log2-binary-factors( 8) ==> 3 | + log2-binary-factors( -9) ==> 0 log2-binary-factors( 9) ==> 0 | + log2-binary-factors(-10) ==> 1 log2-binary-factors(10) ==> 1 | + log2-binary-factors(-11) ==> 0 log2-binary-factors(11) ==> 0 | + log2-binary-factors(-12) ==> 2 log2-binary-factors(12) ==> 2 | + log2-binary-factors(-13) ==> 0 log2-binary-factors(13) ==> 0 | + log2-binary-factors(-14) ==> 1 log2-binary-factors(14) ==> 1 | + log2-binary-factors(-15) ==> 0 log2-binary-factors(15) ==> 0 | + log2-binary-factors(-16) ==> 4 log2-binary-factors(16) ==> 4 | + | +5.1.3 Bit Within Word | +--------------------- | + | + -- Function: logbit? index n | + -- Function: bit-set? index n | + (logbit? index n) == (logtest (expt 2 index) n) | - - 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: copy-bit index from bit + -- Function: copy-bit index from bit | Returns an integer the same as FROM except in the INDEXth bit, which is 1 if BIT is `#t' and 0 if BIT is `#f'. @@ -5241,36 +5861,36 @@ Bit Within Word (number->string (copy-bit 2 0 #t) 2) => "100" (number->string (copy-bit 2 #b1111 #f) 2) => "1011" -Fields of Bits --------------- +5.1.4 Field of Bits | +------------------- | - - Function: logical:ones n | - Returns the smallest non-negative integer having N binary ones. | - | - - Function: bit-field n start end + -- Function: bit-field 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-field #b1101101010 0 4) 2) => "1010" (number->string (bit-field #b1101101010 4 9) 2) => "10110" - - Function: copy-bit-field to start end from + -- Function: copy-bit-field to from start end | Returns an integer the same as TO except possibly in the START (inclusive) through END (exclusive) bits, which are the same as those of FROM. The 0-th bit of FROM becomes the STARTth bit of the result. Example: - (number->string (copy-bit-field #b1101101010 0 4 0) 2) + (number->string (copy-bit-field #b1101101010 0 0 4) 2) | => "1101100000" - (number->string (copy-bit-field #b1101101010 0 4 -1) 2) + (number->string (copy-bit-field #b1101101010 -1 0 4) 2) | => "1101101111" + (number->string (copy-bit-field #b110100100010000 -1 5 9) 2) | + => "110100111110000" | - - Function: ash n count + -- Function: ash n count | + -- Function: arithmetic-shift n count | Returns an integer equivalent to `(inexact->exact (floor (* N (expt 2 COUNT))))'. @@ -5280,53 +5900,36 @@ Fields of Bits (number->string (ash #b1010 -1) 2) => "101" - - Function: integer-length n - Returns the number of bits neccessary to represent N. + -- Function: rotate-bit-field n count start end | + Returns N with the bit-field from START to END cyclically permuted | + by COUNT bits towards high-order. | 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 - -Bit order and Lamination ------------------------- - - - Function: logical:rotate k count len - Returns the low-order LEN bits of K cyclically permuted COUNT bits - towards high-order. - - Example: - (number->string (logical:rotate #b0100 3 4) 2) - => "10" - (number->string (logical:rotate #b0100 -1 4) 2) - => "10" - - - Function: bit-reverse k n - Returns the low-order K bits of N with the bit order reversed. - The low-order bit of N is the high order bit of the returned value. - - (number->string (bit-reverse 8 #xa7) 16) + (number->string (rotate-bit-field #b0100 3 0 4) 2) | + => "10" + (number->string (rotate-bit-field #b0100 -1 0 4) 2) | + => "10" + (number->string (rotate-bit-field #b110100100010000 -1 5 9) 2) | + => "110100010010000" | + (number->string (rotate-bit-field #b110100100010000 1 5 9) 2) | + => "110100000110000" | + + -- Function: reverse-bit-field n start end | + Returns N with the order of bits START to END reversed. | + + (number->string (reverse-bit-field #xa7 0 8) 16) | => "e5" - - Function: integer->list k len - - Function: integer->list k +5.1.5 Bits as Booleans | +---------------------- | + | + -- Function: integer->list k len | + -- Function: integer->list k | `integer->list' returns a list of LEN booleans corresponding to each bit of the given integer. #t is coded for each 1; #f for 0. The LEN argument defaults to `(integer-length K)'. - - Function: list->integer list + -- Function: list->integer list | `list->integer' returns an integer formed from the booleans in the list LIST, which must be a list of booleans. A 1 bit is coded for each #t; a 0 bit for #f. @@ -5334,67 +5937,19 @@ Bit order and Lamination `integer->list' and `list->integer' are inverses so far as `equal?' is concerned. - - Function: booleans->integer bool1 ... + -- Function: booleans->integer bool1 ... | Returns the integer coded by the BOOL1 ... arguments. - - - Function: bitwise:laminate k1 ... - Returns an integer composed of the bits of K1 ... interlaced in - argument order. Given K1, ... KN, the n low-order bits of the - returned value will be the lowest-order bit of each argument. - - - Function: bitwise:delaminate count k - Returns a list of COUNT integers comprised of every COUNTh bit of - the integer K. - - For any non-negative integers K and COUNT: - (eqv? k (bitwise:laminate (bitwise:delaminate count k))) - -Gray code ---------- - -A "Gray code" is an ordering of non-negative integers in which exactly -one bit differs between each pair of successive elements. There are -multiple Gray codings. An n-bit Gray code corresponds to a Hamiltonian -cycle on an n-dimensional hypercube. - -Gray codes find use communicating incrementally changing values between -asynchronous agents. De-laminated Gray codes comprise the coordinates -of Peano-Hilbert space-filling curves. - - - Function: integer->gray-code k - Converts K to a Gray code of the same `integer-length' as K. - - - Function: gray-code->integer k - Converts the Gray code K to an integer of the same - `integer-length' as K. - - For any non-negative integer K, - (eqv? k (gray-code->integer (integer->gray-code k))) - - - Function: = k1 k2 - - Function: gray-code<? k1 k2 - - Function: gray-code>? k1 k2 - - Function: gray-code<=? k1 k2 - - Function: gray-code>=? k1 k2 - These procedures return #t if their Gray code arguments are - (respectively): equal, monotonically increasing, monotonically - decreasing, monotonically nondecreasing, or monotonically - nonincreasing. - - For any non-negative integers K1 and K2, the Gray code predicate - of `(integer->gray-code k1)' and `(integer->gray-code k2)' will - return the same value as the corresponding predicate of K1 and K2. - + | File: slib.info, Node: Modular Arithmetic, Next: Prime Numbers, Prev: Bit-Twiddling, Up: Mathematical Packages -Modular Arithmetic -================== +5.2 Modular Arithmetic | +====================== | -`(require 'modular)' +`(require 'modular)' - - Function: mod x1 x2 - - Function: rem x1 x2 + -- Function: mod x1 x2 | + -- Function: rem x1 x2 | These procedures implement the Common-Lisp functions of the same names. The real number X2 must be non-zero. `mod' returns `(- X1 (* X2 (floor (/ X1 X2))))'. `rem' returns `(- X1 (* X2 (truncate @@ -5405,25 +5960,25 @@ Modular Arithmetic (mod -90 360) => 270 (rem -90 180) => -90 - + (mod 540 360) => 180 (rem 540 360) => 180 - + (mod (* 5/2 pi) (* 2 pi)) => 1.5707963267948965 (rem (* -5/2 pi) (* 2 pi)) => -1.5707963267948965 - - Function: extended-euclid n1 n2 + -- 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 + -- Function: symmetric:modulus n | Returns `(quotient (+ -1 n) -2)' for positive odd integer N. - - Function: modulus->integer modulus + -- 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 + -- Function: modular:normalize modulus n | Returns the integer `(modulo N (modulus->integer MODULUS))' in the representation specified by MODULUS. @@ -5439,46 +5994,46 @@ For all of these functions, if the first argument (MODULUS) is: `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)'. + 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 + -- 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 n2 + -- Function: modular:invert modulus n2 | Returns an integer n such that 1 = (n * N2) mod MODULUS. If N2 has no inverse mod MODULUS an error is signaled. - - Function: modular:negate modulus n2 + -- Function: modular:negate modulus n2 | Returns (-N2) mod MODULUS. - - Function: modular:+ modulus n2 n3 + -- Function: modular:+ modulus n2 n3 | Returns (N2 + N3) mod MODULUS. - - Function: modular:- modulus n2 n3 + -- Function: modular:- modulus n2 n3 | Returns (N2 - N3) mod MODULUS. - - Function: modular:* modulus n2 n3 + -- Function: modular:* modulus n2 n3 | Returns (N2 * N3) mod MODULUS. The Scheme code for `modular:*' with negative MODULUS is not completed for fixnum-only implementations. - - Function: modular:expt modulus n2 n3 + -- Function: modular:expt modulus n2 n3 | Returns (N2 ^ N3) mod MODULUS. File: slib.info, Node: Prime Numbers, Next: Random Numbers, Prev: Modular Arithmetic, Up: Mathematical Packages -Prime Numbers -============= +5.3 Prime Numbers | +================= | -`(require 'factor)' +`(require 'factor)' - - Variable: prime:prngs + -- Variable: prime:prngs | PRIME:PRNGS is the random-state (*note Random Numbers::) used by these procedures. If you call these procedures from more than one thread (or from interrupt), `random' may complain about reentrant @@ -5489,28 +6044,28 @@ the Solovay-Strassen primality test. 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 + -- 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. - - Variable: prime:trials + -- Variable: prime:trials | PRIME:TRIALS the maxinum number of iterations of Solovay-Strassen that will be done to test a number for primality. - - Function: prime? n + -- Function: prime? n | Returns `#f' if N is composite; `#t' if N is prime. There is a slight chance `(expt 2 (- prime:trials))' that a composite will return `#t'. - - Function: primes< start count + -- Function: primes< start count | Returns a list of the first COUNT prime numbers less than START. If there are fewer than COUNT prime numbers less than START, then the returned list will have fewer than START elements. - - Function: primes> start count + -- Function: primes> start count | Returns a list of the first COUNT prime numbers greater than START. - - Function: factor k + -- 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) <)'. @@ -5518,37 +6073,37 @@ the Solovay-Strassen primality test. See File: slib.info, Node: Random Numbers, Next: Fast Fourier Transform, Prev: Prime Numbers, Up: Mathematical Packages -Random Numbers -============== +5.4 Random Numbers | +================== | -A pseudo-random number generator is only as good as the tests it passes. | -George Marsaglia of Florida State University developed a battery of | -tests named "DIEHARD" (<http://stat.fsu.edu/~geo/diehard.html>). | -`diehard.c' has a bug which the patch | -<http://swissnet.ai.mit.edu/ftpdir/users/jaffer/diehard.c.pat> corrects. +A pseudo-random number generator is only as good as the tests it passes. +George Marsaglia of Florida State University developed a battery of +tests named "DIEHARD" (`http://stat.fsu.edu/~geo/diehard.html'). | +`diehard.c' has a bug which the patch +`http://swiss.csail.mit.edu/ftpdir/users/jaffer/diehard.c.pat' corrects. | - SLIB's PRNG generates 8 bits at a time. With the degenerate seed | + SLIB's PRNG generates 8 bits at a time. With the degenerate seed `0', the numbers generated pass DIEHARD; but when bits are combined from sequential bytes, tests fail. With the seed `http://swissnet.ai.mit.edu/~jaffer/SLIB.html', all of those tests pass. -* Menu: | - | -* Exact Random Numbers:: 'random | -* Inexact Random Numbers:: 'random-inexact | - | +* Menu: + +* Exact Random Numbers:: 'random +* Inexact Random Numbers:: 'random-inexact + File: slib.info, Node: Exact Random Numbers, Next: Inexact Random Numbers, Prev: Random Numbers, Up: Random Numbers - | -Exact Random Numbers | --------------------- | - | -`(require 'random)' | - | - - Function: random n state - - Function: random n | - N must be an exact positive integer. `random' returns an exact | - integer between zero (inclusive) and N (exclusive). The values | + +5.4.1 Exact Random Numbers | +-------------------------- | + +`(require 'random)' + + -- Function: random n state | + -- Function: random n | + N must be an exact positive integer. `random' returns an exact + integer between zero (inclusive) and N (exclusive). The values returned by `random' are uniformly distributed from 0 to N. The optional argument STATE must be of the type returned by @@ -5557,7 +6112,7 @@ Exact Random Numbers | to maintain the state of the pseudo-random-number generator and is altered as a side effect of calls to `random'. - - Variable: *random-state* + -- 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 @@ -5565,13 +6120,13 @@ Exact Random Numbers | function correctly as a random-number state object in another implementation. - - Function: copy-random-state state + -- Function: copy-random-state state | Returns a new copy of argument STATE. - - Function: copy-random-state + -- Function: copy-random-state | Returns a new copy of `*random-state*'. - - Function: seed->random-state seed + -- Function: seed->random-state seed | Returns a new object of type suitable for use as the value of the variable `*random-state*' or as a second argument to `random'. The number or string SEED is used to initialize the state. If @@ -5580,8 +6135,8 @@ Exact Random Numbers | Calling `seed->random-state' with unequal arguments will nearly always return unequal states. - - Function: make-random-state - - Function: make-random-state obj + -- Function: make-random-state | + -- Function: make-random-state obj | Returns a new object of type suitable for use as the value of the variable `*random-state*' or as a second argument to `random'. If the optional argument OBJ is given, it should be a printable @@ -5591,44 +6146,44 @@ Exact Random Numbers | File: slib.info, Node: Inexact Random Numbers, Prev: Exact Random Numbers, Up: Random Numbers - | -Inexact Random Numbers | ----------------------- | - | -`(require 'random-inexact)' | - - Function: random:uniform - - Function: random:uniform state +5.4.2 Inexact Random Numbers | +---------------------------- | + +`(require 'random-inexact)' + + -- Function: random:uniform | + -- Function: random:uniform state | Returns an uniformly distributed inexact real random number in the range between 0 and 1. - - Function: random:exp - - Function: random:exp state + -- Function: random:exp | + -- Function: 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))'. - - Function: random:normal - - Function: random:normal state + -- Function: random:normal | + -- Function: 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 | + -- 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:hollow-sphere! vect | - - Procedure: random:hollow-sphere! vect state | + -- 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:solid-sphere! vect | - - Procedure: random:solid-sphere! vect state | + -- 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 @@ -5638,43 +6193,41 @@ Inexact Random Numbers | File: slib.info, Node: Fast Fourier Transform, Next: Cyclic Checksum, Prev: Random Numbers, Up: Mathematical Packages -Fast Fourier Transform -====================== +5.5 Fast Fourier Transform | +========================== | -`(require 'fft)' +`(require 'fft)' - - Function: fft array + -- Function: fft array | ARRAY is an array of `(expt 2 n)' numbers. `fft' returns an array of complex numbers comprising the "Discrete Fourier Transform" of - ARRAY. + ARRAY. - - Function: fft-1 array + -- Function: fft-1 array | `fft-1' returns an array of complex numbers comprising the inverse Discrete Fourier Transform of ARRAY. `(fft-1 (fft ARRAY))' will return an array of values close to ARRAY. (fft '#(1 0+i -1 0-i 1 0+i -1 0-i)) => - + #(0.0 0.0 0.0+628.0783185208527e-18i 0.0 0.0 0.0 8.0-628.0783185208527e-18i 0.0) - + (fft-1 '#(0 0 0 0 0 0 8 0)) => - + #(1.0 -61.23031769111886e-18+1.0i -1.0 61.23031769111886e-18-1.0i 1.0 -61.23031769111886e-18+1.0i -1.0 61.23031769111886e-18-1.0i) File: slib.info, Node: Cyclic Checksum, Next: Graphing, Prev: Fast Fourier Transform, Up: Mathematical Packages - | -Cyclic Checksum -=============== -`(require 'crc)' +5.6 Cyclic Checksum | +=================== | -Cyclic Redundancy Checks using Galois field GF(2) polynomial arithmetic -are used for error detection in many data transmission and storage -applications. +`(require 'crc)' Cyclic Redundancy Checks using Galois field GF(2) | +polynomial arithmetic are used for error detection in many data | +transmission and storage applications. | The generator polynomials for various CRC protocols are availble from many sources. But the polynomial is just one of many parameters which @@ -5691,9 +6244,26 @@ existing systems: non-inverted) to the data stream. +The performance of a particular CRC polynomial over packets of given | +sizes varies widely. In terms of the probability of undetected errors, | +some uses of extant CRC polynomials are suboptimal by several orders of | +magnitude. | + | +If you are considering CRC for a new application, consult the following | +article to find the optimum CRC polynomial for your range of data | +lengths: | + | + * Philip Koopman and Tridib Chakravarty, | + "Cyclic Redundancy Code (CRC) Polynomial Selection For Embedded | + Networks", | + The International Conference on Dependable Systems and Networks, | + DSN-2004. | + | +`http://www.ece.cmu.edu/~koopman/roses/dsn04/koopman04_crc_poly_embedded.pdf' | + | There is even some controversy over the polynomials themselves. - - Constant: crc-32-polynomial + -- Constant: crc-32-polynomial | For CRC-32, http://www2.sis.pitt.edu/~jkabara/tele-2100/lect08.html gives x^32+x^26+x^23+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x^1+1. @@ -5707,9 +6277,9 @@ There is even some controversy over the polynomials themselves. http://www.nobugconsulting.ro/crc.php give x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1. - SLIB `crc-32-polynomial' uses the latter definition. | + SLIB `crc-32-polynomial' uses the latter definition. - - Constant: crc-ccitt-polynomial + -- Constant: crc-ccitt-polynomial | http://www.math.grin.edu/~rebelsky/Courses/CS364/2000S/Outlines/outline.12.html, http://duchon.umuc.edu/Web_Pages/duchon/99_f_cm435/ShiftRegister.htm, http://www.cs.ncl.ac.uk/people/harry.whitfield/home.formal/CRCs.html, @@ -5717,7 +6287,7 @@ There is even some controversy over the polynomials themselves. http://www.gpfn.sk.ca/~rhg/csc8550s02/crc.html give CRC-CCITT: x^16+x^12+x^5+1. - - Constant: crc-16-polynomial + -- Constant: crc-16-polynomial | http://www.math.grin.edu/~rebelsky/Courses/CS364/2000S/Outlines/outline.12.html, http://duchon.umuc.edu/Web_Pages/duchon/99_f_cm435/ShiftRegister.htm, http://www.cs.ncl.ac.uk/people/harry.whitfield/home.formal/CRCs.html, @@ -5725,7 +6295,7 @@ There is even some controversy over the polynomials themselves. http://www.usb.org/developers/data/crcdes.pdf give CRC-16: x^16+x^15+x^2+1. - - Constant: crc-12-polynomial + -- Constant: crc-12-polynomial | http://www.math.grin.edu/~rebelsky/Courses/CS364/2000S/Outlines/outline.12.html, http://www.cs.ncl.ac.uk/people/harry.whitfield/home.formal/CRCs.html, http://www.it.iitb.ac.in/it605/lectures/link/node4.html, and @@ -5742,10 +6312,11 @@ There is even some controversy over the polynomials themselves. x^12+x^11+x^3+x^2+x+1. These differ in bit 1 and calculations using them return different - values. With citations near evenly split, it is hard to know | - which is correct. | + values. With citations near evenly split, it is hard to know + which is correct. Thanks to Philip Koopman for breaking the tie | + in favor of the latter (#xC07). | - - Constant: crc-10-polynomial + -- Constant: crc-10-polynomial | http://www.math.grin.edu/~rebelsky/Courses/CS364/2000S/Outlines/outline.12.html gives CRC-10: x^10+x^9+x^5+x^4+1; but http://cell-relay.indiana.edu/cell-relay/publications/software/CRC/crc10.html, @@ -5756,29 +6327,29 @@ There is even some controversy over the polynomials themselves. http://www.nobugconsulting.ro/crc.php give CRC-10: x^10+x^9+x^5+x^4+x+1. - - Constant: crc-08-polynomial + -- Constant: crc-08-polynomial | http://www.math.grin.edu/~rebelsky/Courses/CS364/2000S/Outlines/outline.12.html, http://www.cs.ncl.ac.uk/people/harry.whitfield/home.formal/CRCs.html, http://www.it.iitb.ac.in/it605/lectures/link/node4.html, and http://www.nobugconsulting.ro/crc.php give CRC-8: x^8+x^2+x^1+1 - - Constant: atm-hec-polynomial + -- Constant: atm-hec-polynomial | http://cell-relay.indiana.edu/cell-relay/publications/software/CRC/32bitCRC.tutorial.html and http://www.gpfn.sk.ca/~rhg/csc8550s02/crc.html give ATM HEC: x^8+x^2+x+1. - - Constant: dowcrc-polynomial + -- Constant: dowcrc-polynomial | http://www.cs.ncl.ac.uk/people/harry.whitfield/home.formal/CRCs.html gives DOWCRC: x^8+x^5+x^4+1. - - Constant: usb-token-polynomial + -- Constant: usb-token-polynomial | http://www.usb.org/developers/data/crcdes.pdf and http://www.nobugconsulting.ro/crc.php give USB-token: x^5+x^2+1. Each of these polynomial constants is a string of `1's and `0's, the exponent of each power of X in descending order. - - Function: crc:make-table poly + -- Function: crc:make-table poly | POLY must be string of `1's and `0's beginning with `1' and having length greater than 8. `crc:make-table' returns a vector of 256 integers, such that: @@ -5796,28 +6367,28 @@ exponent of each power of X in descending order. `crc:make-table' returns #f. - - Function: cksum file + -- Function: cksum file | Computes the P1003.2/D11.2 (POSIX.2) 32-bit checksum of FILE. (require 'crc) (cksum (in-vicinity (library-vicinity) "ratize.scm")) => 157103930 - - Function: cksum port + -- Function: cksum port | Computes the checksum of the bytes read from PORT until the end-of-file. -`cksum-string', which returns the P1003.2/D11.2 (POSIX.2) 32-bit | -checksum of the bytes in STR, can be defined as follows: | +`cksum-string', which returns the P1003.2/D11.2 (POSIX.2) 32-bit +checksum of the bytes in STR, can be defined as follows: - (require 'string-port) | - (define (cksum-string str) (call-with-input-string str cksum)) | + (require 'string-port) + (define (cksum-string str) (call-with-input-string str cksum)) - - Function: crc16 file + -- Function: crc16 file | Computes the USB data-packet (16-bit) CRC of FILE. - - Function: crc16 port + -- Function: crc16 port | Computes the USB data-packet (16-bit) CRC of the bytes read from PORT until the end-of-file. @@ -5825,10 +6396,10 @@ checksum of the bytes in STR, can be defined as follows: | in http://www.usb.org/developers/data/crcdes.pdf. - - Function: crc5 file + -- Function: crc5 file | Computes the USB token (5-bit) CRC of FILE. - - Function: crc5 port + -- Function: crc5 port | Computes the USB token (5-bit) CRC of the bytes read from PORT until the end-of-file. @@ -5838,24 +6409,24 @@ checksum of the bytes in STR, can be defined as follows: | File: slib.info, Node: Graphing, Next: Solid Modeling, Prev: Cyclic Checksum, Up: Mathematical Packages - | -Graphing | -======== -* Menu: | - | -* Character Plotting:: | -* PostScript Graphing:: | - | +5.7 Graphing | +============ | + +* Menu: + +* Character Plotting:: +* PostScript Graphing:: + File: slib.info, Node: Character Plotting, Next: PostScript Graphing, Prev: Graphing, Up: Graphing - | -Character Plotting | ------------------- | - | -`(require 'charplot)' - - Variable: charplot:dimensions +5.7.1 Character Plotting | +------------------------ | + +`(require 'charplot)' + + -- Variable: charplot:dimensions | A list of the maximum height (number of lines) and maximum width (number of columns) for the graph, its scales, and labels. @@ -5863,7 +6434,7 @@ Character Plotting | `output-port-height' and `output-port-width' of `current-output-port'. - - Procedure: plot coords x-label y-label + -- Procedure: plot coords x-label y-label | COORDS is a list or vector of coordinates, lists of x and y coordinates. X-LABEL and Y-LABEL are strings with which to label the x and y axes. @@ -5871,12 +6442,12 @@ Character Plotting | Example: (require 'charplot) (set! charplot:dimensions '(20 55)) - + (define (make-points n) (if (zero? n) '() (cons (list (/ n 6) (sin (/ n 6))) (make-points (1- n))))) - + (plot (make-points 40) "x" "Sin(x)") -| Sin(x) _________________________________________ @@ -5900,8 +6471,8 @@ Character Plotting | |:_____._____:_____._____:_____._____:____| x 2 4 6 - - Procedure: plot func x1 x2 - - Procedure: plot func x1 x2 npts + -- Procedure: plot func x1 x2 | + -- Procedure: plot func x1 x2 npts | Plots the function of one argument FUNC over the range X1 to X2. If the optional integer argument NPTS is supplied, it specifies the number of points to evaluate FUNC at. @@ -5929,11 +6500,11 @@ Character Plotting | |_:_____._____:_____._____:_____._____:___| 0 2 4 6 - - Procedure: histograph data label + -- Procedure: histograph data label | Creates and displays a histogram of the numerical values contained in vector or list DATA - (require 'random-inexact) | + (require 'random-inexact) (histograph (do ((idx 99 (+ -1 idx)) (lst '() (cons (* .02 (random:normal)) lst))) ((negative? idx) lst)) @@ -5962,452 +6533,456 @@ Character Plotting | File: slib.info, Node: PostScript Graphing, Prev: Character Plotting, Up: Graphing - | -PostScript Graphing | -------------------- | - | -`(require 'eps-graph)' | - | -This is a graphing package creating encapsulated-PostScript files. Its | -motivations and design choice are described in | -<http://swissnet.ai.mit.edu/~jaffer/Docupage/grapheps> | - | -A dataset to be plotted is taken from a 2-dimensional array. | -Corresponding coordinates are in rows. Coordinates from any pair of | -columns can be plotted. | - | - - Function: create-postscript-graph filename.eps size elt1 ... | - FILENAME.EPS should be a string naming an output file to be | - created. SIZE should be an exact integer, a list of two exact | - integers, or #f. ELT1, ... are values returned by graphing | - primitives described here. | - | - `create-postscript-graph' creates an "Encapsulated-PostScript" | - file named FILENAME.EPS containing graphs as directed by the ELT1, | - ... arguments. | - | - The size of the graph is determined by the SIZE argument. If a | - list of two integers, they specify the width and height. If one | - integer, then that integer is the width and the height is 3/4 of | - the width. If #f, the graph will be 800 by 600. | - | -These graphing procedures should be called as arguments to | -`create-postscript-graph'. The order of these arguments is | -significant; PostScript graphics state is affected serially from the | -first ELT argument to the last. | - | - - Function: whole-page | - Pushes a rectangle for the whole encapsulated page onto the | - PostScript stack. This pushed rectangle is an implicit argument to | - `partition-page' or `setup-plot'. | - | -* Menu: | - | -* Column Ranges:: | -* Drawing the Graph:: | -* Graphics Context:: | -* Rectangles:: | -* Legending:: | -* Legacy Plotting:: | -* Example Graph:: | - | + +5.7.2 PostScript Graphing | +------------------------- | + +`(require 'eps-graph)' + +This is a graphing package creating encapsulated-PostScript files. Its +motivations and design choice are described in +`http://swiss.csail.mit.edu/~jaffer/Docupage/grapheps' | + +A dataset to be plotted is taken from a 2-dimensional array. +Corresponding coordinates are in rows. Coordinates from any pair of +columns can be plotted. + + -- Function: create-postscript-graph filename.eps size elt1 ... | + FILENAME.EPS should be a string naming an output file to be + created. SIZE should be an exact integer, a list of two exact + integers, or #f. ELT1, ... are values returned by graphing + primitives described here. + + `create-postscript-graph' creates an "Encapsulated-PostScript" + file named FILENAME.EPS containing graphs as directed by the ELT1, + ... arguments. + + The size of the graph is determined by the SIZE argument. If a + list of two integers, they specify the width and height. If one + integer, then that integer is the width and the height is 3/4 of + the width. If #f, the graph will be 800 by 600. + +These graphing procedures should be called as arguments to +`create-postscript-graph'. The order of these arguments is +significant; PostScript graphics state is affected serially from the +first ELT argument to the last. + + -- Function: whole-page | + Pushes a rectangle for the whole encapsulated page onto the + PostScript stack. This pushed rectangle is an implicit argument to + `partition-page' or `setup-plot'. + +* Menu: + +* Column Ranges:: +* Drawing the Graph:: +* Graphics Context:: +* Rectangles:: +* Legending:: +* Legacy Plotting:: +* Example Graph:: + File: slib.info, Node: Column Ranges, Next: Drawing the Graph, Prev: PostScript Graphing, Up: PostScript Graphing - | -Column Ranges | -............. | - | -A "range" is a list of two numbers, the minimum and the maximum. | -Ranges can be given explicity or computed in PostScript by | -`column-range'. | - | - - Function: column-range array k | - Returns the range of values in 2-dimensional ARRAY column K. | - | - - Function: pad-range range p | - Expands RANGE by P/100 on each end. | - | - - Function: snap-range range | - Expands RANGE to round number of ticks. | - | - - Function: combine-ranges range1 range2 ... | - Returns the minimal range covering all RANGE1, RANGE2, ... | - | - - Function: setup-plot x-range y-range pagerect | - - Function: setup-plot x-range y-range | - X-RANGE and Y-RANGE should each be a list of two numbers or the | - value returned by `pad-range', `snap-range', or `combine-range'. | - PAGERECT is the rectangle bounding the graph to be drawn; if | - missing, the rectangle from the top of the PostScript stack is | - popped and used. | - | - Based on the given ranges, `setup-plot' sets up scaling and | - margins for making a graph. The margins are sized proportional to | - the FONTHEIGHT value at the time of the call to setup-plot. | - `setup-plot' sets two variables: | - | - PLOTRECT | - The region where data points will be plotted. | - | - GRAPHRECT | - The PAGERECT argument to `setup-plot'. Includes plotrect, | - legends, etc. | - | + +5.7.2.1 Column Ranges | +..................... | + +A "range" is a list of two numbers, the minimum and the maximum. Ranges | +can be given explicity or computed in PostScript by `column-range'. | + + -- Function: column-range array k | + Returns the range of values in 2-dimensional ARRAY column K. + + -- Function: pad-range range p | + Expands RANGE by P/100 on each end. + + -- Function: snap-range range | + Expands RANGE to round number of ticks. + + -- Function: combine-ranges range1 range2 ... | + Returns the minimal range covering all RANGE1, RANGE2, ... + + -- Function: setup-plot x-range y-range pagerect | + -- Function: setup-plot x-range y-range | + X-RANGE and Y-RANGE should each be a list of two numbers or the + value returned by `pad-range', `snap-range', or `combine-range'. + PAGERECT is the rectangle bounding the graph to be drawn; if + missing, the rectangle from the top of the PostScript stack is + popped and used. + + Based on the given ranges, `setup-plot' sets up scaling and + margins for making a graph. The margins are sized proportional to + the FONTHEIGHT value at the time of the call to setup-plot. + `setup-plot' sets two variables: + + PLOTRECT + The region where data points will be plotted. + + GRAPHRECT + The PAGERECT argument to `setup-plot'. Includes plotrect, + legends, etc. + File: slib.info, Node: Drawing the Graph, Next: Graphics Context, Prev: Column Ranges, Up: PostScript Graphing - | -Drawing the Graph | -................. | - | - - Function: plot-column array x-column y-column proc3s | - Plots points with x coordinate in X-COLUMN of ARRAY and y | - coordinate Y-COLUMN of ARRAY. The symbol PROC3S specifies the | - type of glyph or drawing style for presenting these coordinates. | - | -The glyphs and drawing styles available are: | - | -`line' | - Draws line connecting points in order. | - | -`mountain' | - Fill area below line connecting points. | - | -`cloud' | - Fill area above line connecting points. | - | -`impulse' | - Draw line from x-axis to each point. | - | -`bargraph' | - Draw rectangle from x-axis to each point. | - | -`disc' | - Solid round dot. | - | -`point' | - Minimal point - invisible if linewidth is 0. | - | -`square' | - Square box. | - | -`diamond' | - Square box at 45.o | - | -`plus' | - Plus sign. | - | -`cross' | - X sign. | - | -`triup' | - Triangle pointing upward | - | -`tridown' | - Triangle pointing downward | - | -`pentagon' | - Five sided polygon | - | -`circle' | - Hollow circle | - | + +5.7.2.2 Drawing the Graph | +......................... | + + -- Function: plot-column array x-column y-column proc3s | + Plots points with x coordinate in X-COLUMN of ARRAY and y + coordinate Y-COLUMN of ARRAY. The symbol PROC3S specifies the + type of glyph or drawing style for presenting these coordinates. + +The glyphs and drawing styles available are: + +`line' + Draws line connecting points in order. + +`mountain' + Fill area below line connecting points. + +`cloud' + Fill area above line connecting points. + +`impulse' + Draw line from x-axis to each point. + +`bargraph' + Draw rectangle from x-axis to each point. + +`disc' + Solid round dot. + +`point' + Minimal point - invisible if linewidth is 0. + +`square' + Square box. + +`diamond' + Square box at 45.o + +`plus' + Plus sign. + +`cross' + X sign. + +`triup' + Triangle pointing upward + +`tridown' + Triangle pointing downward + +`pentagon' + Five sided polygon + +`circle' + Hollow circle + File: slib.info, Node: Graphics Context, Next: Rectangles, Prev: Drawing the Graph, Up: PostScript Graphing - | -Graphics Context | -................ | - | - - Function: in-graphic-context arg ... | - Saves the current graphics state, executes ARGS, then restores to | - saved graphics state. | - | - - Function: set-color color | - COLOR should be a string naming a Resene color, a saturate color, | - or a number between 0 and 100. | - | - `set-color' sets the PostScript color to the color of the given | - string, or a grey value between black (0) and white (100). | - | - - Function: set-font name fontheight | - NAME should be a (case-sensitive) string naming a PostScript font. | - FONTHEIGHT should be a positive real number. | - | - `set-font' Changes the current PostScript font to NAME with height | - equal to FONTHEIGHT. The default font is Helvetica (12pt). | - | -The base set of PostScript fonts is: | - | -Times Times-Italic Times-Bold Times-BoldItalic | -Helvetica Helvetica-Oblique Helvetica-Bold Helvetica-BoldOblique | -Courier Courier-Oblique Courier-Bold Courier-BoldOblique | -Symbol | - | -Line parameters do no affect fonts; they do effect glyphs. | - | - - Function: set-linewidth w | - The default linewidth is 1. Setting it to 0 makes the lines drawn | - as skinny as possible. Linewidth must be much smaller than | - glyphsize for readable glyphs. | - | - - Function: set-linedash j k | - Lines are drawn J-on K-off. | - | - - Function: set-linedash j | - Lines are drawn J-on J-off. | - | - - Function: set-linedash | - Turns off dashing. | - | - - Function: set-glyphsize w | - Sets the (PostScript) variable glyphsize to W. The default | - glyphsize is 6. | - | -The effects of `clip-to-rect' are also part of the graphic context. | - | + +5.7.2.3 Graphics Context | +........................ | + + -- Function: in-graphic-context arg ... | + Saves the current graphics state, executes ARGS, then restores to + saved graphics state. + + -- Function: set-color color | + COLOR should be a string naming a Resene color, a saturate color, + or a number between 0 and 100. + + `set-color' sets the PostScript color to the color of the given + string, or a grey value between black (0) and white (100). + + -- Function: set-font name fontheight | + NAME should be a (case-sensitive) string naming a PostScript font. + FONTHEIGHT should be a positive real number. + + `set-font' Changes the current PostScript font to NAME with height + equal to FONTHEIGHT. The default font is Helvetica (12pt). + +The base set of PostScript fonts is: + +Times Times-Italic Times-Bold Times-BoldItalic +Helvetica Helvetica-Oblique Helvetica-Bold Helvetica-BoldOblique +Courier Courier-Oblique Courier-Bold Courier-BoldOblique +Symbol + +Line parameters do no affect fonts; they do effect glyphs. + + -- Function: set-linewidth w | + The default linewidth is 1. Setting it to 0 makes the lines drawn + as skinny as possible. Linewidth must be much smaller than + glyphsize for readable glyphs. + + -- Function: set-linedash j k | + Lines are drawn J-on K-off. + + -- Function: set-linedash j | + Lines are drawn J-on J-off. + + -- Function: set-linedash | + Turns off dashing. + + -- Function: set-glyphsize w | + Sets the (PostScript) variable glyphsize to W. The default + glyphsize is 6. + +The effects of `clip-to-rect' are also part of the graphic context. + File: slib.info, Node: Rectangles, Next: Legending, Prev: Graphics Context, Up: PostScript Graphing - | -Rectangles | -.......... | - | -A "rectangle" is a list of 4 numbers; the first two elements are the x | -and y coordinates of lower left corner of the rectangle. The other two | -elements are the width and height of the rectangle. | - | - - Function: whole-page | - Pushes a rectangle for the whole encapsulated page onto the | - PostScript stack. This pushed rectangle is an implicit argument to | - `partition-page' or `setup-plot'. | - | - - Function: partition-page xparts yparts | - Pops the rectangle currently on top of the stack and pushes XPARTS | - * YPARTS sub-rectangles onto the stack in decreasing y and | - increasing x order. If you are drawing just one graph, then you | - don't need `partition-page'. | - | - - Variable: plotrect | - The rectangle where data points should be plotted. PLOTRECT is | - set by `setup-plot'. | - | - - Variable: graphrect | - The PAGERECT argument of the most recent call to `setup-plot'. | - Includes plotrect, legends, etc. | - | - - Function: fill-rect rect | - fills RECT with the current color. | - | - - Function: outline-rect rect | - Draws the perimiter of RECT in the current color. | - | - - Function: clip-to-rect rect | - Modifies the current graphics-state so that nothing will be drawn | - outside of the rectangle RECT. Use `in-graphic-context' to limit | - the extent of `clip-to-rect'. | - | + +5.7.2.4 Rectangles | +.................. | + +A "rectangle" is a list of 4 numbers; the first two elements are the x +and y coordinates of lower left corner of the rectangle. The other two +elements are the width and height of the rectangle. + + -- Function: whole-page | + Pushes a rectangle for the whole encapsulated page onto the + PostScript stack. This pushed rectangle is an implicit argument to + `partition-page' or `setup-plot'. + + -- Function: partition-page xparts yparts | + Pops the rectangle currently on top of the stack and pushes XPARTS + * YPARTS sub-rectangles onto the stack in decreasing y and + increasing x order. If you are drawing just one graph, then you + don't need `partition-page'. + + -- Variable: plotrect | + The rectangle where data points should be plotted. PLOTRECT is + set by `setup-plot'. + + -- Variable: graphrect | + The PAGERECT argument of the most recent call to `setup-plot'. + Includes plotrect, legends, etc. + + -- Function: fill-rect rect | + fills RECT with the current color. + + -- Function: outline-rect rect | + Draws the perimiter of RECT in the current color. + + -- Function: clip-to-rect rect | + Modifies the current graphics-state so that nothing will be drawn + outside of the rectangle RECT. Use `in-graphic-context' to limit + the extent of `clip-to-rect'. + File: slib.info, Node: Legending, Next: Legacy Plotting, Prev: Rectangles, Up: PostScript Graphing - | -Legending | -......... | - | - - Function: title-top title subtitle | - - Function: title-top title | - Puts a TITLE line and an optional SUBTITLE line above the | - `graphrect'. | - | - - Function: title-bottom title subtitle | - - Function: title-bottom title | - Puts a TITLE line and an optional SUBTITLE line below the | - `graphrect'. | - | - - Variable: topedge | - - Variable: bottomedge | - These edge coordinates of `graphrect' are suitable for passing as | - the first argument to `rule-horizontal'. | - | - - Variable: leftedge | - - Variable: rightedge | - These edge coordinates of `graphrect' are suitable for passing as | - the first argument to `rule-vertical'. | - | - - Function: rule-vertical x-coord text tick-width | - Draws a vertical ruler with X coordinate X-COORD and labeled with | - string TEXT. If TICK-WIDTH is positive, then the ticks are | - TICK-WIDTH long on the right side of X-COORD; and TEXT and numeric | - legends are on the left. If TICK-WIDTH is negative, then the | - ticks are -TICK-WIDTH long on the left side of X-COORD; and TEXT | - and numeric legends are on the right. | - | - - Function: rule-horizontal x-coord text tick-height | - Draws a horizontal ruler with X coordinate X-COORD and labeled with | - string TEXT. If TICK-HEIGHT is positive, then the ticks are | - TICK-HEIGHT long on the right side of X-COORD; and TEXT and | - numeric legends are on the left. If TICK-HEIGHT is negative, then | - the ticks are -TICK-HEIGHT long on the left side of X-COORD; and | - TEXT and numeric legends are on the right. | - | - - Function: y-axis | - Draws the y-axis. | - | - - Function: x-axis | - Draws the x-axis. | - | - - Function: grid-verticals | - Draws vertical lines through `graphrect' at each tick on the | - vertical ruler. | - | - - Function: grid-horizontals | - Draws horizontal lines through `graphrect' at each tick on the | - horizontal ruler. | - | + +5.7.2.5 Legending | +................. | + + -- Function: title-top title subtitle | + -- Function: title-top title | + Puts a TITLE line and an optional SUBTITLE line above the + `graphrect'. + + -- Function: title-bottom title subtitle | + -- Function: title-bottom title | + Puts a TITLE line and an optional SUBTITLE line below the + `graphrect'. + + -- Variable: topedge | + -- Variable: bottomedge | + These edge coordinates of `graphrect' are suitable for passing as + the first argument to `rule-horizontal'. + + -- Variable: leftedge | + -- Variable: rightedge | + These edge coordinates of `graphrect' are suitable for passing as + the first argument to `rule-vertical'. + + -- Function: set-margin-templates left right | + The margin-templates are strings whose displayed width is used to | + reserve space for the left and right side numerical legends. The | + default values are "-.0123456789". | + | + -- Function: rule-vertical x-coord text tick-width | + Draws a vertical ruler with X coordinate X-COORD and labeled with + string TEXT. If TICK-WIDTH is positive, then the ticks are + TICK-WIDTH long on the right side of X-COORD; and TEXT and numeric + legends are on the left. If TICK-WIDTH is negative, then the + ticks are -TICK-WIDTH long on the left side of X-COORD; and TEXT + and numeric legends are on the right. + + -- Function: rule-horizontal x-coord text tick-height | + Draws a horizontal ruler with X coordinate X-COORD and labeled with + string TEXT. If TICK-HEIGHT is positive, then the ticks are + TICK-HEIGHT long on the right side of X-COORD; and TEXT and + numeric legends are on the left. If TICK-HEIGHT is negative, then + the ticks are -TICK-HEIGHT long on the left side of X-COORD; and + TEXT and numeric legends are on the right. + + -- Function: y-axis | + Draws the y-axis. + + -- Function: x-axis | + Draws the x-axis. + + -- Function: grid-verticals | + Draws vertical lines through `graphrect' at each tick on the + vertical ruler. + + -- Function: grid-horizontals | + Draws horizontal lines through `graphrect' at each tick on the + horizontal ruler. + File: slib.info, Node: Legacy Plotting, Next: Example Graph, Prev: Legending, Up: PostScript Graphing - | -Legacy Plotting | -............... | - | - - Variable: graph:dimensions | - A list of the width and height of the graph to be plotted using | - `plot'. | - | - - Function: plot func x1 x2 npts | - - Function: plot func x1 x2 | - Creates and displays using `(system "gv tmp.eps")' an encapsulated | - PostScript graph of the function of one argument FUNC over the | - range X1 to X2. If the optional integer argument NPTS is | - supplied, it specifies the number of points to evaluate FUNC at. | - | - - Function: plot coords x-label y-label | - COORDS is a list or vector of coordinates, lists of x and y | - coordinates. X-LABEL and Y-LABEL are strings with which to label | - the x and y axes. | - | + +5.7.2.6 Legacy Plotting | +....................... | + + -- Variable: graph:dimensions | + A list of the width and height of the graph to be plotted using + `plot'. + + -- Function: plot func x1 x2 npts | + -- Function: plot func x1 x2 | + Creates and displays using `(system "gv tmp.eps")' an encapsulated + PostScript graph of the function of one argument FUNC over the + range X1 to X2. If the optional integer argument NPTS is + supplied, it specifies the number of points to evaluate FUNC at. + + -- Function: plot coords x-label y-label | + COORDS is a list or vector of coordinates, lists of x and y + coordinates. X-LABEL and Y-LABEL are strings with which to label + the x and y axes. + File: slib.info, Node: Example Graph, Prev: Legacy Plotting, Up: PostScript Graphing - | -Example Graph | -............. | - | -The file `am1.5.html', a table of solar irradiance, is fetched with | -`wget' if it isn't already in the working directory. The file is read | -and stored into an array, IRRADIANCE. | - | - `create-postscript-graph' is then called to create an | -encapsulated-PostScript file, `solarad.eps'. The size of the page is | -set to 600 by 300. `whole-page' is called and leaves the rectangle on | -the PostScript stack. `setup-plot' is called with a literal range for | -x and computes the range for column 1. | - | - Two calls to `top-title' are made so a different font can be used for | -the lower half. `in-graphic-context' is used to limit the scope of the | -font change. The graphing area is outlined and a rule drawn on the | -left side. | - | - Because the X range was intentionally reduced, `in-graphic-context' | -is called and `clip-to-rect' limits drawing to the plotting area. A | -black line is drawn from data column 1. That line is then overlayed | -with a mountain plot of the same column colored "Bright Sun". | - | - After returning from the `in-graphic-context', the bottom ruler is | -drawn. Had it been drawn earlier, all its ticks would have been | -painted over by the mountain plot. | - | - The color is then changed to `seagreen' and the same graphrect is | -setup again, this time with a different Y scale, 0 to 1000. The | -graphic context is again clipped to PLOTRECT, linedash is set, and | -column 2 is plotted as a dashed line. Finally the rightedge is ruled. | -Having the line and its scale both in green helps disambiguate the | -scales. | - | - (require 'eps-graph) | - (require 'line-i/o) | - (require 'string-port) | - | - (define irradiance | - (let ((url "http://www.pv.unsw.edu.au/am1.5.html") | - (file "am1.5.html")) | - (define (read->list line) | - (define elts '()) | - (call-with-input-string line | - (lambda (iprt) (do ((elt (read iprt) (read iprt))) | - ((eof-object? elt) elts) | - (set! elts (cons elt elts)))))) | - (if (not (file-exists? file)) | - (system (string-append "wget -c -O" file " " url))) | - (call-with-input-file file | - (lambda (iprt) | - (define lines '()) | - (do ((line (read-line iprt) (read-line iprt))) | - ((eof-object? line) | - (let ((nra (create-array (Ar64) | - (length lines) | - (length (car lines))))) | - (do ((lns lines (cdr lns)) | - (idx (+ -1 (length lines)) (+ -1 idx))) | - ((null? lns) nra) | - (do ((kdx (+ -1 (length (car lines))) (+ -1 kdx)) | - (lst (car lns) (cdr lst))) | - ((null? lst)) | - (array-set! nra (car lst) idx kdx))))) | - (if (and (positive? (string-length line)) | - (char-numeric? (string-ref line 0))) | - (set! lines (cons (read->list line) lines)))))))) | - | - (let ((xrange '(.25 2.5))) | - (create-postscript-graph | - "solarad.eps" '(600 300) | - (whole-page) | - (setup-plot xrange (column-range irradiance 1)) | - (title-top | - "Solar Irradiance http://www.pv.unsw.edu.au/am1.5.html") | - (in-graphic-context | - (set-font "Helvetica-Oblique" 12) | - (title-top | - "" | + +5.7.2.7 Example Graph | +..................... | + +The file `am1.5.html', a table of solar irradiance, is fetched with +`wget' if it isn't already in the working directory. The file is read +and stored into an array, IRRADIANCE. + + `create-postscript-graph' is then called to create an +encapsulated-PostScript file, `solarad.eps'. The size of the page is +set to 600 by 300. `whole-page' is called and leaves the rectangle on +the PostScript stack. `setup-plot' is called with a literal range for +x and computes the range for column 1. + + Two calls to `top-title' are made so a different font can be used for +the lower half. `in-graphic-context' is used to limit the scope of the +font change. The graphing area is outlined and a rule drawn on the +left side. + + Because the X range was intentionally reduced, `in-graphic-context' +is called and `clip-to-rect' limits drawing to the plotting area. A +black line is drawn from data column 1. That line is then overlayed +with a mountain plot of the same column colored "Bright Sun". + + After returning from the `in-graphic-context', the bottom ruler is +drawn. Had it been drawn earlier, all its ticks would have been +painted over by the mountain plot. + + The color is then changed to `seagreen' and the same graphrect is +setup again, this time with a different Y scale, 0 to 1000. The +graphic context is again clipped to PLOTRECT, linedash is set, and +column 2 is plotted as a dashed line. Finally the rightedge is ruled. +Having the line and its scale both in green helps disambiguate the +scales. + + (require 'eps-graph) + (require 'line-i/o) + (require 'string-port) + + (define irradiance + (let ((url "http://www.pv.unsw.edu.au/am1.5.html") + (file "am1.5.html")) + (define (read->list line) + (define elts '()) + (call-with-input-string line + (lambda (iprt) (do ((elt (read iprt) (read iprt))) + ((eof-object? elt) elts) + (set! elts (cons elt elts)))))) + (if (not (file-exists? file)) + (system (string-append "wget -c -O" file " " url))) + (call-with-input-file file + (lambda (iprt) + (define lines '()) + (do ((line (read-line iprt) (read-line iprt))) + ((eof-object? line) + (let ((nra (make-array (A:floR64b) | + (length lines) + (length (car lines))))) + (do ((lns lines (cdr lns)) + (idx (+ -1 (length lines)) (+ -1 idx))) + ((null? lns) nra) + (do ((kdx (+ -1 (length (car lines))) (+ -1 kdx)) + (lst (car lns) (cdr lst))) + ((null? lst)) + (array-set! nra (car lst) idx kdx))))) + (if (and (positive? (string-length line)) + (char-numeric? (string-ref line 0))) + (set! lines (cons (read->list line) lines)))))))) + + (let ((xrange '(.25 2.5))) + (create-postscript-graph + "solarad.eps" '(600 300) + (whole-page) + (setup-plot xrange (column-range irradiance 1)) + (title-top + "Solar Irradiance http://www.pv.unsw.edu.au/am1.5.html") + (in-graphic-context + (set-font "Helvetica-Oblique" 12) + (title-top + "" "Key Centre for Photovoltaic Engineering UNSW - Air Mass 1.5 Global Spectrum")) - (outline-rect plotrect) | - (rule-vertical leftedge "W/(m^2.um)" 10) | - (in-graphic-context (clip-to-rect plotrect) | - (plot-column irradiance 0 1 'line) | - (set-color "Bright Sun") | - (plot-column irradiance 0 1 'mountain) | - ) | - (rule-horizontal bottomedge "Wavelength in .um" 5) | - (set-color 'seagreen) | - | - (setup-plot xrange '(0 1000) graphrect) | - (in-graphic-context (clip-to-rect plotrect) | - (set-linedash 5 2) | - (plot-column irradiance 0 2 'line)) | - (rule-vertical rightedge "Integrated .W/(m^2)" -10) | - )) | - | - (system "gv solarad.eps") | - | + (outline-rect plotrect) + (rule-vertical leftedge "W/(m^2.um)" 10) + (in-graphic-context (clip-to-rect plotrect) + (plot-column irradiance 0 1 'line) + (set-color "Bright Sun") + (plot-column irradiance 0 1 'mountain) + ) + (rule-horizontal bottomedge "Wavelength in .um" 5) + (set-color 'seagreen) + + (setup-plot xrange '(0 1000) graphrect) + (in-graphic-context (clip-to-rect plotrect) + (set-linedash 5 2) + (plot-column irradiance 0 2 'line)) + (rule-vertical rightedge "Integrated .W/(m^2)" -10) + )) + + (system "gv solarad.eps") + File: slib.info, Node: Solid Modeling, Next: Color, Prev: Graphing, Up: Mathematical Packages - | -Solid Modeling -============== -`(require 'solid)' +5.8 Solid Modeling | +================== | -`http://swissnet.ai.mit.edu/~jaffer/Solid/#Example' gives an example +`(require 'solid)' + +`http://swiss.csail.mit.edu/~jaffer/Solid/#Example' gives an example | use of this package. - - Function: vrml node ... + -- Function: vrml node ... | Returns the VRML97 string (including header) of the concatenation of strings NODES, .... - - Function: vrml-append node1 node2 ... + -- Function: vrml-append node1 node2 ... | Returns the concatenation with interdigitated newlines of strings NODE1, NODE2, .... - - Function: vrml-to-file file node ... + -- Function: vrml-to-file file node ... | Writes to file named FILE the VRML97 string (including header) of the concatenation of strings NODES, .... - - Function: world:info title info ... + -- Function: world:info title info ... | Returns a VRML97 string setting the title of the file in which it appears to TITLE. Additional strings INFO, ... are comments. @@ -6416,11 +6991,11 @@ appear in the resulting VRML code. This string turns off the headlight at the viewpoint: " NavigationInfo {headlight FALSE}" - - Function: scene:panorama front right back left top bottom + -- Function: scene:panorama front right back left top bottom | Specifies the distant images on the inside faces of the cube enclosing the virtual world. - - Function: scene:sphere colors angles + -- Function: scene:sphere colors angles | COLORS is a list of color objects. Each may be of type *Note color: Color Data-Type, a 24-bit sRGB integer, or a list of 3 numbers between 0.0 and 1.0. @@ -6431,16 +7006,16 @@ at the viewpoint: are taken from the colors paired with the angles nearest them. `scene:sphere' fills horizontal bands with interpolated colors on - the backgroud sphere encasing the world. + the background sphere encasing the world. | - - Function: scene:sky-and-dirt - Returns a blue and brown backgroud sphere encasing the world. + -- Function: scene:sky-and-dirt | + Returns a blue and brown background sphere encasing the world. | - - Function: scene:sky-and-grass - Returns a blue and green backgroud sphere encasing the world. + -- Function: scene:sky-and-grass | + Returns a blue and green background sphere encasing the world. | - - Function: scene:sun latitude julian-day hour turbidity strength - - Function: scene:sun latitude julian-day hour turbidity + -- Function: scene:sun latitude julian-day hour turbidity strength | + -- Function: scene:sun latitude julian-day hour turbidity | LATITUDE is the virtual place's latitude in degrees. JULIAN-DAY is an integer from 0 to 366, the day of the year. HOUR is a real number from 0 to 24 for the time of day; 12 is noon. TURBIDITY is @@ -6450,8 +7025,8 @@ at the viewpoint: would be at HOUR on JULIAN-DAY at LATITUDE. If STRENGTH is positive, included is a light source of STRENGTH (default 1). - - Function: scene:overcast latitude julian-day hour turbidity strength - - Function: scene:overcast latitude julian-day hour turbidity + -- Function: scene:overcast latitude julian-day hour turbidity strength | + -- Function: scene:overcast latitude julian-day hour turbidity | LATITUDE is the virtual place's latitude in degrees. JULIAN-DAY is an integer from 0 to 366, the day of the year. HOUR is a real number from 0 to 24 for the time of day; 12 is noon. TURBIDITY is @@ -6464,14 +7039,14 @@ at the viewpoint: Viewpoints are objects in the virtual world, and can be transformed individually or with solid objects. - - Function: scene:viewpoint name distance compass pitch - - Function: scene:viewpoint name distance compass + -- Function: scene:viewpoint name distance compass pitch | + -- Function: scene:viewpoint name distance compass | Returns a viewpoint named NAME facing the origin and placed DISTANCE from it. COMPASS is a number from 0 to 360 giving the compass heading. PITCH is a number from -90 to 90, defaulting to 0, specifying the angle from the horizontal. - - Function: scene:viewpoints proximity + -- Function: scene:viewpoints proximity | Returns 6 viewpoints, one at the center of each face of a cube with sides 2 * PROXIMITY, centered on the origin. @@ -6493,8 +7068,8 @@ It is sometimes useful for light sources to be brighter than `1'. When INTENSITY arguments are greater than 1, these functions gang multiple sources to reach the desired strength. - - Function: light:ambient color intensity - - Function: light:ambient color + -- Function: light:ambient color intensity | + -- Function: light:ambient color | Ambient light shines on all surfaces with which it is grouped. COLOR is a an object of type *Note color: Color Data-Type, a @@ -6505,9 +7080,9 @@ sources to reach the desired strength. `light:ambient' returns a light source or sources of COLOR with total strength of INTENSITY (or 1 if omitted). - - Function: light:directional color direction intensity - - Function: light:directional color direction - - Function: light:directional color + -- Function: light:directional color direction intensity | + -- Function: light:directional color direction | + -- Function: light:directional color | Directional light shines parallel rays with uniform intensity on all objects with which it is grouped. @@ -6527,10 +7102,10 @@ sources to reach the desired strength. `light:directional' returns a light source or sources of COLOR with total strength of INTENSITY, shining from DIRECTION. - - Function: light:beam attenuation radius aperture peak - - Function: light:beam attenuation radius aperture - - Function: light:beam attenuation radius - - Function: light:beam attenuation + -- Function: light:beam attenuation radius aperture peak | + -- Function: light:beam attenuation radius aperture | + -- Function: light:beam attenuation radius | + -- Function: light:beam attenuation | ATTENUATION is a list or vector of three nonnegative real numbers specifying the reduction of intensity, the reduction of intensity with distance, and the reduction of intensity as the square of @@ -6541,10 +7116,10 @@ sources to reach the desired strength. the light's axis through which it sheds some light. PEAK is a real number between 0 and 90, the angle of greatest illumination. - - Function: light:point location color intensity beam - - Function: light:point location color intensity - - Function: light:point location color - - Function: light:point location + -- Function: light:point location color intensity beam | + -- Function: light:point location color intensity | + -- Function: light:point location color | + -- Function: light:point location | Point light radiates from LOCATION, intensity decreasing with distance, towards all objects with which it is grouped. @@ -6559,11 +7134,11 @@ sources to reach the desired strength. that the pointlight itself is not visible. To make it so, place an object with emissive appearance at LOCATION. - - Function: light:spot location direction color intensity beam - - Function: light:spot location direction color intensity - - Function: light:spot location direction color - - Function: light:spot location direction - - Function: light:spot location + -- Function: light:spot location direction color intensity beam | + -- Function: light:spot location direction color intensity | + -- Function: light:spot location direction color | + -- Function: light:spot location direction | + -- Function: light:spot location | Spot light radiates from LOCATION towards DIRECTION, intensity decreasing with distance, illuminating objects with which it is grouped. @@ -6589,8 +7164,8 @@ sources to reach the desired strength. Object Primitives ----------------- - - Function: solid:box geometry appearance - - Function: solid:box geometry + -- Function: solid:box geometry appearance | + -- Function: solid:box geometry | GEOMETRY must be a number or a list or vector of three numbers. If GEOMETRY is a number, the `solid:box' returns a cube with sides of length GEOMETRY centered on the origin. Otherwise, `solid:box' @@ -6598,40 +7173,41 @@ Object Primitives origin. APPEARANCE determines the surface properties of the returned object. - - Function: solid:cylinder radius height appearance - - Function: solid:cylinder radius height - Returns a right cylinder with dimensions RADIUS and `(abs HEIGHT)' - centered on the origin. If HEIGHT is positive, then the cylinder - ends will be capped. APPEARANCE determines the surface properties - of the returned object. + -- Function: solid:cylinder radius height appearance | + -- Function: solid:cylinder radius height | + Returns a right cylinder with dimensions `(abs RADIUS)' and `(abs | + HEIGHT)' centered on the origin. If HEIGHT is positive, then the | + cylinder ends will be capped. If RADIUS is negative, then only | + the ends will appear. APPEARANCE determines the surface | + properties of the returned object. | - - Function: solid:disk radius thickness appearance - - Function: solid:disk radius thickness + -- Function: solid:disk radius thickness appearance | + -- Function: solid:disk radius thickness | THICKNESS must be a positive real number. `solid:disk' returns a circular disk with dimensions RADIUS and THICKNESS centered on the origin. APPEARANCE determines the surface properties of the returned object. - - Function: solid:cone radius height appearance - - Function: solid:cone radius height + -- Function: solid:cone radius height appearance | + -- Function: solid:cone radius height | Returns an isosceles cone with dimensions RADIUS and HEIGHT centered on the origin. APPEARANCE determines the surface properties of the returned object. - - Function: solid:pyramid side height appearance - - Function: solid:pyramid side height + -- Function: solid:pyramid side height appearance | + -- Function: solid:pyramid side height | Returns an isosceles pyramid with dimensions SIDE and HEIGHT centered on the origin. APPEARANCE determines the surface properties of the returned object. - - Function: solid:sphere radius appearance - - Function: solid:sphere radius + -- Function: solid:sphere radius appearance | + -- Function: solid:sphere radius | Returns a sphere of radius RADIUS centered on the origin. APPEARANCE determines the surface properties of the returned object. - - Function: solid:ellipsoid geometry appearance - - Function: solid:ellipsoid geometry + -- Function: solid:ellipsoid geometry appearance | + -- Function: solid:ellipsoid geometry | GEOMETRY must be a number or a list or vector of three numbers. If GEOMETRY is a number, the `solid:ellipsoid' returns a sphere of diameter GEOMETRY centered on the origin. Otherwise, @@ -6639,9 +7215,23 @@ Object Primitives centered on the origin. APPEARANCE determines the surface properties of the returned object. - - Function: solid:basrelief width height depth colorray appearance - - Function: solid:basrelief width height depth appearance - - Function: solid:basrelief width height depth + -- Function: solid:polyline coordinates appearance | + -- Function: solid:polyline coordinates | + COORDINATES must be a list or vector of coordinate lists or vectors | + specifying the x, y, and z coordinates of points. | + `solid:polyline' returns lines connecting successive pairs of | + points. If called with one argument, then the polyline will be | + white. If APPEARANCE is given, then the polyline will have its | + emissive color only; being black if APPEARANCE does not have an | + emissive color. | + | + The following code will return a red line between points at `(1 2 | + 3)' and `(4 5 6)': | + (solid:polyline '((1 2 3) (4 5 6)) (solid:color #f 0 #f 0 '(1 0 0))) + | + -- Function: solid:basrelief width height depth colorray appearance | + -- Function: solid:basrelief width height depth appearance | + -- Function: solid:basrelief width height depth | One of WIDTH, HEIGHT, or DEPTH must be a 2-dimensional array; the others must be real numbers giving the length of the basrelief in those dimensions. The rest of this description assumes that @@ -6662,36 +7252,52 @@ Object Primitives COLORRAY paints the corresponding face of HEIGHT. Other dimensions for COLORRAY are in error. + -- Function: solid:text fontstyle str len appearance | + -- Function: solid:text fontstyle str len | + FONTSTYLE must be a value returned by `solid:font'. | + | + STR must be a string or list of strings. | + | + LEN must be #f, a nonnegative integer, or list of nonnegative | + integers. | + | + APPEARANCE, if given, determines the surface properties of the | + returned object. | + | + `solid:text' returns a two-sided, flat text object positioned in | + the Z=0 plane of the local coordinate system | + | Surface Attributes ------------------ - - Function: solid:color diffuseColor ambientIntensity specularColor + -- Function: solid:color diffuseColor ambientIntensity specularColor | shininess emissiveColor transparency - - Function: solid:color diffuseColor ambientIntensity specularColor + -- Function: solid:color diffuseColor ambientIntensity specularColor | shininess emissiveColor - - Function: solid:color diffuseColor ambientIntensity specularColor + -- Function: solid:color diffuseColor ambientIntensity specularColor | shininess - - Function: solid:color diffuseColor ambientIntensity specularColor - - Function: solid:color diffuseColor ambientIntensity - - Function: solid:color diffuseColor - Returns an "appearance", the optical properties of the objects - with which it is associated. AMBIENTINTENSITY, SHININESS, and + -- Function: solid:color diffuseColor ambientIntensity specularColor | + -- Function: solid:color diffuseColor ambientIntensity | + -- Function: solid:color diffuseColor | + Returns an "appearance", the optical properties of the objects with | + which it is associated. AMBIENTINTENSITY, SHININESS, and | TRANSPARENCY must be numbers between 0 and 1. DIFFUSECOLOR, SPECULARCOLOR, and EMISSIVECOLOR are objects of type *Note color: Color Data-Type, 24-bit sRGB integers or lists of 3 numbers between 0.0 and 1.0. If a color argument is omitted or #f, then the default color will be used. - - Function: solid:texture image color scale rotation center translation - - Function: solid:texture image color scale rotation center - - Function: solid:texture image color scale rotation - - Function: solid:texture image color scale - - Function: solid:texture image color - - Function: solid:texture image - Returns an "appearance", the optical properties of the objects - with which it is associated. IMAGE is a string naming a JPEG or - PNG image resource. COLOR is #f, a color, or the string returned - by `solid:color'. The rest of the optional arguments specify + -- Function: solid:texture image color scale rotation center | + translation | + -- Function: solid:texture image color scale rotation center | + -- Function: solid:texture image color scale rotation | + -- Function: solid:texture image color scale | + -- Function: solid:texture image color | + -- Function: solid:texture image | + Returns an "appearance", the optical properties of the objects with | + which it is associated. IMAGE is a string naming a JPEG or PNG | + image resource. COLOR is #f, a color, or the string returned by | + `solid:color'. The rest of the optional arguments specify | 2-dimensional transforms applying to the IMAGE. SCALE must be #f, a number, or list or vector of 2 numbers @@ -6702,42 +7308,75 @@ Surface Attributes list or vector of 2 numbers specifying the translation to apply to IMAGE. + -- Function: solid:font family style justify size spacing language | + direction | + Returns a fontstyle object suitable for passing as an argument to | + `solid:text'. Any of the arguments may be #f, in which case its | + default value, which is first in each list of allowed values, is | + used. | + | + FAMILY is a case-sensitive string naming a font; `SERIF', `SANS', | + and `TYPEWRITER' are supported at the minimum. | + | + STYLE is a case-sensitive string `PLAIN', `BOLD', `ITALIC', or | + `BOLDITALIC'. | + | + JUSTIFY is a case-sensitive string `FIRST', `BEGIN', `MIDDLE', or | + `END'; or a list of one or two case-sensitive strings (same | + choices). The mechanics of JUSTIFY get complicated; it is | + explained by tables 6.2 to 6.7 of | + `http://www.web3d.org/x3d/specifications/vrml/ISO-IEC-14772-IS-VRML97WithAmendment1/part1/nodesRef.html#Table6.2' + | + SIZE is the extent, in the non-advancing direction, of the text. | + SIZE defaults to 1. | + | + SPACING is the ratio of the line (or column) offset to SIZE. | + SPACING defaults to 1. | + | + LANGUAGE is the RFC-1766 language name. | + | + DIRECTION is a list of two numbers: `(X Y)'. If | + `(> (abs X) (abs Y))', then the text will be arrayed horizontally; | + otherwise vertically. The direction in which characters are | + arrayed is determined by the sign of the major axis: positive X | + being left-to-right; positive Y being top-to-bottom. | + | Aggregating Objects ------------------- - - Function: solid:center-row-of number solid spacing + -- Function: solid:center-row-of number solid spacing | Returns a row of NUMBER SOLID objects spaced evenly SPACING apart. - - Function: solid:center-array-of number-a number-b solid spacing-a + -- Function: solid:center-array-of number-a number-b solid spacing-a | spacing-b Returns NUMBER-B rows, SPACING-B apart, of NUMBER-A SOLID objects SPACING-A apart. - - Function: solid:center-pile-of number-a number-b number-c solid + -- Function: solid:center-pile-of number-a number-b number-c solid | spacing-a spacing-b spacing-c Returns NUMBER-C planes, SPACING-C apart, of NUMBER-B rows, SPACING-B apart, of NUMBER-A SOLID objects SPACING-A apart. - - Function: solid:arrow center + -- Function: solid:arrow center | CENTER must be a list or vector of three numbers. Returns an upward pointing metallic arrow centered at CENTER. - - Function: solid:arrow + -- Function: solid:arrow | Returns an upward pointing metallic arrow centered at the origin. Spatial Transformations ----------------------- - - Function: solid:translation center solid ... + -- Function: solid:translation center solid ... | CENTER must be a list or vector of three numbers. `solid:translation' Returns an aggregate of SOLIDS, ... with their origin moved to CENTER. - - Function: solid:scale scale solid ... + -- Function: solid:scale scale solid ... | SCALE must be a number or a list or vector of three numbers. `solid:scale' Returns an aggregate of SOLIDS, ... scaled per SCALE. - - Function: solid:rotation axis angle solid ... + -- Function: solid:rotation axis angle solid ... | AXIS must be a list or vector of three numbers. `solid:rotation' Returns an aggregate of SOLIDS, ... rotated ANGLE degrees around the axis AXIS. @@ -6745,10 +7384,10 @@ Spatial Transformations File: slib.info, Node: Color, Next: Root Finding, Prev: Solid Modeling, Up: Mathematical Packages -Color -===== +5.9 Color | +========= | -`http://swissnet.ai.mit.edu/~jaffer/Color' +`http://swiss.csail.mit.edu/~jaffer/Color' | The goals of this package are to provide methods to specify, compute, and transform colors in a core set of additive color spaces. The color @@ -6768,15 +7407,15 @@ encountered in practice and the literature. File: slib.info, Node: Color Data-Type, Next: Color Spaces, Prev: Color, Up: Color -Color Data-Type ---------------- +5.9.1 Color Data-Type | +--------------------- | `(require 'color)' - - Function: color? obj + -- Function: color? obj | Returns #t if OBJ is a color. - - Function: color? obj typ + -- Function: color? obj typ | Returns #t if OBJ is a color of color-space TYP. The symbol TYP must be one of: @@ -6794,27 +7433,37 @@ Color Data-Type * L*C*h - - Function: make-color space arg ... + -- Function: make-color space arg ... | Returns a color of type SPACE. - - Function: color-space color + * For SPACE arguments `CIEXYZ', `RGB709', and `sRGB', the sole | + ARG is a list of three numbers. | + | + * For SPACE arguments `L*a*b*', `L*u*v*', and `L*C*h', ARG is a | + list of three numbers optionally followed by a whitepoint. | + | + * For `xRGB', ARG is an integer. | + | + * For `e-sRGB', the arguments are as for `e-sRGB->color'. | + | + -- Function: color-space color | Returns the symbol for the color-space in which COLOR is embedded. - - Function: color-precision color + -- Function: color-precision color | For colors in digital color-spaces, `color-precision' returns the number of bits used for each of the R, G, and B channels of the encoding. Otherwise, `color-precision' returns #f - - Function: color-white-point color + -- Function: color-white-point color | Returns the white-point of COLOR in all color-spaces except CIEXYZ. - - Function: convert-color color space white-point - - Function: convert-color color space - - Function: convert-color color e-sRGB precision + -- Function: convert-color color space white-point | + -- Function: convert-color color space | + -- Function: convert-color color e-sRGB precision | Converts COLOR into SPACE at optional WHITE-POINT. -External Representation -....................... +5.9.1.1 External Representation | +............................... | Each color encoding has an external, case-insensitive representation. To ensure portability, the white-point for all color strings is D65. @@ -6849,32 +7498,32 @@ sRGB #x<RRGGBB> Where RRGGBB is a non-negative six-digit hexadecimal number. - - Function: color->string color + -- Function: color->string color | Returns a string representation of COLOR. - - Function: string->color string + -- Function: string->color string | Returns the color represented by STRING. If STRING is not a syntactically valid notation for a color, then `string->color' returns #f. -White -..... +5.9.1.2 White | +............. | We experience color relative to the illumination around us. CIEXYZ coordinates, although subject to uniform scaling, are objective. Thus other color spaces are specified relative to a "white point" in CIEXYZ -coordinates. +coordinates. The white point for digital color spaces is set to D65. For the other spaces a WHITE-POINT argument can be specified. The default if none is specified is the white-point with which the color was created or last converted; and D65 if none has been specified. - - Constant: D65 + -- Constant: D65 | Is the color of 6500.K (blackbody) illumination. D65 is close to the average color of daylight. - - Constant: D50 + -- Constant: D50 | Is the color of 5000.K (blackbody) illumination. D50 is the color of indoor lighting by incandescent bulbs, whose filaments have temperatures around 5000.K. @@ -6892,58 +7541,58 @@ device-dependent RGBi and RGB spaces of Xlib. File: slib.info, Node: Color Spaces, Next: Spectra, Prev: Color Data-Type, Up: Color -Color Spaces ------------- +5.9.2 Color Spaces | +------------------ | Measurement-based Color Spaces .............................. The "tristimulus" color spaces are those whose component values are proportional measurements of light intensity. The CIEXYZ(1931) system -provides 3 sets of spectra to convolve with a spectrum of interest. -The result of those convolutions is coordinates in CIEXYZ space. All +provides 3 sets of spectra to dot-product with a spectrum of interest. | +The result of those dot-products is coordinates in CIEXYZ space. All | tristimuls color spaces are related to CIEXYZ by linear transforms, namely matrix multiplication. Of the color spaces listed here, CIEXYZ and RGB709 are tristimulus spaces. - - Color Space: CIEXYZ + -- Color Space: CIEXYZ | The CIEXYZ color space covers the full "gamut". It is the basis for color-space conversions. - CIEXYZ is a list of three inexact numbers between 0 and 1.1. '(0. - 0. 0.) is black; '(1. 1. 1.) is white. + CIEXYZ is a list of three inexact numbers between 0.0 and 1.1. | + '(0. 0. 0.) is black; '(1. 1. 1.) is white. | - - Function: ciexyz->color xyz + -- Function: ciexyz->color xyz | XYZ must be a list of 3 numbers. If XYZ is valid CIEXYZ coordinates, then `ciexyz->color' returns the color specified by XYZ; otherwise returns #f. - - Function: color:ciexyz x y z + -- Function: color:ciexyz x y z | Returns the CIEXYZ color composed of X, Y, Z. If the coordinates do not encode a valid CIEXYZ color, then an error is signaled. - - Function: color->ciexyz color + -- Function: color->ciexyz color | Returns the list of 3 numbers encoding COLOR in CIEXYZ. - - Color Space: RGB709 + -- Color Space: RGB709 | BT.709-4 (03/00) `Parameter values for the HDTV standards for production and international programme exchange' specifies parameter values for chromaticity, sampling, signal format, frame rates, etc., of high definition television signals. An RGB709 color is represented by a list of three inexact numbers - between 0 and 1. '(0. 0. 0.) is black '(1. 1. 1.) is white. + between 0.0 and 1.0. '(0. 0. 0.) is black '(1. 1. 1.) is white. | - - Function: rgb709->color rgb + -- Function: rgb709->color rgb | RGB must be a list of 3 numbers. If RGB is valid RGB709 coordinates, then `rgb709->color' returns the color specified by RGB; otherwise returns #f. - - Function: color:rgb709 r g b + -- Function: color:rgb709 r g b | Returns the RGB709 color composed of R, G, B. If the coordinates do not encode a valid RGB709 color, then an error is signaled. - - Function: color->rgb709 color + -- Function: color->rgb709 color | Returns the list of 3 numbers encoding COLOR in RGB709. Perceptual Uniformity @@ -6956,58 +7605,58 @@ range of distances (6:1) in the L*a*b* and L*u*v* spaces than in tristimulus spaces (80:1). For this reason, color distances are computed in L*a*b* (or L*C*h). - - Color Space: L*a*b* + -- Color Space: L*a*b* | Is a CIE color space which better matches the human visual system's perception of color. It is a list of three numbers: - * 0 <= L* <= 100 (CIE "Lightness") + * 0 <= L* <= 100 (CIE "Lightness") * -500 <= a* <= 500 * -200 <= b* <= 200 - - Function: l*a*b*->color L*a*b* white-point + -- Function: l*a*b*->color L*a*b* white-point | L*A*B* must be a list of 3 numbers. If L*A*B* is valid L*a*b* coordinates, then `l*a*b*->color' returns the color specified by L*A*B*; otherwise returns #f. - - Function: color:l*a*b* L* a* b* white-point + -- Function: color:l*a*b* L* a* b* white-point | Returns the L*a*b* color composed of L*, A*, B* with WHITE-POINT. - - Function: color:l*a*b* L* a* b* + -- Function: color:l*a*b* L* a* b* | Returns the L*a*b* color composed of L*, A*, B*. If the coordinates do not encode a valid L*a*b* color, then an error is signaled. - - Function: color->l*a*b* color white-point + -- Function: color->l*a*b* color white-point | Returns the list of 3 numbers encoding COLOR in L*a*b* with WHITE-POINT. - - Function: color->l*a*b* color + -- Function: color->l*a*b* color | Returns the list of 3 numbers encoding COLOR in L*a*b*. - - Color Space: L*u*v* + -- Color Space: L*u*v* | Is another CIE encoding designed to better match the human visual system's perception of color. - - Function: l*u*v*->color L*u*v* white-point + -- Function: l*u*v*->color L*u*v* white-point | L*U*V* must be a list of 3 numbers. If L*U*V* is valid L*u*v* coordinates, then `l*u*v*->color' returns the color specified by L*U*V*; otherwise returns #f. - - Function: color:l*u*v* L* u* v* white-point + -- Function: color:l*u*v* L* u* v* white-point | Returns the L*u*v* color composed of L*, U*, V* with WHITE-POINT. - - Function: color:l*u*v* L* u* v* + -- Function: color:l*u*v* L* u* v* | Returns the L*u*v* color composed of L*, U*, V*. If the coordinates do not encode a valid L*u*v* color, then an error is signaled. - - Function: color->l*u*v* color white-point + -- Function: color->l*u*v* color white-point | Returns the list of 3 numbers encoding COLOR in L*u*v* with WHITE-POINT. - - Function: color->l*u*v* color + -- Function: color->l*u*v* color | Returns the list of 3 numbers encoding COLOR in L*u*v*. Cylindrical Coordinates @@ -7023,16 +7672,16 @@ specification of color must be device-dependent. But take heart! A cylindrical system can be based on L*a*b* and is used for predicting how close colors seem to observers. - - Color Space: L*C*h + -- Color Space: L*C*h | Expresses the *a and b* of L*a*b* in polar coordinates. It is a list of three numbers: - * 0 <= L* <= 100 (CIE "Lightness") + * 0 <= L* <= 100 (CIE "Lightness") * C* (CIE "Chroma") is the distance from the neutral (gray) - axis. + axis. - * 0 <= h <= 360 (CIE "Hue") is the angle. + * 0 <= h <= 360 (CIE "Hue") is the angle. The colors by quadrant of h are: @@ -7042,23 +7691,23 @@ close colors seem to observers. 270 blue, purple, magenta 360 - - Function: l*c*h->color L*C*h white-point + -- Function: l*c*h->color L*C*h white-point | L*C*H must be a list of 3 numbers. If L*C*H is valid L*C*h coordinates, then `l*c*h->color' returns the color specified by L*C*H; otherwise returns #f. - - Function: color:l*c*h L* C* h white-point + -- Function: color:l*c*h L* C* h white-point | Returns the L*C*h color composed of L*, C*, H with WHITE-POINT. - - Function: color:l*c*h L* C* h + -- Function: color:l*c*h L* C* h | Returns the L*C*h color composed of L*, C*, H. If the coordinates do not encode a valid L*C*h color, then an error is signaled. - - Function: color->l*c*h color white-point + -- Function: color->l*c*h color white-point | Returns the list of 3 numbers encoding COLOR in L*C*h with WHITE-POINT. - - Function: color->l*c*h color + -- Function: color->l*c*h color | Returns the list of 3 numbers encoding COLOR in L*C*h. Digital Color Spaces @@ -7067,7 +7716,7 @@ Digital Color Spaces The color spaces discussed so far are impractical for image data because of numerical precision and computational requirements. In 1998 the IEC adopted `A Standard Default Color Space for the Internet - sRGB' -(<http://www.w3.org/Graphics/Color/sRGB>). sRGB was cleverly designed +(`http://www.w3.org/Graphics/Color/sRGB'). sRGB was cleverly designed | to employ the 24-bit (256x256x256) color encoding already in widespread use; and the 2.2 gamma intrinsic to CRT monitors. @@ -7077,36 +7726,36 @@ then each coordinate is individually subjected to the same non-linear mapping. Inverse operations in the reverse order create the inverse transform. - - Color Space: sRGB + -- Color Space: sRGB | Is "A Standard Default Color Space for the Internet". Most display monitors will work fairly well with sRGB directly. Systems using ICC profiles (1) should work very well with sRGB. - - Function: srgb->color rgb + -- Function: srgb->color rgb | RGB must be a list of 3 numbers. If RGB is valid sRGB coordinates, then `srgb->color' returns the color specified by RGB; otherwise returns #f. - - Function: color:srgb r g b + -- Function: color:srgb r g b | Returns the sRGB color composed of R, G, B. If the coordinates do not encode a valid sRGB color, then an error is signaled. - - Color Space: xRGB + -- Color Space: xRGB | Represents the equivalent sRGB color with a single 24-bit integer. The most significant 8 bits encode red, the middle 8 bits blue, and the least significant 8 bits green. - - Function: color->srgb color + -- Function: color->srgb color | Returns the list of 3 integers encoding COLOR in sRGB. - - Function: color->xrgb color + -- Function: color->xrgb color | Returns the 24-bit integer encoding COLOR in sRGB. - - Function: xrgb->color k + -- Function: xrgb->color k | Returns the sRGB color composed of the 24-bit integer K. - - Color Space: e-sRGB + -- Color Space: e-sRGB | Is "Photography - Electronic still picture imaging - Extended sRGB color encoding" (PIMA 7667:2001). It extends the gamut of sRGB; and its higher precision numbers provide a larger dynamic range. @@ -7123,34 +7772,32 @@ transform. e-sRGB16 0 to 65535 - - Function: e-srgb->color precision rgb + -- Function: e-srgb->color precision rgb | PRECISION must be the integer 10, 12, or 16. RGB must be a list of 3 numbers. If RGB is valid e-sRGB coordinates, then `e-srgb->color' returns the color specified by RGB; otherwise returns #f. - - Function: color:e-srgb 10 r g b + -- Function: color:e-srgb 10 r g b | Returns the e-sRGB10 color composed of integers R, G, B. - - Function: color:e-srgb 12 r g b + -- Function: color:e-srgb 12 r g b | Returns the e-sRGB12 color composed of integers R, G, B. - - Function: color:e-srgb 16 r g b + -- Function: color:e-srgb 16 r g b | Returns the e-sRGB16 color composed of integers R, G, B. If the coordinates do not encode a valid e-sRGB color, then an error is signaled. - - Function: color->e-srgb precision color + -- Function: color->e-srgb precision color | PRECISION must be the integer 10, 12, or 16. `color->e-srgb' returns the list of 3 integers encoding COLOR in sRGB10, sRGB12, or sRGB16. ---------- Footnotes ---------- - (1) - -A comprehensive encoding of transforms between CIEXYZ and device color -spaces is the International Color Consortium profile format, + (1) A comprehensive encoding of transforms between CIEXYZ and device | +color spaces is the International Color Consortium profile format, | ICC.1:1998-09: The intent of this format is to provide a cross-platform device @@ -7161,8 +7808,8 @@ ICC.1:1998-09: File: slib.info, Node: Spectra, Next: Color Difference Metrics, Prev: Color Spaces, Up: Color -Spectra -------- +5.9.3 Spectra | +------------- | The following functions compute colors from spectra, scale color luminance, and extract chromaticity. XYZ is used in the names of @@ -7182,31 +7829,73 @@ A spectrum may be represented as: CIEXYZ values are calculated as dot-product with the X, Y (Luminance), and Z "Spectral Tristimulus Values". The files `cie1931.xyz' and -`cie1964.xyz' in the distribution contain these CIE-defined values. +`cie1964.xyz' in the distribution contain these CIE-defined values. - - Feature: cie1964 + -- Feature: cie1964 | Loads the Spectral Tristimulus Values defining `CIE 1964 Supplementary Standard Colorimetric Observer'. - - Feature: cie1931 + -- Feature: cie1931 | Loads the Spectral Tristimulus Values defining `CIE 1931 Supplementary Standard Colorimetric Observer'. - - Feature: ciexyz + -- Feature: ciexyz | Requires Spectral Tristimulus Values, defaulting to cie1931. -`(require 'cie1964)' or `(require 'cie1931)' will `load-ciexyz' | -specific values used by the following spectrum conversion procedures. | -The spectrum conversion procedures `(require 'ciexyz)' to assure that a | -set is loaded. | - - - Function: spectrum->XYZ proc +`(require 'cie1964)' or `(require 'cie1931)' will `load-ciexyz' +specific values used by the following spectrum conversion procedures. +The spectrum conversion procedures `(require 'ciexyz)' to assure that a +set is loaded. + + -- Function: read-cie-illuminant path | + PATH must be a string naming a file consisting of 107 numbers for | + 5.nm intervals from 300.nm to 830.nm. `read-cie-illuminant' reads | + (using Scheme `read') these numbers and returns a length 107 | + vector filled with them. | + | + (define CIE:SI-D65 | + (read-CIE-illuminant (in-vicinity (library-vicinity) "ciesid65.dat"))) | + (spectrum->XYZ CIE:SI-D65 300e-9 830e-9) | + => (25.108569422374994 26.418013465625001 28.764075683374993) | + | + -- Function: read-normalized-illuminant path | + PATH must be a string naming a file consisting of 107 numbers for | + 5.nm intervals from 300.nm to 830.nm. | + `read-normalized-illuminant' reads (using Scheme `read') these | + numbers and returns a length 107 vector filled with them, | + normalized so that `spectrum->XYZ' of the illuminant returns its | + whitepoint. | + | + CIE Standard Illuminants A and D65 are included with SLIB: | + | + (define CIE:SI-A | + (read-normalized-illuminant (in-vicinity (library-vicinity) "ciesia.dat"))) + (define CIE:SI-D65 | + (read-normalized-illuminant (in-vicinity (library-vicinity) "ciesid65.dat"))) + (spectrum->XYZ CIE:SI-A 300e-9 830e-9) | + => (1.098499460820401 999.9999999999998e-3 355.8173930654951e-3) | + (CIEXYZ->sRGB (spectrum->XYZ CIE:SI-A 300e-9 830e-9)) | + => (255 234 133) | + (spectrum->XYZ CIE:SI-D65 300e-9 830e-9) | + => (950.4336673552745e-3 1.0000000000000002 1.0888053986649182) | + (CIEXYZ->sRGB (spectrum->XYZ CIE:SI-D65 300e-9 830e-9)) | + => (255 255 255) | + | + -- Function: illuminant-map proc siv | + SIV must be a one-dimensional array or vector of 107 numbers. | + `illuminant-map' returns a vector of length 107 containing the | + result of applying PROC to each element of SIV. | + | + -- Function: illuminant-map->XYZ proc siv | + `(spectrum->XYZ (illuminant-map PROC SIV) 300e-9 830e-9)' | + | + -- Function: spectrum->XYZ proc | PROC must be a function of one argument. `spectrum->XYZ' computes the CIEXYZ(1931) values for the spectrum returned by PROC when called with arguments from 380e-9 to 780e-9, the wavelength in meters. - - Function: spectrum->XYZ spectrum x1 x2 + -- Function: spectrum->XYZ spectrum x1 x2 | X1 and X2 must be positive real numbers specifying the wavelengths (in meters) corresponding to the zeroth and last elements of vector or list SPECTRUM. `spectrum->XYZ' returns the CIEXYZ(1931) @@ -7221,33 +7910,27 @@ set is loaded. | (define y_n (cadr xyz)) (map (lambda (x) (/ x y_n)) xyz) => (0.9687111145512467 1.0 1.1210875945303613) - + (define xyz (spectrum->XYZ (blackbody-spectrum 5000))) (map (lambda (x) (/ x y_n)) xyz) => (0.2933441826889158 0.2988931825387761 0.25783646831201573) - - Function: spectrum->CIEXYZ proc - - Function: spectrum->CIEXYZ spectrum x1 x2 - `spectrum->CIEXYZ' computes the CIEXYZ(1931) values for the - spectrum, scaled so their sum is 1. - - - Function: spectrum->chromaticity proc - - Function: spectrum->chromaticity spectrum x1 x2 + -- Function: spectrum->chromaticity proc | + -- Function: spectrum->chromaticity spectrum x1 x2 | Computes the chromaticity for the given spectrum. - - Function: wavelength->XYZ w - - Function: wavelength->chromaticity w - - Function: wavelength->CIEXYZ w + -- Function: wavelength->XYZ w | W must be a number between 380e-9 to 780e-9. `wavelength->XYZ' returns (unnormalized) XYZ values for a monochromatic light source - with wavelength W. `wavelength->chromaticity' returns the - chromaticity for a monochromatic light source with wavelength W. - `wavelength->CIEXYZ' returns XYZ values for the saturated color - having chromaticity of a monochromatic light source with wavelength - W. - - - Function: blackbody-spectrum temp - - Function: blackbody-spectrum temp span + with wavelength W. | + + -- Function: wavelength->chromaticity w | + W must be a number between 380e-9 to 780e-9. | + `wavelength->chromaticity' returns the chromaticity for a | + monochromatic light source with wavelength W. | + | + -- Function: blackbody-spectrum temp | + -- Function: blackbody-spectrum temp span | Returns a procedure of one argument (wavelength in meters), which returns the radiance of a black body at TEMP. @@ -7256,10 +7939,10 @@ set is loaded. | procedure correspond to the power of the photons with wavelengths W to W+1e-9. - - Function: temperature->XYZ x + -- Function: temperature->XYZ x | The positive number X is a temperature in degrees kelvin. - `temperature->XYZ' computes the CIEXYZ(1931) values for the - spectrum of a black body at temperature X. + `temperature->XYZ' computes the unnormalized CIEXYZ(1931) values | + for the spectrum of a black body at temperature X. | Compute the chromaticities of 6500.K and 5000.K blackbody radiation: @@ -7267,36 +7950,33 @@ set is loaded. | (require 'color-space) (XYZ->chromaticity (temperature->XYZ 6500)) => (0.3135191660557008 0.3236456786200268) - + (XYZ->chromaticity (temperature->XYZ 5000)) => (0.34508082841161052 0.3516084965163377) - - Function: temperature->CIEXYZ x + -- Function: temperature->chromaticity x | The positive number X is a temperature in degrees kelvin. - `temperature->CIEXYZ' computes the CIEXYZ(1931) values for the - spectrum of a black body at temperature X, scaled to be just - inside the RGB709 gamut. + `temperature->cromaticity' computes the chromaticity for the | + spectrum of a black body at temperature X. | - - Function: temperature->chromaticity x | - | - - Function: XYZ:normalize xyz - XYZ is a list of three non-negative real numbers. `XYZ:normalize' - returns a list of numbers proportional to XYZ; scaled so their sum - is 1. + Compute the chromaticities of 6500.K and 5000.K blackbody | + radiation: | + + (require 'color-space) | + (temperature->chromaticity 6500) | + => (0.3135191660557008 0.3236456786200268) | - - Function: XYZ:normalize-colors colors ... - COLORS is a list of XYZ triples. `XYZ:normalize-colors' scales - all the triples by a common factor such that the maximum sum of - numbers in a scaled triple is 1. + (temperature->chromaticity 5000) | + => (0.34508082841161052 0.3516084965163377) | - - Function: XYZ->chromaticity xyz + -- Function: XYZ->chromaticity xyz | Returns a two element list: the x and y components of XYZ normalized to 1 (= X + Y + Z). - - Function: chromaticity->CIEXYZ x y + -- Function: chromaticity->CIEXYZ x y | Returns the list of X, and Y, 1 - Y - X. - - Function: chromaticity->whitepoint x y + -- Function: chromaticity->whitepoint x y | Returns the CIEXYZ(1931) values having luminosity 1 and chromaticity X and Y. @@ -7308,18 +7988,18 @@ obvious range. With no given whitepoint, the only reasonable course is to ascertain the luminance range of a dataset and normalize the values to lie from 0 to 1. - - Function: XYZ->xyY xyz + -- Function: XYZ->xyY xyz | Returns a three element list: the X and Y components of XYZ normalized to 1, and CIE luminance Y. - - Function: xyY->XYZ xyY + -- Function: xyY->XYZ xyY | - - Function: xyY:normalize-colors colors + -- Function: xyY:normalize-colors colors | COLORS is a list of xyY triples. `xyY:normalize-colors' scales each chromaticity so it sums to 1 or less; and divides the Y values by the maximum Y in the dataset, so all lie between 0 and 1. - - Function: xyY:normalize-colors colors n + -- Function: xyY:normalize-colors colors n | If N is positive real, then `xyY:normalize-colors' divides the Y values by N times the maximum Y in the dataset. @@ -7342,33 +8022,33 @@ chromaticities with sums greater than one are scaled to sum to one. File: slib.info, Node: Color Difference Metrics, Next: Color Conversions, Prev: Spectra, Up: Color -Color Difference Metrics ------------------------- +5.9.4 Color Difference Metrics | +------------------------------ | -`(require 'color-space)' | - | - The low-level metric functions operate on lists of 3 numbers, lab1, | -lab2, lch1, or lch2. | - | - `(require 'color)' | - | - The wrapped functions operate on objects of type color, color1 and | -color2 in the function entries. | - | - - Function: L*a*b*:DE* lab1 lab2 | - Returns the Euclidean distance between LAB1 and LAB2. | - | - - Function: CIE:DE* color1 color2 white-point - - Function: CIE:DE* color1 color2 +`(require 'color-space)' + + The low-level metric functions operate on lists of 3 numbers, lab1, +lab2, lch1, or lch2. + + `(require 'color)' + + The wrapped functions operate on objects of type color, color1 and +color2 in the function entries. + + -- Function: L*a*b*:DE* lab1 lab2 | + Returns the Euclidean distance between LAB1 and LAB2. + + -- Function: CIE:DE* color1 color2 white-point | + -- Function: CIE:DE* color1 color2 | Returns the Euclidean distance in L*a*b* space between COLOR1 and COLOR2. - - Function: L*C*h:DE*94 lch1 lch2 parametric-factors | - - Function: L*C*h:DE*94 lch1 lch2 | - - Function: CIE:DE*94 color1 color2 parametric-factors - - Function: CIE:DE*94 color1 color2 - Measures distance in the L*C*h cylindrical color-space. The three | - axes are individually scaled (depending on C*) in their | + -- Function: L*C*h:DE*94 lch1 lch2 parametric-factors | + -- Function: L*C*h:DE*94 lch1 lch2 | + -- Function: CIE:DE*94 color1 color2 parametric-factors | + -- Function: CIE:DE*94 color1 color2 | + Measures distance in the L*C*h cylindrical color-space. The three + axes are individually scaled (depending on C*) in their contributions to the total distance. The CIE has defined reference conditions under which the metric @@ -7399,22 +8079,22 @@ Great Britain created a more sophisticated color-distance function for use in judging the consistency of dye lots. With CMC:DE* it is possible to use a single value pass/fail tolerance for all shades. - - Function: CMC-DE lch1 lch2 parametric-factors | - - Function: CMC-DE lch1 lch2 l c | - - Function: CMC-DE lch1 lch2 l | - - Function: CMC-DE lch1 lch2 | - - Function: CMC:DE* color1 color2 l c - - Function: CMC:DE* color1 color2 - `CMC:DE' is a L*C*h metric. The PARAMETRIC-FACTORS argument is a | - list of 2 numbers L and C. L and C parameterize this metric. 1 | - and 1 are recommended for perceptibility; the default, 2 and 1, | + -- Function: CMC-DE lch1 lch2 parametric-factors | + -- Function: CMC-DE lch1 lch2 l c | + -- Function: CMC-DE lch1 lch2 l | + -- Function: CMC-DE lch1 lch2 | + -- Function: CMC:DE* color1 color2 l c | + -- Function: CMC:DE* color1 color2 | + `CMC:DE' is a L*C*h metric. The PARAMETRIC-FACTORS argument is a + list of 2 numbers L and C. L and C parameterize this metric. 1 + and 1 are recommended for perceptibility; the default, 2 and 1, for acceptability. File: slib.info, Node: Color Conversions, Next: Color Names, Prev: Color Difference Metrics, Up: Color -Color Conversions ------------------ +5.9.5 Color Conversions | +----------------------- | This package contains the low-level color conversion and color metric routines operating on lists of 3 numbers. There is no type or range @@ -7422,54 +8102,54 @@ checking. `(require 'color-space)' - - Constant: CIEXYZ:D65 + -- Constant: CIEXYZ:D65 | Is the color of 6500.K (blackbody) illumination. D65 is close to the average color of daylight. - - Constant: CIEXYZ:D50 + -- Constant: CIEXYZ:D50 | Is the color of 5000.K (blackbody) illumination. D50 is the color of indoor lighting by incandescent bulbs. - - Constant: CIEXYZ:A - - Constant: CIEXYZ:B - - Constant: CIEXYZ:C - - Constant: CIEXYZ:E + -- Constant: CIEXYZ:A | + -- Constant: CIEXYZ:B | + -- Constant: CIEXYZ:C | + -- Constant: CIEXYZ:E | CIE 1931 illuminants normalized to 1 = y. - - Function: color:linear-transform matrix row | - | - - Function: CIEXYZ->RGB709 xyz - - Function: RGB709->CIEXYZ srgb + -- Function: color:linear-transform matrix row | + + -- Function: CIEXYZ->RGB709 xyz | + -- Function: RGB709->CIEXYZ srgb | - - Function: CIEXYZ->L*u*v* xyz white-point - - Function: CIEXYZ->L*u*v* xyz - - Function: L*u*v*->CIEXYZ L*u*v* white-point - - Function: L*u*v*->CIEXYZ L*u*v* + -- Function: CIEXYZ->L*u*v* xyz white-point | + -- Function: CIEXYZ->L*u*v* xyz | + -- Function: L*u*v*->CIEXYZ L*u*v* white-point | + -- Function: L*u*v*->CIEXYZ L*u*v* | The WHITE-POINT defaults to CIEXYZ:D65. - - Function: CIEXYZ->L*a*b* xyz white-point - - Function: CIEXYZ->L*a*b* xyz - - Function: L*a*b*->CIEXYZ L*a*b* white-point - - Function: L*a*b*->CIEXYZ L*a*b* + -- Function: CIEXYZ->L*a*b* xyz white-point | + -- Function: CIEXYZ->L*a*b* xyz | + -- Function: L*a*b*->CIEXYZ L*a*b* white-point | + -- Function: L*a*b*->CIEXYZ L*a*b* | The XYZ WHITE-POINT defaults to CIEXYZ:D65. - - Function: L*a*b*->L*C*h L*a*b* - - Function: L*C*h->L*a*b* L*C*h + -- Function: L*a*b*->L*C*h L*a*b* | + -- Function: L*C*h->L*a*b* L*C*h | - - Function: CIEXYZ->sRGB xyz - - Function: sRGB->CIEXYZ srgb + -- Function: CIEXYZ->sRGB xyz | + -- Function: sRGB->CIEXYZ srgb | - - Function: CIEXYZ->xRGB xyz | - - Function: xRGB->CIEXYZ srgb | - | - - Function: sRGB->xRGB xyz | - - Function: xRGB->sRGB srgb | - | - - Function: CIEXYZ->e-sRGB n xyz - - Function: e-sRGB->CIEXYZ n srgb + -- Function: CIEXYZ->xRGB xyz | + -- Function: xRGB->CIEXYZ srgb | + + -- Function: sRGB->xRGB xyz | + -- Function: xRGB->sRGB srgb | - - Function: sRGB->e-sRGB n srgb - - Function: e-sRGB->sRGB n srgb + -- Function: CIEXYZ->e-sRGB n xyz | + -- Function: e-sRGB->CIEXYZ n srgb | + + -- Function: sRGB->e-sRGB n srgb | + -- Function: e-sRGB->sRGB n srgb | The integer N must be 10, 12, or 16. Because sRGB and e-sRGB use the same RGB709 chromaticities, conversion between them is simpler than conversion through CIEXYZ. @@ -7477,23 +8157,23 @@ checking. Do not convert e-sRGB precision through `e-sRGB->sRGB' then `sRGB->e-sRGB' - values would be truncated to 8-bits! - - Function: e-sRGB->e-sRGB n1 srgb n2 + -- Function: e-sRGB->e-sRGB n1 srgb n2 | The integers N1 and N2 must be 10, 12, or 16. `e-sRGB->e-sRGB' converts SRGB to e-sRGB of precision N2. - | + File: slib.info, Node: Color Names, Next: Daylight, Prev: Color Conversions, Up: Color -Color Names ------------ +5.9.6 Color Names | +----------------- | -`(require 'color-names)' +`(require 'color-names)' Rather than ballast the color dictionaries with numbered grays, `file->color-dictionary' discards them. They are provided through the `grey' procedure: - - Function: grey k + -- Function: grey k | Returns `(inexact->exact (round (* k 2.55)))', the X11 color grey<k>. @@ -7503,37 +8183,37 @@ to color-strings (*note External Representation: Color Data-Type.). The column names in a color dictionary are unimportant; the first field is the key, and the second is the color-string. - - Function: color-name:canonicalize name + -- Function: color-name:canonicalize name | Returns a downcased copy of the string or symbol NAME with `_', `-', and whitespace removed. - - Function: color-name->color name table1 table2 ... + -- Function: color-name->color name table1 table2 ... | TABLE1, TABLE2, ... must be color-dictionary tables. `color-name->color' searches for the canonical form of NAME in TABLE1, TABLE2, ... in order; returning the color-string of the first matching record; #f otherwise. - - Function: color-dictionaries->lookup table1 table2 ... + -- Function: color-dictionaries->lookup table1 table2 ... | TABLE1, TABLE2, ... must be color-dictionary tables. `color-dictionaries->lookup' returns a procedure which searches for the canonical form of its string argument in TABLE1, TABLE2, ...; returning the color-string of the first matching record; and #f otherwise. - - Function: color-dictionary name rdb base-table-type + -- Function: color-dictionary name rdb base-table-type | RDB must be a string naming a relational database file; and the symbol NAME a table therein. The database will be opened as BASE-TABLE-TYPE. `color-dictionary' returns the read-only table NAME in database NAME if it exists; #f otherwise. - - Function: color-dictionary name rdb + -- Function: color-dictionary name rdb | RDB must be an open relational database or a string naming a relational database file; and the symbol NAME a table therein. `color-dictionary' returns the read-only table NAME in database NAME if it exists; #f otherwise. - - Function: load-color-dictionary name rdb base-table-type - - Function: load-color-dictionary name rdb + -- Function: load-color-dictionary name rdb base-table-type | + -- Function: load-color-dictionary name rdb | RDB must be a string naming a relational database file; and the symbol NAME a table therein. If the symbol BASE-TABLE-TYPE is provided, the database will be opened as BASE-TABLE-TYPE. @@ -7546,10 +8226,10 @@ is the key, and the second is the color-string. Dictionary Creation ................... -`(require 'color-database)' | - | - - Function: file->color-dictionary file table-name rdb base-table-type - - Function: file->color-dictionary file table-name rdb +`(require 'color-database)' + + -- Function: file->color-dictionary file table-name rdb base-table-type | + -- Function: file->color-dictionary file table-name rdb | RDB must be an open relational database or a string naming a relational database file, TABLE-NAME a symbol, and the string FILE must name an existing file with colornames and their corresponding @@ -7557,8 +8237,8 @@ Dictionary Creation table TABLE-NAME in RDB and enters the associations found in FILE into it. - - Function: url->color-dictionary url table-name rdb base-table-type - - Function: url->color-dictionary url table-name rdb + -- Function: url->color-dictionary url table-name rdb base-table-type | + -- Function: url->color-dictionary url table-name rdb | RDB must be an open relational database or a string naming a relational database file and TABLE-NAME a symbol. `url->color-dictionary' retrieves the resource named by the string @@ -7568,27 +8248,28 @@ Dictionary Creation This section has detailed the procedures for creating and loading color dictionaries. So where are the dictionaries to load? - `http://swissnet.ai.mit.edu/~jaffer/Color/Dictionaries.html' + `http://swiss.csail.mit.edu/~jaffer/Color/Dictionaries.html' | Describes and evaluates several color-name dictionaries on the web. The following procedure creates a database containing two of these dictionaries. - - Function: make-slib-color-name-db + -- Function: make-slib-color-name-db | Creates an alist-table relational database in library-vicinity containing the "Resene" and "saturate" color-name dictionaries. - If the files `resenecolours.txt' and `saturate.txt' exist in the - library-vicinity, then they used as the source of color-name data. - Otherwise, `make-slib-color-name-db' calls url->color-dictionary - with the URLs of appropriate source files. + If the files `resenecolours.txt', `nbs-iscc.txt', and | + `saturate.txt' exist in the library-vicinity, then they used as | + the source of color-name data. Otherwise, | + `make-slib-color-name-db' calls url->color-dictionary with the | + URLs of appropriate source files. | The Short List .............. -`(require 'saturate)' +`(require 'saturate)' - - Function: saturate name + -- Function: saturate name | Looks for NAME among the 19 saturated colors from `Approximate Colors on CIE Chromaticity Diagram': @@ -7598,7 +8279,7 @@ The Short List purplish blue bluish purple purple reddish purple red purple purplish red red - (<http://swissnet.ai.mit.edu/~jaffer/Color/saturate.pdf>). If + (`http://swiss.csail.mit.edu/~jaffer/Color/saturate.pdf'). If | NAME is found, the corresponding color is returned. Otherwise #f is returned. Use saturate only for light source colors. @@ -7606,11 +8287,11 @@ Resene Paints Limited, New Zealand's largest privately-owned and operated paint manufacturing company, has generously made their `Resene RGB Values List' available. - `(require 'resene)' + `(require 'resene)' - - Function: resene name + -- Function: resene name | Looks for NAME among the 1300 entries in the Resene color-name - dictionary (<http://swissnet.ai.mit.edu/~jaffer/Color/resene.pdf>). + dictionary (`http://swiss.csail.mit.edu/~jaffer/Color/resene.pdf'). | If NAME is found, the corresponding color is returned. Otherwise #f is returned. The `Resene RGB Values List' is an excellent source for surface colors. @@ -7634,7 +8315,7 @@ program, then you must include its license with your program: copyright notice in the documentation or other materials provided with the distribution. - 3. Resene Paints Ltd makes no warranty or representation that | + 3. Resene Paints Ltd makes no warranty or representation that this dictionary is error-free, and is under no obligation to provide any services, by way of maintenance, update, or otherwise. @@ -7649,26 +8330,26 @@ program, then you must include its license with your program: File: slib.info, Node: Daylight, Prev: Color Names, Up: Color -Daylight --------- +5.9.7 Daylight | +-------------- | -`(require 'daylight)' +`(require 'daylight)' This package calculates the colors of sky as detailed in: `http://www.cs.utah.edu/vissim/papers/sunsky/sunsky.pdf' `A Practical Analytic Model for Daylight' A. J. Preetham, Peter Shirley, Brian Smits - - Function: solar-hour julian-day hour + -- Function: solar-hour julian-day hour | Returns the solar-time in hours given the integer JULIAN-DAY in the range 1 to 366, and the local time in hours. To be meticulous, subtract 4 minutes for each degree of longitude west of the standard meridian of your time zone. - - Function: solar-declination julian-day + -- Function: solar-declination julian-day | - - Function: solar-polar declination latitude solar-hour + -- Function: solar-polar declination latitude solar-hour | Returns a list of THETA_S, the solar angle from the zenith, and PHI_S, the solar azimuth. 0 <= THETA_S measured in degrees. PHI_S is measured in degrees from due south; west of south being @@ -7706,24 +8387,20 @@ turbidity values less than 1.3. 1 2 4 8 16 32 64 Meterorological range (km) versus Turbidity - - Function: sunlight-spectrum turbidity theta_s + -- Function: sunlight-spectrum turbidity theta_s | Returns a vector of 41 values, the spectrum of sunlight from 380.nm to 790.nm for a given TURBIDITY and THETA_S. - - Function: sunlight-xyz turbidity theta_s - Returns (unnormalized) XYZ values for color of sunlight for a - given TURBIDITY and THETA_S. + -- Function: sunlight-chromaticity turbidity theta_s | + Given TURBIDITY and THETA_S, `sunlight-chromaticity' returns the | + CIEXYZ triple for color of sunlight scaled to be just inside the | + RGB709 gamut. | - - Function: sunlight-ciexyz turbidity theta_s - Given TURBIDITY and THETA_S, `sunlight-ciexyz' returns the CIEXYZ - triple for color of sunlight scaled to be just inside the RGB709 - gamut. - - - Function: zenith-xyy turbidity theta_s + -- Function: zenith-xyy turbidity theta_s | Returns the xyY (chromaticity and luminance) at the zenith. The Luminance has units kcd/m^2. - - Function: overcast-sky-color-xyy turbidity theta_s + -- Function: overcast-sky-color-xyy turbidity theta_s | TURBIDITY is a positive real number expressing the amount of light scattering. The real number THETA_S is the solar angle from the zenith in degrees. @@ -7733,8 +8410,8 @@ turbidity values less than 1.3. and returning the xyY value for light coming from that elevation of the sky. - - Function: clear-sky-color-xyy turbidity theta_s phi_s - - Function: sky-color-xyy turbidity theta_s phi_s + -- Function: clear-sky-color-xyy turbidity theta_s phi_s | + -- Function: sky-color-xyy turbidity theta_s phi_s | TURBIDITY is a positive real number expressing the amount of light scattering. The real number THETA_S is the solar angle from the zenith in degrees. The real number PHI_S is the solar angle from @@ -7751,33 +8428,33 @@ turbidity values less than 1.3. File: slib.info, Node: Root Finding, Next: Minimizing, Prev: Color, Up: Mathematical Packages -Root Finding -============ +5.10 Root Finding | +================= | -`(require 'root)' +`(require 'root)' - - Function: newton:find-integer-root f df/dx x0 + -- Function: newton: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: + To find the closest integer to a given integer's 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 + -- 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 + -- 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)) @@ -7794,7 +8471,7 @@ Polynomials', IEEE Transactions on Circuits and Systems, Vol. 36, No. 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 + -- 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 @@ -7805,7 +8482,7 @@ Polynomials', IEEE Transactions on Circuits and Systems, Vol. 36, No. 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 + -- 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 @@ -7817,8 +8494,8 @@ Polynomials', IEEE Transactions on Circuits and Systems, Vol. 36, No. `laguerre:find-polynomial-root' returns the result of -PREC iterations. - - Function: secant:find-root f x0 x1 prec - - Function: secant:find-bracketed-root f x0 x1 prec + -- Function: secant:find-root f x0 x1 prec | + -- Function: secant:find-bracketed-root f x0 x1 prec | Given a real valued procedure F and two real valued starting points X0 and X1, returns a real X for which `(abs (f x))' is less than PREC; or returns `#f' if such a real can't be found. @@ -7846,10 +8523,10 @@ Polynomials', IEEE Transactions on Circuits and Systems, Vol. 36, No. File: slib.info, Node: Minimizing, Next: Commutative Rings, Prev: Root Finding, Up: Mathematical Packages -Minimizing -========== +5.11 Minimizing | +=============== | -`(require 'minimize)' +`(require 'minimize)' The Golden Section Search (1) algorithm finds minima of functions which are expensive to compute or for which derivatives are not available. @@ -7860,7 +8537,7 @@ If the derivative is available, Newton-Raphson is probably a better choice. If the function is inexpensive to compute, consider approximating the derivative. - - Function: golden-section-search f x0 x1 prec + -- Function: golden-section-search f x0 x1 prec | X_0 are X_1 real numbers. The (single argument) procedure F is unimodal over the open interval (X_0, X_1). That is, there is exactly one point in the interval for which the derivative of F is @@ -7893,27 +8570,27 @@ and Software' Prentice-Hall, 1989, ISBN 0-13-627258-4 File: slib.info, Node: Commutative Rings, Next: Matrix Algebra, Prev: Minimizing, Up: Mathematical Packages -Commutative Rings -================= +5.12 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 one to use basic Scheme numeric functions with symbols and non-numeric elements of commutative rings. - `(require 'commutative-ring)' + `(require 'commutative-ring)' The "commutative-ring" package makes the procedures `+', `-', `*', `/', and `^' "careful" in the sense that any non-numeric arguments they do not 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). +identifiers (to their corresponding symbols). (define a 'a) ... (define z 'z) - Or just `(require 'self-set)'. Now try some sample expressions: + Or just `(require 'self-set)'. Now try some sample expressions: (+ (+ a b) (- a b)) => (* a 2) (* (+ a b) (+ a b)) => (^ (+ a b) 2) @@ -7930,7 +8607,7 @@ multiplication converted to multiplication and exponentiation. We can enable distributive rules, thus expanding to sum of products form: (set! *ruleset* (combined-rulesets distribute* distribute/)) - + (* (+ a b) (+ a b)) => (+ (* 2 a b) (^ a 2) (^ b 2)) (* (+ a b) (- a b)) => (- (^ a 2) (^ b 2)) (* (- a b) (- a b)) => (- (+ (^ a 2) (^ b 2)) (* 2 a b)) @@ -7946,7 +8623,7 @@ form: expressions: (require 'determinant) - + (determinant '((a b c) (d e f) (g h i))) => (- (+ (* a e i) (* b f g) (* c d h)) (* a f h) (* b d i) (* c e g)) @@ -7957,30 +8634,30 @@ expressions are handled similarly. This list might be extended to include `quotient', `modulo', `remainder', `lcm', and `gcd'; but these work only for the more -restrictive Euclidean (Unique Factorization) Domain. +restrictive Euclidean (Unique Factorization) Domain. -Rules and Rulesets -================== +5.13 Rules and Rulesets | +======================= | The "commutative-ring" package allows control of ring properties through the use of "rulesets". - - Variable: *ruleset* + -- Variable: *ruleset* | Contains the set of rules currently in effect. Rules defined by `cring:define-rule' are stored within the value of *ruleset* at the time `cring:define-rule' is called. If *RULESET* is `#f', then no rules apply. - - Function: make-ruleset rule1 ... - - Function: make-ruleset name rule1 ... + -- Function: make-ruleset rule1 ... | + -- Function: make-ruleset name rule1 ... | Returns a new ruleset containing the rules formed by applying `cring:define-rule' to each 4-element list argument RULE. If the first argument to `make-ruleset' is a symbol, then the database table created for the new ruleset will be named NAME. Calling `make-ruleset' with no rule arguments creates an empty ruleset. - - Function: combined-rulesets ruleset1 ... - - Function: combined-rulesets name ruleset1 ... + -- Function: combined-rulesets ruleset1 ... | + -- Function: combined-rulesets name ruleset1 ... | Returns a new ruleset containing the rules contained in each ruleset argument RULESET. If the first argument to `combined-ruleset' is a symbol, then the database table created for @@ -7989,11 +8666,11 @@ through the use of "rulesets". Two rulesets are defined by this package. - - Constant: distribute* + -- Constant: distribute* | Contains the ruleset to distribute multiplication over addition and subtraction. - - Constant: distribute/ + -- Constant: distribute/ | Contains the ruleset to distribute division over addition and subtraction. @@ -8005,14 +8682,14 @@ elements simplify by specifying the rules for `+' or `*' for cases where expressions involving objects reduce to numbers or to expressions involving different non-numeric elements. - - Function: cring:define-rule op sub-op1 sub-op2 reduction + -- Function: cring:define-rule op sub-op1 sub-op2 reduction | Defines a rule for the case when the operation represented by symbol OP is applied to lists whose `car's are SUB-OP1 and SUB-OP2, respectively. The argument REDUCTION is a procedure accepting 2 arguments which will be lists whose `car's are SUB-OP1 and SUB-OP2. - - Function: cring:define-rule op sub-op1 'identity reduction + -- Function: cring:define-rule op sub-op1 'identity reduction | Defines a rule for the case when the operation represented by symbol OP is applied to a list whose `car' is SUB-OP1, and some other argument. REDUCTION will be called with the list whose @@ -8033,8 +8710,8 @@ involving different non-numeric elements. (lambda (exp1 exp2) (apply + (map (lambda (trm) (* trm exp2)) (cdr exp1)))))) -How to Create a Commutative Ring -================================ +5.14 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 @@ -8050,9 +8727,9 @@ symbol whose top-level value is the procedure to create it. ((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))) @@ -8113,7 +8790,7 @@ have _not_ been defined are not changed. (eq? (first list1) (last1 list2))) (butlast (splice list1 list2) 1)) (else (slib:error 'cyclicsplice list1 list2)))) - + (N*N (S a b) (S a b)) => (m a b) Then register the rule for multiplying type N objects by type N @@ -8172,21 +8849,21 @@ objects. File: slib.info, Node: Matrix Algebra, Prev: Commutative Rings, Up: Mathematical Packages -Matrix Algebra -============== +5.15 Matrix Algebra | +=================== | -`(require 'determinant)' +`(require 'determinant)' -A Matrix can be either a list of lists (rows) or an array. As with -linear-algebra texts, this package uses 1-based coordinates. +A Matrix can be either a list of lists (rows) or an array. Unlike | +linear-algebra texts, this package uses 0-based coordinates. | - - Function: matrix->lists matrix + -- Function: matrix->lists matrix | Returns the list-of-lists form of MATRIX. - - Function: matrix->array matrix + -- Function: matrix->array matrix | Returns the (ones-based) array form of MATRIX. - - Function: determinant matrix + -- Function: determinant matrix | MATRIX must be a square matrix. `determinant' returns the determinant of MATRIX. @@ -8194,14 +8871,14 @@ linear-algebra texts, this package uses 1-based coordinates. (determinant '((1 2) (3 4))) => -2 (determinant '((1 2 3) (4 5 6) (7 8 9))) => 0 - - Function: transpose matrix + -- Function: transpose matrix | Returns a copy of MATRIX flipped over the diagonal containing the 1,1 element. - - Function: matrix:product m1 m2 + -- Function: matrix:product m1 m2 | Returns the product of matrices M1 and M2. - - Function: matrix:inverse matrix + -- Function: matrix:inverse matrix | MATRIX must be a square matrix. If MATRIX is singlar, then `matrix:inverse' returns #f; otherwise `matrix:inverse' returns the `matrix:product' inverse of MATRIX. @@ -8209,22 +8886,22 @@ linear-algebra texts, this package uses 1-based coordinates. File: slib.info, Node: Database Packages, Next: Other Packages, Prev: Mathematical Packages, Up: Top -Database Packages -***************** +6 Database Packages | +******************* | * Menu: - | + * Relational Database:: 'relational-database -* Relational Infrastructure:: | +* Relational Infrastructure:: * Weight-Balanced Trees:: 'wt-tree File: slib.info, Node: Relational Database, Next: Relational Infrastructure, Prev: Database Packages, Up: Database Packages - | -Relational Database -=================== -`(require 'relational-database)' +6.1 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 @@ -8232,24 +8909,24 @@ Banks'). An SLIB relational database implementation can be created from any *Note Base Table:: implementation. Why relational database? For motivations and design issues see -`http://swissnet.ai.mit.edu/~jaffer/DBManifesto.html'. +`http://swiss.csail.mit.edu/~jaffer/DBManifesto.html'. | * Menu: -* Using Databases:: 'databases | +* Using Databases:: 'databases * Table Operations:: -* Database Interpolation:: 'database-interpolate | +* Database Interpolation:: 'database-interpolate * Embedded Commands:: 'database-commands -* Database Macros:: 'within-database | +* Database Macros:: 'within-database * Database Browser:: 'database-browse File: slib.info, Node: Using Databases, Next: Table Operations, Prev: Relational Database, Up: Relational Database - | -Using Databases ---------------- -`(require 'databases)' +6.1.1 Using Databases | +--------------------- | + +`(require 'databases)' This enhancement wraps a utility layer on `relational-database' which provides: @@ -8285,58 +8962,58 @@ Database Operations::. Except for `create-database', each procedure will accept either a filename or database procedure for its first argument. - - Function: create-database filename base-table-type - FILENAME should be a string naming a file; or `#f'. | - BASE-TABLE-TYPE must be a symbol naming a feature which can be | - passed to `require'. `create-database' returns a new, open | - relational database (with base-table type BASE-TABLE-TYPE) | - associated with FILENAME, or a new ephemeral database if FILENAME | - is `#f'. | + -- Function: create-database filename base-table-type | + FILENAME should be a string naming a file; or `#f'. + BASE-TABLE-TYPE must be a symbol naming a feature which can be + passed to `require'. `create-database' returns a new, open + relational database (with base-table type BASE-TABLE-TYPE) + associated with FILENAME, or a new ephemeral database if FILENAME + is `#f'. - `create-database' is the only run-time use of require in SLIB | - which crosses module boundaries. When BASE-TABLE-TYPE is | - `require'd by `create-database'; it adds an association of | - BASE-TABLE-TYPE with its "relational-system" procedure to | - MDBM:*DATABASES*. | + `create-database' is the only run-time use of require in SLIB + which crosses module boundaries. When BASE-TABLE-TYPE is + `require'd by `create-database'; it adds an association of + BASE-TABLE-TYPE with its "relational-system" procedure to + MDBM:*DATABASES*. - alist-table is the default base-table type: | - | - (require 'databases) | - (define my-rdb (create-database "my.db" 'alist-table)) | - | -Only `alist-table' and base-table modules which have been `require'd | -will dispatch correctly from the `open-database' procedures. | -Therefore, either pass two arguments to `open-database', or require the | -base-table of your database file uses before calling `open-database' | -with one argument. | - | - - Procedure: open-database! rdb base-table-type | + alist-table is the default base-table type: + + (require 'databases) + (define my-rdb (create-database "my.db" 'alist-table)) + +Only `alist-table' and base-table modules which have been `require'd +will dispatch correctly from the `open-database' procedures. +Therefore, either pass two arguments to `open-database', or require the +base-table of your database file uses before calling `open-database' +with one argument. + + -- Procedure: open-database! rdb base-table-type | Returns _mutable_ open relational database or #f. - - Function: open-database rdb base-table-type + -- Function: open-database rdb base-table-type | Returns an open relational database associated with RDB. The database will be opened with base-table type BASE-TABLE-TYPE). - - Function: open-database rdb + -- Function: open-database rdb | Returns an open relational database associated with RDB. `open-database' will attempt to deduce the correct base-table-type. - - Function: write-database rdb filename + -- Function: write-database rdb filename | Writes the mutable relational-database RDB to FILENAME. - - Function: sync-database rdb + -- Function: sync-database rdb | Writes the mutable relational-database RDB to the filename it was opened with. - - Function: solidify-database rdb + -- Function: solidify-database rdb | Syncs RDB and makes it immutable. - - Function: close-database rdb + -- Function: close-database rdb | RDB will only be closed when the count of `open-database' - `close-database' calls for RDB (and its filename) is 0. `close-database' returns #t if successful; and #f otherwise. - - Function: mdbm:report + -- Function: mdbm:report | Prints a table of open database files. The columns are the base-table type, number of opens, `!' for mutable, the filename, and the lock certificate (if locked). @@ -8346,37 +9023,37 @@ with one argument. | alist-table 003 /usr/local/lib/slib/clrnamdb.scm alist-table 001 ! sdram.db jaffer@aubrey.jaffer.3166:1038628199 -Opening Tables | -.............. | - | - - Function: open-table rdb table-name | - RDB must be a relational database and TABLE-NAME a symbol. | - | - `open-table' returns a "methods" procedure for an existing | - relational table in RDB if it exists and can be opened for | - reading, otherwise returns `#f'. | - | - - Procedure: open-table! rdb table-name | - RDB must be a relational database and TABLE-NAME a symbol. | - | - `open-table!' returns a "methods" procedure for an existing | - relational table in RDB if it exists and can be opened in mutable | - mode, otherwise returns `#f'. | - | +Opening Tables +.............. + + -- Function: open-table rdb table-name | + RDB must be a relational database and TABLE-NAME a symbol. + + `open-table' returns a "methods" procedure for an existing + relational table in RDB if it exists and can be opened for + reading, otherwise returns `#f'. + + -- Procedure: open-table! rdb table-name | + RDB must be a relational database and TABLE-NAME a symbol. + + `open-table!' returns a "methods" procedure for an existing + relational table in RDB if it exists and can be opened in mutable + mode, otherwise returns `#f'. + Defining Tables ............... - - Function: define-domains rdb row5 ... | - Adds the domain rows ROW5 ... to the `*domains-data*' table in | + -- Function: define-domains rdb row5 ... | + Adds the domain rows ROW5 ... to the `*domains-data*' table in RDB. The format of the row is given in *Note Catalog - Representation::. | - | - (define-domains rdb '(permittivity #f complex? c64 #f)) | - | - - Function: add-domain rdb row5 | - Use `define-domains' instead. | - | - - Function: define-tables rdb spec-0 ... + Representation::. + + (define-domains rdb '(permittivity #f complex? c64 #f)) + + -- Function: add-domain rdb row5 | + Use `define-domains' instead. + + -- Function: define-tables rdb spec-0 ... | Adds tables as specified in SPEC-0 ... to the open relational-database RDB. Each SPEC has the form: @@ -8404,12 +9081,12 @@ Defining Tables 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 foreign-key domain will be created for it. | + field table, a foreign-key domain will be created for it. Listing Tables .............. - - Function: list-table-definition rdb table-name + -- Function: list-table-definition rdb table-name | If symbol TABLE-NAME exists in the open relational-database RDB, then returns a list of the table-name, its primary key names and domains, its other key names and domains, and the table's records @@ -8420,57 +9097,57 @@ Listing Tables File: slib.info, Node: Table Operations, Next: Database Interpolation, Prev: Using Databases, Up: Relational Database - | -Table Operations | ----------------- | + +6.1.2 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: | +relational table. A method is retrieved from a table by calling the +table with the symbol name of the operation. For example: - ((plat 'get 'processor) 'djgpp) => i386 | + ((plat 'get 'processor) 'djgpp) => i386 -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. | +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. - - Operation on relational-table: get column-name | - Returns a procedure of arguments KEY1 KEY2 ... which returns the | - value for the COLUMN-NAME column of the row associated with | - primary keys KEY1, KEY2 ... if that row exists in the table, or | - `#f' otherwise. | + -- Operation on relational-table: get column-name | + Returns a procedure of arguments KEY1 KEY2 ... which returns the + value for the COLUMN-NAME column of the row associated with + primary keys KEY1, KEY2 ... if that row exists in the table, or + `#f' otherwise. - ((plat 'get 'processor) 'djgpp) => i386 | - ((plat 'get 'processor) 'be-os) => #f | + ((plat 'get 'processor) 'djgpp) => i386 + ((plat 'get 'processor) 'be-os) => #f -* Menu: | +* Menu: -* Single Row Operations:: | -* Match-Keys:: | -* Multi-Row Operations:: | -* Indexed Sequential Access Methods:: | -* Sequential Index Operations:: | -* Table Administration:: | +* Single Row Operations:: +* Match-Keys:: +* Multi-Row Operations:: +* Indexed Sequential Access Methods:: +* Sequential Index Operations:: +* Table Administration:: File: slib.info, Node: Single Row Operations, Next: Match-Keys, Prev: Table Operations, Up: Table Operations - | -Single Row Operations | -..................... | -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 must not be | -missing. | - | - - Operation on relational-table: row:insert | - 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. | +6.1.2.1 Single Row Operations | +............................. | + +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 must not be +missing. + + -- Operation on relational-table: row:insert | + 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. (define telephone-table-desc - ((my-database 'create-table) 'telephone-table-desc)) | + ((my-database 'create-table) 'telephone-table-desc)) (define ndrp (telephone-table-desc 'row:insert)) (ndrp '(1 #t name #f string)) (ndrp '(2 #f telephone @@ -8483,93 +9160,93 @@ missing. | (string->list d)))) string)) - - Operation on relational-table: row:update | - Returns a procedure of one argument, ROW, which 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. | + -- Operation on relational-table: row:update | + Returns a procedure of one argument, ROW, which 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. - - Operation on relational-table: row:retrieve | + -- Operation on relational-table: row:retrieve | Returns a procedure of arguments KEY1 KEY2 ... which returns the - row associated with primary keys KEY1, KEY2 ... if it exists, or | + row associated with primary keys KEY1, KEY2 ... if it exists, or `#f' otherwise. - ((plat 'row:retrieve) 'linux) => (linux i386 linux gcc) | - ((plat 'row:retrieve) 'multics) => #f | + ((plat 'row:retrieve) 'linux) => (linux i386 linux gcc) + ((plat 'row:retrieve) 'multics) => #f + + -- Operation on relational-table: row:remove | + Returns a procedure of arguments KEY1 KEY2 ... which removes and + returns the row associated with primary keys KEY1, KEY2 ... if it + exists, or `#f' otherwise. + + -- Operation on relational-table: row:delete | + Returns a procedure of arguments KEY1 KEY2 ... which deletes the + row associated with primary keys KEY1, KEY2 ... if it exists. The + value returned is unspecified. - - Operation on relational-table: row:remove | - Returns a procedure of arguments KEY1 KEY2 ... which removes and | - returns the row associated with primary keys KEY1, KEY2 ... if it | - exists, or `#f' otherwise. | - | - - Operation on relational-table: row:delete | - Returns a procedure of arguments KEY1 KEY2 ... which deletes the | - row associated with primary keys KEY1, KEY2 ... if it exists. The | - value returned is unspecified. | - | File: slib.info, Node: Match-Keys, Next: Multi-Row Operations, Prev: Single Row Operations, Up: Table Operations - | -Match-Keys | -.......... | - | -The (optional) MATCH-KEY1 ... 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 MATCH-KEY arguments default to `#f'. | - | -The MATCH-KEY1 ... restrict the actions of the table command to those | -records whose primary keys each satisfy the corresponding MATCH-KEY | -argument. The arguments and their actions are: | - | - `#f' | - The false value matches any key in the corresponding position. | - | - 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 `#f' is not. | - | - other values | - Any other value matches only those keys `equal?' to it. | - | - - Operation on relational-table: get* column-name | + +6.1.2.2 Match-Keys | +.................. | + +The (optional) MATCH-KEY1 ... 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 MATCH-KEY arguments default to `#f'. + +The MATCH-KEY1 ... restrict the actions of the table command to those +records whose primary keys each satisfy the corresponding MATCH-KEY +argument. The arguments and their actions are: + + `#f' + The false value matches any key in the corresponding position. + + 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 `#f' is not. + + other values + Any other value matches only those keys `equal?' to it. + + -- Operation on relational-table: get* column-name | Returns a procedure of optional arguments MATCH-KEY1 ... which returns a list of the values for the specified column for all rows in this table. The optional MATCH-KEY1 ... arguments restrict - actions to a subset of the table. | + actions to a subset of the table. ((plat 'get* 'processor)) => - (i386 i8086 i386 i8086 i386 i386 i8086 m68000 | + (i386 i8086 i386 i8086 i386 i386 i8086 m68000 m68000 m68000 m68000 m68000 powerpc) - + ((plat 'get* 'processor) #f) => - (i386 i8086 i386 i8086 i386 i386 i8086 m68000 | + (i386 i8086 i386 i8086 i386 i386 i8086 m68000 m68000 m68000 m68000 m68000 powerpc) - + (define (a-key? key) (char=? #\a (string-ref (symbol->string key) 0))) - + ((plat 'get* 'processor) a-key?) => (m68000 m68000 m68000 m68000 m68000 powerpc) - + ((plat 'get* 'name) a-key?) => (atari-st-turbo-c atari-st-gcc amiga-sas/c-5.10 amiga-aztec amiga-dice-c aix) File: slib.info, Node: Multi-Row Operations, Next: Indexed Sequential Access Methods, Prev: Match-Keys, Up: Table Operations - | -Multi-Row Operations | -.................... | - - Operation on relational-table: row:retrieve* | +6.1.2.3 Multi-Row Operations | +............................ | + + -- Operation on relational-table: row:retrieve* | Returns a procedure of optional arguments MATCH-KEY1 ... which returns a list of all rows in this table. The optional MATCH-KEY1 - ... arguments restrict actions to a subset of the table. For | - details see *Note Match-Keys::. | + ... arguments restrict actions to a subset of the table. For + details see *Note Match-Keys::. ((plat 'row:retrieve*) a-key?) => ((atari-st-turbo-c m68000 atari turbo-c) @@ -8579,171 +9256,171 @@ Multi-Row Operations | (amiga-dice-c m68000 amiga dice-c) (aix powerpc aix -)) - - Operation on relational-table: row:remove* | + -- Operation on relational-table: row:remove* | Returns a procedure of optional arguments MATCH-KEY1 ... which removes and returns a list of all rows in this table. The optional - MATCH-KEY1 ... arguments restrict actions to a subset of the table. | + MATCH-KEY1 ... arguments restrict actions to a subset of the table. - - Operation on relational-table: row:delete* | + -- Operation on relational-table: row:delete* | Returns a procedure of optional arguments MATCH-KEY1 ... which Deletes all rows from this table. The optional MATCH-KEY1 ... - arguments restrict deletions to a subset of the table. The value | - returned is unspecified. The descriptor table and catalog entry | - for this table are not affected. | + arguments restrict deletions to a subset of the table. The value + returned is unspecified. The descriptor table and catalog entry + for this table are not affected. - - Operation on relational-table: for-each-row | - Returns a procedure of arguments PROC MATCH-KEY1 ... which calls | - PROC with each ROW in this table. The optional MATCH-KEY1 ... | - arguments restrict actions to a subset of the table. For details | - see *Note Match-Keys::. | + -- Operation on relational-table: for-each-row | + Returns a procedure of arguments PROC MATCH-KEY1 ... which calls + PROC with each ROW in this table. The optional MATCH-KEY1 ... + arguments restrict actions to a subset of the table. For details + see *Note Match-Keys::. -Note that `row:insert*' and `row:update*' do _not_ use match-keys. | - | - - Operation on relational-table: row:insert* | +Note that `row:insert*' and `row:update*' do _not_ use match-keys. + + -- Operation on relational-table: row:insert* | Returns a procedure of one argument, ROWS, which adds each row in the list of rows, 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. | + an error is signaled. The value returned is unspecified. - - Operation on relational-table: row:update* | + -- Operation on relational-table: row:update* | Returns a procedure of one argument, ROWS, which adds each row in the list of rows, 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. | + it will be overwritten. The value returned is unspecified. File: slib.info, Node: Indexed Sequential Access Methods, Next: Sequential Index Operations, Prev: Multi-Row Operations, Up: Table Operations - | -Indexed Sequential Access Methods | -................................. | - | -"Indexed Sequential Access Methods" are a way of arranging database | -information so that records can be accessed both by key and by key | -sequence (ordering). "ISAM" is not part of Codd's relational model. | -Hardcore relational programmers might use some least-upper-bound join | -for every row to get them into an order. | - | -Associative memory in B-Trees is an example of a database | -implementation which can support a native key ordering. SLIB's | -`alist-table' implementation uses `sort' to implement | -`for-each-row-in-order', but does not support `isam-next' and | -`isam-prev'. | - | -The multi-primary-key ordering employed by these operations is the | -lexicographic collation of those primary-key fields in their given | -order. For example: | - | - (12 a 34) < (12 a 36) < (12 b 1) < (13 a 0) | - | + +6.1.2.4 Indexed Sequential Access Methods | +......................................... | + +"Indexed Sequential Access Methods" are a way of arranging database +information so that records can be accessed both by key and by key +sequence (ordering). "ISAM" is not part of Codd's relational model. +Hardcore relational programmers might use some least-upper-bound join +for every row to get them into an order. + +Associative memory in B-Trees is an example of a database +implementation which can support a native key ordering. SLIB's +`alist-table' implementation uses `sort' to implement +`for-each-row-in-order', but does not support `isam-next' and +`isam-prev'. + +The multi-primary-key ordering employed by these operations is the +lexicographic collation of those primary-key fields in their given +order. For example: + + (12 a 34) < (12 a 36) < (12 b 1) < (13 a 0) + File: slib.info, Node: Sequential Index Operations, Next: Table Administration, Prev: Indexed Sequential Access Methods, Up: Table Operations - | -Sequential Index Operations | -........................... | - | -The following procedures are individually optional depending on the | -base-table implememtation. If an operation is _not_ supported, then | -calling the table with that operation symbol will return false. | - | - - Operation on relational-table: for-each-row-in-order | + +6.1.2.5 Sequential Index Operations | +................................... | + +The following procedures are individually optional depending on the +base-table implememtation. If an operation is _not_ supported, then +calling the table with that operation symbol will return false. + + -- Operation on relational-table: for-each-row-in-order | Returns a procedure of arguments PROC MATCH-KEY1 ... which calls PROC with each ROW in this table in the (implementation-dependent) - natural, repeatable ordering for rows. The optional MATCH-KEY1 | - ... arguments restrict actions to a subset of the table. For | - details see *Note Match-Keys::. | - - - Operation on relational-table: isam-next | - Returns a procedure of arguments KEY1 KEY2 ... which returns the | - key-list identifying the lowest record higher than KEY1 KEY2 ... | - which is stored in the relational-table; or false if no higher | - record is present. | - - - Operation on relational-table: isam-next column-name | - The symbol COLUMN-NAME names a key field. In the list returned by | - `isam-next', that field, or a field to its left, will be changed. | - This allows one to skip over less significant key fields. | - - - Operation on relational-table: isam-prev | - Returns a procedure of arguments KEY1 KEY2 ... which returns the | - key-list identifying the highest record less than KEY1 KEY2 ... | - which is stored in the relational-table; or false if no lower | - record is present. | - - - Operation on relational-table: isam-prev index | - The symbol COLUMN-NAME names a key field. In the list returned by | - `isam-next', that field, or a field to its left, will be changed. | - This allows one to skip over less significant key fields. | - - For example, if a table has key fields: | - (col1 col2) | - (9 5) | - (9 6) | - (9 7) | - (9 8) | - (12 5) | - (12 6) | - (12 7) | - - Then: | - ((table 'isam-next) '(9 5)) => (9 6) | - ((table 'isam-next 'col2) '(9 5)) => (9 6) | - ((table 'isam-next 'col1) '(9 5)) => (12 5) | - ((table 'isam-prev) '(12 7)) => (12 6) | - ((table 'isam-prev 'col2) '(12 7)) => (12 6) | - ((table 'isam-prev 'col1) '(12 7)) => (9 8) | + natural, repeatable ordering for rows. The optional MATCH-KEY1 + ... arguments restrict actions to a subset of the table. For + details see *Note Match-Keys::. + + -- Operation on relational-table: isam-next | + Returns a procedure of arguments KEY1 KEY2 ... which returns the + key-list identifying the lowest record higher than KEY1 KEY2 ... + which is stored in the relational-table; or false if no higher + record is present. + + -- Operation on relational-table: isam-next column-name | + The symbol COLUMN-NAME names a key field. In the list returned by + `isam-next', that field, or a field to its left, will be changed. + This allows one to skip over less significant key fields. + + -- Operation on relational-table: isam-prev | + Returns a procedure of arguments KEY1 KEY2 ... which returns the + key-list identifying the highest record less than KEY1 KEY2 ... + which is stored in the relational-table; or false if no lower + record is present. + + -- Operation on relational-table: isam-prev column-name | + The symbol COLUMN-NAME names a key field. In the list returned by + `isam-next', that field, or a field to its left, will be changed. + This allows one to skip over less significant key fields. + + For example, if a table has key fields: + (col1 col2) + (9 5) + (9 6) + (9 7) + (9 8) + (12 5) + (12 6) + (12 7) + + Then: + ((table 'isam-next) '(9 5)) => (9 6) + ((table 'isam-next 'col2) '(9 5)) => (9 6) + ((table 'isam-next 'col1) '(9 5)) => (12 5) + ((table 'isam-prev) '(12 7)) => (12 6) + ((table 'isam-prev 'col2) '(12 7)) => (12 6) + ((table 'isam-prev 'col1) '(12 7)) => (9 8) File: slib.info, Node: Table Administration, Prev: Sequential Index Operations, Up: Table Operations - | -Table Administration | -.................... | - | - - Operation on relational-table: column-names | - - Operation on relational-table: column-foreigns | - - Operation on relational-table: column-domains | - - Operation on relational-table: column-types | + +6.1.2.6 Table Administration | +............................ | + + -- Operation on relational-table: column-names | + -- Operation on relational-table: column-foreigns | + -- Operation on relational-table: column-domains | + -- Operation on relational-table: 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. - - Operation on relational-table: primary-limit | + -- Operation on relational-table: primary-limit | Returns the number of primary keys fields in the relations in this table. - - Operation on relational-table: close-table | - Subsequent operations to this table will signal an error. | - | + -- Operation on relational-table: close-table | + Subsequent operations to this table will signal an error. + File: slib.info, Node: Database Interpolation, Next: Embedded Commands, Prev: Table Operations, Up: Relational Database - | -Database Interpolation | ----------------------- -`(require 'database-interpolate)' | +6.1.3 Database Interpolation | +---------------------------- | + +`(require 'database-interpolate)' -Indexed sequential access methods allow finding the keys (having | -associations) closest to a given value. This facilitates the | -interpolation of associations between those in the table. | +Indexed sequential access methods allow finding the keys (having +associations) closest to a given value. This facilitates the +interpolation of associations between those in the table. - - Function: interpolate-from-table table column | - TABLE should be a relational table with one numeric primary key | - field which supports the `isam-prev' and `isam-next' operations. | - COLUMN should be a symbol or exact positive integer designating a | - numerically valued column of TABLE. | + -- Function: interpolate-from-table table column | + TABLE should be a relational table with one numeric primary key + field which supports the `isam-prev' and `isam-next' operations. + COLUMN should be a symbol or exact positive integer designating a + numerically valued column of TABLE. - `interpolate-from-table' calculates and returns a value | - proportionally intermediate between its values in the next and | - previous key records contained in TABLE. For keys larger than all | - the stored keys the value associated with the largest stored key | - is used. For keys smaller than all the stored keys the value | - associated with the smallest stored key is used. | + `interpolate-from-table' calculates and returns a value + proportionally intermediate between its values in the next and + previous key records contained in TABLE. For keys larger than all + the stored keys the value associated with the largest stored key + is used. For keys smaller than all the stored keys the value + associated with the smallest stored key is used. File: slib.info, Node: Embedded Commands, Next: Database Macros, Prev: Database Interpolation, Up: Relational Database - | -Embedded Commands ------------------ + +6.1.4 Embedded Commands | +----------------------- | `(require 'database-commands)' @@ -8786,19 +9463,19 @@ code in the `*commands*' table. File: slib.info, Node: Database Extension, Next: Command Intrinsics, Prev: Embedded Commands, Up: Embedded Commands -Database Extension -.................. +6.1.4.1 Database Extension | +.......................... | - - Function: wrap-command-interface rdb + -- Function: wrap-command-interface rdb | Returns relational database RDB wrapped with additional commands defined in its *commands* table. - - Function: add-command-tables rdb + -- Function: add-command-tables rdb | The relational database RDB must be mutable. ADD-COMMAND-TABLES adds a *command* table to RDB; then returns `(wrap-command-interface RDB)'. - - Function: define-*commands* rdb spec-0 ... + -- Function: define-*commands* rdb spec-0 ... | Adds commands to the `*commands*' table as specified in SPEC-0 ... to the open relational-database RDB. Each SPEC has the form: @@ -8816,8 +9493,8 @@ Database Extension (lambda (<name> <rdb>) <expression1> <expression2> ...) - - Function: open-command-database filename - - Function: open-command-database filename base-table-type + -- Function: open-command-database filename | + -- Function: open-command-database filename base-table-type | Returns an open enhanced 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, @@ -8825,28 +9502,28 @@ Database Extension base-table-type. If the database can not be opened or if it lacks the `*commands*' table, `#f' is returned. - - Function: open-command-database! filename - - Function: open-command-database! filename base-table-type + -- Function: open-command-database! filename | + -- Function: open-command-database! filename base-table-type | Returns _mutable_ open enhanced relational database ... - - Function: open-command-database database + -- Function: open-command-database database | Returns DATABASE if it is an immutable relational database; #f otherwise. - - Function: open-command-database! database + -- Function: open-command-database! database | Returns DATABASE if it is a mutable relational database; #f otherwise. File: slib.info, Node: Command Intrinsics, Next: Define-tables Example, Prev: Database Extension, Up: Embedded Commands -Command Intrinsics -.................. +6.1.4.2 Command Intrinsics | +.......................... | Some commands are defined in all extended relational-databases. The are called just like *Note Database Operations::. - - Operation on relational-database: add-domain domain-row | + -- Operation on relational-database: 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'. @@ -8875,18 +9552,18 @@ called just like *Note Database Operations::. (filename #f #f string #f) (build-whats #f #f symbol #f))) - - Operation on relational-database: delete-domain domain-name | + -- Operation on relational-database: delete-domain domain-name | Removes and returns the DOMAIN-NAME row from the "domains" table. - - Operation on relational-database: domain-checker domain | + -- Operation on relational-database: domain-checker domain | Returns a procedure to check an argument for conformance to domain DOMAIN. File: slib.info, Node: Define-tables Example, Next: The *commands* Table, Prev: Command Intrinsics, Up: Embedded Commands -Define-tables Example -..................... +6.1.4.3 Define-tables Example | +............................. | The following example shows a new database with the name of `foo.db' being created with tables describing processor families and @@ -8901,10 +9578,10 @@ saved and changed to immutable. ((also-ran processor-family)) ((m68000 #f) (m68030 m68000) - (i386 i8086) | - (i8086 #f) | + (i386 i8086) + (i8086 #f) (powerpc #f))) - + '(platform ((name symbol)) ((processor processor-family) @@ -8916,21 +9593,21 @@ saved and changed to immutable. (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 i8086 ms-dos borland-c) | + (borland-c-3.1 i8086 ms-dos borland-c) (djgpp i386 ms-dos gcc) (linux i386 linux gcc) - (microsoft-c i8086 ms-dos microsoft-c) | + (microsoft-c i8086 ms-dos microsoft-c) (os/2-emx i386 os/2 gcc) - (turbo-c-2 i8086 ms-dos turbo-c) | + (turbo-c-2 i8086 ms-dos turbo-c) (watcom-9.0 i386 ms-dos watcom)))) - + (solidify-database my-rdb) File: slib.info, Node: The *commands* Table, Next: Command Service, Prev: Define-tables Example, Up: Embedded Commands -The *commands* Table -.................... +6.1.4.4 The *commands* Table | +............................ | The table `*commands*' in an "enhanced" relational-database has the fields (with domains): @@ -8947,7 +9624,7 @@ 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 ordinal | + PRI index ordinal name symbol arity parameter-arity domain domain @@ -8991,10 +9668,10 @@ shared state with the domain-integrity-rule. File: slib.info, Node: Command Service, Next: Command Example, Prev: The *commands* Table, Up: Embedded Commands -Command Service -............... +6.1.4.5 Command Service | +....................... | - - Function: make-command-server rdb table-name + -- 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 @@ -9044,8 +9721,8 @@ For information about parameters, *Note Parameter lists::. File: slib.info, Node: Command Example, Prev: Command Service, Up: Embedded Commands -Command Example -............... +6.1.4.6 Command Example | +....................... | Here is an example of setting up a command with arguments and parsing those arguments from a `getopt' style argument list (*note Getopt::). @@ -9057,9 +9734,9 @@ those arguments from a `getopt' style argument list (*note Getopt::). (require 'getopt) (require 'fluid-let) (require 'printf) - + (define my-rdb (add-command-tables (create-database #f 'alist-table))) - + (define-tables my-rdb '(foo-params *parameter-columns* @@ -9070,13 +9747,13 @@ those arguments from a `getopt' style argument list (*note Getopt::). (lambda (pl) '()) #f "zero or more symbols") (3 nary1-symbols nary1 symbol (lambda (pl) '(symb)) #f "one or more symbols") - (4 optional-number optional ordinal | + (4 optional-number optional ordinal (lambda (pl) '()) #f "zero or one number") (5 flag boolean boolean (lambda (pl) '(#f)) #f "a boolean flag"))) '(foo-pnames ((name string)) - ((parameter-index ordinal)) | + ((parameter-index ordinal)) (("s" 1) ("single-string" 1) ("n" 2) @@ -9098,7 +9775,7 @@ those arguments from a `getopt' style argument list (*note Getopt::). foo-pnames (lambda (rdb) (lambda args (print args))) "test command arguments")))) - + (define (dbutil:serve-command-line rdb command-table command argv) (set! *argv* (if (vector? argv) (vector->list argv) argv)) ((make-command-server rdb command-table) @@ -9107,7 +9784,7 @@ those arguments from a `getopt' style argument list (*note Getopt::). arities types defaulters dirs aliases) (apply comval (getopt->arglist options positions arities types defaulters dirs aliases))))) - + (define (cmd . opts) (fluid-let ((*optind* 1)) (printf "%-34s => " @@ -9117,7 +9794,7 @@ those arguments from a `getopt' style argument list (*note Getopt::). (force-output) (dbutil:serve-command-line my-rdb 'my-commands 'foo (length opts) opts))) - + (cmd) => ("str" () (symb) () #f) (cmd "-f") => ("str" () (symb) () #t) (cmd "--flag") => ("str" () (symb) () #t) @@ -9144,20 +9821,20 @@ those arguments from a `getopt' style argument list (*note Getopt::). (cmd "-?") -| Usage: cmd [OPTION ARGUMENT ...] ... - + -f, --flag -o, --optional[=]<number> -n, --nary[=]<symbols> ... -N, --nary1[=]<symbols> ... -s, --single[=]<string> - + ERROR: getopt->parameter-list "unrecognized option" "-?" File: slib.info, Node: Database Macros, Next: Database Browser, Prev: Embedded Commands, Up: Relational Database - | -Database Macros ---------------- + +6.1.5 Database Macros | +--------------------- | `(require 'within-database)' @@ -9178,27 +9855,36 @@ emacs: * Menu: +* Within-database:: | * Within-database Example:: - - Function: within-database database statement-1 ... + +File: slib.info, Node: Within-database, Next: Within-database Example, Prev: Database Macros, Up: Database Macros + | +6.1.5.1 Within-database | +....................... | + | + -- Function: within-database database statement-1 ... | `within-database' creates a lexical scope in which the commands `define-table' and `define-command' create tables and `*commands*'-table entries respectively in open relational - database DATABASE. + database DATABASE. The expressions in `within-database' form are | + executed in order. | `within-database' Returns DATABASE. - - Syntax: define-command (<name> <rdb>) "comment" <expression1> + -- Syntax: define-command (<name> <rdb>) "comment" <expression1> | <expression2> ... - - Syntax: define-command (<name> <rdb>) <expression1> <expression2> ... + -- Syntax: define-command (<name> <rdb>) <expression1> <expression2> | + ... | Adds to the `*commands*' table a command <name>: (lambda (<name> <rdb>) <expression1> <expression2> ...) - - Syntax: define-table <name> <descriptor-name> <descriptor-name> + -- Syntax: define-table <name> <descriptor-name> <descriptor-name> | <rows> - - Syntax: define-table <name> <primary-key-fields> <other-fields> + -- Syntax: define-table <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 @@ -9220,23 +9906,50 @@ emacs: 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 foreign-key domain will be created for it. | - - + field table, a foreign-key domain will be created for it. + + + -- Function: add-macro-support database | + The relational database DATABASE must be mutable. | + `add-macro-support' adds a `*macros*' table and `define-macro' | + macro to DATABASE; then DATABASE is returned. | + | + -- Syntax: define-macro (<name> arg1 ...) "comment" <expression1> | + <expression2> ... | + -- Syntax: define-macro (<name> arg1 ...) <expression1> <expression2> | + ... | + Adds a macro <name> to the `*macros*'. | + | + _Note:_ `within-database' creates lexical scope where not only | + `define-command' and `define-table', but every command and macro | + are defined, ie.: | + | + (within-database my-rdb | + (define-command (message rdb) | + (lambda (msg) | + (display "message: ") | + (display msg) | + (newline))) | + (message "Defining FOO...") | + ;; ... defining FOO ... | + (message "Defining BAR...") | + ;; ... defining BAR ... | + ) | + | -File: slib.info, Node: Within-database Example, Prev: Database Macros, Up: Database Macros - -Within-database Example -....................... +File: slib.info, Node: Within-database Example, Prev: Within-database, Up: Database Macros + | +6.1.5.2 Within-database Example | +............................... | Here is an example of `within-database' macros: (require 'within-database) - + (define my-rdb (add-command-tables (create-database "foo.db" 'alist-table))) - + (within-database my-rdb (define-command (*initialize* rdb) "Print Welcome" @@ -9251,8 +9964,8 @@ Here is an example of `within-database' macros: ((also-ran processor-family))) (m68000 #f) (m68030 m68000) - (i386 i8086) | - (i8086 #f) | + (i386 i8086) + (i8086 #f) (powerpc #f)) (define-table (platform ((name symbol)) @@ -9269,627 +9982,627 @@ Here is an example of `within-database' macros: (define-command (get-processor rdb) "Get processor for given platform." (((rdb 'open-table) 'platform #f) 'get 'processor))) - + (close-database my-rdb) - + (set! my-rdb (open-command-database! "foo.db")) -| Welcome - + (my-rdb 'without-documentation) -| without-documentation called - + ((my-rdb 'get-processor) 'amiga-sas/c-5.10) => m68000 - + (close-database my-rdb) File: slib.info, Node: Database Browser, Prev: Database Macros, Up: Relational Database - | -Database Browser | ----------------- -(require 'database-browse) | +6.1.6 Database Browser | +---------------------- | - - Procedure: browse database | - Prints the names of all the tables in DATABASE and sets browse's | - default to DATABASE. | +(require 'database-browse) - - Procedure: browse | - Prints the names of all the tables in the default database. | + -- Procedure: browse database | + Prints the names of all the tables in DATABASE and sets browse's + default to DATABASE. - - Procedure: browse table-name | - For each record of the table named by the symbol TABLE-NAME, | - prints a line composed of all the field values. | + -- Procedure: browse | + Prints the names of all the tables in the default database. - - Procedure: browse pathname | - Opens the database named by the string PATHNAME, prints the names | - of all its tables, and sets browse's default to the database. | + -- Procedure: browse table-name | + For each record of the table named by the symbol TABLE-NAME, + prints a line composed of all the field values. - - Procedure: browse database table-name | - Sets browse's default to DATABASE and prints the records of the | - table named by the symbol TABLE-NAME. | + -- Procedure: browse pathname | + Opens the database named by the string PATHNAME, prints the names + of all its tables, and sets browse's default to the database. + + -- Procedure: browse database table-name | + Sets browse's default to DATABASE and prints the records of the + table named by the symbol TABLE-NAME. + + -- Procedure: browse pathname table-name | + Opens the database named by the string PATHNAME and sets browse's + default to it; `browse' prints the records of the table named by + the symbol TABLE-NAME. - - Procedure: browse pathname table-name | - Opens the database named by the string PATHNAME and sets browse's | - default to it; `browse' prints the records of the table named by | - the symbol TABLE-NAME. | - | File: slib.info, Node: Relational Infrastructure, Next: Weight-Balanced Trees, Prev: Relational Database, Up: Database Packages - | -Relational Infrastructure | -========================= | -* Menu: | +6.2 Relational Infrastructure | +============================= | + +* Menu: -* Base Table:: | -* Catalog Representation:: | -* Relational Database Objects:: | -* Database Operations:: | +* Base Table:: +* Catalog Representation:: +* Relational Database Objects:: +* Database Operations:: File: slib.info, Node: Base Table, Next: Catalog Representation, Prev: Relational Infrastructure, Up: Relational Infrastructure - | -Base Table | ----------- | -A "base-table" is the primitive database layer upon which SLIB | -relational databases are built. At the minimum, it must support the | -types integer, symbol, string, and boolean. The base-table may restrict | -the size of integers, symbols, and strings it supports. | +6.2.1 Base Table | +---------------- | - A base table implementation is available as the value of the | -identifier naming it (eg. ALIST-TABLE) after requiring the symbol of | -that name. | +A "base-table" is the primitive database layer upon which SLIB +relational databases are built. At the minimum, it must support the +types integer, symbol, string, and boolean. The base-table may restrict +the size of integers, symbols, and strings it supports. - - Feature: alist-table | - `(require 'alist-table)' | + A base table implementation is available as the value of the +identifier naming it (eg. ALIST-TABLE) after requiring the symbol of +that name. - Association-list base tables support all Scheme types and are | - suitable for small databases. In order to be retrieved after | - being written to a file, the data stored should include only | - objects which are readable and writeable in the Scheme | - implementation. | + -- Feature: alist-table | + `(require 'alist-table)' - The "alist-table" base-table implementation is included in the | - SLIB distribution. | + Association-list base tables support all Scheme types and are + suitable for small databases. In order to be retrieved after + being written to a file, the data stored should include only + objects which are readable and writeable in the Scheme + implementation. - "WB" is a B-tree database package with SCM interfaces. Being | -disk-based, WB databases readily store and access hundreds of megabytes | -of data. WB comes with two base-table embeddings. | - | - - Feature: wb-table | - `(require 'wb-table)' | - | - `wb-table' supports scheme expressions for keys and values whose | - text representations are less than 255 characters in length. | - *Note wb-table: (wb)wb-table. | - | - - Feature: rwb-isam | - `(require 'rwb-isam)' | - | - "rwb-isam" is a sophisticated base-table implementation built on | - WB and SCM which uses binary numerical formats for key and non-key | - fields. It supports IEEE floating-point and fixed-precision | - integer keys with the correct numerical collation order. | - | - 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. | - | - - Variable: *base-table-implementations* | - To support automatic dispatch for `open-database', each base-table | - module adds an association to *BASE-TABLE-IMPLEMENTATIONS* when | - loaded. This association is the list of the base-table symbol and | - the value returned by `(make-relational-system BASE-TABLE)'. | - | -* Menu: | - | -* The Base:: | -* Base Tables:: | -* Base Field Types:: | -* Composite Keys:: | -* Base Record Operations:: | -* Match Keys:: | -* Aggregate Base Operations:: | -* Base ISAM Operations:: | + The "alist-table" base-table implementation is included in the + SLIB distribution. + + "WB" is a B-tree database package with SCM interfaces. Being +disk-based, WB databases readily store and access hundreds of megabytes +of data. WB comes with two base-table embeddings. + + -- Feature: wb-table | + `(require 'wb-table)' + + `wb-table' supports scheme expressions for keys and values whose + text representations are less than 255 characters in length. + *Note wb-table: (wb)wb-table. + + -- Feature: rwb-isam | + `(require 'rwb-isam)' + + "rwb-isam" is a sophisticated base-table implementation built on + WB and SCM which uses binary numerical formats for key and non-key + fields. It supports IEEE floating-point and fixed-precision + integer keys with the correct numerical collation order. + + 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. + + -- Variable: *base-table-implementations* | + To support automatic dispatch for `open-database', each base-table + module adds an association to *BASE-TABLE-IMPLEMENTATIONS* when + loaded. This association is the list of the base-table symbol and + the value returned by `(make-relational-system BASE-TABLE)'. + +* Menu: + +* The Base:: +* Base Tables:: +* Base Field Types:: +* Composite Keys:: +* Base Record Operations:: +* Match Keys:: +* Aggregate Base Operations:: +* Base ISAM Operations:: File: slib.info, Node: The Base, Next: Base Tables, Prev: Base Table, Up: Base Table - | -The Base | -........ | - -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 my-base (alist-table 'make-base)) | - my-base => *a procedure* | - (define foo (alist-table 'foo)) | - foo => #f | - - - Operation on base-table: 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. | - - - Operation on base-table: 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. | - - - Operation on base-table: 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. | - - - Operation on base-table: 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. | - | - - Operation on base-table: 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. | + +6.2.1.1 The Base | +................ | + +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 my-base (alist-table 'make-base)) + my-base => *a procedure* + (define foo (alist-table 'foo)) + foo => #f + + -- Operation on base-table: 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. + + -- Operation on base-table: 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. + + -- Operation on base-table: 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. + + -- Operation on base-table: 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. + + -- Operation on base-table: 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. File: slib.info, Node: Base Tables, Next: Base Field Types, Prev: The Base, Up: Base Table - | -Base Tables | -........... | - | - - Operation on base-table: make-table lldb key-dimension column-types | - Returns the ordinal 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. | - | - - Operation on base-table: 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. | - | - - Operation on base-table: 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. | - | - - Operation on base-table: catalog-id | - A constant BASE-ID ordinal suitable for passing as a parameter to | - `open-table'. CATALOG-ID will be used as the base table for the | - system catalog. | - | + +6.2.1.2 Base Tables | +................... | + + -- Operation on base-table: make-table lldb key-dimension column-types | + Returns the ordinal 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. + + -- Operation on base-table: 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. + + -- Operation on base-table: 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. + + -- Operation on base-table: catalog-id | + A constant BASE-ID ordinal suitable for passing as a parameter to + `open-table'. CATALOG-ID will be used as the base table for the + system catalog. + File: slib.info, Node: Base Field Types, Next: Composite Keys, Prev: Base Tables, Up: Base Table - | -Base Field Types | -................ | - | - - Operation on base-table: 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', `ordinal', | - `symbol', `string', and `boolean'. | - | - - Operation on base-table: 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 `ordinal', and `symbol'. | - | -An "ordinal" is an exact positive integer. The other types are | -standard Scheme. | - | + +6.2.1.3 Base Field Types | +........................ | + + -- Operation on base-table: 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', `ordinal', + `symbol', `string', and `boolean'. + + -- Operation on base-table: 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 `ordinal', and `symbol'. + +An "ordinal" is an exact positive integer. The other types are +standard Scheme. + File: slib.info, Node: Composite Keys, Next: Base Record Operations, Prev: Base Field Types, Up: Base Table - | -Composite Keys | -.............. | - | - - Operation on base-table: 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?'. | - | - - Operation on base-table: 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?'. | - | - - Operation on base-table: 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 COMPOSITE-KEY. The | - list TYPES must have at least KEY-DIMENSION elements. | - | - - Operation on base-table: 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 COMPOSITE-KEY. | - | + +6.2.1.4 Composite Keys | +...................... | + + -- Operation on base-table: 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?'. + + -- Operation on base-table: 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?'. + + -- Operation on base-table: 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 COMPOSITE-KEY. The + list TYPES must have at least KEY-DIMENSION elements. + + -- Operation on base-table: 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 COMPOSITE-KEY. + File: slib.info, Node: Base Record Operations, Next: Match Keys, Prev: Composite Keys, Up: Base Table - | -Base Record Operations | -...................... | - | -In the following functions, the KEY argument can always be assumed to | -be the value returned by a call to a _keyify_ routine. | - | - - Operation on base-table: 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. | - | - - Operation on base-table: 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. | - | -`make-getter-1' is a new operation. The relational-database module | -works with older base-table implementations by using `make-getter'. | - | - - Operation on base-table: make-getter-1 key-dimension types index | - Returns a procedure which takes arguments HANDLE and KEY. This | - procedure returns the value of the INDEXth field (in the base | - table opened in HANDLE) whose primary key is KEY if it exists, and | - `#f' otherwise. | - | - INDEX must be larger than KEY-DIMENSION. | - | - - Operation on base-table: 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. | - | - - Operation on base-table: delete handle key | - Removes the row associated with KEY from the table opened in | - HANDLE. An unspecified value is returned. | - | + +6.2.1.5 Base Record Operations | +.............................. | + +In the following functions, the KEY argument can always be assumed to +be the value returned by a call to a _keyify_ routine. + + -- Operation on base-table: 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. + + -- Operation on base-table: 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. + +`make-getter-1' is a new operation. The relational-database module +works with older base-table implementations by using `make-getter'. + + -- Operation on base-table: make-getter-1 key-dimension types index | + Returns a procedure which takes arguments HANDLE and KEY. This + procedure returns the value of the INDEXth field (in the base + table opened in HANDLE) whose primary key is KEY if it exists, and + `#f' otherwise. + + INDEX must be larger than KEY-DIMENSION. + + -- Operation on base-table: 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. + + -- Operation on base-table: delete handle key | + Removes the row associated with KEY from the table opened in + HANDLE. An unspecified value is returned. + File: slib.info, Node: Match Keys, Next: Aggregate Base Operations, Prev: Base Record Operations, Up: Base Table - | -Match Keys | -.......... | - | -A MATCH-KEYS argument is a list of length equal to the number of | -primary keys. The MATCH-KEYS restrict the actions of the table command | -to those records whose primary keys all satisfy the corresponding | -element of the MATCH-KEYS list. The elements and their actions are: | - | - `#f' | - The false value matches any key in the corresponding position. | - | - 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 `#f' is not. | - | - other values | - Any other value matches only those keys `equal?' to it. | - | + +6.2.1.6 Match Keys | +.................. | + +A MATCH-KEYS argument is a list of length equal to the number of +primary keys. The MATCH-KEYS restrict the actions of the table command +to those records whose primary keys all satisfy the corresponding +element of the MATCH-KEYS list. The elements and their actions are: + + `#f' + The false value matches any key in the corresponding position. + + 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 `#f' is not. + + other values + Any other value matches only those keys `equal?' to it. + File: slib.info, Node: Aggregate Base Operations, Next: Base ISAM Operations, Prev: Match Keys, Up: Base Table - | -Aggregate Base Operations | -......................... | - | -The KEY-DIMENSION and COLUMN-TYPES arguments are needed to decode the | -composite-keys for matching with MATCH-KEYS. | - | - - Operation on base-table: delete* handle key-dimension column-types | - match-keys | - Removes all rows which satisfy MATCH-KEYS from the table opened in | - HANDLE. An unspecified value is returned. | - | - - Operation on base-table: for-each-key handle procedure key-dimension | - column-types match-keys | - Calls PROCEDURE once with each KEY in the table opened in HANDLE | - which satisfy MATCH-KEYS in an unspecified order. An unspecified | - value is returned. | - | - - Operation on base-table: map-key handle procedure key-dimension | - column-types match-keys | - Returns a list of the values returned by calling PROCEDURE once | - with each KEY in the table opened in HANDLE which satisfy | - MATCH-KEYS in an unspecified order. | - | + +6.2.1.7 Aggregate Base Operations | +................................. | + +The KEY-DIMENSION and COLUMN-TYPES arguments are needed to decode the +composite-keys for matching with MATCH-KEYS. + + -- Operation on base-table: delete* handle key-dimension column-types | + match-keys + Removes all rows which satisfy MATCH-KEYS from the table opened in + HANDLE. An unspecified value is returned. + + -- Operation on base-table: for-each-key handle procedure | + key-dimension column-types match-keys | + Calls PROCEDURE once with each KEY in the table opened in HANDLE + which satisfy MATCH-KEYS in an unspecified order. An unspecified + value is returned. + + -- Operation on base-table: map-key handle procedure key-dimension | + column-types match-keys + Returns a list of the values returned by calling PROCEDURE once + with each KEY in the table opened in HANDLE which satisfy + MATCH-KEYS in an unspecified order. + File: slib.info, Node: Base ISAM Operations, Prev: Aggregate Base Operations, Up: Base Table - | -Base ISAM Operations | -.................... | - | -These operations are optional for a Base-Table implementation. | - | - - Operation on base-table: ordered-for-each-key handle procedure | - key-dimension column-types match-keys | - Calls PROCEDURE once with each KEY in the table opened in HANDLE | - which satisfy MATCH-KEYS in the natural order for the types of the | - primary key fields of that table. An unspecified value is | - returned. | - | - - Operation on base-table: make-nexter handle key-dimension | - column-types index | - Returns a procedure of arguments KEY1 KEY2 ... which returns the | - key-list identifying the lowest record higher than KEY1 KEY2 ... | - which is stored in the base-table and which differs in column | - INDEX or a lower indexed key; or false if no higher record is | - present. | - | - - Operation on base-table: make-prever handle key-dimension | - column-types index | - Returns a procedure of arguments KEY1 KEY2 ... which returns the | - key-list identifying the highest record less than KEY1 KEY2 ... | - which is stored in the base-table and which differs in column | - INDEX or a lower indexed key; or false if no higher record is | - present. | - | + +6.2.1.8 Base ISAM Operations | +............................ | + +These operations are optional for a Base-Table implementation. + + -- Operation on base-table: ordered-for-each-key handle procedure | + key-dimension column-types match-keys + Calls PROCEDURE once with each KEY in the table opened in HANDLE + which satisfy MATCH-KEYS in the natural order for the types of the + primary key fields of that table. An unspecified value is + returned. + + -- Operation on base-table: make-nexter handle key-dimension | + column-types index + Returns a procedure of arguments KEY1 KEY2 ... which returns the + key-list identifying the lowest record higher than KEY1 KEY2 ... + which is stored in the base-table and which differs in column + INDEX or a lower indexed key; or false if no higher record is + present. + + -- Operation on base-table: make-prever handle key-dimension | + column-types index + Returns a procedure of arguments KEY1 KEY2 ... which returns the + key-list identifying the highest record less than KEY1 KEY2 ... + which is stored in the base-table and which differs in column + INDEX or a lower indexed key; or false if no higher record is + present. + File: slib.info, Node: Catalog Representation, Next: Relational Database Objects, Prev: Base Table, Up: Relational Infrastructure - | -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. | - | -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> | - | + +6.2.2 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. + +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: Relational Database Objects, Next: Database Operations, Prev: Catalog Representation, Up: Relational Infrastructure - | -Relational Database Objects | ---------------------------- | - | -This object-oriented interface is deprecated for typical database | -applications; *Note Using Databases:: provides an application programmer | -interface which is easier to understand and use. | - | - - 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'. | - | - - Operation on relational-system: 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:: | - | - - Operation on relational-system: 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. | - | + +6.2.3 Relational Database Objects | +--------------------------------- | + +This object-oriented interface is deprecated for typical database +applications; *Note Using Databases:: provides an application programmer +interface which is easier to understand and use. + + -- 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'. + + -- Operation on relational-system: 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:: + + -- Operation on relational-system: 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: Database Operations, Prev: Relational Database Objects, Up: Relational Infrastructure - | -Database Operations | -------------------- | - | -This object-oriented interface is deprecated for typical database | -applications; *Note Using Databases:: provides an application programmer | -interface which is easier to understand and use. | - | -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)) | - | - - Operation on relational-database: 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. | - | - - Operation on relational-database: 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. | - | - - Operation on relational-database: sync-database | - Causes any pending updates to the database file to be written out. | - If the operations completed successfully, `#t' is returned. | - Otherwise, `#f' is returned. | - | - - Operation on relational-database: solidify-database | - Causes any pending updates to the database file to be written out. | - If the writes completed successfully, then the database is | - changed to be immutable and `#t' is returned. Otherwise, `#f' is | - returned. | - | - - Operation on relational-database: table-exists? table-name | - Returns `#t' if TABLE-NAME exists in the system catalog, otherwise | - returns `#f'. | - | - - Operation on relational-database: 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 mutable databases. | - | - - Operation on relational-database: 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. | - | - - Operation on relational-database: 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::. | - | - - Operation on relational-database: 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'. | - | - - Operation on relational-database: create-view ?? | - - Operation on relational-database: project-table ?? | - - Operation on relational-database: restrict-table ?? | - - Operation on relational-database: cart-prod-tables ?? | - Not yet implemented. | - | + +6.2.4 Database Operations | +------------------------- | + +This object-oriented interface is deprecated for typical database +applications; *Note Using Databases:: provides an application programmer +interface which is easier to understand and use. + +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)) + + -- Operation on relational-database: 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. + + -- Operation on relational-database: 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. + + -- Operation on relational-database: sync-database | + Causes any pending updates to the database file to be written out. + If the operations completed successfully, `#t' is returned. + Otherwise, `#f' is returned. + + -- Operation on relational-database: solidify-database | + Causes any pending updates to the database file to be written out. + If the writes completed successfully, then the database is + changed to be immutable and `#t' is returned. Otherwise, `#f' is + returned. + + -- Operation on relational-database: table-exists? table-name | + Returns `#t' if TABLE-NAME exists in the system catalog, otherwise + returns `#f'. + + -- Operation on relational-database: 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 mutable databases. + + -- Operation on relational-database: 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. + + -- Operation on relational-database: 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::. + + -- Operation on relational-database: 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'. + + -- Operation on relational-database: create-view ?? | + -- Operation on relational-database: project-table ?? | + -- Operation on relational-database: restrict-table ?? | + -- Operation on relational-database: cart-prod-tables ?? | + Not yet implemented. + File: slib.info, Node: Weight-Balanced Trees, Prev: Relational Infrastructure, Up: Database Packages - | -Weight-Balanced Trees -===================== -`(require 'wt-tree)' +6.3 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 @@ -9956,7 +10669,7 @@ based on interpreting the trees as sets, hence the name To use weight balanced trees, execute (load-option 'wt-tree) - + once before calling any of the procedures defined here. * Menu: @@ -9969,8 +10682,8 @@ once before calling any of the procedures defined here. 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 -------------------------------------- +6.3.1 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 @@ -9984,7 +10697,7 @@ 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<? + -- 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': @@ -10004,33 +10717,33 @@ used many times throughout the program's execution. tree operations must all be created with a tree type originating from the same call to `make-wt-tree-type'. - - variable+: number-wt-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 + -- 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 + -- 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 + -- 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 + -- 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: @@ -10046,23 +10759,23 @@ used many times throughout the program's execution. 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 ------------------------------------------ +6.3.2 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/empty? wt-tree + + -- procedure+: wt-tree/empty? wt-tree | Returns `#t' if WT-TREE contains no associations, otherwise returns `#f'. - - procedure+: wt-tree/size wt-tree + -- 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 + -- 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 @@ -10070,34 +10783,34 @@ number of associations in a tree. proportional to the logarithm of the number of associations in WT-TREE. - - procedure+: wt-tree/add! wt-tree key datum + -- 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 + -- 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 + -- 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 + -- 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 + -- 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 @@ -10106,28 +10819,28 @@ number of associations in a 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 --------------------------------------------- +6.3.3 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 + -- 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 + -- 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 + -- 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 @@ -10140,7 +10853,7 @@ associations. 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 + -- 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 @@ -10151,7 +10864,7 @@ associations. 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 + -- 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 @@ -10161,7 +10874,7 @@ associations. 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 + -- 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 @@ -10176,7 +10889,7 @@ associations. required by this operation is proportional to the size of WT-TREE-1. - - procedure+: wt-tree/set-equal? wt-tree-1 wt-tree-2 + -- 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_. @@ -10193,7 +10906,7 @@ associations. 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 + -- 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 @@ -10214,7 +10927,7 @@ associations. 0 WT-TREE) - - procedure+: wt-tree/for-each action 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 @@ -10230,17 +10943,17 @@ associations. 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 --------------------------------------------- +6.3.4 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 + -- 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' @@ -10258,10 +10971,10 @@ determined, both in logarthmic time. 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 + -- 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 @@ -10269,9 +10982,9 @@ determined, both in logarthmic time. 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 + -- 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 @@ -10286,7 +10999,7 @@ determined, both in logarthmic time. (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 + -- 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. @@ -10296,7 +11009,7 @@ determined, both in logarthmic time. (wt-tree/delete WT-TREE (wt-tree/min WT-TREE)) - - procedure+: wt-tree/delete-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 @@ -10308,8 +11021,8 @@ determined, both in logarthmic time. File: slib.info, Node: Other Packages, Next: About SLIB, Prev: Database Packages, Up: Top -Other Packages -************** +7 Other Packages | +**************** | * Menu: @@ -10319,13 +11032,13 @@ Other Packages * Standards Support:: Support for Scheme Standards. * Session Support:: REPL and Debugging. * System Interface:: 'system, 'getenv, and other programs. -* Extra-SLIB Packages:: Outside the envelope. | +* Extra-SLIB Packages:: Outside the envelope. File: slib.info, Node: Data Structures, Next: Sorting and Searching, Prev: Other Packages, Up: Other Packages -Data Structures -=============== +7.1 Data Structures | +=================== | * Menu: @@ -10334,7 +11047,7 @@ Data Structures * Array Mapping:: 'array-for-each * Association Lists:: 'alist * Byte:: 'byte -* Byte/Number Conversions:: 'byte-number | +* Byte/Number Conversions:: 'byte-number * MAT-File Format:: 'matfile * Portable Image Files:: 'pnm * Collections:: 'collect @@ -10348,122 +11061,79 @@ Data Structures File: slib.info, Node: Arrays, Next: Subarrays, Prev: Data Structures, Up: Data Structures -Arrays ------- +7.1.1 Arrays | +------------ | -`(require 'array)' +`(require 'array)' or `(require 'srfi-63)' | - - Function: array? obj + -- Function: array? obj | Returns `#t' if the OBJ is an array, and `#f' if not. -_Note:_ Arrays are not disjoint from other Scheme types. Strings and -vectors also satisfy `array?'. A disjoint array predicate can be -written: +_Note:_ Arrays are not disjoint from other Scheme types. Vectors and | +possibly strings also satisfy `array?'. A disjoint array predicate can | +be written: | (define (strict-array? obj) (and (array? obj) (not (string? obj)) (not (vector? obj)))) - - Function: array=? array1 array2 - Returns `#t' if ARRAY1 and ARRAY2 have the same rank and shape and - the corresponding elements of ARRAY1 and ARRAY2 are `equal?'. - - (array=? (create-array '#(foo) 3 3) - (create-array '#(foo) '(0 2) '(0 2))) - => #t - - - Function: create-array prototype bound1 bound2 ... - Creates and returns an array of type PROTOTYPE with dimensions - BOUND1, BOUND2, ... and filled with elements from PROTOTYPE. - PROTOTYPE must be an array, vector, or string. The - implementation-dependent type of the returned array will be the - same as the type of PROTOTYPE; except if that would be a vector or - string with non-zero origin, in which case some variety of array - will be returned. - - If the PROTOTYPE has no elements, then the initial contents of the - returned array are unspecified. Otherwise, the returned array - will be filled with the element at the origin of PROTOTYPE. - -These functions return a prototypical uniform-array enclosing the | -optional argument (which must be of the correct type). If the | -uniform-array type is supported by the implementation, then it is | -returned; defaulting to the next larger precision type; resorting | -finally to vector. | - - - Function: ac64 z - - Function: ac64 - Returns a high-precision complex uniform-array prototype. - - - Function: ac32 z - - Function: ac32 - Returns a complex uniform-array prototype. - - - Function: ar64 x - - Function: ar64 - Returns a high-precision real uniform-array prototype. - - - Function: ar32 x - - Function: ar32 - Returns a real uniform-array prototype. - - - Function: as64 n - - Function: as64 - Returns an exact signed integer uniform-array prototype with at - least 64 bits of precision. - - - Function: as32 n - - Function: as32 - Returns an exact signed integer uniform-array prototype with at - least 32 bits of precision. - - - Function: as16 n - - Function: as16 - Returns an exact signed integer uniform-array prototype with at - least 16 bits of precision. - - - Function: as8 n - - Function: as8 - Returns an exact signed integer uniform-array prototype with at - least 8 bits of precision. - - - Function: au64 k - - Function: au64 - Returns an exact non-negative integer uniform-array prototype with - at least 64 bits of precision. - - - Function: au32 k - - Function: au32 - Returns an exact non-negative integer uniform-array prototype with - at least 32 bits of precision. - - - Function: au16 k - - Function: au16 - Returns an exact non-negative integer uniform-array prototype with - at least 16 bits of precision. - - - Function: au8 k - - Function: au8 - Returns an exact non-negative integer uniform-array prototype with - at least 8 bits of precision. - - - Function: at1 bool - - Function: at1 - Returns a boolean uniform-array prototype. - -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 - - (create-array '#(foo) 3 3) == (create-array '#(foo) '(0 2) '(0 2)) - - - Function: make-shared-array array mapper bound1 bound2 ... + -- Function: equal? obj1 obj2 | + Returns `#t' if OBJ1 and OBJ2 have the same rank and dimensions | + and the corresponding elements of OBJ1 and OBJ2 are `equal?'. | + + `equal?' recursively compares the contents of pairs, vectors, | + strings, and _arrays_, applying `eqv?' on other objects such as | + numbers and symbols. A rule of thumb is that objects are | + generally `equal?' if they print the same. `equal?' may fail to | + terminate if its arguments are circular data structures. | + + (equal? 'a 'a) => #t | + (equal? '(a) '(a)) => #t | + (equal? '(a (b) c) | + '(a (b) c)) => #t | + (equal? "abc" "abc") => #t | + (equal? 2 2) => #t | + (equal? (make-vector 5 'a) | + (make-vector 5 'a)) => #t | + (equal? (make-array (A:fixN32b 4) 5 3) | + (make-array (A:fixN32b 4) 5 3)) => #t | + (equal? (make-array '#(foo) 3 3) | + (make-array '#(foo) 3 3)) => #t | + (equal? (lambda (x) x) | + (lambda (y) y)) => _unspecified_ | + + -- Function: array-rank obj | + Returns the number of dimensions of OBJ. If OBJ is not an array, | + 0 is returned. | + + -- Function: array-dimensions array | + Returns a list of dimensions. | + + (array-dimensions (make-array '#() 3 5)) | + => (3 5) | + + -- Function: make-array prototype k1 ... | + Creates and returns an array of type PROTOTYPE with dimensions K1, | + ... and filled with elements from PROTOTYPE. PROTOTYPE must be | + an array, vector, or string. The implementation-dependent type of | + the returned array will be the same as the type of PROTOTYPE; | + except if that would be a vector or string with rank not equal to | + one, in which case some variety of array will be returned. | + + If the PROTOTYPE has no elements, then the initial contents of the | + returned array are unspecified. Otherwise, the returned array | + will be filled with the element at the origin of PROTOTYPE. | + + -- Function: create-array prototype k1 ... | + `create-array' is an alias for `make-array'. | + + -- Function: make-shared-array array mapper k1 ... | `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 (create-array '#(#f) 8 8)) + (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) @@ -10475,42 +11145,167 @@ a single integer. So (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: list->array rank proto list | + LIST must be a rank-nested list consisting of all the elements, in | + row-major order, of the array to be created. | - - Function: array-shape array - Returns a list of inclusive bounds. + `list->array' returns an array of rank RANK and type PROTO | + consisting of all the elements, in row-major order, of LIST. When | + RANK is 0, LIST is the lone array element; not necessarily a list. | - (array-shape (create-array '#() 3 5)) - => ((0 2) (0 4)) + (list->array 2 '#() '((1 2) (3 4))) | + => #2A((1 2) (3 4)) | + (list->array 0 '#() 3) | + => #0A 3 | - - Function: array-dimensions array - `array-dimensions' is similar to `array-shape' but replaces - elements with a 0 minimum with one greater than the maximum. + -- Function: array->list array | + Returns a rank-nested list consisting of all the elements, in | + row-major order, of ARRAY. In the case of a rank-0 array, | + `array->list' returns the single element. | - (array-dimensions (create-array '#() 3 5)) - => (3 5) + (array->list #2A((ho ho ho) (ho oh oh))) | + => ((ho ho ho) (ho oh oh)) | + (array->list #0A ho) | + => ho | - - Function: array-in-bounds? array index1 index2 ... + -- Function: vector->array vect proto dim1 ... | + VECT must be a vector of length equal to the product of exact | + nonnegative integers DIM1, .... | + | + `vector->array' returns an array of type PROTO consisting of all | + the elements, in row-major order, of VECT. In the case of a | + rank-0 array, VECT has a single element. | + | + (vector->array #(1 2 3 4) #() 2 2) | + => #2A((1 2) (3 4)) | + (vector->array '#(3) '#()) | + => #0A 3 | + | + -- Function: array->vector array | + Returns a new vector consisting of all the elements of ARRAY in | + row-major order. | + | + (array->vector #2A ((1 2)( 3 4))) | + => #(1 2 3 4) | + (array->vector #0A ho) | + => #(ho) | + | + -- Function: array-in-bounds? array index1 ... | Returns `#t' if its arguments would be acceptable to `array-ref'. - - Function: array-ref array index1 index2 ... - Returns the (INDEX1, INDEX2, ...) element of ARRAY. + -- Function: array-ref array k1 ... | + Returns the (K1, ...) element of ARRAY. | - - Procedure: array-set! array obj index1 index2 ... | - Stores OBJ in the (INDEX1, INDEX2, ...) element of ARRAY. The - value returned by `array-set!' is unspecified. + -- Procedure: array-set! array obj k1 ... | + Stores OBJ in the (K1, ...) element of ARRAY. The value returned | + by `array-set!' is unspecified. | + | +These functions return a prototypical uniform-array enclosing the | +optional argument (which must be of the correct type). If the | +uniform-array type is supported by the implementation, then it is | +returned; defaulting to the next larger precision type; resorting | +finally to vector. | + | + -- Function: a:floc128b z | + -- Function: a:floc128b | + Returns an inexact 128.bit flonum complex uniform-array prototype. | + | + -- Function: a:floc64b z | + -- Function: a:floc64b | + Returns an inexact 64.bit flonum complex uniform-array prototype. | + | + -- Function: a:floc32b z | + -- Function: a:floc32b | + Returns an inexact 32.bit flonum complex uniform-array prototype. | + | + -- Function: a:floc16b z | + -- Function: a:floc16b | + Returns an inexact 16.bit flonum complex uniform-array prototype. | + | + -- Function: a:flor128b z | + -- Function: a:flor128b | + Returns an inexact 128.bit flonum real uniform-array prototype. | + | + -- Function: a:flor64b z | + -- Function: a:flor64b | + Returns an inexact 64.bit flonum real uniform-array prototype. | + | + -- Function: a:flor32b z | + -- Function: a:flor32b | + Returns an inexact 32.bit flonum real uniform-array prototype. | + | + -- Function: a:flor16b z | + -- Function: a:flor16b | + Returns an inexact 16.bit flonum real uniform-array prototype. | + | + -- Function: a:flor128b z | + -- Function: a:flor128b | + Returns an exact 128.bit decimal flonum rational uniform-array | + prototype. | + | + -- Function: a:flor64b z | + -- Function: a:flor64b | + Returns an exact 64.bit decimal flonum rational uniform-array | + prototype. | + | + -- Function: a:flor32b z | + -- Function: a:flor32b | + Returns an exact 32.bit decimal flonum rational uniform-array | + prototype. | + | + -- Function: a:fixz64b n | + -- Function: a:fixz64b | + Returns an exact binary fixnum uniform-array prototype with at | + least 64 bits of precision. | + | + -- Function: a:fixz32b n | + -- Function: a:fixz32b | + Returns an exact binary fixnum uniform-array prototype with at | + least 32 bits of precision. | + | + -- Function: a:fixz16b n | + -- Function: a:fixz16b | + Returns an exact binary fixnum uniform-array prototype with at | + least 16 bits of precision. | + | + -- Function: a:fixz8b n | + -- Function: a:fixz8b | + Returns an exact binary fixnum uniform-array prototype with at | + least 8 bits of precision. | + | + -- Function: a:fixn64b k | + -- Function: a:fixn64b | + Returns an exact non-negative binary fixnum uniform-array | + prototype with at least 64 bits of precision. | + | + -- Function: a:fixn32b k | + -- Function: a:fixn32b | + Returns an exact non-negative binary fixnum uniform-array | + prototype with at least 32 bits of precision. | + | + -- Function: a:fixn16b k | + -- Function: a:fixn16b | + Returns an exact non-negative binary fixnum uniform-array | + prototype with at least 16 bits of precision. | + | + -- Function: a:fixn8b k | + -- Function: a:fixn8b | + Returns an exact non-negative binary fixnum uniform-array | + prototype with at least 8 bits of precision. | + | + -- Function: a:bool bool | + -- Function: a:bool | + Returns a boolean uniform-array prototype. | File: slib.info, Node: Subarrays, Next: Array Mapping, Prev: Arrays, Up: Data Structures -Subarrays ---------- +7.1.2 Subarrays | +--------------- | -`(require 'subarray)' +`(require 'subarray)' - - Function: subarray array select ... + -- Function: subarray array select ... | selects a subset of an array. For ARRAY of rank n, there must be at least n SELECTS arguments. For 0 <= j < n, SELECTSj is either an integer, a list of two integers within the range for the jth @@ -10542,26 +11337,10 @@ Subarrays > (subarray ra #f '(1 2)) #2A((b c) (e f)) - - Function: subarray0 array select ... - Behaves like subarray, but aligns the returned array origin to 0 - .... - - - Function: array-align array coord ... - Returns an array shared with ARRAY but with a different origin. - The COORDS are the exact integer coordinates of the new origin. - Indexes corresponding to missing or #f coordinates are not - realigned. + -- Variable: subarray0 | + Legacy alias for subarray. | - For example: - (define ra2 (create-array '#(5) '(5 9) '(-4 0))) - (array-shape ra2) => ((5 9) (-4 0)) - (array-shape (array-align ra2 0 0)) => ((0 4) (0 4)) - (array-shape (array-align ra2 0)) => ((0 4) (-4 0)) - (array-shape (array-align ra2)) => ((5 9) (-4 0)) - (array-shape (array-align ra2 0 #f)) => ((0 4) (-4 0)) - (array-shape (array-align ra2 #f 0)) => ((5 9) (0 4)) - - - Function: array-trim array trim ... + -- Function: array-trim array trim ... | Returns a subarray sharing contents with ARRAY except for slices removed from either side of each dimension. Each of the TRIMS is an exact integer indicating how much to trim. A positive S trims @@ -10570,33 +11349,25 @@ Subarrays lower bound. For example: - (array-trim '#(0 1 2 3 4) 1) => #1A(1 2 3 4) ;; shape is ((0 3)) - (array-trim '#(0 1 2 3 4) -1) => #1A(0 1 2 3) ;; shape is ((1 4)) - + (array-trim '#(0 1 2 3 4) 1) => #1A(1 2 3 4) | + (array-trim '#(0 1 2 3 4) -1) => #1A(0 1 2 3) | + (require 'array-for-each) (define (centered-difference ra) - (array-map - (array-trim ra 1) (array-trim ra -1))) - (define (forward-difference ra) - (array-map - (array-trim ra 1) ra)) - (define (backward-difference ra) - (array-map - ra (array-trim ra -1))) - + (array-map ra - (array-trim ra 1) (array-trim ra -1))) | + (centered-difference '#(0 1 3 5 9 22)) - => #1A(3 4 6 17) ;;shape is ((1 4)) - (backward-difference '#(0 1 3 5 9 22)) - => #1A(1 2 2 4 13) ;; shape is ((1 5)) - (forward-difference '#(0 1 3 5 9 22)) - => #(1 2 2 4 13) ;; shape is ((0 4)) + => #(1 2 2 4 13) | File: slib.info, Node: Array Mapping, Next: Association Lists, Prev: Subarrays, Up: Data Structures -Array Mapping -------------- +7.1.3 Array Mapping | +------------------- | -`(require 'array-for-each)' +`(require 'array-for-each)' - - Procedure: array-map! array0 proc array1 ... | + -- Procedure: 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 @@ -10604,31 +11375,31 @@ Array Mapping corresponding element in ARRAY0. The value returned is unspecified. The order of application is unspecified. - - Function: array-map prototype proc array1 array2 ... | - ARRAY2, ... must have the same number of dimensions as ARRAY1 and | - have a range for each index which includes the range for the | - corresponding index in ARRAY1. PROC is applied to each tuple of | - elements of ARRAY1, ARRAY2, ... and the result is stored as the | - corresponding element in a new array of type PROTOTYPE. The new | - array is returned. The order of application is unspecified. | - | - - Function: array-for-each proc array0 ... | + -- Function: array-map prototype proc array1 array2 ... | + ARRAY2, ... must have the same number of dimensions as ARRAY1 and + have a range for each index which includes the range for the + corresponding index in ARRAY1. PROC is applied to each tuple of + elements of ARRAY1, ARRAY2, ... and the result is stored as the + corresponding element in a new array of type PROTOTYPE. The new + array is returned. 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 | + -- 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)). - - Procedure: array-index-map! array proc | + -- Procedure: array-index-map! array proc | applies PROC to the indices of each element of ARRAY in turn, storing the result in the corresponding element. The value returned and the order of application are unspecified. One can implement ARRAY-INDEXES as (define (array-indexes array) - (let ((ra (apply create-array '#() (array-shape array)))) + (let ((ra (apply make-array '#() (array-dimensions array)))) | (array-index-map! ra (lambda x x)) ra)) Another example: @@ -10637,7 +11408,7 @@ Array Mapping (array-index-map! v (lambda (i) i)) v)) - - Procedure: array-copy! source destination | + -- Procedure: array:copy! destination source | 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. @@ -10646,10 +11417,10 @@ Array Mapping File: slib.info, Node: Association Lists, Next: Byte, Prev: Array Mapping, Up: Data Structures -Association Lists ------------------ +7.1.4 Association Lists | +----------------------- | -`(require 'alist)' +`(require 'alist)' Alist functions provide utilities for treating a list of key-value pairs as an associative database. These functions take an equality @@ -10659,18 +11430,18 @@ 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: 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 + -- 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 + -- 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 @@ -10681,7 +11452,7 @@ tables for improved performance. (define alist '()) (set! alist (put alist "Foo" 9)) - - Function: alist-remover pred + -- 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 @@ -10690,302 +11461,302 @@ tables for improved performance. (define rem (alist-remover string-ci=?)) (set! alist (rem alist "foo")) - - Function: alist-map proc alist + -- 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 + -- 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: Byte, Next: Byte/Number Conversions, Prev: Association Lists, Up: Data Structures - | -Byte ----- -`(require 'byte)' +7.1.5 Byte | +---------- | + +`(require 'byte)' 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 "byte". +character sets. These functions abstract the notion of a "byte". - - Function: byte-ref bytes k + -- Function: byte-ref bytes k | K must be a valid index of BYTES. `byte-ref' returns byte K of BYTES using zero-origin indexing. - - Procedure: byte-set! bytes k byte - K must be a valid index of BYTES, and BYTE must be a small | - nonnegative integer. `byte-set!' stores BYTE in element K of | - BYTES and returns an unspecified value. | - | - - Function: make-bytes k byte - - Function: make-bytes k | - `make-bytes' returns a newly allocated byte-array of length K. If | + -- Procedure: byte-set! bytes k byte | + K must be a valid index of BYTES, and BYTE must be a small + nonnegative integer. `byte-set!' stores BYTE in element K of + BYTES and returns an unspecified value. + + -- Function: make-bytes k byte | + -- Function: make-bytes k | + `make-bytes' returns a newly allocated byte-array of length K. If BYTE is given, then all elements of the byte-array are initialized to BYTE, otherwise the contents of the byte-array are unspecified. - - Function: bytes-length bytes + -- Function: bytes-length bytes | `bytes-length' returns length of byte-array BYTES. - - Function: bytes byte ... - Returns a newly allocated byte-array composed of the small | - nonnegative arguments. | + -- Function: bytes byte ... | + Returns a newly allocated byte-array composed of the small + nonnegative arguments. - - Function: bytes->list bytes - `bytes->list' returns a newly allocated list of the bytes that | - make up the given byte-array. | - | - - Function: list->bytes bytes - `list->bytes' returns a newly allocated byte-array formed from the | - small nonnegative integers in the list BYTES. | + -- Function: bytes->list bytes | + `bytes->list' returns a newly allocated list of the bytes that + make up the given byte-array. -`Bytes->list' and `list->bytes' are inverses so far as `equal?' is | -concerned. | + -- Function: list->bytes bytes | + `list->bytes' returns a newly allocated byte-array formed from the + small nonnegative integers in the list BYTES. - - Function: bytes-copy bytes | - Returns a newly allocated copy of the given BYTES. | - | - - Procedure: bytes-reverse! bytes | - Reverses the order of byte-array BYTES. | - | - - Function: bytes-reverse bytes | - Returns a newly allocated bytes-array consisting of the elements of | - BYTES in reverse order. | - | -Input and output of bytes should be with ports opened in "binary" mode | -(*note Input/Output::). Calling `open-file' with 'rb or 'wb modes | +`Bytes->list' and `list->bytes' are inverses so far as `equal?' is +concerned. + + -- Function: bytes-copy bytes | + Returns a newly allocated copy of the given BYTES. + + -- Procedure: bytes-reverse! bytes | + Reverses the order of byte-array BYTES. + + -- Function: bytes-reverse bytes | + Returns a newly allocated bytes-array consisting of the elements of + BYTES in reverse order. + +Input and output of bytes should be with ports opened in "binary" mode +(*note Input/Output::). Calling `open-file' with 'rb or 'wb modes argument will return a binary port if the Scheme implementation supports it. - | - - Function: write-byte byte port - - Function: write-byte byte | + + -- Function: write-byte byte port | + -- Function: write-byte byte | Writes the byte BYTE (not an external representation of the byte) to the given PORT and returns an unspecified value. The PORT argument may be omitted, in which case it defaults to the value - returned by `current-output-port'. - | - - Function: read-byte port - - Function: read-byte | + returned by `current-output-port'. + + -- Function: read-byte port | + -- Function: read-byte | Returns the next byte available from the input PORT, updating the PORT to point to the following byte. If no more bytes are - available, an end-of-file object is returned. PORT may be | + 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'. + `current-input-port'. + +When reading and writing binary numbers with `read-bytes' and +`write-bytes', the sign of the length argument determines the +endianness (order) of bytes. Positive treats them as big-endian, the +first byte input or output is highest order. Negative treats them as +little-endian, the first byte input or output is the lowest order. + +Once read in, SLIB treats byte sequences as big-endian. The multi-byte +sequences produced and used by number conversion routines *note +Byte/Number Conversions:: are always big-endian. + + -- Function: read-bytes n port | + -- Function: read-bytes n | + `read-bytes' returns a newly allocated bytes-array filled with + `(abs N)' bytes read from PORT. If N is positive, then the first + byte read is stored at index 0; otherwise the last byte read is + stored at index 0. Note that the length of the returned string + will be less than `(abs N)' if PORT reaches end-of-file. + + PORT may be omitted, in which case it defaults to the value + returned by `current-input-port'. + + -- Function: write-bytes bytes n port | + -- Function: write-bytes bytes n | + `write-bytes' writes `(abs N)' bytes to output-port PORT. If N is + positive, then the first byte written is index 0 of BYTES; + otherwise the last byte written is index 0 of BYTES. + `write-bytes' returns an unspecified value. + + PORT may be omitted, in which case it defaults to the value + returned by `current-output-port'. -When reading and writing binary numbers with `read-bytes' and | -`write-bytes', the sign of the length argument determines the | -endianness (order) of bytes. Positive treats them as big-endian, the | -first byte input or output is highest order. Negative treats them as | -little-endian, the first byte input or output is the lowest order. | - | -Once read in, SLIB treats byte sequences as big-endian. The multi-byte | -sequences produced and used by number conversion routines *note | -Byte/Number Conversions:: are always big-endian. | - | - - Function: read-bytes n port | - - Function: read-bytes n | - `read-bytes' returns a newly allocated bytes-array filled with | - `(abs N)' bytes read from PORT. If N is positive, then the first | - byte read is stored at index 0; otherwise the last byte read is | - stored at index 0. Note that the length of the returned string | - will be less than `(abs N)' if PORT reaches end-of-file. | - | - PORT may be omitted, in which case it defaults to the value | - returned by `current-input-port'. | - | - - Function: write-bytes bytes n port | - - Function: write-bytes bytes n | - `write-bytes' writes `(abs N)' bytes to output-port PORT. If N is | - positive, then the first byte written is index 0 of BYTES; | - otherwise the last byte written is index 0 of BYTES. | - `write-bytes' returns an unspecified value. | - | - PORT may be omitted, in which case it defaults to the value | - returned by `current-output-port'. | - | -`substring-read!' and `substring-write' provide lower-level procedures | -for reading and writing blocks of bytes. The relative size of START | -and END determines the order of writing. | - | - - Procedure: substring-read! string start end port | - - Procedure: substring-read! string start end | - Fills STRING with up to `(abs (- START END))' bytes read from | - PORT. The first byte read is stored at index STRING. | - `substring-read!' returns the number of bytes read. | - | - PORT may be omitted, in which case it defaults to the value | - returned by `current-input-port'. | - | - - Function: substring-write string start end port | - - Function: substring-write string start end | - `substring-write' writes `(abs (- START END))' bytes to | - output-port PORT. The first byte written is index START of | - STRING. `substring-write' returns the number of bytes written. | - | - PORT may be omitted, in which case it defaults to the value | - returned by `current-output-port'. | +`substring-read!' and `substring-write' provide lower-level procedures +for reading and writing blocks of bytes. The relative size of START +and END determines the order of writing. + + -- Procedure: substring-read! string start end port | + -- Procedure: substring-read! string start end | + Fills STRING with up to `(abs (- START END))' bytes read from + PORT. The first byte read is stored at index STRING. + `substring-read!' returns the number of bytes read. + + PORT may be omitted, in which case it defaults to the value + returned by `current-input-port'. + + -- Function: substring-write string start end port | + -- Function: substring-write string start end | + `substring-write' writes `(abs (- START END))' bytes to + output-port PORT. The first byte written is index START of + STRING. `substring-write' returns the number of bytes written. + + PORT may be omitted, in which case it defaults to the value + returned by `current-output-port'. File: slib.info, Node: Byte/Number Conversions, Next: MAT-File Format, Prev: Byte, Up: Data Structures - | -Byte/Number Conversions | ------------------------ | - | -`(require 'byte-number)' | - | -The multi-byte sequences produced and used by numeric conversion | -routines are always big-endian. Endianness can be changed during | -reading and writing bytes using `read-bytes' and `write-bytes' *Note | -read-bytes: Byte. | - | -The sign of the length argument to bytes/integer conversion procedures | -determines the signedness of the number. | - | - - Function: bytes->integer bytes n | - Converts the first `(abs N)' bytes of big-endian BYTES array to an | - integer. If N is negative then the integer coded by the bytes are | - treated as two's-complement (can be negative). | - | - (bytes->integer (bytes 0 0 0 15) -4) => 15 | - (bytes->integer (bytes 0 0 0 15) 4) => 15 | - (bytes->integer (bytes 255 255 255 255) -4) => -1 | - (bytes->integer (bytes 255 255 255 255) 4) => 4294967295 | - (bytes->integer (bytes 128 0 0 0) -4) => -2147483648 | - (bytes->integer (bytes 128 0 0 0) 4) => 2147483648 | - | - - Function: integer->bytes n len | - Converts the integer N to a byte-array of `(abs N)' bytes. If N | - and LEN are both negative, then the bytes in the returned array | - are coded two's-complement. | - | - (bytes->list (integer->bytes 15 -4)) => (0 0 0 15) | - (bytes->list (integer->bytes 15 4)) => (0 0 0 15) | + +7.1.6 Byte/Number Conversions | +----------------------------- | + +`(require 'byte-number)' + +The multi-byte sequences produced and used by numeric conversion +routines are always big-endian. Endianness can be changed during +reading and writing bytes using `read-bytes' and `write-bytes' *Note +read-bytes: Byte. + +The sign of the length argument to bytes/integer conversion procedures +determines the signedness of the number. + + -- Function: bytes->integer bytes n | + Converts the first `(abs N)' bytes of big-endian BYTES array to an + integer. If N is negative then the integer coded by the bytes are + treated as two's-complement (can be negative). + + (bytes->integer (bytes 0 0 0 15) -4) => 15 + (bytes->integer (bytes 0 0 0 15) 4) => 15 + (bytes->integer (bytes 255 255 255 255) -4) => -1 + (bytes->integer (bytes 255 255 255 255) 4) => 4294967295 + (bytes->integer (bytes 128 0 0 0) -4) => -2147483648 + (bytes->integer (bytes 128 0 0 0) 4) => 2147483648 + + -- Function: integer->bytes n len | + Converts the integer N to a byte-array of `(abs N)' bytes. If N + and LEN are both negative, then the bytes in the returned array + are coded two's-complement. + + (bytes->list (integer->bytes 15 -4)) => (0 0 0 15) + (bytes->list (integer->bytes 15 4)) => (0 0 0 15) (bytes->list (integer->bytes -1 -4)) => (255 255 255 255) (bytes->list (integer->bytes 4294967295 4)) => (255 255 255 255) - (bytes->list (integer->bytes -2147483648 -4)) => (128 0 0 0) | - (bytes->list (integer->bytes 2147483648 4)) => (128 0 0 0) | - | - - Function: bytes->ieee-float bytes | - BYTES must be a 4-element byte-array. `bytes->ieee-float' | - calculates and returns the value of BYTES interpreted as a | - big-endian IEEE 4-byte (32-bit) number. | - | - (bytes->ieee-float (bytes #x40 0 0 0)) => 2.0 | - (bytes->ieee-float (bytes #x40 #xd0 0 0)) => 6.5 | - (bytes->ieee-float (bytes #xc0 #xd0 0 0)) => -6.5 | - | - (bytes->ieee-float (bytes 0 #x80 0 0)) => 11.754943508222875e-39 | - (bytes->ieee-float (bytes 0 #x40 0 0)) => 5.877471754111437e-39 | - (bytes->ieee-float (bytes 0 0 0 1)) => 1.401298464324817e-45 | - | - (bytes->ieee-float (bytes #xff #x80 0 0)) => -1/0 | - (bytes->ieee-float (bytes #x7f #x80 0 0)) => 1/0 | - (bytes->ieee-float (bytes #x7f #x80 0 1)) => 0/0 | - | - - Function: bytes->ieee-double bytes | - BYTES must be a 8-element byte-array. `bytes->ieee-double' | - calculates and returns the value of BYTES interpreted as a | - big-endian IEEE 8-byte (64-bit) number. | - | - (bytes->ieee-double (bytes 0 0 0 0 0 0 0 0)) => 0.0 | - (bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) => 2 | - (bytes->ieee-double (bytes #x40 #x1A 0 0 0 0 0 0)) => 6.5 | - (bytes->ieee-double (bytes #xC0 #x1A 0 0 0 0 0 0)) => -6.5 | - | - (bytes->ieee-double (bytes 0 8 0 0 0 0 0 0)) => 11.125369292536006e-309 | - (bytes->ieee-double (bytes 0 4 0 0 0 0 0 0)) => 5.562684646268003e-309 | - (bytes->ieee-double (bytes 0 0 0 0 0 0 0 1)) => 4.0e-324 | - | - (bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0)) => -1/0 | - (bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) => 1/0 | - (bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0)) => 0/0 | - | - - Function: ieee-float->bytes x | - Returns a 4-element byte-array encoding the IEEE single-precision | - floating-point of X. | - | + (bytes->list (integer->bytes -2147483648 -4)) => (128 0 0 0) + (bytes->list (integer->bytes 2147483648 4)) => (128 0 0 0) + + -- Function: bytes->ieee-float bytes | + BYTES must be a 4-element byte-array. `bytes->ieee-float' + calculates and returns the value of BYTES interpreted as a + big-endian IEEE 4-byte (32-bit) number. + + (bytes->ieee-float (bytes #x40 0 0 0)) => 2.0 + (bytes->ieee-float (bytes #x40 #xd0 0 0)) => 6.5 + (bytes->ieee-float (bytes #xc0 #xd0 0 0)) => -6.5 + + (bytes->ieee-float (bytes 0 #x80 0 0)) => 11.754943508222875e-39 + (bytes->ieee-float (bytes 0 #x40 0 0)) => 5.877471754111437e-39 + (bytes->ieee-float (bytes 0 0 0 1)) => 1.401298464324817e-45 + + (bytes->ieee-float (bytes #xff #x80 0 0)) => -1/0 + (bytes->ieee-float (bytes #x7f #x80 0 0)) => 1/0 + (bytes->ieee-float (bytes #x7f #x80 0 1)) => 0/0 + + -- Function: bytes->ieee-double bytes | + BYTES must be a 8-element byte-array. `bytes->ieee-double' + calculates and returns the value of BYTES interpreted as a + big-endian IEEE 8-byte (64-bit) number. + + (bytes->ieee-double (bytes 0 0 0 0 0 0 0 0)) => 0.0 + (bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) => 2 + (bytes->ieee-double (bytes #x40 #x1A 0 0 0 0 0 0)) => 6.5 + (bytes->ieee-double (bytes #xC0 #x1A 0 0 0 0 0 0)) => -6.5 + + (bytes->ieee-double (bytes 0 8 0 0 0 0 0 0)) => 11.125369292536006e-309 + (bytes->ieee-double (bytes 0 4 0 0 0 0 0 0)) => 5.562684646268003e-309 + (bytes->ieee-double (bytes 0 0 0 0 0 0 0 1)) => 4.0e-324 + + (bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0)) => -1/0 + (bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) => 1/0 + (bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0)) => 0/0 + + -- Function: ieee-float->bytes x | + Returns a 4-element byte-array encoding the IEEE single-precision + floating-point of X. + (bytes->list (ieee-float->bytes 2.0)) => (64 0 0 0) (bytes->list (ieee-float->bytes 6.5)) => (64 208 0 0) (bytes->list (ieee-float->bytes -6.5)) => (192 208 0 0) - | + (bytes->list (ieee-float->bytes 11.754943508222875e-39)) => ( 0 128 0 0) (bytes->list (ieee-float->bytes 5.877471754111438e-39)) => ( 0 64 0 0) (bytes->list (ieee-float->bytes 1.401298464324817e-45)) => ( 0 0 0 1) - | + (bytes->list (ieee-float->bytes -1/0)) => (255 128 0 0) (bytes->list (ieee-float->bytes 1/0)) => (127 128 0 0) (bytes->list (ieee-float->bytes 0/0)) => (127 128 0 1) - | - - Function: ieee-double->bytes x | - Returns a 8-element byte-array encoding the IEEE double-precision | - floating-point of X. | - | - (bytes->list (ieee-double->bytes 2.0)) => (64 0 0 0 0 0 0 0) | - (bytes->list (ieee-double->bytes 6.5)) => (64 26 0 0 0 0 0 0) | - (bytes->list (ieee-double->bytes -6.5)) => (192 26 0 0 0 0 0 0) | - | - (bytes->list (ieee-double->bytes 11.125369292536006e-309)) | - => ( 0 8 0 0 0 0 0 0) | - (bytes->list (ieee-double->bytes 5.562684646268003e-309)) | - => ( 0 4 0 0 0 0 0 0) | - (bytes->list (ieee-double->bytes 4.0e-324)) | - => ( 0 0 0 0 0 0 0 1) | - | - (bytes->list (ieee-double->bytes -1/0)) => (255 240 0 0 0 0 0 0) | - (bytes->list (ieee-double->bytes 1/0)) => (127 240 0 0 0 0 0 0) | - (bytes->list (ieee-double->bytes 0/0)) => (127 248 0 0 0 0 0 0) | - | -Byte Collation Order | -.................... | - | -The `string<?' ordering of big-endian byte-array representations of | -fixed and IEEE floating-point numbers agrees with the numerical | -ordering only when those numbers are non-negative. | - | -Straighforward modification of these formats can extend the | -byte-collating order to work for their entire ranges. This agreement | -enables the full range of numbers as keys in | -"indexed-sequential-access-method" databases. | - | - - Procedure: integer-byte-collate! byte-vector | - Modifies sign bit of BYTE-VECTOR so that `string<?' ordering of | - two's-complement byte-vectors matches numerical order. | - `integer-byte-collate!' returns BYTE-VECTOR and is its own | - functional inverse. | - | - - Function: integer-byte-collate byte-vector | - Returns copy of BYTE-VECTOR with sign bit modified so that | - `string<?' ordering of two's-complement byte-vectors matches | - numerical order. `integer-byte-collate' is its own functional | - inverse. | - | - - Procedure: ieee-byte-collate! byte-vector | - Modifies BYTE-VECTOR so that `string<?' ordering of IEEE | - floating-point byte-vectors matches numerical order. | - `ieee-byte-collate!' returns BYTE-VECTOR. | - | - - Procedure: ieee-byte-decollate! byte-vector | - Given BYTE-VECTOR modified by `IEEE-byte-collate!', reverses the | - BYTE-VECTOR modifications. | - | - - Function: ieee-byte-collate byte-vector | - Returns copy of BYTE-VECTOR encoded so that `string<?' ordering of | - IEEE floating-point byte-vectors matches numerical order. | - | - - Function: ieee-byte-decollate byte-vector | - Given BYTE-VECTOR returned by `IEEE-byte-collate', reverses the | - BYTE-VECTOR modifications. | - | + + -- Function: ieee-double->bytes x | + Returns a 8-element byte-array encoding the IEEE double-precision + floating-point of X. + + (bytes->list (ieee-double->bytes 2.0)) => (64 0 0 0 0 0 0 0) + (bytes->list (ieee-double->bytes 6.5)) => (64 26 0 0 0 0 0 0) + (bytes->list (ieee-double->bytes -6.5)) => (192 26 0 0 0 0 0 0) + + (bytes->list (ieee-double->bytes 11.125369292536006e-309)) + => ( 0 8 0 0 0 0 0 0) + (bytes->list (ieee-double->bytes 5.562684646268003e-309)) + => ( 0 4 0 0 0 0 0 0) + (bytes->list (ieee-double->bytes 4.0e-324)) + => ( 0 0 0 0 0 0 0 1) + + (bytes->list (ieee-double->bytes -1/0)) => (255 240 0 0 0 0 0 0) + (bytes->list (ieee-double->bytes 1/0)) => (127 240 0 0 0 0 0 0) + (bytes->list (ieee-double->bytes 0/0)) => (127 248 0 0 0 0 0 0) + +Byte Collation Order +.................... + +The `string<?' ordering of big-endian byte-array representations of +fixed and IEEE floating-point numbers agrees with the numerical +ordering only when those numbers are non-negative. + +Straighforward modification of these formats can extend the +byte-collating order to work for their entire ranges. This agreement +enables the full range of numbers as keys in +"indexed-sequential-access-method" databases. + + -- Procedure: integer-byte-collate! byte-vector | + Modifies sign bit of BYTE-VECTOR so that `string<?' ordering of + two's-complement byte-vectors matches numerical order. + `integer-byte-collate!' returns BYTE-VECTOR and is its own + functional inverse. + + -- Function: integer-byte-collate byte-vector | + Returns copy of BYTE-VECTOR with sign bit modified so that + `string<?' ordering of two's-complement byte-vectors matches + numerical order. `integer-byte-collate' is its own functional + inverse. + + -- Procedure: ieee-byte-collate! byte-vector | + Modifies BYTE-VECTOR so that `string<?' ordering of IEEE + floating-point byte-vectors matches numerical order. + `ieee-byte-collate!' returns BYTE-VECTOR. + + -- Procedure: ieee-byte-decollate! byte-vector | + Given BYTE-VECTOR modified by `IEEE-byte-collate!', reverses the + BYTE-VECTOR modifications. + + -- Function: ieee-byte-collate byte-vector | + Returns copy of BYTE-VECTOR encoded so that `string<?' ordering of + IEEE floating-point byte-vectors matches numerical order. + + -- Function: ieee-byte-decollate byte-vector | + Given BYTE-VECTOR returned by `IEEE-byte-collate', reverses the + BYTE-VECTOR modifications. + File: slib.info, Node: MAT-File Format, Next: Portable Image Files, Prev: Byte/Number Conversions, Up: Data Structures - | -MAT-File Format ---------------- -`(require 'matfile)' +7.1.7 MAT-File Format | +--------------------- | + +`(require 'matfile)' `http://www.mathworks.com/access/helpdesk/help/pdf_doc/matlab/matfile_format.pdf' @@ -10994,16 +11765,16 @@ files. MAT-files written from big-endian or little-endian computers having IEEE format numbers are currently supported. Support for files written from VAX or Cray machines could also be added. -The numeric and text matrix types handled; support for "sparse" -matrices awaits a sample file. +The numeric and text matrix types handled; support for "sparse" matrices | +awaits a sample file. | - - Function: matfile:read filename + -- Function: matfile:read filename | FILENAME should be a string naming an existing file containing a MATLAB Version 4 MAT-File. The `matfile:read' procedure reads matrices from the file and returns a list of the results; a list of the name string and array for each matrix. - - Function: matfile:load filename + -- Function: matfile:load filename | FILENAME should be a string naming an existing file containing a MATLAB Version 4 MAT-File. The `matfile:load' procedure reads matrices from the file and defines the `string-ci->symbol' for @@ -11013,14 +11784,14 @@ matrices awaits a sample file. File: slib.info, Node: Portable Image Files, Next: Collections, Prev: MAT-File Format, Up: Data Structures -Portable Image Files --------------------- +7.1.8 Portable Image Files | +-------------------------- | -`(require 'pnm)' +`(require 'pnm)' - - Function: pnm:type-dimensions path - The string PATH must name a "portable bitmap graphics" file. - `pnm:type-dimensions' returns a list of 4 items: + -- Function: pnm:type-dimensions path | + The string PATH must name a "portable bitmap graphics" file. `pnm:type-dimensions' + returns a list of 4 items: | 1. A symbol describing the type of the file named by PATH. 2. The image width in pixels. @@ -11044,16 +11815,16 @@ Portable Image Files RGB (full color) image; red, green, and blue interleaved pixel values are from 0 to MAXVAL - - Function: pnm:image-file->array path array - Reads the "portable bitmap graphics" file named by PATH into - ARRAY. ARRAY must be the correct size and type for PATH. ARRAY - is returned. + -- Function: pnm:image-file->array path array | + Reads the "portable bitmap graphics" file named by PATH into ARRAY. | + ARRAY must be the correct size and type for PATH. ARRAY is | + returned. | - - Function: pnm:image-file->array path + -- Function: pnm:image-file->array path | `pnm:image-file->array' creates and returns an array with the - "portable bitmap graphics" file named by PATH read into it. + "portable bitmap graphics" file named by PATH read into it. - - Function: pnm:array-write type array maxval path comment ... | + -- Function: pnm:array-write type array maxval path comment ... | Writes the contents of ARRAY to a TYPE image file named PATH. The file will have pixel values between 0 and MAXVAL, which must be compatible with TYPE. For `pbm' files, MAXVAL must be `1'. @@ -11062,10 +11833,10 @@ Portable Image Files File: slib.info, Node: Collections, Next: Dynamic Data Type, Prev: Portable Image Files, Up: Data Structures -Collections ------------ +7.1.9 Collections | +----------------- | -`(require 'collect)' +`(require 'collect)' Routines for managing collections. Collections are aggregate data structures supporting iteration over their elements, similar to the @@ -11094,12 +11865,12 @@ Yasos::). They must support the following operations: They might support specialized `for-each-key' and `for-each-elt' operations. - - Function: collection? obj + -- 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 collection1 ... - - Procedure: do-elts proc collection1 ... + -- Procedure: map-elts proc collection1 ... | + -- Procedure: do-elts proc collection1 ... | 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 @@ -11114,8 +11885,8 @@ operations. (map-elts + (list 1 2 3) (vector 1 2 3)) => #(2 4 6) - - Procedure: map-keys proc collection1 ... - - Procedure: do-keys proc collection1 ... + -- Procedure: map-keys proc collection1 ... | + -- Procedure: do-keys proc collection1 ... | These are analogous to `map-elts' and `do-elts', but each iteration is over the COLLECTIONS' _keys_ rather than their elements. @@ -11124,16 +11895,16 @@ operations. (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 + -- 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 collection1 ... - A generalization of the list-based `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::). + -- Function: reduce proc seed collection1 ... | + A generalization of the list-based `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)) @@ -11141,7 +11912,7 @@ operations. (reduce union '() '((a b c) (b c d) (d a))) => (c b d a). - - Function: any? pred collection1 ... + -- Function: any? pred collection1 ... | A generalization of the list-based `some' (*note Lists as sequences::) to collections. @@ -11149,7 +11920,7 @@ operations. (any? odd? (list 2 3 4 5)) => #t - - Function: every? pred collection1 ... + -- Function: every? pred collection1 ... | A generalization of the list-based `every' (*note Lists as sequences::) to collections. @@ -11157,15 +11928,15 @@ operations. (every? collection? '((1 2) #(1 2))) => #t - - Function: empty? collection + -- Function: empty? collection | Returns `#t' iff there are no elements in COLLECTION. `(empty? COLLECTION) == (zero? (size COLLECTION))' - - Function: size collection + -- Function: size collection | Returns the number of elements in COLLECTION. - - Function: Setter list-ref + -- 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. @@ -11174,7 +11945,7 @@ operations. (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 @@ -11231,28 +12002,28 @@ operations. File: slib.info, Node: Dynamic Data Type, Next: Hash Tables, Prev: Collections, Up: Data Structures -Dynamic Data Type ------------------ +7.1.10 Dynamic Data Type | +------------------------ | -`(require 'dynamic)' +`(require 'dynamic)' - - Function: make-dynamic obj + -- Function: make-dynamic obj | Create and returns a new "dynamic" whose global value is OBJ. - - Function: dynamic? 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 + -- Function: dynamic-ref dyn | Return the value of the given dynamic in the current dynamic environment. - - Procedure: dynamic-set! dyn obj + -- 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 + -- 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 @@ -11266,12 +12037,12 @@ Dynamic Data Type File: slib.info, Node: Hash Tables, Next: Object, Prev: Dynamic Data Type, Up: Data Structures -Hash Tables ------------ +7.1.11 Hash Tables | +------------------ | -`(require 'hash-table)' +`(require 'hash-table)' - - Function: predicate->hash pred + -- 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 @@ -11279,7 +12050,7 @@ Hash Tables A hash table is a vector of association lists. - - Function: make-hash-table k + -- Function: make-hash-table k | Returns a vector of K empty (association) lists. Hash table functions provide utilities for an associative database. @@ -11287,61 +12058,61 @@ 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 + -- 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 + -- Function: hash-inquirer pred | Returns a procedure of 2 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 + -- 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 + -- 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 + -- 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 + -- 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. - - Function: hash-rehasher pred | - `hash-rehasher' accepts a hash table predicate and returns a | - function of two arguments HASHTAB and NEW-K which is specialized | - for that predicate. | - | - This function is used for nondestrutively resizing a hash table. | - HASHTAB should be an existing hash-table using PRED, NEW-K is the | - size of a new hash table to be returned. The new hash table will | - have all of the associations of the old hash table. | - | + -- Function: hash-rehasher pred | + `hash-rehasher' accepts a hash table predicate and returns a + function of two arguments HASHTAB and NEW-K which is specialized + for that predicate. + + This function is used for nondestrutively resizing a hash table. + HASHTAB should be an existing hash-table using PRED, NEW-K is the + size of a new hash table to be returned. The new hash table will + have all of the associations of the old hash table. + File: slib.info, Node: Object, Next: Priority Queues, Prev: Hash Tables, Up: Data Structures -Macroless Object System ------------------------ +7.1.12 Macroless Object System | +------------------------------ | -`(require 'object)' +`(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 --------- +7.1.13 Concepts | +--------------- | OBJECT An object is an ordered association-list (by `eq?') of methods @@ -11370,10 +12141,10 @@ PREDICATE A object's method asscociated with a generic-predicate. Returns `#t'. -Procedures ----------- +7.1.14 Procedures | +----------------- | - - Function: make-object ancestor ... + -- 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 @@ -11381,48 +12152,48 @@ Procedures In this case the method of the ANCESTOR first appearing in the list is the one returned by `get-method'. - - Function: object? obj + -- Function: object? obj | Returns boolean value whether OBJ was created by make-object. - - Function: make-generic-method exception-procedure + -- 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 + -- Function: make-generic-predicate | Returns a boolean procedure for any scheme object. - - Function: make-method! object generic-method method + -- 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 + -- Function: make-predicate! object generic-preciate | Makes a predicate method associated with the GENERIC-PREDICATE. - - Function: unmake-method! object generic-method + -- Function: unmake-method! object generic-method | Removes an object's association with a GENERIC-METHOD . - - Function: get-method object 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 --------- +7.1.15 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)) @@ -11430,7 +12201,7 @@ Examples (define name (make-generic-method)) (define address (make-generic-method)) (define members (make-generic-method)) - + (define society (let () (define self (make-instance-object)) @@ -11454,7 +12225,7 @@ Examples 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)) @@ -11469,8 +12240,8 @@ Examples (imigrate! self) self) -Inverter Documentation -...................... +7.1.15.1 Inverter Documentation | +............................... | Inheritance: <inverter>::(<number> <description>) @@ -11482,8 +12253,8 @@ Inheritance: <inverter>::invert <inverter>::inverter? -Number Documention -.................. +7.1.15.2 Number Documention | +........................... | Inheritance <number>::() @@ -11493,8 +12264,8 @@ Inheritance <number>::value <number>::set-value! -Inverter code -............. +7.1.15.3 Inverter code | +...................... | (require 'object) @@ -11509,20 +12280,20 @@ Inverter code (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) (let* ((self (make-object (make-number 1) @@ -11536,106 +12307,107 @@ Inverter code (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 (x) (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: Priority Queues, Next: Queues, Prev: Object, Up: Data Structures -Priority Queues ---------------- +7.1.16 Priority Queues | +---------------------- | -`(require 'priority-queue)' +`(require 'priority-queue)' -This algorithm for priority queues is due to `Introduction to | -Algorithms' by T. Cormen, C. Leiserson, R. Rivest. 1989 MIT Press. | - | - - Function: make-heap pred<? +This algorithm for priority queues is due to `Introduction to +Algorithms' by T. Cormen, C. Leiserson, R. Rivest. 1989 MIT Press. + + -- Function: make-heap pred<? | Returns a binary heap suitable which can be used for priority queue operations. - - Function: heap-length heap + -- Function: heap-length heap | Returns the number of elements in HEAP. - - Procedure: heap-insert! heap item + -- Procedure: heap-insert! heap item | Inserts ITEM into HEAP. ITEM can be inserted multiple times. The value returned is unspecified. - - Procedure: heap-extract-max! heap | + -- Procedure: 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. - | + File: slib.info, Node: Queues, Next: Records, Prev: Priority Queues, Up: Data Structures -Queues ------- +7.1.17 Queues | +------------- | -`(require 'queue)' +`(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. +"dequeues"). A queue may also be used like a stack. - - Function: make-queue + -- Function: make-queue | Returns a new, empty queue. - - Function: queue? obj + -- Function: queue? obj | Returns `#t' if OBJ is a queue. - - Function: queue-empty? q + -- Function: queue-empty? q | Returns `#t' if the queue Q is empty. - - Procedure: queue-push! q datum + -- Procedure: queue-push! q datum | Adds DATUM to the front of queue Q. - - Procedure: enqueue! q datum + -- Procedure: enqueue! q datum | Adds DATUM to the rear of queue Q. - - Procedure: dequeue! q | - - Procedure: queue-pop! 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. | - All of the following functions raise an error if the queue Q is empty. | - | - - Procedure: dequeue-all! q + -- Procedure: dequeue! q | + -- Procedure: queue-pop! 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. + + All of the following functions raise an error if the queue Q is empty. + + -- Procedure: dequeue-all! q | Removes and returns (the list) of all contents of queue Q. - | - - Function: queue-front q + + -- Function: queue-front q | Returns the datum at the front of the queue Q. - - Function: queue-rear q + -- Function: queue-rear q | Returns the datum at the rear of the queue Q. - | + File: slib.info, Node: Records, Prev: Queues, Up: Data Structures -Records -------- +7.1.18 Records | +-------------- | -`(require 'record)' +`(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 + -- 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 @@ -11645,7 +12417,7 @@ record data types. duplicates. It is unspecified how record-type descriptors are represented. - - Function: record-constructor rtd [field-names] + -- 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, @@ -11658,13 +12430,13 @@ record data types. it is an error if it contains any duplicates or any symbols not in the default list. - - Function: record-predicate rtd + -- 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 + -- 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 @@ -11673,7 +12445,7 @@ record data types. 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 + -- 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 @@ -11699,8 +12471,8 @@ supported. File: slib.info, Node: Sorting and Searching, Next: Procedures, Prev: Data Structures, Up: Other Packages -Sorting and Searching -===================== +7.2 Sorting and Searching | +========================= | * Menu: @@ -11718,10 +12490,10 @@ Sorting and Searching File: slib.info, Node: Common List Functions, Next: Tree Operations, Prev: Sorting and Searching, Up: Sorting and Searching -Common List Functions ---------------------- +7.2.1 Common List Functions | +--------------------------- | -`(require 'common-list-functions)' +`(require 'common-list-functions)' The procedures below follow the Common LISP equivalents apart from optional arguments in some cases. @@ -11737,11 +12509,11 @@ optional arguments in some cases. File: slib.info, Node: List construction, Next: Lists as sets, Prev: Common List Functions, Up: Common List Functions -List construction -................. +7.2.1.1 List construction | +......................... | - - Function: make-list k - - Function: make-list k init + -- Function: make-list k | + -- 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. @@ -11751,7 +12523,7 @@ List construction (make-list 5 'foo) => (foo foo foo foo foo) - - Function: list* obj1 obj2 ... + -- Function: list* obj1 obj2 ... | 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.: @@ -11765,7 +12537,7 @@ List construction (list* ARGS '()) == (list ARGS) - - Function: copy-list lst + -- 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 @@ -11791,13 +12563,13 @@ List construction File: slib.info, Node: Lists as sets, Next: Lists as sequences, Prev: List construction, Up: Common List Functions -Lists as sets -............. +7.2.1.2 Lists as sets | +..................... | `eqv?' is used to test for membership by procedures which treat lists as sets. - - Function: adjoin e l + -- 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)'. @@ -11808,7 +12580,7 @@ as sets. (adjoin 'foo '(bar baz bang)) => (foo bar baz bang) - - Function: union l1 l2 + -- Function: union l1 l2 | `union' returns a list of all elements that are in L1 or L2. Duplicates between L1 and L2 are culled. Duplicates within L1 or within L2 may or may not be removed. @@ -11819,7 +12591,7 @@ as sets. (union '(0 1 2 3 4) '(3 4 5 6)) => (5 6 0 1 2 3 4) - - Function: intersection l1 l2 + -- Function: intersection l1 l2 | `intersection' returns a list of all elements that are in both L1 and L2. @@ -11829,7 +12601,7 @@ as sets. (intersection '(1 2 3 4) '(5 6 7 8)) => () - - Function: set-difference l1 l2 + -- Function: set-difference l1 l2 | `set-difference' returns a list of all elements that are in L1 but not in L2. @@ -11839,7 +12611,7 @@ as sets. (set-difference '(1 2 3 4) '(1 2 3 4 5 6)) => () - - Function: subset? list1 list2 + -- Function: subset? list1 list2 | Returns `#t' if every element of LIST1 is `eqv?' an element of LIST2; otherwise returns `#f'. @@ -11849,7 +12621,7 @@ as sets. (subset? '(1 2 3 4) '(6 5 4 3 2 1 0)) => #t - - Function: member-if pred lst + -- Function: member-if pred lst | `member-if' returns the list headed by the first element of LST to satisfy `(PRED ELEMENT)'. `Member-if' returns `#f' if PRED returns `#f' for every ELEMENT in LST. @@ -11860,7 +12632,7 @@ as sets. (member-if number? '(a 2 b 4)) => (2 b 4) - - Function: some pred lst1 lst2 ... + -- Function: some pred lst1 lst2 ... | 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. @@ -11871,53 +12643,53 @@ as sets. Example: (some odd? '(1 2 3 4)) => #t - + (some odd? '(2 4 6 8)) => #f - + (some > '(1 3) '(2 4)) => #f - - Function: every pred lst1 lst2 ... + -- Function: every pred lst1 lst2 ... | `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 lst1 ... + -- Function: notany pred lst1 ... | `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 lst1 ... + -- Function: notevery pred lst1 ... | `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: list-of?? predicate + -- Function: list-of?? predicate | Returns a predicate which returns true if its argument is a list every element of which satisfies PREDICATE. - - Function: list-of?? predicate low-bound high-bound + -- Function: list-of?? predicate low-bound high-bound | LOW-BOUND and HIGH-BOUND are non-negative integers. `list-of??' returns a predicate which returns true if its argument is a list of length between LOW-BOUND and HIGH-BOUND (inclusive); every element of which satisfies PREDICATE. - - Function: list-of?? predicate bound + -- Function: list-of?? predicate bound | BOUND is an integer. If BOUND is negative, `list-of??' returns a predicate which returns true if its argument is a list of length greater than `(- BOUND)'; every element of which satisfies @@ -11925,7 +12697,7 @@ as sets. returns true if its argument is a list of length less than or equal to BOUND; every element of which satisfies PREDICATE. - - Function: find-if pred lst + -- 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. @@ -11933,14 +12705,14 @@ as sets. 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 + -- 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 @@ -11949,22 +12721,22 @@ as sets. 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 + -- 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 + -- 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. @@ -11974,36 +12746,36 @@ as sets. (remove-if-not odd? '(1 2 3 4 5 6 7 8)) => (1 3 5 7) - - Function: has-duplicates? lst + -- 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 The procedure `remove-duplicates' uses `member' (rather than `memv'). - - Function: remove-duplicates lst + -- Function: remove-duplicates lst | returns a copy of LST with its duplicate members removed. Elements are considered duplicate if they are `equal?'. Example: (remove-duplicates '(1 2 3 4)) => (1 2 3 4) - + (remove-duplicates '(2 4 3 4)) => (2 4 3) File: slib.info, Node: Lists as sequences, Next: Destructive list operations, Prev: Lists as sets, Up: Common List Functions -Lists as sequences -.................. +7.2.1.3 Lists as sequences | +.......................... | - - Function: position obj lst + -- Function: position obj lst | `position' returns the 0-based position of OBJ in LST, or `#f' if OBJ does not occur in LST. @@ -12015,7 +12787,7 @@ Lists as sequences (position 'oops '(foo bar baz bang)) => #f - - Function: reduce p lst + -- 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 @@ -12047,17 +12819,17 @@ Lists as sequences 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 + -- 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 @@ -12074,7 +12846,7 @@ Lists as sequences (sum) == (reduce-init + 0 '()) => 0 - + (reduce-init string-append "@" '("hello" "cruel" "world")) == (string-append (string-append (string-append "@" "hello") @@ -12089,7 +12861,7 @@ Lists as sequences Example: ;;; Real-world example: Insertion sort using reduce-init. - + (define (insert l item) (if (null? l) (list item) @@ -12097,7 +12869,7 @@ Lists as sequences (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) @@ -12107,7 +12879,7 @@ Lists as sequences == (insert (1 1 3 4) 5) => (1 1 3 4 5) - - Function: last lst n + -- Function: last lst n | `last' returns the last N elements of LST. N must be a non-negative integer. @@ -12117,7 +12889,7 @@ Lists as sequences (last '(1 2 3) 0) => 0 - - Function: butlast lst n + -- Function: butlast lst n | `butlast' returns all but the last N elements of LST. Example: @@ -12127,13 +12899,13 @@ Lists as sequences => () `last' and `butlast' split a list into two parts when given identical -arugments. +arguments. | (last '(a b c d e) 2) => (d e) (butlast '(a b c d e) 2) => (a b c) - - Function: nthcdr n lst + -- Function: nthcdr n lst | `nthcdr' takes N `cdr's of LST and returns the result. Thus `(nthcdr 3 LST)' == `(cdddr LST)' @@ -12143,7 +12915,7 @@ arugments. (nthcdr 0 '(a b c d)) => (a b c d) - - Function: butnthcdr n lst + -- Function: butnthcdr n lst | `butnthcdr' returns all but the nthcdr N elements of LST. Example: @@ -12153,7 +12925,7 @@ arugments. => (a b c d) `nthcdr' and `butnthcdr' split a list into two parts when given -identical arugments. +identical arguments. | (nthcdr 2 '(a b c d e)) => (c d e) (butnthcdr 2 '(a b c d e)) @@ -12162,13 +12934,13 @@ identical arugments. File: slib.info, Node: Destructive list operations, Next: Non-List functions, Prev: Lists as sequences, Up: Common List Functions -Destructive list operations -........................... +7.2.1.4 Destructive list operations | +................................... | These procedures may mutate the list they operate on, but any such mutation is undefined. - - Procedure: nconc args + -- 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::). @@ -12196,7 +12968,7 @@ mutation is undefined. `nconc' is the same as `append!' in `sc2.scm'. - - Procedure: nreverse lst + -- Procedure: nreverse lst | `nreverse' reverses the order of elements in LST by mutating `cdr's of the list. Sometimes called `reverse!'. @@ -12212,14 +12984,13 @@ mutation is undefined. 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 + -- 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: @@ -12228,7 +12999,7 @@ mutation is undefined. => (bar baz bang) lst => (foo bar baz bang) - + (define lst (list 1 2 3 4 5 6 7 8 9)) (delete-if odd? lst) => (2 4 6 8) @@ -12240,7 +13011,6 @@ mutation is undefined. 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. @@ -12248,10 +13018,10 @@ mutation is undefined. File: slib.info, Node: Non-List functions, Prev: Destructive list operations, Up: Common List Functions -Non-List functions -.................. +7.2.1.5 Non-List functions | +.......................... | - - Function: and? arg1 ... + -- Function: and? arg1 ... | `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 @@ -12263,7 +13033,7 @@ Non-List functions (and #f 1 2) => #f - - Function: or? arg1 ... + -- Function: or? arg1 ... | `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'.) @@ -12274,7 +13044,7 @@ Non-List functions (or? #f #f #f) => #f - - Function: atom? object + -- Function: atom? object | Returns `#t' if OBJECT is not a pair and `#f' if it is pair. (Called `atom' in Common LISP.) (atom? 1) @@ -12287,17 +13057,17 @@ Non-List functions File: slib.info, Node: Tree Operations, Next: Chapter Ordering, Prev: Common List Functions, Up: Sorting and Searching -Tree operations ---------------- +7.2.2 Tree operations | +--------------------- | -`(require 'tree)' +`(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 - - Function: subst new old tree equ? | + -- Function: subst new old tree | + -- Function: substq new old tree | + -- Function: substv new old tree | + -- Function: subst new old tree equ? | `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 @@ -12316,7 +13086,7 @@ Tree operations '((old . spice) ((old . shoes) old . pair) (old . pair))) => ((old . spice) ((old . shoes) a . cons) (a . cons)) - - Function: copy-tree tree + -- 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. @@ -12331,17 +13101,17 @@ Tree operations File: slib.info, Node: Chapter Ordering, Next: Sorting, Prev: Tree Operations, Up: Sorting and Searching -Chapter Ordering ----------------- +7.2.3 Chapter Ordering | +---------------------- | -`(require 'chapter-order)' +`(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 + -- 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<?' @@ -12351,12 +13121,12 @@ like case. (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 + -- 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 + -- 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 @@ -12370,10 +13140,10 @@ like case. File: slib.info, Node: Sorting, Next: Topological Sort, Prev: Chapter Ordering, Up: Sorting and Searching -Sorting -------- +7.2.4 Sorting | +------------- | -`(require 'sort)' +`(require 'sort)' Many Scheme systems provide some kind of sorting functions. They do not, however, always provide the _same_ sorting functions, and those @@ -12387,14 +13157,11 @@ Dybvig says that Chez Scheme provides (merge! predicate list1 list2) (sort predicate list) (sort! predicate list) - -while MIT Scheme 7.1, following Common LISP, offers unstable + while MIT Scheme 7.1, following Common LISP, offers unstable (sort list predicate) - -TI PC Scheme offers + TI PC Scheme offers (sort! list/vector predicate?) - -and Elk offers + and Elk offers (sort list/vector predicate?) (sort! list/vector predicate?) @@ -12457,16 +13224,16 @@ arguments which acts like `<'. For example, are suitable for use as comparison functions. Think of `(less? x y)' as saying when `x' must _not_ precede `y'. - - Function: sorted? sequence less? + -- 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 not a list, vector, or | - string. | + pair. It is an error if the sequence is not a list, vector, or + string. - - Function: merge list1 list2 less? + -- 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 @@ -12475,7 +13242,7 @@ as saying when `x' must _not_ precede `y'. bit of work anyway. I did, however, appeal to CL to determine the _order_ of the arguments. - - Procedure: merge! list1 list2 less? + -- 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 @@ -12488,23 +13255,22 @@ as saying when `x' must _not_ precede `y'. per iteration.) - - Function: sort sequence less? - Accepts either a list, vector, or string; 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. | + -- Function: sort sequence less? | + Accepts either a list, vector, or string; 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? + -- 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 or string, the sorted elements are | - put back in the same vector or string. | + original sequence is a vector or string, the sorted elements are + put back in the same vector or string. 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 <) @@ -12513,28 +13279,25 @@ 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 + and then, when you would have written (sort a-sequence #'my-less :key #'my-key) - -in Common LISP, just write + in Common LISP, just write (sort! a-sequence (keyed my-less? my-key)) - -in Scheme. + in Scheme. File: slib.info, Node: Topological Sort, Next: Hashing, Prev: Sorting, Up: Sorting and Searching -Topological Sort ----------------- +7.2.5 Topological Sort | +---------------------- | -`(require 'topological-sort)' or `(require 'tsort)' +`(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 + -- Function: tsort dag pred | + -- Function: topological-sort dag pred | where DAG is a list of sublists. The car of each sublist is a vertex. @@ -12576,17 +13339,17 @@ The algorithm is inspired by Cormen, Leiserson and Rivest (1990) File: slib.info, Node: Hashing, Next: Space-Filling Curves, Prev: Topological Sort, Up: Sorting and Searching -Hashing -------- +7.2.6 Hashing | +------------- | -`(require 'hash)' +`(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 + -- 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. @@ -12607,54 +13370,159 @@ Hash tables use these functions. File: slib.info, Node: Space-Filling Curves, Next: Soundex, Prev: Hashing, Up: Sorting and Searching -Space-Filling Curves --------------------- +7.2.7 Space-Filling Curves | +-------------------------- | * Menu: -* Peano-Hilbert Space-Filling Curve:: +* Hilbert Space-Filling Curve:: Non-negative coordinates | +* Peano Space-Filling Curve:: Integer coordinates | * Sierpinski Curve:: -File: slib.info, Node: Peano-Hilbert Space-Filling Curve, Next: Sierpinski Curve, Prev: Space-Filling Curves, Up: Space-Filling Curves - -Peano-Hilbert Space-Filling Curve -................................. +File: slib.info, Node: Hilbert Space-Filling Curve, Next: Peano Space-Filling Curve, Prev: Space-Filling Curves, Up: Space-Filling Curves + | +7.2.7.1 Hilbert Space-Filling Curve | +................................... | -`(require 'hilbert-fill)' +`(require 'hilbert-fill)' -The "Peano-Hilbert Space-Filling Curve" is a one-to-one mapping between -a unit line segment and an N-dimensional unit cube. +The "Hilbert Space-Filling Curve" is a one-to-one mapping between a | +unit line segment and an N-dimensional unit cube. This implementation | +treats the nonnegative integers either as fractional bits of a given | +width or as nonnegative integers. | The integer procedures map the non-negative integers to an arbitrarily large N-dimensional cube with its corner at the origin and all coordinates are non-negative. -For any exact nonnegative integers SCALAR and RANK, +For any exact nonnegative integer SCALAR and exact integer RANK > 2, | (= SCALAR (hilbert-coordinates->integer (integer->hilbert-coordinates SCALAR RANK))) => #t - - Function: integer->hilbert-coordinates scalar rank + When treating integers as K fractional bits, | + | + (= SCALAR (hilbert-coordinates->integer | + (integer->hilbert-coordinates SCALAR RANK K)) K) | + => #t | + | + -- Function: integer->hilbert-coordinates scalar rank | Returns a list of RANK integer coordinates corresponding to exact non-negative integer SCALAR. The lists returned by `integer->hilbert-coordinates' for SCALAR arguments 0 and 1 will differ in the first element. - - Function: hilbert-coordinates->integer coords + -- Function: integer->hilbert-coordinates scalar rank k | + SCALAR must be a nonnegative integer of no more than `RANK*K' bits. | + | + `integer->hilbert-coordinates' Returns a list of RANK K-bit | + nonnegative integer coordinates corresponding to exact | + non-negative integer SCALAR. The curves generated by | + `integer->hilbert-coordinates' have the same alignment independent | + of K. | + | + -- Function: hilbert-coordinates->integer coords | + -- Function: hilbert-coordinates->integer coords k | Returns an exact non-negative integer corresponding to COORDS, a list of non-negative integer coordinates. +7.2.7.2 Gray code | +................. | + | +A "Gray code" is an ordering of non-negative integers in which exactly | +one bit differs between each pair of successive elements. There are | +multiple Gray codings. An n-bit Gray code corresponds to a Hamiltonian | +cycle on an n-dimensional hypercube. | + | +Gray codes find use communicating incrementally changing values between | +asynchronous agents. De-laminated Gray codes comprise the coordinates | +of Hilbert space-filling curves. | + | + -- Function: integer->gray-code k | + Converts K to a Gray code of the same `integer-length' as K. | + | + -- Function: gray-code->integer k | + Converts the Gray code K to an integer of the same | + `integer-length' as K. | + | + For any non-negative integer K, | + (eqv? k (gray-code->integer (integer->gray-code k))) | + | + -- Function: = k1 k2 | + -- Function: gray-code<? k1 k2 | + -- Function: gray-code>? k1 k2 | + -- Function: gray-code<=? k1 k2 | + -- Function: gray-code>=? k1 k2 | + These procedures return #t if their Gray code arguments are | + (respectively): equal, monotonically increasing, monotonically | + decreasing, monotonically nondecreasing, or monotonically | + nonincreasing. | + | + For any non-negative integers K1 and K2, the Gray code predicate | + of `(integer->gray-code k1)' and `(integer->gray-code k2)' will | + return the same value as the corresponding predicate of K1 and K2. | + | +7.2.7.3 Bitwise Lamination | +.......................... | + | + -- Function: bitwise-laminate k1 ... | + -- Function: bitwise-delaminate count k | + Returns an integer composed of the bits of K1 ... interlaced in | + argument order. Given K1, ... KN, the n low-order bits of the | + returned value will be the lowest-order bit of each argument. | + | + -- Function: bitwise-laminate count k | + Returns a list of COUNT integers comprised of every COUNTh bit of | + the integer K. | + | + (map (lambda (k) (number->string k 2)) | + (bitwise-delaminate 4 #x7654)) | + => ("0" "1111" "1100" "1010") | + (number->string (bitwise-laminate 0 #b1111 #b1100 #b1010) 16) | + => "7654" | + | + For any non-negative integers K and COUNT: | + (eqv? k (bitwise-laminate (bitwise-delaminate count k))) | + | + -- Function: delaminate-list count ks | + Returns a list of COUNT integers comprised of the Jth bit of the | + integers KS where J ranges from COUNT-1 to 0. | + | + (map (lambda (k) (number->string k 2)) | + (delaminate-list 4 '(7 6 5 4 0 0 0 0))) | + => ("0" "11110000" "11000000" "10100000") | + | + `delaminate-list' is its own inverse: | + (delaminate-list 8 (delaminate-list 4 '(7 6 5 4 0 0 0 0))) | + => (7 6 5 4 0 0 0 0) | + | -File: slib.info, Node: Sierpinski Curve, Prev: Peano-Hilbert Space-Filling Curve, Up: Space-Filling Curves - -Sierpinski Curve -................ +File: slib.info, Node: Peano Space-Filling Curve, Next: Sierpinski Curve, Prev: Hilbert Space-Filling Curve, Up: Space-Filling Curves + | +7.2.7.4 Peano Space-Filling Curve | +................................. | + | + -- Function: integer->peano-coordinates scalar rank | + Returns a list of RANK nonnegative integer coordinates | + corresponding to exact nonnegative integer SCALAR. The lists | + returned by `integer->peano-coordinates' for SCALAR arguments 0 | + and 1 will differ in the first element. | + | + -- Function: peano-coordinates->integer coords | + Returns an exact nonnegative integer corresponding to COORDS, a | + list of nonnegative integer coordinates. | + | + +File: slib.info, Node: Sierpinski Curve, Prev: Peano Space-Filling Curve, Up: Space-Filling Curves + | +7.2.7.5 Sierpinski Curve | +........................ | -`(require 'sierpinski)' +`(require 'sierpinski)' - - Function: make-sierpinski-indexer max-coordinate + -- 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. @@ -12701,12 +13569,12 @@ Sierpinski Curve File: slib.info, Node: Soundex, Next: String Search, Prev: Space-Filling Curves, Up: Sorting and Searching -Soundex -------- +7.2.8 Soundex | +------------- | -`(require 'soundex)' +`(require 'soundex)' - - Function: soundex name + -- 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 @@ -12729,7 +13597,7 @@ Soundex (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") @@ -12737,31 +13605,31 @@ Soundex 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: String Search, Next: Sequence Comparison, Prev: Soundex, Up: Sorting and Searching -String Search -------------- +7.2.9 String Search | +------------------- | -`(require 'string-search)' +`(require 'string-search)' - - Procedure: string-index string char - - Procedure: string-index-ci string char + -- Procedure: string-index string char | + -- Procedure: string-index-ci 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: string-reverse-index string char - - Procedure: string-reverse-index-ci string char + -- Procedure: string-reverse-index string char | + -- Procedure: string-reverse-index-ci string char | Returns the index of the last occurence of CHAR within STRING, or `#f' if the STRING does not contain a character CHAR. - - Procedure: substring? pattern string | - - Procedure: substring-ci? pattern string | + -- Procedure: substring? pattern string | + -- Procedure: substring-ci? 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 @@ -12771,18 +13639,18 @@ String Search (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 max-no-chars | Looks for a string STR within the first MAX-NO-CHARS chars of the input port IN-PORT. - - Procedure: find-string-from-port? str in-port + -- 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. - - Procedure: find-string-from-port? str in-port char + -- Procedure: find-string-from-port? str in-port char | Searches up to the first occurrence of character CHAR in STR. - - Procedure: find-string-from-port? str in-port proc + -- Procedure: find-string-from-port? str in-port proc | Searches up to the first occurrence of the procedure PROC returning non-false when called with a character (from IN-PORT) argument. @@ -12797,47 +13665,48 @@ String Search can be used even if the IN-PORT is open to a pipe or other communication channel. - - Function: string-subst txt old1 new1 ... + -- Function: string-subst txt old1 new1 ... | Returns a copy of string TXT with all occurrences of string OLD1 in TXT replaced with NEW1; then OLD2 replaced with NEW2 .... Matches are found from the left. Matches do not overlap. - - Function: count-newlines str | + -- Function: count-newlines str | Returns the number of `#\newline' characters in string STR. File: slib.info, Node: Sequence Comparison, Prev: String Search, Up: Sorting and Searching -Sequence Comparison -------------------- +7.2.10 Sequence Comparison | +-------------------------- | -`(require 'diff)' +`(require 'diff)' `diff:edit-length' implements the algorithm: S. Wu, E. Myers, U. Manber, and W. Miller, "An O(NP) Sequence Comparison Algorithm," Information Processing Letters 35, 6 (1990), 317-323. - <http://www.cs.arizona.edu/people/gene/vita.html> + `http://www.cs.arizona.edu/people/gene/PAPERS/np_diff.ps' | The values returned by `diff:edit-length' can be used to gauge the degree of match between two sequences. -Surprisingly, "An O(NP) Sequence Comparison Algorithm" does not derive -the edit sequence; only the sequence length. Developing this | -linear-space sub-quadratic-time algorithm for computing the edit | -sequence required hundreds of hours of work. I have submitted a paper | -describing the algorithm to the Journal of Computational Biology. | +`diff:edits' and `diff:longest-common-subsequence' combine the | +algorithm with the divide-and-conquer method outlined in: | + | + E. Myers and W. Miller, | + "Optimal alignments in linear space", | + Computer Application in the Biosciences (CABIOS), 4(1):11-17, 1988. | + `http://www.cs.arizona.edu/people/gene/PAPERS/linear.ps' | If the items being sequenced are text lines, then the computed edit-list is equivalent to the output of the "diff" utility program. If the items being sequenced are words, then it is like the lesser -known "spiff" program. +known "spiff" program. - - Function: diff:longest-common-subsequence array1 array2 =? p-lim - - Function: diff:longest-common-subsequence array1 array2 =? - ARRAY1 and ARRAY2 are one-dimensional arrays. The procedure =? is - used to compare sequence tokens for equality. + -- Function: diff:longest-common-subsequence array1 array2 p-lim | + -- Function: diff:longest-common-subsequence array1 array2 | + ARRAY1 and ARRAY2 are one-dimensional arrays. | The non-negative integer P-LIM, if provided, is maximum number of deletions of the shorter sequence to allow. @@ -12848,10 +13717,9 @@ known "spiff" program. of length `(quotient (- (+ len1 len2) (diff:edit-length ARRAY1 ARRAY2)) 2)' holding the longest sequence common to both ARRAYs. - - Function: diff:edits array1 array2 =? p-lim - - Function: diff:edits array1 array2 =? - ARRAY1 and ARRAY2 are one-dimensional arrays. The procedure =? is - used to compare sequence tokens for equality. + -- Function: diff:edits array1 array2 p-lim | + -- Function: diff:edits array1 array2 | + ARRAY1 and ARRAY2 are one-dimensional arrays. | The non-negative integer P-LIM, if provided, is maximum number of deletions of the shorter sequence to allow. `diff:edits' will @@ -12868,10 +13736,9 @@ known "spiff" program. K < 0 Deletes `(array-ref ARRAY2 (- -1 K))' from the sequence. - - Function: diff:edit-length array1 array2 =? p-lim - - Function: diff:edit-length array1 array2 =? - ARRAY1 and ARRAY2 are one-dimensional arrays. The procedure =? is - used to compare sequence tokens for equality. + -- Function: diff:edit-length array1 array2 p-lim | + -- Function: diff:edit-length array1 array2 | + ARRAY1 and ARRAY2 are one-dimensional arrays. | The non-negative integer P-LIM, if provided, is maximum number of deletions of the shorter sequence to allow. `diff:edit-length' @@ -12880,21 +13747,21 @@ known "spiff" program. `diff:edit-length' returns the length of the shortest sequence of edits transformaing ARRAY1 to ARRAY2. - (diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm" eqv?) + (diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm") | => "fghijklm" - - (diff:edit-length "fghiejcklm" "fgehijkpqrlm" eqv?) + + (diff:edit-length "fghiejcklm" "fgehijkpqrlm") | => 6 - - (diff:edits "fghiejcklm" "fgehijkpqrlm" eqv?) - => #As32(3 -5 -7 8 9 10) + + (diff:edits "fghiejcklm" "fgehijkpqrlm") | + => #A:fixZ32b(3 -5 -7 8 9 10) | ; e c h p q r File: slib.info, Node: Procedures, Next: Standards Support, Prev: Sorting and Searching, Up: Other Packages -Procedures -========== +7.3 Procedures | +============== | Anything that doesn't fall neatly into any of the other categories winds up here. @@ -12911,15 +13778,15 @@ up here. File: slib.info, Node: Type Coercion, Next: String-Case, Prev: Procedures, Up: Procedures -Type Coercion -------------- +7.3.1 Type Coercion | +------------------- | -`(require 'coerce)' +`(require 'coerce)' - - Function: type-of obj + -- Function: type-of obj | Returns a symbol name for the type of OBJ. - - Function: coerce obj result-type + -- Function: coerce obj result-type | Converts and returns OBJ of type `char', `number', `string', `symbol', `list', or `vector' to RESULT-TYPE (which must be one of these symbols). @@ -12927,33 +13794,33 @@ Type Coercion File: slib.info, Node: String-Case, Next: String Ports, Prev: Type Coercion, Up: Procedures -String-Case ------------ +7.3.2 String-Case | +----------------- | -`(require 'string-case)' +`(require 'string-case)' - - Procedure: string-upcase str - - Procedure: string-downcase str - - Procedure: string-capitalize str + -- 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-capitalize! str | + -- Function: string-upcase! str | + -- Function: string-downcase! str | + -- Function: string-capitalize! str | The destructive versions of the functions above. - - Function: string-ci->symbol str + -- Function: string-ci->symbol str | Converts string STR to a symbol having the same case as if the symbol had been `read'. - - Function: symbol-append obj1 ... + -- Function: symbol-append obj1 ... | Converts OBJ1 ... to strings, appends them, and converts to a symbol which is returned. Strings and numbers are converted to read's symbol case; the case of symbol characters is not changed. #f is converted to the empty string (symbol). - - Function: StudlyCapsExpand str delimiter - - Function: StudlyCapsExpand str + -- Function: StudlyCapsExpand str delimiter | + -- Function: StudlyCapsExpand str | DELIMITER must be a string or character. If absent, DELIMITER defaults to `-'. `StudlyCapsExpand' returns a copy of STR where DELIMITER is inserted between each lower-case character @@ -12975,18 +13842,18 @@ String-Case File: slib.info, Node: String Ports, Next: Line I/O, Prev: String-Case, Up: Procedures -String Ports ------------- +7.3.3 String Ports | +------------------ | -`(require 'string-port)' +`(require 'string-port)' - - Procedure: call-with-output-string proc + -- 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 + -- 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 @@ -12995,13 +13862,13 @@ String Ports File: slib.info, Node: Line I/O, Next: Multi-Processing, Prev: String Ports, Up: Procedures -Line I/O --------- +7.3.4 Line I/O | +-------------- | -`(require 'line-i/o)' +`(require 'line-i/o)' - - Function: read-line - - Function: read-line port + -- 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 @@ -13009,8 +13876,8 @@ Line I/O which case it defaults to the value returned by `current-input-port'. - - Procedure: read-line! string | - - Procedure: read-line! string port | + -- Procedure: read-line! string | + -- Procedure: 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 @@ -13020,44 +13887,44 @@ Line I/O which case it defaults to the value returned by `current-input-port'. - - Function: write-line string - - Function: write-line string 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. The PORT argument may be omitted, in which case it defaults to the value returned by `current-input-port'. - - Function: system->line command tmp | - - Function: system->line command | - COMMAND must be a string. The string TMP, if supplied, is a path | - to use as a temporary file. `system->line' calls `system' with | - COMMAND as argument, redirecting stdout to file TMP. | - `system->line' returns a string containing the first line of | - output from TMP. | + -- Function: system->line command tmp | + -- Function: system->line command | + COMMAND must be a string. The string TMP, if supplied, is a path + to use as a temporary file. `system->line' calls `system' with + COMMAND as argument, redirecting stdout to file TMP. + `system->line' returns a string containing the first line of + output from TMP. File: slib.info, Node: Multi-Processing, Next: Metric Units, Prev: Line I/O, Up: Procedures -Multi-Processing ----------------- +7.3.5 Multi-Processing | +---------------------- | -`(require 'process)' +`(require 'process)' This module implements asynchronous (non-polled) time-sliced multi-processing in the SCM Scheme implementation using procedures `alarm' and `alarm-interrupt'. Until this is ported to another implementation, consider it an example of writing schedulers in Scheme. - - Procedure: add-process! proc + -- 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! + -- 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! + -- 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::). @@ -13065,12 +13932,12 @@ implementation, consider it an example of writing schedulers in Scheme. File: slib.info, Node: Metric Units, Prev: Multi-Processing, Up: Procedures -Metric Units ------------- +7.3.6 Metric Units | +------------------ | -`(require 'metric-units)' +`(require 'metric-units)' - <http://swissnet.ai.mit.edu/~jaffer/MIXF.html> + `http://swiss.csail.mit.edu/~jaffer/MIXF' | "Metric Interchange Format" is a character string encoding for numerical values and units which: @@ -13132,8 +13999,8 @@ used with the unit symbols t (metric ton), r (revolution), or Bd (baud). Exponents may be positive or negative. Fractional exponents must be parenthesized. -SI Prefixes -........... +7.3.6.1 SI Prefixes | +................... | Factor Name Symbol | Factor Name Symbol ====== ==== ====== | ====== ==== ====== @@ -13148,8 +14015,8 @@ SI Prefixes 1e2 hecto h | 1e-21 zepto z 1e1 deka da | 1e-24 yocto y -Binary Prefixes -............... +7.3.6.2 Binary Prefixes | +....................... | These binary prefixes are valid only with the units B (byte) and bit. However, decimal prefixes can also be used with bit; and decimal @@ -13164,8 +14031,8 @@ multiple (not submultiple) prefixes can also be used with B (byte). 1.048576e6 (2^20) mebi Mi 1.024e3 (2^10) kibi Ki -Unit Symbols -............ +7.3.6.3 Unit Symbols | +.................... | Type of Quantity Name Symbol Equivalent ================ ==== ====== ========== @@ -13221,7 +14088,7 @@ Unit Symbols * db/Np = ln(10) / 20 - - Function: si:conversion-factor to-unit from-unit + -- Function: si:conversion-factor to-unit from-unit | If the strings FROM-UNIT and TO-UNIT express valid unit expressions for quantities of the same unit-dimensions, then the value returned by `si:conversion-factor' will be such that @@ -13259,8 +14126,8 @@ Unit Symbols File: slib.info, Node: Standards Support, Next: Session Support, Prev: Procedures, Up: Other Packages -Standards Support -================= +7.4 Standards Support | +===================== | * Menu: @@ -13272,7 +14139,7 @@ Standards Support * Multi-argument / and -:: 'multiarg/and- * Multi-argument Apply:: 'multiarg-apply * Rationalize:: 'rationalize -* Promises:: 'delay | +* Promises:: 'delay * Dynamic-Wind:: 'dynamic-wind * Eval:: 'eval * Values:: 'values @@ -13281,19 +14148,19 @@ Standards Support File: slib.info, Node: RnRS, Next: With-File, Prev: Standards Support, Up: Standards Support -RnRS ----- +7.4.1 RnRS | +---------- | The `r2rs', `r3rs', `r4rs', and `r5rs' features attempt to provide procedures and macros to bring a Scheme implementation to the desired version of Scheme. - - Feature: r2rs + -- Feature: r2rs | Requires features implementing procedures and optional procedures specified by `Revised^2 Report on the Algorithmic Language Scheme'; namely `rev3-procedures' and `rev2-procedures'. - - Feature: r3rs + -- Feature: r3rs | Requires features implementing procedures and optional procedures specified by `Revised^3 Report on the Algorithmic Language Scheme'; namely `rev3-procedures'. @@ -13301,12 +14168,12 @@ version of Scheme. _Note:_ SLIB already mandates the `r3rs' procedures which can be portably implemented in `r4rs' implementations. - - Feature: r4rs + -- Feature: r4rs | Requires features implementing procedures and optional procedures specified by `Revised^4 Report on the Algorithmic Language Scheme'; namely `rev4-optional-procedures'. - - Feature: r5rs + -- Feature: r5rs | Requires features implementing procedures and optional procedures specified by `Revised^5 Report on the Algorithmic Language Scheme'; namely `values', `macro', and `eval'. @@ -13314,42 +14181,42 @@ version of Scheme. File: slib.info, Node: With-File, Next: Transcripts, Prev: RnRS, Up: Standards Support -With-File ---------- +7.4.2 With-File | +--------------- | -`(require 'with-file)' +`(require 'with-file)' - - Function: with-input-from-file file thunk - - Function: with-output-to-file file thunk + -- 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 ------------ +7.4.3 Transcripts | +----------------- | -`(require 'transcript)' +`(require 'transcript)' - - Function: transcript-on filename - - Function: transcript-off filename + -- 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 ---------------- +7.4.4 Rev2 Procedures | +--------------------- | -`(require '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, chokes on this module. - - Procedure: substring-move-left! string1 start1 end1 string2 start2 - - Procedure: substring-move-right! string1 start1 end1 string2 start2 + -- 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 @@ -13365,110 +14232,103 @@ Scheme->C, for instance, chokes on this module. increasing indices. `substring-move-right!' stores characters in time order of increasing indeces. - - Procedure: substring-fill! string start end char + -- Procedure: substring-fill! string start end char | Fills the elements START-END of STRING with the character CHAR. - - Function: string-null? str + -- Function: string-null? str | == `(= 0 (string-length STR))' - - Procedure: append! pair1 ... + -- Procedure: append! pair1 ... | Destructively appends its arguments. Equivalent to `nconc'. - - Function: 1+ n + -- Function: 1+ n | Adds 1 to N. - - Function: -1+ n + -- Function: -1+ n | Subtracts 1 from N. - - Function: <? - - Function: <=? - - Function: =? - - Function: >? - - Function: >=? + -- 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 ------------------------- +7.4.5 Rev4 Optional Procedures | +------------------------------ | -`(require '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-tail l p | - - Function: list->string l + -- Function: string-copy | - - Function: string-copy + -- Procedure: string-fill! s obj | - - Procedure: string-fill! s obj - - - Function: list->vector l - - - Function: vector->list s - - - Procedure: vector-fill! s obj + -- 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 - ----------------------- +7.4.6 Multi-argument / and - | +---------------------------- | -`(require 'multiarg/and-)' +`(require 'multiarg/and-)' For the specification of these optional forms, *Note Numerical -operations: (r4rs)Numerical operations. | +operations: (r4rs)Numerical operations. - - Function: / dividend divisor1 ... - | - - Function: - minuend subtrahend1 ... + -- Function: / dividend divisor1 ... | + + -- Function: - minuend subtrahend1 ... | File: slib.info, Node: Multi-argument Apply, Next: Rationalize, Prev: Multi-argument / and -, Up: Standards Support -Multi-argument Apply --------------------- +7.4.7 Multi-argument Apply | +-------------------------- | -`(require 'multiarg-apply)' +`(require 'multiarg-apply)' For the specification of this optional form, *Note Control features: (r4rs)Control features. - | - - Function: apply proc arg1 ... + + -- Function: apply proc arg1 ... | File: slib.info, Node: Rationalize, Next: Promises, Prev: Multi-argument Apply, Up: Standards Support -Rationalize ------------ +7.4.8 Rationalize | +----------------- | -`(require 'rationalize)' +`(require 'rationalize)' - - Function: rationalize x e | + -- Function: rationalize x e | 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. + `Rationalize' has limited use in implementations lacking exact (non-integer) rational numbers. The following procedures return a list of the numerator and denominator. - - Function: find-ratio x e | + -- Function: find-ratio x e | `find-ratio' returns the list of the _simplest_ numerator and - denominator whose quotient differs from X by no more than E. | + denominator whose quotient differs from X by no more than E. (find-ratio 3/97 .0001) => (3 97) (find-ratio 3/97 .001) => (1 32) - - Function: find-ratio-between x y + -- Function: find-ratio-between x y | `find-ratio-between' returns the list of the _simplest_ numerator and denominator between X and Y. @@ -13478,38 +14338,38 @@ of the numerator and denominator. File: slib.info, Node: Promises, Next: Dynamic-Wind, Prev: Rationalize, Up: Standards Support -Promises --------- +7.4.9 Promises | +-------------- | -`(require 'promise)' +`(require 'promise)' - - Function: make-promise proc + -- Function: make-promise proc | + + -- Function: force promise | + + `(require 'delay)' provides `force' and `delay': + + -- Macro: delay obj | + Change occurrences of `(delay EXPRESSION)' to + + (make-promise (lambda () EXPRESSION)) - - Function: force promise | - | - `(require 'delay)' provides `force' and `delay': | - | - - Macro: delay obj | - Change occurrences of `(delay EXPRESSION)' to | - | - (make-promise (lambda () EXPRESSION)) | - | - | - (*note Control features: (r4rs)Control features.). | + + (*note Control features: (r4rs)Control features.). File: slib.info, Node: Dynamic-Wind, Next: Eval, Prev: Promises, Up: Standards Support -Dynamic-Wind ------------- +7.4.10 Dynamic-Wind | +------------------- | -`(require '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 + -- Procedure: dynamic-wind thunk1 thunk2 thunk3 | The arguments THUNK1, THUNK2, and THUNK3 must all be procedures of no arguments (thunks). @@ -13530,12 +14390,12 @@ designed to take into account the fact that continuations produced by File: slib.info, Node: Eval, Next: Values, Prev: Dynamic-Wind, Up: Standards Support -Eval ----- +7.4.11 Eval | +----------- | -`(require 'eval)' +`(require 'eval)' - - Function: eval expression environment-specifier + -- Function: eval expression environment-specifier | Evaluates EXPRESSION in the specified environment and returns its value. EXPRESSION must be a valid Scheme expression represented as data, and ENVIRONMENT-SPECIFIER must be a value returned by one @@ -13548,15 +14408,15 @@ Eval (eval '(* 7 3) (scheme-report-environment 5)) => 21 - + (let ((f (eval '(lambda (f x) (f x x)) (null-environment)))) (f + 10)) => 20 - - Function: scheme-report-environment version - - Function: null-environment version - - Function: null-environment + -- Function: scheme-report-environment version | + -- Function: null-environment version | + -- Function: null-environment | VERSION must be an exact non-negative integer N corresponding to a version of one of the Revised^N Reports on Scheme. `Scheme-report-environment' returns a specifier for an environment @@ -13577,7 +14437,7 @@ Eval `scheme-report-environment' may be immutable. - - Function: interaction-environment + -- Function: interaction-environment | This optional procedure returns a specifier for the environment that contains implementation-defined bindings, typically a superset of those listed in the report. The intent is that this @@ -13613,16 +14473,16 @@ Here are some more `eval' examples: File: slib.info, Node: Values, Next: SRFI, Prev: Eval, Up: Standards Support -Values ------- +7.4.12 Values | +------------- | -`(require 'values)' +`(require 'values)' - - Function: values obj ... + -- Function: values obj ... | `values' takes any number of arguments, and passes (returns) them to its continuation. - - Function: call-with-values thunk proc + -- 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 @@ -13637,13 +14497,13 @@ Values File: slib.info, Node: SRFI, Prev: Values, Up: Standards Support -SRFI ----- +7.4.13 SRFI | +----------- | -`(require 'srfi)' +`(require 'srfi)' Implements "Scheme Request For Implementation" (SRFI) as described at -<http://srfi.schemers.org/> +`http://srfi.schemers.org/' | The Copyright terms of each SRFI states: @@ -13653,7 +14513,7 @@ Therefore, the specification of SRFI constructs must not be quoted without including the complete SRFI document containing discussion and a sample implementation program. - - Macro: cond-expand <clause1> <clause2> ... + -- Macro: cond-expand <clause1> <clause2> ... | _Syntax:_ Each <clause> should be of the form (<feature> <expression1> ...) @@ -13669,230 +14529,292 @@ a sample implementation program. an error is signaled. SLIB `cond-expand' is an extension of SRFI-0, - <http://srfi.schemers.org/srfi-0/srfi-0.html>. + `http://srfi.schemers.org/srfi-0/srfi-0.html'. | * Menu: * SRFI-1:: list-processing -* SRFI-2:: guarded LET* special form | -* SRFI-8:: Binding to multiple values | -* SRFI-9:: Defining Record Types | +* SRFI-2:: guarded LET* special form +* SRFI-8:: Binding to multiple values +* SRFI-9:: Defining Record Types + SRFI-47 is the same as *Note Arrays::. | + | File: slib.info, Node: SRFI-1, Next: SRFI-2, Prev: SRFI, Up: SRFI - | -SRFI-1 -...... -`(require 'srfi-1)' +7.4.13.1 SRFI-1 | +............... | + +`(require 'srfi-1)' Implements the "SRFI-1" "list-processing library" as described at -<http://srfi.schemers.org/srfi-1/srfi-1.html> +`http://srfi.schemers.org/srfi-1/srfi-1.html' | Constructors ------------ - - Function: xcons d a + -- Function: xcons d a | `(define (xcons d a) (cons a d))'. - - Function: list-tabulate len proc + -- Function: list-tabulate len proc | Returns a list of length LEN. Element I is `(PROC I)' for 0 <= I < LEN. - - Function: cons* obj1 obj2 + -- Function: cons* obj1 obj2 | - - Function: list-copy flist | - | - - Function: iota count start step - - Function: iota count start - - Function: iota count + -- Function: list-copy flist | + + -- Function: iota count start step | + -- Function: iota count start | + -- Function: iota count | Returns a list of COUNT numbers: (START, START+STEP, ..., START+(COUNT-1)*STEP). - - Function: circular-list obj1 obj2 ... + -- Function: circular-list obj1 obj2 ... | Returns a circular list of OBJ1, OBJ2, .... Predicates ---------- - - Function: proper-list? obj + -- Function: proper-list? obj | - - Function: circular-list? x + -- Function: circular-list? x | - - Function: dotted-list? obj + -- Function: dotted-list? obj | - - Function: null-list? obj + -- Function: null-list? obj | - - Function: not-pair? obj + -- Function: not-pair? obj | - - Function: list= =pred list ... + -- Function: list= =pred list ... | Selectors --------- - - Function: first pair - | - - Function: second pair | - | - - Function: third pair | - | - - Function: fourth pair | - | - - Function: fifth pair | - - Function: sixth obj - - Function: seventh obj - - Function: eighth obj - - Function: ninth obj - - Function: tenth obj + -- Function: first pair | - - Function: car+cdr pair - | - - Function: drop lst k - - Function: take lst k | - | - - Procedure: take! lst k | + -- Function: second pair | - - Function: take-right lst k + -- Function: third pair | - - Function: drop-right lst k | - | - - Procedure: drop-right! lst k | - | - - Function: split-at lst k + -- Function: fourth pair | - - Procedure: split-at! lst k | - | - - Function: last lst - (car (last-pair lst)) + -- Function: fifth pair | + -- Function: sixth pair | + -- Function: seventh pair | + -- Function: eighth pair | + -- Function: ninth pair | + -- Function: tenth pair | + + -- Function: car+cdr pair | + + -- Function: drop lst k | + -- Function: take lst k | + -- Function: take! lst k | + + -- Function: take-right lst k | + + -- Function: drop-right lst k | + + -- Procedure: drop-right! lst k | + + -- Function: split-at lst k | + -- Function: split-at! lst k | + + -- Function: last lst k ... | Miscellaneous ------------- - - Function: length+ obj + -- Function: length+ clist | - - Function: concatenate lists - - Function: concatenate! lists + -- Function: concatenate lists | + -- Function: concatenate! lists | - - Procedure: reverse! lst | + -- Procedure: reverse! lst | - - Function: append-reverse rev-head tail - - Function: append-reverse! rev-head tail + -- Function: append-reverse rev-head tail | + -- Function: append-reverse! rev-head tail | - - Function: zip list1 list2 ... + -- Function: zip list1 list2 ... | - - Function: unzip1 lst - - Function: unzip2 lst - - Function: unzip3 lst - - Function: unzip4 lst - - Function: unzip5 lst + -- Function: unzip1 lst | + -- Function: unzip2 lst | + -- Function: unzip3 lst | + -- Function: unzip4 lst | + -- Function: unzip5 lst | - - Function: count pred list1 list2 ... + -- Function: count pred list1 list2 ... | Fold and Unfold --------------- - - Procedure: map! f list1 clist2 ... | + -- Function: fold kons knil clist1 clist2 ... | + + -- Function: fold-right kons knil clist1 clist2 ... | + | + -- Function: pair-fold kons knil clist1 clist2 ... | + | + -- Function: pair-fold-right kons knil clist1 clist2 ... | | - - Function: pair-for-each f clist1 clist2 ... | + -- Function: reduce f ridentity list | + -- Function: reduce-right f ridentity list | | + -- Procedure: map! f clist1 clist2 ... | + | + -- Function: pair-for-each f clist1 clist2 ... | + Filtering and Partitioning -------------------------- - - Function: filter pred lis | + -- Function: filter pred list | + + -- Procedure: filter! pred list | + + -- Function: partition pred list | | - - Procedure: filter! pred l | + -- Function: remove pred list | | - - Function: partition pred list | + -- Procedure: partition! pred list | | + -- Procedure: remove! pred list | + Searching --------- - - Function: find pred list + -- Function: find pred clist | - - Function: find-tail pred list + -- Function: find-tail pred clist | - - Function: remove pred l | - | - - Procedure: remove! pred l | - | - - Function: any pred clist1 clist2 ... | - | - - Function: list-index pred clist1 clist2 ... | - | - - Function: span pred list | + -- Function: span pred list | + + -- Procedure: span! pred list | + + -- Function: break pred list | + + -- Procedure: break! pred list | + + -- Function: any pred clist1 clist2 ... | + + -- Function: list-index pred clist1 clist2 ... | | - - Function: member obj list pred - - Function: member obj list - `member' returns the first sublist of LIST whose car is OBJ, where - the sublists of LIST are the non-empty lists returned by - (list-tail LIST K) for K less than the length of LIST. If OBJ - does not occur in LIST, then #f (not the empty list) is returned. - The procedure PRED is used for testing equality. If PRED is not - provided, `equal?' is used. + -- Function: member obj list = | + -- Function: member obj list | Deleting -------- + -- Function: delete-duplicates x list = | + -- Function: delete-duplicates x list | + | + -- Procedure: delete-duplicates! x list = | + -- Procedure: delete-duplicates! x list | + | Association lists ----------------- - - Function: assoc obj alist pred - - Function: assoc obj alist - ALIST (for "association list") must be a list of pairs. These - procedures find the first pair in ALIST whose car field is OBJ, and - returns that pair. If no pair in ALIST has OBJ as its car, then #f - (not the empty list) is returned. The procedure PRED is used for - testing equality. If PRED is not provided, `equal?' is used. + -- Function: assoc obj alist pred | + -- Function: assoc obj alist | + | + -- Function: alist-cons key datum alist | + | + -- Function: alist-copy alist | + | + -- Function: alist-delete key alist = | + -- Function: alist-delete key alist | + | + -- Procedure: alist-delete! key alist = | + -- Procedure: alist-delete! key alist | Set operations -------------- - -File: slib.info, Node: SRFI-2, Next: SRFI-8, Prev: SRFI-1, Up: SRFI + -- Function: lset<= = list1 ... | + Determine if a transitive subset relation exists between the | + lists LIST1 ..., using = to determine equality of list members. | | -SRFI-2 | -...... | + -- Function: lset= = list1 list2 ... | | -`(require 'srfi-2)' | + -- Function: lset-adjoin list elt1 ... | | - - Macro: and-let* claws body ... | - <http://srfi.schemers.org/srfi-2/srfi-2.html> | + -- Function: lset-union = list1 ... | | - -File: slib.info, Node: SRFI-8, Next: SRFI-9, Prev: SRFI-2, Up: SRFI + -- Function: lset-intersection = list1 list2 ... | | -SRFI-8 | -...... | + -- Function: lset-difference = list1 list2 ... | | -`(require 'srfi-8)' | + -- Function: lset-xor = list1 ... | | - - Special Form: receive formals expression body ... | - <http://srfi.schemers.org/srfi-8/srfi-8.html> | + -- Function: lset-diff+intersection = list1 list2 ... | | - -File: slib.info, Node: SRFI-9, Prev: SRFI-8, Up: SRFI +These are linear-update variants. They are allowed, but not required, | +to use the cons cells in their first list parameter to construct their | +answer. `lset-union!' is permitted to recycle cons cells from any of | +its list arguments. | | -SRFI-9 | -...... | + -- Procedure: lset-intersection! = list1 list2 ... | | -`(require 'srfi-9)' | + -- Procedure: lset-difference! = list1 list2 ... | | - <http://srfi.schemers.org/srfi-9/srfi-9.html> | + -- Procedure: lset-union! = list1 ... | | - - Special Form: define-record-type <type-name> (<constructor-name> | - <field-tag> ...) <predicate-name> <field spec> ... | - Where | - <field-spec> == (<field-tag> <accessor-name>) | - == (<field-tag> <accessor-name> <modifier-name>) | + -- Procedure: lset-xor! = list1 ... | | - `define-record-type' is a syntax wrapper for the SLIB `record' | - module. | + -- Procedure: lset-diff+intersection! = list1 list2 ... | | +File: slib.info, Node: SRFI-2, Next: SRFI-8, Prev: SRFI-1, Up: SRFI + +7.4.13.2 SRFI-2 | +............... | + +`(require 'srfi-2)' + + -- Macro: and-let* claws body ... | + `http://srfi.schemers.org/srfi-2/srfi-2.html' | + + +File: slib.info, Node: SRFI-8, Next: SRFI-9, Prev: SRFI-2, Up: SRFI + +7.4.13.3 SRFI-8 | +............... | + +`(require 'srfi-8)' + + -- Special Form: receive formals expression body ... | + `http://srfi.schemers.org/srfi-8/srfi-8.html' | + + +File: slib.info, Node: SRFI-9, Prev: SRFI-8, Up: SRFI + +7.4.13.4 SRFI-9 | +............... | + +`(require 'srfi-9)' + + `http://srfi.schemers.org/srfi-9/srfi-9.html' | + + -- Special Form: define-record-type <type-name> (<constructor-name> | + <field-tag> ...) <predicate-name> <field spec> ... + Where + <field-spec> == (<field-tag> <accessor-name>) + == (<field-tag> <accessor-name> <modifier-name>) + + `define-record-type' is a syntax wrapper for the SLIB `record' + module. + + File: slib.info, Node: Session Support, Next: System Interface, Prev: Standards Support, Up: Other Packages + +7.5 Session Support | +=================== | + | +If `(provided? 'abort)': | | -Session Support -=============== + -- Function: abort | + Resumes the top level Read-Eval-Print loop. If provided, `abort' | + is used by the `break' and `debug' packages. | * Menu: @@ -13905,20 +14827,20 @@ Session Support File: slib.info, Node: Repl, Next: Quick Print, Prev: Session Support, Up: Session Support -Repl ----- +7.5.1 Repl | +---------- | -`(require 'repl)' +`(require 'repl)' Here is a read-eval-print-loop which, given an eval, evaluates forms. - - Procedure: repl:top-level repl:eval + -- 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 + -- Procedure: repl:quit | Exits from the invocation of `repl:top-level'. The `repl:' procedures establish, as much as is possible to do @@ -13940,10 +14862,10 @@ catching lines and the following lines to your Scheme init file: File: slib.info, Node: Quick Print, Next: Debug, Prev: Repl, Up: Session Support -Quick Print ------------ +7.5.2 Quick Print | +----------------- | -`(require 'qp)' +`(require 'qp)' When displaying error messages and warnings, it is paramount that the output generated for circular lists and large data structures be @@ -13955,16 +14877,16 @@ much improved. 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 ... + -- 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* + -- Variable: *qp-width* | *QP-WIDTH* is the largest number of characters that `qp' should use. If *QP-WIDTH* is #f, then all items will be `write'n. If *QP-WIDTH* is 0, then all items except procedures will be @@ -13973,10 +14895,10 @@ much improved. File: slib.info, Node: Debug, Next: Breakpoints, Prev: Quick Print, Up: Session Support -Debug ------ +7.5.3 Debug | +----------- | -`(require 'debug)' +`(require 'debug)' Requiring `debug' automatically requires `trace' and `break'. @@ -13986,94 +14908,92 @@ printer for `qp'. This example shows how to do this: (define qpn (lambda args) ...) (provide 'qp) (require 'debug) - - - Procedure: trace-all file ... + + | + -- Procedure: trace-all file ... | Traces (*note Trace::) all procedures `define'd at top-level in `file' .... - - Procedure: track-all file ... + -- Procedure: track-all file ... | Tracks (*note Trace::) all procedures `define'd at top-level in `file' .... - - Procedure: stack-all file ... + -- Procedure: stack-all file ... | Stacks (*note Trace::) all procedures `define'd at top-level in `file' .... - - Procedure: break-all file ... + -- Procedure: break-all file ... | Breakpoints (*note Breakpoints::) all procedures `define'd at top-level in `file' .... File: slib.info, Node: Breakpoints, Next: Trace, Prev: Debug, Up: Session Support -Breakpoints ------------ +7.5.4 Breakpoints | +----------------- | -`(require 'break)' +`(require 'break)' - - Function: init-debug + -- 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 ... + -- Function: breakpoint arg1 ... | Returns from the top level continuation and pushes the continuation from which it was called on a continuation stack. - - Function: continue + -- Function: continue | Pops the topmost continuation off of the continuation stack and returns an unspecified value to it. - - Function: continue arg1 ... + -- Function: continue arg1 ... | Pops the topmost continuation off of the continuation stack and returns ARG1 ... to it. - - Macro: break proc1 ... + -- Macro: break proc1 ... | Redefines the top-level named procedures given as arguments so that `breakpoint' is called before calling PROC1 .... - - Macro: break + -- 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 ... + -- Macro: unbreak proc1 ... | Turns breakpoints off for its arguments. - - Macro: unbreak + -- Macro: unbreak | With no arguments, unbreaks all currently broken identifiers and returns a list of these formerly broken identifiers. These are _procedures_ for breaking. If defmacros are not natively supported by your implementation, these might be more convenient to use. - - Function: breakf proc - - Function: breakf proc name + -- Function: breakf proc | + -- Function: 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: unbreakf proc | To unbreak, type (set! SYMBOL (unbreakf SYMBOL)) File: slib.info, Node: Trace, Prev: Breakpoints, Up: Session Support -Tracing -------- +7.5.5 Tracing | +------------- | -`(require 'trace)' +`(require 'trace)' This feature provides three ways to monitor procedure invocations: @@ -14090,101 +15010,98 @@ trace ...' when the procdure is called; pops and prints `RETN PROCEDURE-NAME VALUE' when the procedure returns. - - Variable: debug:max-count + -- Variable: debug:max-count | If a traced procedure calls itself or untraced procedures which call it, stack, track, and trace will limit the number of stack pushes to DEBUG:MAX-COUNT. - - Function: print-call-stack - - Function: print-call-stack port + -- Function: print-call-stack | + -- Function: print-call-stack port | Prints the call-stack to PORT or the current-error-port. - - Macro: trace proc1 ... + -- Macro: trace proc1 ... | Traces the top-level named procedures given as arguments. - - Macro: trace + -- 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: track proc1 ... + -- Macro: track proc1 ... | Traces the top-level named procedures given as arguments. - - Macro: track + -- Macro: track | With no arguments, makes sure that all the currently tracked identifiers are tracked (even if those identifiers have been redefined) and returns a list of the tracked identifiers. - - Macro: stack proc1 ... + -- Macro: stack proc1 ... | Traces the top-level named procedures given as arguments. - - Macro: stack + -- Macro: stack | With no arguments, makes sure that all the currently stacked identifiers are stacked (even if those identifiers have been redefined) and returns a list of the stacked identifiers. - - Macro: untrace proc1 ... + -- Macro: untrace proc1 ... | Turns tracing, tracking, and off for its arguments. - - Macro: untrace + -- Macro: untrace | With no arguments, untraces all currently traced identifiers and returns a list of these formerly traced identifiers. - - Macro: untrack proc1 ... + -- Macro: untrack proc1 ... | Turns tracing, tracking, and off for its arguments. - - Macro: untrack + -- Macro: untrack | With no arguments, untracks all currently tracked identifiers and returns a list of these formerly tracked identifiers. - - Macro: unstack proc1 ... + -- Macro: unstack proc1 ... | Turns tracing, stacking, and off for its arguments. - - Macro: unstack + -- Macro: unstack | With no arguments, unstacks all currently stacked identifiers and returns a list of these formerly stacked identifiers. These are _procedures_ for tracing. If defmacros are not natively supported by your implementation, these might be more convenient to use. - - Function: tracef proc - - Function: tracef proc name - - Function: trackf proc | - - Function: trackf proc name | - - Function: stackf proc | - - Function: stackf proc name | + -- Function: tracef proc | + -- Function: tracef proc name | + -- Function: trackf proc | + -- Function: trackf proc name | + -- Function: stackf proc | + -- Function: stackf 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: untracef proc | Removes tracing, tracking, or stacking for PROC. To untrace, type (set! SYMBOL (untracef SYMBOL)) File: slib.info, Node: System Interface, Next: Extra-SLIB Packages, Prev: Session Support, Up: Other Packages -System Interface -================ +7.6 System Interface | +==================== | If `(provided? 'getenv)': - - Function: getenv name + -- 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 + -- Function: system command-string | Executes the COMMAND-STRING on the computer and returns the integer status code. @@ -14197,12 +15114,12 @@ If `(provided? 'system)': File: slib.info, Node: Directories, Next: Transactions, Prev: System Interface, Up: System Interface -Directories ------------ +7.6.1 Directories | +----------------- | -`(require 'directory)' +`(require 'directory)' - - Function: current-directory + -- Function: current-directory | `current-directory' returns a string containing the absolute file name representing the current working directory. If this string cannot be obtained, #f is returned. @@ -14210,22 +15127,22 @@ Directories If `current-directory' cannot be supported by the platform, then #f is returned. - - Function: make-directory name + -- Function: make-directory name | Creates a sub-directory NAME of the current-directory. If successful, `make-directory' returns #t; otherwise #f. - - Function: directory-for-each proc directory + -- Function: directory-for-each proc directory | PROC must be a procedure taking one argument. `Directory-For-Each' applies PROC to the (string) name of each file in DIRECTORY. The dynamic order in which PROC is applied to the filenames is unspecified. The value returned by `directory-for-each' is unspecified. - - Function: directory-for-each proc directory pred + -- Function: directory-for-each proc directory pred | Applies PROC only to those filenames for which the procedure PRED returns a non-false value. - - Function: directory-for-each proc directory match + -- Function: directory-for-each proc directory match | Applies PROC only to those filenames for which `(filename:match?? MATCH)' would return a non-false value (*note Filenames: (slib)Filenames.). @@ -14239,15 +15156,15 @@ Directories File: slib.info, Node: Transactions, Next: CVS, Prev: Directories, Up: System Interface -Transactions ------------- +7.6.2 Transactions | +------------------ | If `system' is provided by the Scheme implementation, the "transact" package provides functions for file-locking and file-replacement transactions. - `(require 'transact)' - | + `(require 'transact)' + File Locking ............ @@ -14268,9 +15185,9 @@ operating system development efforts. There is further irony that both camps support contention detection and resolution only through weak conventions of some their document editing programs. -The "file-lock" procedures implement a transaction method for file -replacement compatible with the methods used by the GNU "emacs" text -editor on Unix systems and the Microsoft "Word" editor. +The "file-lock" procedures implement a transaction method for file replacement +compatible with the methods used by the GNU "emacs" text editor on Unix | +systems and the Microsoft "Word" editor. | Both protocols employ what I term a "certificate" containing the user, hostname, time, and (on Unix) process-id. Intent to replace FILE is @@ -14283,12 +15200,12 @@ link to a certificate named for the visited FILE prefixed with `.#'. Because Unix systems can import Microsoft file systems, these routines maintain and check both Emacs and Word certificates. - - Function: file-lock-owner path + -- Function: file-lock-owner path | Returns the string `USER@HOSTNAME' associated with the lock owner of file PATH if locked; and #f otherwise. - - Procedure: file-lock! path email | - - Procedure: file-lock! path | + -- Procedure: file-lock! path email | + -- Procedure: file-lock! path | PATH must be a string naming the file to be locked. If supplied, EMAIL must be a string formatted as `USER@HOSTNAME'. If absent, EMAIL defaults to the value returned by `user-email-address'. @@ -14297,7 +15214,7 @@ maintain and check both Emacs and Word certificates. PATH is unlocked, then `file-lock!' returns the certificate string associated with the new lock for file PATH. - - Procedure: file-unlock! path certificate | + -- Procedure: file-unlock! path certificate | PATH must be a string naming the file to be unlocked. CERTIFICATE must be the string returned by `file-lock!' for PATH. @@ -14308,7 +15225,7 @@ maintain and check both Emacs and Word certificates. File Transactions ................. - - Function: emacs:backup-name path backup-style + -- Function: emacs:backup-name path backup-style | PATH must be a string. BACKUP-STYLE must be a symbol. Depending on BACKUP-STYLE, `emacs:backup-name' returns: none @@ -14332,10 +15249,10 @@ File Transactions bak the string "PATH.bak" - - Function: transact-file-replacement proc path backup-style + -- Function: transact-file-replacement proc path backup-style | certificate - - Function: transact-file-replacement proc path backup-style - - Function: transact-file-replacement proc path + -- Function: transact-file-replacement proc path backup-style | + -- Function: transact-file-replacement proc path | PATH must be a string naming an existing file. BACKUP-STYLE is one of the symbols none, simple, numbered, existing, orig, bak or #f; with meanings described above; or a string naming the location @@ -14368,7 +15285,7 @@ File Transactions Identification .............. - - Function: user-email-address + -- Function: user-email-address | `user-email-address' returns a string of the form `username@hostname'. If this e-mail address cannot be obtained, #f is returned. @@ -14376,42 +15293,45 @@ Identification File: slib.info, Node: CVS, Prev: Transactions, Up: System Interface -CVS ---- +7.6.3 CVS | +--------- | -`(require 'cvs)' +`(require 'cvs)' - - Function: cvs-files directory/ + -- Function: cvs-files directory/ | Returns a list of the local pathnames (with prefix DIRECTORY/) of all CVS controlled files in DIRECTORY/ and in DIRECTORY/'s subdirectories. - - Function: cvs-directories directory/ + -- Function: cvs-directories directory/ | Returns a list of all of DIRECTORY/ and all DIRECTORY/'s CVS controlled subdirectories. - - Function: cvs-root path/ + -- Function: cvs-root path/ | Returns the (string) contents of PATH/CVS/Root; or `(getenv "CVSROOT")' if Root doesn't exist. - - Function: cvs-repository directory/ + -- Function: cvs-repository directory/ | Returns the (string) contents of DIRECTORY/CVS/Root appended with DIRECTORY/CVS/Repository; or #f if DIRECTORY/CVS/Repository doesn't exist. - - Procedure: cvs-set-root! new-root directory/ | - Writes NEW-ROOT to file CVS/Root of DIRECTORY/ and all its + -- Procedure: cvs-set-root! new-root directory/ | + Writes NEW-ROOT to file CVS/Root of DIRECTORY/. | + | + -- Procedure: cvs-set-roots! new-root directory/ | + Writes NEW-ROOT to file CVS/Root of DIRECTORY/ and all its CVS | subdirectories. - - Function: cvs-vet directory/ + -- Function: cvs-vet directory/ | Signals an error if CVS/Repository or CVS/Root files in DIRECTORY/ or any subdirectory do not match. File: slib.info, Node: Extra-SLIB Packages, Prev: System Interface, Up: Other Packages -Extra-SLIB Packages -=================== +7.7 Extra-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: @@ -14435,9 +15355,9 @@ as easily as any other SLIB package. Some optional packages (for which SLIB-PSD is a portable debugger for Scheme (requires emacs editor). - http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz + http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz | - swissnet.ai.mit.edu:/pub/scm/slib-psd1-3.tar.gz + swiss.csail.mit.edu:/pub/scm/slib-psd1-3.tar.gz | ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz @@ -14467,35 +15387,38 @@ JFILTER File: slib.info, Node: About SLIB, Next: Index, Prev: Other Packages, Up: Top -About SLIB -********** +8 About SLIB | +************ | More people than I can name have contributed to SLIB. Thanks to all of you! - SLIB 3a1, released November 2003. | + SLIB 3a2, released June 2005. | Aubrey Jaffer <agj @ alum.mit.edu> Hyperactive Software - The Maniac Inside! - <http://swissnet.ai.mit.edu/~jaffer/SLIB.html> + `http://swiss.csail.mit.edu/~jaffer/SLIB.html' | * Menu: * Installation:: How to install SLIB on your system. +* The SLIB script:: Run interactive SLIB sessions. | * Porting:: SLIB to new platforms. * Coding Guidelines:: How to write modules for SLIB. * Copyrights:: Intellectual propery issues. -* About this manual:: | +* About this manual:: -File: slib.info, Node: Installation, Next: Porting, Prev: About SLIB, Up: About SLIB - -Installation -============ +File: slib.info, Node: Installation, Next: The SLIB script, Prev: About SLIB, Up: About SLIB + | +8.1 Installation | +================ | -There are four parts to installation: +There are five parts to installation: | * Unpack the SLIB distribution. + * Install documentation and `slib' script. | + | * Configure the Scheme implementation(s) to locate the SLIB directory. @@ -14504,8 +15427,8 @@ There are four parts to installation: * Build the SLIB catalog for the Scheme implementation. -Unpacking the SLIB Distribution -------------------------------- +8.1.1 Unpacking the SLIB Distribution | +------------------------------------- | If the SLIB distribution is a Linux RPM, it will create the SLIB directory `/usr/share/slib'. @@ -14518,8 +15441,14 @@ this might be `/usr/share/slib', `/usr/local/lib/slib', or `/usr/lib/slib'. If you know where SLIB should go on other platforms, please inform agj @ alum.mit.edu. -Configure Scheme Implementation to Locate SLIB ----------------------------------------------- +8.1.2 Install documentation and slib script | +------------------------------------------- | + | + make infoz | + make install | + | +8.1.3 Configure Scheme Implementation to Locate SLIB | +---------------------------------------------------- | If the Scheme implementation supports `getenv', then the value of the shell environment variable SCHEME_LIBRARY_PATH will be used for @@ -14531,8 +15460,8 @@ supports `getenv' but does not use it for determining The `(library-vicinity)' can also be specified from the SLIB initialization file or by implementation-specific means. -Loading SLIB Initialization File --------------------------------- +8.1.4 Loading SLIB Initialization File | +-------------------------------------- | Check the manifest in `README' to find a configuration file for your Scheme implementation. Initialization files for most IEEE P1178 @@ -14546,8 +15475,8 @@ the file for how to configure it. Once this is done, modify the startup file for your Scheme implementation to `load' this initialization file. -Build New SLIB Catalog for Implementation ------------------------------------------ +8.1.5 Build New SLIB Catalog for Implementation | +----------------------------------------------- | When SLIB is first used from an implementation, a file named `slibcat' is written to the `implementation-vicinity' for that implementation. @@ -14567,19 +15496,65 @@ SLIB-installed scheme implementation, type: (require 'new-catalog) (slib:exit) -Implementation-specific Instructions ------------------------------------- +8.1.6 Implementation-specific Instructions | +------------------------------------------ | Multiple implementations of Scheme can all use the same SLIB directory. Simply configure each implementation's initialization file as outlined above. - - Implementation: SCM + -- Implementation: SCM | The SCM implementation does not require any initialization file as SLIB support is already built into SCM. See the documentation with SCM for installation instructions. - - Implementation: VSCM + -- Implementation: PLT Scheme | + -- Implementation: DrScheme | + -- Implementation: MzScheme | + The `init.ss' file in the _slibinit_ collection is an SLIB | + initialization file. | + | + To use SLIB in MzScheme, set the SCHEME_LIBRARY_PATH environment | + variable to the installed SLIB location; then invoke MzScheme thus: | + | + `mzscheme -f ${SCHEME_LIBRARY_PATH}DrScheme.init' | + | + -- Implementation: MIT Scheme | + `scheme -load ${SCHEME_LIBRARY_PATH}mitscheme.init' | + | + -- Implementation: Gambit-C 3.0 | + `$command -:s ${SCHEME_LIBRARY_PATH}gambit.init -' | + | + -- Implementation: Guile | + Guile versions 1.6 and earlier link to an archaic SLIB version. In | + RedHat or Fedora installations: | + | + rm /usr/share/guile/slib | + ln -s ${SCHEME_LIBRARY_PATH} /usr/share/guile/slib | + | + In Debian installations: | + | + rm /usr/share/guile/1.6/slib | + ln -s ${SCHEME_LIBRARY_PATH} /usr/share/guile/1.6/slib | + | + `${SCHEME_LIBRARY_PATH}' is where SLIB gets installed. | + | + Guile with SLIB can then be started thus: | + | + `guile -l ${SCHEME_LIBRARY_PATH}guile.init' | + | + -- Implementation: Scheme48 | + To make a Scheme48 image for an installation under `<prefix>', | + | + 1. `cd' to the SLIB directory | + | + 2. type `make prefix=<prefix> slib48'. | + | + 3. 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. | + | + -- Implementation: VSCM | From: Matthias Blume <blume @ cs.Princeton.EDU> Date: Tue, 1 Mar 1994 11:42:31 -0500 @@ -14603,48 +15578,36 @@ above. Makefile (definition of DDP) for details.) - - Implementation: Scheme48 - To make a Scheme48 image for an installation under `<prefix>', - - 1. `cd' to the SLIB directory - - 2. type `make prefix=<prefix> slib48'. - - 3. 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. - - - Implementation: PLT Scheme - - Implementation: DrScheme - - Implementation: MzScheme - The `init.ss' file in the _slibinit_ collection is an SLIB - initialization file. + +File: slib.info, Node: The SLIB script, Next: Porting, Prev: Installation, Up: About SLIB + | +8.2 The SLIB script | +=================== | - To use SLIB in MzScheme, set the SCHEME_LIBRARY_PATH environment - variable to the installed SLIB location; then invoke MzScheme thus: +SLIB comes with shell script for Unix platforms. | - `mzscheme -f ${SCHEME_LIBRARY_PATH}DrScheme.init' + slib [ scm | gsi | mzscheme | guile | slib48 | scheme48 | scmlit ] | + | - - Implementation: MIT Scheme - `scheme -load ${SCHEME_LIBRARY_PATH}mitscheme.init' +Starts an interactive Scheme-with-SLIB session. | - - Implementation: Guile - `guile -l ${SCHEME_LIBRARY_PATH}guile.init' +The optional argument to the `slib' script is the Scheme implementation | +to run. Absent the argument, it searches for implementations in the | +above order. | -File: slib.info, Node: Porting, Next: Coding Guidelines, Prev: Installation, Up: About SLIB - -Porting -======= +File: slib.info, Node: Porting, Next: Coding Guidelines, Prev: The SLIB script, Up: About SLIB + | +8.3 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', | - `Revised^4 Report on the Algorithmic Language Scheme', or | - `Revised^5 Report on the Algorithmic Language Scheme' | - | -in order to support SLIB. (1) | +compliant with + `IEEE Std 1178-1990', + `Revised^4 Report on the Algorithmic Language Scheme', or + `Revised^5 Report on the Algorithmic Language Scheme' + in order to support SLIB. (1) `Template.scm' is an example configuration file. The comments inside will direct you on how to customize it to reflect your system. Give @@ -14656,9 +15619,9 @@ initialization file might be called `foo.init'. implementation's initialization. It will load `require.scm' from the library; this will allow the use of `provide', `provided?', and `require' along with the "vicinity" functions (these functions are -documented in the sections *Note Feature:: and *Note Require::). The | -rest of the library will then be accessible in a system independent | -fashion. | +documented in the sections *Note Feature:: and *Note Require::). The +rest of the library will then be accessible in a system independent +fashion. Please mail new working configuration files to `agj @ alum.mit.edu' so that they can be included in the SLIB distribution. @@ -14672,43 +15635,43 @@ Language Scheme' implementation, then you will need to finish writing File: slib.info, Node: Coding Guidelines, Next: Copyrights, Prev: Porting, Up: About SLIB -Coding Guidelines -================= +8.4 Coding Guidelines | +===================== | 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? 'r3rs)' or `(require 'r3rs)' (*note | -Require::). | +by using, for example, `(provided? 'r3rs)' or `(require 'r3rs)' (*note +Require::). - If a procedure defined in a module is called by other procedures in | -that module, then those procedures should instead call an alias defined | -in that module: | + If a procedure defined in a module is called by other procedures in +that module, then those procedures should instead call an alias defined +in that module: - (define module-name:foo foo) | - | - The module name and `:' should prefix that symbol for the internal | -name. Do not export internal aliases. | - | - A procedure is exported from a module by putting Schmooz-style | -comments (*note Schmooz::) or `;@' at the beginning of the line | -immediately preceding the definition (`define', `define-syntax', or | -`defmacro'). Modules, exports and other relevant issues are discussed | -in *Note Compiling Scheme::. | - | - Code submitted for inclusion in SLIB should not duplicate (more than | -one) routines already in SLIB files. Use `require' to force those | -library routines to be used by your package. | + (define module-name:foo foo) + + The module name and `:' should prefix that symbol for the internal +name. Do not export internal aliases. + + A procedure is exported from a module by putting Schmooz-style +comments (*note Schmooz::) or `;@' at the beginning of the line +immediately preceding the definition (`define', `define-syntax', or +`defmacro'). Modules, exports and other relevant issues are discussed +in *Note Compiling Scheme::. + + Code submitted for inclusion in SLIB should not duplicate (more than +one) routines already in SLIB files. Use `require' to force those +library routines to be used by your package. Documentation should be provided in Emacs Texinfo format if possible, -but documentation must be provided. | +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 -------------- +8.4.1 Modifications | +------------------- | Please document your changes. A line or two for `ChangeLog' is sufficient for simple fixes or extensions. Look at the format of @@ -14730,11 +15693,11 @@ fixes. File: slib.info, Node: Copyrights, Next: About this manual, Prev: Coding Guidelines, Up: About SLIB - | -Copyrights -========== -This section has instructions for SLIB authors regarding copyrights. +8.5 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 @@ -14744,8 +15707,8 @@ modify it. The comments at the beginning of `require.scm' and 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 ------------------------------------ +8.5.1 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 agj @ @@ -14772,8 +15735,8 @@ and have your employer sign it. Mail the signed disclaimer to the SLIB maintainer. Contact agj @ alum.mit.edu for the address to mail the disclaimer to. An example disclaimer follows. -Explicit copying terms ----------------------- +8.5.2 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: @@ -14790,8 +15753,8 @@ placing into the Public Domain (by sending me a disclaimer) you need to: disclaim to the SLIB maintainer. Contact agj @ alum.mit.edu for the address to mail the disclaimer to. -Example: Company Copyright Disclaimer -------------------------------------- +8.5.3 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 @@ -14809,1653 +15772,1950 @@ license out software produced there will do. Here is a sample wording: File: slib.info, Node: About this manual, Prev: Copyrights, Up: About SLIB - | -About this manual | -================= | - | - * 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. | - | - * Examples in this text were produced using the `scm' Scheme | - implementation. | - | - * At the beginning of each section, there is a line that looks like | - `(require 'feature)'. Include this line in your code prior to | - using the package. | - | + +8.6 About this manual | +===================== | + + * 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. + + * Examples in this text were produced using the `scm' Scheme + implementation. + + * At the beginning of each section, there is a line that looks like `(require + 'feature)'. Include this line in your code prior to using the | + package. | + File: slib.info, Node: Index, Prev: About SLIB, Up: Top + +Index | +***** | | Procedure and Macro Index ************************* This is an alphabetical list of all the procedures and macros in SLIB. + * Menu: * -: Multi-argument / and -. -* -1+: Rev2 Procedures. + (line 14) | +* -1+: Rev2 Procedures. (line 42) | * /: Multi-argument / and -. -* 1+: Rev2 Procedures. -* <=?: Rev2 Procedures. -* <?: Rev2 Procedures. -* =: Bit-Twiddling. -* =?: Rev2 Procedures. -* >=?: Rev2 Procedures. -* >?: Rev2 Procedures. -* absolute-path?: URI. -* absolute-uri?: URI. -* ac32: Arrays. -* ac64: Arrays. -* add-command-tables: Database Extension. -* add-domain: Using Databases. | -* add-domain on relational-database: Command Intrinsics. | -* add-process!: Multi-Processing. -* add-setter: Setters. -* adjoin: Lists as sets. -* adjoin-parameters!: Parameter lists. | + (line 12) | +* 1+: Rev2 Procedures. (line 39) | +* <=?: Rev2 Procedures. (line 46) | +* <?: Rev2 Procedures. (line 45) | +* =: Hilbert Space-Filling Curve. | + (line 72) | +* =?: Rev2 Procedures. (line 47) | +* >=?: Rev2 Procedures. (line 49) | +* >?: Rev2 Procedures. (line 48) | +* a:bool: Arrays. (line 236) | +* a:fixn16b: Arrays. (line 226) | +* a:fixn32b: Arrays. (line 221) | +* a:fixn64b: Arrays. (line 216) | +* a:fixn8b: Arrays. (line 231) | +* a:fixz16b: Arrays. (line 206) | +* a:fixz32b: Arrays. (line 201) | +* a:fixz64b: Arrays. (line 196) | +* a:fixz8b: Arrays. (line 211) | +* a:floc128b: Arrays. (line 149) | +* a:floc16b: Arrays. (line 161) | +* a:floc32b: Arrays. (line 157) | +* a:floc64b: Arrays. (line 153) | +* a:flor128b: Arrays. (line 165) | +* a:flor16b: Arrays. (line 177) | +* a:flor32b: Arrays. (line 173) | +* a:flor64b: Arrays. (line 169) | +* abort: Session Support. (line 9) | +* absolute-path?: URI. (line 102) | +* absolute-uri?: URI. (line 98) | +* add-command-tables: Database Extension. (line 11) | +* add-domain: Using Databases. (line 131) | +* add-domain on relational-database: Command Intrinsics. (line 10) | +* add-macro-support: Within-database. (line 52) | +* add-process!: Multi-Processing. (line 14) | +* add-setter: Setters. (line 43) | +* adjoin: Lists as sets. (line 10) | +* adjoin-parameters!: Parameter lists. (line 38) | * 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. -* alist-table: The Base. | -* and-let*: SRFI-2. | -* and?: Non-List functions. -* any: SRFI-1. | -* any?: Collections. -* append!: Rev2 Procedures. -* append-reverse: SRFI-1. -* append-reverse!: SRFI-1. + (line 65) | +* alist-associator: Association Lists. (line 28) | +* alist-cons: SRFI-1. (line 178) | +* alist-copy: SRFI-1. (line 180) | +* alist-delete: SRFI-1. (line 182) | +* alist-delete!: SRFI-1. (line 185) | +* alist-for-each: Association Lists. (line 53) | +* alist-inquirer: Association Lists. (line 23) | +* alist-map: Association Lists. (line 48) | +* alist-remover: Association Lists. (line 39) | +* alist-table: The Base. (line 12) | +* and-let*: SRFI-2. (line 9) | +* and?: Non-List functions. (line 7) | +* any: SRFI-1. (line 156) | +* any-bits-set?: Bit-Twiddling. (line 64) | +* any?: Collections. (line 83) | +* append!: Rev2 Procedures. (line 36) | +* append-reverse: SRFI-1. (line 95) | +* append-reverse!: SRFI-1. (line 96) | * apply: Multi-argument Apply. -* ar32: Arrays. -* ar64: Arrays. -* array-align: Subarrays. -* array-copy!: Array Mapping. -* array-dimensions: Arrays. -* array-for-each: Array Mapping. -* array-in-bounds?: Arrays. -* array-index-map!: Array Mapping. -* array-indexes: Array Mapping. -* array-map: Array Mapping. | -* array-map!: Array Mapping. -* array-rank: Arrays. -* array-ref: Arrays. -* array-set!: Arrays. -* array-shape: Arrays. -* array-trim: Subarrays. -* array=?: Arrays. -* array?: Arrays. -* as16: Arrays. -* as32: Arrays. -* as64: Arrays. -* as8: Arrays. -* asctime: Posix Time. -* ash: Bit-Twiddling. -* assoc: SRFI-1. -* at1: Arrays. -* atom?: Non-List functions. -* au16: Arrays. -* au32: Arrays. -* au64: Arrays. -* au8: Arrays. -* batch:call-with-output-script: Batch. -* batch:command: Batch. -* batch:comment: Batch. -* batch:delete-file: Batch. -* batch:initialize!: Batch. -* batch:lines->file: Batch. -* batch:rename-file: Batch. -* batch:run-script: Batch. -* batch:try-chopped-command: Batch. -* batch:try-command: Batch. | -* bit-field: Bit-Twiddling. -* bit-reverse: Bit-Twiddling. -* bitwise-if: Bit-Twiddling. -* bitwise:delaminate: Bit-Twiddling. -* bitwise:laminate: Bit-Twiddling. -* blackbody-spectrum: Spectra. -* booleans->integer: Bit-Twiddling. -* break: Breakpoints. -* break-all: Debug. -* breakf: Breakpoints. -* breakpoint: Breakpoints. -* browse: Database Browser. -* browse-url: System. -* butlast: Lists as sequences. -* butnthcdr: Lists as sequences. -* byte-ref: Byte. -* byte-set!: Byte. -* bytes: Byte. -* bytes->ieee-double: Byte/Number Conversions. | -* bytes->ieee-float: Byte/Number Conversions. | -* bytes->integer: Byte/Number Conversions. | -* bytes->list: Byte. -* bytes-copy: Byte. | -* bytes-length: Byte. -* bytes-reverse: Byte. | -* bytes-reverse!: Byte. | -* call-with-dynamic-binding: Dynamic Data Type. -* call-with-input-string: String Ports. -* call-with-open-ports: Input/Output. -* call-with-output-string: String Ports. -* call-with-tmpnam: Filenames. | -* call-with-values: Values. -* capture-syntactic-environment: Syntactic Closures. -* car+cdr: SRFI-1. -* cart-prod-tables on relational-database: Database Operations. | -* catalog->html: HTML Tables. -* catalog-id on base-table: Base Tables. | -* catalog:read: Catalog Vicinities. | -* cdna:base-count: NCBI-DNA. -* cdna:report-base-count: NCBI-DNA. -* cgi:serve-query: HTTP and CGI. -* 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. -* chromaticity->CIEXYZ: Spectra. -* chromaticity->whitepoint: Spectra. + (line 12) | +* arithmetic-shift: Bit-Twiddling. (line 182) | +* array->list: Arrays. (line 101) | +* array->vector: Arrays. (line 124) | +* array-dimensions: Arrays. (line 48) | +* array-for-each: Array Mapping. (line 25) | +* array-in-bounds?: Arrays. (line 133) | +* array-index-map!: Array Mapping. (line 34) | +* array-indexes: Array Mapping. (line 29) | +* array-map: Array Mapping. (line 17) | +* array-map!: Array Mapping. (line 9) | +* array-rank: Arrays. (line 44) | +* array-ref: Arrays. (line 136) | +* array-set!: Arrays. (line 139) | +* array-trim: Subarrays. (line 44) | +* array:copy!: Array Mapping. (line 50) | +* array?: Arrays. (line 9) | +* asctime: Posix Time. (line 62) | +* ash: Bit-Twiddling. (line 181) | +* assoc: SRFI-1. (line 175) | +* atom?: Non-List functions. (line 30) | +* batch:call-with-output-script: Batch. (line 47) | +* batch:command: Batch. (line 64) | +* batch:comment: Batch. (line 95) | +* batch:delete-file: Batch. (line 102) | +* batch:initialize!: Batch. (line 36) | +* batch:lines->file: Batch. (line 98) | +* batch:rename-file: Batch. (line 106) | +* batch:run-script: Batch. (line 88) | +* batch:try-chopped-command: Batch. (line 76) | +* batch:try-command: Batch. (line 72) | +* bit-count: Bit-Twiddling. (line 74) | +* bit-field: Bit-Twiddling. (line 156) | +* bit-set?: Bit-Twiddling. (line 135) | +* bitwise-and: Bit-Twiddling. (line 19) | +* bitwise-delaminate: Hilbert Space-Filling Curve. | + (line 90) | +* bitwise-if: Bit-Twiddling. (line 56) | +* bitwise-ior: Bit-Twiddling. (line 28) | +* bitwise-laminate: Hilbert Space-Filling Curve. | + (line 89) | +* bitwise-merge: Bit-Twiddling. (line 57) | +* bitwise-not: Bit-Twiddling. (line 46) | +* bitwise-xor: Bit-Twiddling. (line 37) | +* blackbody-spectrum: Spectra. (line 125) | +* booleans->integer: Bit-Twiddling. (line 229) | +* break <1>: Breakpoints. (line 28) | +* break: SRFI-1. (line 152) | +* break!: SRFI-1. (line 154) | +* break-all: Debug. (line 31) | +* breakf: Breakpoints. (line 47) | +* breakpoint: Breakpoints. (line 16) | +* browse: Database Browser. (line 9) | +* browse-url: System. (line 60) | +* butlast: Lists as sequences. (line 121) | +* butnthcdr: Lists as sequences. (line 147) | +* byte-ref: Byte. (line 14) | +* byte-set!: Byte. (line 18) | +* bytes: Byte. (line 32) | +* bytes->ieee-double: Byte/Number Conversions. + (line 58) | +* bytes->ieee-float: Byte/Number Conversions. + (line 41) | +* bytes->integer: Byte/Number Conversions. + (line 17) | +* bytes->list: Byte. (line 36) | +* bytes-copy: Byte. (line 47) | +* bytes-length: Byte. (line 29) | +* bytes-reverse: Byte. (line 53) | +* bytes-reverse!: Byte. (line 50) | +* call-with-dynamic-binding: Dynamic Data Type. (line 25) | +* call-with-input-string: String Ports. (line 15) | +* call-with-open-ports: Input/Output. (line 54) | +* call-with-output-string: String Ports. (line 9) | +* call-with-tmpnam: Filenames. (line 74) | +* call-with-values: Values. (line 13) | +* capture-syntactic-environment: Syntactic Closures. (line 211) | +* car+cdr: SRFI-1. (line 68) | +* cart-prod-tables on relational-database: Database Operations. + (line 78) | +* catalog->html: HTML Tables. (line 49) | +* catalog-id on base-table: Base Tables. (line 30) | +* catalog:read: Catalog Vicinities. (line 57) | +* cdna:base-count: NCBI-DNA. (line 35) | +* cdna:report-base-count: NCBI-DNA. (line 39) | +* cgi:serve-query: HTTP and CGI. (line 69) | +* chap:next-string: Chapter Ordering. (line 29) | +* chap:string<=?: Chapter Ordering. (line 25) | +* chap:string<?: Chapter Ordering. (line 14) | +* chap:string>=?: Chapter Ordering. (line 26) | +* chap:string>?: Chapter Ordering. (line 24) | +* check-parameters: Parameter lists. (line 59) | +* chromaticity->CIEXYZ: Spectra. (line 169) | +* chromaticity->whitepoint: Spectra. (line 172) | * CIE:DE*: Color Difference Metrics. + (line 20) | * CIE:DE*94: Color Difference Metrics. -* ciexyz->color: Color Spaces. -* CIEXYZ->e-sRGB: Color Conversions. -* CIEXYZ->L*a*b*: Color Conversions. -* CIEXYZ->L*u*v*: Color Conversions. -* CIEXYZ->RGB709: Color Conversions. -* CIEXYZ->sRGB: Color Conversions. -* CIEXYZ->xRGB: Color Conversions. | -* circular-list: SRFI-1. -* circular-list?: SRFI-1. -* cksum: Cyclic Checksum. | -* clear-sky-color-xyy: Daylight. -* clip-to-rect: Rectangles. | -* close-base on base-table: The Base. | -* close-database: Using Databases. -* close-database on relational-database: Database Operations. | -* close-port: Input/Output. -* close-table on relational-table: Table Administration. | -* CMC-DE: Color Difference Metrics. | + (line 27) | +* ciexyz->color: Color Spaces. (line 25) | +* CIEXYZ->e-sRGB: Color Conversions. (line 56) | +* CIEXYZ->L*a*b*: Color Conversions. (line 38) | +* CIEXYZ->L*u*v*: Color Conversions. (line 32) | +* CIEXYZ->RGB709: Color Conversions. (line 29) | +* CIEXYZ->sRGB: Color Conversions. (line 47) | +* CIEXYZ->xRGB: Color Conversions. (line 50) | +* circular-list: SRFI-1. (line 32) | +* circular-list?: SRFI-1. (line 40) | +* cksum: Cyclic Checksum. (line 149) | +* clear-sky-color-xyy: Daylight. (line 84) | +* clip-to-rect: Rectangles. (line 36) | +* close-base on base-table: The Base. (line 60) | +* close-database: Using Databases. (line 89) | +* close-database on relational-database: Database Operations. (line 20) | +* close-port: Input/Output. (line 47) | +* close-table on relational-table: Table Administration. + (line 20) | +* CMC-DE: Color Difference Metrics. + (line 61) | * CMC:DE*: Color Difference Metrics. -* codons<-cdna: NCBI-DNA. -* coerce: Type Coercion. -* collection?: Collections. -* color->ciexyz: Color Spaces. -* color->e-srgb: Color Spaces. -* color->l*a*b*: Color Spaces. -* color->l*c*h: Color Spaces. -* color->l*u*v*: Color Spaces. -* color->rgb709: Color Spaces. -* color->srgb: Color Spaces. -* color->string: Color Data-Type. -* color->xrgb: Color Spaces. -* color-dictionaries->lookup: Color Names. -* color-dictionary: Color Names. -* color-name->color: Color Names. -* color-name:canonicalize: Color Names. -* color-precision: Color Data-Type. -* color-space: Color Data-Type. -* color-white-point: Color Data-Type. -* color:ciexyz: Color Spaces. -* color:e-srgb: Color Spaces. -* color:l*a*b*: Color Spaces. -* color:l*c*h: Color Spaces. -* color:l*u*v*: Color Spaces. -* color:linear-transform: Color Conversions. | -* color:rgb709: Color Spaces. -* color:srgb: Color Spaces. -* color?: Color Data-Type. -* column-domains on relational-table: Table Administration. | -* column-foreigns on relational-table: Table Administration. | -* column-names on relational-table: Table Administration. | -* column-range: Column Ranges. | -* column-types on relational-table: Table Administration. | -* combine-ranges: Column Ranges. | -* combined-rulesets: Commutative Rings. -* command->p-specs: HTML. -* command:make-editable-table: HTML Tables. -* command:modify-table: HTML Tables. -* concatenate: SRFI-1. -* concatenate!: SRFI-1. -* cond-expand: SRFI. -* cons*: SRFI-1. -* continue: Breakpoints. -* convert-color: Color Data-Type. -* copy-bit: Bit-Twiddling. -* copy-bit-field: Bit-Twiddling. -* copy-list: List construction. -* copy-random-state: Exact Random Numbers. | -* copy-tree: Tree Operations. -* count: SRFI-1. -* count-newlines: String Search. | -* crc16: Cyclic Checksum. -* crc5: Cyclic Checksum. -* crc:make-table: Cyclic Checksum. -* create-array: Arrays. | -* create-database: Using Databases. -* create-database on relational-system: Relational Database Objects. | -* create-postscript-graph: PostScript Graphing. | -* create-table on relational-database: Database Operations. | -* create-view on relational-database: Database Operations. | -* cring:define-rule: Commutative Rings. -* ctime: Posix Time. -* current-directory: Directories. -* current-error-port: Input/Output. -* current-input-port <1>: Byte. + (line 65) | +* codons<-cdna: NCBI-DNA. (line 18) | +* coerce: Type Coercion. (line 12) | +* collection?: Collections. (line 36) | +* color->ciexyz: Color Spaces. (line 34) | +* color->e-srgb: Color Spaces. (line 252) | +* color->l*a*b*: Color Spaces. (line 91) | +* color->l*c*h: Color Spaces. (line 166) | +* color->l*u*v*: Color Spaces. (line 115) | +* color->rgb709: Color Spaces. (line 55) | +* color->srgb: Color Spaces. (line 209) | +* color->string: Color Data-Type. (line 95) | +* color->xrgb: Color Spaces. (line 212) | +* color-dictionaries->lookup: Color Names. (line 33) | +* color-dictionary: Color Names. (line 40) | +* color-name->color: Color Names. (line 27) | +* color-name:canonicalize: Color Names. (line 23) | +* color-precision: Color Data-Type. (line 46) | +* color-space: Color Data-Type. (line 43) | +* color-white-point: Color Data-Type. (line 51) | +* color:ciexyz: Color Spaces. (line 30) | +* color:e-srgb: Color Spaces. (line 241) | +* color:l*a*b*: Color Spaces. (line 83) | +* color:l*c*h: Color Spaces. (line 159) | +* color:l*u*v*: Color Spaces. (line 107) | +* color:linear-transform: Color Conversions. (line 27) | +* color:rgb709: Color Spaces. (line 51) | +* color:srgb: Color Spaces. (line 200) | +* color?: Color Data-Type. (line 9) | +* column-domains on relational-table: Table Administration. + (line 9) | +* column-foreigns on relational-table: Table Administration. + (line 8) | +* column-names on relational-table: Table Administration. + (line 7) | +* column-range: Column Ranges. (line 10) | +* column-types on relational-table: Table Administration. + (line 10) | +* combine-ranges: Column Ranges. (line 19) | +* combined-rulesets: Commutative Rings. (line 90) | +* command->p-specs: HTML. (line 149) | +* command:make-editable-table: HTML Tables. (line 98) | +* command:modify-table: HTML Tables. (line 87) | +* concatenate: SRFI-1. (line 90) | +* concatenate!: SRFI-1. (line 91) | +* cond-expand: SRFI. (line 20) | +* cons*: SRFI-1. (line 22) | +* continue: Breakpoints. (line 20) | +* convert-color: Color Data-Type. (line 54) | +* copy-bit: Bit-Twiddling. (line 144) | +* copy-bit-field: Bit-Twiddling. (line 167) | +* copy-list: List construction. (line 32) | +* copy-random-state: Exact Random Numbers. + (line 29) | +* copy-tree: Tree Operations. (line 33) | +* count: SRFI-1. (line 106) | +* count-newlines: String Search. (line 61) | +* crc16: Cyclic Checksum. (line 167) | +* crc5: Cyclic Checksum. (line 178) | +* crc:make-table: Cyclic Checksum. (line 131) | +* create-array: Arrays. (line 66) | +* create-database: Using Databases. (line 43) | +* create-database on relational-system: Relational Database Objects. + (line 34) | +* create-postscript-graph: PostScript Graphing. (line 17) | +* create-table on relational-database: Database Operations. (line 64) | +* create-view on relational-database: Database Operations. (line 75) | +* cring:define-rule: Commutative Rings. (line 116) | +* ctime: Posix Time. (line 68) | +* current-directory: Directories. (line 9) | +* current-error-port: Input/Output. (line 70) | +* current-input-port <1>: Byte. (line 74) | * current-input-port: Ruleset Definition and Use. -* current-output-port: Byte. -* current-time: Time and Date. -* cvs-directories: CVS. -* cvs-files: CVS. -* cvs-repository: CVS. -* cvs-root: CVS. -* cvs-set-root!: CVS. -* cvs-vet: CVS. -* db->html-directory: HTML Tables. -* db->html-files: HTML Tables. -* db->netscape: HTML Tables. -* decode-universal-time: Common-Lisp Time. -* define-*commands*: Database Extension. -* define-access-operation: Setters. -* define-command: Database Macros. -* define-domains: Using Databases. | -* define-operation: Yasos interface. -* define-predicate: Yasos interface. -* define-record-type: SRFI-9. | -* define-structure: Syntax-Case Macros. | -* define-syntax: Macro by Example. -* define-table: Database Macros. -* define-tables: Using Databases. -* defmacro: Defmacro. -* defmacro:eval: Defmacro. -* defmacro:expand*: Defmacro. -* defmacro:load: Defmacro. -* defmacro?: Defmacro. -* delay: Promises. | -* delete: Destructive list operations. | -* delete on base-table: Base Record Operations. | -* delete* on base-table: Aggregate Base Operations. | -* delete-domain on relational-database: Command Intrinsics. | -* delete-file: Input/Output. + (line 57) | +* current-output-port: Byte. (line 66) | +* current-time: Time and Date. (line 20) | +* cvs-directories: CVS. (line 14) | +* cvs-files: CVS. (line 9) | +* cvs-repository: CVS. (line 22) | +* cvs-root: CVS. (line 18) | +* cvs-set-root!: CVS. (line 27) | +* cvs-set-roots!: CVS. (line 30) | +* cvs-vet: CVS. (line 34) | +* db->html-directory: HTML Tables. (line 147) | +* db->html-files: HTML Tables. (line 137) | +* db->netscape: HTML Tables. (line 158) | +* decode-universal-time: Common-Lisp Time. (line 15) | +* define-*commands*: Database Extension. (line 16) | +* define-access-operation: Setters. (line 53) | +* define-command: Within-database. (line 17) | +* define-domains: Using Databases. (line 124) | +* define-macro: Within-database. (line 58) | +* define-operation: Yasos interface. (line 7) | +* define-predicate: Yasos interface. (line 12) | +* define-record-type: SRFI-9. (line 12) | +* define-structure: Define-Structure. (line 12) | +* define-syntax: Macro by Example. (line 39) | +* define-table: Within-database. (line 26) | +* define-tables: Using Databases. (line 134) | +* defmacro: Defmacro. (line 40) | +* defmacro:eval: Defmacro. (line 15) | +* defmacro:expand*: Defmacro. (line 51) | +* defmacro:load: Defmacro. (line 19) | +* defmacro?: Defmacro. (line 27) | +* delaminate-list: Hilbert Space-Filling Curve. | + (line 108) | +* delay: Promises. (line 15) | +* delete: Destructive list operations. + (line 58) | +* delete on base-table: Base Record Operations. + (line 37) | +* delete* on base-table: Aggregate Base Operations. + (line 11) | +* delete-domain on relational-database: Command Intrinsics. (line 39) | +* delete-duplicates: SRFI-1. (line 166) | +* delete-duplicates!: SRFI-1. (line 169) | +* delete-file: Input/Output. (line 14) | * delete-if: Destructive list operations. + (line 59) | * delete-if-not: Destructive list operations. -* delete-table on relational-database: Database Operations. | -* dequeue!: Queues. -* dequeue-all!: Queues. -* determinant: Matrix Algebra. -* diff:edit-length: Sequence Comparison. -* diff:edits: Sequence Comparison. -* diff:longest-common-subsequence: Sequence Comparison. -* difftime: Time and Date. -* directory-for-each: Directories. | -* do-elts: Collections. -* do-keys: Collections. -* domain-checker on relational-database: Command Intrinsics. | -* dotted-list?: SRFI-1. -* drop: SRFI-1. -* drop-right: SRFI-1. | -* drop-right!: SRFI-1. | -* dynamic-ref: Dynamic Data Type. -* dynamic-set!: Dynamic Data Type. -* dynamic-wind: Dynamic-Wind. -* dynamic?: Dynamic Data Type. -* e-sRGB->CIEXYZ: Color Conversions. -* e-srgb->color: Color Spaces. -* e-sRGB->e-sRGB: Color Conversions. -* e-sRGB->sRGB: Color Conversions. -* eighth: SRFI-1. -* emacs:backup-name: Transactions. -* empty?: Collections. -* encode-universal-time: Common-Lisp Time. -* enqueue!: Queues. -* equal?: Byte. -* eval: Eval. -* every: Lists as sets. -* every?: Collections. -* exports<-info-index: Top-level Variable References. | -* extended-euclid: Modular Arithmetic. -* factor: Prime Numbers. -* feature->export-alist: Module Manifests. | -* feature->exports: Module Manifests. | -* feature->requires: Module Manifests. | -* feature-eval: Feature. | + (line 60) | +* delete-table on relational-database: Database Operations. (line 59) | +* dequeue!: Queues. (line 28) | +* dequeue-all!: Queues. (line 36) | +* determinant: Matrix Algebra. (line 18) | +* diff:edit-length: Sequence Comparison. (line 64) | +* diff:edits: Sequence Comparison. (line 45) | +* diff:longest-common-subsequence: Sequence Comparison. (line 32) | +* difftime: Time and Date. (line 26) | +* directory-for-each: Directories. (line 21) | +* do-elts: Collections. (line 41) | +* do-keys: Collections. (line 57) | +* domain-checker on relational-database: Command Intrinsics. (line 42) | +* dotted-list?: SRFI-1. (line 42) | +* drop: SRFI-1. (line 70) | +* drop-right: SRFI-1. (line 76) | +* drop-right!: SRFI-1. (line 78) | +* dynamic-ref: Dynamic Data Type. (line 17) | +* dynamic-set!: Dynamic Data Type. (line 21) | +* dynamic-wind: Dynamic-Wind. (line 13) | +* dynamic?: Dynamic Data Type. (line 12) | +* e-sRGB->CIEXYZ: Color Conversions. (line 57) | +* e-srgb->color: Color Spaces. (line 235) | +* e-sRGB->e-sRGB: Color Conversions. (line 68) | +* e-sRGB->sRGB: Color Conversions. (line 60) | +* eighth: SRFI-1. (line 64) | +* emacs:backup-name: Transactions. (line 73) | +* empty?: Collections. (line 99) | +* encode-universal-time: Common-Lisp Time. (line 40) | +* enqueue!: Queues. (line 25) | +* equal? <1>: Byte. (line 44) | +* equal?: Arrays. (line 19) | +* eval: Eval. (line 9) | +* every: Lists as sets. (line 91) | +* every?: Collections. (line 91) | +* exports<-info-index: Top-level Variable References. + (line 35) | +* expt: Miscellany. (line 20) | +* extended-euclid: Modular Arithmetic. (line 28) | +* factor: Prime Numbers. (line 41) | +* feature->export-alist: Module Manifests. (line 100) | +* feature->exports: Module Manifests. (line 105) | +* feature->requires: Module Manifests. (line 29) | +* feature->requires*: Module Manifests. (line 45) | +* feature-eval: Feature. (line 52) | * fft: Fast Fourier Transform. + (line 9) | * fft-1: Fast Fourier Transform. -* fifth: SRFI-1. -* file->color-dictionary: Color Names. -* file->definitions: Module Manifests. | -* file->exports: Module Manifests. | -* file->loads: Module Manifests. | -* file->requires: Module Manifests. | -* file-exists?: Input/Output. -* file-lock!: Transactions. -* file-lock-owner: Transactions. -* file-unlock!: Transactions. | -* filename:match-ci??: Filenames. -* filename:match??: Filenames. -* filename:substitute-ci??: Filenames. -* filename:substitute??: Filenames. -* fill-empty-parameters: Parameter lists. -* fill-rect: Rectangles. | -* filter: SRFI-1. | -* filter!: SRFI-1. | -* find: SRFI-1. -* find-if: Lists as sets. -* find-ratio: Rationalize. -* find-ratio-between: Rationalize. -* find-string-from-port?: String Search. -* find-tail: SRFI-1. -* first: SRFI-1. -* fluid-let: Fluid-Let. -* for-each-elt: Collections. -* for-each-key: Collections. | -* for-each-key on base-table: Aggregate Base Operations. | -* for-each-row on relational-table: Multi-Row Operations. | -* for-each-row-in-order on relational-table: Sequential Index Operations. | -* force: Promises. | -* force-output: Input/Output. -* form:delimited: HTML. -* form:element: HTML. -* form:image: HTML. -* form:reset: HTML. -* form:submit: HTML. -* fourth: SRFI-1. | + (line 14) | +* fifth: SRFI-1. (line 61) | +* file->color-dictionary: Color Names. (line 68) | +* file->definitions: Module Manifests. (line 72) | +* file->exports: Module Manifests. (line 84) | +* file->loads: Module Manifests. (line 53) | +* file->requires: Module Manifests. (line 15) | +* file->requires*: Module Manifests. (line 49) | +* file-exists?: Input/Output. (line 9) | +* file-lock!: Transactions. (line 52) | +* file-lock-owner: Transactions. (line 48) | +* file-unlock!: Transactions. (line 62) | +* filename:match-ci??: Filenames. (line 10) | +* filename:match??: Filenames. (line 9) | +* filename:substitute-ci??: Filenames. (line 35) | +* filename:substitute??: Filenames. (line 34) | +* fill-empty-parameters: Parameter lists. (line 51) | +* fill-rect: Rectangles. (line 30) | +* filter: SRFI-1. (line 129) | +* filter!: SRFI-1. (line 131) | +* find: SRFI-1. (line 144) | +* find-if: Lists as sets. (line 138) | +* find-ratio: Rationalize. (line 20) | +* find-ratio-between: Rationalize. (line 27) | +* find-string-from-port?: String Search. (line 30) | +* find-tail: SRFI-1. (line 146) | +* first: SRFI-1. (line 53) | +* first-set-bit: Bit-Twiddling. (line 100) | +* fluid-let: Fluid-Let. (line 9) | +* fold: SRFI-1. (line 111) | +* fold-right: SRFI-1. (line 113) | +* for-each-elt: Collections. (line 67) | +* for-each-key: Collections. (line 66) | +* for-each-key on base-table: Aggregate Base Operations. + (line 16) | +* for-each-row on relational-table: Multi-Row Operations. + (line 33) | +* for-each-row-in-order on relational-table: Sequential Index Operations. + (line 11) | +* force: Promises. (line 11) | +* force-output: Input/Output. (line 74) | +* form:delimited: HTML. (line 138) | +* form:element: HTML. (line 98) | +* form:image: HTML. (line 92) | +* form:reset: HTML. (line 95) | +* form:submit: HTML. (line 84) | +* format: Format Interface. (line 7) | +* fourth: SRFI-1. (line 59) | * fprintf: Standard Formatted Output. + (line 10) | * fscanf: Standard Formatted Input. -* gen-elts: Collections. | -* gen-keys: Collections. | -* generic-write: Generic-Write. -* gentemp: Defmacro. -* get on relational-table: Table Operations. | -* get* on relational-table: Match-Keys. | -* get-decoded-time: Common-Lisp Time. -* get-foreign-choices: HTML. | -* get-method: Object. -* get-universal-time: Common-Lisp Time. -* getenv: System Interface. -* getopt: Getopt. -* getopt--: Getopt. | + (line 14) | +* gen-elts: Collections. (line 25) | +* gen-keys: Collections. (line 29) | +* generic-write: Generic-Write. (line 15) | +* gentemp: Defmacro. (line 9) | +* get on relational-table: Table Operations. (line 18) | +* get* on relational-table: Match-Keys. (line 29) | +* get-decoded-time: Common-Lisp Time. (line 7) | +* get-foreign-choices: HTML. (line 146) | +* get-method: Object. (line 78) | +* get-universal-time: Common-Lisp Time. (line 10) | +* getenv: System Interface. (line 9) | +* getopt: Getopt. (line 39) | +* getopt--: Getopt. (line 125) | * getopt->arglist: Getopt Parameter lists. + (line 37) | * getopt->parameter-list: Getopt Parameter lists. -* glob-pattern?: URI. -* gmktime: Posix Time. -* gmtime: Posix Time. -* golden-section-search: Minimizing. -* gray-code->integer: Bit-Twiddling. -* gray-code<=?: Bit-Twiddling. -* gray-code<?: Bit-Twiddling. -* gray-code>=?: Bit-Twiddling. -* gray-code>?: Bit-Twiddling. -* grey: Color Names. -* grid-horizontals: Legending. | -* grid-verticals: Legending. | -* gtime: Posix 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-rehasher: Hash Tables. | -* hash-remover: Hash Tables. -* hashq: Hashing. -* hashv: Hashing. -* heap-extract-max!: Priority Queues. -* heap-insert!: Priority Queues. -* heap-length: Priority Queues. -* hilbert-coordinates->integer: Peano-Hilbert Space-Filling Curve. -* histograph: Character Plotting. | -* home-vicinity: Vicinity. -* htm-fields: Parsing HTML. -* html-for-each: Parsing HTML. -* html:anchor: URI. -* html:atval: HTML. -* html:base: URI. -* html:body: HTML. -* html:buttons: HTML. -* html:caption: HTML Tables. -* html:checkbox: HTML. -* html:comment: HTML. -* html:delimited-list: HTML. | -* html:editable-row-converter: HTML Tables. -* html:form: HTML. -* html:head: HTML. -* html:heading: HTML Tables. -* html:hidden: HTML. -* html:href-heading: HTML Tables. -* html:http-equiv: HTML. -* html:isindex: URI. -* html:link: URI. -* html:linked-row-converter: HTML Tables. -* html:meta: HTML. -* html:meta-refresh: HTML. -* html:plain: HTML. -* html:pre: HTML. -* html:read-title: Parsing HTML. -* html:select: HTML. -* html:table: HTML Tables. -* html:text: HTML. -* html:text-area: HTML. -* http:content: HTTP and CGI. -* http:error-page: HTTP and CGI. -* http:forwarding-page: HTTP and CGI. -* http:header: HTTP and CGI. -* http:serve-query: HTTP and CGI. -* identifier=?: Syntactic Closures. -* identifier?: Syntactic Closures. -* identity: Miscellany. -* ieee-byte-collate: Byte/Number Conversions. | -* ieee-byte-collate!: Byte/Number Conversions. | -* ieee-byte-decollate: Byte/Number Conversions. | -* ieee-byte-decollate!: Byte/Number Conversions. | -* ieee-double->bytes: Byte/Number Conversions. | -* ieee-float->bytes: Byte/Number Conversions. | -* implementation-vicinity: Vicinity. -* in-graphic-context: Graphics Context. | -* in-vicinity: Vicinity. -* init-debug: Breakpoints. -* integer->bytes: Byte/Number Conversions. | -* integer->gray-code: Bit-Twiddling. -* integer->hilbert-coordinates: Peano-Hilbert Space-Filling Curve. -* integer->list: Bit-Twiddling. -* integer-byte-collate: Byte/Number Conversions. | -* integer-byte-collate!: Byte/Number Conversions. | -* integer-expt: Bit-Twiddling. -* integer-length: Bit-Twiddling. -* integer-sqrt: Root Finding. -* interaction-environment: Eval. -* interpolate-from-table: Database Interpolation. | -* intersection: Lists as sets. -* iota: SRFI-1. -* isam-next on relational-table: Sequential Index Operations. | -* isam-prev on relational-table: Sequential Index Operations. | -* jacobi-symbol: Prime Numbers. -* kill-process!: Multi-Processing. -* kill-table on base-table: Base Tables. | -* L*a*b*->CIEXYZ: Color Conversions. -* l*a*b*->color: Color Spaces. -* L*a*b*->L*C*h: Color Conversions. -* L*a*b*:DE*: Color Difference Metrics. | -* l*c*h->color: Color Spaces. -* L*C*h->L*a*b*: Color Conversions. -* L*C*h:DE*94: Color Difference Metrics. | -* L*u*v*->CIEXYZ: Color Conversions. -* l*u*v*->color: Color Spaces. -* laguerre:find-polynomial-root: Root Finding. -* laguerre:find-root: Root Finding. -* last <1>: SRFI-1. -* last: Lists as sequences. -* last-pair: Miscellany. -* length+: SRFI-1. -* library-vicinity: Vicinity. -* light:ambient: Solid Modeling. -* light:beam: Solid Modeling. -* light:directional: Solid Modeling. -* light:point: Solid Modeling. -* light:spot: Solid Modeling. -* list*: List construction. -* list->bytes: Byte. -* list->integer: Bit-Twiddling. -* list->string: Rev4 Optional Procedures. -* list->vector: Rev4 Optional Procedures. -* list-copy: SRFI-1. | -* list-index: SRFI-1. | -* list-of??: Lists as sets. -* list-table-definition: Using Databases. -* list-tabulate: SRFI-1. + (line 10) | +* glob-pattern?: URI. (line 110) | +* gmktime: Posix Time. (line 50) | +* gmtime: Posix Time. (line 36) | +* golden-section-search: Minimizing. (line 18) | +* gray-code->integer: Hilbert Space-Filling Curve. | + (line 65) | +* gray-code<=?: Hilbert Space-Filling Curve. | + (line 75) | +* gray-code<?: Hilbert Space-Filling Curve. | + (line 73) | +* gray-code>=?: Hilbert Space-Filling Curve. | + (line 76) | +* gray-code>?: Hilbert Space-Filling Curve. | + (line 74) | +* grey: Color Names. (line 13) | +* grid-horizontals: Legending. (line 58) | +* grid-verticals: Legending. (line 54) | +* gtime: Posix Time. (line 67) | +* has-duplicates?: Lists as sets. (line 187) | +* hash: Hashing. (line 14) | +* hash-associator: Hash Tables. (line 36) | +* hash-for-each: Hash Tables. (line 51) | +* hash-inquirer: Hash Tables. (line 31) | +* hash-map: Hash Tables. (line 46) | +* hash-rehasher: Hash Tables. (line 56) | +* hash-remover: Hash Tables. (line 41) | +* hashq: Hashing. (line 12) | +* hashv: Hashing. (line 13) | +* heap-extract-max!: Priority Queues. (line 23) | +* heap-insert!: Priority Queues. (line 19) | +* heap-length: Priority Queues. (line 16) | +* hilbert-coordinates->integer: Hilbert Space-Filling Curve. | + (line 45) | +* histograph: Character Plotting. (line 83) | +* home-vicinity: Vicinity. (line 51) | +* htm-fields: Parsing HTML. (line 58) | +* html-for-each: Parsing HTML. (line 10) | +* html:anchor: URI. (line 24) | +* html:atval: HTML. (line 9) | +* html:base: URI. (line 39) | +* html:body: HTML. (line 47) | +* html:buttons: HTML. (line 81) | +* html:caption: HTML Tables. (line 11) | +* html:checkbox: HTML. (line 69) | +* html:comment: HTML. (line 55) | +* html:delimited-list: HTML. (line 143) | +* html:editable-row-converter: HTML Tables. (line 117) | +* html:form: HTML. (line 61) | +* html:head: HTML. (line 39) | +* html:heading: HTML Tables. (line 15) | +* html:hidden: HTML. (line 66) | +* html:href-heading: HTML Tables. (line 18) | +* html:http-equiv: HTML. (line 24) | +* html:isindex: URI. (line 43) | +* html:link: URI. (line 32) | +* html:linked-row-converter: HTML Tables. (line 22) | +* html:meta: HTML. (line 17) | +* html:meta-refresh: HTML. (line 30) | +* html:plain: HTML. (line 13) | +* html:pre: HTML. (line 50) | +* html:read-title: Parsing HTML. (line 44) | +* html:select: HTML. (line 78) | +* html:table: HTML Tables. (line 9) | +* html:text: HTML. (line 72) | +* html:text-area: HTML. (line 75) | +* http:content: HTTP and CGI. (line 13) | +* http:error-page: HTTP and CGI. (line 20) | +* http:forwarding-page: HTTP and CGI. (line 26) | +* http:header: HTTP and CGI. (line 9) | +* http:serve-query: HTTP and CGI. (line 36) | +* identifier=?: Syntactic Closures. (line 369) | +* identifier?: Syntactic Closures. (line 334) | +* identity: Miscellany. (line 9) | +* ieee-byte-collate: Byte/Number Conversions. + (line 144) | +* ieee-byte-collate!: Byte/Number Conversions. + (line 135) | +* ieee-byte-decollate: Byte/Number Conversions. + (line 148) | +* ieee-byte-decollate!: Byte/Number Conversions. + (line 140) | +* ieee-double->bytes: Byte/Number Conversions. + (line 92) | +* ieee-float->bytes: Byte/Number Conversions. + (line 76) | +* illuminant-map: Spectra. (line 77) | +* illuminant-map->XYZ: Spectra. (line 82) | +* implementation-vicinity: Vicinity. (line 42) | +* in-graphic-context: Graphics Context. (line 7) | +* in-vicinity: Vicinity. (line 62) | +* init-debug: Breakpoints. (line 9) | +* integer->bytes: Byte/Number Conversions. + (line 29) | +* integer->gray-code: Hilbert Space-Filling Curve. | + (line 62) | +* integer->hilbert-coordinates: Hilbert Space-Filling Curve. | + (line 30) | +* integer->list: Bit-Twiddling. (line 215) | +* integer->peano-coordinates: Peano Space-Filling Curve. | + (line 7) | +* integer-byte-collate: Byte/Number Conversions. + (line 129) | +* integer-byte-collate!: Byte/Number Conversions. + (line 123) | +* integer-length: Bit-Twiddling. (line 88) | +* integer-sqrt: Root Finding. (line 26) | +* interaction-environment: Eval. (line 51) | +* interpolate-from-table: Database Interpolation. + (line 13) | +* intersection: Lists as sets. (line 32) | +* iota: SRFI-1. (line 26) | +* isam-next on relational-table: Sequential Index Operations. + (line 18) | +* isam-prev on relational-table: Sequential Index Operations. + (line 29) | +* jacobi-symbol: Prime Numbers. (line 20) | +* kill-process!: Multi-Processing. (line 24) | +* kill-table on base-table: Base Tables. (line 26) | +* L*a*b*->CIEXYZ: Color Conversions. (line 40) | +* l*a*b*->color: Color Spaces. (line 78) | +* L*a*b*->L*C*h: Color Conversions. (line 44) | +* L*a*b*:DE*: Color Difference Metrics. + (line 17) | +* l*c*h->color: Color Spaces. (line 154) | +* L*C*h->L*a*b*: Color Conversions. (line 45) | +* L*C*h:DE*94: Color Difference Metrics. + (line 25) | +* L*u*v*->CIEXYZ: Color Conversions. (line 34) | +* l*u*v*->color: Color Spaces. (line 102) | +* laguerre:find-polynomial-root: Root Finding. (line 58) | +* laguerre:find-root: Root Finding. (line 47) | +* last <1>: SRFI-1. (line 83) | +* last: Lists as sequences. (line 111) | +* last-pair: Miscellany. (line 73) | +* length+: SRFI-1. (line 88) | +* library-vicinity: Vicinity. (line 39) | +* light:ambient: Solid Modeling. (line 110) | +* light:beam: Solid Modeling. (line 144) | +* light:directional: Solid Modeling. (line 122) | +* light:point: Solid Modeling. (line 158) | +* light:spot: Solid Modeling. (line 176) | +* list*: List construction. (line 18) | +* list->array: Arrays. (line 88) | +* list->bytes: Byte. (line 40) | +* list->integer: Bit-Twiddling. (line 221) | +* list-copy: SRFI-1. (line 24) | +* list-index: SRFI-1. (line 158) | +* list-of??: Lists as sets. (line 120) | +* list-table-definition: Using Databases. (line 167) | +* list-tabulate: SRFI-1. (line 18) | * list-tail: Rev4 Optional Procedures. -* list=: SRFI-1. -* load->path: Module Manifests. | -* load-ciexyz: Spectra. | -* load-color-dictionary: Color Names. | -* localtime: Posix Time. -* logand: Bit-Twiddling. -* logbit?: Bit-Twiddling. -* logcount: Bit-Twiddling. -* logical:ones: Bit-Twiddling. | -* logical:rotate: 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-base on base-table: The Base. | -* make-bytes: Byte. -* make-color: Color Data-Type. -* make-command-server: Command Service. -* make-directory: Directories. -* make-dynamic: Dynamic Data Type. -* make-exchanger: Miscellany. -* make-generic-method: Object. -* make-generic-predicate: Object. -* make-getter on base-table: Base Record Operations. | -* make-getter-1 on base-table: Base Record Operations. | -* make-hash-table: Hash Tables. -* make-heap: Priority Queues. -* make-key->list on base-table: Composite Keys. | -* make-key-extractor on base-table: Composite Keys. | -* make-keyifier-1 on base-table: Composite Keys. | -* make-list: List construction. -* make-list-keyifier on base-table: Composite Keys. | -* make-method!: Object. -* make-nexter on base-table: Base ISAM Operations. | -* make-object: Object. -* make-parameter-list: Parameter lists. -* make-predicate!: Object. -* make-prever on base-table: Base ISAM Operations. | -* make-promise: Promises. -* make-putter on base-table: Base Record Operations. | -* make-query-alist-command-server: HTTP and CGI. -* make-queue: Queues. -* make-random-state: Exact Random Numbers. | -* make-record-type: Records. + (line 12) | +* list=: SRFI-1. (line 48) | +* load->path: Module Manifests. (line 63) | +* load-ciexyz: Spectra. (line 37) | +* load-color-dictionary: Color Names. (line 52) | +* localtime: Posix Time. (line 39) | +* log2-binary-factors: Bit-Twiddling. (line 99) | +* logand: Bit-Twiddling. (line 18) | +* logbit?: Bit-Twiddling. (line 134) | +* logcount: Bit-Twiddling. (line 73) | +* logior: Bit-Twiddling. (line 27) | +* lognot: Bit-Twiddling. (line 45) | +* logtest: Bit-Twiddling. (line 63) | +* logxor: Bit-Twiddling. (line 36) | +* lset-adjoin: SRFI-1. (line 197) | +* lset-diff+intersection: SRFI-1. (line 207) | +* lset-diff+intersection!: SRFI-1. (line 222) | +* lset-difference: SRFI-1. (line 203) | +* lset-difference!: SRFI-1. (line 216) | +* lset-intersection: SRFI-1. (line 201) | +* lset-intersection!: SRFI-1. (line 214) | +* lset-union: SRFI-1. (line 199) | +* lset-union!: SRFI-1. (line 218) | +* lset-xor: SRFI-1. (line 205) | +* lset-xor!: SRFI-1. (line 220) | +* lset<=: SRFI-1. (line 191) | +* lset=: SRFI-1. (line 195) | +* macro:eval <1>: Syntax-Case Macros. (line 14) | +* macro:eval <2>: Syntactic Closures. (line 14) | +* macro:eval <3>: Macros That Work. (line 18) | +* macro:eval: R4RS Macros. (line 19) | +* macro:expand <1>: Syntax-Case Macros. (line 9) | +* macro:expand <2>: Syntactic Closures. (line 9) | +* macro:expand <3>: Macros That Work. (line 13) | +* macro:expand: R4RS Macros. (line 15) | +* macro:load <1>: Syntax-Case Macros. (line 20) | +* macro:load <2>: Syntactic Closures. (line 20) | +* macro:load <3>: Macros That Work. (line 24) | +* macro:load: R4RS Macros. (line 23) | +* macroexpand: Defmacro. (line 31) | +* macroexpand-1: Defmacro. (line 30) | +* macwork:eval: Macros That Work. (line 19) | +* macwork:expand: Macros That Work. (line 14) | +* macwork:load: Macros That Work. (line 25) | +* make-array: Arrays. (line 54) | +* make-base on base-table: The Base. (line 19) | +* make-bytes: Byte. (line 23) | +* make-color: Color Data-Type. (line 30) | +* make-command-server: Command Service. (line 7) | +* make-directory: Directories. (line 17) | +* make-dynamic: Dynamic Data Type. (line 9) | +* make-exchanger: Miscellany. (line 37) | +* make-generic-method: Object. (line 57) | +* make-generic-predicate: Object. (line 62) | +* make-getter on base-table: Base Record Operations. + (line 14) | +* make-getter-1 on base-table: Base Record Operations. + (line 23) | +* make-hash-table: Hash Tables. (line 17) | +* make-heap: Priority Queues. (line 12) | +* make-key->list on base-table: Composite Keys. (line 38) | +* make-key-extractor on base-table: Composite Keys. (line 31) | +* make-keyifier-1 on base-table: Composite Keys. (line 7) | +* make-list: List construction. (line 7) | +* make-list-keyifier on base-table: Composite Keys. (line 17) | +* make-method!: Object. (line 65) | +* make-nexter on base-table: Base ISAM Operations. + (line 17) | +* make-object: Object. (line 46) | +* make-parameter-list: Parameter lists. (line 23) | +* make-predicate!: Object. (line 72) | +* make-prever on base-table: Base ISAM Operations. + (line 25) | +* make-promise: Promises. (line 9) | +* make-putter on base-table: Base Record Operations. + (line 31) | +* make-query-alist-command-server: HTTP and CGI. (line 86) | +* make-queue: Queues. (line 13) | +* make-random-state: Exact Random Numbers. + (line 44) | +* make-record-type: Records. (line 12) | * make-relational-system: Relational Database Objects. -* make-ruleset: Commutative Rings. -* make-shared-array: Arrays. -* make-sierpinski-indexer: Sierpinski Curve. -* make-slib-color-name-db: Color Names. -* make-syntactic-closure: Syntactic Closures. -* make-table on base-table: Base Tables. | -* make-uri: URI. -* make-vicinity: Vicinity. + (line 11) | +* make-ruleset: Commutative Rings. (line 82) | +* make-shared-array: Arrays. (line 69) | +* make-sierpinski-indexer: Sierpinski Curve. (line 9) | +* make-slib-color-name-db: Color Names. (line 94) | +* make-syntactic-closure: Syntactic Closures. (line 177) | +* make-table on base-table: Base Tables. (line 7) | +* make-uri: URI. (line 12) | +* make-vicinity: Vicinity. (line 21) | * make-wt-tree: Construction of Weight-Balanced Trees. + (line 51) | * make-wt-tree-type: Construction of Weight-Balanced Trees. -* map!: SRFI-1. | -* map-elts: Collections. -* map-key on base-table: Aggregate Base Operations. | -* map-keys: Collections. -* matfile:load: MAT-File Format. -* matfile:read: MAT-File Format. -* matrix->array: Matrix Algebra. -* matrix->lists: Matrix Algebra. -* matrix:inverse: Matrix Algebra. -* matrix:product: Matrix Algebra. -* mdbm:report: Using Databases. -* member: SRFI-1. -* member-if: Lists as sets. -* merge: Sorting. -* merge!: Sorting. -* mktime: Posix Time. -* mod: Modular Arithmetic. | -* 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. -* mrna<-cdna: NCBI-DNA. -* must-be-first: Batch. -* must-be-last: Batch. -* ncbi:read-dna-sequence: NCBI-DNA. -* ncbi:read-file: NCBI-DNA. + (line 19) | +* map!: SRFI-1. (line 122) | +* map-elts: Collections. (line 40) | +* map-key on base-table: Aggregate Base Operations. + (line 22) | +* map-keys: Collections. (line 56) | +* matfile:load: MAT-File Format. (line 25) | +* matfile:read: MAT-File Format. (line 19) | +* matrix->array: Matrix Algebra. (line 15) | +* matrix->lists: Matrix Algebra. (line 12) | +* matrix:inverse: Matrix Algebra. (line 33) | +* matrix:product: Matrix Algebra. (line 30) | +* mdbm:report: Using Databases. (line 94) | +* member: SRFI-1. (line 160) | +* member-if: Lists as sets. (line 62) | +* merge: Sorting. (line 97) | +* merge!: Sorting. (line 106) | +* mktime: Posix Time. (line 54) | +* mod: Modular Arithmetic. (line 9) | +* modular:*: Modular Arithmetic. (line 77) | +* modular:+: Modular Arithmetic. (line 71) | +* modular:-: Modular Arithmetic. (line 74) | +* modular:expt: Modular Arithmetic. (line 83) | +* modular:invert: Modular Arithmetic. (line 64) | +* modular:invertable?: Modular Arithmetic. (line 60) | +* modular:negate: Modular Arithmetic. (line 68) | +* modular:normalize: Modular Arithmetic. (line 39) | +* modulus->integer: Modular Arithmetic. (line 35) | +* mrna<-cdna: NCBI-DNA. (line 15) | +* must-be-first: Batch. (line 128) | +* must-be-last: Batch. (line 133) | +* ncbi:read-dna-sequence: NCBI-DNA. (line 7) | +* ncbi:read-file: NCBI-DNA. (line 11) | * nconc: Destructive list operations. -* newton:find-integer-root: Root Finding. -* newton:find-root: Root Finding. -* ninth: SRFI-1. -* not-pair?: SRFI-1. -* notany: Lists as sets. -* notevery: Lists as sets. + (line 10) | +* newton:find-integer-root: Root Finding. (line 9) | +* newton:find-root: Root Finding. (line 30) | +* ninth: SRFI-1. (line 65) | +* not-pair?: SRFI-1. (line 46) | +* notany: Lists as sets. (line 105) | +* notevery: Lists as sets. (line 109) | * nreverse: Destructive list operations. -* nthcdr: Lists as sequences. -* null-directory?: URI. -* null-environment: Eval. -* null-list?: SRFI-1. -* object: Yasos interface. -* object->limited-string: Object-To-String. -* object->string: Object-To-String. -* object-with-ancestors: Yasos interface. -* object?: Object. -* offset-time: Time and Date. -* open-base on base-table: The Base. | -* open-command-database: Database Extension. -* open-command-database!: Database Extension. | -* open-database: Using Databases. -* open-database on relational-system: Relational Database Objects. | -* open-database!: Using Databases. -* open-file <1>: Byte. | -* open-file: Input/Output. -* open-table: Using Databases. | -* open-table on base-table: Base Tables. | -* open-table on relational-database: Database Operations. | -* open-table!: Using Databases. | -* operate-as: Yasos interface. -* or?: Non-List functions. -* ordered-for-each-key on base-table: Base ISAM Operations. | -* os->batch-dialect: Batch. -* outline-rect: Rectangles. | -* output-port-height: Input/Output. -* output-port-width: Input/Output. -* overcast-sky-color-xyy: Daylight. -* p<-cdna: NCBI-DNA. -* pad-range: Column Ranges. | -* pair-for-each: SRFI-1. | -* parameter-list->arglist: Parameter lists. -* parameter-list-expand: Parameter lists. -* parameter-list-ref: Parameter lists. -* parse-ftp-address: URI. -* partition: SRFI-1. | -* partition-page: Rectangles. | -* path->uri: URI. -* pathname->vicinity: Vicinity. -* plot <1>: Legacy Plotting. | -* plot: Character Plotting. | -* plot-column: Drawing the Graph. | + (line 38) | +* nthcdr: Lists as sequences. (line 137) | +* null-directory?: URI. (line 106) | +* null-environment: Eval. (line 29) | +* null-list?: SRFI-1. (line 44) | +* object: Yasos interface. (line 17) | +* object->limited-string: Object-To-String. (line 12) | +* object->string: Object-To-String. (line 9) | +* object-with-ancestors: Yasos interface. (line 23) | +* object?: Object. (line 54) | +* offset-time: Time and Date. (line 30) | +* open-base on base-table: The Base. (line 33) | +* open-command-database: Database Extension. (line 34) | +* open-command-database!: Database Extension. (line 43) | +* open-database: Using Databases. (line 71) | +* open-database on relational-system: Relational Database Objects. + (line 45) | +* open-database!: Using Databases. (line 68) | +* open-file <1>: Byte. (line 57) | +* open-file: Input/Output. (line 18) | +* open-table: Using Databases. (line 107) | +* open-table on base-table: Base Tables. (line 16) | +* open-table on relational-database: Database Operations. (line 52) | +* open-table!: Using Databases. (line 114) | +* operate-as: Yasos interface. (line 31) | +* or?: Non-List functions. (line 19) | +* ordered-for-each-key on base-table: Base ISAM Operations. + (line 10) | +* os->batch-dialect: Batch. (line 138) | +* outline-rect: Rectangles. (line 33) | +* output-port-height: Input/Output. (line 87) | +* output-port-width: Input/Output. (line 81) | +* overcast-sky-color-xyy: Daylight. (line 74) | +* p<-cdna: NCBI-DNA. (line 27) | +* pad-range: Column Ranges. (line 13) | +* pair-fold: SRFI-1. (line 115) | +* pair-fold-right: SRFI-1. (line 117) | +* pair-for-each: SRFI-1. (line 124) | +* parameter-list->arglist: Parameter lists. (line 86) | +* parameter-list-expand: Parameter lists. (line 41) | +* parameter-list-ref: Parameter lists. (line 26) | +* parse-ftp-address: URI. (line 117) | +* partition: SRFI-1. (line 133) | +* partition!: SRFI-1. (line 137) | +* partition-page: Rectangles. (line 16) | +* path->uri: URI. (line 95) | +* pathname->vicinity: Vicinity. (line 25) | +* peano-coordinates->integer: Peano Space-Filling Curve. | + (line 13) | +* plot <1>: Legacy Plotting. (line 11) | +* plot: Character Plotting. (line 17) | +* plot-column: Drawing the Graph. (line 7) | * pnm:array-write: Portable Image Files. + (line 44) | * pnm:image-file->array: Portable Image Files. + (line 35) | * pnm:type-dimensions: Portable Image Files. -* port?: Input/Output. -* position: Lists as sequences. -* pprint-file: Pretty-Print. -* pprint-filter-file: Pretty-Print. + (line 9) | +* port?: Input/Output. (line 44) | +* position: Lists as sequences. (line 7) | +* pprint-file: Pretty-Print. (line 63) | +* pprint-filter-file: Pretty-Print. (line 69) | * prec:commentfix: Grammar Rule Definition. + (line 111) | * prec:define-grammar: Ruleset Definition and Use. + (line 24) | * prec:delim: Grammar Rule Definition. + (line 24) | * prec:infix: Grammar Rule Definition. + (line 53) | * prec:inmatchfix: Grammar Rule Definition. + (line 151) | * prec:make-led: Nud and Led Definition. + (line 49) | * prec:make-nud: Nud and Led Definition. + (line 39) | * prec:matchfix: Grammar Rule Definition. + (line 131) | * prec:nary: Grammar Rule Definition. + (line 72) | * prec:nofix: Grammar Rule Definition. + (line 29) | * prec:parse: Ruleset Definition and Use. + (line 33) | * prec:postfix: Grammar Rule Definition. + (line 85) | * prec:prefix: Grammar Rule Definition. + (line 36) | * prec:prestfix: Grammar Rule Definition. -* predicate->asso: Association Lists. -* predicate->hash: Hash Tables. -* predicate->hash-asso: Hash Tables. -* present? on base-table: Base Record Operations. | -* pretty-print: Pretty-Print. -* pretty-print->string: Pretty-Print. -* primary-limit on relational-table: Table Administration. | -* prime?: Prime Numbers. -* primes<: Prime Numbers. -* primes>: Prime Numbers. -* print: Yasos interface. -* print-call-stack: Trace. + (line 94) | +* predicate->asso: Association Lists. (line 17) | +* predicate->hash: Hash Tables. (line 9) | +* predicate->hash-asso: Hash Tables. (line 25) | +* present? on base-table: Base Record Operations. + (line 10) | +* pretty-print: Pretty-Print. (line 9) | +* pretty-print->string: Pretty-Print. (line 23) | +* primary-limit on relational-table: Table Administration. + (line 16) | +* prime?: Prime Numbers. (line 28) | +* primes<: Prime Numbers. (line 33) | +* primes>: Prime Numbers. (line 38) | +* print: Yasos interface. (line 36) | +* print-call-stack: Trace. (line 29) | * printf: Standard Formatted Output. -* process:schedule!: Multi-Processing. -* program-vicinity: Vicinity. -* project-table on relational-database: Database Operations. | -* proper-list?: SRFI-1. -* protein<-cdna: NCBI-DNA. | -* provide: Feature. | -* provided?: Feature. -* 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: Exact Random Numbers. | -* random:exp: Inexact Random Numbers. | -* random:hollow-sphere!: Inexact Random Numbers. | -* random:normal: Inexact Random Numbers. | -* random:normal-vector!: Inexact Random Numbers. | -* random:solid-sphere!: Inexact Random Numbers. | -* random:uniform: Inexact Random Numbers. | -* rationalize: Rationalize. -* read-byte: Byte. -* read-bytes: Byte. | -* read-command: Command Line. -* read-line: Line I/O. -* read-line!: Line I/O. -* read-options-file: Command Line. -* receive: SRFI-8. | -* record-accessor: Records. -* record-constructor: Records. -* record-modifier: Records. -* record-predicate: Records. -* reduce <1>: Lists as sequences. -* reduce: Collections. -* reduce-init: Lists as sequences. -* rem: Modular Arithmetic. -* remove <1>: SRFI-1. | -* remove: Lists as sets. -* remove!: SRFI-1. | -* remove-duplicates: Lists as sets. -* remove-if: Lists as sets. -* remove-if-not: Lists as sets. -* remove-parameter: Parameter lists. -* remove-setter-for: Setters. -* repl:quit: Repl. -* repl:top-level: Repl. -* replace-suffix: Filenames. -* require <1>: Catalog Creation. | -* require: Require. | -* require-if: Require. | -* resene: Color Names. -* restrict-table on relational-database: Database Operations. | -* reverse!: SRFI-1. -* RGB709->CIEXYZ: Color Conversions. -* rgb709->color: Color Spaces. -* row:delete on relational-table: Single Row Operations. | -* row:delete* on relational-table: Multi-Row Operations. | -* row:insert on relational-table: Single Row Operations. | -* row:insert* on relational-table: Multi-Row Operations. | -* row:remove on relational-table: Single Row Operations. | -* row:remove* on relational-table: Multi-Row Operations. | -* row:retrieve on relational-table: Single Row Operations. | -* row:retrieve* on relational-table: Multi-Row Operations. | -* row:update on relational-table: Single Row Operations. | -* row:update* on relational-table: Multi-Row Operations. | -* rule-horizontal: Legending. | -* rule-vertical: Legending. | -* saturate: Color Names. + (line 9) | +* process:schedule!: Multi-Processing. (line 20) | +* program-vicinity: Vicinity. (line 30) | +* project-table on relational-database: Database Operations. (line 76) | +* proper-list?: SRFI-1. (line 38) | +* protein<-cdna: NCBI-DNA. (line 23) | +* provide: Feature. (line 58) | +* provided?: Feature. (line 30) | +* qp: Quick Print. (line 19) | +* qpn: Quick Print. (line 20) | +* qpr: Quick Print. (line 21) | +* queue-empty?: Queues. (line 19) | +* queue-front: Queues. (line 39) | +* queue-pop!: Queues. (line 29) | +* queue-push!: Queues. (line 22) | +* queue-rear: Queues. (line 42) | +* queue?: Queues. (line 16) | +* random: Exact Random Numbers. + (line 9) | +* random:exp: Inexact Random Numbers. + (line 14) | +* random:hollow-sphere!: Inexact Random Numbers. + (line 32) | +* random:normal: Inexact Random Numbers. + (line 20) | +* random:normal-vector!: Inexact Random Numbers. + (line 26) | +* random:solid-sphere!: Inexact Random Numbers. + (line 39) | +* random:uniform: Inexact Random Numbers. + (line 9) | +* rationalize: Rationalize. (line 9) | +* read-byte: Byte. (line 69) | +* read-bytes: Byte. (line 87) | +* read-cie-illuminant: Spectra. (line 43) | +* read-command: Command Line. (line 9) | +* read-line: Line I/O. (line 9) | +* read-line!: Line I/O. (line 18) | +* read-normalized-illuminant: Spectra. (line 54) | +* read-options-file: Command Line. (line 65) | +* receive: SRFI-8. (line 9) | +* record-accessor: Records. (line 41) | +* record-constructor: Records. (line 22) | +* record-modifier: Records. (line 50) | +* record-predicate: Records. (line 35) | +* reduce <1>: SRFI-1. (line 119) | +* reduce <2>: Lists as sequences. (line 19) | +* reduce: Collections. (line 71) | +* reduce-init: Lists as sequences. (line 61) | +* reduce-right: SRFI-1. (line 120) | +* rem: Modular Arithmetic. (line 10) | +* remove <1>: SRFI-1. (line 135) | +* remove: Lists as sets. (line 153) | +* remove!: SRFI-1. (line 139) | +* remove-duplicates: Lists as sets. (line 199) | +* remove-if: Lists as sets. (line 166) | +* remove-if-not: Lists as sets. (line 177) | +* remove-parameter: Parameter lists. (line 31) | +* remove-setter-for: Setters. (line 49) | +* repl:quit: Repl. (line 17) | +* repl:top-level: Repl. (line 11) | +* replace-suffix: Filenames. (line 65) | +* require <1>: Catalog Creation. (line 48) | +* require: Require. (line 25) | +* require-if: Require. (line 40) | +* resene: Color Names. (line 129) | +* restrict-table on relational-database: Database Operations. (line 77) | +* reverse!: SRFI-1. (line 93) | +* reverse-bit-field: Bit-Twiddling. (line 206) | +* RGB709->CIEXYZ: Color Conversions. (line 30) | +* rgb709->color: Color Spaces. (line 46) | +* rotate-bit-field: Bit-Twiddling. (line 192) | +* row:delete on relational-table: Single Row Operations. + (line 50) | +* row:delete* on relational-table: Multi-Row Operations. + (line 26) | +* row:insert on relational-table: Single Row Operations. + (line 12) | +* row:insert* on relational-table: Multi-Row Operations. + (line 41) | +* row:remove on relational-table: Single Row Operations. + (line 45) | +* row:remove* on relational-table: Multi-Row Operations. + (line 21) | +* row:retrieve on relational-table: Single Row Operations. + (line 37) | +* row:retrieve* on relational-table: Multi-Row Operations. + (line 7) | +* row:update on relational-table: Single Row Operations. + (line 31) | +* row:update* on relational-table: Multi-Row Operations. + (line 47) | +* rule-horizontal: Legending. (line 40) | +* rule-vertical: Legending. (line 32) | +* saturate: Color Names. (line 109) | * scanf: Standard Formatted Input. + (line 13) | * scanf-read-list: Standard Formatted Input. -* scene:overcast: Solid Modeling. -* scene:panorama: Solid Modeling. -* scene:sky-and-dirt: Solid Modeling. -* scene:sky-and-grass: Solid Modeling. -* scene:sphere: Solid Modeling. -* scene:sun: Solid Modeling. -* scene:viewpoint: Solid Modeling. -* scene:viewpoints: Solid Modeling. -* scheme-report-environment: Eval. -* schmooz: Schmooz. -* secant:find-bracketed-root: Root Finding. -* secant:find-root: Root Finding. -* second: SRFI-1. | -* seed->random-state: Exact Random Numbers. | -* set: Setters. -* set-color: Graphics Context. | -* set-difference: Lists as sets. -* set-font: Graphics Context. | -* set-glyphsize: Graphics Context. | -* set-linedash: Graphics Context. | -* set-linewidth: Graphics Context. | -* Setter: Collections. -* setter: Setters. -* setup-plot: Column Ranges. | -* seventh: SRFI-1. -* si:conversion-factor: Metric Units. + (line 9) | +* scene:overcast: Solid Modeling. (line 67) | +* scene:panorama: Solid Modeling. (line 33) | +* scene:sky-and-dirt: Solid Modeling. (line 50) | +* scene:sky-and-grass: Solid Modeling. (line 53) | +* scene:sphere: Solid Modeling. (line 37) | +* scene:sun: Solid Modeling. (line 56) | +* scene:viewpoint: Solid Modeling. (line 81) | +* scene:viewpoints: Solid Modeling. (line 88) | +* scheme-report-environment: Eval. (line 28) | +* schmooz: Schmooz. (line 16) | +* secant:find-bracketed-root: Root Finding. (line 71) | +* secant:find-root: Root Finding. (line 70) | +* second: SRFI-1. (line 55) | +* seed->random-state: Exact Random Numbers. + (line 35) | +* set: Setters. (line 30) | +* set-color: Graphics Context. (line 11) | +* set-difference: Lists as sets. (line 42) | +* set-font: Graphics Context. (line 18) | +* set-glyphsize: Graphics Context. (line 48) | +* set-linedash: Graphics Context. (line 39) | +* set-linewidth: Graphics Context. (line 34) | +* set-margin-templates: Legending. (line 27) | +* Setter: Collections. (line 107) | +* setter: Setters. (line 22) | +* setup-plot: Column Ranges. (line 22) | +* seventh: SRFI-1. (line 63) | +* si:conversion-factor: Metric Units. (line 160) | * singleton-wt-tree: Construction of Weight-Balanced Trees. -* sixth: SRFI-1. -* size <1>: Collections. -* size: Yasos interface. -* sky-color-xyy: Daylight. -* slib:error: System. -* slib:eval: System. -* slib:eval-load: System. -* slib:exit: System. -* slib:in-catalog?: Require. | -* slib:load: System. -* slib:load-compiled: System. -* slib:load-source: System. -* slib:report: Configuration. -* slib:report-version: Configuration. -* slib:warn: System. -* snap-range: Column Ranges. | -* software-type: Configuration. -* solar-declination: Daylight. -* solar-hour: Daylight. -* solar-polar: Daylight. -* solid:arrow: Solid Modeling. -* solid:basrelief: Solid Modeling. -* solid:box: Solid Modeling. -* solid:center-array-of: Solid Modeling. -* solid:center-pile-of: Solid Modeling. -* solid:center-row-of: Solid Modeling. -* solid:color: Solid Modeling. -* solid:cone: Solid Modeling. -* solid:cylinder: Solid Modeling. -* solid:disk: Solid Modeling. -* solid:ellipsoid: Solid Modeling. -* solid:pyramid: Solid Modeling. -* solid:rotation: Solid Modeling. -* solid:scale: Solid Modeling. -* solid:sphere: Solid Modeling. -* solid:texture: Solid Modeling. -* solid:translation: Solid Modeling. | -* solidify-database: Using Databases. -* solidify-database on relational-database: Database Operations. | -* some: Lists as sets. -* sort: Sorting. -* sort!: Sorting. -* sorted?: Sorting. -* soundex: Soundex. -* span: SRFI-1. | -* spectrum->chromaticity: Spectra. -* spectrum->CIEXYZ: Spectra. -* spectrum->XYZ: Spectra. -* split-at: SRFI-1. -* split-at!: SRFI-1. | + (line 58) | +* sixth: SRFI-1. (line 62) | +* size <1>: Collections. (line 104) | +* size: Yasos interface. (line 41) | +* sky-color-xyy: Daylight. (line 85) | +* slib:error: System. (line 45) | +* slib:eval: System. (line 30) | +* slib:eval-load: System. (line 35) | +* slib:exit: System. (line 51) | +* slib:in-catalog?: Require. (line 57) | +* slib:load: System. (line 20) | +* slib:load-compiled: System. (line 15) | +* slib:load-source: System. (line 9) | +* slib:report: Configuration. (line 43) | +* slib:report-version: Configuration. (line 36) | +* slib:warn: System. (line 42) | +* snap-range: Column Ranges. (line 16) | +* software-type: Configuration. (line 32) | +* solar-declination: Daylight. (line 21) | +* solar-hour: Daylight. (line 14) | +* solar-polar: Daylight. (line 23) | +* solid:arrow: Solid Modeling. (line 399) | +* solid:basrelief: Solid Modeling. (line 271) | +* solid:box: Solid Modeling. (line 206) | +* solid:center-array-of: Solid Modeling. (line 390) | +* solid:center-pile-of: Solid Modeling. (line 395) | +* solid:center-row-of: Solid Modeling. (line 386) | +* solid:color: Solid Modeling. (line 313) | +* solid:cone: Solid Modeling. (line 230) | +* solid:cylinder: Solid Modeling. (line 215) | +* solid:disk: Solid Modeling. (line 223) | +* solid:ellipsoid: Solid Modeling. (line 248) | +* solid:font: Solid Modeling. (line 351) | +* solid:polyline: Solid Modeling. (line 257) | +* solid:pyramid: Solid Modeling. (line 236) | +* solid:rotation: Solid Modeling. (line 418) | +* solid:scale: Solid Modeling. (line 414) | +* solid:sphere: Solid Modeling. (line 242) | +* solid:text: Solid Modeling. (line 294) | +* solid:texture: Solid Modeling. (line 330) | +* solid:translation: Solid Modeling. (line 409) | +* solidify-database: Using Databases. (line 86) | +* solidify-database on relational-database: Database Operations. + (line 42) | +* some: Lists as sets. (line 73) | +* sort: Sorting. (line 119) | +* sort!: Sorting. (line 126) | +* sorted?: Sorting. (line 88) | +* soundex: Soundex. (line 9) | +* span: SRFI-1. (line 148) | +* span!: SRFI-1. (line 150) | +* spectrum->chromaticity: Spectra. (line 111) | +* spectrum->XYZ: Spectra. (line 85) | +* split-at: SRFI-1. (line 80) | +* split-at!: SRFI-1. (line 81) | * sprintf: Standard Formatted Output. -* sRGB->CIEXYZ: Color Conversions. -* srgb->color: Color Spaces. -* sRGB->e-sRGB: Color Conversions. -* sRGB->xRGB: Color Conversions. | + (line 11) | +* sRGB->CIEXYZ: Color Conversions. (line 48) | +* srgb->color: Color Spaces. (line 195) | +* sRGB->e-sRGB: Color Conversions. (line 59) | +* sRGB->xRGB: Color Conversions. (line 53) | * sscanf: Standard Formatted Input. -* stack: Trace. -* stack-all: Debug. -* stackf: Trace. | -* string->color: Color Data-Type. -* string->list: Rev4 Optional Procedures. -* string-capitalize: String-Case. -* string-capitalize!: String-Case. | -* string-ci->symbol: String-Case. + (line 15) | +* stack: Trace. (line 49) | +* stack-all: Debug. (line 27) | +* stackf: Trace. (line 85) | +* string->color: Color Data-Type. (line 98) | +* string-capitalize: String-Case. (line 11) | +* string-capitalize!: String-Case. (line 16) | +* string-ci->symbol: String-Case. (line 19) | * string-copy: Rev4 Optional Procedures. -* string-downcase: String-Case. -* string-downcase!: String-Case. + (line 14) | +* string-downcase: String-Case. (line 10) | +* string-downcase!: String-Case. (line 15) | * string-fill!: Rev4 Optional Procedures. -* string-index: String Search. -* string-index-ci: String Search. -* string-join: Batch. -* string-null?: Rev2 Procedures. -* string-reverse-index: String Search. -* string-reverse-index-ci: String Search. -* string-subst: String Search. -* string-upcase: String-Case. -* string-upcase!: String-Case. -* StudlyCapsExpand: String-Case. -* sub-vicinity: Vicinity. -* subarray: Subarrays. -* subarray0: Subarrays. -* subset?: Lists as sets. -* subst: Tree Operations. -* substq: Tree Operations. -* substring-ci?: String Search. -* substring-fill!: Rev2 Procedures. -* substring-move-left!: Rev2 Procedures. -* substring-move-right!: Rev2 Procedures. -* substring-read!: Byte. | -* substring-write: Byte. | -* substring?: String Search. -* substv: Tree Operations. -* sunlight-ciexyz: Daylight. -* sunlight-spectrum: Daylight. -* sunlight-xyz: Daylight. -* supported-key-type? on base-table: Base Field Types. | -* supported-type? on base-table: Base Field Types. | -* symbol-append: String-Case. -* symmetric:modulus: Modular Arithmetic. -* sync-base on base-table: The Base. | -* sync-database: Using Databases. -* sync-database on relational-database: Database Operations. | -* syncase:eval: Syntax-Case Macros. -* syncase:expand: Syntax-Case Macros. -* syncase:load: Syntax-Case Macros. -* syncase:sanity-check: Syntax-Case Macros. | -* synclo:eval: Syntactic Closures. -* synclo:expand: Syntactic Closures. -* synclo:load: Syntactic Closures. -* syntax-rules: Macro by Example. -* system: System Interface. -* system->line: Line I/O. | -* table->linked-html: HTML Tables. -* table->linked-page: HTML Tables. -* table-exists? on relational-database: Database Operations. | -* table-name->filename: HTML Tables. -* take: SRFI-1. -* take!: SRFI-1. | -* take-right: SRFI-1. -* temperature->chromaticity: Spectra. | -* temperature->CIEXYZ: Spectra. -* temperature->XYZ: Spectra. -* tenth: SRFI-1. -* third: SRFI-1. | -* time-zone: Time Zone. -* title-bottom: Legending. | -* title-top: Legending. | -* tmpnam: Input/Output. -* tok:bump-column: Token definition. | -* tok:char-group: Token definition. -* top-refs: Top-level Variable References. | -* top-refs<-file: Top-level Variable References. | -* topological-sort: Topological Sort. -* trace: Trace. -* trace-all: Debug. -* tracef: Trace. -* track: Trace. -* track-all: Debug. -* trackf: Trace. | -* transact-file-replacement: Transactions. -* transcript-off: Transcripts. -* transcript-on: Transcripts. -* transformer: Syntactic Closures. -* transpose: Matrix Algebra. -* truncate-up-to: Batch. -* tsort: Topological Sort. | -* type-of: Type Coercion. -* tz:params: Time Zone. -* tz:std-offset: Time Zone. | -* tzset: Time Zone. -* unbreak: Breakpoints. -* unbreakf: Breakpoints. -* union: Lists as sets. -* unmake-method!: Object. -* unstack: Trace. -* untrace: Trace. -* untracef: Trace. -* untrack: Trace. -* unzip1: SRFI-1. -* unzip2: SRFI-1. -* unzip3: SRFI-1. -* unzip4: SRFI-1. -* unzip5: SRFI-1. -* uri->tree: URI. -* uri:decode-query: URI. -* uri:make-path: URI. | -* uri:path->keys: URI. | -* uri:split-fields: URI. | -* uric:decode: URI. -* uric:encode: URI. -* url->color-dictionary: Color Names. -* user-email-address: Transactions. -* user-vicinity: Vicinity. -* values: Values. -* vector->list: Rev4 Optional Procedures. + (line 16) | +* string-index: String Search. (line 9) | +* string-index-ci: String Search. (line 10) | +* string-join: Batch. (line 123) | +* string-null?: Rev2 Procedures. (line 33) | +* string-reverse-index: String Search. (line 14) | +* string-reverse-index-ci: String Search. (line 15) | +* string-subst: String Search. (line 56) | +* string-upcase: String-Case. (line 9) | +* string-upcase!: String-Case. (line 14) | +* StudlyCapsExpand: String-Case. (line 29) | +* sub-vicinity: Vicinity. (line 73) | +* subarray: Subarrays. (line 9) | +* subset?: Lists as sets. (line 52) | +* subst: Tree Operations. (line 11) | +* substq: Tree Operations. (line 12) | +* substring-ci?: String Search. (line 20) | +* substring-fill!: Rev2 Procedures. (line 30) | +* substring-move-left!: Rev2 Procedures. (line 13) | +* substring-move-right!: Rev2 Procedures. (line 14) | +* substring-read!: Byte. (line 112) | +* substring-write: Byte. (line 121) | +* substring?: String Search. (line 19) | +* substv: Tree Operations. (line 13) | +* sunlight-chromaticity: Daylight. (line 65) | +* sunlight-spectrum: Daylight. (line 61) | +* supported-key-type? on base-table: Base Field Types. (line 13) | +* supported-type? on base-table: Base Field Types. (line 7) | +* symbol-append: String-Case. (line 23) | +* symmetric:modulus: Modular Arithmetic. (line 32) | +* sync-base on base-table: The Base. (line 53) | +* sync-database: Using Databases. (line 82) | +* sync-database on relational-database: Database Operations. (line 37) | +* syncase:eval: Syntax-Case Macros. (line 15) | +* syncase:expand: Syntax-Case Macros. (line 10) | +* syncase:load: Syntax-Case Macros. (line 21) | +* syncase:sanity-check: Syntax-Case Macros. (line 67) | +* synclo:eval: Syntactic Closures. (line 15) | +* synclo:expand: Syntactic Closures. (line 10) | +* synclo:load: Syntactic Closures. (line 21) | +* syntax-rules: Macro by Example. (line 56) | +* system: System Interface. (line 16) | +* system->line: Line I/O. (line 35) | +* table->linked-html: HTML Tables. (line 34) | +* table->linked-page: HTML Tables. (line 42) | +* table-exists? on relational-database: Database Operations. (line 48) | +* table-name->filename: HTML Tables. (line 31) | +* take: SRFI-1. (line 71) | +* take!: SRFI-1. (line 72) | +* take-right: SRFI-1. (line 74) | +* temperature->chromaticity: Spectra. (line 150) | +* temperature->XYZ: Spectra. (line 135) | +* tenth: SRFI-1. (line 66) | +* third: SRFI-1. (line 57) | +* time-zone: Time Zone. (line 68) | +* time:gmtime: Time Infrastructure. (line 9) | +* time:invert: Time Infrastructure. (line 10) | +* time:split: Time Infrastructure. (line 11) | +* title-bottom: Legending. (line 12) | +* title-top: Legending. (line 7) | +* tmpnam: Input/Output. (line 65) | +* tok:bump-column: Token definition. (line 61) | +* tok:char-group: Token definition. (line 7) | +* top-refs: Top-level Variable References. + (line 15) | +* top-refs<-file: Top-level Variable References. + (line 19) | +* topological-sort: Topological Sort. (line 13) | +* trace: Trace. (line 33) | +* trace-all: Debug. (line 19) | +* tracef: Trace. (line 81) | +* track: Trace. (line 41) | +* track-all: Debug. (line 23) | +* trackf: Trace. (line 83) | +* transact-file-replacement: Transactions. (line 98) | +* transcript-off: Transcripts. (line 10) | +* transcript-on: Transcripts. (line 9) | +* transformer: Syntactic Closures. (line 113) | +* transpose: Matrix Algebra. (line 26) | +* truncate-up-to: Batch. (line 113) | +* tsort: Topological Sort. (line 12) | +* type-of: Type Coercion. (line 9) | +* tz:params: Time Zone. (line 73) | +* tz:std-offset: Time Zone. (line 89) | +* tzfile:read: Time Infrastructure. (line 15) | +* tzset: Time Zone. (line 97) | +* unbreak: Breakpoints. (line 37) | +* unbreakf: Breakpoints. (line 58) | +* union: Lists as sets. (line 21) | +* unmake-method!: Object. (line 75) | +* unstack: Trace. (line 71) | +* untrace: Trace. (line 57) | +* untracef: Trace. (line 96) | +* untrack: Trace. (line 64) | +* unzip1: SRFI-1. (line 100) | +* unzip2: SRFI-1. (line 101) | +* unzip3: SRFI-1. (line 102) | +* unzip4: SRFI-1. (line 103) | +* unzip5: SRFI-1. (line 104) | +* uri->tree: URI. (line 47) | +* uri:decode-query: URI. (line 71) | +* uri:make-path: URI. (line 21) | +* uri:path->keys: URI. (line 87) | +* uri:split-fields: URI. (line 67) | +* uric:decode: URI. (line 81) | +* uric:encode: URI. (line 76) | +* url->color-dictionary: Color Names. (line 77) | +* user-email-address: Transactions. (line 133) | +* user-vicinity: Vicinity. (line 47) | +* values: Values. (line 9) | +* vector->array: Arrays. (line 111) | * vector-fill!: Rev4 Optional Procedures. -* vet-slib: Module Analysis. | -* vicinity:suffix?: Vicinity. | -* vrml: Solid Modeling. -* vrml-append: Solid Modeling. -* vrml-to-file: Solid Modeling. -* wavelength->chromaticity: Spectra. -* wavelength->CIEXYZ: Spectra. -* wavelength->XYZ: Spectra. -* whole-page <1>: Rectangles. | -* whole-page: PostScript Graphing. | -* with-input-from-file: With-File. -* with-output-to-file: With-File. -* within-database: Database Macros. -* world:info: Solid Modeling. -* wrap-command-interface: Database Extension. -* write-base on base-table: The Base. | -* write-byte: Byte. -* write-bytes: Byte. | -* write-database: Using Databases. -* write-database on relational-database: Database Operations. | -* write-line: Line I/O. + (line 18) | +* vet-slib: Module Analysis. (line 9) | +* vicinity:suffix?: Vicinity. (line 58) | +* vrml: Solid Modeling. (line 12) | +* vrml-append: Solid Modeling. (line 16) | +* vrml-to-file: Solid Modeling. (line 20) | +* wavelength->chromaticity: Spectra. (line 120) | +* wavelength->XYZ: Spectra. (line 115) | +* whole-page <1>: Rectangles. (line 11) | +* whole-page: PostScript Graphing. (line 37) | +* with-input-from-file: With-File. (line 9) | +* with-load-pathname: Vicinity. (line 79) | +* with-output-to-file: With-File. (line 10) | +* within-database: Within-database. (line 7) | +* world:info: Solid Modeling. (line 24) | +* wrap-command-interface: Database Extension. (line 7) | +* write-base on base-table: The Base. (line 43) | +* write-byte: Byte. (line 62) | +* write-bytes: Byte. (line 98) | +* write-database: Using Databases. (line 79) | +* write-database on relational-database: Database Operations. (line 26) | +* write-line: Line I/O. (line 29) | * wt-tree/add: Basic Operations on Weight-Balanced Trees. + (line 20) | * wt-tree/add!: Basic Operations on Weight-Balanced Trees. + (line 28) | * wt-tree/delete: Basic Operations on Weight-Balanced Trees. + (line 48) | * wt-tree/delete!: Basic Operations on Weight-Balanced Trees. + (line 55) | * wt-tree/delete-min: Indexing Operations on Weight-Balanced Trees. + (line 60) | * wt-tree/delete-min!: Indexing Operations on Weight-Balanced Trees. + (line 70) | * wt-tree/difference: Advanced Operations on Weight-Balanced Trees. + (line 49) | * wt-tree/empty?: Basic Operations on Weight-Balanced Trees. + (line 12) | * wt-tree/fold: Advanced Operations on Weight-Balanced Trees. + (line 91) | * wt-tree/for-each: Advanced Operations on Weight-Balanced Trees. + (line 112) | * wt-tree/index: Indexing Operations on Weight-Balanced Trees. + (line 12) | * wt-tree/index-datum: Indexing Operations on Weight-Balanced Trees. + (line 13) | * wt-tree/index-pair: Indexing Operations on Weight-Balanced Trees. + (line 14) | * wt-tree/intersection: Advanced Operations on Weight-Balanced Trees. + (line 38) | * wt-tree/lookup: Basic Operations on Weight-Balanced Trees. + (line 41) | * wt-tree/member?: Basic Operations on Weight-Balanced Trees. + (line 35) | * wt-tree/min: Indexing Operations on Weight-Balanced Trees. + (line 43) | * wt-tree/min-datum: Indexing Operations on Weight-Balanced Trees. + (line 44) | * wt-tree/min-pair: Indexing Operations on Weight-Balanced Trees. + (line 45) | * wt-tree/rank: Indexing Operations on Weight-Balanced Trees. + (line 35) | * wt-tree/set-equal?: Advanced Operations on Weight-Balanced Trees. + (line 74) | * wt-tree/size: Basic Operations on Weight-Balanced Trees. + (line 16) | * wt-tree/split<: Advanced Operations on Weight-Balanced Trees. + (line 11) | * wt-tree/split>: Advanced Operations on Weight-Balanced Trees. + (line 18) | * wt-tree/subset?: Advanced Operations on Weight-Balanced Trees. + (line 59) | * wt-tree/union: Advanced Operations on Weight-Balanced Trees. -* x-axis: Legending. | -* xcons: SRFI-1. -* xRGB->CIEXYZ: Color Conversions. | -* xrgb->color: Color Spaces. -* xRGB->sRGB: Color Conversions. | -* xyY->XYZ: Spectra. -* xyY:normalize-colors: Spectra. -* XYZ->chromaticity: Spectra. -* XYZ->xyY: Spectra. -* XYZ:normalize: Spectra. -* XYZ:normalize-colors: Spectra. -* y-axis: Legending. | -* zenith-xyy: Daylight. -* zip: SRFI-1. + (line 25) | +* x-axis: Legending. (line 51) | +* xcons: SRFI-1. (line 15) | +* xRGB->CIEXYZ: Color Conversions. (line 51) | +* xrgb->color: Color Spaces. (line 215) | +* xRGB->sRGB: Color Conversions. (line 54) | +* xyY->XYZ: Spectra. (line 188) | +* xyY:normalize-colors: Spectra. (line 190) | +* XYZ->chromaticity: Spectra. (line 165) | +* XYZ->xyY: Spectra. (line 184) | +* y-axis: Legending. (line 48) | +* zenith-xyy: Daylight. (line 70) | +* zip: SRFI-1. (line 98) | Variable Index ************** This is an alphabetical list of all the global variables in SLIB. + * Menu: -* *argv*: Getopt. -* *base-table-implementations*: Base Table. -* *catalog*: Require. | -* *http:byline*: HTTP and CGI. | -* *operating-system*: Batch. -* *optarg*: Getopt. -* *optind*: Getopt. -* *qp-width*: Quick Print. -* *random-state*: Exact Random Numbers. | -* *ruleset*: Commutative Rings. +* *argv*: Getopt. (line 25) | +* *base-table-implementations*: Base Table. (line 52) | +* *catalog*: Require. (line 10) | +* *http:byline*: HTTP and CGI. (line 17) | +* *operating-system*: Batch. (line 41) | +* *optarg*: Getopt. (line 35) | +* *optind*: Getopt. (line 30) | +* *qp-width*: Quick Print. (line 28) | +* *random-state*: Exact Random Numbers. + (line 21) | +* *ruleset*: Commutative Rings. (line 76) | * *syn-defs*: Ruleset Definition and Use. + (line 7) | * *syn-ignore-whitespace*: Ruleset Definition and Use. -* *timezone*: Time Zone. -* atm-hec-polynomial: Cyclic Checksum. -* bottomedge: Legending. | -* char-code-limit: Configuration. -* charplot:dimensions: Character Plotting. | -* CIEXYZ:A: Color Conversions. -* CIEXYZ:B: Color Conversions. -* CIEXYZ:C: Color Conversions. -* CIEXYZ:D50: Color Conversions. -* CIEXYZ:D65: Color Conversions. -* CIEXYZ:E: Color Conversions. | -* crc-08-polynomial: Cyclic Checksum. -* crc-10-polynomial: Cyclic Checksum. -* crc-12-polynomial: Cyclic Checksum. -* crc-16-polynomial: Cyclic Checksum. -* crc-32-polynomial: Cyclic Checksum. -* crc-ccitt-polynomial: Cyclic Checksum. -* D50: Color Data-Type. -* D65: Color Data-Type. -* daylight?: Time Zone. -* debug:max-count: Trace. -* distribute*: Commutative Rings. -* distribute/: Commutative Rings. -* dowcrc-polynomial: Cyclic Checksum. -* graph:dimensions: Legacy Plotting. | -* graphrect: Rectangles. | -* leftedge: Legending. | -* most-positive-fixnum: Configuration. -* nil: Miscellany. + (line 12) | +* *timezone*: Time Zone. (line 111) | +* atm-hec-polynomial: Cyclic Checksum. (line 115) | +* bottomedge: Legending. (line 18) | +* char-code-limit: Configuration. (line 11) | +* charplot:dimensions: Character Plotting. (line 9) | +* CIEXYZ:A: Color Conversions. (line 21) | +* CIEXYZ:B: Color Conversions. (line 22) | +* CIEXYZ:C: Color Conversions. (line 23) | +* CIEXYZ:D50: Color Conversions. (line 17) | +* CIEXYZ:D65: Color Conversions. (line 13) | +* CIEXYZ:E: Color Conversions. (line 24) | +* crc-08-polynomial: Cyclic Checksum. (line 109) | +* crc-10-polynomial: Cyclic Checksum. (line 98) | +* crc-12-polynomial: Cyclic Checksum. (line 77) | +* crc-16-polynomial: Cyclic Checksum. (line 69) | +* crc-32-polynomial: Cyclic Checksum. (line 45) | +* crc-ccitt-polynomial: Cyclic Checksum. (line 61) | +* D50: Color Data-Type. (line 120) | +* D65: Color Data-Type. (line 116) | +* daylight?: Time Zone. (line 117) | +* debug:max-count: Trace. (line 24) | +* distribute*: Commutative Rings. (line 100) | +* distribute/: Commutative Rings. (line 104) | +* dowcrc-polynomial: Cyclic Checksum. (line 120) | +* graph:dimensions: Legacy Plotting. (line 7) | +* graphrect: Rectangles. (line 26) | +* leftedge: Legending. (line 22) | +* most-positive-fixnum: Configuration. (line 15) | +* nil: Miscellany. (line 70) | * number-wt-type: Construction of Weight-Balanced Trees. -* plotrect: Rectangles. | -* prime:prngs: Prime Numbers. -* prime:trials: Prime Numbers. -* rightedge: Legending. | -* slib:form-feed: Configuration. -* slib:tab: Configuration. + (line 39) | +* plotrect: Rectangles. (line 22) | +* prime:prngs: Prime Numbers. (line 9) | +* prime:trials: Prime Numbers. (line 24) | +* rightedge: Legending. (line 23) | +* slib:form-feed: Configuration. (line 29) | +* slib:tab: Configuration. (line 26) | * stderr: Standard Formatted I/O. + (line 25) | * stdin: Standard Formatted I/O. + (line 19) | * stdout: Standard Formatted I/O. + (line 22) | * string-wt-type: Construction of Weight-Balanced Trees. -* t: Miscellany. -* tok:decimal-digits: Token definition. -* tok:lower-case: Token definition. -* tok:upper-case: Token definition. -* tok:whitespaces: Token definition. -* topedge: Legending. | -* tzname: Time Zone. -* usb-token-polynomial: Cyclic Checksum. + (line 45) | +* subarray0: Subarrays. (line 41) | +* t: Miscellany. (line 67) | +* tok:decimal-digits: Token definition. (line 41) | +* tok:lower-case: Token definition. (line 48) | +* tok:upper-case: Token definition. (line 44) | +* tok:whitespaces: Token definition. (line 52) | +* topedge: Legending. (line 17) | +* tzname: Time Zone. (line 123) | +* usb-token-polynomial: Cyclic Checksum. (line 124) | Concept and Feature Index ************************* + * Menu: -* aggregate <1>: Module Semantics. | -* aggregate: Library Catalogs. | -* alarm: Multi-Processing. | -* alarm-interrupt: Multi-Processing. | -* alist: Association Lists. +* aggregate <1>: Module Semantics. (line 20) | +* aggregate: Library Catalogs. (line 24) | +* alarm: Multi-Processing. (line 10) | +* alarm-interrupt: Multi-Processing. (line 10) | +* alist: Association Lists. (line 6) | * alist-table <1>: Relational Database Objects. -* alist-table <2>: The Base. | -* alist-table: Base Table. -* ange-ftp: URI. -* appearance: Solid Modeling. -* array: Arrays. -* array-for-each: Array Mapping. -* association function: Association Lists. | -* attribute-value: HTML. -* Auto-sharing: Using Databases. + (line 23) | +* alist-table <2>: The Base. (line 12) | +* alist-table: Base Table. (line 16) | +* ange-ftp: URI. (line 118) | +* appearance: Solid Modeling. (line 320) | +* array: Arrays. (line 6) | +* array-for-each: Array Mapping. (line 6) | +* association function: Association Lists. (line 17) | +* attribute-value: HTML. (line 10) | +* Auto-sharing: Using Databases. (line 25) | * balanced binary trees: Weight-Balanced Trees. -* base: URI. -* base-table: Base Table. -* batch: Batch. -* binary: Byte. + (line 8) | +* base: URI. (line 39) | +* base-table: Base Table. (line 6) | +* batch: Batch. (line 6) | +* binary: Byte. (line 56) | * binary trees: Weight-Balanced Trees. + (line 8) | * binary trees, as discrete maps: Weight-Balanced Trees. + (line 52) | * binary trees, as sets: Weight-Balanced Trees. + (line 52) | * binding power: Precedence Parsing Overview. -* break: Breakpoints. -* byte: Byte. -* byte-number: Byte/Number Conversions. | -* calendar time <1>: Posix Time. -* calendar time: Time and Date. -* Calendar-Time: Posix Time. -* caltime: Posix Time. -* canonical: Color Names. -* careful: Commutative Rings. -* catalog: Require. | -* Catalog File: Library Catalogs. -* certificate: Transactions. -* cgi: HTTP and CGI. -* chapter-order: Chapter Ordering. -* charplot: Character Plotting. | -* Chroma: Color Spaces. -* cie1931: Spectra. -* cie1964: Spectra. -* ciexyz: Spectra. -* CIEXYZ: Color Spaces. -* cksum-string: Cyclic Checksum. | -* coerce: Type Coercion. -* collect: Collections. -* color-database: Color Names. | -* color-names: Color Names. | -* command line: Command Line. -* commentfix: Rule Types. + (line 22) | +* break: Breakpoints. (line 6) | +* byte: Byte. (line 6) | +* byte-number: Byte/Number Conversions. + (line 6) | +* calendar time <1>: Posix Time. (line 10) | +* calendar time: Time and Date. (line 16) | +* Calendar-Time: Posix Time. (line 10) | +* caltime: Posix Time. (line 10) | +* canonical: Color Names. (line 16) | +* careful: Commutative Rings. (line 14) | +* catalog: Require. (line 6) | +* Catalog File: Library Catalogs. (line 6) | +* certificate: Transactions. (line 36) | +* cgi: HTTP and CGI. (line 6) | +* chapter-order: Chapter Ordering. (line 6) | +* charplot: Character Plotting. (line 6) | +* Chroma: Color Spaces. (line 141) | +* cie1931: Spectra. (line 31) | +* cie1964: Spectra. (line 27) | +* ciexyz: Spectra. (line 35) | +* CIEXYZ: Color Spaces. (line 18) | +* cksum-string: Cyclic Checksum. (line 160) | +* coerce: Type Coercion. (line 6) | +* collect: Collections. (line 6) | +* color-database: Color Names. (line 65) | +* color-names: Color Names. (line 6) | +* command line: Command Line. (line 10) | +* commentfix: Rule Types. (line 35) | * common-list-functions <1>: Common List Functions. -* common-list-functions: Collections. -* commutative-ring: Commutative Rings. -* compiled: Library Catalogs. | -* compiling: Module Conventions. | -* Coordinated Universal Time: Posix Time. -* copyright: Copyrights. -* crc: Cyclic Checksum. -* cvs: CVS. -* database-commands: Command Example. -* databases <1>: Command Example. + (line 6) | +* common-list-functions: Collections. (line 74) | +* commutative-ring: Commutative Rings. (line 11) | +* compiled: Library Catalogs. (line 21) | +* compiling: Module Conventions. (line 11) | +* Coordinated Universal Time: Posix Time. (line 13) | +* copyright: Copyrights. (line 6) | +* crc: Cyclic Checksum. (line 6) | +* cvs: CVS. (line 6) | +* database-commands: Command Example. (line 10) | +* databases <1>: Command Example. (line 11) | * databases <2>: Define-tables Example. -* databases <3>: Using Databases. -* databases: Batch. -* daylight: Daylight. -* db->html: HTML Tables. | -* debug <1>: Breakpoints. -* debug: Debug. -* defmacro: Library Catalogs. | -* defmacroexpand <1>: Pretty-Print. -* defmacroexpand: Defmacro. -* delim: Rule Types. -* dequeues: Queues. | -* determinant: Matrix Algebra. | -* diff: Sequence Comparison. -* directory: Directories. | -* Discrete Fourier Transform: Fast Fourier Transform. | + (line 12) | +* databases <3>: Using Databases. (line 6) | +* databases: Batch. (line 145) | +* daylight: Daylight. (line 6) | +* db->html: HTML Tables. (line 6) | +* debug <1>: Breakpoints. (line 11) | +* debug: Debug. (line 6) | +* defmacro: Library Catalogs. (line 31) | +* defmacroexpand <1>: Pretty-Print. (line 88) | +* defmacroexpand: Defmacro. (line 48) | +* delim: Rule Types. (line 47) | +* dequeues: Queues. (line 10) | +* determinant: Matrix Algebra. (line 6) | +* diff: Sequence Comparison. (line 6) | +* directory: Directories. (line 6) | +* Discrete Fourier Transform: Fast Fourier Transform. + (line 11) | * discrete maps, using binary trees: Weight-Balanced Trees. -* DrScheme: Installation. -* dynamic: Dynamic Data Type. -* dynamic-wind: Dynamic-Wind. -* e-sRGB: Color Spaces. -* emacs: Transactions. -* Encapsulated-PostScript: PostScript Graphing. | -* escaped: URI. -* Euclidean Domain: Commutative Rings. -* eval: Eval. -* exchanger: Miscellany. -* factor: Prime Numbers. -* feature <1>: About this manual. -* feature <2>: Require. | -* feature: Feature. + (line 52) | +* DrScheme: Installation. (line 103) | +* dynamic: Dynamic Data Type. (line 6) | +* dynamic-wind: Dynamic-Wind. (line 6) | +* e-sRGB: Color Spaces. (line 218) | +* emacs: Transactions. (line 33) | +* Encapsulated-PostScript: PostScript Graphing. (line 23) | +* escaped: URI. (line 77) | +* EUC: Extra-SLIB Packages. (line 53) | +* Euclidean Domain: Commutative Rings. (line 67) | +* eval: Eval. (line 6) | +* exchanger: Miscellany. (line 31) | +* factor: Prime Numbers. (line 6) | +* feature <1>: About this manual. (line 13) | +* feature <2>: Require. (line 18) | +* feature: Feature. (line 6) | * fft: Fast Fourier Transform. -* File Transfer Protocol: URI. -* file-lock: Transactions. -* filename: Filenames. -* fluid-let: Fluid-Let. -* form: HTML. -* format: Format. -* gamut: Color Spaces. -* generic-write: Generic-Write. -* getit: URI. -* getopt <1>: Command Example. -* getopt: Getopt. -* getopt-parameters <1>: Command Example. + (line 6) | +* File Transfer Protocol: URI. (line 113) | +* file-lock: Transactions. (line 32) | +* filename: Filenames. (line 6) | +* fluid-let: Fluid-Let. (line 6) | +* form: HTML. (line 63) | +* format: Format. (line 6) | +* Gambit-C: Installation. (line 116) | +* gamut: Color Spaces. (line 18) | +* generic-write: Generic-Write. (line 6) | +* getit: URI. (line 118) | +* getopt <1>: Command Example. (line 14) | +* getopt: Getopt. (line 6) | +* getopt-parameters <1>: Command Example. (line 12) | * getopt-parameters: Getopt Parameter lists. -* glob <1>: Batch. -* glob: Filenames. -* Gray code: Bit-Twiddling. -* Guile: Installation. -* hash: Hashing. -* hash-table: Hash Tables. -* Hilbert: Peano-Hilbert Space-Filling Curve. -* hilbert-fill: Peano-Hilbert Space-Filling Curve. -* HOME <1>: Vicinity. -* HOME: Catalog Creation. | -* homecat: Catalog Vicinities. | -* html-for-each: Parsing HTML. -* html-form: HTML. -* http: HTTP and CGI. -* Hue: Color Spaces. -* ICC Profile: Color Spaces. -* implcat: Catalog Vicinities. | -* indexed-sequential-access-method: Byte/Number Conversions. | -* infix: Rule Types. -* Info: Top-level Variable References. | -* inmatchfix: Rule Types. -* install: Installation. | -* installation: Installation. | -* intrinsic feature: Feature. | -* ISAM: Indexed Sequential Access Methods. | -* L*a*b*: Color Spaces. -* L*C*h: Color Spaces. -* L*u*v*: Color Spaces. + (line 6) | +* glob <1>: Batch. (line 148) | +* glob: Filenames. (line 6) | +* Gray code: Hilbert Space-Filling Curve. | + (line 52) | +* Guile: Installation. (line 119) | +* hash: Hashing. (line 6) | +* hash-table: Hash Tables. (line 6) | +* Hilbert: Hilbert Space-Filling Curve. | + (line 8) | +* Hilbert Space-Filling Curve: Hilbert Space-Filling Curve. | + (line 8) | +* hilbert-fill: Hilbert Space-Filling Curve. | + (line 6) | +* HOME <1>: Vicinity. (line 51) | +* HOME: Catalog Creation. (line 19) | +* homecat: Catalog Vicinities. (line 35) | +* html-for-each: Parsing HTML. (line 6) | +* html-form: HTML. (line 6) | +* http: HTTP and CGI. (line 6) | +* Hue: Color Spaces. (line 143) | +* ICC Profile: Color Spaces. (line 191) | +* implcat: Catalog Vicinities. (line 23) | +* indexed-sequential-access-method: Byte/Number Conversions. + (line 120) | +* infix: Rule Types. (line 19) | +* Info: Top-level Variable References. + (line 32) | +* inmatchfix: Rule Types. (line 43) | +* install: Installation. (line 6) | +* installation: Installation. (line 6) | +* intrinsic feature: Feature. (line 9) | +* ISAM: Indexed Sequential Access Methods. + (line 6) | +* Japanese: Extra-SLIB Packages. (line 53) | +* JFILTER: Extra-SLIB Packages. (line 53) | +* JIS: Extra-SLIB Packages. (line 53) | +* L*a*b*: Color Spaces. (line 68) | +* L*C*h: Color Spaces. (line 135) | +* L*u*v*: Color Spaces. (line 98) | +* lamination: Hilbert Space-Filling Curve. | + (line 88) | * Left Denotation, led: Nud and Led Definition. -* Lightness: Color Spaces. -* line-i: Line I/O. -* list-processing library: SRFI-1. -* load-option: Weight-Balanced Trees. | -* logical: Bit-Twiddling. -* macro <1>: Repl. -* macro <2>: R4RS Macros. | -* macro: Library Catalogs. | -* macro-by-example <1>: Macro by Example. | -* macro-by-example: Library Catalogs. | -* macros-that-work <1>: Macros That Work. | -* macros-that-work: Library Catalogs. | -* manifest: Module Manifests. | -* match: Match Keys. | -* match-keys <1>: Match Keys. | -* match-keys: Match-Keys. | -* matchfix: Rule Types. -* matfile: MAT-File Format. -* matlab: MAT-File Format. -* metric-units: Metric Units. -* minimize: Minimizing. + (line 13) | +* Lightness: Color Spaces. (line 71) | +* line-i: Line I/O. (line 6) | +* list-processing library: SRFI-1. (line 8) | +* load-option: Weight-Balanced Trees. + (line 73) | +* logical: Bit-Twiddling. (line 6) | +* macro <1>: Repl. (line 32) | +* macro <2>: R4RS Macros. (line 6) | +* macro: Library Catalogs. (line 37) | +* macro-by-example <1>: Macro by Example. (line 6) | +* macro-by-example: Library Catalogs. (line 34) | +* macros-that-work <1>: Macros That Work. (line 6) | +* macros-that-work: Library Catalogs. (line 40) | +* manifest: Module Manifests. (line 6) | +* match: Match Keys. (line 6) | +* match-keys <1>: Match Keys. (line 6) | +* match-keys: Match-Keys. (line 6) | +* matchfix: Rule Types. (line 39) | +* matfile: MAT-File Format. (line 6) | +* matlab: MAT-File Format. (line 6) | +* metric-units: Metric Units. (line 6) | +* minimize: Minimizing. (line 6) | * minimum field width (printf): Standard Formatted Output. -* MIT Scheme: Installation. -* mkimpcat.scm: Catalog Vicinities. | -* mklibcat.scm: Catalog Vicinities. | -* modular: Modular Arithmetic. + (line 88) | +* MIT Scheme: Installation. (line 113) | +* mkimpcat.scm: Catalog Vicinities. (line 28) | +* mklibcat.scm: Catalog Vicinities. (line 16) | +* modular: Modular Arithmetic. (line 6) | * multiarg: Multi-argument / and -. + (line 6) | * multiarg-apply: Multi-argument Apply. -* MzScheme: Installation. -* nary: Rule Types. -* new-catalog: Catalog Creation. | -* nofix: Rule Types. -* null: HTML Tables. + (line 6) | +* MzScheme: Installation. (line 104) | +* nary: Rule Types. (line 23) | +* new-catalog: Catalog Creation. (line 48) | +* nofix: Rule Types. (line 11) | +* null: HTML Tables. (line 92) | * Null Denotation, nud: Nud and Led Definition. -* object: Object. -* object->string: Object-To-String. -* oop: Yasos. + (line 9) | +* object: Object. (line 6) | +* object->string: Object-To-String. (line 6) | +* oop: Yasos. (line 6) | * option, run-time-loadable: Weight-Balanced Trees. -* options file: Command Line. -* parameters <1>: Command Example. -* parameters <2>: Batch. -* parameters: Parameter lists. -* parse: Precedence Parsing. + (line 69) | +* options file: Command Line. (line 65) | +* parameters <1>: Command Example. (line 13) | +* parameters <2>: Batch. (line 146) | +* parameters: Parameter lists. (line 6) | +* parse: Precedence Parsing. (line 6) | * pbm: Portable Image Files. + (line 22) | * pbm-raw: Portable Image Files. -* Peano: Peano-Hilbert Space-Filling Curve. -* Peano-Hilbert Space-Filling Curve: Peano-Hilbert Space-Filling Curve. + (line 22) | * pgm: Portable Image Files. + (line 26) | * pgm-raw: Portable Image Files. -* plain-text: HTML. -* PLT Scheme: Installation. -* pnm: Portable Image Files. | -* portable bitmap graphics: Portable Image Files. | -* posix-time: Posix Time. -* postfix: Rule Types. + (line 26) | +* plain-text: HTML. (line 14) | +* PLT Scheme: Installation. (line 102) | +* pnm: Portable Image Files. + (line 6) | +* portable bitmap graphics: Portable Image Files. + (line 9) | +* posix-time: Posix Time. (line 7) | +* postfix: Rule Types. (line 27) | * ppm: Portable Image Files. + (line 31) | * ppm-raw: Portable Image Files. -* pprint-file: Pretty-Print. -* PRE: HTML. -* precedence: Precedence Parsing. + (line 31) | +* pprint-file: Pretty-Print. (line 60) | +* PRE: HTML. (line 50) | +* precedence: Precedence Parsing. (line 6) | * precision (printf): Standard Formatted Output. -* prefix: Rule Types. -* prestfix: Rule Types. -* pretty-print: Pretty-Print. -* primes: Prime Numbers. + (line 101) | +* prefix: Rule Types. (line 15) | +* prestfix: Rule Types. (line 31) | +* pretty-print: Pretty-Print. (line 6) | +* primes: Prime Numbers. (line 6) | * printf: Standard Formatted Output. -* priority-queue: Priority Queues. -* PRNG: Random Numbers. -* process: Multi-Processing. -* promise: Promises. -* qp <1>: Quick Print. -* qp: Getopt. -* query-string: HTTP and CGI. -* queue: Queues. -* r2rs: RnRS. -* r3rs <1>: Coding Guidelines. | -* r3rs: RnRS. -* r4rs: RnRS. -* r5rs: RnRS. -* random: Exact Random Numbers. | -* random-inexact: Inexact Random Numbers. | -* range: Column Ranges. | -* rationalize: Rationalize. -* read-command: Command Line. -* record: Records. -* rectangle: Rectangles. | -* relational-database: Relational Database. -* relational-system: Using Databases. | -* repl <1>: Repl. -* repl: Syntax-Case Macros. -* resene: Color Names. -* Resene: Color Names. -* reset: HTML. -* rev2-procedures: Rev2 Procedures. | + (line 6) | +* priority-queue: Priority Queues. (line 6) | +* PRNG: Random Numbers. (line 6) | +* process: Multi-Processing. (line 6) | +* Prolog: Extra-SLIB Packages. (line 49) | +* promise: Promises. (line 6) | +* PSD: Extra-SLIB Packages. (line 26) | +* qp <1>: Quick Print. (line 6) | +* qp: Getopt. (line 146) | +* query-string: HTTP and CGI. (line 36) | +* queue: Queues. (line 6) | +* r2rs: RnRS. (line 11) | +* r3rs <1>: Coding Guidelines. (line 10) | +* r3rs: RnRS. (line 16) | +* r4rs: RnRS. (line 24) | +* r5rs: RnRS. (line 29) | +* random: Exact Random Numbers. + (line 6) | +* random-inexact: Inexact Random Numbers. + (line 6) | +* range: Column Ranges. (line 6) | +* rationalize: Rationalize. (line 6) | +* read-command: Command Line. (line 6) | +* record: Records. (line 6) | +* rectangle: Rectangles. (line 6) | +* relational-database: Relational Database. (line 6) | +* relational-system: Using Databases. (line 53) | +* repl <1>: Repl. (line 6) | +* repl: Syntax-Case Macros. (line 61) | +* resene: Color Names. (line 126) | +* Resene: Color Names. (line 95) | +* reset: HTML. (line 95) | +* rev2-procedures: Rev2 Procedures. (line 6) | * rev4-optional-procedures: Rev4 Optional Procedures. -* RGB709: Color Spaces. -* ring, commutative: Commutative Rings. -* RNG: Random Numbers. -* root: Root Finding. + (line 6) | +* RGB709: Color Spaces. (line 37) | +* ring, commutative: Commutative Rings. (line 11) | +* RNG: Random Numbers. (line 6) | +* root: Root Finding. (line 6) | * run-time-loadable option: Weight-Balanced Trees. -* rwb-isam: Base Table. | -* saturate: Color Names. + (line 69) | +* rwb-isam: Base Table. (line 39) | +* saturate: Color Names. (line 95) | * scanf: Standard Formatted Input. -* scheme: URI. -* Scheme Request For Implementation: SRFI. -* Scheme48: Installation. -* schmooz: Schmooz. -* SCM: Installation. -* self-set: Commutative Rings. -* Sequence Comparison: Sequence Comparison. -* Server-based Naming Authority: URI. -* session: Feature. + (line 6) | +* SCHELOG: Extra-SLIB Packages. (line 49) | +* scheme: URI. (line 99) | +* Scheme Request For Implementation: SRFI. (line 8) | +* Scheme48: Installation. (line 137) | +* schmooz: Schmooz. (line 6) | +* SCM: Installation. (line 97) | +* script: Installation. (line 37) | +* self-set: Commutative Rings. (line 17) | +* Sequence Comparison: Sequence Comparison. (line 6) | +* Server-based Naming Authority: URI. (line 58) | +* session: Feature. (line 7) | * sets, using binary trees: Weight-Balanced Trees. -* shell: Command Line. | -* sierpinski: Sierpinski Curve. -* sitecat: Catalog Vicinities. | -* sky: Daylight. -* slibcat: Catalog Vicinities. | -* solid: Solid Modeling. -* solid-modeling: Solid Modeling. -* solids: Solid Modeling. -* sort: Sorting. -* soundex: Soundex. -* source: Library Catalogs. | -* Space-Filling: Peano-Hilbert Space-Filling Curve. -* sparse: MAT-File Format. -* Spectral Tristimulus Values: Spectra. -* spiff: Sequence Comparison. -* srfi: SRFI. -* SRFI-1: SRFI-1. -* srfi-1: SRFI-1. -* srfi-2: SRFI-2. | -* srfi-8: SRFI-8. | -* srfi-9: SRFI-9. | -* sRGB: Color Spaces. + (line 52) | +* shell: Command Line. (line 12) | +* sierpinski: Sierpinski Curve. (line 6) | +* sitecat: Catalog Vicinities. (line 19) | +* sky: Daylight. (line 6) | +* slib: Installation. (line 37) | +* slibcat: Catalog Vicinities. (line 11) | +* solid: Solid Modeling. (line 6) | +* solid-modeling: Solid Modeling. (line 6) | +* solids: Solid Modeling. (line 6) | +* sort: Sorting. (line 6) | +* soundex: Soundex. (line 6) | +* source: Library Catalogs. (line 18) | +* Space-Filling: Hilbert Space-Filling Curve. | + (line 8) | +* sparse: MAT-File Format. (line 15) | +* Spectral Tristimulus Values: Spectra. (line 24) | +* spiff: Sequence Comparison. (line 29) | +* srfi: SRFI. (line 6) | +* SRFI-1: SRFI-1. (line 8) | +* srfi-1: SRFI-1. (line 6) | +* srfi-2: SRFI-2. (line 6) | +* srfi-8: SRFI-8. (line 6) | +* srfi-9: SRFI-9. (line 6) | +* sRGB: Color Spaces. (line 189) | * stdio: Standard Formatted I/O. -* string-case: String-Case. -* string-port: String Ports. -* string-search: String Search. -* subarray: Subarrays. -* sun: Daylight. -* sunlight: Daylight. -* symmetric: Modular Arithmetic. | -* syntactic-closures <1>: Syntactic Closures. | -* syntactic-closures: Library Catalogs. | + (line 14) | +* string-case: String-Case. (line 6) | +* string-port: String Ports. (line 6) | +* string-search: String Search. (line 6) | +* subarray: Subarrays. (line 6) | +* sun: Daylight. (line 6) | +* sunlight: Daylight. (line 6) | +* symmetric: Modular Arithmetic. (line 54) | +* syntactic-closures <1>: Syntactic Closures. (line 6) | +* syntactic-closures: Library Catalogs. (line 46) | * syntax tree: Precedence Parsing Overview. -* syntax-case <1>: Syntax-Case Macros. | -* syntax-case: Library Catalogs. | -* time: Time and Date. -* time-zone: Time Zone. -* top-level variable references: Top-level Variable References. | -* top-refs: Top-level Variable References. | -* topological-sort: Topological Sort. -* trace: Trace. -* transact: Transactions. -* transcript: Transcripts. -* tree: Tree Operations. + (line 32) | +* syntax-case <1>: Syntax-Case Macros. (line 6) | +* syntax-case: Library Catalogs. (line 43) | +* time: Time and Date. (line 16) | +* time-zone: Time Zone. (line 63) | +* top-level variable references: Top-level Variable References. + (line 6) | +* top-refs: Top-level Variable References. + (line 6) | +* topological-sort: Topological Sort. (line 6) | +* trace: Trace. (line 6) | +* transact: Transactions. (line 10) | +* transcript: Transcripts. (line 6) | +* tree: Tree Operations. (line 6) | * trees, balanced binary: Weight-Balanced Trees. -* tristimulus: Color Spaces. -* tsort: Topological Sort. -* turbidity: Daylight. -* TZ-string: Time Zone. -* Uniform Resource Identifiers: URI. -* Uniform Resource Locator: URI. -* Unique Factorization: Commutative Rings. -* unsafe: URI. -* URI: URI. -* uri: URI. -* URI: HTTP and CGI. -* usercat: Catalog Vicinities. | -* UTC: Posix Time. -* values: Values. -* variable references: Top-level Variable References. | -* vet: Module Analysis. | -* VSCM: Installation. -* WB: Base Table. -* wb-table: Base Table. + (line 8) | +* tristimulus: Color Spaces. (line 9) | +* tsort: Topological Sort. (line 6) | +* turbidity: Daylight. (line 31) | +* TZ-string: Time Zone. (line 9) | +* Uniform Resource Identifiers: URI. (line 8) | +* Uniform Resource Locator: URI. (line 118) | +* Unique Factorization: Commutative Rings. (line 67) | +* unsafe: URI. (line 77) | +* URI: URI. (line 71) | +* uri: URI. (line 6) | +* URI: HTTP and CGI. (line 36) | +* usercat: Catalog Vicinities. (line 38) | +* UTC: Posix Time. (line 13) | +* values: Values. (line 6) | +* variable references: Top-level Variable References. + (line 6) | +* vet: Module Analysis. (line 6) | +* VSCM: Installation. (line 148) | +* WB: Base Table. (line 34) | +* wb-table: Base Table. (line 32) | * weight-balanced binary trees: Weight-Balanced Trees. -* wget: Color Names. -* white point: Color Data-Type. -* wild-card: Match Keys. | -* with-file: With-File. -* Word: Transactions. + (line 8) | +* wget: Color Names. (line 81) | +* white point: Color Data-Type. (line 107) | +* wild-card: Match Keys. (line 6) | +* with-file: With-File. (line 6) | +* Word: Transactions. (line 34) | * wt-tree: Weight-Balanced Trees. -* xRGB: Color Spaces. -* xyY: Spectra. -* yasos: Yasos. + (line 6) | +* xRGB: Color Spaces. (line 204) | +* xyY: Spectra. (line 175) | +* yasos: Yasos. (line 6) | Tag Table: -Node: Top1038 -Node: The Library System1832 -Node: Feature2447 -Node: Require5817 -Node: Library Catalogs9665 -Node: Catalog Creation11330 -Node: Catalog Vicinities14797 -Node: Compiling Scheme19397 -Node: Module Conventions20721 -Ref: Module Conventions-Footnote-115614 -Node: Module Manifests23491 -Node: Module Semantics32652 -Node: Top-level Variable References35341 -Ref: Top-level Variable References-Footnote-124139 -Node: Module Analysis39789 -Node: Universal SLIB Procedures42532 -Node: Vicinity43862 -Node: Configuration47550 -Node: Input/Output50710 -Node: System54238 -Node: Miscellany57523 -Node: Scheme Syntax Extension Packages59694 -Node: Defmacro60439 -Node: R4RS Macros62386 -Node: Macro by Example63639 -Node: Macros That Work66514 -Node: Syntactic Closures72567 -Node: Syntax-Case Macros89995 -Node: Fluid-Let94454 -Node: Yasos95393 -Node: Yasos terms96184 -Node: Yasos interface97208 -Node: Setters99283 -Node: Yasos examples101923 -Node: Textual Conversion Packages104922 -Node: Precedence Parsing105719 -Node: Precedence Parsing Overview106395 -Ref: Precedence Parsing Overview-Footnote-188500 -Node: Rule Types108019 -Node: Ruleset Definition and Use109452 -Node: Token definition111816 -Node: Nud and Led Definition114725 -Node: Grammar Rule Definition117172 -Node: Format124746 -Node: Standard Formatted I/O125156 -Node: Standard Formatted Output125720 -Node: Standard Formatted Input135110 -Node: Programs and Arguments141768 -Node: Getopt142268 -Node: Command Line148891 -Node: Parameter lists152078 -Node: Getopt Parameter lists155963 -Node: Filenames159199 -Node: Batch163646 -Node: HTML171449 -Node: HTML Tables178112 -Node: HTTP and CGI184553 -Node: Parsing HTML189090 -Node: URI191584 -Node: Printing Scheme196704 -Node: Generic-Write197013 -Node: Object-To-String198414 -Node: Pretty-Print198816 -Node: Time and Date201777 -Node: Time Zone202797 -Node: Posix Time207756 -Node: Common-Lisp Time209892 -Node: NCBI-DNA211471 -Node: Schmooz212801 -Node: Mathematical Packages217028 -Node: Bit-Twiddling217744 -Node: Modular Arithmetic225665 -Node: Prime Numbers228534 -Node: Random Numbers230215 -Node: Exact Random Numbers231435 -Node: Inexact Random Numbers234181 -Node: Fast Fourier Transform236532 -Node: Cyclic Checksum237446 -Node: Graphing244571 -Node: Character Plotting245251 -Node: PostScript Graphing251089 -Node: Column Ranges255097 -Node: Drawing the Graph258417 -Node: Graphics Context263014 -Node: Rectangles267208 -Node: Legending270354 -Node: Legacy Plotting274779 -Node: Example Graph276487 -Node: Solid Modeling284587 -Node: Color300794 -Node: Color Data-Type301620 -Ref: Color Data-Type-Footnote-1261941 -Node: Color Spaces305581 -Ref: Color Spaces-Footnote-1271875 -Node: Spectra315434 -Node: Color Difference Metrics323004 -Node: Color Conversions326666 -Node: Color Names329317 -Node: Daylight336339 -Node: Root Finding341138 -Node: Minimizing345119 -Ref: Minimizing-Footnote-1301934 -Node: Commutative Rings347157 -Node: Matrix Algebra358549 -Node: Database Packages359679 -Node: Relational Database360087 -Node: Using Databases361118 -Node: Table Operations369657 -Node: Single Row Operations371774 -Node: Match-Keys375050 -Node: Multi-Row Operations378335 -Node: Indexed Sequential Access Methods381431 -Node: Sequential Index Operations383339 -Node: Table Administration387317 -Node: Database Interpolation388727 -Node: Embedded Commands390241 -Node: Database Extension391882 -Node: Command Intrinsics393982 -Node: Define-tables Example395584 -Node: The *commands* Table397396 -Node: Command Service399709 -Node: Command Example401654 -Node: Database Macros406303 -Node: Within-database Example408933 -Node: Database Browser410852 -Node: Relational Infrastructure412730 -Node: Base Table413507 -Node: The Base418368 -Node: Base Tables422788 -Node: Base Field Types425445 -Node: Composite Keys426988 -Node: Base Record Operations430382 -Node: Match Keys433530 -Node: Aggregate Base Operations435329 -Node: Base ISAM Operations437366 -Node: Catalog Representation439784 -Node: Relational Database Objects445280 -Node: Database Operations449505 -Node: Weight-Balanced Trees455859 -Node: Construction of Weight-Balanced Trees459813 -Node: Basic Operations on Weight-Balanced Trees463261 -Node: Advanced Operations on Weight-Balanced Trees466187 -Node: Indexing Operations on Weight-Balanced Trees472207 -Node: Other Packages476032 -Node: Data Structures476583 -Node: Arrays477400 -Node: Subarrays482891 -Node: Array Mapping486245 -Node: Association Lists488990 -Node: Byte491241 -Node: Byte/Number Conversions499604 -Node: MAT-File Format511631 -Node: Portable Image Files512974 -Node: Collections514601 -Node: Dynamic Data Type520757 -Node: Hash Tables522016 -Node: Object524916 -Node: Priority Queues533150 -Node: Queues534217 -Node: Records535855 -Node: Sorting and Searching539345 -Node: Common List Functions540030 -Node: List construction540474 -Node: Lists as sets542169 -Node: Lists as sequences548782 -Node: Destructive list operations554036 -Node: Non-List functions556705 -Node: Tree Operations557775 -Node: Chapter Ordering559541 -Node: Sorting561170 -Node: Topological Sort567171 -Node: Hashing568864 -Node: Space-Filling Curves569865 -Node: Peano-Hilbert Space-Filling Curve570085 -Node: Sierpinski Curve571277 -Node: Soundex573731 -Node: String Search575345 -Node: Sequence Comparison578018 -Node: Procedures581424 -Node: Type Coercion581944 -Node: String-Case582361 -Node: String Ports584209 -Node: Line I/O584966 -Node: Multi-Processing587018 -Node: Metric Units588120 -Node: Standards Support596342 -Node: RnRS597171 -Node: With-File598378 -Node: Transcripts598639 -Node: Rev2 Procedures598958 -Node: Rev4 Optional Procedures600666 -Node: Multi-argument / and -601234 -Node: Multi-argument Apply601748 -Node: Rationalize602150 -Node: Promises603412 -Node: Dynamic-Wind604467 -Node: Eval605719 -Node: Values609054 -Node: SRFI609852 -Node: SRFI-1611285 -Node: SRFI-2617429 -Node: SRFI-8618223 -Node: SRFI-9619017 -Node: Session Support620436 -Node: Repl620913 -Node: Quick Print622194 -Node: Debug623483 -Node: Breakpoints624367 -Node: Trace626388 -Node: System Interface629792 -Node: Directories630353 -Node: Transactions631828 -Node: CVS637524 -Node: Extra-SLIB Packages638596 -Node: About SLIB640897 -Node: Installation641640 -Node: Porting646734 -Ref: Porting-Footnote-1555316 -Node: Coding Guidelines648663 -Node: Copyrights651753 -Node: About this manual655155 -Node: Index656435 +Node: Top1050 +Node: The Library System1830 +Node: Feature2245 +Ref: Feature-Footnote-14358 +Node: Require5422 +Node: Library Catalogs8232 +Node: Catalog Creation9818 +Node: Catalog Vicinities12409 +Node: Compiling Scheme15318 +Node: Module Conventions16086 +Ref: Module Conventions-Footnote-115790 +Node: Module Manifests17905 +Node: Module Semantics24174 +Node: Top-level Variable References25906 +Ref: Top-level Variable References-Footnote-125205 +Node: Module Analysis28540 +Node: Universal SLIB Procedures29984 +Node: Vicinity30703 +Node: Configuration35672 +Node: Input/Output39213 +Node: System43424 +Node: Miscellany47174 +Node: Scheme Syntax Extension Packages50488 +Node: Defmacro51328 +Node: R4RS Macros53936 +Node: Macro by Example55457 +Node: Macros That Work58668 +Node: Syntactic Closures65450 +Node: Syntax-Case Macros84160 +Node: Define-Structure88676 +Node: Fluid-Let92589 +Node: Yasos93779 +Node: Yasos terms94719 +Node: Yasos interface95891 +Node: Setters98343 +Node: Yasos examples101344 +Node: Textual Conversion Packages104430 +Node: Precedence Parsing105331 +Node: Precedence Parsing Overview106130 +Ref: Precedence Parsing Overview-Footnote-192368 +Node: Rule Types107883 +Node: Ruleset Definition and Use109969 +Node: Token definition112657 +Node: Nud and Led Definition115647 +Node: Grammar Rule Definition118282 +Node: Format126334 +Node: Format Interface127181 +Node: Format Specification130001 +Node: Standard Formatted I/O164087 +Node: Standard Formatted Output165095 +Node: Standard Formatted Input175192 +Node: Programs and Arguments182214 +Node: Getopt182830 +Node: Command Line189908 +Node: Parameter lists193453 +Node: Getopt Parameter lists197629 +Node: Filenames201062 +Node: Batch205387 +Node: HTML213937 +Node: HTML Tables221689 +Node: HTTP and CGI229219 +Node: Parsing HTML234169 +Node: URI236951 +Node: Printing Scheme242831 +Node: Generic-Write243268 +Node: Object-To-String244827 +Node: Pretty-Print245438 +Node: Time and Date248854 +Node: Time Zone250220 +Node: Posix Time255673 +Node: Common-Lisp Time258625 +Node: Time Infrastructure260591 +Node: NCBI-DNA261802 +Node: Schmooz263727 +Node: Mathematical Packages268256 +Node: Bit-Twiddling269021 +Node: Modular Arithmetic281008 +Node: Prime Numbers284612 +Node: Random Numbers286794 +Node: Exact Random Numbers287776 +Node: Inexact Random Numbers290537 +Node: Fast Fourier Transform292983 +Node: Cyclic Checksum294111 +Node: Graphing303476 +Node: Character Plotting303805 +Node: PostScript Graphing309646 +Node: Column Ranges311628 +Node: Drawing the Graph313486 +Node: Graphics Context314712 +Node: Rectangles317024 +Node: Legending318945 +Node: Legacy Plotting322142 +Node: Example Graph323249 +Node: Solid Modeling327759 +Node: Color351601 +Node: Color Data-Type352612 +Ref: Color Data-Type-Footnote-1284376 +Node: Color Spaces358369 +Ref: Color Spaces-Footnote-1294375 +Node: Spectra370274 +Node: Color Difference Metrics382078 +Node: Color Conversions385366 +Node: Color Names389006 +Node: Daylight396689 +Node: Root Finding401853 +Node: Minimizing406185 +Ref: Minimizing-Footnote-1325873 +Node: Commutative Rings408394 +Node: Matrix Algebra420462 +Node: Database Packages422035 +Node: Relational Database422438 +Node: Using Databases423442 +Node: Table Operations430658 +Node: Single Row Operations432012 +Node: Match-Keys434523 +Node: Multi-Row Operations436752 +Node: Indexed Sequential Access Methods439440 +Node: Sequential Index Operations440524 +Node: Table Administration443107 +Node: Database Interpolation444263 +Node: Embedded Commands445497 +Node: Database Extension447183 +Node: Command Intrinsics449704 +Node: Define-tables Example451428 +Node: The *commands* Table453178 +Node: Command Service455558 +Node: Command Example457663 +Node: Database Macros462328 +Node: Within-database463389 +Node: Within-database Example467960 +Node: Database Browser469922 +Node: Relational Infrastructure471391 +Node: Base Table471795 +Node: The Base474637 +Node: Base Tables478020 +Node: Base Field Types479690 +Node: Composite Keys480635 +Node: Base Record Operations482873 +Node: Match Keys484812 +Node: Aggregate Base Operations485815 +Node: Base ISAM Operations487046 +Node: Catalog Representation488515 +Node: Relational Database Objects491286 +Node: Database Operations494070 +Node: Weight-Balanced Trees498159 +Node: Construction of Weight-Balanced Trees502153 +Node: Basic Operations on Weight-Balanced Trees505925 +Node: Advanced Operations on Weight-Balanced Trees509145 +Node: Indexing Operations on Weight-Balanced Trees515503 +Node: Other Packages519732 +Node: Data Structures520387 +Node: Arrays521297 +Node: Subarrays537830 +Node: Array Mapping540359 +Node: Association Lists543098 +Node: Byte545792 +Node: Byte/Number Conversions552214 +Node: MAT-File Format559755 +Node: Portable Image Files561303 +Node: Collections563302 +Node: Dynamic Data Type570079 +Node: Hash Tables571690 +Node: Object574797 +Node: Priority Queues584148 +Node: Queues585299 +Node: Records587191 +Node: Sorting and Searching591002 +Node: Common List Functions591803 +Node: List construction592364 +Node: Lists as sets594388 +Node: Lists as sequences601898 +Node: Destructive list operations607714 +Node: Non-List functions610724 +Node: Tree Operations612077 +Node: Chapter Ordering614118 +Node: Sorting616063 +Node: Topological Sort622251 +Node: Hashing624164 +Node: Space-Filling Curves625476 +Node: Hilbert Space-Filling Curve625936 +Node: Peano Space-Filling Curve634464 +Node: Sierpinski Curve635724 +Node: Soundex638404 +Node: String Search640187 +Node: Sequence Comparison643272 +Node: Procedures647125 +Node: Type Coercion647783 +Node: String-Case648432 +Node: String Ports650820 +Node: Line I/O651780 +Node: Multi-Processing654063 +Node: Metric Units655440 +Node: Standards Support664254 +Node: RnRS665166 +Node: With-File666775 +Node: Transcripts667248 +Node: Rev2 Procedures667791 +Node: Rev4 Optional Procedures670214 +Node: Multi-argument / and -670979 +Node: Multi-argument Apply671573 +Node: Rationalize672062 +Node: Promises673492 +Node: Dynamic-Wind674227 +Node: Eval675646 +Node: Values679319 +Node: SRFI680355 +Node: SRFI-1682144 +Node: SRFI-2693631 +Node: SRFI-8694050 +Node: SRFI-9694469 +Node: Session Support695156 +Node: Repl696162 +Node: Quick Print697691 +Node: Debug699333 +Node: Breakpoints700639 +Node: Trace703394 +Node: System Interface707940 +Node: Directories708727 +Node: Transactions710523 +Node: CVS716514 +Node: Extra-SLIB Packages718222 +Node: About SLIB720688 +Node: Installation721619 +Node: The SLIB script730918 +Node: Porting731819 +Ref: Porting-Footnote-1590851 +Node: Coding Guidelines733598 +Node: Copyrights736248 +Node: About this manual739997 +Node: Index740742 End Tag Table @@ -1,6 +1,6 @@ ##"slib" script; Find a Scheme implementation and initialize SLIB in it. -#Copyright (C) 2003 Aubrey Jaffer +#Copyright (C) 2003, 2004 Aubrey Jaffer # #Permission to copy this software, to modify it, to redistribute it, #to distribute modified versions, and to use it for any purpose is @@ -47,26 +47,7 @@ if [ ! -z "$1" ]; then echo "$usage"; exit 1 fi -if type $command>/dev/null 2>&1; then - SPEW="`$command --version < /dev/null 2>&1`" - if echo ${SPEW} | grep -q 'Initialize load-path (colon-list of directories)' \ - ; then implementation=elk - elif echo ${SPEW} | grep -q 'MIT Scheme' ; then implementation=mit - elif echo ${SPEW} | grep -q 'UMB Scheme' ; then implementation=umb - elif echo ${SPEW} | grep -q 'scheme48' ; then implementation=s48 - elif echo ${SPEW} | grep -q 'MzScheme' ; then implementation=plt - elif echo ${SPEW} | grep -q 'Guile' ; then implementation=gui - elif echo ${SPEW} | grep -q 'gambc' ; then implementation=gam - elif echo ${SPEW} | grep -q 'SCM' ; then implementation=scm - else implementation= - fi -elif [ ! -z "$command" ]; then - echo "Program '$command' not found." - exit 1 -fi - -if [ -z "$command" ]; -then +if [ -z "$command" ]; then if type scm>/dev/null 2>&1; then command=scm; implementation=scm elif type gsi>/dev/null 2>&1; then @@ -77,43 +58,73 @@ then command=guile; implementation=gui elif type slib48>/dev/null 2>&1; then command=slib48; implementation=s48 + elif type scmlit>/dev/null 2>&1; then + command=scmlit; implementation=scm + elif type elk>/dev/null 2>&1; then + command=elk; implementation=elk else echo No Scheme implementation found. exit 1 fi +# Gambit 4.0 doesn't allow input redirection; foils --version test. +elif [ "$command" == "gsi" ]; then implementation=gam +elif type $command>/dev/null 2>&1; then + SPEW="`$command --version < /dev/null 2>&1`" + if echo ${SPEW} | grep 'Initialize load-path (colon-list of directories)'\ + >/dev/null 2>&1; then implementation=elk + elif echo ${SPEW} | grep 'MIT' >/dev/null 2>&1; then implementation=mit + elif echo ${SPEW} | grep 'UMB Scheme'>/dev/null 2>&1; then implementation=umb + elif echo ${SPEW} | grep 'scheme48' >/dev/null 2>&1; then implementation=s48 + elif echo ${SPEW} | grep 'MzScheme' >/dev/null 2>&1; then implementation=plt + elif echo ${SPEW} | grep 'Guile' >/dev/null 2>&1; then implementation=gui + elif echo ${SPEW} | grep 'SCM' >/dev/null 2>&1; then implementation=scm + else implementation= + fi +else + echo "Program '$command' not found." + exit 1 fi case $implementation in scm);; s48);; *) if [ -z "${SCHEME_LIBRARY_PATH}" ]; then - export SCHEME_LIBRARY_PATH=`rpm -ql slib 2>/dev/null \ - | grep require.scm | sed 's%require.scm%%'` + if type rpm>/dev/null 2>&1; then + SCHEME_LIBRARY_PATH=`rpm -ql slib 2>/dev/null \ + | grep require.scm | sed 's%require.scm%%'` + fi fi if [ -z "${SCHEME_LIBRARY_PATH}" ]; then if [ -d /usr/local/lib/slib/ ]; then - export SCHEME_LIBRARY_PATH=/usr/local/lib/slib/ + SCHEME_LIBRARY_PATH=/usr/local/lib/slib/ elif [ -d /usr/share/slib/ ]; then - export SCHEME_LIBRARY_PATH=/usr/share/slib/ + SCHEME_LIBRARY_PATH=/usr/share/slib/ fi + export SCHEME_LIBRARY_PATH fi;; esac # for gambit case $implementation in gam) if [ -z "${LD_LIBRARY_PATH}" ]; then - export LD_LIBRARY_PATH=/usr/local/lib + LD_LIBRARY_PATH=/usr/local/lib + export LD_LIBRARY_PATH fi;; esac case $implementation in - scm) exec $command -ip1 -l ${SCHEME_LIBRARY_PATH}scm.init $*;; - elk) exec $command -i -l ${SCHEME_LIBRARY_PATH}elk.init;; - gam) exec $command -:s ${SCHEME_LIBRARY_PATH}gambit.init - $*;; - plt) exec $command -f ${SCHEME_LIBRARY_PATH}DrScheme.init $*;; - gui) exec $command -l ${SCHEME_LIBRARY_PATH}guile.init $*;; - mit) exec $command -load ${SCHEME_LIBRARY_PATH}mitscheme.init $*;; - s48) exec $command $*;; + scm) exec $command -ip1 -l ${SCHEME_LIBRARY_PATH}scm.init "$@";; + elk) exec $command -i -l ${SCHEME_LIBRARY_PATH}elk.init "$@";; + gam) exec $command -:s ${SCHEME_LIBRARY_PATH}gambit.init - "$@";; + plt) exec $command -f ${SCHEME_LIBRARY_PATH}DrScheme.init "$@";; + gui) exec $command -l ${SCHEME_LIBRARY_PATH}guile.init "$@";; + mit) exec $command -load ${SCHEME_LIBRARY_PATH}mitscheme.init "$@";; + s48) if [ -f "${S48_VICINITY}slib.image" ]; then + exec scheme48 -h 4000000 -i ${S48_VICINITY}slib.image + else + echo "scheme48 found; in slib directory do: 'make slib48 && make install48'"; + fi + exit 1;; umb) echo "umb-scheme vicinities are too wedged to run slib"; exit 1;; *) exit 1;; esac @@ -1,11 +1,11 @@ %define name slib -%define version 3a1 +%define version 3a2 %define release 1 Name: %{name} Release: %{release} Version: %{version} -Packager: Radey Shouman <shouman@ne.mediaone.net> +Packager: Aubrey Jaffer <agj@alum.mit.edu> Copyright: distributable, see individual files for copyright Vendor: Aubrey Jaffer <agj @ alum.mit.edu> @@ -14,10 +14,10 @@ Provides: slib BuildArch: noarch Summary: platform independent library for scheme -Source: ftp://swissnet.ai.mit.edu/pub/scm/slib%{version}.zip -URL: http://swissnet.ai.mit.edu/~jaffer/SLIB.html +Source: ftp://swiss.csail.mit.edu/pub/scm/slib%{version}.zip +URL: http://swiss.csail.mit.edu/~jaffer/SLIB.html BuildRoot: %{_tmppath}/%{name}%{version} -Prefix: /usr/share +Prefix: /usr %description "SLIB" is a portable library for the programming language Scheme. @@ -32,19 +32,27 @@ implementation, user, or directory. %prep %setup -n slib -c -T cd .. -unzip $RPM_SOURCE_DIR/slib%{version}.zip +unzip ${RPM_SOURCE_DIR}/slib%{version}.zip %build gzip -f slib.info %install -mkdir -p ${RPM_BUILD_ROOT}%{prefix}/slib -cp -r . ${RPM_BUILD_ROOT}%{prefix}/slib +mkdir -p ${RPM_BUILD_ROOT}%{prefix}/lib/slib +mkdir -p ${RPM_BUILD_ROOT}%{prefix}/bin +cp -r *.scm *.init *.xyz saturate.txt resenecolours.txt grapheps.ps Makefile ${RPM_BUILD_ROOT}%{prefix}/lib/slib mkdir -p ${RPM_BUILD_ROOT}/usr/info cp slib.info.gz ${RPM_BUILD_ROOT}/usr/info +echo '#! /bin/sh' > ${RPM_BUILD_ROOT}%{prefix}/bin/slib +echo SCHEME_LIBRARY_PATH=%{prefix}/lib/slib/ >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib +echo export SCHEME_LIBRARY_PATH >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib +echo VERSION=%{version} >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib +echo "S48_VICINITY=\"%{prefix}/lib/scheme48\";export S48_VICINITY" >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib +cat slib.sh >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib +chmod +x ${RPM_BUILD_ROOT}%{prefix}/bin/slib %clean -rm -rf $RPM_BUILD_ROOT +rm -rf ${RPM_BUILD_ROOT} %post /sbin/install-info /usr/info/slib.info.gz /usr/info/dir @@ -52,36 +60,40 @@ rm -rf $RPM_BUILD_ROOT # This symlink is made as in the spec file of Robert J. Meier. if [ -L /usr/share/guile/slib ]; then rm /usr/share/guile/slib - ln -s %{prefix}/slib /usr/share/guile/slib + ln -s %{prefix}/lib/slib /usr/share/guile/slib fi # Rebuild catalogs for as many implementations as possible. export PATH=$PATH:/usr/local/bin echo PATH=${PATH} -cd %{prefix}/slib/ +cd %{prefix}/lib/slib/ make catalogs -# Make color-name databases. -make clrnamdb %preun -cd %{prefix}/slib/ -rm -f clrnamdb.scm srcdir.mk slib.image +cd %{prefix}/lib/slib/ +rm -f srcdir.mk slib.image %files %defattr(-, root, root) -%dir %{prefix}/slib -%{prefix}/slib/*.scm -%{prefix}/slib/*.init -%{prefix}/slib/cie1931.xyz -%{prefix}/slib/cie1964.xyz -%{prefix}/slib/saturate.txt -%{prefix}/slib/resenecolours.txt +%{prefix}/bin/slib +%dir %{prefix}/lib/slib +%{prefix}/lib/slib/*.scm +%{prefix}/lib/slib/*.init +%{prefix}/lib/slib/cie1931.xyz +%{prefix}/lib/slib/cie1964.xyz +%{prefix}/lib/slib/saturate.txt +%{prefix}/lib/slib/resenecolours.txt +%{prefix}/lib/slib/grapheps.ps /usr/info/slib.info.gz # The Makefile is included as it is useful for building documentation. -%{prefix}/slib/Makefile +%{prefix}/lib/slib/Makefile %doc ANNOUNCE README COPYING FAQ ChangeLog %changelog +* Sat Jun 18 2004 Aubrey Jaffer <agj@alum.mit.edu> +- Fixed for RPMbuild version 4.3.1 +- Make slib executable. + * Wed Mar 14 2001 Radey Shouman <shouman@ne.mediaone.net> - Adapted from the spec file of R. J. Meier. @@ -76,15 +76,14 @@ you! SLIB @value{SLIBVERSION}, released @value{SLIBDATE}.@* Aubrey Jaffer <agj @@ alum.mit.edu>@* @ifset html -<A HREF="http://swissnet.ai.mit.edu/~jaffer/SLIB.html"> +<A HREF="http://swiss.csail.mit.edu/~jaffer/SLIB.html"> @end ifset -@url{http://swissnet.ai.mit.edu/~jaffer/SLIB.html} +@url{http://swiss.csail.mit.edu/~jaffer/SLIB.html} @ifset html </A> @end ifset @end quotation -@ifclear html @vskip 0pt plus 1filll Copyright @copyright{} 1993 Todd R. Eigenschink@* Copyright @copyright{} 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000 Aubrey Jaffer @@ -102,10 +101,9 @@ Permission is granted to copy and distribute translations of this manual into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the author. -@end ifclear @end titlepage -@ifinfo +@ifnottex @noindent @dfn{SLIB} is a portable library for the programming language @dfn{Scheme}. It provides a platform independent framework for using @@ -113,7 +111,7 @@ by the author. contains useful packages for all Scheme implementations. Its catalog can be transparently extended to accomodate packages specific to a site, implementation, user, or directory. -@end ifinfo +@end ifnottex @menu * The Library System:: How to use and customize. @@ -179,8 +177,14 @@ procedures or syntax (macros). Returns @code{#t} if @var{feature} is present in the current Scheme session; otherwise @code{#f}. More specifically, @code{provided?} returns @code{#t} if the symbol @var{feature} is the -@code{software-type} or if @var{feature} has been provided by a module -already loaded; and @code{#f} otherwise. +@code{software-type}, the @code{scheme-implementation-type} +@footnote{scheme-implementation-type is the name symbol of the running +Scheme implementation (RScheme, |STk|, Bigloo, chez, Elk, gambit, +guile, JScheme, MacScheme, MITScheme, Pocket-Scheme, Scheme48, +Scheme->C, Scheme48, Scsh, T, umb-scheme, or Vscm). Dependence on +scheme-implementation-type is almost always the wrong way to do +things.}, or if @var{feature} has been provided by a module already +loaded; and @code{#f} otherwise. In some implementations @code{provided?} tests whether a module has been @code{require}d by any module or in any thread; other @@ -302,16 +306,6 @@ large precision exact integers. @end example @noindent -The @code{commutative-ring} module uses @code{require-if} to ensure -that it has an exponentiation routine, regardless of whether the -implementation supports inexact numbers: - -@example -(require-if '(not inexact) 'logical) ;for integer-expt -(define number^ (if (provided? 'inexact) expt integer-expt)) -@end example - -@noindent The catalog can also be queried using @code{slib:in-catalog?}. @defun slib:in-catalog? feature @@ -346,7 +340,7 @@ Loads file @i{<path>}. @code{slib:load-compiled}s the files @i{<path>} @dots{}. @item (@var{feature} aggregate @i{<symbol>} @dots{}) @cindex aggregate -@code{slib:require}s the features @i{<symbol>} @dots{}. +@code{require}s the features @i{<symbol>} @dots{}. @end table @noindent @@ -603,7 +597,7 @@ immediately preceding the definition (@code{define}, @example ;@@ -(define (make-vicinity <pathname>) <pathname>) +(define (identity <obj>) <obj>) @end example @item @@ -709,11 +703,14 @@ 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. +on the file name. + +All of these procedures are file-system dependent. Use of these +vicinity procedures can make programs file-system @emph{in}dependent. @noindent These procedures are provided by all implementations. +On most systems a vicinity is a string. @defun make-vicinity dirpath Returns @var{dirpath} as a vicinity for use as first argument to @@ -731,11 +728,11 @@ Returns the vicinity containing @var{path}. @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}. +compiled system (with multiple files) this would be the directory +where the object or executable files are. If no file is currently +loading, then the result is undefined. @strong{Warning:} +@code{program-vicinity} can return incorrect values if your program +escapes back into a @code{load} continuation. @end defun @defun library-vicinity @@ -793,6 +790,14 @@ return a pathname of the subdirectory @var{name} of @var{vicinity}. @end defun +@defun with-load-pathname path thunk +@var{path} should be a string naming a file being read or loaded. +@code{with-load-pathname} evaluates @var{thunk} in a dynamic scope +where an internal variable is bound to @var{path}; the internal +variable is used for messages and @code{program-vicinity}. +@code{with-load-pathname} returns the value returned by @var{thunk}. +@end defun + @node Configuration, Input/Output, Vicinity, Universal SLIB Procedures @@ -1084,6 +1089,19 @@ Example: @end lisp @end defun +@defun expt n k +Returns @var{n} raised to the non-negative integer exponent @var{k}. + +Example: +@lisp +(expt 2 5) + @result{} 32 +(expt -3 3) + @result{} -27 +@end lisp +@end defun + + @subsection Mutual Exclusion @noindent @@ -1164,6 +1182,7 @@ Returns the last pair in the list @var{l}. Example: Syntax extensions (macros) included with SLIB. +* Define-Structure:: 'structure * Fluid-Let:: 'fluid-let * Yasos:: 'yasos, 'oop, 'collect @end menu @@ -1991,7 +2010,7 @@ Bawden. -@node Syntax-Case Macros, Fluid-Let, Syntactic Closures, Scheme Syntax Extension Packages +@node Syntax-Case Macros, Define-Structure, Syntactic Closures, Scheme Syntax Extension Packages @section Syntax-Case Macros @code{(require 'syntax-case)} @@ -2111,18 +2130,73 @@ 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). -@subsection Note from SLIB maintainer + + +@node Define-Structure, Fluid-Let, Syntax-Case Macros, Scheme Syntax Extension Packages +@section Define-Structure @code{(require 'structure)} -@findex define-structure +@noindent Included with the @code{syntax-case} files was @file{structure.scm} -which defines a macro @code{define-structure}. I have no -documentation for this macro; it is not used by any other code in -SLIB. +which defines a macro @code{define-structure}. Here is its +documentation from Gambit 4.0: + +@deffn {special form} define-structure @var{name} @var{field}@dots{} +Record data types similar to Pascal records and C @code{struct} +types can be defined using the @code{define-structure} special form. +The identifier @var{name} specifies the name of the new data type. The +structure name is followed by @var{k} identifiers naming each field of +the record. The @code{define-structure} expands into a set of definitions +of the following procedures: + +@itemize @bullet{} + +@item +`@t{make-}@var{name}' -- A @var{k} argument procedure which constructs +a new record from the value of its @var{k} fields. + +@item +`@var{name}@t{?}' -- A procedure which tests if its single argument +is of the given record type. + +@item +`@var{name}@t{-}@var{field}' -- For each field, a procedure taking +as its single argument a value of the given record type and returning +the content of the corresponding field of the record. + +@item +`@var{name}@t{-}@var{field}@t{-set!}' -- For each field, a two +argument procedure taking as its first argument a value of the given +record type. The second argument gets assigned to the corresponding +field of the record and the void object is returned. + +@end itemize + +Gambit record data types have a printed representation that includes +the name of the type and the name and value of each field. + +For example: + +@smallexample +> @b{(define-structure point x y color)} +> @b{(define p (make-point 3 5 'red))} +> @b{p} +#<point #3 x: 3 y: 5 color: red> +> @b{(point-x p)} +3 +> @b{(point-color p)} +red +> @b{(point-color-set! p 'black)} +> @b{p} +#<point #3 x: 3 y: 5 color: black> +@end smallexample + +@end deffn -@node Fluid-Let, Yasos, Syntax-Case Macros, Scheme Syntax Extension Packages + +@node Fluid-Let, Yasos, Define-Structure, Scheme Syntax Extension Packages @section Fluid-Let @code{(require 'fluid-let)} @@ -2538,7 +2612,7 @@ call graph of grammar rules effectively instantiate the sytnax tree. @noindent The JACAL symbolic math system -(@url{http://swissnet.ai.mit.edu/~jaffer/JACAL.html}) uses +(@url{http://swiss.csail.mit.edu/~jaffer/JACAL.html}) uses @t{precedence-parse}. Its grammar definitions in the file @file{jacal/English.scm} can serve as examples of use. @@ -3034,18 +3108,20 @@ The ruleset in effect before @var{tk} was parsed is restored; @node Format, Standard Formatted I/O, Precedence Parsing, Textual Conversion Packages -@section Format (version 3.0) +@section Format (version 3.1) @ifset html <A NAME="format"></A> @end ifset -@c @code{(require 'format)} +@code{(require 'format)} @ftindex format -@c @include fmtdoc.txi -The @file{format.scm} package was removed because it was not -reentrant. @url{http://swissnet.ai.mit.edu/~jaffer/SLIB.FAQ} explains -more about FORMAT's woes. +@c The @file{format.scm} package was removed because it was not +@c reentrant. @url{http://swiss.csail.mit.edu/~jaffer/SLIB.FAQ} explains +@c more about FORMAT's woes. + +@include format.texi + @node Standard Formatted I/O, Programs and Arguments, Format, Textual Conversion Packages @@ -3267,9 +3343,9 @@ stripped off. @samp{%g} prints @samp{e} between mantissa and exponont. @samp{%G} prints @samp{E} between mantissa and exponent. @item @samp{k}, @samp{K} -Print a number like @samp{%g}, except that an SI prefix is output after -the number, which is scaled accordingly. @samp{%K} outputs a space -between number and prefix, @samp{%k} does not. +Print a number like @samp{%g}, except that an SI prefix is output +after the number, which is scaled accordingly. @samp{%K} outputs a +dot between number and prefix, @samp{%k} does not. @end table @@ -4275,6 +4351,7 @@ thus can reduce loading time. The following will write into * Time Zone:: * Posix Time:: 'posix-time * Common-Lisp Time:: 'common-lisp-time +* Time Infrastructure:: @end menu @noindent @@ -4303,6 +4380,7 @@ Returns the calendar time of @var{caltime} offset by @var{offset} number of seconds @code{(+ caltime offset)}. @end defun + @node Time Zone, Posix Time, Time and Date, Time and Date @subsection Time Zone @@ -4525,7 +4603,7 @@ Equivalent to @code{(asctime (gmtime @var{caltime}))}, @end defun -@node Common-Lisp Time, , Posix Time, Time and Date +@node Common-Lisp Time, Time Infrastructure, Posix Time, Time and Date @subsection Common-Lisp Time @defun get-decoded-time @@ -4576,6 +4654,21 @@ Notice that the values returned by @code{decode-universal-time} do not match the arguments to @code{encode-universal-time}. @end defun +@node Time Infrastructure, , Common-Lisp Time, Time and Date +@subsection Time Infrastructure + +@code{(require 'time-core)} + +@defun time:gmtime tm +@defunx time:invert decoder target +@defunx time:split t tm_isdst tm_gmtoff tm_zone +@end defun + +@code{(require 'tzfile)} + +@defun tzfile:read path +@end defun + @node NCBI-DNA, Schmooz, Time and Date, Textual Conversion Packages @section NCBI-DNA @@ -4619,15 +4712,16 @@ match the arguments to @code{encode-universal-time}. @noindent 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. These functions behave as though operating on integers -in two's-complement representation. +@code{(require 'logical)} before the code that uses these functions. +These functions behave as though operating on integers in +two's-complement representation. @subsection Bitwise Operations -@defun logand n1 n1 -Returns the integer which is the bit-wise AND of the two integer +@defun logand n1 @dots{} +@defunx bitwise-and n1 @dots{} +Returns the integer which is the bit-wise AND of the integer arguments. Example: @@ -4637,9 +4731,9 @@ Example: @end lisp @end defun -@defun logior n1 n2 -Returns the integer which is the bit-wise OR of the two integer -arguments. +@defun logior n1 @dots{} +@defunx bitwise-ior n1 @dots{} +Returns the integer which is the bit-wise OR of the integer arguments. Example: @lisp @@ -4648,8 +4742,9 @@ Example: @end lisp @end defun -@defun logxor n1 n2 -Returns the integer which is the bit-wise XOR of the two integer +@defun logxor n1 @dots{} +@defunx bitwise-xor n1 @dots{} +Returns the integer which is the bit-wise XOR of the integer arguments. Example: @@ -4660,7 +4755,9 @@ Example: @end defun @defun lognot n -Returns the integer which is the 2s-complement of the integer argument. +@defunx bitwise-not n +Returns the integer which is the one's-complement of the integer +argument. Example: @lisp @@ -4672,6 +4769,7 @@ Example: @end defun @defun bitwise-if mask n0 n1 +@defunx bitwise-merge mask n0 n1 Returns an integer composed of some bits from integer @var{n0} and some from integer @var{n1}. A bit of the result is taken from @var{n0} if the corresponding bit of integer @var{mask} is 1 and from @var{n1} if that bit @@ -4679,6 +4777,7 @@ of @var{mask} is 0. @end defun @defun logtest j k +@defunx any-bits-set? j k @example (logtest j k) @equiv{} (not (zero? (logand j k))) @@ -4687,7 +4786,11 @@ of @var{mask} is 0. @end example @end defun + +@subsection Integer Properties + @defun logcount n +@defunx bit-count 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, @@ -4704,12 +4807,62 @@ Example: @end lisp @end defun +@defun integer-length n +Returns the number of bits neccessary to represent @var{n}. + +Example: +@lisp +(integer-length #b10101010) + @result{} 8 +(integer-length 0) + @result{} 0 +(integer-length #b1111) + @result{} 4 +@end lisp +@end defun + +@defun log2-binary-factors n +@defunx first-set-bit n +Returns the number of factors of two of integer @var{n}. This value +is also the bit-index of the least-significant @samp{1} bit in +@var{n}. + +@lisp +(require 'printf) +(do ((idx 0 (+ 1 idx))) + ((> idx 16)) + (printf "%s(%3d) ==> %-5d %s(%2d) ==> %-5d\n" + 'log2-binary-factors + (- idx) (log2-binary-factors (- idx)) + 'log2-binary-factors + idx (log2-binary-factors idx))) +@print{} +log2-binary-factors( 0) ==> -1 log2-binary-factors( 0) ==> -1 +log2-binary-factors( -1) ==> 0 log2-binary-factors( 1) ==> 0 +log2-binary-factors( -2) ==> 1 log2-binary-factors( 2) ==> 1 +log2-binary-factors( -3) ==> 0 log2-binary-factors( 3) ==> 0 +log2-binary-factors( -4) ==> 2 log2-binary-factors( 4) ==> 2 +log2-binary-factors( -5) ==> 0 log2-binary-factors( 5) ==> 0 +log2-binary-factors( -6) ==> 1 log2-binary-factors( 6) ==> 1 +log2-binary-factors( -7) ==> 0 log2-binary-factors( 7) ==> 0 +log2-binary-factors( -8) ==> 3 log2-binary-factors( 8) ==> 3 +log2-binary-factors( -9) ==> 0 log2-binary-factors( 9) ==> 0 +log2-binary-factors(-10) ==> 1 log2-binary-factors(10) ==> 1 +log2-binary-factors(-11) ==> 0 log2-binary-factors(11) ==> 0 +log2-binary-factors(-12) ==> 2 log2-binary-factors(12) ==> 2 +log2-binary-factors(-13) ==> 0 log2-binary-factors(13) ==> 0 +log2-binary-factors(-14) ==> 1 log2-binary-factors(14) ==> 1 +log2-binary-factors(-15) ==> 0 log2-binary-factors(15) ==> 0 +log2-binary-factors(-16) ==> 4 log2-binary-factors(16) ==> 4 +@end lisp +@end defun @subsection Bit Within Word -@defun logbit? index j +@defun logbit? index n +@defunx bit-set? index n @example -(logbit? index j) @equiv{} (logtest (integer-expt 2 index) j) +(logbit? index n) @equiv{} (logtest (expt 2 index) n) (logbit? 0 #b1101) @result{} #t (logbit? 1 #b1101) @result{} #f @@ -4731,11 +4884,8 @@ Example: @end example @end defun -@subsection Fields of Bits -@defun logical:ones n -Returns the smallest non-negative integer having @var{n} binary ones. -@end defun +@subsection Field of Bits @defun bit-field n start end Returns the integer composed of the @var{start} (inclusive) through @@ -4751,7 +4901,7 @@ Example: @end lisp @end defun -@defun copy-bit-field to start end from +@defun copy-bit-field to from start end Returns an integer the same as @var{to} except possibly in the @var{start} (inclusive) through @var{end} (exclusive) bits, which are the same as those of @var{from}. The 0-th bit of @var{from} becomes the @@ -4759,14 +4909,17 @@ the same as those of @var{from}. The 0-th bit of @var{from} becomes the Example: @example -(number->string (copy-bit-field #b1101101010 0 4 0) 2) +(number->string (copy-bit-field #b1101101010 0 0 4) 2) @result{} "1101100000" -(number->string (copy-bit-field #b1101101010 0 4 -1) 2) +(number->string (copy-bit-field #b1101101010 -1 0 4) 2) @result{} "1101101111" +(number->string (copy-bit-field #b110100100010000 -1 5 9) 2) + @result{} "110100111110000" @end example @end defun @defun ash n count +@defunx arithmetic-shift n count Returns an integer equivalent to @code{(inexact->exact (floor (* @var{n} (expt 2 @var{count}))))}. @@ -4779,58 +4932,37 @@ Example: @end lisp @end defun -@defun integer-length n -Returns the number of bits neccessary to represent @var{n}. -Example: -@lisp -(integer-length #b10101010) - @result{} 8 -(integer-length 0) - @result{} 0 -(integer-length #b1111) - @result{} 4 -@end lisp -@end defun - -@defun integer-expt n k -Returns @var{n} raised to the non-negative integer exponent @var{k}. +@defun rotate-bit-field n count start end +Returns @var{n} with the bit-field from @var{start} to @var{end} +cyclically permuted by @var{count} bits towards high-order. Example: @lisp -(integer-expt 2 5) - @result{} 32 -(integer-expt -3 3) - @result{} -27 +(number->string (rotate-bit-field #b0100 3 0 4) 2) + @result{} "10" +(number->string (rotate-bit-field #b0100 -1 0 4) 2) + @result{} "10" +(number->string (rotate-bit-field #b110100100010000 -1 5 9) 2) + @result{} "110100010010000" +(number->string (rotate-bit-field #b110100100010000 1 5 9) 2) + @result{} "110100000110000" @end lisp @end defun -@subsection Bit order and Lamination - -@defun logical:rotate k count len -Returns the low-order @var{len} bits of @var{k} cyclically permuted -@var{count} bits towards high-order. - -Example: -@lisp -(number->string (logical:rotate #b0100 3 4) 2) -@result{} "10" -(number->string (logical:rotate #b0100 -1 4) 2) -@result{} "10" -@end lisp -@end defun - -@defun bit-reverse k n -Returns the low-order @var{k} bits of @var{n} with the bit order -reversed. The low-order bit of @var{n} is the high order bit of the -returned value. +@defun reverse-bit-field n start end +Returns @var{n} with the order of bits @var{start} to @var{end} +reversed. @example -(number->string (bit-reverse 8 #xa7) 16) +(number->string (reverse-bit-field #xa7 0 8) 16) @result{} "e5" @end example @end defun + +@subsection Bits as Booleans + @defun integer->list k len @defunx integer->list k @code{integer->list} returns a list of @var{len} booleans corresponding @@ -4850,67 +4982,6 @@ each #t; a 0 bit for #f. Returns the integer coded by the @var{bool1} @dots{} arguments. @end defun -@defun bitwise:laminate k1 @dots{} -Returns an integer composed of the bits of @var{k1} @dots{} interlaced -in argument order. Given @var{k1}, @dots{} @var{kn}, the n low-order -bits of the returned value will be the lowest-order bit of each -argument. - -@defunx bitwise:delaminate count k -Returns a list of @var{count} integers comprised of every @var{count}h -bit of the integer @var{k}. - -For any non-negative integers @var{k} and @var{count}: -@example -(eqv? k (bitwise:laminate (bitwise:delaminate count k))) -@end example -@end defun - - -@subsection Gray code - -@cindex Gray code -@noindent -A @dfn{Gray code} is an ordering of non-negative integers in which -exactly one bit differs between each pair of successive elements. There -are multiple Gray codings. An n-bit Gray code corresponds to a -Hamiltonian cycle on an n-dimensional hypercube. - -@noindent -Gray codes find use communicating incrementally changing values between -asynchronous agents. De-laminated Gray codes comprise the coordinates -of Peano-Hilbert space-filling curves. - - -@defun integer->gray-code k -Converts @var{k} to a Gray code of the same @code{integer-length} as -@var{k}. - -@defunx gray-code->integer k -Converts the Gray code @var{k} to an integer of the same -@code{integer-length} as @var{k}. - -For any non-negative integer @var{k}, -@example -(eqv? k (gray-code->integer (integer->gray-code k))) -@end example -@end defun - -@defun = k1 k2 -@defunx gray-code<? k1 k2 -@defunx gray-code>? k1 k2 -@defunx gray-code<=? k1 k2 -@defunx gray-code>=? k1 k2 -These procedures return #t if their Gray code arguments are -(respectively): equal, monotonically increasing, monotonically -decreasing, monotonically nondecreasing, or monotonically nonincreasing. - -For any non-negative integers @var{k1} and @var{k2}, the Gray code -predicate of @code{(integer->gray-code k1)} and -@code{(integer->gray-code k2)} will return the same value as the -corresponding predicate of @var{k1} and @var{k2}. -@end defun - @@ -4939,7 +5010,7 @@ A pseudo-random number generator is only as good as the tests it passes. George Marsaglia of Florida State University developed a battery of tests named @dfn{DIEHARD} (@url{http://stat.fsu.edu/~geo/diehard.html}). @file{diehard.c} has a bug which the patch -@url{http://swissnet.ai.mit.edu/ftpdir/users/jaffer/diehard.c.pat} corrects. +@url{http://swiss.csail.mit.edu/ftpdir/users/jaffer/diehard.c.pat} corrects. SLIB's PRNG generates 8 bits at a time. With the degenerate seed @samp{0}, the numbers generated pass DIEHARD; but when bits are @@ -5004,6 +5075,27 @@ or non-inverted) to the data stream. @end itemize @noindent +The performance of a particular CRC polynomial over packets of given +sizes varies widely. In terms of the probability of undetected +errors, some uses of extant CRC polynomials are suboptimal by several +orders of magnitude. + +@noindent +If you are considering CRC for a new application, consult the +following article to find the optimum CRC polynomial for your range of +data lengths: + +@itemize @bullet +@item +Philip Koopman and Tridib Chakravarty,@* +``Cyclic Redundancy Code (CRC) Polynomial Selection For Embedded Networks'',@* +The International Conference on Dependable Systems and Networks, DSN-2004.@* +@end itemize + +@exdent +@url{http://www.ece.cmu.edu/~koopman/roses/dsn04/koopman04_crc_poly_embedded.pdf} + +@noindent There is even some controversy over the polynomials themselves. @defvr Constant crc-32-polynomial @@ -5062,7 +5154,8 @@ CRC-12: x^12+x^11+x^3+x^2+x+1. These differ in bit 1 and calculations using them return different values. With citations near evenly split, it is hard to know which is -correct. +correct. Thanks to Philip Koopman for breaking the tie in favor of +the latter (#xC07). @end defvr @defvr Constant crc-10-polynomial @@ -5345,7 +5438,7 @@ vector or list @var{data} <A NAME="Color"></A> @end ifset -@uref{http://swissnet.ai.mit.edu/~jaffer/Color} +@uref{http://swiss.csail.mit.edu/~jaffer/Color} @noindent The goals of this package are to provide methods to specify, compute, @@ -5398,6 +5491,20 @@ L*C*h @defun make-color space arg @dots{} Returns a color of type @var{space}. + +@itemize @bullet +@item +For @var{space} arguments @code{CIEXYZ}, @code{RGB709}, and +@code{sRGB}, the sole @var{arg} is a list of three numbers. +@item +For @var{space} arguments @code{L*a*b*}, @code{L*u*v*}, and +@code{L*C*h}, @var{arg} is a list of three numbers optionally followed +by a whitepoint. +@item +For @code{xRGB}, @var{arg} is an integer. +@item +For @code{e-sRGB}, the arguments are as for @code{e-sRGB->color}. +@end itemize @end defun @defun color-space color @@ -5589,6 +5696,57 @@ Requires Spectral Tristimulus Values, defaulting to cie1931. conversion procedures. The spectrum conversion procedures @code{(require 'ciexyz)} to assure that a set is loaded. +@defun read-cie-illuminant path +@var{path} must be a string naming a file consisting of 107 numbers +for 5.nm intervals from 300.nm to 830.nm. @code{read-cie-illuminant} +reads (using Scheme @code{read}) these numbers and returns a length +107 vector filled with them. +@end defun + +@example +(define CIE:SI-D65 + (read-CIE-illuminant (in-vicinity (library-vicinity) "ciesid65.dat"))) +(spectrum->XYZ CIE:SI-D65 300e-9 830e-9) +@result{} (25.108569422374994 26.418013465625001 28.764075683374993) +@end example + + +@defun read-normalized-illuminant path +@var{path} must be a string naming a file consisting of 107 numbers +for 5.nm intervals from 300.nm to 830.nm. +@code{read-normalized-illuminant} reads (using Scheme @code{read}) +these numbers and returns a length 107 vector filled with them, +normalized so that @code{spectrum->XYZ} of the illuminant returns its +whitepoint. +@end defun + +CIE Standard Illuminants A and D65 are included with SLIB: + +@example +(define CIE:SI-A + (read-normalized-illuminant (in-vicinity (library-vicinity) "ciesia.dat"))) +(define CIE:SI-D65 + (read-normalized-illuminant (in-vicinity (library-vicinity) "ciesid65.dat"))) +(spectrum->XYZ CIE:SI-A 300e-9 830e-9) +@result{} (1.098499460820401 999.9999999999998e-3 355.8173930654951e-3) +(CIEXYZ->sRGB (spectrum->XYZ CIE:SI-A 300e-9 830e-9)) +@result{} (255 234 133) +(spectrum->XYZ CIE:SI-D65 300e-9 830e-9) +@result{} (950.4336673552745e-3 1.0000000000000002 1.0888053986649182) +(CIEXYZ->sRGB (spectrum->XYZ CIE:SI-D65 300e-9 830e-9)) +@result{} (255 255 255) +@end example + +@defun illuminant-map proc siv +@var{siv} must be a one-dimensional array or vector of 107 numbers. +@code{illuminant-map} returns a vector of length 107 containing the +result of applying @var{proc} to each element of @var{siv}. +@end defun + +@defun illuminant-map->XYZ proc siv +@code{(spectrum->XYZ (illuminant-map @var{proc} @var{siv}) 300e-9 830e-9)} +@end defun + @defun spectrum->XYZ proc @var{proc} must be a function of one argument. @code{spectrum->XYZ} computes the CIEXYZ(1931) values for the spectrum returned by @var{proc} @@ -5616,11 +5774,6 @@ Compute the colors of 6500.K and 5000.K blackbody radiation: (map (lambda (x) (/ x y_n)) xyz) @result{} (0.2933441826889158 0.2988931825387761 0.25783646831201573) @end example - -@defunx spectrum->CIEXYZ proc -@defunx spectrum->CIEXYZ spectrum x1 x2 -@code{spectrum->CIEXYZ} computes the CIEXYZ(1931) values for the -spectrum, scaled so their sum is 1. @end defun @defun spectrum->chromaticity proc @@ -5629,16 +5782,15 @@ Computes the chromaticity for the given spectrum. @end defun @defun wavelength->XYZ w -@defunx wavelength->chromaticity w -@defunx wavelength->CIEXYZ w @var{w} must be a number between 380e-9 to 780e-9. @code{wavelength->XYZ} returns (unnormalized) XYZ values for a monochromatic light source with wavelength @var{w}. +@end defun + +@defun wavelength->chromaticity w +@var{w} must be a number between 380e-9 to 780e-9. @code{wavelength->chromaticity} returns the chromaticity for a monochromatic light source with wavelength @var{w}. -@code{wavelength->CIEXYZ} returns XYZ values for the saturated color -having chromaticity of a monochromatic light source with wavelength -@var{w}. @end defun @defun blackbody-spectrum temp @@ -5654,8 +5806,8 @@ procedure correspond to the power of the photons with wavelengths @defun temperature->XYZ x The positive number @var{x} is a temperature in degrees kelvin. -@code{temperature->XYZ} computes the CIEXYZ(1931) values for the -spectrum of a black body at temperature @var{x}. +@code{temperature->XYZ} computes the unnormalized CIEXYZ(1931) values +for the spectrum of a black body at temperature @var{x}. Compute the chromaticities of 6500.K and 5000.K blackbody radiation: @@ -5669,26 +5821,21 @@ Compute the chromaticities of 6500.K and 5000.K blackbody radiation: @end example @end defun -@defun temperature->CIEXYZ x +@defun temperature->chromaticity x The positive number @var{x} is a temperature in degrees kelvin. -@code{temperature->CIEXYZ} computes the CIEXYZ(1931) values for the -spectrum of a black body at temperature @var{x}, scaled to be just -inside the RGB709 gamut. -@end defun +@code{temperature->cromaticity} computes the chromaticity for the +spectrum of a black body at temperature @var{x}. -@defun temperature->chromaticity x -@end defun +Compute the chromaticities of 6500.K and 5000.K blackbody radiation: -@defun XYZ:normalize xyz -@var{xyz} is a list of three non-negative real numbers. -@code{XYZ:normalize} returns a list of numbers proportional to -@var{xyz}; scaled so their sum is 1. -@end defun +@example +(require 'color-space) +(temperature->chromaticity 6500) + @result{} (0.3135191660557008 0.3236456786200268) -@defun XYZ:normalize-colors colors @dots{} -@var{colors} is a list of XYZ triples. @code{XYZ:normalize-colors} -scales all the triples by a common factor such that the maximum sum of -numbers in a scaled triple is 1. +(temperature->chromaticity 5000) + @result{} (0.34508082841161052 0.3516084965163377) +@end example @end defun @defun XYZ->chromaticity xyz @@ -5958,7 +6105,7 @@ Looks for @var{name} among the 19 saturated colors from @item red purple @tab purplish red @tab red @end multitable -(@url{http://swissnet.ai.mit.edu/~jaffer/Color/saturate.pdf}). If +(@url{http://swiss.csail.mit.edu/~jaffer/Color/saturate.pdf}). If @var{name} is found, the corresponding color is returned. Otherwise #f is returned. Use saturate only for light source colors. @end defun @@ -5974,7 +6121,7 @@ operated paint manufacturing company, has generously made their @defun resene name Looks for @var{name} among the 1300 entries in the Resene color-name -dictionary (@url{http://swissnet.ai.mit.edu/~jaffer/Color/resene.pdf}). +dictionary (@url{http://swiss.csail.mit.edu/~jaffer/Color/resene.pdf}). If @var{name} is found, the corresponding color is returned. Otherwise #f is returned. The @cite{Resene RGB Values List} is an excellent source for surface colors. @@ -6043,7 +6190,7 @@ its argument) @var{df/dx}, and initial integer value @var{x0} 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: +To find the closest integer to a given integer's square root: @example (define (integer-sqrt y) @@ -6485,7 +6632,7 @@ Data Banks}). An SLIB relational database implementation can be created from any @ref{Base Table} implementation. Why relational database? For motivations and design issues see@* -@uref{http://swissnet.ai.mit.edu/~jaffer/DBManifesto.html}. +@uref{http://swiss.csail.mit.edu/~jaffer/DBManifesto.html}. @menu * Using Databases:: 'databases @@ -6788,7 +6935,7 @@ returns the key-list identifying the highest record less than @var{key1} @var{key2} @dots{} which is stored in the relational-table; or false if no lower record is present. -@defopx {Operation} {relational-table} isam-prev index +@defopx {Operation} {relational-table} isam-prev column-name The symbol @var{column-name} names a key field. In the list returned by @code{isam-next}, that field, or a field to its left, will be changed. This allows one to skip over less significant key fields. @@ -7329,15 +7476,20 @@ etags -lscheme -r'/ *(define-\(command\|table\) (\([^; \t]+\)/\2/' \ @end example @menu +* Within-database:: * Within-database Example:: @end menu +@node Within-database, Within-database Example, Database Macros, Database Macros +@subsubsection Within-database + @defun within-database database statement-1 @dots{} @code{within-database} creates a lexical scope in which the commands @code{define-table} and @code{define-command} create tables and @code{*commands*}-table entries respectively in open relational -database @var{database}. +database @var{database}. The expressions in `within-database' form +are executed in order. @code{within-database} Returns @var{database}. @end defun @@ -7385,8 +7537,38 @@ key field table, a foreign-key domain will be created for it. @end deffn +@defun add-macro-support database +The relational database @var{database} must be mutable. +@code{add-macro-support} adds a @code{*macros*} table and +@code{define-macro} macro to @var{database}; then @var{database} is +returned. +@end defun + +@deffn Syntax define-macro (@r{<name>} @r{arg1} @dots{}) @r{"comment"} @r{<expression1>} @r{<expression2>} @dots{} +@deffnx Syntax define-macro (@r{<name>} @r{arg1} @dots{}) @r{<expression1>} @r{<expression2>} @dots{} +Adds a macro @r{<name>} to the @code{*macros*}. + +@emph{Note:} @code{within-database} creates lexical scope where not +only @code{define-command} and @code{define-table}, but every command +and macro are defined, ie.: -@node Within-database Example, , Database Macros, Database Macros +@example +(within-database my-rdb + (define-command (message rdb) + (lambda (msg) + (display "message: ") + (display msg) + (newline))) + (message "Defining FOO...") + ;; ... defining FOO ... + (message "Defining BAR...") + ;; ... defining BAR ... + ) +@end example +@end deffn + + +@node Within-database Example, , Within-database, Database Macros @subsubsection Within-database Example @noindent @@ -9656,7 +9838,7 @@ Example: @noindent @code{last} and @code{butlast} split a list into two parts when given -identical arugments. +identical arguments. @example (last '(a b c d e) 2) @result{} (d e) @@ -9693,7 +9875,7 @@ Example: @noindent @code{nthcdr} and @code{butnthcdr} split a list into two parts when -given identical arugments. +given identical arguments. @example (nthcdr 2 '(a b c d e)) @result{} (c d e) @@ -10090,17 +10272,24 @@ items have the same @code{hashv} implies the items have the same @subsection Space-Filling Curves @menu -* Peano-Hilbert Space-Filling Curve:: +* Hilbert Space-Filling Curve:: Non-negative coordinates +* Peano Space-Filling Curve:: Integer coordinates * Sierpinski Curve:: @end menu -@node Peano-Hilbert Space-Filling Curve, Sierpinski Curve, Space-Filling Curves, Space-Filling Curves -@subsubsection Peano-Hilbert Space-Filling Curve +@node Hilbert Space-Filling Curve, Peano Space-Filling Curve, Space-Filling Curves, Space-Filling Curves +@subsubsection Hilbert Space-Filling Curve @include phil-spc.txi -@node Sierpinski Curve, , Peano-Hilbert Space-Filling Curve, Space-Filling Curves +@node Peano Space-Filling Curve, Sierpinski Curve, Hilbert Space-Filling Curve, Space-Filling Curves +@subsubsection Peano Space-Filling Curve + +@include peanosfc.txi + + +@node Sierpinski Curve, , Peano Space-Filling Curve, Space-Filling Curves @subsubsection Sierpinski Curve @code{(require 'sierpinski)} @@ -10444,7 +10633,7 @@ Kills the current process and runs the next process from @code{(require 'metric-units)} @ftindex metric-units -@url{http://swissnet.ai.mit.edu/~jaffer/MIXF.html} +@url{http://swiss.csail.mit.edu/~jaffer/MIXF} @dfn{Metric Interchange Format} is a character string encoding for numerical values and units which: @@ -10810,24 +10999,12 @@ For the specification of these optional procedures, @defun list-tail l p @end defun -@defun string->list s -@end defun - -@defun list->string l -@end defun - @defun string-copy @end defun @deffn {Procedure} string-fill! s obj @end deffn -@defun list->vector l -@end defun - -@defun vector->list s -@end defun - @deffn {Procedure} vector-fill! s obj @end deffn @@ -11062,6 +11239,8 @@ unspecified. * SRFI-9:: Defining Record Types @end menu +SRFI-47 is the same as @ref{Arrays}. + @node SRFI-1, SRFI-2, SRFI, SRFI @subsubsection SRFI-1 @@ -11102,6 +11281,14 @@ Where @node Session Support, System Interface, Standards Support, Other Packages @section Session Support +@noindent +If @code{(provided? 'abort)}: + +@defun abort +Resumes the top level Read-Eval-Print loop. If provided, @code{abort} +is used by the @code{break} and @code{debug} packages. +@end defun + @menu * Repl:: Macros at top-level * Quick Print:: Loop-safe Output @@ -11508,17 +11695,18 @@ sites are: @table @asis @item SLIB-PSD +@cindex PSD is a portable debugger for Scheme (requires emacs editor). @ifset html -<A HREF="http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz"> +<A HREF="http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz"> @end ifset -http://swissnet.ai.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz +http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz @ifset html </A> @end ifset -swissnet.ai.mit.edu:/pub/scm/slib-psd1-3.tar.gz +swiss.csail.mit.edu:/pub/scm/slib-psd1-3.tar.gz ftp.maths.tcd.ie:pub/bosullvn/jacal/slib-psd1-3.tar.gz @@ -11544,6 +11732,8 @@ http://www.cs.tut.fi/staff/pk/scheme/psd/article/article.html @sp 1 @item SCHELOG +@cindex SCHELOG +@cindex Prolog is an embedding of Prolog in Scheme.@* @ifset html <A HREF="http://www.ccs.neu.edu/~dorai/schelog/schelog.html"> @@ -11555,6 +11745,10 @@ http://www.ccs.neu.edu/~dorai/schelog/schelog.html @sp 1 @item JFILTER +@cindex JFILTER +@cindex Japanese +@cindex JIS +@cindex EUC is a Scheme program which converts text among the JIS, EUC, and Shift-JIS Japanese character sets.@* @ifset html @@ -11570,7 +11764,7 @@ http://www.sci.toyama-u.ac.jp/~iwao/Scheme/Jfilter/index.html @node About SLIB, Index, Other Packages, Top @chapter About SLIB -@ifinfo +@ifnottex @noindent More people than I can name have contributed to SLIB. Thanks to all of you! @@ -11579,12 +11773,13 @@ you! SLIB @value{SLIBVERSION}, released @value{SLIBDATE}.@* Aubrey Jaffer <agj @@ alum.mit.edu>@* @i{Hyperactive Software} -- The Maniac Inside!@* -@url{http://swissnet.ai.mit.edu/~jaffer/SLIB.html} +@url{http://swiss.csail.mit.edu/~jaffer/SLIB.html} @end quotation -@end ifinfo +@end ifnottex @menu * Installation:: How to install SLIB on your system. +* The SLIB script:: Run interactive SLIB sessions. * Porting:: SLIB to new platforms. * Coding Guidelines:: How to write modules for SLIB. * Copyrights:: Intellectual propery issues. @@ -11592,7 +11787,7 @@ Aubrey Jaffer <agj @@ alum.mit.edu>@* @end menu -@node Installation, Porting, About SLIB, About SLIB +@node Installation, The SLIB script, About SLIB, About SLIB @section Installation @ifset html @@ -11604,12 +11799,14 @@ Aubrey Jaffer <agj @@ alum.mit.edu>@* @cindex install @cindex installation -There are four parts to installation: +There are five parts to installation: @itemize @bullet @item Unpack the SLIB distribution. @item +Install documentation and @code{slib} script. +@item Configure the Scheme implementation(s) to locate the SLIB directory. @item Arrange for Scheme implementation to load its SLIB initialization file. @@ -11630,6 +11827,15 @@ this might be @file{/usr/share/slib}, @file{/usr/local/lib/slib}, or @file{/usr/lib/slib}. If you know where SLIB should go on other platforms, please inform agj @@ alum.mit.edu. +@subsection Install documentation and slib script + +@cindex slib +@cindex script +@example +make infoz +make install +@end example + @subsection Configure Scheme Implementation to Locate SLIB If the Scheme implementation supports @code{getenv}, then the value of @@ -11696,6 +11902,66 @@ support is already built into SCM. See the documentation with SCM for installation instructions. @end deftp +@deftp Implementation {PLT Scheme} +@deftpx Implementation {DrScheme} +@deftpx Implementation {MzScheme} + +The @file{init.ss} file in the _slibinit_ collection is an SLIB +initialization file. + +To use SLIB in MzScheme, set the @var{SCHEME_LIBRARY_PATH} environment +variable to the installed SLIB location; then invoke MzScheme thus: + +@code{mzscheme -f $@{SCHEME_LIBRARY_PATH@}DrScheme.init} +@end deftp + +@deftp Implementation {MIT Scheme} +@code{scheme -load $@{SCHEME_LIBRARY_PATH@}mitscheme.init} +@end deftp + +@deftp Implementation Gambit-C 3.0 + +@code{$command -:s $@{SCHEME_LIBRARY_PATH@}gambit.init -} +@end deftp + +@deftp Implementation {Guile} +Guile versions 1.6 and earlier link to an archaic SLIB version. In +RedHat or Fedora installations: + +@example +rm /usr/share/guile/slib +ln -s $@{SCHEME_LIBRARY_PATH@} /usr/share/guile/slib +@end example + +In Debian installations: + +@example +rm /usr/share/guile/1.6/slib +ln -s $@{SCHEME_LIBRARY_PATH@} /usr/share/guile/1.6/slib +@end example + +@code{$@{SCHEME_LIBRARY_PATH@}} is where SLIB gets installed. + +Guile with SLIB can then be started thus: + +@code{guile -l $@{SCHEME_LIBRARY_PATH@}guile.init} +@end deftp + +@deftp Implementation Scheme48 +To make a Scheme48 image for an installation under @code{<prefix>}, + +@enumerate +@item +@code{cd} to the SLIB directory +@item +type @code{make prefix=<prefix> slib48}. +@item +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. +@end enumerate +@end deftp + @deftp Implementation VSCM @format From: Matthias Blume <blume @@ cs.Princeton.EDU> @@ -11726,45 +11992,27 @@ e.g. mv dumpfile /usr/local/vscm/lib/scheme-boot @end deftp -@deftp Implementation Scheme48 -To make a Scheme48 image for an installation under @code{<prefix>}, - -@enumerate -@item -@code{cd} to the SLIB directory -@item -type @code{make prefix=<prefix> slib48}. -@item -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. -@end enumerate -@end deftp - -@deftp Implementation {PLT Scheme} -@deftpx Implementation {DrScheme} -@deftpx Implementation {MzScheme} -The @file{init.ss} file in the _slibinit_ collection is an SLIB -initialization file. +@node The SLIB script, Porting, Installation, About SLIB +@section The SLIB script -To use SLIB in MzScheme, set the @var{SCHEME_LIBRARY_PATH} environment -variable to the installed SLIB location; then invoke MzScheme thus: +SLIB comes with shell script for Unix platforms. -@code{mzscheme -f $@{SCHEME_LIBRARY_PATH@}DrScheme.init} -@end deftp +@example +@exdent @b{ slib } [ scm | gsi | mzscheme | guile | slib48 | scheme48 | scmlit ] +@end example -@deftp Implementation {MIT Scheme} -@code{scheme -load $@{SCHEME_LIBRARY_PATH@}mitscheme.init} -@end deftp +@noindent +Starts an interactive Scheme-with-SLIB session. -@deftp Implementation {Guile} -@code{guile -l $@{SCHEME_LIBRARY_PATH@}guile.init} -@end deftp +@noindent +The optional argument to the @code{slib} script is the Scheme +implementation to run. Absent the argument, it searches for +implementations in the above order. -@node Porting, Coding Guidelines, Installation, About SLIB +@node Porting, Coding Guidelines, The SLIB script, About SLIB @section Porting If there is no initialization file for your Scheme implementation, you @@ -11973,26 +12221,10 @@ At the beginning of each section, there is a line that looks like using the package. @end itemize - +@ifinfo @node Index, , About SLIB, Top -@c @node Procedure and Macro Index, Operator Index, About SLIB, Top -@unnumbered Procedure and Macro Index - -This is an alphabetical list of all the procedures and macros in SLIB. - -@printindex fn - -@c @node Variable Index, Concept Index, Operator 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 +@unnumbered Index +@end ifinfo -@contents +@include indexes.texi @bye @@ -1,5 +1,5 @@ ;;; "solid.scm" Solid Modeling with VRML97 -; Copyright 2001 Aubrey Jaffer +; Copyright 2001, 2004 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -36,7 +36,7 @@ ;;@ftindex solid-modeling ;; ;;@noindent -;;@uref{http://swissnet.ai.mit.edu/~jaffer/Solid/#Example} gives an +;;@uref{http://swiss.csail.mit.edu/~jaffer/Solid/#Example} gives an ;;example use of this package. (define pi/180 (/ (* 4 (atan 1)) 180)) @@ -169,7 +169,7 @@ ;;elements of @2, then the color at the zenith and nadir are taken from ;;the colors paired with the angles nearest them. ;; -;;@0 fills horizontal bands with interpolated colors on the backgroud +;;@0 fills horizontal bands with interpolated colors on the background ;;sphere encasing the world. (define (scene:sphere colors angles) (define seen0? 0) @@ -233,7 +233,7 @@ (cons (car colors) ground-colors) (cons (car angles) ground-angles)))))) -;;@body Returns a blue and brown backgroud sphere encasing the world. +;;@body Returns a blue and brown background sphere encasing the world. (define (scene:sky-and-dirt) (scene:sphere '((0.0 0.2 0.7) @@ -245,7 +245,7 @@ (0.3 0.2 0.0)) '(90 15 0 0 -15 -70 -90))) -;;@body Returns a blue and green backgroud sphere encasing the world. +;;@body Returns a blue and green background sphere encasing the world. (define (scene:sky-and-grass) (scene:sphere '((0.0 0.2 0.7) @@ -281,8 +281,9 @@ latitude (solar-hour julian-day hour))) (phi_s (cadr theta_s)) - (sun-xyz (sunlight-CIEXYZ turbidity (car theta_s))) - (sun-color (and sun-xyz (CIEXYZ->color sun-xyz)))) + (sun-chroma (sunlight-chromaticity turbidity (car theta_s))) + (sun-color (and sun-chroma + (CIEXYZ->color (apply chromaticity->CIEXYZ sun-chroma))))) (set! theta_s (car theta_s)) (set! strength (if (null? strength) 1 (car strength))) (if (not strength) (set! strength 0)) @@ -317,8 +318,9 @@ latitude (solar-hour julian-day hour))) (phi_s (cadr theta_s)) - (sun-xyz (sunlight-CIEXYZ turbidity (car theta_s))) - (sun-color (and sun-xyz (CIEXYZ->color sun-xyz))) + (sun-chroma (sunlight-chromaticity turbidity (car theta_s))) + (sun-color (and sun-chroma + (CIEXYZ->color (apply chromaticity->CIEXYZ sun-chroma)))) (color-func (overcast-sky-color-xyY turbidity (car theta_s)))) (set! theta_s (car theta_s)) (set! strength (if (null? strength) 1 (car strength))) @@ -349,12 +351,14 @@ (define (scene:viewpoint name distance compass . pitch) (set! pitch (* pi/180 (if (null? pitch) 0 (car pitch)))) (set! compass (* pi/180 compass)) - (let ((vp - (sprintf #f "Viewpoint {description \"%s\" %s %s}" - name - (sprintf #f "position 0 0 %g" distance) - (sprintf #f "orientation 1 0 0 %g" pitch)))) - (sprintf #f "Transform {rotation 0 -1 0 %g children [%s]}\\n" compass vp))) + (let ((level ;fieldOfView 0.785398 (pi/4) + (sprintf #f "Viewpoint {position 0 0 %g description %#a}" + distance name))) + (define tilt + (sprintf #f "Transform {rotation 1 0 0 %g children [%s]}\\n" + pitch level)) + (sprintf #f "Transform {rotation 0 -1 0 %g children [%s]}\\n" + compass tilt))) ;;@body Returns 6 viewpoints, one at the center of each face of a cube ;;with sides 2 * @1, centered on the origin. @@ -568,17 +572,21 @@ ;;@args radius height appearance ;;@args radius height -;;Returns a right cylinder with dimensions @1 and @code{(abs @2)} +;;Returns a right cylinder with dimensions @code{(abs @1)} and @code{(abs @2)} ;;centered on the origin. If @2 is positive, then the cylinder ends -;;will be capped. @3 determines the surface properties of the returned +;;will be capped. If @1 is negative, then only the ends will appear. +;;@3 determines the surface properties of the returned ;;object. (define (solid:cylinder radius height . appearance) (solid:node "Shape" (if (null? appearance) "" (string-append (car appearance) " ")) "geometry " (solid:node "Cylinder" - (sprintf #f "height %g radius %g%s" - (abs height) radius + (sprintf #f "height %g radius %g%s%s" + (abs height) (abs radius) + (if (negative? radius) + " side FALSE" + "") (if (negative? height) " bottom FALSE top FALSE" ""))))) @@ -647,6 +655,44 @@ (apply solid:sphere .5 appearance))) (else (slib:error 'solid:ellipsoid '? (cons geometry appearance))))) +;;@args coordinates appearance +;;@args coordinates +;;@1 must be a list or vector of coordinate lists or vectors +;;specifying the x, y, and z coordinates of points. @0 returns lines +;;connecting successive pairs of points. If called with one argument, +;;then the polyline will be white. If @2 is given, then the polyline +;;will have its emissive color only; being black if @2 does not have +;;an emissive color. +;; +;;The following code will return a red line between points at +;;@code{(1 2 3)} and @code{(4 5 6)}: +;;@example +;;(solid:polyline '((1 2 3) (4 5 6)) (solid:color #f 0 #f 0 '(1 0 0))) +;;@end example +(define (solid:polyline coordinates . args) + (define coordslist (if (list? coordinates) + coordinates + (array->list coordinates))) + (solid:node + "Shape" + (case (length args) + ((1) (car args)) + ((0) "") + (else (slib:error 'solid:indexed-polylines 'too-many-args))) + " geometry " + (solid:node + " IndexedLineSet" + (sprintf #f " coord Coordinate { point [%s] }\\n coordIndex [%s]" + (apply string-append + (map (lambda (lst) + (apply sprintf #f " %g %g %g," + (if (vector? lst) (vector->list lst) lst))) + coordslist)) + (do ((idx (+ -1 (length coordslist)) (+ -1 idx)) + (lst '() (cons (sprintf #f " %g," idx) lst))) + ((negative? idx) + (apply string-append lst))))))) + ;;@args width height depth colorray appearance ;;@args width height depth appearance ;;@args width height depth @@ -677,12 +723,12 @@ '(-1 0 0) 90 (solid:bry width depth height args))))) (define (solid:bry width heights depth args) - (define shape (array-shape heights)) - (if (not (eqv? 2 (length shape))) - (slib:error 'solid:basrelief 'rank? shape)) - (let ((xdim (- (cadadr shape) (caadr shape) -1)) - (zdim (- (cadar shape) (caar shape) -1))) - (define elevs (solid:extract-elevations heights shape)) + (define dimensions (array-dimensions heights)) + (if (not (eqv? 2 (length dimensions))) + (slib:error 'solid:basrelief 'rank? dimensions)) + (let ((xdim (cadr dimensions)) + (zdim (car dimensions))) + (define elevs (solid:extract-elevations heights dimensions)) (solid:translation (list (* -1/2 width) 0 (* -1/2 depth)) (solid:node @@ -697,7 +743,7 @@ " ElevationGrid" " solid FALSE" (sprintf #f " xDimension %g xSpacing %g zDimension %g zSpacing %g\\n" - xdim (/ width xdim) zdim (/ depth zdim)) + xdim (/ width (+ -1 xdim)) zdim (/ depth (+ -1 zdim))) (sprintf #f " height [%s]\\n" elevs) (if (and (not (null? args)) (<= 2 (array-rank (car args)))) (case (length args) @@ -705,35 +751,39 @@ ((1 0) "")) "")))))) -(define (solid:extract-elevations heights shape) - (define zdim (- (cadar shape) (caar shape) -1)) +(define (solid:extract-elevations heights dimensions) + (define zdim (cadr dimensions)) (define cnt 0) (define hts '()) (define lns '()) (array-for-each (lambda (ht) - (set! hts (cons (sprintf #f " %g" ht) hts)) (set! cnt (+ 1 cnt)) - (cond ((>= cnt zdim) - (set! cnt 0) - (set! lns (cons (sprintf #f " %s\\n" - (apply string-append (reverse hts))) - lns)) - (set! hts '())))) + (set! hts (cons (sprintf #f + (if (zero? (modulo cnt 8)) "\\n %g" " %g") ht) + hts)) + (cond + ((>= cnt zdim) + (set! cnt 0) + (set! lns (cons (apply string-append + (cons " " + (reverse (cons (sprintf #f "\\n") hts)))) + lns)) + (set! hts '())))) heights) (if (not (null? hts)) (slib:error 'solid:extract-elevations 'leftover hts)) (apply string-append (reverse lns))) (define (solid:extract-colors heights colora) - (define hshape (array-shape heights)) - (define cshape (array-shape colora)) - (cond ((equal? hshape cshape)) - ((and (eqv? 2 (length cshape)) + (define hdims (array-dimensions heights)) + (define cdims (array-dimensions colora)) + (cond ((equal? hdims cdims)) + ((and (eqv? 2 (length cdims)) (equal? '(0 1 0 1) (map - - (apply append hshape) - (apply append cshape))))) - (else (slib:error 'solid:basrelief 'mismatch 'shape hshape cshape))) - (let ((ldim (- (cadadr cshape) (caadr cshape) -1)) + (apply append hdims) + (apply append cdims))))) + (else (slib:error 'solid:basrelief 'mismatch 'dimensions hdims cdims))) + (let ((ldim (cadr cdims)) (cnt 0) (sts '()) (lns '())) @@ -749,9 +799,45 @@ (set! sts '())))) colora) (sprintf #f " colorPerVertex %s color Color {color [%s]}\\n" - (if (equal? hshape cshape) "TRUE" "FALSE") + (if (equal? hdims cdims) "TRUE" "FALSE") (apply string-append (reverse lns))))) +;;@args fontstyle str len appearance +;;@args fontstyle str len +;; +;;@1 must be a value returned by @code{solid:font}. +;; +;;@2 must be a string or list of strings. +;; +;;@3 must be #f, a nonnegative integer, or list of nonnegative +;;integers. +;; +;;@4, if given, determines the surface properties of the returned +;;object. +;; +;;@0 returns a two-sided, flat text object positioned in the Z=0 plane +;;of the local coordinate system +(define (solid:text fontstyle str lengths . appearance) + (solid:node + "Shape" + (if (null? appearance) "" (string-append (car appearance) " ")) + "geometry " + (solid:node + "Text" + (sprintf #f "fontStyle %s string [ %s ]%s" + fontstyle + (apply string-append + (map (lambda (st) (sprintf #f " %#a" st)) + (if (string? str) (list str) str))) + (cond ((not lengths) "") + ((number? lengths) + (sprintf #f " maxExtent %g" lengths)) + (else + (sprintf #f " length [ %s ]" + (apply string-append + (map (lambda (x) (sprintf #f " %g" x)) + lengths))))))))) + ;;@subheading Surface Attributes ;;@args diffuseColor ambientIntensity specularColor shininess emissiveColor transparency @@ -839,6 +925,63 @@ (coordinates2string translation)) "")))))) +;;; X11 foundry-family-weight-slant-setwidth-style-pixelSize-pointSize-Xresolution-Yresolution-spacing-averageWidth-registry-encoding + +;;@body +;;Returns a fontstyle object suitable for passing as an argument to +;;@code{solid:text}. Any of the arguments may be #f, in which case +;;its default value, which is first in each list of allowed values, is +;;used. +;; +;;@1 is a case-sensitive string naming a font; @samp{SERIF}, +;;@samp{SANS}, and @samp{TYPEWRITER} are supported at the minimum. +;; +;;@2 is a case-sensitive string @samp{PLAIN}, @samp{BOLD}, +;;@samp{ITALIC}, or @samp{BOLDITALIC}. +;; +;;@3 is a case-sensitive string @samp{FIRST}, @samp{BEGIN}, +;;@samp{MIDDLE}, or @samp{END}; or a list of one or two case-sensitive +;;strings (same choices). The mechanics of @3 get complicated; it is +;;explained by tables 6.2 to 6.7 of +;;@url{http://www.web3d.org/x3d/specifications/vrml/ISO-IEC-14772-IS-VRML97WithAmendment1/part1/nodesRef.html#Table6.2} +;; +;; +;;@4 is the extent, in the non-advancing direction, of the text. +;;@4 defaults to 1. +;; +;;@5 is the ratio of the line (or column) offset to @4. +;;@5 defaults to 1. +;; +;;@6 is the RFC-1766 language name. +;; +;;@7 is a list of two numbers: @w{@code{(@var{x} @var{y})}}. If +;;@w{@code{(> (abs @var{x}) (abs @var{y}))}}, then the text will be +;;arrayed horizontally; otherwise vertically. The direction in which +;;characters are arrayed is determined by the sign of the major axis: +;;positive @var{x} being left-to-right; positive @var{y} being +;;top-to-bottom. +(define (solid:font family style justify size spacing language direction) + (define (field name value) + (if value (sprintf #f " %s %#a" name value) "")) + (define (bfield name boolean) + (sprintf #f " %s %s" name (if boolean "TRUE" "FALSE"))) + (solid:node "FontStyle" + (field "family" family) + (field "style" style) + (if (list? justify) + (apply sprintf #f " %s [%#a %#a]" "justify" justify) + (field "justify" justify)) + (field "size" size) + (field "spacing" spacing) + (field "language" language) + (if direction + (string-append + (bfield "horizontal" (> (abs (car direction)) + (abs (cadr direction)))) + (bfield "leftToRight" (positive? (car direction))) + (bfield "topToBottom" (positive? (cadr direction)))) + ""))) + ;;@subheading Aggregating Objects ;;@body Returns a row of @1 @2 objects spaced evenly @3 apart. @@ -10,7 +10,7 @@ @ftindex solid-modeling @noindent -@uref{http://swissnet.ai.mit.edu/~jaffer/Solid/#Example} gives an +@uref{http://swiss.csail.mit.edu/~jaffer/Solid/#Example} gives an example use of this package. @@ -19,20 +19,24 @@ Returns the VRML97 string (including header) of the concatenation of strings @var{nodes}, @dots{}. @end defun + @defun vrml-append node1 node2 @dots{} Returns the concatenation with interdigitated newlines of strings @var{node1}, @var{node2}, @dots{}. @end defun + @defun vrml-to-file file node @dots{} Writes to file named @var{file} the VRML97 string (including header) of the concatenation of strings @var{nodes}, @dots{}. @end defun + @defun world:info title info @dots{} Returns a VRML97 string setting the title of the file in which it appears to @var{title}. Additional strings @var{info}, @dots{} are comments. @end defun + @noindent VRML97 strings passed to @code{vrml} and @code{vrml-to-file} as @@ -48,6 +52,7 @@ Specifies the distant images on the inside faces of the cube enclosing the virtual world. @end defun + @defun scene:sphere colors angles @@ -60,18 +65,21 @@ between 0.0 and 1.0. elements of @var{angles}, then the color at the zenith and nadir are taken from the colors paired with the angles nearest them. -@code{scene:sphere} fills horizontal bands with interpolated colors on the backgroud +@code{scene:sphere} fills horizontal bands with interpolated colors on the background sphere encasing the world. @end defun + @defun scene:sky-and-dirt -Returns a blue and brown backgroud sphere encasing the world. +Returns a blue and brown background sphere encasing the world. @end defun + @defun scene:sky-and-grass -Returns a blue and green backgroud sphere encasing the world. +Returns a blue and green background sphere encasing the world. @end defun + @defun scene:sun latitude julian-day hour turbidity strength @@ -87,6 +95,7 @@ in @xref{Daylight, turbidity}. (default 1). @end defun + @defun scene:overcast latitude julian-day hour turbidity strength @@ -100,6 +109,7 @@ in @xref{Daylight, turbidity}. @code{scene:overcast} returns an overcast sky as it might look at @var{hour} on @var{julian-day} at @var{latitude}. If @var{strength} is positive, included is an ambient light source of @var{strength} (default 1). @end defun + @noindent Viewpoints are objects in the virtual world, and can be transformed individually or with solid objects. @@ -115,10 +125,12 @@ number from -90 to 90, defaulting to 0, specifying the angle from the horizontal. @end defun + @defun scene:viewpoints proximity Returns 6 viewpoints, one at the center of each face of a cube with sides 2 * @var{proximity}, centered on the origin. @end defun + @subheading Light Sources @noindent @@ -155,6 +167,7 @@ defaulting to @samp{1}. (or 1 if omitted). @end defun + @defun light:directional color direction intensity @@ -181,6 +194,7 @@ shine down. shining from @var{direction}. @end defun + @defun light:beam attenuation radius aperture peak @@ -201,6 +215,7 @@ light's axis through which it sheds some light. @var{peak} is a real number between 0 and 90, the angle of greatest illumination. @end defun + @defun light:point location color intensity beam @@ -224,6 +239,7 @@ defaulting to @samp{1}. @var{beam} is a structure returned by To make it so, place an object with emissive appearance at @var{location}. @end defun + @defun light:spot location direction color intensity beam @@ -255,6 +271,7 @@ then the default color will be used. @var{color}. Note that the spotlight itself is not visible. To make it so, place an object with emissive appearance at @var{location}. @end defun + @subheading Object Primitives @@ -269,16 +286,19 @@ centered on the origin. @var{appearance} determines the surface properties of t returned object. @end defun + @defun solid:cylinder radius height appearance @defunx solid:cylinder radius height -Returns a right cylinder with dimensions @var{radius} and @code{(abs @var{height})} +Returns a right cylinder with dimensions @code{(abs @var{radius})} and @code{(abs @var{height})} centered on the origin. If @var{height} is positive, then the cylinder ends -will be capped. @var{appearance} determines the surface properties of the returned +will be capped. If @var{radius} is negative, then only the ends will appear. +@var{appearance} determines the surface properties of the returned object. @end defun + @defun solid:disk radius thickness appearance @@ -288,6 +308,7 @@ with dimensions @var{radius} and @var{thickness} centered on the origin. @var{a surface properties of the returned object. @end defun + @defun solid:cone radius height appearance @@ -297,6 +318,7 @@ the origin. @var{appearance} determines the surface properties of the returned object. @end defun + @defun solid:pyramid side height appearance @@ -306,6 +328,7 @@ the origin. @var{appearance} determines the surface properties of the returned object. @end defun + @defun solid:sphere radius appearance @@ -314,6 +337,7 @@ Returns a sphere of radius @var{radius} centered on the origin. @var{appearance the surface properties of the returned object. @end defun + @defun solid:ellipsoid geometry appearance @@ -324,6 +348,26 @@ Otherwise, @code{solid:ellipsoid} returns an ellipsoid with diameters @var{geome origin. @var{appearance} determines the surface properties of the returned object. @end defun + +@defun solid:polyline coordinates appearance + + +@defunx solid:polyline coordinates +@var{coordinates} must be a list or vector of coordinate lists or vectors +specifying the x, y, and z coordinates of points. @code{solid:polyline} returns lines +connecting successive pairs of points. If called with one argument, +then the polyline will be white. If @var{appearance} is given, then the polyline +will have its emissive color only; being black if @var{appearance} does not have +an emissive color. + +The following code will return a red line between points at +@code{(1 2 3)} and @code{(4 5 6)}: +@example +(solid:polyline '((1 2 3) (4 5 6)) (solid:color #f 0 #f 0 '(1 0 0))) +@end example +@end defun + + @defun solid:basrelief width height depth colorray appearance @@ -348,6 +392,27 @@ corresponding vertex of @var{height}. If @var{colorray} has all dimensions one than @var{height}, then each element of @var{colorray} paints the corresponding face of @var{height}. Other dimensions for @var{colorray} are in error. @end defun + + +@defun solid:text fontstyle str len appearance + + +@defunx solid:text fontstyle str len + +@var{fontstyle} must be a value returned by @code{solid:font}. + +@var{str} must be a string or list of strings. + +@var{len} must be #f, a nonnegative integer, or list of nonnegative +integers. + +@var{appearance}, if given, determines the surface properties of the returned +object. + +@code{solid:text} returns a two-sided, flat text object positioned in the Z=0 plane +of the local coordinate system +@end defun + @subheading Surface Attributes @@ -372,6 +437,7 @@ and 1. @var{diffuseColor}, @var{specularColor}, and @var{emissiveColor} are obj If a color argument is omitted or #f, then the default color will be used. @end defun + @defun solid:texture image color scale rotation center translation @@ -398,6 +464,44 @@ rotate @var{image}. @var{center} must be #f or a list or vector of 2 numbers sp the center of @var{image} relative to the @var{image} dimensions. @var{translation} must be #f or a list or vector of 2 numbers specifying the translation to apply to @var{image}. @end defun + + +@defun solid:font family style justify size spacing language direction + +Returns a fontstyle object suitable for passing as an argument to +@code{solid:text}. Any of the arguments may be #f, in which case +its default value, which is first in each list of allowed values, is +used. + +@var{family} is a case-sensitive string naming a font; @samp{SERIF}, +@samp{SANS}, and @samp{TYPEWRITER} are supported at the minimum. + +@var{style} is a case-sensitive string @samp{PLAIN}, @samp{BOLD}, +@samp{ITALIC}, or @samp{BOLDITALIC}. + +@var{justify} is a case-sensitive string @samp{FIRST}, @samp{BEGIN}, +@samp{MIDDLE}, or @samp{END}; or a list of one or two case-sensitive +strings (same choices). The mechanics of @var{justify} get complicated; it is +explained by tables 6.2 to 6.7 of +@url{http://www.web3d.org/x3d/specifications/vrml/ISO-IEC-14772-IS-VRML97WithAmendment1/part1/nodesRef.html#Table6.2} + + +@var{size} is the extent, in the non-advancing direction, of the text. +@var{size} defaults to 1. + +@var{spacing} is the ratio of the line (or column) offset to @var{size}. +@var{spacing} defaults to 1. + +@var{language} is the RFC-1766 language name. + +@var{direction} is a list of two numbers: @w{@code{(@var{x} @var{y})}}. If +@w{@code{(> (abs @var{x}) (abs @var{y}))}}, then the text will be +arrayed horizontally; otherwise vertically. The direction in which +characters are arrayed is determined by the sign of the major axis: +positive @var{x} being left-to-right; positive @var{y} being +top-to-bottom. +@end defun + @subheading Aggregating Objects @@ -405,14 +509,17 @@ list or vector of 2 numbers specifying the translation to apply to @var{image}. Returns a row of @var{number} @var{solid} objects spaced evenly @var{spacing} apart. @end defun + @defun solid:center-array-of number-a number-b solid spacing-a spacing-b Returns @var{number-b} rows, @var{spacing-b} apart, of @var{number-a} @var{solid} objects @var{spacing-a} apart. @end defun + @defun solid:center-pile-of number-a number-b number-c solid spacing-a spacing-b spacing-c Returns @var{number-c} planes, @var{spacing-c} apart, of @var{number-b} rows, @var{spacing-b} apart, of @var{number-a} @var{solid} objects @var{spacing-a} apart. @end defun + @defun solid:arrow center @var{center} must be a list or vector of three numbers. Returns an upward @@ -422,6 +529,7 @@ pointing metallic arrow centered at @var{center}. @defunx solid:arrow Returns an upward pointing metallic arrow centered at the origin. @end defun + @subheading Spatial Transformations @@ -430,12 +538,15 @@ Returns an upward pointing metallic arrow centered at the origin. aggregate of @var{solids}, @dots{} with their origin moved to @var{center}. @end defun + @defun solid:scale scale solid @dots{} @var{scale} must be a number or a list or vector of three numbers. @code{solid:scale} Returns an aggregate of @var{solids}, @dots{} scaled per @var{scale}. @end defun + @defun solid:rotation axis angle solid @dots{} @var{axis} must be a list or vector of three numbers. @code{solid:rotation} Returns an aggregate of @var{solids}, @dots{} rotated @var{angle} degrees around the axis @var{axis}. @end defun + @@ -19,13 +19,14 @@ (define (sorted? seq less?) (cond ((null? seq) #t) ((array? seq) - (let ((shape (array-shape seq))) - (or (<= (- (cadar shape) (caar shape)) 0) - (do ((i (+ 1 (caar shape)) (+ i 1))) - ((or (= i (cadar shape)) + (let ((dims (array-dimensions seq))) + (define dimax (+ -1 (car dims))) + (or (<= dimax 0) + (do ((i 1 (+ i 1))) + ((or (= i dimax) (less? (array-ref seq i) (array-ref seq (- i 1)))) - (= i (cadar shape))))))) + (= i dimax)))))) (else (let loop ((last (car seq)) (next (cdr seq))) (or (null? next) @@ -117,10 +118,10 @@ (else '()))) (cond ((array? seq) - (let ((shape (array-shape seq)) + (let ((dims (array-dimensions seq)) (vec seq)) (set! seq (rank-1-array->list seq)) - (do ((p (step (+ 1 (cadar shape))) (cdr p)) + (do ((p (step (car dims)) (cdr p)) (i 0 (+ i 1))) ((null? p) vec) (array-set! vec (car p) i)))) @@ -128,10 +129,10 @@ (step (length seq))))) (define (rank-1-array->list array) - (define shape (array-shape array)) - (do ((idx (cadar shape) (+ -1 idx)) + (define dimensions (array-dimensions array)) + (do ((idx (+ -1 (car dimensions)) (+ -1 idx)) (lst '() (cons (array-ref array idx) lst))) - ((< idx (caar shape)) lst))) + ((< idx 0) lst))) ;;; (sort sequence less?) ;;; sorts a array, string, or list non-destructively. It does this @@ -146,8 +147,8 @@ ((string? seq) (list->string (sort:sort! (string->list seq) less?))) ((array? seq) - (let ((shape (array-shape seq))) - (define newra (apply create-array seq shape)) + (let ((dimensions (array-dimensions seq))) + (define newra (apply make-array seq dimensions)) (do ((sorted (sort:sort! (rank-1-array->list seq) less?) (cdr sorted)) (i 0 (+ i 1))) diff --git a/soundex.scm b/soundex.scm index 6d73341..9853401 100644 --- a/soundex.scm +++ b/soundex.scm @@ -3,44 +3,44 @@ ; ; This code is in the public domain. -;Date: Mon, 2 May 94 13:45:39 -0500 - ; Taken from Knuth, Vol. 3 "Sorting and searching", pp 391--2 +;;; 2003-01-26 L.J. Buitinck converted to use dotted pairs for codes. + (require 'common-list-functions) ;@ (define SOUNDEX (let* ((letters-to-omit - (list #\A #\E #\H #\I #\O #\U #\W #\Y)) + '(#\A #\E #\H #\I #\O #\U #\W #\Y)) (codes - (list (list #\B #\1) - (list #\F #\1) - (list #\P #\1) - (list #\V #\1) - ;; - (list #\C #\2) - (list #\G #\2) - (list #\J #\2) - (list #\K #\2) - (list #\Q #\2) - (list #\S #\2) - (list #\X #\2) - (list #\Z #\2) - ;; - (list #\D #\3) - (list #\T #\3) - ;; - (list #\L #\4) - ;; - (list #\M #\5) - (list #\N #\5) - ;; - (list #\R #\6))) + '((#\B . #\1) + (#\F . #\1) + (#\P . #\1) + (#\V . #\1) + ;; + (#\C . #\2) + (#\G . #\2) + (#\J . #\2) + (#\K . #\2) + (#\Q . #\2) + (#\S . #\2) + (#\X . #\2) + (#\Z . #\2) + ;; + (#\D . #\3) + (#\T . #\3) + ;; + (#\L . #\4) + ;; + (#\M . #\5) + (#\N . #\5) + ;; + (#\R . #\6))) (xform (lambda (c) (let ((code (assv c codes))) (if code - (cadr code) + (cdr code) c))))) (lambda (name) (let ((char-list @@ -78,5 +78,3 @@ (loop (cons #\0 rev-chars))) ((< 4 len) (loop (cdr rev-chars)))))))))))) - - @@ -1,6 +1,7 @@ ;;; "srfi-1.scm" SRFI-1 list-processing library -*-scheme-*- ;; Copyright 2001 Aubrey Jaffer ;; Copyright 2003 Sven Hartrumpf +;; Copyright 2003-2004 Lars Buitinck ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -38,11 +39,13 @@ ;;@subheading Constructors -;;@body @code{(define (xcons d a) (cons a d))}. +;;@body +;; @code{(define (xcons d a) (cons a d))}. (define (xcons d a) (cons a d)) -;;@body Returns a list of length @1. Element @var{i} is @code{(@2 -;;@var{i})} for 0 <= @var{i} < @1. +;;@body +;; Returns a list of length @1. Element @var{i} is +;;@code{(@2 @var{i})} for 0 <= @var{i} < @1. (define (list-tabulate len proc) (do ((i (- len 1) (- i 1)) (ans '() (cons (proc i) ans))) @@ -122,23 +125,24 @@ (define third caddr) ;;@args pair (define fourth cadddr) -;;@args pair -(define (fifth obj) (car (cddddr obj))) -(define (sixth obj) (cadr (cddddr obj))) -(define (seventh obj) (caddr (cddddr obj))) -(define (eighth obj) (cadddr (cddddr obj))) -(define (ninth obj) (car (cddddr (cddddr obj)))) -(define (tenth obj) (cadr (cddddr (cddddr obj)))) +;;@body +(define (fifth pair) (car (cddddr pair))) +(define (sixth pair) (cadr (cddddr pair))) +(define (seventh pair) (caddr (cddddr pair))) +(define (eighth pair) (cadddr (cddddr pair))) +(define (ninth pair) (car (cddddr (cddddr pair)))) +(define (tenth pair) (cadr (cddddr (cddddr pair)))) ;;@body (define (car+cdr pair) (values (car pair) (cdr pair))) -;;@body +;;@args lst k (define (drop lst k) (nthcdr k lst)) (define (take lst k) (butnthcdr k lst)) -;;@args lst k -(define take! take) - +(define (take! lst k) + (if (or (null? lst) (<= k 0)) + '() + (begin (set-cdr! (drop (- k 1) lst) '()) lst))) ;;@args lst k (define take-right last) ;;@args lst k @@ -146,13 +150,21 @@ ;;@args lst k (define drop-right! drop-right) -;;@args lst k -(define (split-at lst k) (values (take lst k) (drop lst k))) -;;@args lst k -(define split-at! split-at) +;;@body +(define (split-at lst k) + (let loop ((l '()) (r lst) (k k)) + (if (or (null? r) (= k 0)) + (values (reverse! l) r) + (loop (cons (car r) l) (cdr r) (- k 1))))) +(define (split-at! lst k) + (if (= k 0) + (values '() lst) + (let* ((half (drop lst (- k 1))) + (r (cdr half))) + (set-cdr! half '()) + (values lst r)))) -;;@args lst -;;(car (last-pair lst)) +;;@body (define (last lst . k) (if (null? k) (car (last-pair lst)) @@ -161,7 +173,7 @@ ;;@subheading Miscellaneous ;;@body -(define (length+ obj) (and (list? obj) (length obj))) +(define (length+ clist) (and (list? clist) (length clist))) ;;Append and append! are provided by R4RS and rev2-procedures. @@ -214,42 +226,83 @@ ;;@subheading Fold and Unfold +;;@args kons knil clist1 clist2 ... +(define (fold f z l1 . l) + (set! l (cons l1 l)) + (if (any null? l) + z + (apply fold (cons* f (apply f (append! (map car l) (list z))) + (map cdr l))))) +;;@args kons knil clist1 clist2 ... +(define (fold-right f z l1 . l) + (set! l (cons l1 l)) + (if (any null? l) + z + (apply f (append! (map car l) + (list (apply fold-right (cons* f z (map cdr l)))))))) +;;@args kons knil clist1 clist2 ... +(define (pair-fold f z l) ;XXX should be multi-arg + (if (null? l) + z + (let ((tail (cdr l))) + (pair-fold f (f l z) tail)))) +;;@args kons knil clist1 clist2 ... +(define (pair-fold-right f z l) ;XXX should be multi-arg + (if (null? l) + z + (f l (pair-fold-right f z (cdr l))))) -;;; We stop when LIS1 runs out, not when any list runs out. -;;@args f list1 clist2 ... -(define (map! f lis1 . lists) +;;@body +(define (reduce f ridentity list) + (if (null? list) ridentity (fold f (car list) (cdr list)))) +(define (reduce-right f ridentity list) + (if (null? list) + ridentity + (let red ((l (cdr list)) (ridentity (car list))) + (if (null? list) + ridentity + (f ridentity (red (cdr list) (car list))))))) + +;;; We stop when CLIST1 runs out, not when any list runs out. +;;@args f clist1 clist2 ... +(define (map! f clist1 . lists) (if (pair? lists) - (let lp ((lis1 lis1) (lists lists)) - (if (not (null-list? lis1)) + (let lp ((clist1 clist1) (lists lists)) + (if (not (null-list? clist1)) (call-with-values ; expanded a receive call (lambda () (%cars+cdrs/no-test lists)) (lambda (heads tails) - (set-car! lis1 (apply f (car lis1) heads)) - (lp (cdr lis1) tails))))) - + (set-car! clist1 (apply f (car clist1) heads)) + (lp (cdr clist1) tails))))) ;; Fast path. - (pair-for-each (lambda (pair) (set-car! pair (f (car pair)))) lis1)) - lis1) - + (pair-for-each (lambda (pair) (set-car! pair (f (car pair)))) clist1)) + clist1) ;;@args f clist1 clist2 ... -(define (pair-for-each proc lis1 . lists) +(define (pair-for-each proc clist1 . lists) (if (pair? lists) - (let lp ((lists (cons lis1 lists))) + (let lp ((lists (cons clist1 lists))) (let ((tails (%cdrs lists))) (if (pair? tails) (begin (apply proc lists) (lp tails))))) ;; Fast path. - (let lp ((lis lis1)) + (let lp ((lis clist1)) (if (not (null-list? lis)) (let ((tail (cdr lis))) ; Grab the cdr now, (proc lis) ; in case PROC SET-CDR!s LIS. (lp tail)))))) +(define (filter-map f l1 . l) + (let loop ((l (cons l1 l)) (r '())) + (if (any null? l) + (reverse! r) + (let ((x (apply f (map car l)))) + (loop (map! cdr l) (if x (cons x r) r)))))) + ;;@subheading Filtering and Partitioning -;;@body +;;@args pred list (define (filter pred lis) ; Sleazing with EQ? makes this one faster. (let recur ((lis lis)) (if (null-list? lis) lis ; Use NOT-PAIR? to handle dotted lists. @@ -260,32 +313,10 @@ (if (eq? tail new-tail) lis (cons head new-tail))) (recur tail)))))) ; this one can be a tail call. -;;@body -(define (filter! pred l) - (if (null? l) - l - (let ((l2 l) - (l3 (cdr l))) - (do ((end #f) - (result '())) - (end result) - (cond ((pred (car l2)) ; keep the first element of l2 - (cond ((null? result) - (set! result l2))) ; first pair of remaining elements - (cond ((pair? l3) - (set! l2 l3) - (set! l3 (cdr l2))) - (else - (set! end #t)))) - (else ; remove the first element of l2 - (cond ((pair? l3) - (set-car! l2 (car l3)) - (set! l3 (cdr l3)) - (set-cdr! l2 l3)) - (else - (cond ((pair? result) - (list-remove-last! result))) - (set! end #t))))))))) +;;@args pred list +(define (filter! p? l) + (call-with-values (lambda () (partition! p? l)) + (lambda (x y) x))) ;;@args pred list (define (partition pred lis) @@ -300,24 +331,61 @@ (values (if (pair? out) (cons elt in) lis) out) (values in (if (pair? in) (cons elt out) lis))))))))) -;;@subheading Searching - ;;@args pred list -(define find find-if) - -;;@args pred list -(define find-tail member-if) - -;;@body (define remove (let ((comlist:remove remove)) (lambda (pred l) (if (procedure? pred) (filter (lambda (x) (not (pred x))) l) (comlist:remove pred l))))) ; 'remove' has incompatible semantics in comlist of SLIB! -;;@body + +;;@args pred list +(define (partition! p? l) + (if (null? l) + (values l l) + (let ((p-ptr (cons '*unused* l)) (not-ptr (cons '*unused* l))) + (let loop ((l l) (p-prev p-ptr) (not-prev not-ptr)) + (cond ((null? l) (values (cdr p-ptr) (cdr not-ptr))) + ((p? (car l)) (begin (set-cdr! not-prev (cdr l)) + (loop (cdr l) l not-prev))) + (else (begin (set-cdr! p-prev (cdr l)) + (loop (cdr l) p-prev l)))))))) + +;;@args pred list (define (remove! pred l) (filter! (lambda (x) (not (pred x))) l)) + +;;@subheading Searching + +;;@args pred clist +(define find find-if) +;;@args pred clist +(define find-tail member-if) + +;;@args pred list +(define (span pred lis) + (let recur ((lis lis)) + (if (null-list? lis) (values '() '()) + (let ((x (car lis))) + (if (pred x) + (call-with-values ; eliminated a receive call + (lambda () (recur (cdr lis))) + (lambda (prefix suffix) + (values (cons x prefix) suffix))) + (values '() lis)))))) + +;;@args pred list +(define (span! p? lst) + (let loop ((l lst) (prev (cons '*unused* lst))) + (cond ((null? l) (values lst '())) + ((p? (car l)) (loop (cdr l) l)) + (else (begin (set-cdr! prev '()) (values lst l)))))) + +;;@args pred list +(define (break p? l) (span (lambda (x) (not (p? x))) l)) +;;@args pred list +(define (break! p? l) (span! (lambda (x) (not (p? x))) l)) + ;;@args pred clist1 clist2 ... (define (any pred lis1 . lists) (if (pair? lists) @@ -339,7 +407,6 @@ (if (null-list? tail) (pred head) ; Last PRED app is tail call. (or (pred head) (lp (car tail) (cdr tail)))))))) - ;;@args pred clist1 clist2 ... (define (list-index pred lis1 . lists) (if (pair? lists) @@ -356,27 +423,8 @@ (and (not (null-list? lis)) (if (pred (car lis)) n (lp (cdr lis) (+ n 1))))))) -;;@args pred list -(define (span pred lis) - (let recur ((lis lis)) - (if (null-list? lis) (values '() '()) - (let ((x (car lis))) - (if (pred x) - (call-with-values ; eliminated a receive call - (lambda () (recur (cdr lis))) - (lambda (prefix suffix) - (values (cons x prefix) suffix))) - (values '() lis)))))) - -;;@args obj list pred +;;@args obj list = ;;@args obj list -;; -;;@0 returns the first sublist of @2 whose car is @1, where the sublists -;;of @2 are the non-empty lists returned by @t{(list-tail @2 @var{k})} -;;for @var{k} less than the length of @2. If @1 does not occur in @2, -;;then @t{#f} (not the empty list) is returned. The procedure @3 is -;;used for testing equality. If @3 is not provided, @samp{equal?} is -;;used. (define member (let ((old-member member)) (lambda (obj list . pred) @@ -387,16 +435,22 @@ ;;@subheading Deleting +;;@args x list = +;;@args x list +(define (delete-duplicates l =?) + (let loop ((l l) (r '())) + (if (null? l) + (reverse! r) + (loop (cdr l) + (if (member (car l) r =?) r (cons (car l) r)))))) +;;@args x list = +;;@args x list +(define delete-duplicates! delete-duplicates) + ;;@subheading Association lists ;;@args obj alist pred ;;@args obj alist -;; -;;@2 (for ``association list'') must be a list of pairs. These -;;procedures find the first pair in @2 whose car field is @1, and -;;returns that pair. If no pair in @2 has @1 as its car, then @t{#f} -;;(not the empty list) is returned. The procedure @3 is used for -;;testing equality. If @3 is not provided, @samp{equal?} is used. (define assoc (let ((old-assoc assoc)) (lambda (obj alist . pred) @@ -405,8 +459,140 @@ (let ((pred (car pred))) (find (lambda (pair) (pred obj (car pair))) alist)))))) +;; XXX maybe define the following in alist and require that module here? + +;;@args key datum alist +(define (alist-cons k d l) (cons (cons k d) l)) + +;;@args alist +(define (alist-copy l) + (map (lambda (x) (cons (car x) (cdr x))) l)) + +;;@args key alist = +;;@args key alist +(define (alist-delete k l . opt) + (let ((key=? (if (pair? opt) (car opt) equal?))) + (remove (lambda (x) (key=? (car x) k)) l))) +;;@args key alist = +;;@args key alist +(define (alist-delete! k l . opt) + (let ((key=? (if (pair? opt) (car opt) equal?))) + (remove! (lambda (x) (key=? (car x) k)) l))) + ;;@subheading Set operations +;;@args = list1 @dots{} +;;Determine if a transitive subset relation exists between the lists @2 +;;@dots{}, using @1 to determine equality of list members. +(define (lset<= =? . l) + (or (null? l) + (letrec ((subset? (lambda (l1 l2) + (or (eq? l1 l2) + (every (lambda (x) (member x l2)) l1))))) + (let loop ((l1 (car l)) (l (cdr l))) + (or (null? l) + (let ((l2 (car l))) + (and (subset? l1 l2) + (loop l2 (cdr l))))))))) + +;;@args = list1 list2 @dots{} +(define (lset= =? . l) + (or (null? l) + (let loop ((l1 (car l)) (l (cdr l))) + (or (null? l) + (let ((l2 (car l))) + (and (lset<= =? l1 l2) + (lset<= =? l2 l1) + (loop (if (< (length l1) (length l2)) l1 l2) + (cdr l)))))))) + +;;@args list elt1 @dots{} +(define (lset-adjoin =? l1 . l2) + (let ((adjoin (lambda (x l) + (if (member x l =?) l (cons x l))))) + (fold adjoin l1 l2))) + +;;@args = list1 @dots{} +(define (lset-union =? . l) + (let ((union (lambda (l1 l2) + (if (or (null? l2) (eq? l1 l2)) + l1 + (apply lset-adjoin (cons* =? l2 l1)))))) + (fold union '() l))) + +;;@args = list1 list2 @dots{} +(define (lset-intersection =? l1 . l) + (let loop ((l l) (r l1)) + (cond ((null? l) r) + ((null? (car l)) '()) + (else (loop (cdr l) + (filter (lambda (x) (member x (car l) =?)) r)))))) + +;;@args = list1 list2 ... +(define (lset-difference =? l1 . l) + (call-with-current-continuation + (lambda (return) + (let ((diff (lambda (l1 l2) + (cond ((null? l2) (return '())) + ((null? l1) l2) + (else (remove (lambda (x) (member x l1 =?)) + l2)))))) + (fold diff l1 l))))) + +;; Alternatively definition of lset-difference, for large numbers of sets. +;(define (lset-difference =? l1 . l) +; (set! l (cdr (delete-duplicates! (cons l1 l) eq?))) +; (case (length l) +; ((0) l1) +; ((1) (remove (lambda (x) (member x l1 =?)) (car l))) +; (else (apply (lset-difference! (cons* =? (list-copy l1) l)))))) + +;;@args = list1 ... +(define (lset-xor =? . l) + (let ((xor (lambda (l1 l2) (lset-union =? (lset-difference =? l1 l2) + (lset-difference =? l2 l1))))) + (fold xor '() l))) + +;;@args = list1 list2 ... +(define (lset-diff+intersection =? l1 . l) + (let ((u (apply lset-union (cons =? l)))) + (values (lset-difference =? l1 u) + (lset-intersection =? l1 u)))) + +;;@noindent +;;These are linear-update variants. They are allowed, but not +;;required, to use the cons cells in their first list parameter to +;;construct their answer. @code{lset-union!} is permitted to recycle +;;cons cells from any of its list arguments. + +;;@args = list1 list2 ... +(define lset-intersection! lset-intersection) +;;@args = list1 list2 ... +(define (lset-difference! =? l1 . l) + (let loop ((l l) (d l1)) + (if (or (null? l) (null? d)) + d + (loop (cdr l) + (let ((l1 (car l))) + (if (null? l1) d (remove! (lambda (x) (member x l1 =?)) d))))))) + +;;@args = list1 ... +(define (lset-union! =? . l) + (let loop ((l l) (u '())) + (if (null? l) + u + (loop (cdr l) + (cond ((null? (car l)) u) + ((eq? (car l) u) u) + ((null? u) (car l)) + (else (append-reverse! (lset-difference! =? (car l) u) + u))))))) +;;@args = list1 ... +(define lset-xor! lset-xor) + +;;@args = list1 list2 ... +(define lset-diff+intersection! lset-diff+intersection) + ;;;; helper functions from the reference implementation: @@ -11,22 +11,28 @@ at @url{http://srfi.schemers.org/srfi-1/srfi-1.html} @defun xcons d a -@code{(define (xcons d a) (cons a d))}. + + @code{(define (xcons d a) (cons a d))}. @end defun + @defun list-tabulate len proc -Returns a list of length @var{len}. Element @var{i} is @code{(@var{proc} -@var{i})} for 0 <= @var{i} < @var{len}. + + Returns a list of length @var{len}. Element @var{i} is +@code{(@var{proc} @var{i})} for 0 <= @var{i} < @var{len}. @end defun + @defun cons* obj1 obj2 @end defun + @defun list-copy flist @end defun + @defun iota count start step @@ -36,10 +42,12 @@ Returns a list of length @var{len}. Element @var{i} is @code{(@var{proc} Returns a list of @var{count} numbers: (@var{start}, @var{start}+@var{step}, @dots{}, @var{start}+(@var{count}-1)*@var{step}). @end defun + @defun circular-list obj1 obj2 @dots{} Returns a circular list of @var{obj1}, @var{obj2}, @dots{}. @end defun + @subheading Predicates @@ -47,25 +55,31 @@ Returns a circular list of @var{obj1}, @var{obj2}, @dots{}. @end defun + @defun circular-list? x @end defun + @defun dotted-list? obj @end defun + @defun null-list? obj @end defun + @defun not-pair? obj @end defun + @defun list= =pred list @dots{} @end defun + @subheading Selectors @@ -73,89 +87,99 @@ Returns a circular list of @var{obj1}, @var{obj2}, @dots{}. @end defun + @defun second pair @end defun + @defun third pair @end defun + @defun fourth pair @end defun + @defun fifth pair -@defunx sixth obj -@defunx seventh obj -@defunx eighth obj -@defunx ninth obj -@defunx tenth obj +@defunx sixth pair +@defunx seventh pair +@defunx eighth pair +@defunx ninth pair +@defunx tenth pair @end defun + @defun car+cdr pair @end defun + @defun drop lst k @defunx take lst k +@defunx take! lst k @end defun -@deffn {Procedure} take! lst k - -@end deffn @defun take-right lst k @end defun + @defun drop-right lst k @end defun + @deffn {Procedure} drop-right! lst k @end deffn + @defun split-at lst k +@defunx split-at! lst k @end defun -@deffn {Procedure} split-at! lst k -@end deffn - -@defun last lst +@defun last lst k @dots{} -(car (last-pair lst)) @end defun + @subheading Miscellaneous -@defun length+ obj +@defun length+ clist @end defun + @defun concatenate lists @defunx concatenate! lists @end defun + @deffn {Procedure} reverse! lst @end deffn + @defun append-reverse rev-head tail @defunx append-reverse! rev-head tail @end defun + @defun zip list1 list2 @dots{} @end defun + @defun unzip1 lst @defunx unzip2 lst @defunx unzip3 lst @@ -164,77 +188,145 @@ Returns a circular list of @var{obj1}, @var{obj2}, @dots{}. @end defun + @defun count pred list1 list2 @dots{} @end defun + @subheading Fold and Unfold -@deffn {Procedure} map! f list1 clist2 @dots{} +@defun fold kons knil clist1 clist2 @dots{} + +@end defun + + +@defun fold-right kons knil clist1 clist2 @dots{} + +@end defun + + +@defun pair-fold kons knil clist1 clist2 @dots{} + +@end defun + + +@defun pair-fold-right kons knil clist1 clist2 @dots{} + +@end defun + + +@defun reduce f ridentity list +@defunx reduce-right f ridentity list + +@end defun + + +@deffn {Procedure} map! f clist1 clist2 @dots{} @end deffn + @defun pair-for-each f clist1 clist2 @dots{} @end defun + @subheading Filtering and Partitioning -@defun filter pred lis +@defun filter pred list @end defun -@deffn {Procedure} filter! pred l + +@deffn {Procedure} filter! pred list @end deffn + @defun partition pred list @end defun + + +@defun remove pred list + +@end defun + + +@deffn {Procedure} partition! pred list + +@end deffn + + +@deffn {Procedure} remove! pred list + +@end deffn + @subheading Searching -@defun find pred list +@defun find pred clist @end defun -@defun find-tail pred list + +@defun find-tail pred clist @end defun -@defun remove pred l + +@defun span pred list @end defun -@deffn {Procedure} remove! pred l + +@deffn {Procedure} span! pred list @end deffn + +@defun break pred list + +@end defun + + +@deffn {Procedure} break! pred list + +@end deffn + + @defun any pred clist1 clist2 @dots{} @end defun + @defun list-index pred clist1 clist2 @dots{} @end defun -@defun span pred list +@defun member obj list = + + +@defunx member obj list @end defun -@defun member obj list pred +@subheading Deleting -@defunx member obj list +@defun delete-duplicates x list = -@code{member} returns the first sublist of @var{list} whose car is @var{obj}, where the sublists -of @var{list} are the non-empty lists returned by @t{(list-tail @var{list} @var{k})} -for @var{k} less than the length of @var{list}. If @var{obj} does not occur in @var{list}, -then @t{#f} (not the empty list) is returned. The procedure @var{pred} is -used for testing equality. If @var{pred} is not provided, @samp{equal?} is -used. + +@defunx delete-duplicates x list @end defun -@subheading Deleting + + +@deffn {Procedure} delete-duplicates! x list = + + +@deffnx {Procedure} delete-duplicates! x list +@end deffn @subheading Association lists @@ -243,12 +335,104 @@ used. @defunx assoc obj alist +@end defun + + +@defun alist-cons key datum alist -@var{alist} (for ``association list'') must be a list of pairs. These -procedures find the first pair in @var{alist} whose car field is @var{obj}, and -returns that pair. If no pair in @var{alist} has @var{obj} as its car, then @t{#f} -(not the empty list) is returned. The procedure @var{pred} is used for -testing equality. If @var{pred} is not provided, @samp{equal?} is used. @end defun + + +@defun alist-copy alist + +@end defun + + +@defun alist-delete key alist = + + +@defunx alist-delete key alist +@end defun + + +@deffn {Procedure} alist-delete! key alist = + + +@deffnx {Procedure} alist-delete! key alist +@end deffn + @subheading Set operations + +@defun lset<= = list1 @dots{} + +Determine if a transitive subset relation exists between the lists @var{list1} +@dots{}, using @var{=} to determine equality of list members. +@end defun + + +@defun lset= = list1 list2 @dots{} + +@end defun + + +@defun lset-adjoin list elt1 @dots{} + +@end defun + + +@defun lset-union = list1 @dots{} + +@end defun + + +@defun lset-intersection = list1 list2 @dots{} + +@end defun + + +@defun lset-difference = list1 list2 @dots{} + +@end defun + + +@defun lset-xor = list1 @dots{} + +@end defun + + +@defun lset-diff+intersection = list1 list2 @dots{} + +@end defun + +@noindent +These are linear-update variants. They are allowed, but not +required, to use the cons cells in their first list parameter to +construct their answer. @code{lset-union!} is permitted to recycle +cons cells from any of its list arguments. + + +@deffn {Procedure} lset-intersection! = list1 list2 @dots{} + +@end deffn + + +@deffn {Procedure} lset-difference! = list1 list2 @dots{} + +@end deffn + + +@deffn {Procedure} lset-union! = list1 @dots{} + +@end deffn + + +@deffn {Procedure} lset-xor! = list1 @dots{} + +@end deffn + + +@deffn {Procedure} lset-diff+intersection! = list1 list2 @dots{} + +@end deffn + @@ -6,3 +6,4 @@ @url{http://srfi.schemers.org/srfi-2/srfi-2.html} @end defmac + @@ -6,3 +6,4 @@ @url{http://srfi.schemers.org/srfi-8/srfi-8.html} @end defspec + @@ -40,3 +40,4 @@ error is signaled. SLIB @code{cond-expand} is an extension of SRFI-0, @url{http://srfi.schemers.org/srfi-0/srfi-0.html}. @end defmac + diff --git a/strcase.scm b/strcase.scm index 71daba4..d099bb6 100644 --- a/strcase.scm +++ b/strcase.scm @@ -7,6 +7,8 @@ ; SYMBOL-APPEND and StudlyCapsExpand added by A. Jaffer 2001. ; Authors of the original version were Ken Dickey and Aubrey Jaffer. +(require 'rev4-optional-procedures) ;string-copy + ;string-upcase, string-downcase, string-capitalize ; are obvious string conversion procedures and are non destructive. ;string-upcase!, string-downcase!, string-capitalize! diff --git a/subarray.scm b/subarray.scm index 69b18c4..152ccbb 100644 --- a/subarray.scm +++ b/subarray.scm @@ -65,64 +65,39 @@ (loop sels (cdr args) (cons (car args) lst)))) ((number? (car sels)) (loop (cdr sels) args (cons (car sels) lst))) + ((list? (car sels)) + (loop (cdr sels) + (cdr args) + (cons (+ (car args) (caar sels)) lst))) (else (loop (cdr sels) (cdr args) (cons (car args) lst)))))) (let loop ((sels selects) - (shp (array-shape array)) - (nshp '())) - (cond ((null? shp) + (dims (array-dimensions array)) + (ndims '())) + (cond ((null? dims) (if (null? sels) - (reverse nshp) - (slib:error 'subarray 'rank (array-rank array) 'mismatch selects))) + (reverse ndims) + (slib:error + 'subarray 'rank (array-rank array) 'mismatch selects))) ((null? sels) - (loop sels (cdr shp) (cons (car shp) nshp))) + (loop sels (cdr dims) (cons (car dims) ndims))) + ((number? (car sels)) + (loop (cdr sels) (cdr dims) ndims)) ((not (car sels)) - (loop (cdr sels) (cdr shp) (cons (car shp) nshp))) - ((integer? (car sels)) - (loop (cdr sels) (cdr shp) nshp)) + (loop (cdr sels) (cdr dims) (cons (car dims) ndims))) + ((list? (car sels)) + (loop (cdr sels) + (cdr dims) + (cons (list 0 (- (cadar sels) (caar sels))) ndims))) (else - (loop (cdr sels) (cdr shp) (cons (car sels) nshp))))))) + (loop (cdr sels) (cdr dims) (cons (car sels) ndims))))))) ;;@body -;;Behaves like @r{subarray}, but @r{align}s the returned array origin to -;;0 @dots{}. -(define (subarray0 array . selects) - (define ra (apply subarray array selects)) - (apply array-align ra (map (lambda (x) 0) (array-shape ra)))) +;;Legacy alias for @r{subarray}. +(define subarray0 subarray) ;;@body ;; -;;Returns an array shared with @1 but with a different origin. The @2 -;;are the exact integer coordinates of the new origin. Indexes -;;corresponding to missing or #f coordinates are not realigned. -;; -;;For example: -;;@example -;;(define ra2 (create-array '#(5) '(5 9) '(-4 0))) -;;(array-shape ra2) @result{} ((5 9) (-4 0)) -;;(array-shape (array-align ra2 0 0)) @result{} ((0 4) (0 4)) -;;(array-shape (array-align ra2 0)) @result{} ((0 4) (-4 0)) -;;(array-shape (array-align ra2)) @result{} ((5 9) (-4 0)) -;;(array-shape (array-align ra2 0 #f)) @result{} ((0 4) (-4 0)) -;;(array-shape (array-align ra2 #f 0)) @result{} ((5 9) (0 4)) -;;@end example -(define (array-align array . coords) - (let* ((shape (array-shape array)) - (offs (let recur ((shp shape) - (crd coords)) - (cond ((null? shp) '()) - ((null? crd) (map (lambda (x) 0) shp)) - ((not (car crd)) (cons 0 (recur (cdr shp) (cdr crd)))) - (else (cons (- (car crd) (caar shp)) - (recur (cdr shp) (cdr crd)))))))) - (apply make-shared-array - array (lambda inds (map - inds offs)) - (map (lambda (spec off) - (list (+ (car spec) off) (+ (cadr spec) off))) - shape offs)))) - -;;@body -;; ;;Returns a subarray sharing contents with @1 except for slices removed ;;from either side of each dimension. Each of the @2 is an exact ;;integer indicating how much to trim. A positive @var{s} trims the @@ -132,41 +107,32 @@ ;; ;;For example: ;;@example -;;(array-trim '#(0 1 2 3 4) 1) @result{} #1A(1 2 3 4) ;; shape is ((0 3)) -;;(array-trim '#(0 1 2 3 4) -1) @result{} #1A(0 1 2 3) ;; shape is ((1 4)) +;;(array-trim '#(0 1 2 3 4) 1) @result{} #1A(1 2 3 4) +;;(array-trim '#(0 1 2 3 4) -1) @result{} #1A(0 1 2 3) ;; ;;(require 'array-for-each) ;;(define (centered-difference ra) -;; (array-map - (array-trim ra 1) (array-trim ra -1))) -;;(define (forward-difference ra) -;; (array-map - (array-trim ra 1) ra)) -;;(define (backward-difference ra) -;; (array-map - ra (array-trim ra -1))) +;; (array-map ra - (array-trim ra 1) (array-trim ra -1))) ;; ;;(centered-difference '#(0 1 3 5 9 22)) -;; @result{} #1A(3 4 6 17) ;;shape is ((1 4)) -;;(backward-difference '#(0 1 3 5 9 22)) -;; @result{} #1A(1 2 2 4 13) ;; shape is ((1 5)) -;;(forward-difference '#(0 1 3 5 9 22)) -;; @result{} #(1 2 2 4 13) ;; shape is ((0 4)) +;; @result{} #(1 2 2 4 13) ;;@end example (define (array-trim array . trims) - (let* ((shape (array-shape array)) - (trims (let recur ((shp shape) - (ss trims)) - (cond ((null? shp) '()) - ((null? ss) (map (lambda (x) 0) shp)) - ((integer? (car ss)) - (cons (car ss) (recur (cdr shp) (cdr ss)))) - (else - (slib:error 'array-trim 'bad 'trim (car ss))))))) - (apply make-shared-array - array - (lambda inds (map + inds trims)) - (map (lambda (spec trim) - (cond ((negative? trim) - (cons (- (car spec) trim) (cdr spec))) - ((positive? trim) - (list (car spec) (- (cadr spec) trim))) - (else spec))) - shape trims)))) + (define (loop dims trims shps) + (cond ((null? trims) + (if (null? dims) + (reverse shps) + (loop (cdr dims) + '() + (cons (list 0 (+ -1 (car dims))) shps)))) + ((null? dims) + (slib:error 'array-trim 'too 'many 'trims trims)) + ((negative? (car trims)) + (loop (cdr dims) + (cdr trims) + (cons (list 0 (+ (car trims) (car dims) -1)) shps))) + (else + (loop (cdr dims) + (cdr trims) + (cons (list (car trims) (+ -1 (car dims))) shps))))) + (apply subarray array (loop (array-dimensions array) trims '()))) diff --git a/subarray.txi b/subarray.txi index 7d62ed6..1a0545f 100644 --- a/subarray.txi +++ b/subarray.txi @@ -36,31 +36,12 @@ shared. @end example @end defun -@defun subarray0 array select @dots{} -Behaves like @r{subarray}, but @r{align}s the returned array origin to -0 @dots{}. -@end defun - -@defun array-align array coord @dots{} +@defvar subarray0 +Legacy alias for @r{subarray}. +@end defvar -Returns an array shared with @var{array} but with a different origin. The @var{coords} -are the exact integer coordinates of the new origin. Indexes -corresponding to missing or #f coordinates are not realigned. - -For example: -@example -(define ra2 (create-array '#(5) '(5 9) '(-4 0))) -(array-shape ra2) @result{} ((5 9) (-4 0)) -(array-shape (array-align ra2 0 0)) @result{} ((0 4) (0 4)) -(array-shape (array-align ra2 0)) @result{} ((0 4) (-4 0)) -(array-shape (array-align ra2)) @result{} ((5 9) (-4 0)) -(array-shape (array-align ra2 0 #f)) @result{} ((0 4) (-4 0)) -(array-shape (array-align ra2 #f 0)) @result{} ((5 9) (0 4)) -@end example -@end defun - @defun array-trim array trim @dots{} @@ -73,22 +54,15 @@ bound. For example: @example -(array-trim '#(0 1 2 3 4) 1) @result{} #1A(1 2 3 4) ;; shape is ((0 3)) -(array-trim '#(0 1 2 3 4) -1) @result{} #1A(0 1 2 3) ;; shape is ((1 4)) +(array-trim '#(0 1 2 3 4) 1) @result{} #1A(1 2 3 4) +(array-trim '#(0 1 2 3 4) -1) @result{} #1A(0 1 2 3) (require 'array-for-each) (define (centered-difference ra) - (array-map - (array-trim ra 1) (array-trim ra -1))) -(define (forward-difference ra) - (array-map - (array-trim ra 1) ra)) -(define (backward-difference ra) - (array-map - ra (array-trim ra -1))) + (array-map ra - (array-trim ra 1) (array-trim ra -1))) (centered-difference '#(0 1 3 5 9 22)) - @result{} #1A(3 4 6 17) ;;shape is ((1 4)) -(backward-difference '#(0 1 3 5 9 22)) - @result{} #1A(1 2 2 4 13) ;; shape is ((1 5)) -(forward-difference '#(0 1 3 5 9 22)) - @result{} #(1 2 2 4 13) ;; shape is ((0 4)) + @result{} #(1 2 2 4 13) @end example @end defun + @@ -14,7 +14,10 @@ (define (scheme-implementation-type) 'T) -(define (scheme-implementation-version) "3.1") +(define (scheme-implementation-version) + (string-append (number->string (quotient *T-VERSION-NUMBER* 1000)) + "." + (number->string (modulo *T-VERSION-NUMBER* 1000)))) ;;; (scheme-implementation-home-page) should return a (string) URI ;;; (Uniform Resource Identifier) for this scheme implementation's home @@ -45,35 +48,114 @@ ;;; 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. +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;;; What is this early definition doing?? +(define program-vicinity + (make-simple-switch 'program-vicinity + (lambda (x) (or (string? x) (false? x))) + '#f)) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") + ;(SLIB:LOAD-SOURCE "filename") compiled ;can load compiled files - ;(slib:load-compiled "filename") + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to -; eval ;R5RS two-argument eval -; values ;R5RS multiple values -; dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; r5rs ;conforms to +;;; eval ;R5RS two-argument eval +;;; values ;R5RS multiple values +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE -; r4rs ;conforms to +;;; r4rs ;conforms to -; ieee-p1178 ;conforms to +;;; ieee-p1178 ;conforms to r3rs ;conforms to @@ -84,36 +166,32 @@ ;-1+, <?, <=?, =?, >?, >=? object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE - transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; ieee-floating-point ;conforms to IEEE Standard 754-1985 + full-continuation ;can return multiple times +;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. -; defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures -; string-port ;has CALL-WITH-INPUT-STRING and +;;; defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures +;;; string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort +;;; sort pretty-print -; object->string +;;; object->string format ;Common-lisp output formatting trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor -; system ;posix (system <string>) -; getenv ;posix (getenv <string>) +;;; compiler ;has (COMPILER) +;;; ed ;(ED) is editor +;;; system ;posix (system <string>) +;;; getenv ;posix (getenv <string>) program-arguments ;returns list of strings (argv) -; current-time ;returns time in seconds since 1/1/1970 +;;; current-time ;returns time in seconds since 1/1/1970 ;; Implementation Specific features @@ -273,18 +351,7 @@ (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))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -308,15 +375,8 @@ (define (1- n) (+ n -1)) ;(define (-1+ n) (+ n -1)) -(define program-vicinity - (make-simple-switch 'program-vicinity - (lambda (x) (or (string? x) (false? x))) - '#f)) - -(define in-vicinity string-append) - ;;; Define SLIB:EXIT to be the implementation procedure to exit or -;;; return if exitting not supported. +;;; return if exiting not supported. (define slib:exit (lambda args (exit)) (define (string . args) (apply string-append (map char->string args))) diff --git a/timecore.scm b/timecore.scm new file mode 100644 index 0000000..4393cdd --- /dev/null +++ b/timecore.scm @@ -0,0 +1,202 @@ +;;;; "timecore.scm" Core time conversion routines +;;; Copyright (C) 1994, 1997, 2004, 2005 Aubrey Jaffer +; +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, 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 warranty or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +;;; No, it doesn't do leap seconds. + +(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) + (define tms (inexact->exact + (round (- (difftime t time:year-70) tm_gmtoff)))) + (let* ((secs (modulo tms 86400)) ; SECS/DAY + (days (+ (quotient tms 86400) ; SECS/DAY + (if (and (negative? tms) (positive? secs)) -1 0)))) + (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 (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 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) + (quotient secs 60) ; Minutes. [0-59] + tm_hour ; Hours. [0-23] + (+ tm_mday 1) ; Day. [1-31] + tm_mon ; Month. [0-11] + (- tm_year 1900) ; Year - 1900. + tm_wday ; Day of week. [0-6] + tm_yday ; Days in year. [0-365] + tm_isdst ; DST. [-1/0/1] + tm_gmtoff ; Seconds west of UTC. + tm_zone ; Timezone abbreviation. + ))))))))))) + +(define time:year-70 + (let ((t (current-time))) + (offset-time t (- (difftime t 0))))) +;@ +(define (time:invert decoder target) + (let* ((times '#(1 60 3600 86400 2678400 32140800)) + (trough ; rough time for target + (do ((i 5 (+ i -1)) + (trough time:year-70 + (offset-time trough (* (vector-ref target i) + (vector-ref times i))))) + ((negative? i) trough)))) +;;; (print 'trough trough 'target target) + (let loop ((guess trough) + (j 0) + (guess-tm (decoder trough))) +;;; (print 'guess guess 'guess-tm guess-tm) + (do ((i 5 (+ i -1)) + (rough time:year-70 + (offset-time rough (* (vector-ref guess-tm i) + (vector-ref times i)))) + (sign (let ((d (- (vector-ref target 5) + (vector-ref guess-tm 5)))) + (and (not (zero? d)) d)) + (or sign + (let ((d (- (vector-ref target i) + (vector-ref guess-tm i)))) + (and (not (zero? d)) d))))) + ((negative? i) + (let ((distance (abs (difftime trough rough)))) + (cond ((and (zero? distance) sign) +;;; (print "trying to jump") + (set! distance (if (negative? sign) -86400 86400))) + ((and sign (negative? sign)) (set! distance (- distance)))) + (set! guess (offset-time guess distance)) +;;; (print 'distance distance 'sign sign) + (cond ((zero? distance) guess) + ((> j 5) #f) ;to prevent inf loops. + (else + (loop guess + (+ 1 j) + (decoder guess)))))))))) +;@ +(define (time:gmtime tm) + (time:split tm 0 0 "GMT")) + +;;;; 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 (tzfile:transition-index time zone) + (define times (difftime time time:year-70)) + (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 (quotient (+ 1 ntrns) 2)) + (jmp (quotient (+ 1 ntrns) 4))) + (let* ((idx (max 0 (min lidx (+ -1 ntrns)))) + (idx-time (vector-ref transition-times idx))) + (cond ((<= jmp 0) + (+ idx (if (>= times idx-time) 0 -1))) + ((= times idx-time) idx) + ((and (zero? idx) (< times idx-time)) -1) + ((and (not (= idx lidx)) (not (< times idx-time))) idx) + (else + (loop ((if (< times idx-time) - +) idx jmp) + (if (= 1 jmp) 0 (quotient (+ 1 jmp) 2)))))))))) + (cdr (vector->list zone))))) +(define (tzfile:get-std-spec mode-table) + (do ((type-idx 0 (+ 1 type-idx))) + ((or (>= type-idx (vector-length mode-table)) + (not (vector-ref (vector-ref mode-table type-idx) 2))) + (if (>= type-idx (vector-length mode-table)) + (vector-ref mode-table 0) + (vector-ref mode-table type-idx))))) + +(define (tzfile:get-zone-spec time zone) + (apply + (lambda (path mode-table leap-seconds transition-times transition-types) + (let ((trans-idx (tzfile:transition-index time zone))) + (if (zero? (vector-length transition-types)) + (vector-ref mode-table 0) + (if (negative? trans-idx) + (tzfile:get-std-spec mode-table) + (vector-ref mode-table + (vector-ref transition-types trans-idx)))))) + (cdr (vector->list zone)))) diff --git a/timezone.scm b/timezone.scm index 89f85c8..2d35dd7 100644 --- a/timezone.scm +++ b/timezone.scm @@ -49,35 +49,33 @@ ;; Sat Nov 15 00:15:33 1997 Aubrey Jaffer (require 'scanf) +(require 'time-core) (require-if 'compiling 'tzfile) -;@ -(define daylight? #f) -(define *timezone* 0) -(define tzname '#("UTC" "???")) - -(define tz:default #f) ;;; This definition is here so that READ-TZFILE can verify the ;;; existence of these files before loading tzfile.scm to actually ;;; read them. (define tzfile:vicinity (make-vicinity - (if (file-exists? "/usr/share/zoneinfo/.") + (if (file-exists? "/usr/share/zoneinfo/GMT") "/usr/share/zoneinfo/" "/usr/lib/zoneinfo/"))) (define (read-tzfile path) + (define (existing path) (and (file-exists? path) path)) (let ((realpath - (cond ((not path) (in-vicinity tzfile:vicinity "localtime")) + (cond ((not path) + (or (existing (in-vicinity tzfile:vicinity "localtime")) + (existing "/etc/localtime"))) ((or (char-alphabetic? (string-ref path 0)) (char-numeric? (string-ref path 0))) (in-vicinity tzfile:vicinity path)) (else path)))) - (and (file-exists? realpath) - (let ((zone #f)) - (require 'tzfile) - (set! zone (tzfile:read realpath)) - (if zone (list->vector (cons 'tz:file zone)) - (slib:error 'read-tzfile realpath)))))) + (or (and (file-exists? realpath) + (let ((zone #f)) + (require 'tzfile) + (set! zone (tzfile:read realpath)) + (and zone (list->vector (cons 'tz:file zone))))) + (slib:error 'read-tzfile realpath)))) ;;; Parse Posix TZ string. @@ -148,117 +146,10 @@ (else #f)))) ;@ (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)))) + (cond ((vector? tz) tz) + ((or (not tz) + (eqv? #\: (string-ref tz 0))) + (let () + (require 'tzfile) + (read-tzfile (and tz (substring tz 1 (string-length tz)))))) (else (string->time-zone tz)))) - -;;; Use the timezone - -(define (tzrule->caltime year previous-gmt-offset - tr-month tr-week tr-day tr-time) - (define leap? (leap-year? year)) - (define gmmt - (time:invert time:gmtime - (vector 0 0 0 1 (if tr-month (+ -1 tr-month) 0) year #f #f 0))) - (offset-time - gmmt - (+ tr-time previous-gmt-offset - (* 3600 24 - (if tr-month - (let* ((fdow (vector-ref (time:gmtime gmmt) 6))) - (case tr-week - ((1 2 3 4) (+ (modulo (- tr-day fdow) 7) - (* 7 (+ -1 tr-week)))) - ((5) - (do ((mmax (vector-ref - (vector-ref time:days/month (if leap? 1 0)) - (+ -1 tr-month))) - (d (modulo (- tr-day fdow) 7) (+ 7 d))) - ((>= d mmax) (+ -7 d)))) - (else (slib:error 'tzrule->caltime - "week out of range" tr-week)))) - (+ tr-day - (if (and (not tr-week) (>= tr-day 60) (leap-year? year)) - 1 0))))))) -;@ -(define (tz:params caltime tz) - (case (vector-ref tz 0) - ((tz:fixed) (list 0 (vector-ref tz 3) (vector-ref tz 2))) - ((tz:rule) - (let* ((year (vector-ref (time:gmtime caltime) 5)) - (ttime0 (apply tzrule->caltime - year (vector-ref tz 4) (vector-ref tz 6))) - (ttime1 (apply tzrule->caltime - year (vector-ref tz 5) (vector-ref tz 7))) - (dst (if (and (not (negative? (difftime caltime ttime0))) - (negative? (difftime caltime ttime1))) - 1 0))) - (list dst (vector-ref tz (+ 4 dst)) (vector-ref tz (+ 2 dst))) - ;;(for-each display (list (gtime ttime0) (gtime caltime) (gtime ttime1))) - )) - ((tz:file) (let ((zone-spec (tzfile:get-zone-spec caltime tz))) - (list (if (vector-ref zone-spec 2) 1 0) - (- (vector-ref zone-spec 1)) - (vector-ref zone-spec 0)))) - (else (slib:error 'tz:params "unknown timezone type" tz)))) -;@ -(define (tz:std-offset zone) - (case (vector-ref zone 0) - ((tz:fixed) (vector-ref zone 3)) - ((tz:rule) (vector-ref zone 4)) - ((tz:file) - (let ((mode-table (vector-ref zone 2))) - (do ((type-idx 0 (+ 1 type-idx))) - ((or (>= type-idx (vector-length mode-table)) - (not (vector-ref (vector-ref mode-table type-idx) 2))) - (if (>= type-idx (vector-length mode-table)) - (vector-ref (vector-ref mode-table 0) 1) - (- (vector-ref (vector-ref mode-table type-idx) 1))))))) - (else (slib:error 'tz:std-offset "unknown timezone type" tz)))) - -;;;@ Interpret the TZ envariable. -(define (tzset . opt-tz) - (define tz (if (null? opt-tz) - (getenv "TZ") - (car opt-tz))) - (if (or (not tz:default) - (and (string? tz) (not (string-ci=? tz (vector-ref tz:default 1))))) - (set! tz:default (or (time-zone tz) '#(tz:fixed "UTC" "GMT" 0)))) - (case (vector-ref tz:default 0) - ((tz:fixed) - (set! tzname (vector (vector-ref tz:default 2) "???")) - (set! daylight? #f) - (set! *timezone* (vector-ref tz:default 3))) - ((tz:rule) - (set! tzname (vector (vector-ref tz:default 2) - (vector-ref tz:default 3))) - (set! daylight? #t) - (set! *timezone* (vector-ref tz:default 4))) - ((tz:file) - (let ((mode-table (vector-ref tz:default 2)) - (transition-types (vector-ref tz:default 5))) - (set! daylight? #f) - (set! *timezone* (vector-ref (vector-ref mode-table 0) 1)) - (set! tzname (make-vector 2 #f)) - (do ((type-idx 0 (+ 1 type-idx))) - ((>= type-idx (vector-length mode-table))) - (let ((rec (vector-ref mode-table type-idx))) - (if (vector-ref rec 2) - (set! daylight? #t) - (set! *timezone* (- (vector-ref rec 1)))))) - - (do ((transition-idx (+ -1 (vector-length transition-types)) - (+ -1 transition-idx))) - ((or (negative? transition-idx) - (and (vector-ref tzname 0) (vector-ref tzname 1)))) - (let ((rec (vector-ref mode-table - (vector-ref transition-types transition-idx)))) - (if (vector-ref rec 2) - (if (not (vector-ref tzname 1)) - (vector-set! tzname 1 (vector-ref rec 0))) - (if (not (vector-ref tzname 0)) - (vector-set! tzname 0 (vector-ref rec 0)))))))) - (else (slib:error 'tzset "unknown timezone type" tz))) - tz:default) diff --git a/top-refs.scm b/top-refs.scm index 29e25dc..3647dc4 100644 --- a/top-refs.scm +++ b/top-refs.scm @@ -74,12 +74,13 @@ (define (top-refs:include filename) (cond ((not (and (string? filename) (file-exists? filename))) (top-refs:warn 'top-refs:include 'skipping filename)) - (else (fluid-let ((*load-pathname* filename)) - (call-with-input-file filename - (lambda (port) - (do ((exp (read port) (read port))) - ((eof-object? exp)) - (top-refs:top-level exp)))))))) + (else (call-with-input-file filename + (lambda (port) + (with-load-pathname filename + (lambda () + (do ((exp (read port) (read port))) + ((eof-object? exp)) + (top-refs:top-level exp))))))))) (define (top-refs:top-level exp) (cond ((not (and (pair? exp) (list? exp))) @@ -238,7 +239,7 @@ ;;@dots{} (info) indexes of @1. The identifiers have the case that ;;the implementation's @code{read} uses for symbols. Identifiers ;;containing spaces (eg. @code{close-base on base-table}) are -;;@emph{not} included. +;;@emph{not} included. #f is returned if the index is not found. ;; ;;Each info index is headed by a @samp{* Menu:} line. To list the ;;symbols in the first and third info indexes do: @@ -266,20 +267,23 @@ (do ((line (read-line port) (read-line port))) ((or (eof-object? line) (not (and (> (string-length line) 5) - (string=? "* " (substring line 0 2))))) + (or (string=? "* " (substring line 0 2)) + (substring? "(line " line))))) (loop (read-line port) (+ 1 iidx) (cdr ndxs))) - (let ((<n> (substring? " <" line))) - (define csi (or (and <n> - (> (string-length line) (+ 3 <n>)) - (string-index - "0123456789" - (string-ref line (+ 2 <n>))) - <n>) - (substring? ": " line))) - (and - csi - (let ((str (substring line 2 csi))) - (if (and (not (substring? " " str)) - (not (memq (string-ci->symbol str) exports))) - (set! exports (cons (string-ci->symbol str) exports)))))))) + (and + (string=? "* " (substring line 0 2)) + (let ((<n> (substring? " <" line))) + (define csi (or (and <n> + (> (string-length line) (+ 3 <n>)) + (string-index + "0123456789" + (string-ref line (+ 2 <n>))) + <n>) + (substring? ": " line))) + (and + csi + (let ((str (substring line 2 csi))) + (if (and (not (substring? " " str)) + (not (memq (string-ci->symbol str) exports))) + (set! exports (cons (string-ci->symbol str) exports))))))))) (else (loop (read-line port) (+ 1 iidx) ndxs)))))))) diff --git a/top-refs.txi b/top-refs.txi index 11944bb..dd231c8 100644 --- a/top-refs.txi +++ b/top-refs.txi @@ -18,6 +18,7 @@ Returns a list of the top-level variables referenced by the Scheme expression @var{obj}. @end defun + @defun top-refs<-file filename @var{filename} should be a string naming an existing file containing Scheme @@ -33,6 +34,7 @@ constant or composed of combinations of vicinity functions and string literal constants; and the resulting file exists (possibly with ".scm" appended). @end defun + @noindent The following function parses an @dfn{Info} Index. @cindex Info @@ -54,7 +56,7 @@ info -f slib2d6.info -n "Index" -o slib-index.info @dots{} (info) indexes of @var{file}. The identifiers have the case that the implementation's @code{read} uses for symbols. Identifiers containing spaces (eg. @code{close-base on base-table}) are -@emph{not} included. +@emph{not} included. #f is returned if the index is not found. Each info index is headed by a @samp{* Menu:} line. To list the symbols in the first and third info indexes do: @@ -63,3 +65,4 @@ symbols in the first and third info indexes do: (exports<-info-index "slib.info" 1 3) @end example @end defun + @@ -50,8 +50,8 @@ (eq? eq?) (+ +) (zero? zero?) (modulo modulo) (apply apply) (display display) (qpn qpn) (list list) (cons cons) - (CALL (string->symbol "CALL")) - (RETN (string->symbol "RETN"))) + (CALL 'CALL) ;(string->symbol "CALL") + (RETN 'RETN)) ;(string->symbol "RETN") (lambda (how function . optname) (set! trace:indent 0) (let ((name (if (null? optname) function (car optname)))) diff --git a/transact.scm b/transact.scm index 59a06fe..83b37a7 100644 --- a/transact.scm +++ b/transact.scm @@ -90,7 +90,7 @@ "~$" (substring file (min 2 (max 0 (- filen 10))) filen))))) (define (word-lock:certificate lockpath) - (define iport (open-file lockpath "rb")) + (define iport (and (file-exists? lockpath) (open-file lockpath 'rb))) (and iport (call-with-open-ports @@ -143,7 +143,7 @@ (cond ((and conflict (substring? "-> " conflict)) => (lambda (idx) (substring conflict (+ 3 idx) (string-length conflict)))) - (conflict (slib:error 'bad 'emacs 'lock lockpath conflict)) + ((and conflict (not (equal? conflict ""))) (slib:error 'bad 'emacs 'lock lockpath conflict)) (else #f))) (define (file-lock:certificate path) @@ -165,13 +165,13 @@ (define at (substring? "@" email)) (let ((user (substring email 0 at)) (hostname (substring email (+ 1 at) (string-length email))) - (oport (open-file lockpath "wb"))) + (oport (open-file lockpath 'wb))) (define userlen (string-length user)) (and oport (call-with-open-ports oport (lambda (oport) (define pos 1) (define (nulls cnt) - (display (make-bytes cnt 0) oport) + (write-bytes (make-bytes cnt 0) cnt oport) (set! pos (+ cnt pos))) (define (write-field field) (define len (string-length field)) @@ -227,7 +227,8 @@ (case (software-type) ((UNIX COHERENT PLAN9) ;; file-system may not support symbolic links. - (or (emacs:lock! path email) wl)) + (or (and (provided? 'current-time) (emacs:lock! path email)) + wl)) (else wl))))) ;;@body @@ -434,7 +435,7 @@ (sscanf line " Workstation Domain %s" workgroup) (sscanf line " Workgroup %s" workgroup) (sscanf line " User name %s" user))))))) - + (and netdir (not (and user hostname)) (set! netdir (string-append netdir "\\system.ini")) (file-exists? netdir) diff --git a/transact.txi b/transact.txi index 5e3ff8f..4dec378 100644 --- a/transact.txi +++ b/transact.txi @@ -55,6 +55,7 @@ Returns the string @samp{@var{user}@@@var{hostname}} associated with the lock owner of file @var{path} if locked; and #f otherwise. @end defun + @deffn {Procedure} file-lock! path email @@ -69,6 +70,7 @@ unlocked, then @code{file-lock!} returns the certificate string associated with new lock for file @var{path}. @end deffn + @deffn {Procedure} file-unlock! path certificate @var{path} must be a string naming the file to be unlocked. @var{certificate} must be the @@ -78,6 +80,7 @@ If @var{path} is locked with @var{certificate}, then @code{file-unlock!} removes @samp{#t}. Otherwise, @code{file-unlock!} leaves the file system unaltered and returns @samp{#f}. @end deffn + @subsubheading File Transactions @@ -104,6 +107,7 @@ the string "@var{path}.bak" @end table @end defun + @defun transact-file-replacement proc path backup-style certificate @@ -140,6 +144,7 @@ returns a string, then @var{path} is renamed to it. Finally, the temporary file is renamed @var{path}. @code{transact-file-replacement} returns #t if @var{path} was successfully replaced; and #f otherwise. @end defun + @subsubheading Identification @@ -148,3 +153,4 @@ Finally, the temporary file is renamed @var{path}. @code{user-email-address} returns a string of the form @samp{username@r{@@}hostname}. If this e-mail address cannot be obtained, #f is returned. @end defun + @@ -31,6 +31,7 @@ Examples: @end lisp @end defun + @defun copy-tree tree Makes a copy of the nested list structure @var{tree} using new pairs and @@ -46,3 +47,4 @@ Example: @result{} #f @end lisp @end defun + @@ -51,3 +51,4 @@ tie or his belt.) @code{tsort} gives the correct order of dressing: (socks undershorts pants shoes watch shirt belt tie jacket) @end example @end defun + @@ -1,5 +1,5 @@ ; "tzfile.scm", Read sysV style (binary) timezone file. -; Copyright (c) 1997 Aubrey Jaffer +; Copyright (C) 1997 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -36,7 +36,6 @@ (if (eof-object? c) c (if (zero? (char->integer c)) #f #t)))) ;@ (define (tzfile:read path) - (define null (integer->char 0)) (call-with-open-ports (open-file path 'rb) (lambda (port) @@ -69,7 +68,7 @@ (abbrevs (do ((ra (make-bytes charcnt 0)) (idx 0 (+ 1 idx))) ((>= idx charcnt) ra) - (string-set! ra idx (read-char port)))) + (byte-set! ra idx (read-byte 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))) @@ -90,49 +89,9 @@ (let ((rec (vector-ref mode-table idx))) (vector-set! rec 0 (let loop ((pos (vector-ref rec 0))) - (cond ((>= pos (string-length abbrevs)) + (cond ((>= pos (bytes-length abbrevs)) (slib:warn 'tzfile:read "format error" abbrevs) #f) - ((char=? null (string-ref abbrevs pos)) + ((zero? (byte-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 (quotient (+ 1 ntrns) 2)) - (jmp (quotient (+ 1 ntrns) 4))) - (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 (quotient (+ 1 jmp) 2)))))))))) - (cdr (vector->list zone))))) - -(define (tzfile:get-std-spec mode-table) - (do ((type-idx 0 (+ 1 type-idx))) - ((or (>= type-idx (vector-length mode-table)) - (not (vector-ref (vector-ref mode-table type-idx) 2))) - (if (>= type-idx (vector-length mode-table)) - (vector-ref mode-table 0) - (vector-ref mode-table type-idx))))) -;@ -(define (tzfile:get-zone-spec time zone) - (apply - (lambda (path mode-table leap-seconds transition-times transition-types) - (let* ((trans-idx (tzfile:transition-index time zone))) - (if (zero? (vector-length transition-types)) - (vector-ref mode-table 0) - (if (negative? trans-idx) - (tzfile:get-std-spec mode-table) - (vector-ref mode-table - (vector-ref transition-types trans-idx)))))) - (cdr (vector->list zone)))) diff --git a/umbscheme.init b/umbscheme.init index 605878c..9794d80 100644 --- a/umbscheme.init +++ b/umbscheme.init @@ -54,62 +54,149 @@ ;;; directory, the directory which typically contains files which ;;; customize a computer environment for a user. (define (home-vicinity) "") - -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") -; r4rs ;conforms to -; r3rs ;conforms to + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 + + ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. + + r5rs ;conforms to +;;; eval ;SLIB:EVAL is single argument eval +;;; values ;R5RS multiple values +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros + delay ;has DELAY and FORCE + multiarg-apply ;APPLY can take more than 2 args. + char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. + rationalize + transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE + +;;; r4rs ;conforms to + ieee-p1178 ;conforms to -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; 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!, + +;;; r3rs ;conforms to + +;;; 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-TO-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 +;;; object-hash ;has OBJECT-HASH + full-continuation ;can return multiple times -; object-hash ;has OBJECT-HASH - -; sort -; pretty-print -; object->string -; format -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor + ieee-floating-point ;conforms to IEEE Standard 754-1985 + ;IEEE Standard for Binary + ;Floating-Point Arithmetic. + + ;; Other common features + +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. + defmacro ;has Common Lisp DEFMACRO +;;; record ;has user defined data structures +;;; string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING +;;; sort +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; getenv ;posix (getenv <string>) +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + )) ;;; (OUTPUT-PORT-WIDTH <port>) @@ -220,18 +307,7 @@ (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))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -261,10 +337,8 @@ ;(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. +;;; return if exiting not supported. (define slib:exit (lambda args #f)) ;;; Here for backward compatability @@ -207,10 +207,10 @@ (if idx-at (substring authority (+ 1 idx-at) (string-length authority)) authority)) - (idx-: (string-index hostport #\:)) - (host (if idx-: (substring hostport 0 idx-:) hostport)) - (port (and idx-: - (substring hostport (+ 1 idx-:) (string-length hostport))))) + (cdx (string-index hostport #\:)) + (host (if cdx (substring hostport 0 cdx) hostport)) + (port (and cdx + (substring hostport (+ 1 cdx) (string-length hostport))))) (if (or userinfo port) (list userinfo host (or (string->number port) port)) host))) @@ -269,10 +269,10 @@ uri))) (if front (let* ((len (string-length front)) - (idx-: (string-index front #\:)) - (scheme (and idx-: (substring front 0 idx-:))) - (path (if idx-: - (substring front (+ 1 idx-:) len) + (cdx (string-index front #\:)) + (scheme (and cdx (substring front 0 cdx))) + (path (if cdx + (substring front (+ 1 cdx) len) front))) (cond ((eqv? 0 (substring? "//" path)) (set! len (string-length path)) @@ -22,11 +22,13 @@ described in RFC 2396. Returns a Uniform Resource Identifier string from component arguments. @end defun + @defun uri:make-path path Returns a URI string combining the components of list @var{path}. @end defun + @defun html:anchor name Returns a string which defines this location in the (HTML) file as @var{name}. The hypertext @samp{<A HREF="#@var{name}">} will link to this point. @@ -38,6 +40,7 @@ as @var{name}. The hypertext @samp{<A HREF="#@var{name}">} will link to this po @end example @end defun + @defun html:link uri highlighted Returns a string which links the @var{highlighted} text to @var{uri}. @@ -48,17 +51,20 @@ Returns a string which links the @var{highlighted} text to @var{uri}. @end example @end defun + @defun html:base uri Returns a string specifying the @dfn{base} @var{uri} of a document, for @cindex base inclusion in the HEAD of the document (@pxref{HTML, head}). @end defun + @defun html:isindex prompt Returns a string specifying the search @var{prompt} of a document, for inclusion in the HEAD of the document (@pxref{HTML, head}). @end defun + @defun uri->tree uri-reference base-tree @@ -87,17 +93,20 @@ string. @end example @end defun + @defun uri:split-fields txt chr Returns a list of @var{txt} split at each occurrence of @var{chr}. @var{chr} does not appear in the returned list of strings. @end defun + @defun uri:decode-query query-string Converts a @dfn{URI} encoded @var{query-string} to a query-alist. @cindex URI @end defun + @noindent @code{uric:} prefixes indicate procedures dealing with URI-components. @@ -110,17 +119,20 @@ Returns a copy of the string @var{uri-component} in which all @dfn{unsafe} octet @code{uric:decode} decodes strings encoded by @code{uric:encode}. @end defun + @defun uric:decode uri-component Returns a copy of the string @var{uri-component} in which each @samp{%} escaped characters in @var{uri-component} is replaced with the character it encodes. This routine is useful for showing URI contents on error pages. @end defun + @defun uri:path->keys path-list ptypes @var{path-list} is a path-list as returned by @code{uri:split-fields}. @code{uri:path->keys} returns a list of items returned by @code{uri:decode-path}, coerced to types @var{ptypes}. @end defun + @subheading File-system Locators and Predicates @@ -128,6 +140,7 @@ to types @var{ptypes}. Returns a URI-string for @var{path} on the local host. @end defun + @defun absolute-uri? str Returns #t if @var{str} is an absolute-URI as indicated by a syntactically valid (per RFC 2396) @dfn{scheme}; otherwise returns @@ -135,20 +148,24 @@ syntactically valid (per RFC 2396) @dfn{scheme}; otherwise returns #f. @end defun + @defun absolute-path? file-name Returns #t if @var{file-name} is a fully specified pathname (does not depend on the current working directory); otherwise returns #f. @end defun + @defun null-directory? str Returns #t if changing directory to @var{str} would leave the current directory unchanged; otherwise returns #f. @end defun + @defun glob-pattern? str Returns #t if the string @var{str} contains characters used for specifying glob patterns, namely @samp{*}, @samp{?}, or @samp{[}. @end defun + @noindent Before RFC 2396, the @dfn{File Transfer Protocol} (FTP) served a @cindex File Transfer Protocol @@ -176,3 +193,4 @@ remote-site remote-directory @end enumerate @end defun + diff --git a/version.txi b/version.txi index 647e5b6..5d88497 100644 --- a/version.txi +++ b/version.txi @@ -1,2 +1,2 @@ -@set SLIBVERSION 3a1 -@set SLIBDATE November 2003 +@set SLIBVERSION 3a2 +@set SLIBDATE June 2005 @@ -26,36 +26,35 @@ (define r4rs-symbols '(* + - -> / < <= = => > >= ... abs acos and angle append apply asin - assoc assq assv atan begin boolean? caaaar caaadr caaar caadar caaddr - caadr caar cadaar cadadr cadar caddar cadddr caddr cadr + assoc assq assv atan begin boolean? caaaar caaadr caaar caadar + caaddr caadr caar cadaar cadadr cadar caddar cadddr caddr cadr call-with-current-continuation call-with-input-file - call-with-output-file car case cdaaar cdaadr cdaar cdadar cdaddr cdadr - cdar cddaar cddadr cddar cdddar cddddr cdddr cddr cdr ceiling - char->integer char-alphabetic? char-ci<=? char-ci<? char-ci=? - char-ci>=? char-ci>? char-downcase char-lower-case? char-numeric? - char-ready? char-upcase char-upper-case? char-whitespace? char<=? - char<? char=? char>=? char>? char? close-input-port - close-output-port complex? cond cons cos current-input-port - current-output-port define denominator display do else eof-object? - eq? equal? eqv? even? exact->inexact exact? exp expt floor - for-each force gcd if imag-part implementation-vicinity in-vicinity - inexact->exact inexact? input-port? integer->char integer? lambda - lcm length let let* letrec library-vicinity list list->string - list->vector list-ref list-tail list? load log magnitude make-polar - make-rectangular make-string make-vector make-vicinity map max member - memq memv min modulo negative? newline not null? number->string - number? numerator odd? open-input-file open-output-file or - output-port? pair? peek-char positive? procedure? quasiquote - quotient rational? rationalize read read-char real-part real? - remainder reverse round set! set-car! set-cdr! sin sqrt string - string->list string->number string->symbol string-append string-ci<=? - string-ci<? string-ci=? string-ci>=? string-ci>? string-copy - string-fill! string-length string-ref string-set! string<=? - string<? string=? string>=? string>? string? sub-vicinity - substring symbol->string symbol? tan transcript-off transcript-on - truncate unquote unquote-splicing user-vicinity vector vector->list - vector-fill! vector-length vector-ref vector-set! vector? - with-input-from-file with-output-to-file write write-char zero? )) + call-with-output-file car case cdaaar cdaadr cdaar cdadar cdaddr + cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr cdr + ceiling char->integer char-alphabetic? char-ci<=? char-ci<? + char-ci=? char-ci>=? char-ci>? char-downcase char-lower-case? + char-numeric? char-ready? char-upcase char-upper-case? + char-whitespace? char<=? char<? char=? char>=? char>? char? + close-input-port close-output-port complex? cond cons cos + current-input-port current-output-port define display do else + eof-object? eq? equal? eqv? even? exact->inexact exact? exp expt + floor for-each gcd if imag-part implementation-vicinity + in-vicinity inexact->exact inexact? input-port? integer->char + integer? lambda lcm length let let* letrec library-vicinity list + list-ref list->string list->vector list? load log magnitude + make-polar make-rectangular make-string make-vector + make-vicinity map max member memq memv min modulo negative? + newline not null? number->string number? odd? open-input-file + open-output-file or output-port? pair? peek-char positive? + procedure? quasiquote quotient rational? read read-char + real-part real? remainder reverse round set! set-car! set-cdr! + sin sqrt string string->list string->number string->symbol + string-append string-ci<=? string-ci<? string-ci=? string-ci>=? + string-ci>? string-length string-ref string-set! string<=? + string<? string=? string>=? string>? string? sub-vicinity + substring symbol->string symbol? tan truncate unquote + unquote-splicing user-vicinity vector vector->list vector-length + vector-ref vector-set! vector? write write-char zero? )) (define (path<-entry entry) (define (findit path) @@ -130,10 +129,10 @@ (set! cur (+ 1 objl cur)))))) lst))) -;;@body +;;@args file1 @dots{} ;;Using the procedures in the @code{top-refs} and @code{manifest} -;;modules, @0 analyzes each SLIB module, reporting about any -;;procedure or macro defined whether it is: +;;modules, @0 analyzes each SLIB module and @1, @dots{}, reporting +;;about any procedure or macro defined whether it is: ;; ;;@table @asis ;; @@ -159,7 +158,10 @@ ;;never-executed branches, transitive require assumptions, spelling ;;errors, undocumented procedures, missing procedures, and cyclic ;;dependencies in SLIB. -(define (vet-slib) +;; +;;The optional arguments @1, @dots{} provide a simple way to vet +;;prospective SLIB modules. +(define (vet-slib . files) (define infos (exports<-info-index (in-vicinity (library-vicinity) "slib.info") 1 2)) (define r4rs+slib #f) @@ -203,16 +205,20 @@ (show missings 'missing) ))))) (set! r4rs+slib (union r4rs-symbols slib-exports)) - (for-each (lambda (entry) - (set! export-alist - (cons (cons (car entry) - (feature->exports (car entry) slib:catalog)) - export-alist))) - slib:catalog) - (for-each (lambda (entry) - (define path (path<-entry entry)) - (and path (dopath path))) - slib:catalog) + (let ((catalog + (append (map (lambda (file) (cons (string->symbol file) file)) + files) + slib:catalog))) + (for-each (lambda (entry) + (set! export-alist + (cons (cons (car entry) + (feature->exports (car entry) slib:catalog)) + export-alist))) + catalog) + (for-each (lambda (entry) + (define path (path<-entry entry)) + (and path (dopath path))) + catalog)) (write '("SLIB")) (show (set-difference infos (union r4rs+slib all-exports)) 'documented-unexports)) @@ -2,11 +2,11 @@ @ftindex vet -@defun vet-slib +@defun vet-slib file1 @dots{} Using the procedures in the @code{top-refs} and @code{manifest} -modules, @code{vet-slib} analyzes each SLIB module, reporting about any -procedure or macro defined whether it is: +modules, @code{vet-slib} analyzes each SLIB module and @var{file1}, @dots{}, reporting +about any procedure or macro defined whether it is: @table @asis @@ -32,4 +32,8 @@ This straightforward analysis caught three full days worth of never-executed branches, transitive require assumptions, spelling errors, undocumented procedures, missing procedures, and cyclic dependencies in SLIB. + +The optional arguments @var{file1}, @dots{} provide a simple way to vet +prospective SLIB modules. @end defun + @@ -86,75 +86,148 @@ home (string-append home "/"))) (else home))))) +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((VMS) "[.]") + (else ""))) -;;; *FEATURES* should be set to a list of symbols describing features -;;; of this implementation. Suggestions for features are: +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((AMIGA) '(#\: #\/)) + ((MACOS THINKC) '(#\:)) + ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) + ((NOSVE) '(#\: #\.)) + ((UNIX COHERENT PLAN9) '(#\/)) + ((VMS) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((VMS) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((NOSVE) ".") + ((MACOS THINKC) ":") + ((MS-DOS WINDOWS ATARIST OS/2) "\\") + ((UNIX COHERENT PLAN9 AMIGA) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity <pathname>) <pathname>) +;@ +(define with-load-pathname + (let ((exchange + (lambda (new) + (let ((old *load-pathname*)) + (set! *load-pathname* new) + old)))) + (lambda (path thunk) + (let* ((old (exchange path)) + (val (thunk))) + (exchange old) + val)))) + +;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. (define *features* '( source ;can load scheme source files - ;(slib:load-source "filename") -; compiled ;can load compiled files - ;(slib:load-compiled "filename") - + ;(SLIB:LOAD-SOURCE "filename") +;;; compiled ;can load compiled files + ;(SLIB:LOAD-COMPILED "filename") + vicinity + srfi-59 ;; Scheme report features + ;; R5RS-compliant implementations should provide all 9 features. -; r5rs ;conforms to -; eval ;R5RS 2-argument eval +;;; r5rs ;conforms to +;;; eval ;R5RS two-argument eval values ;R5RS multiple values -; dynamic-wind ;R5RS dynamic-wind -; macro ;R5RS high level macros +;;; dynamic-wind ;R5RS dynamic-wind +;;; macro ;R5RS high level macros delay ;has DELAY and FORCE multiarg-apply ;APPLY can take more than 2 args. -; char-ready? +;;; char-ready? + rev4-optional-procedures ;LIST-TAIL, STRING-COPY, + ;STRING-FILL!, and VECTOR-FILL! + + ;; These four features are optional in both R4RS and R5RS + + multiarg/and- ;/ and - can take more than 2 args. rationalize - rev4-optional-procedures ;LIST-TAIL, STRING->LIST, - ;LIST->STRING, STRING-COPY, - ;STRING-FILL!, LIST->VECTOR, - ;VECTOR->LIST, and VECTOR-FILL! +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-TO-FILE r4rs ;conforms to ieee-p1178 ;conforms to -; r3rs ;conforms to +;;; r3rs ;conforms to -; rev2-procedures ;SUBSTRING-MOVE-LEFT!, +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? -; object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH - multiarg/and- ;/ and - can take more than 2 args. - with-file ;has WITH-INPUT-FROM-FILE and - ;WITH-OUTPUT-TO-FILE -; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + full-continuation ;can return multiple times ieee-floating-point ;conforms to IEEE Standard 754-1985 ;IEEE Standard for Binary ;Floating-Point Arithmetic. - full-continuation ;can return multiple times ;; Other common features -; srfi ;srfi-0, COND-EXPAND finds all srfi-* -; sicp ;runs code from Structure and +;;; srfi ;srfi-0, COND-EXPAND finds all srfi-* +;;; sicp ;runs code from Structure and ;Interpretation of Computer ;Programs by Abelson and Sussman. defmacro ;has Common Lisp DEFMACRO -; record ;has user defined data structures +;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING -; sort -; pretty-print +;;; sort +;;; pretty-print object->string -; format ;Common-lisp output formatting -; trace ;has macros: TRACE and UNTRACE -; compiler ;has (COMPILER) -; ed ;(ED) is editor +;;; format ;Common-lisp output formatting +;;; 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) -; current-time ;returns time in seconds since 1/1/1970 +;;; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + )) ;;; (OBJECT->STRING obj) -- analogous to WRITE @@ -349,18 +422,7 @@ (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))))) +;; slib:eval-load definition moved to "require.scm" (define slib:warn (lambda args @@ -389,10 +451,8 @@ (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. +;;; return if exiting not supported. (define slib:exit (lambda args (cond ((null? args) (quit)) @@ -63,21 +63,6 @@ ;; ;;(declare (usual-integrations)) -(define error: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. ;;; @@ -369,11 +354,11 @@ (if (or (< index 0) (>= index bound) (not (fix:fixnum? index))) - (error:bad-range-argument index 'node/index) + (slib:error 'bad-range-argument index 'node/index) (loop node index)))) (define (error:empty owner) - (error:error "Operation requires non-empty tree:" owner)) + (slib:error "Operation requires non-empty tree:" owner)) (define (local:make-wt-tree-type key<?) @@ -567,7 +552,7 @@ ((pair? alist) (loop (cdr alist) (node/add node (caar alist) (cdar alist)))) (else - (error:wrong-type-argument alist "alist" 'alist->tree)))) + (slib:error 'wrong-type-argument alist "alist" 'alist->tree)))) (%make-wt-tree my-type (loop alist empty))) (define (tree/get tree key default) @@ -607,18 +592,20 @@ (define (guarantee-tree tree procedure) (if (not (wt-tree? tree)) - (error:wrong-type-argument tree "weight-balanced tree" procedure))) + (slib:error 'wrong-type-argument + tree "weight-balanced tree" procedure))) (define (guarantee-tree-type type procedure) (if (not (tree-type? type)) - (error:wrong-type-argument type "weight-balanced tree type" procedure))) + (slib:error 'wrong-type-argument + type "weight-balanced tree type" procedure))) (define (guarantee-compatible-trees tree1 tree2 procedure) (guarantee-tree tree1 procedure) (guarantee-tree tree2 procedure) (if (not (eq? (tree/type tree1) (tree/type tree2))) - (error:error "The trees" tree1 'and tree2 'have 'incompatible 'types - (tree/type tree1) 'and (tree/type tree2)))) + (slib:error "The trees" tree1 'and tree2 'have 'incompatible 'types + (tree/type tree1) 'and (tree/type tree2)))) ;;;______________________________________________________________________ ;;; |