diff options
| -rw-r--r-- | ANNOUNCE | 230 | ||||
| -rw-r--r-- | ChangeLog | 248 | ||||
| -rw-r--r-- | DrScheme.init | 412 | ||||
| -rw-r--r-- | FAQ | 12 | ||||
| -rw-r--r-- | Makefile | 99 | ||||
| -rw-r--r-- | README | 3 | ||||
| -rw-r--r-- | RScheme.init | 14 | ||||
| -rw-r--r-- | STk.init | 17 | ||||
| -rw-r--r-- | Template.scm | 21 | ||||
| -rw-r--r-- | array.scm | 81 | ||||
| -rw-r--r-- | bigloo.init | 44 | ||||
| -rw-r--r-- | byte.scm | 31 | ||||
| -rw-r--r-- | byte.txi | 29 | ||||
| -rw-r--r-- | chez.init | 19 | ||||
| -rw-r--r-- | clrnamdb.scm | 2 | ||||
| -rw-r--r-- | dft.scm | 195 | ||||
| -rw-r--r-- | dft.txi | 90 | ||||
| -rw-r--r-- | elk.init | 31 | ||||
| -rw-r--r-- | fdl.texi | 455 | ||||
| -rw-r--r-- | fft.scm | 94 | ||||
| -rw-r--r-- | fft.txi | 34 | ||||
| -rw-r--r-- | gambit.init | 14 | ||||
| -rw-r--r-- | getopt.scm | 2 | ||||
| -rw-r--r-- | getparam.scm | 2 | ||||
| -rw-r--r-- | grapheps.ps | 18 | ||||
| -rw-r--r-- | grapheps.scm | 18 | ||||
| -rw-r--r-- | grapheps.txi | 12 | ||||
| -rw-r--r-- | guile.init | 114 | ||||
| -rw-r--r-- | http-cgi.scm | 4 | ||||
| -rw-r--r-- | indexes.texi | 27 | ||||
| -rw-r--r-- | jscheme.init | 14 | ||||
| -rw-r--r-- | macscheme.init | 15 | ||||
| -rw-r--r-- | math-integer.scm | 102 | ||||
| -rw-r--r-- | math-integer.txi | 38 | ||||
| -rw-r--r-- | math-real.scm | 91 | ||||
| -rw-r--r-- | mitscheme.init | 22 | ||||
| -rw-r--r-- | mkclrnam.scm | 2 | ||||
| -rw-r--r-- | mklibcat.scm | 220 | ||||
| -rw-r--r-- | modular.scm | 178 | ||||
| -rw-r--r-- | modular.txi | 56 | ||||
| -rw-r--r-- | peanosfc.scm | 78 | ||||
| -rw-r--r-- | plottest.scm | 46 | ||||
| -rw-r--r-- | pnm.scm | 3 | ||||
| -rw-r--r-- | prec.scm | 14 | ||||
| -rw-r--r-- | printf.scm | 14 | ||||
| -rw-r--r-- | pscheme.init | 194 | ||||
| -rw-r--r-- | qp.scm | 8 | ||||
| -rw-r--r-- | require.scm | 46 | ||||
| -rw-r--r-- | root.scm | 37 | ||||
| -rw-r--r-- | scheme2c.init | 23 | ||||
| -rw-r--r-- | scheme48.init | 118 | ||||
| -rw-r--r-- | schmooz.scm | 4 | ||||
| -rw-r--r-- | scsh.init | 14 | ||||
| -rw-r--r-- | simetrix.scm | 6 | ||||
| -rw-r--r-- | slib.1 | 2 | ||||
| -rw-r--r-- | slib.doc | 2 | ||||
| -rw-r--r-- | slib.info | 2463 | ||||
| -rw-r--r-- | slib.spec | 13 | ||||
| -rw-r--r-- | slib.texi | 498 | ||||
| -rw-r--r-- | solid.scm | 58 | ||||
| -rw-r--r-- | solid.txi | 20 | ||||
| -rw-r--r-- | sort.scm | 76 | ||||
| -rw-r--r-- | srfi-1.scm | 4 | ||||
| -rw-r--r-- | srfi-23.scm | 1 | ||||
| -rw-r--r-- | strcase.scm | 5 | ||||
| -rw-r--r-- | subarray.scm | 21 | ||||
| -rw-r--r-- | subarray.txi | 12 | ||||
| -rw-r--r-- | t3.init | 14 | ||||
| -rw-r--r-- | top-refs.scm | 2 | ||||
| -rw-r--r-- | trace.scm | 4 | ||||
| -rw-r--r-- | tzfile.scm | 2 | ||||
| -rw-r--r-- | umbscheme.init | 14 | ||||
| -rw-r--r-- | version.txi | 4 | ||||
| -rw-r--r-- | vet.scm | 6 | ||||
| -rw-r--r-- | vscm.init | 16 |
75 files changed, 4705 insertions, 2247 deletions
@@ -1,107 +1,175 @@ -This message announces the availability of Scheme Library release slib3a3. +This message announces the availability of Scheme Library release slib3a4. SLIB is a portable Scheme library providing compatibiliy and utility functions for all standard Scheme implementations. -SLIB supports the Bigloo, Chez, DrScheme, ELK, GAMBIT, Jscheme, -MacScheme, MITScheme, PocketScheme, RScheme, Scheme->C, Scheme48, SCM, -SCSH, T3.1, UMB-Scheme, and VSCM implementations. +SLIB supports Bigloo, Chez, ELK 3.0, GAMBIT 3.0, Guile, JScheme, +MacScheme, MITScheme, PLT Scheme (DrScheme and MzScheme), Pocket +Scheme, RScheme, scheme->C, Scheme48, SCM, SCM Mac, scsh, Stk, T3.1, +umb-scheme, and VSCM. SLIB is free software. It has a Permissive-Non-Warranty license -(http://www.swiss.ai.mit.edu/~jaffer/SLIB_COPYING.txt). +(http://swiss.csail.mit.edu/~jaffer/SLIB_COPYING.txt). Documentation and distributions in several formats are linked from SLIB's home page: - http://swissnet.ai.mit.edu/~jaffer/SLIB.html + http://swiss.csail.mit.edu/~jaffer/SLIB.html Links to distributions of SLIB and related softwares are at the end of this message. -=-=- -slib3a3 news: - -Multi-dimensional linear interpolation and resampling of arrays are -added. Case-folding of symbols is removed from SLIB. It should work -with implementations which are case-sensitive when reading symbols. - - * grapheps.scm (graph:plot): Plot multiple traces from array. - (functions->array): Generalizes graph:plot-function. - - * root.scm (integer-sqrt): Changed to algorithm attributed to - Bradley Lucier by Steve VanDevender. - * slib.texi (Root Finding): integer-sqrt changed to floor of sqrt. - - * linterp.scm (interpolate-array-ref, resample-array!): Added. - - * bytenumb.scm (bytes->ieee-float, bytes->ieee-double) - (ieee-float->bytes, ieee-double->bytes): Fixed for -0.0. - * bytenumb.scm (ieee-float->bytes, ieee-double->bytes): Handle 0/0 - in srfi-70 arithmetic. - - * guile.init (slib:load, slib:load-from-path): Adapted patch from - Thomas Bushnell BSG for loading into SLIB module. - * guile.init (home-vicinity): Check for getenv first. - (*features*): Fixed array, system, etc. - (system->line): Fixed return status (thanks to Rob Browning). - (guile:wrap-case-insensitive): Removed; sources now case clean. - * guile.init (system->line): Added features line-i/o and hash. - (implementation-vicinity): Fixed to parent directory of ice-9. - * guile.init (sub-vicinity): Downcased software-type symbols. - - * dirs.scm, transact.scm, batch.scm, prec.scm, - Template.scm, *.init: Downcased all software-type symbols. - * require.scm, mklibcat.scm, mkclrnam.scm, alistab.scm, Makefile: - Downcased *slib-version* symbol. - - * top-refs.scm (top-refs:expression): Check for lists before - walking CASE and COND clauses (srfi-61.scm macro broke it). - - * http-cgi.scm (query-alist->parameter-list): Fixed order of nary - fields. - * http-cgi.scm (http:status-line): Changed to HTTP-1.0; works - better in MS-Windows. - * db2html.scm (command:make-editable-table): Boolean "arity". - - * peanosfc.scm (peano-coordinates->natural) - (natural->peano-coordinates): Non-negative versions. - * phil-spc.scm (hilbert-coordinates->integer): nbits calculation - was missing (incorrectly used rank). - (bitwise-laminate, bitwise-delaminate): Removed unused functions. - - * slib.texi (SRFI): Added table mapping SRFI to feature. - (Scheme Syntax Extension Packages): Moved most SRFIs here. - * srfi.scm: Removed comments about copyright. - * mklibcat.scm (and-let*, receive, define-record-type) - (guarded-cond-clause): Added aliases for srfi-2, srfi-8, srfi-9, - and srfi-61. - * Makefile (srfiles): Most srfi-* moved from txiscms. - (srfiles): Added srfi-61. - - * slib.spec: Updated from RedHat version from Jindrich Novy. - * slib.spec (%post): Commented out install-info. - * slib.spec (install): Make slib executable. - * slib.spec: Fixed for rpmbuild version 4.3.1 - * Makefile (rpm): Program name changed to rpmbuild. - -From: Ivan Shmakov - * srfi-61.scm (cond): Added extension. +slib3a4 news: + ++ Discreet Fourier Transforms of any rank. + ++ Added SRFI-94 and SRFI-23 + +From Ivan Shmakov + + * scheme48.init (file-exists?): Much simplified. + +From Kevin Ryde + + * guile.init: Fixed line-i/o in Guile >= 1.8. + + * srfi-1.scm (reduce-right): Was infinite loop. + +From Ben Goetter + + * pscheme.init: Revised for Pscheme 1.3. + +From Aubrey Jaffer + + * dft.scm (dft, dft-1): Added routines which use the best method + for decimating each dimension. + (dft:dft): Call 1d transform only with contiguous arrays. + (sft, sft-1, fft, fft-1): Added optional array-prototype argument. + (sft, sft-1): Slow Fourier transforms added. + (dft:sft1d!, dft:fft1d!): Flipped polarity of exponent to agree + with http://en.wikipedia.org/wiki/Discrete_Fourier_transform. + Generalized to any positive rank. + Renamed from "fft.scm". + + * slib.texi (Sorting): Updated; cleaned up. + (Sorting): Added optional KEY arguments. + * sort.scm (merge!): Fixed. + (sort!): Swap pairs so that list returned EQ? to argument. + (sort, sort!, sorted?, merge, merge!): Added optional KEY argument. + + * tzfile.scm (tzfile:read): Use subbytes instead of subarray. + * byte.scm (subbytes): Added. + (subbytes-read!, subbytes-write): Renamed from substring-... + + * slib.texi (Irrational Real Functions) + (Irrational Integer Functions): Sections added. + * math-integer.scm, math-real.scm: Added SRFI-94. + + * slib.texi (Feature): Indexed number-system attribute features. + * require.scm: Tightened number-system attribute features. + + * modular.scm (modular:characteristic, modular:+): Recoded so `-' + has no more than 2 arguments. + (mod, rem): Removed. + (modular:characteristic): Renamed from modulus->integer. + (modular:expt): Handle base = modulus - 1. Corrected documentation. + + * srfi-23.scm (error): Added. + + * simetrix.scm (SI:unit-infos): Updated u and eV to CODATA-2002. + + * peanosfc.scm (peano-coordinates->integer) + (integer->peano-coordinates): Fixed; were broken for rank != 2. + + * subarray.scm (subarray): Handle reverse index ranges. + + * pnm.scm (pnm:array-write): Don't lose comments when recursing. + + * slib.spec (%files): Added man1/slib.1.gz. + + * grapheps.ps (sign): Cleaner than inline code. + (setup-plot): Now handles decreasing axes. + * grapheps.scm (plot): Handle list of lists data. + + * root.scm (integer-sqrt): Streamlined. + (secant:find-root-1): Fixed internal argument mismatch + for number-of-iterations case. + + * getopt.scm (*argv*): Removed (define *argv* *argv*). + + * solid.scm (solid:prism, solid:lumber): Added. + + * array.scm (make-shared-array): Work for rank-0 arrays. + (equal?): Compare element-by-element of two arrays. + (make-array): Return string or vector even if prototype is a + strict array. + (make-array): Return simple string or vector if possible. + + * strcase.scm (symbol-append): Work with case-sensitive or + case-insensitive symbols. + + * Makefile (dvi, pdf): New tetex-3.0(-20.FC5) broke them -- fixed. + (docs): Added target to make all documentation files and invoke xdvi. + (texifiles): Added fdl.texi. + (S48LIB): Renamed from LIB. + (S48SLIB): Subdirectory of implementation-vicinity. + (install48): Make $(S48SLIB) directory and files. + + * indexes.texi (Index): Removed "Full Table of Contents". + * slib.texi (SRFI): Added @ftindex entries for SRFIs. + Converted to @copying and GNU Free Documentation License. + + * mklibcat.scm: Change all slib files to `source'. + + * require.scm (catalog:get): Handle (home-vicinity) being false. + (catalog:get): mklibcat is `source'. + (require): Don't provide `new-catalog'. + + * *.init, Template.scm, require.scm (slib:features): Renamed from + *features* to avoid conflict with Guile identifier. + + * vscm.init, umbscheme.init, Template.scm, t3.init, STk.init, + scsh.init, scheme2c.init, RScheme.init, mitscheme.init, + macscheme.init, jscheme.init, gambit.init, elk.init, + DrScheme.init, chez.init, bigloo.init (slib:error): Capture + `error' identifier (to survive redefinition). + + * elk.init (slib:error): Removed bad insertion. + + * bigloo.init (slib:features): Lacks object-hash. + (slib:load): Fixed suffix lossage. + (slib:features): Removed object->string and rationalize. + + * guile.init (char-code-limit): Reduced to workaround string + ordering bug. + (system, delete-file, open-file, make-array): Changed + from define to set! to eliminate guile-1.8.0 warning: + WARNING: (guile-user): imported module (ice-9 slib) overrides core binding + (defined?, in-vicinity, port?, 1+, -1+, 1-): Removed + definitions duplicating Guile defines. + (*features*): Set, rather than define. + (browse-url): Added. + + * scheme48.init: (slib:load-compiled): Loads a native SRFI module. + Create "implcat" and new-catalog with native SRFI modules. + (slib-primitives): Removed s48-modulo and s48-atan. -=-=- SLIB is available from: - http://swissnet.ai.mit.edu/ftpdir/scm/slib3a3.zip - http://swissnet.ai.mit.edu/ftpdir/scm/slib-3a3-1.noarch.rpm - swissnet.ai.mit.edu:/pub/scm/slib3a3.zip - swissnet.ai.mit.edu:/pub/scm/slib-3a3-1.noarch.rpm + http://swiss.csail.mit.edu/ftpdir/scm/slib3a4.zip + http://swiss.csail.mit.edu/ftpdir/scm/slib-3a4-1.noarch.rpm + swiss.csail.mit.edu:/pub/scm/slib3a4.zip + swiss.csail.mit.edu:/pub/scm/slib-3a4-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 - swissnet.ai.mit.edu:/pub/scm/slib-psd1-3.tar.gz + http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz + swiss.csail.mit.edu:/pub/scm/slib-psd1-3.tar.gz SCHELOG is an embedding of Prolog in Scheme+SLIB: - http://www.cs.rice.edu/CS/PLT/packages/schelog/ + http://www.ccs.neu.edu/home/dorai/schelog/schelog.html Programs for printing and viewing TexInfo documentation (which SLIB has) come with GNU Emacs or can be obtained via ftp from: - ftp.gnu.org:pub/gnu/texinfo/texinfo-4.0.tar.gz + ftp://ftp.gnu.org/pub/gnu/texinfo/texinfo-4.8.tar.gz @@ -1,3 +1,251 @@ +2006-10-21 Aubrey Jaffer <jaffer@aubrey.jaffer> + + * require.scm (*slib-version*): Bumped from 3a3 to 3a4. + +2006-10-21 Aubrey Jaffer <agj@alum.mit.edu> + + * grapheps.scm (plot): Handle list of lists data. + +2006-10-13 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Sorting): Updated; cleaned up. + + * sort.scm (merge!): Fixed. + (sort!): Swap pairs so that list returned EQ? to argument. + +2006-10-11 Aubrey Jaffer <ajaffer@clearmethods.com> + + * slib.texi (Sorting): Added optional KEY arguments. + + * sort.scm (sort, sort!, sorted?, merge, merge!): Added optional + KEY argument. + +2006-09-26 Aubrey Jaffer <agj@alum.mit.edu> + + * dft.scm (dft, dft-1): Added routines which use the best method + for decimating each dimension. + (dft:dft): Call 1d transform only with contiguous arrays. + (dft:dft): Tested and fixed for ranks 1 to 3. + +2006-09-21 Aubrey Jaffer <agj@alum.mit.edu> + + * dft.scm (dft:check-dimensions): Abstracted from fft and fft-1. + +2006-09-19 Aubrey Jaffer <agj@alum.mit.edu> + + * tzfile.scm (tzfile:read): Use subbytes instead of subarray. + + * byte.scm (subbytes): Added. + (subbytes-read!, subbytes-write): Renamed from substring-... + +2006-09-17 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (txiscms): Aded math-integer. + (afiles): Added math-real. + + * slib.texi (Irrational Real Functions) + (Irrational Integer Functions): Sections added. + + * math-integer.scm, math-real.scm: Added. + +2006-09-15 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Feature): Indexed number-system attribute features. + + * require.scm: Tightened number-system attribute features. + +2006-09-14 Aubrey Jaffer <agj@alum.mit.edu> + + * indexes.texi (Index): Removed "Full Table of Contents". + + * slib.texi (SRFI): Added @ftindex entries. + +2006-09-13 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (SRFI): Added @ftindex entries for SRFIs. + + * vscm.init, umbscheme.init, Template.scm, t3.init, STk.init, + scsh.init, scheme2c.init, RScheme.init, mitscheme.init, + macscheme.init, jscheme.init, gambit.init, elk.init, + DrScheme.init, chez.init, bigloo.init (slib:error): Capture + `error' identifier (to survive redefinition). + + * srfi-23.scm (error): File added. + + * elk.init (slib:error): Removed bad insertion. + +2006-09-12 Aubrey Jaffer <agj@alum.mit.edu> + + * peanosfc.scm (peano-coordinates->integer) + (integer->peano-coordinates): Fixed; were broken for rank != 2. + +2006-09-10 Aubrey Jaffer <agj@alum.mit.edu> + + * root.scm (integer-sqrt): Streamlined. + +2006-09-05 Aubrey Jaffer <agj@alum.mit.edu> + + * dft.scm (sft, sft-1, fft, fft-1): Added optional array-prototype + argument. + + * subarray.scm (subarray): Handle reverse index ranges. + +2006-09-04 Aubrey Jaffer <agj@alum.mit.edu> + + * pnm.scm (pnm:array-write): Don't lose comments when recursing. + + * dft.scm (sft, sft-1): Slow Fourier transforms added. + (dft:sft1d!, dft:fft1d!): Flipped polarity of exponent to agree + with http://en.wikipedia.org/wiki/Discrete_Fourier_transform. + + * dft.scm: Renamed from "fft.scm". + +2006-09-03 Aubrey Jaffer <agj@alum.mit.edu> + + * fft.scm (fft:dft): Generalized to any positive rank. + +2006-09-02 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.spec (%files): Added man1/slib.1.gz. + +2006-08-13 Aubrey Jaffer <agj@alum.mit.edu> + + * grapheps.ps (sign): Cleaner than inline code. + +2006-08-10 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (dvi, pdf): New tetex-3.0(-20.FC5) broke them -- fixed. + +2006-08-01 Aubrey Jaffer <agj@alum.mit.edu> + + * grapheps.ps (setup-plot): Now handles decreasing axes. + +2006-07-24 Aubrey Jaffer <agj@alum.mit.edu> + + * grapheps.scm (rule-horizontal): Corrected documentation. + +2006-07-10 Aubrey Jaffer <agj@alum.mit.edu> + + * root.scm (secant:find-root-1): Fixed internal argument mismatch + for number-of-iterations case. + +2006-06-25 Aubrey Jaffer <agj@alum.mit.edu> + + * bigloo.init (slib:features): Lacks object-hash. + +2006-06-02 Aubrey Jaffer <agj@alum.mit.edu> + + * getopt.scm (*argv*): Removed (define *argv* *argv*). + +2006-05-21 Aubrey Jaffer <agj@alum.mit.edu> + + * solid.scm (solid:prism, solid:lumber): Added. + +2006-05-16 Aubrey Jaffer <agj@alum.mit.edu> + + * array.scm (make-shared-array): Work for rank-0 arrays. + (equal?): Compare element-by-element of two arrays. + (make-array): Return string or vector even if prototype is a + strict array. + +2006-05-15 Aubrey Jaffer <agj@alum.mit.edu> + + * array.scm (make-array): Return simple string or vector if + possible. + +2006-05-14 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi: Converted to @copying and GNU Free Documentation + License. + + * Makefile (docs): Added target to make all documentation files + and invoke xdvi. + (texifiles): Added fdl.texi. + +2006-05-13 Aubrey Jaffer <agj@alum.mit.edu> + + * bigloo.init (slib:load): Fixed suffix lossage. + (slib:features): Removed object->string and rationalize. + + * strcase.scm (symbol-append): Work with case-sensitive or + case-insensitive symbols. + +2006-05-01 Ivan Shmakov + + * scheme48.init (file-exists?): Much simplified. + +2006-04-23 Kevin Ryde + + * guile.init: Fixed line-i/o in Guile >= 1.8. + + * srfi-1.scm (reduce-right): Was infinite loop. + +2006-04-19 Aubrey Jaffer <agj@alum.mit.edu> + + * *.init, Template.scm, require.scm (slib:features): Renamed from + *features* to avoid conflict with Guile identifier. + +2006-04-15 Aubrey Jaffer <agj@alum.mit.edu> + + * Makefile (S48LIB): Renamed from LIB. + (S48SLIB): Subdirectory of implementation-vicinity. + (install48): Make $(S48SLIB) directory and files. + +2006-04-05 Ben Goetter + + * pscheme.init: Revised for Pscheme 1.3. + +2006-04-03 Aubrey Jaffer <agj@alum.mit.edu> + + * simetrix.scm (SI:unit-infos): Updated u and eV to CODATA-2002. + +2006-03-27 Aubrey Jaffer <agj@alum.mit.edu> + + * require.scm (catalog:get): Handle (home-vicinity) being false. + +2006-03-21 Aubrey Jaffer <agj@alum.mit.edu> + + * scheme48.init: (slib:load-compiled): Loads a native SRFI module. + Create "implcat" and new-catalog with native SRFI modules. + +2006-03-19 Aubrey Jaffer <agj@alum.mit.edu> + + * modular.scm (modular:characteristic, modular:+): Recoded so `-' + has no more than 2 arguments. + +2006-03-18 Aubrey Jaffer <agj@alum.mit.edu> + + * scheme48.init (slib-primitives): Removed s48-modulo and + s48-atan. + + * guile.init (char-code-limit): Reduced to workaround string + ordering bug. + +2006-03-17 Aubrey Jaffer <agj@alum.mit.edu> + + * guile.init (system, delete-file, open-file, make-array): Changed + from define to set! to eliminate guile-1.8.0 warning: + WARNING: (guile-user): imported module (ice-9 slib) overrides core binding + +2006-03-16 Aubrey Jaffer <agj@alum.mit.edu> + + * guile.init (defined?, in-vicinity, port?, 1+, -1+, 1-): Removed + definitions duplicating Guile defines. + (*features*): Set, rather than define. + (browse-url): Added. + + * require.scm (catalog:get): mklibcat is `source'. + (require): Don't provide `new-catalog'. + + * mklibcat.scm: Change all slib files to `source'. + +2006-03-01 Aubrey Jaffer <agj@alum.mit.edu> + + * modular.scm (mod, rem): Removed. + (modular:characteristic): Renamed from modulus->integer. + (modular:expt): Handle base = modulus - 1. + Corrected documentation. + 2006-02-13 Aubrey Jaffer <jaffer@aubrey> * require.scm (*slib-version*): Bumped from 3a2 to 3a3. diff --git a/DrScheme.init b/DrScheme.init index ca4ec17..c18ea18 100644 --- a/DrScheme.init +++ b/DrScheme.init @@ -1,27 +1,85 @@ ;;;"DrScheme.init" Initialization for SLIB for DrScheme -*-scheme-*- -;;; Author: Aubrey Jaffer -;;; ;;; 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. - -;@ +;;@ (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)])) + +;;@ (scheme-implementation-type) should return the name of the scheme +;;; implementation loading this file. +(define (scheme-implementation-type) '|MzScheme|) + +;;@ (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.plt-scheme.org/") + +;;@ (scheme-implementation-version) should return a string describing +;;; the version the scheme implementation loading this file. +(define scheme-implementation-version version) + +;;@ (implementation-vicinity) should be defined to be the pathname of +;;; the directory where any auxillary files to your Scheme +;;; implementation reside. +(define implementation-vicinity + (let ([path + (or (getenv "PLTHOME") + (with-handlers ([void (lambda (x) #f)]) + (let ([p (collection-path "mzlib")]) + (let*-values ([(base name dir?) (split-path p)] + [(base name dir?) (split-path base)]) + (and (path? base) (path->string base))))) + (case (system-type) + ((unix macosx) "/usr/local/lib/plt") + ((windows) "C:\\Program Files\\PLT") + ((macos) "My Disk:plt:")))]) + (lambda () path))) + +;;@ (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") + ;; Try an slib collection first + (with-handlers ([void (lambda (x) #f)]) + (path->string (collection-path "slib"))) + ;; look for slib in a few common places + (ormap (lambda (dir) + (and (directory-exists? dir) dir)) + '("/usr/local/lib/slib/" + "/usr/share/slib" + ;; this is for RH/Fedora that uses umb-scheme for slib + ;;"/usr/share/umb-scheme/slib" + )) + (error 'slib-init + "can't find SCHEME_LIBRARY_PATH environment variable, \"slib\" collection, or a system slib directory")))) + (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) + (path->string (find-system-path 'home-dir))) ;@ -(define in-vicinity string-append) +(define in-vicinity + (lambda args + (path->string + (let loop ([args args]) + (cond + [(null? (cdr args)) (car args)] + [(string=? "" (car args)) (loop (cdr args))] + [else (let ([v (loop (cdr args))]) + (build-path (car args) v))]))))) ;@ (define (user-vicinity) - (case (software-type) - ((vms) "[.]") - (else ""))) - -(define *load-pathname* #f) + (path->string (build-path 'same))) ;@ (define vicinity:suffix? (let ((suffi @@ -43,53 +101,232 @@ ((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"))) + (path->string + (or (current-load-relative-directory) + (current-directory)))) ;@ (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*)))))) + (lambda (vic name) + (path->string (build-path vic name)))) ;@ (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))))))) + (lambda (a thunk) (thunk))) + +;;; slib:features should be set to a list of symbols describing +;;; features of this implementation. Suggestions for features are: + +(define slib:features + '( + source ;can load scheme source files + ;(slib:load-source "filename") + compiled ;can load compiled files + ;(slib:load-compiled "filename") + rev4-report ;conforms to +;;; rev3-report ;conforms to +;;; ieee-p1178 ;conforms to +;;; sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. + rev4-optional-procedures ;LIST-TAIL, STRING->LIST, + ;LIST->STRING, STRING-COPY, + ;STRING-FILL!, LIST->VECTOR, + ;VECTOR->LIST, and VECTOR-FILL! +;;; rev2-procedures ;SUBSTRING-MOVE-LEFT!, + ;SUBSTRING-MOVE-RIGHT!, + ;SUBSTRING-FILL!, + ;STRING-NULL?, APPEND!, 1+, + ;-1+, <?, <=?, =?, >?, >=? + multiarg/and- ;/ and - can take more than 2 args. + multiarg-apply ;APPLY can take more than 2 args. + rationalize + delay ;has DELAY and FORCE + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-FROM-FILE + string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING +;;; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF + char-ready? + macro ;has R4RS high level macros + defmacro ;has Common Lisp DEFMACRO + eval ;SLIB:EVAL is single argument eval +;;; record ;has user defined data structures + values ;proposed multiple values + dynamic-wind ;proposed dynamic-wind + ieee-floating-point ;conforms to + full-continuation ;can return multiple times +;;; object-hash ;has OBJECT-HASH + +;;; sort +;;; queue ;queues + pretty-print +;;; object->string +;;; format +;;; trace ;has macros: TRACE and UNTRACE +;;; compiler ;has (COMPILER) +;;; ed ;(ED) is editor + system ;posix (system <string>) + getenv ;posix (getenv <string>) + program-arguments ;returns list of strings (argv) +;;; Xwindows ;X support +;;; curses ;screen management package +;;; termcap ;terminal description package +;;; terminfo ;sysV terminal description + fluid-let + srfi-59 + vicinity + current-time ;returns time in seconds since 1/1/1970 + )) +;@ +(define program-arguments + (lambda () + (vector->list (current-command-line-arguments)))) + +(require (lib "pretty.ss")) +(unless (memq (system-type) '(unix beos)) + (namespace-require '(lib "date.ss"))) +;@ +(define current-time + ;; Gives time since 1/1/1970 ... + ;; ... GMT for Unix, Windows, and Mac OS X. + ;; ... local time for Mac OS. + (if (memq (system-type) '(unix macosx windows)) + current-seconds + (let ([zero (find-seconds 0 0 0 1 1 1970)]) + (lambda () + (- (current-seconds) zero))))) + +;;@ (OUTPUT-PORT-WIDTH <port>) +(define (output-port-width . arg) 79) + +;;@ (OUTPUT-PORT-HEIGHT <port>) +(define (output-port-height . arg) 24) + +;;; (CURRENT-ERROR-PORT) +;; Already in MzScheme + +;;@ (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>) +;; Already in MzScheme + +;;; (DELETE-FILE <string>) +;; Already in MzScheme + +;;@ 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. +(define call-with-input-string + (lambda (string thunk) + (parameterize ((current-input-port (open-input-string string))) + (thunk (current-input-port))))) +(define call-with-output-string + (lambda (receiver) + (let ((sp (open-output-string))) + (receiver sp) + (get-output-string sp)))) + +;;; "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 256) + +;;@ MOST-POSITIVE-FIXNUM is used in modular.scm +(define most-positive-fixnum #x3FFFFFFF) ; 30 bits on 32-bit machines +; (define most-positive-fixnum #x3FFFFFFFFFFFFFFF) ; 62 bits on 64-bit machines + +;;@ 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 *defmacros* + (list (cons 'defmacro + (lambda (name parms . body) + `(set! *defmacros* (cons (cons ',name (lambda ,parms ,@body)) + *defmacros*)))))) +;@ +(define (defmacro? m) (and (assq m *defmacros*) #t)) +;@ +(define (macroexpand-1 e) + (if (pair? e) + (let ((a (car e))) + (cond ((symbol? a) (set! a (assq a *defmacros*)) + (if a (apply (cdr a) (cdr e)) e)) + (else e))) + e)) +;@ +(define (macroexpand e) + (if (pair? e) + (let ((a (car e))) + (cond ((symbol? a) + (set! a (assq a *defmacros*)) + (if a (macroexpand (apply (cdr a) (cdr e))) e)) + (else e))) + e)) +;@ +(define gentemp + (let ((*gensym-counter* -1)) + (lambda () + (set! *gensym-counter* (+ *gensym-counter* 1)) + (string->symbol + (string-append "slib:G" (number->string *gensym-counter*)))))) +(define base:eval slib:eval) +;@ +(define (defmacro:eval x) (base:eval (defmacro:expand* x))) +(define (defmacro:expand* x) + (slib: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 #\space cep) (write x cep)) args) + (newline cep)))) + +;;@ define an error procedure for the library +(define slib:error + (let ((error error)) + (lambda args + (let ((cep (current-error-port))) + (if (provided? 'trace) (print-call-stack cep)) + (apply error "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 (port? obj) (or (input-port? obj) (output-port? obj))) +;@ (define (call-with-open-ports . ports) (define proc (car ports)) (cond ((procedure? proc) (set! ports (cdr ports))) @@ -99,13 +336,14 @@ (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(" ")'") @@ -113,30 +351,70 @@ (try "netscape '" "'&") (try "netscape '" "'"))) -(cond ((string<? (version) "200") - (require-library "init.ss" "slibinit")) - (else - (load (build-path (collection-path "slibinit") "init.ss")) - (eval '(require (lib "defmacro.ss"))) - (slib:provide 'defmacro))) +;;@ define these as appropriate for your system. +(define slib:tab (integer->char 9)) +(define slib:form-feed (integer->char 12)) -(provide 'vicinity) -(provide 'srfi-59) +;;@ 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) -;;;The rest corrects mistakes in -;;;/usr/local/lib/plt/collects/slibinit/init.ss: +;;@ Define these if your implementation's syntax can support it and if +;;; they are not already defined. +(define 1+ add1) +(define -1+ sub1) +(define 1- -1+) -(provide 'fluid-let) +;;@ Define SLIB:EXIT to be the implementation procedure to exit or +;;; return if exiting not supported. +(define slib:exit exit) -(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) - (newline cep)))) +;;@ Here for backward compatability +(define scheme-file-suffix + (let ((suffix (case (software-type) + ((nosve) "_scm") + (else ".scm")))) + (lambda () suffix))) -(define call-with-input-string - (lambda (string thunk) - (parameterize ((current-input-port (open-input-string string))) - (thunk (current-input-port))))) +(define (ensure-path-string p) + (if (path? p) (path->string p) p)) + +;;@ (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 (ensure-path-string 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 f) + (load (string-append (ensure-path-string f) ".zo"))) + +;;@ At this point SLIB:LOAD must be able to load SLIB files. +(define slib:load slib:load-source) + +(require (rename mzscheme mz:require require)) + +(slib:load (in-vicinity (library-vicinity) "require")) + +;;; Hack `require' to work with both SLIB and MzScheme: +(define slib:require require) +(define-syntax (require stx) + (syntax-case stx (quote) + [_ + (identifier? stx) + #'slib:require] + [(_ (quote something)) + #'(slib:require (quote something))] + [(_ req ...) + (if (eq? 'top-level (syntax-local-context)) + #'(mz:require req ...) + #'(slib:require req ...))])) + +;;; Previously loaded "/usr/local/lib/plt/collects/slibinit/init.ss" +(cond ((string<? (version) "200") + (require-library "init.ss" "slibinit")) + (else + ;; (load (build-path (collection-path "slibinit") "init.ss")) + (eval '(require (lib "defmacro.ss"))))) @@ -1,5 +1,5 @@ -FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib3a3). -Written by Aubrey Jaffer (http://swissnet.ai.mit.edu/~jaffer). +FAQ (Frequently Asked Questions and answers) for SLIB Scheme Library (slib3a4). +Written by Aubrey Jaffer (http://swiss.csail.mit.edu/~jaffer). INTRODUCTION AND GENERAL INFORMATION @@ -21,9 +21,9 @@ Scheme48, SCM, SCM Mac, scsh, Stk, T3.1, umb-scheme, and VSCM. [] How can I obtain SLIB? SLIB is available via http from: - http://swissnet.ai.mit.edu/~jaffer/SLIB.html + http://swiss.csail.mit.edu/~jaffer/SLIB.html SLIB is available via ftp from: - swissnet.ai.mit.edu:/pub/scm/ + swiss.csail.mit.edu:/pub/scm/ [] How do I install SLIB? @@ -46,9 +46,9 @@ Several times a year. [] What is the latest version? -The version as of this writing is slib3a3. The latest documentation +The version as of this writing is slib3a4. The latest documentation is available online at: - http://swissnet.ai.mit.edu/~jaffer/SLIB.html + http://swiss.csail.mit.edu/~jaffer/SLIB.html [] Which version am I using? @@ -16,10 +16,10 @@ srcdir.mk: .. Makefile #srcdir=$(HOME)/slib/ include srcdir.mk -VERSION = 3a3 -RELEASE = 2 +VERSION = 3a4 +RELEASE = 1 -rpm_prefix=/usr/src/redhat/ +rpm_prefix=$(HOME)/rpmbuild/ prefix = /usr/local/ exec_prefix = $(prefix) # directory where `make install' will put executable. @@ -34,17 +34,17 @@ infodir = $(prefix)info/ PREVDOCS = prevdocs/ htmldir=../public_html/ -dvidir=../dvi/ RUNNABLE = scheme48 S48INIT = scheme48.init -LIB = $(libdir)$(RUNNABLE)/ +S48LIB = $(libdir)$(RUNNABLE)/ +S48SLIB = $(S48LIB)slib/ VM = scheme48vm IMAGE48 = slib.image INSTALL_DATA = install -c -$(LIB)slibcat: - touch $(LIB)slibcat +$(S48LIB)slibcat: + touch $(S48LIB)slibcat catalogs: -if type scm; then scm -c "(require 'new-catalog)"; fi @@ -69,16 +69,43 @@ clrnamdb.scm: mkclrnam.scm color.scm resenecolours.txt saturate.txt nbs-iscc.tx echo "$(MKNMDB)" | mzscheme -f DrScheme.init;\ fi +$(S48SLIB)strport.scm: + test -d $(S48SLIB) || mkdir $(S48SLIB) + echo ";;; strport.scm -*- scheme -*-">$(S48SLIB)strport.scm + echo ";@">>$(S48SLIB)strport.scm + echo "(define (call-with-output-string proc)">>$(S48SLIB)strport.scm + echo " (let ((port (make-string-output-port)))">>$(S48SLIB)strport.scm + echo " (proc port)">>$(S48SLIB)strport.scm + echo " (string-output-port-output port)))">>$(S48SLIB)strport.scm + echo "(define (call-with-input-string string proc)">>$(S48SLIB)strport.scm + echo " (proc (make-string-input-port string)))">>$(S48SLIB)strport.scm + +$(S48SLIB)record.scm: + test -d $(S48SLIB) || mkdir $(S48SLIB) + echo ";;; record.scm -*- scheme -*-">$(S48SLIB)record.scm + echo ";; This code is in the public domain">>$(S48SLIB)record.scm + echo ";@">>$(S48SLIB)record.scm + echo "(define make-record-type make-record-type)">>$(S48SLIB)record.scm + echo "(define record-constructor">>$(S48SLIB)record.scm + echo " (let ((constructor record-constructor))">>$(S48SLIB)record.scm + echo " (lambda (rt . fields)">>$(S48SLIB)record.scm + echo " (constructor rt (if (pair? fields)">>$(S48SLIB)record.scm + echo " (car fields)">>$(S48SLIB)record.scm + echo " (record-type-field-names rt))))))">>$(S48SLIB)record.scm + echo "(define record-predicate record-predicate)">>$(S48SLIB)record.scm + echo "(define record-accessor record-accessor)">>$(S48SLIB)record.scm + echo "(define record-modifier record-modifier)">>$(S48SLIB)record.scm + 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;\ + S48_VICINITY="$(S48LIB)";export S48_VICINITY;\ SCHEME_LIBRARY_PATH="`pwd`/";export SCHEME_LIBRARY_PATH;\ $(RUNNABLE) < $(S48INIT) -install48: $(IMAGE48) - $(INSTALL_DATA) $(IMAGE48) $(LIB) +install48: $(IMAGE48) $(S48SLIB)strport.scm $(S48SLIB)record.scm + $(INSTALL_DATA) $(IMAGE48) $(S48LIB) (echo '#! /bin/sh';\ - echo exec $(RUNNABLE) -i '$(LIB)$(IMAGE48)' \"\$$\@\") \ + echo exec $(RUNNABLE) -i '$(S48LIB)$(IMAGE48)' \"\$$\@\") \ > $(bindir)slib48 chmod +x $(bindir)slib48 @@ -91,13 +118,14 @@ 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 limit.scm \ - timecore.scm psxtime.scm cltime.scm timezone.scm tzfile.scm + timecore.scm psxtime.scm cltime.scm timezone.scm tzfile.scm \ + math-real.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 scafiles = scainit.scm scaglob.scm scamacr.scm scaoutp.scm scaexpp.scm \ structure.scm -srfiles = srfi-2.scm srfi-8.scm srfi-9.scm srfi-61.scm +srfiles = srfi-2.scm srfi-8.scm srfi-9.scm srfi-23.scm srfi-61.scm efiles = record.scm dynamic.scm process.scm hash.scm \ wttree.scm wttest.scm sierpinski.scm soundex.scm simetrix.scm rfiles = rdms.scm alistab.scm paramlst.scm \ @@ -111,26 +139,27 @@ txiscms =grapheps.scm glob.scm getparam.scm \ alist.scm ratize.scm modular.scm dirs.scm priorque.scm queue.scm\ srfi.scm srfi-1.scm\ pnm.scm http-cgi.scm htmlform.scm html4each.scm db2html.scm uri.scm\ - fft.scm solid.scm random.scm randinex.scm obj2str.scm ncbi-dna.scm\ + dft.scm solid.scm random.scm randinex.scm obj2str.scm ncbi-dna.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\ - peanosfc.scm linterp.scm + peanosfc.scm linterp.scm math-integer.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\ srfi.txi srfi-1.txi\ pnm.txi http-cgi.txi htmlform.txi html4each.txi db2html.txi uri.txi\ - fft.txi solid.txi random.txi randinex.txi obj2str.txi ncbi-dna.txi\ + dft.txi solid.txi random.txi randinex.txi obj2str.txi ncbi-dna.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\ - peanosfc.txi linterp.txi + peanosfc.txi linterp.txi math-integer.txi % = `echo $(txiscms) | sed 's%.scm%.txi%g'` -texifiles = schmooz.texi indexes.texi object.texi format.texi limit.texi +texifiles = schmooz.texi indexes.texi object.texi format.texi limit.texi \ + fdl.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 \ @@ -139,7 +168,7 @@ ifiles = bigloo.init chez.init elk.init macscheme.init mitscheme.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 jscheme.init -tfiles = plottest.scm macrotst.scm dwindtst.scm formatst.scm +tfiles = 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) \ @@ -159,7 +188,7 @@ install: pinstall clrnamdb.scm 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 + echo "S48_VICINITY=\"$(S48LIB)\";export S48_VICINITY" >> $(bindir)slib cat slib.sh >> $(bindir)slib chmod +x $(bindir)slib @@ -193,24 +222,22 @@ collectx.scm: collect.scm macwork.scm 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) $(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);TEXINPUTS=$(srcdir):;export TEXINPUTS;tex $(srcdir)slib.texi \ +dvi: slib.dvi +slib.dvi: version.txi slib.texi $(txifiles) $(texifiles) + texi2dvi -b -c $(srcdir)slib.texi +slib.fn: + tex $(srcdir)slib.texi \ $(srcdir)schmooz.texi -xdvi: $(dvidir)slib.dvi - xdvi -s 3 $(dvidir)slib.dvi +xdvi: slib.dvi + xdvi -s 4 slib.dvi pdf: $(htmldir)slib.pdf -$(htmldir)slib.pdf: version.txi slib.texi $(dvidir)slib.fn $(txifiles) $(texifiles) -# cd $(dvidir);dvipdf slib.dvi # doesn't have links! - cd $(dvidir);TEXINPUTS=$(srcdir):;export TEXINPUTS;pdftex $(srcdir)slib.texi - mv $(dvidir)slib.pdf $(htmldir) +$(htmldir)slib.pdf: version.txi slib.texi $(txifiles) $(texifiles) +# dvipdf slib.dvi # doesn't have links! + texi2pdf -b -c $(srcdir)slib.texi + mv slib.pdf $(htmldir) xpdf: $(htmldir)slib.pdf - xpdf -z 3 $(htmldir)slib.pdf + xpdf $(htmldir)slib.pdf TEXI2HTML = /usr/local/bin/texi2html -split -verbose slib_toc.html: version.txi slib.texi $(txifiles) $(texifiles) @@ -240,6 +267,10 @@ installinfoz: $(infodir)slib.info.gz $(infodir)slib.info.gz: $(infodir)slib.info gzip -f $(infodir)slib.info +docs: $(infodir)slib.info.gz $(htmldir)slib_toc.html slib.dvi \ + $(htmldir)slib.pdf slib.doc + xdvi -s 4 slib.dvi + makedev = make -f $(HOME)/makefile.dev CHPAT=$(HOME)/bin/chpat RSYNC=rsync --rsync-path=bin/rsync -bav @@ -1,4 +1,4 @@ -This directory contains the distribution of Scheme Library slib3a3. +This directory contains the distribution of Scheme Library slib3a4. 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. @@ -82,7 +82,6 @@ The maintainer can be reached at agj @ alum.mit.edu. `grapheps.scm' has procedures for creating PostScript graphs. `grapheps.ps' is PostScript runtime support for creating graphs. `matfile.scm' reads MAT-File Format version 4 (MATLAB). - `plottest.scm' has code to test charplot.scm. `solid.scm' has VRML97 solid-modeling. `colorspc.scm' has CIE and sRGB color transforms. `colornam.scm' has color-name database functions. diff --git a/RScheme.init b/RScheme.init index 292b963..544bca1 100644 --- a/RScheme.init +++ b/RScheme.init @@ -134,9 +134,9 @@ (exchange old) val)))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -331,12 +331,14 @@ (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 #\space cep) (write x cep)) args)))) ;;; define an error procedure for the library -(define (slib:error msg . args) - (if (provided? 'trace) (print-call-stack (current-error-port))) - (error "~a ~j" msg args)) +(define slib:error + (let ((error error)) + (lambda (msg . args) + (if (provided? 'trace) (print-call-stack (current-error-port))) + (error "~a ~j" msg args)))) ;;; define these as appropriate for your system. (define slib:tab (integer->char 9)) @@ -116,9 +116,9 @@ thunk (lambda () (exchange old))))))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -289,13 +289,16 @@ (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 #\space 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))) - (error (apply string-append (map (lambda (x) (format #f " ~a" x)) args)))) - +(define slib:error + (let ((error error)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (error + (apply string-append + (map (lambda (x) (format #f " ~a" x)) args)))))) ;;; define these as appropriate for your system. (define slib:tab (integer->char 9)) diff --git a/Template.scm b/Template.scm index d24f984..74fb7ea 100644 --- a/Template.scm +++ b/Template.scm @@ -1,4 +1,4 @@ -;;; "Template.scm" configuration template of *features* for Scheme -*-scheme-*- +;;; "Template.scm" configuration template of slib:features for Scheme -*-scheme-*- ;;; Author: Aubrey Jaffer ;;; ;;; This code is in the public domain. @@ -127,9 +127,9 @@ thunk (lambda () (exchange old))))))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -293,7 +293,7 @@ (define (defmacro:eval x) (base:eval (defmacro:expand* x))) (define (defmacro:expand* x) - (require 'defmacroexpand) (apply defmacro:expand* x '())) + (slib:require 'defmacroexpand) (apply defmacro:expand* x '())) ;@ (define (defmacro:load <pathname>) (slib:eval-load <pathname> defmacro:eval)) @@ -304,12 +304,15 @@ (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 #\space cep) (write x cep)) args) + (newline cep)))) ;;@ define an error procedure for the library -(define (slib:error . args) - (if (provided? 'trace) (print-call-stack (current-error-port))) - (apply error args)) +(define slib:error + (let ((error error)) + (lambda 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))) @@ -318,7 +321,7 @@ ((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 (port? obj) (or (input-port? obj) (output-port? obj))) (define (call-with-open-ports . ports) (define proc (car ports)) (cond ((procedure? proc) (set! ports (cdr ports))) @@ -1,5 +1,5 @@ ;;;;"array.scm" Arrays for Scheme -; Copyright (C) 2001, 2003, 2005 Aubrey Jaffer +; Copyright (C) 2001, 2003, 2005, 2006 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 @@ -110,21 +110,26 @@ (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)) + ((and (string? obj1) (string? obj2)) + (string=? obj1 obj2)) + ((and (vector? obj1) (vector? obj2)) + (and (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)))) + ((and (array? obj1) (array? obj2)) + (and (equal? (array:dimensions obj1) (array:dimensions obj2)) + (letrec ((rascan + (lambda (dims idxs) + (if (null? dims) + (equal? (apply array-ref obj1 idxs) + (apply array-ref obj2 idxs)) + (do ((res #t (rascan (cdr dims) (cons idx idxs))) + (idx (+ -1 (car dims)) (+ -1 idx))) + ((or (not res) (negative? idx)) res)))))) + (rascan (reverse (array:dimensions obj1)) '())))) (else #f))) ;;@body @@ -155,24 +160,30 @@ ;;array are unspecified. Otherwise, the returned array will be filled ;;with the element at the origin of @1. (define (make-array prototype . dimensions) + (define prot (array:store prototype)) + (define pdims (array:dimensions prototype)) + (define onedim? (eqv? 1 (length 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)))) + (let ((initializer + (if (zero? (apply * pdims)) '() + (list + (apply array-ref prototype + (map (lambda (x) 0) pdims)))))) + (cond ((and onedim? (string? prot)) + (apply make-string (car dimensions) initializer)) + ((and onedim? (vector? prot)) + (apply make-vector (car dimensions) initializer)) + (else + (let ((store + (if (string? prot) + (apply make-string tcnt initializer) + (apply make-vector tcnt initializer)))) + (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) @@ -203,7 +214,9 @@ (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)) + (uvt (if (zero? rank) + '() + (append (cdr (vector->list (make-vector rank 0))) '(1))) (append (cdr uvt) '(0))) (uvts '() (cons uvt uvts))) ((negative? idx) @@ -269,7 +282,7 @@ (do ((lst '() (cons (ra2l (cdr dims) (cons idx idxs)) lst)) (idx (+ -1 (car dims)) (+ -1 idx))) ((negative? idx) lst)))) - (ra2l (array-dimensions ra) '())) + (ra2l (array:dimensions ra) '())) ;;@args vect proto dim1 @dots{} ;;@1 must be a vector of length equal to the product of exact @@ -312,19 +325,19 @@ ;; @result{} #(ho) ;;@end example (define (array->vector ra) - (define dims (array-dimensions 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) + (vector-set! vect vdx val)) (do ((idx (+ -1 (car dims)) (+ -1 idx))) ((negative? idx) vect) (ra2v (cdr dims) (cons idx idxs))))) - (ra2v dims '()))) + (ra2v dims '()) + vect)) (define (array:in-bounds? array indices) (do ((bnds (array:dimensions array) (cdr bnds)) diff --git a/bigloo.init b/bigloo.init index eb607bb..dfe8e2f 100644 --- a/bigloo.init +++ b/bigloo.init @@ -129,9 +129,9 @@ (exchange old) val)))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -157,7 +157,7 @@ ;; These four features are optional in both R4RS and R5RS multiarg/and- ;/ and - can take more than 2 args. - rationalize +;;; rationalize transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF with-file ;has WITH-INPUT-FROM-FILE and ;WITH-OUTPUT-TO-FILE @@ -173,7 +173,7 @@ ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? - object-hash ;has OBJECT-HASH +;;; object-hash ;has OBJECT-HASH ;; full-continuation ;not without the -call/cc switch ieee-floating-point ;conforms to IEEE Standard 754-1985 @@ -192,7 +192,7 @@ ;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) @@ -205,12 +205,15 @@ ;; Implementation Specific features promise - string-case +;;; string-case ; missing StudlyCapsExpand + ; symbol-append doesn't handle + ; non-symbols. )) (define pretty-print pp) -(define (object->string x) (obj->string x)) +;;; OBJ->STRING returns strings with control characters. +;;(define (object->string x) (obj->string x)) ;;@ (OUTPUT-PORT-WIDTH <port>) (define (output-port-width . arg) 79) @@ -243,12 +246,12 @@ (close-input-port insp) res)) -;;; "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))) +;;;; "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. @@ -291,12 +294,14 @@ (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 #\space 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))) - (error 'slib:error "" args)) +(define slib:error + (let ((error error)) + (lambda 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))) @@ -370,9 +375,8 @@ ;;@ 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) + (if (file-exists? (string-append file (scheme-file-suffix))) + (slib:load-source file) (slib:load-compiled file))) ;@ (define defmacro:load slib:load-source) @@ -1,5 +1,5 @@ ;;; "byte.scm" small integers, not necessarily chars. -; Copyright (C) 2001, 2002, 2003 Aubrey Jaffer +; Copyright (C) 2001, 2002, 2003, 2006 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 @@ -77,6 +77,17 @@ ;;Returns a newly allocated copy of the given @1. (define bytes-copy string-copy) +;;@args bytes start end +;;@1 must be a bytes, and @2 and @3 +;;must be exact integers satisfying +;; +;;@center 0 <= @2 <= @3 <= @w{@t{(bytes-length @1)@r{.}}} +;; +;;@0 returns a newly allocated bytes formed from the bytes of +;;@1 beginning with index @2 (inclusive) and ending with index +;;@3 (exclusive). +(define subbytes substring) + ;;@body ;;Reverses the order of byte-array @1. (define (bytes-reverse! bytes) @@ -149,8 +160,8 @@ (let* ((len (abs n)) (byts (make-bytes len)) (cnt (if (positive? n) - (apply substring-read! byts 0 n port) - (apply substring-read! byts (- n) 0 port)))) + (apply subbytes-read! byts 0 n port) + (apply subbytes-read! byts (- n) 0 port)))) (if (= cnt len) byts (if (positive? n) @@ -168,11 +179,11 @@ ;;by @code{current-output-port}. (define (write-bytes bytes n . port) (if (positive? n) - (apply substring-write bytes 0 n port) - (apply substring-write bytes (- n) 0 port))) + (apply subbytes-write bytes 0 n port) + (apply subbytes-write bytes (- n) 0 port))) ;;@noindent -;;@code{substring-read!} and @code{substring-write} provide +;;@code{subbytes-read!} and @code{subbytes-write} provide ;;lower-level procedures for reading and writing blocks of bytes. The ;;relative size of @var{start} and @var{end} determines the order of ;;writing. @@ -185,7 +196,7 @@ ;; ;;@4 may be omitted, in which case it defaults to the value returned ;;by @code{current-input-port}. -(define (substring-read! string start end . port) +(define (subbytes-read! string start end . port) (if (>= end start) (do ((idx start (+ 1 idx))) ((>= idx end) idx) @@ -211,7 +222,7 @@ ;; ;;@4 may be omitted, in which case it defaults to the value returned ;;by @code{current-output-port}. -(define (substring-write string start end . port) +(define (subbytes-write string start end . port) (if (>= end start) (do ((idx start (+ 1 idx))) ((>= idx end) (- end start)) @@ -219,3 +230,7 @@ (do ((idx (+ -1 start) (+ -1 idx))) ((< idx end) (- start end)) (apply write-byte (byte-ref string idx) port)))) + +;;;; Legacy names. +(define substring-read! subbytes-read!) +(define substring-write subbytes-write) @@ -73,6 +73,19 @@ Returns a newly allocated copy of the given @var{bytes}. @end defun +@defun subbytes bytes start end + +@var{bytes} must be a bytes, and @var{start} and @var{end} +must be exact integers satisfying + +@center 0 <= @var{start} <= @var{end} <= @w{@t{(bytes-length @var{bytes})@r{.}}} + +@code{subbytes} returns a newly allocated bytes formed from the bytes of +@var{bytes} beginning with index @var{start} (inclusive) and ending with index +@var{end} (exclusive). +@end defun + + @deffn {Procedure} bytes-reverse! bytes Reverses the order of byte-array @var{bytes}. @@ -162,31 +175,31 @@ by @code{current-output-port}. @end defun @noindent -@code{substring-read!} and @code{substring-write} provide +@code{subbytes-read!} and @code{subbytes-write} provide lower-level procedures for reading and writing blocks of bytes. The relative size of @var{start} and @var{end} determines the order of writing. -@deffn {Procedure} substring-read! string start end port +@deffn {Procedure} subbytes-read! string start end port -@deffnx {Procedure} substring-read! string start end +@deffnx {Procedure} subbytes-read! string start end Fills @var{string} with up to @code{(abs (- @var{start} @var{end}))} bytes read from @var{port}. The first byte read is stored at index @var{string}. -@code{substring-read!} returns the number of bytes read. +@code{subbytes-read!} returns the number of bytes read. @var{port} may be omitted, in which case it defaults to the value returned by @code{current-input-port}. @end deffn -@defun substring-write string start end port +@defun subbytes-write string start end port -@defunx substring-write string start end -@code{substring-write} writes @code{(abs (- @var{start} @var{end}))} bytes to -output-port @var{port}. The first byte written is index @var{start} of @var{string}. @code{substring-write} +@defunx subbytes-write string start end +@code{subbytes-write} writes @code{(abs (- @var{start} @var{end}))} bytes to +output-port @var{port}. The first byte written is index @var{start} of @var{string}. @code{subbytes-write} returns the number of bytes written. @var{port} may be omitted, in which case it defaults to the value returned @@ -127,9 +127,9 @@ thunk (lambda () (exchange old))))))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -313,12 +313,13 @@ ;;; define an error procedure for the library (define slib:error - (lambda args - (let ((cep (current-error-port))) - (if (provided? 'trace) (print-call-stack cep)) - (display "Error: " cep) - (for-each (lambda (x) (display #\ cep) (write x cep)) args) - (error #f "")))) + (let ((error error)) + (lambda args + (let ((cep (current-error-port))) + (if (provided? 'trace) (print-call-stack cep)) + (display "Error: " cep) + (for-each (lambda (x) (display #\space cep) (write x cep)) args) + (error #f ""))))) ;;; define these as appropriate for your system. (define slib:tab #\tab) @@ -474,7 +475,7 @@ (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 #\space cep) (write x cep)) args)))) ;;; Load the REQUIRE package. (slib:load (in-vicinity (library-vicinity) "require")) diff --git a/clrnamdb.scm b/clrnamdb.scm index 68386c9..e75a48d 100644 --- a/clrnamdb.scm +++ b/clrnamdb.scm @@ -1,4 +1,4 @@ -;;; "/usr/local/lib/slib/clrnamdb.scm" SLIB 3a2 alist-table database -*-scheme-*- +;;; "/usr/local/lib/slib/clrnamdb.scm" SLIB 3a3 alist-table database -*-scheme-*- ( (10 @@ -0,0 +1,195 @@ +;;;"dft.scm" Discrete Fourier Transform +;Copyright (C) 1999, 2003, 2006 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. + +;;;; For one-dimensional power-of-two length see: +;;; Introduction to Algorithms (MIT Electrical +;;; Engineering and Computer Science Series) +;;; by Thomas H. Cormen, Charles E. Leiserson (Contributor), +;;; Ronald L. Rivest (Contributor) +;;; MIT Press; ISBN: 0-262-03141-8 (July 1990) + +;;; Flipped polarity of exponent to agree with +;;; http://en.wikipedia.org/wiki/Discrete_Fourier_transform + +(require 'array) +(require 'logical) +(require 'subarray) + +;;@code{(require 'dft)} or +;;@code{(require 'Fourier-transform)} +;;@ftindex dft, Fourier-transform +;; +;;@code{fft} and @code{fft-1} compute the Fast-Fourier-Transforms +;;(O(n*log(n))) of arrays whose dimensions are all powers of 2. +;; +;;@code{sft} and @code{sft-1} compute the Discrete-Fourier-Transforms +;;for all combinations of dimensions (O(n^2)). + +(define (dft:sft1d! new ara n dir) + (define scl (if (negative? dir) (/ 1.0 n) 1)) + (define pi2i/n (/ (* 0-8i (atan 1) dir) n)) + (do ((k (+ -1 n) (+ -1 k))) + ((negative? k) new) + (let ((sum 0)) + (do ((j (+ -1 n) (+ -1 j))) + ((negative? j) (array-set! new sum k)) + (set! sum (+ sum (* (exp (* pi2i/n j k)) + (array-ref ara j) + scl))))))) + +(define (dft:fft1d! new ara n dir) + (define scl (if (negative? dir) (/ 1.0 n) 1)) + (define lgn (integer-length (+ -1 n))) + (define pi2i (* 0-8i (atan 1) dir)) + (do ((k 0 (+ 1 k))) + ((>= k n)) + (array-set! new (* (array-ref ara k) scl) (reverse-bit-field k 0 lgn))) + (do ((s 1 (+ 1 s)) + (m (expt 2 1) (expt 2 (+ 1 s)))) + ((> s lgn) new) + (let ((w_m (exp (/ pi2i m))) + (m/2-1 (+ (quotient m 2) -1))) + (do ((j 0 (+ 1 j)) + (w 1 (* w w_m))) + ((> j m/2-1)) + (do ((k j (+ m k)) + (k+m/2 (+ j m/2-1 1) (+ m k m/2-1 1))) + ((>= k n)) + (let ((t (* w (array-ref new k+m/2))) + (u (array-ref new k))) + (array-set! new (+ u t) k) + (array-set! new (- u t) k+m/2))))))) + +;;; Row-major order is suboptimal for Scheme. +;;; N are copied into and operated on in place +;;; A[a, *, c] --> N1[c, a, *] +;;; N1[c, *, b] --> N2[b, c, *] +;;; N2[b, *, a] --> N3[a, b, *] + +(define (dft:rotate-indexes idxs) + (define ridxs (reverse idxs)) + (cons (car ridxs) (reverse (cdr ridxs)))) + +(define (dft:dft prot ara dir transform-1d) + (define (ranker ara rdx dims) + (define ndims (dft:rotate-indexes dims)) + (if (negative? rdx) + ara + (let ((new (apply make-array prot ndims)) + (rdxlen (car (last-pair ndims)))) + (define x1d + (cond (transform-1d) + ((eqv? rdxlen (expt 2 (integer-length (+ -1 rdxlen)))) + dft:fft1d!) + (else dft:sft1d!))) + (define (ramap rdims inds) + (cond ((null? rdims) + (x1d (apply subarray new (dft:rotate-indexes inds)) + (apply subarray ara inds) + rdxlen dir)) + ((null? inds) + (do ((i (+ -1 (car rdims)) (+ -1 i))) + ((negative? i)) + (ramap (cddr rdims) + (cons #f (cons i inds))))) + (else + (do ((i (+ -1 (car rdims)) (+ -1 i))) + ((negative? i)) + (ramap (cdr rdims) (cons i inds)))))) + (if (= 1 (length dims)) + (x1d new ara rdxlen dir) + (ramap (reverse dims) '())) + (ranker new (+ -1 rdx) ndims)))) + (ranker ara (+ -1 (array-rank ara)) (array-dimensions ara))) + +;;@args array prot +;;@args array +;;@var{array} is an array of positive rank. @code{sft} returns an +;;array of type @2 (defaulting to @1) of complex numbers comprising +;;the @dfn{Discrete Fourier Transform} of @var{array}. +(define (sft ara . prot) + (dft:dft (if (null? prot) ara (car prot)) ara 1 dft:sft1d!)) + +;;@args array prot +;;@args array +;;@var{array} is an array of positive rank. @code{sft-1} returns an +;;array of type @2 (defaulting to @1) of complex numbers comprising +;;the inverse Discrete Fourier Transform of @var{array}. +(define (sft-1 ara . prot) + (dft:dft (if (null? prot) ara (car prot)) ara -1 dft:sft1d!)) + +(define (dft:check-dimensions ara name) + (for-each (lambda (n) + (if (not (eqv? n (expt 2 (integer-length (+ -1 n))))) + (slib:error name "array length not power of 2" n))) + (array-dimensions ara))) + +;;@args array prot +;;@args array +;;@var{array} is an array of positive rank whose dimensions are all +;;powers of 2. @code{fft} returns an array of type @2 (defaulting to +;;@1) of complex numbers comprising the Discrete Fourier Transform of +;;@var{array}. +(define (fft ara . prot) + (dft:check-dimensions ara 'fft) + (dft:dft (if (null? prot) ara (car prot)) ara 1 dft:fft1d!)) + +;;@args array prot +;;@args array +;;@var{array} is an array of positive rank whose dimensions are all +;;powers of 2. @code{fft-1} returns an array of type @2 (defaulting +;;to @1) of complex numbers comprising the inverse Discrete Fourier +;;Transform of @var{array}. +(define (fft-1 ara . prot) + (dft:check-dimensions ara 'fft-1) + (dft:dft (if (null? prot) ara (car prot)) ara -1 dft:fft1d!)) + +;;@code{dft} and @code{dft-1} compute the discrete Fourier transforms +;;using the best method for decimating each dimension. + +;;@args array prot +;;@args array +;;@0 returns an array of type @2 (defaulting to @1) of complex +;;numbers comprising the Discrete Fourier Transform of @var{array}. +(define (dft ara . prot) + (dft:dft (if (null? prot) ara (car prot)) ara 1 #f)) + +;;@args array prot +;;@args array +;;@0 returns an array of type @2 (defaulting to @1) of +;;complex numbers comprising the inverse Discrete Fourier Transform of +;;@var{array}. +(define (dft-1 ara . prot) + (dft:dft (if (null? prot) ara (car prot)) ara -1 #f)) + +;;@noindent +;;@code{(fft-1 (fft @var{array}))} will return an array of values close to +;;@var{array}. +;; +;;@example +;;(fft '#(1 0+i -1 0-i 1 0+i -1 0-i)) @result{} +;; +;;#(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)) @result{} +;; +;;#(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) +;;@end example @@ -0,0 +1,90 @@ +@code{(require 'dft)} or +@code{(require 'Fourier-transform)} +@ftindex dft, Fourier-transform + +@code{fft} and @code{fft-1} compute the Fast-Fourier-Transforms +(O(n*log(n))) of arrays whose dimensions are all powers of 2. + +@code{sft} and @code{sft-1} compute the Discrete-Fourier-Transforms +for all combinations of dimensions (O(n^2)). + + +@defun sft array prot + + +@defunx sft array +@var{array} is an array of positive rank. @code{sft} returns an +array of type @var{prot} (defaulting to @var{array}) of complex numbers comprising +the @dfn{Discrete Fourier Transform} of @var{array}. +@cindex Discrete Fourier Transform +@end defun + + +@defun sft-1 array prot + + +@defunx sft-1 array +@var{array} is an array of positive rank. @code{sft-1} returns an +array of type @var{prot} (defaulting to @var{array}) of complex numbers comprising +the inverse Discrete Fourier Transform of @var{array}. +@end defun + + +@defun fft array prot + + +@defunx fft array +@var{array} is an array of positive rank whose dimensions are all +powers of 2. @code{fft} returns an array of type @var{prot} (defaulting to +@var{array}) of complex numbers comprising the Discrete Fourier Transform of +@var{array}. +@end defun + + +@defun fft-1 array prot + + +@defunx fft-1 array +@var{array} is an array of positive rank whose dimensions are all +powers of 2. @code{fft-1} returns an array of type @var{prot} (defaulting +to @var{array}) of complex numbers comprising the inverse Discrete Fourier +Transform of @var{array}. +@end defun + +@code{dft} and @code{dft-1} compute the discrete Fourier transforms +using the best method for decimating each dimension. + + +@defun dft array prot + + +@defunx dft array +@code{dft} returns an array of type @var{prot} (defaulting to @var{array}) of complex +numbers comprising the Discrete Fourier Transform of @var{array}. +@end defun + + +@defun dft-1 array prot + + +@defunx dft-1 array +@code{dft-1} returns an array of type @var{prot} (defaulting to @var{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}. + +@example +(fft '#(1 0+i -1 0-i 1 0+i -1 0-i)) @result{} + +#(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)) @result{} + +#(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) +@end example @@ -138,9 +138,9 @@ (exchange old) val)))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -359,23 +359,22 @@ (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 #\space cep) (write x cep)) args)))) ;;; define an error procedure for the library (define slib:error - (lambda args -(define (slib:error . args) - (if (provided? 'trace) (print-call-stack (current-error-port))) - (apply s48-error args)) - (let ((port (open-output-string)) - (err (if (and (pair? args) (symbol? (car args))) - (car args) 'slib)) - (args (if (and (pair? args) (symbol? (car args))) - (cdr args) args))) - (for-each (lambda (x) (display x port) (display " " port)) args) - (let ((str (get-output-string port))) - (close-output-port port) - (error err str))))) + (let ((error error)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (let ((port (open-output-string)) + (err (if (and (pair? args) (symbol? (car args))) + (car args) 'slib)) + (args (if (and (pair? args) (symbol? (car args))) + (cdr args) args))) + (for-each (lambda (x) (display x port) (display " " port)) args) + (let ((str (get-output-string port))) + (close-output-port port) + (error err str)))))) ;;; define these as appropriate for your system. (define slib:tab #\tab) diff --git a/fdl.texi b/fdl.texi new file mode 100644 index 0000000..b9b7dcb --- /dev/null +++ b/fdl.texi @@ -0,0 +1,455 @@ + +@node Copying This Manual, How to use this License for your documents, About this manual, About this manual +@subsection Copying This Manual + +@cindex FDL, GNU Free Documentation License +@center Version 1.2, November 2002 + +@display +Copyright @copyright{} 2000,2001,2002 Free Software Foundation, Inc. +59 Temple Place, Suite 330, Boston, MA 02111-1307, USA + +Everyone is permitted to copy and distribute verbatim copies +of this license document, but changing it is not allowed. +@end display + +@enumerate 0 +@item +PREAMBLE + +The purpose of this License is to make a manual, textbook, or other +functional and useful document @dfn{free} in the sense of freedom: to +assure everyone the effective freedom to copy and redistribute it, +with or without modifying it, either commercially or noncommercially. +Secondarily, this License preserves for the author and publisher a way +to get credit for their work, while not being considered responsible +for modifications made by others. + +This License is a kind of ``copyleft'', which means that derivative +works of the document must themselves be free in the same sense. It +complements the GNU General Public License, which is a copyleft +license designed for free software. + +We have designed this License in order to use it for manuals for free +software, because free software needs free documentation: a free +program should come with manuals providing the same freedoms that the +software does. But this License is not limited to software manuals; +it can be used for any textual work, regardless of subject matter or +whether it is published as a printed book. We recommend this License +principally for works whose purpose is instruction or reference. + +@item +APPLICABILITY AND DEFINITIONS + +This License applies to any manual or other work, in any medium, that +contains a notice placed by the copyright holder saying it can be +distributed under the terms of this License. Such a notice grants a +world-wide, royalty-free license, unlimited in duration, to use that +work under the conditions stated herein. The ``Document'', below, +refers to any such manual or work. Any member of the public is a +licensee, and is addressed as ``you''. You accept the license if you +copy, modify or distribute the work in a way requiring permission +under copyright law. + +A ``Modified Version'' of the Document means any work containing the +Document or a portion of it, either copied verbatim, or with +modifications and/or translated into another language. + +A ``Secondary Section'' is a named appendix or a front-matter section +of the Document that deals exclusively with the relationship of the +publishers or authors of the Document to the Document's overall +subject (or to related matters) and contains nothing that could fall +directly within that overall subject. (Thus, if the Document is in +part a textbook of mathematics, a Secondary Section may not explain +any mathematics.) The relationship could be a matter of historical +connection with the subject or with related matters, or of legal, +commercial, philosophical, ethical or political position regarding +them. + +The ``Invariant Sections'' are certain Secondary Sections whose titles +are designated, as being those of Invariant Sections, in the notice +that says that the Document is released under this License. If a +section does not fit the above definition of Secondary then it is not +allowed to be designated as Invariant. The Document may contain zero +Invariant Sections. If the Document does not identify any Invariant +Sections then there are none. + +The ``Cover Texts'' are certain short passages of text that are listed, +as Front-Cover Texts or Back-Cover Texts, in the notice that says that +the Document is released under this License. A Front-Cover Text may +be at most 5 words, and a Back-Cover Text may be at most 25 words. + +A ``Transparent'' copy of the Document means a machine-readable copy, +represented in a format whose specification is available to the +general public, that is suitable for revising the document +straightforwardly with generic text editors or (for images composed of +pixels) generic paint programs or (for drawings) some widely available +drawing editor, and that is suitable for input to text formatters or +for automatic translation to a variety of formats suitable for input +to text formatters. A copy made in an otherwise Transparent file +format whose markup, or absence of markup, has been arranged to thwart +or discourage subsequent modification by readers is not Transparent. +An image format is not Transparent if used for any substantial amount +of text. A copy that is not ``Transparent'' is called ``Opaque''. + +Examples of suitable formats for Transparent copies include plain +@sc{ascii} without markup, Texinfo input format, La@TeX{} input +format, @acronym{SGML} or @acronym{XML} using a publicly available +@acronym{DTD}, and standard-conforming simple @acronym{HTML}, +PostScript or @acronym{PDF} designed for human modification. Examples +of transparent image formats include @acronym{PNG}, @acronym{XCF} and +@acronym{JPG}. Opaque formats include proprietary formats that can be +read and edited only by proprietary word processors, @acronym{SGML} or +@acronym{XML} for which the @acronym{DTD} and/or processing tools are +not generally available, and the machine-generated @acronym{HTML}, +PostScript or @acronym{PDF} produced by some word processors for +output purposes only. + +The ``Title Page'' means, for a printed book, the title page itself, +plus such following pages as are needed to hold, legibly, the material +this License requires to appear in the title page. For works in +formats which do not have any title page as such, ``Title Page'' means +the text near the most prominent appearance of the work's title, +preceding the beginning of the body of the text. + +A section ``Entitled XYZ'' means a named subunit of the Document whose +title either is precisely XYZ or contains XYZ in parentheses following +text that translates XYZ in another language. (Here XYZ stands for a +specific section name mentioned below, such as ``Acknowledgements'', +``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title'' +of such a section when you modify the Document means that it remains a +section ``Entitled XYZ'' according to this definition. + +The Document may include Warranty Disclaimers next to the notice which +states that this License applies to the Document. These Warranty +Disclaimers are considered to be included by reference in this +License, but only as regards disclaiming warranties: any other +implication that these Warranty Disclaimers may have is void and has +no effect on the meaning of this License. + +@item +VERBATIM COPYING + +You may copy and distribute the Document in any medium, either +commercially or noncommercially, provided that this License, the +copyright notices, and the license notice saying this License applies +to the Document are reproduced in all copies, and that you add no other +conditions whatsoever to those of this License. You may not use +technical measures to obstruct or control the reading or further +copying of the copies you make or distribute. However, you may accept +compensation in exchange for copies. If you distribute a large enough +number of copies you must also follow the conditions in section 3. + +You may also lend copies, under the same conditions stated above, and +you may publicly display copies. + +@item +COPYING IN QUANTITY + +If you publish printed copies (or copies in media that commonly have +printed covers) of the Document, numbering more than 100, and the +Document's license notice requires Cover Texts, you must enclose the +copies in covers that carry, clearly and legibly, all these Cover +Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on +the back cover. Both covers must also clearly and legibly identify +you as the publisher of these copies. The front cover must present +the full title with all words of the title equally prominent and +visible. You may add other material on the covers in addition. +Copying with changes limited to the covers, as long as they preserve +the title of the Document and satisfy these conditions, can be treated +as verbatim copying in other respects. + +If the required texts for either cover are too voluminous to fit +legibly, you should put the first ones listed (as many as fit +reasonably) on the actual cover, and continue the rest onto adjacent +pages. + +If you publish or distribute Opaque copies of the Document numbering +more than 100, you must either include a machine-readable Transparent +copy along with each Opaque copy, or state in or with each Opaque copy +a computer-network location from which the general network-using +public has access to download using public-standard network protocols +a complete Transparent copy of the Document, free of added material. +If you use the latter option, you must take reasonably prudent steps, +when you begin distribution of Opaque copies in quantity, to ensure +that this Transparent copy will remain thus accessible at the stated +location until at least one year after the last time you distribute an +Opaque copy (directly or through your agents or retailers) of that +edition to the public. + +It is requested, but not required, that you contact the authors of the +Document well before redistributing any large number of copies, to give +them a chance to provide you with an updated version of the Document. + +@item +MODIFICATIONS + +You may copy and distribute a Modified Version of the Document under +the conditions of sections 2 and 3 above, provided that you release +the Modified Version under precisely this License, with the Modified +Version filling the role of the Document, thus licensing distribution +and modification of the Modified Version to whoever possesses a copy +of it. In addition, you must do these things in the Modified Version: + +@enumerate A +@item +Use in the Title Page (and on the covers, if any) a title distinct +from that of the Document, and from those of previous versions +(which should, if there were any, be listed in the History section +of the Document). You may use the same title as a previous version +if the original publisher of that version gives permission. + +@item +List on the Title Page, as authors, one or more persons or entities +responsible for authorship of the modifications in the Modified +Version, together with at least five of the principal authors of the +Document (all of its principal authors, if it has fewer than five), +unless they release you from this requirement. + +@item +State on the Title page the name of the publisher of the +Modified Version, as the publisher. + +@item +Preserve all the copyright notices of the Document. + +@item +Add an appropriate copyright notice for your modifications +adjacent to the other copyright notices. + +@item +Include, immediately after the copyright notices, a license notice +giving the public permission to use the Modified Version under the +terms of this License, in the form shown in the Addendum below. + +@item +Preserve in that license notice the full lists of Invariant Sections +and required Cover Texts given in the Document's license notice. + +@item +Include an unaltered copy of this License. + +@item +Preserve the section Entitled ``History'', Preserve its Title, and add +to it an item stating at least the title, year, new authors, and +publisher of the Modified Version as given on the Title Page. If +there is no section Entitled ``History'' in the Document, create one +stating the title, year, authors, and publisher of the Document as +given on its Title Page, then add an item describing the Modified +Version as stated in the previous sentence. + +@item +Preserve the network location, if any, given in the Document for +public access to a Transparent copy of the Document, and likewise +the network locations given in the Document for previous versions +it was based on. These may be placed in the ``History'' section. +You may omit a network location for a work that was published at +least four years before the Document itself, or if the original +publisher of the version it refers to gives permission. + +@item +For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve +the Title of the section, and preserve in the section all the +substance and tone of each of the contributor acknowledgements and/or +dedications given therein. + +@item +Preserve all the Invariant Sections of the Document, +unaltered in their text and in their titles. Section numbers +or the equivalent are not considered part of the section titles. + +@item +Delete any section Entitled ``Endorsements''. Such a section +may not be included in the Modified Version. + +@item +Do not retitle any existing section to be Entitled ``Endorsements'' or +to conflict in title with any Invariant Section. + +@item +Preserve any Warranty Disclaimers. +@end enumerate + +If the Modified Version includes new front-matter sections or +appendices that qualify as Secondary Sections and contain no material +copied from the Document, you may at your option designate some or all +of these sections as invariant. To do this, add their titles to the +list of Invariant Sections in the Modified Version's license notice. +These titles must be distinct from any other section titles. + +You may add a section Entitled ``Endorsements'', provided it contains +nothing but endorsements of your Modified Version by various +parties---for example, statements of peer review or that the text has +been approved by an organization as the authoritative definition of a +standard. + +You may add a passage of up to five words as a Front-Cover Text, and a +passage of up to 25 words as a Back-Cover Text, to the end of the list +of Cover Texts in the Modified Version. Only one passage of +Front-Cover Text and one of Back-Cover Text may be added by (or +through arrangements made by) any one entity. If the Document already +includes a cover text for the same cover, previously added by you or +by arrangement made by the same entity you are acting on behalf of, +you may not add another; but you may replace the old one, on explicit +permission from the previous publisher that added the old one. + +The author(s) and publisher(s) of the Document do not by this License +give permission to use their names for publicity for or to assert or +imply endorsement of any Modified Version. + +@item +COMBINING DOCUMENTS + +You may combine the Document with other documents released under this +License, under the terms defined in section 4 above for modified +versions, provided that you include in the combination all of the +Invariant Sections of all of the original documents, unmodified, and +list them all as Invariant Sections of your combined work in its +license notice, and that you preserve all their Warranty Disclaimers. + +The combined work need only contain one copy of this License, and +multiple identical Invariant Sections may be replaced with a single +copy. If there are multiple Invariant Sections with the same name but +different contents, make the title of each such section unique by +adding at the end of it, in parentheses, the name of the original +author or publisher of that section if known, or else a unique number. +Make the same adjustment to the section titles in the list of +Invariant Sections in the license notice of the combined work. + +In the combination, you must combine any sections Entitled ``History'' +in the various original documents, forming one section Entitled +``History''; likewise combine any sections Entitled ``Acknowledgements'', +and any sections Entitled ``Dedications''. You must delete all +sections Entitled ``Endorsements.'' + +@item +COLLECTIONS OF DOCUMENTS + +You may make a collection consisting of the Document and other documents +released under this License, and replace the individual copies of this +License in the various documents with a single copy that is included in +the collection, provided that you follow the rules of this License for +verbatim copying of each of the documents in all other respects. + +You may extract a single document from such a collection, and distribute +it individually under this License, provided you insert a copy of this +License into the extracted document, and follow this License in all +other respects regarding verbatim copying of that document. + +@item +AGGREGATION WITH INDEPENDENT WORKS + +A compilation of the Document or its derivatives with other separate +and independent documents or works, in or on a volume of a storage or +distribution medium, is called an ``aggregate'' if the copyright +resulting from the compilation is not used to limit the legal rights +of the compilation's users beyond what the individual works permit. +When the Document is included in an aggregate, this License does not +apply to the other works in the aggregate which are not themselves +derivative works of the Document. + +If the Cover Text requirement of section 3 is applicable to these +copies of the Document, then if the Document is less than one half of +the entire aggregate, the Document's Cover Texts may be placed on +covers that bracket the Document within the aggregate, or the +electronic equivalent of covers if the Document is in electronic form. +Otherwise they must appear on printed covers that bracket the whole +aggregate. + +@item +TRANSLATION + +Translation is considered a kind of modification, so you may +distribute translations of the Document under the terms of section 4. +Replacing Invariant Sections with translations requires special +permission from their copyright holders, but you may include +translations of some or all Invariant Sections in addition to the +original versions of these Invariant Sections. You may include a +translation of this License, and all the license notices in the +Document, and any Warranty Disclaimers, provided that you also include +the original English version of this License and the original versions +of those notices and disclaimers. In case of a disagreement between +the translation and the original version of this License or a notice +or disclaimer, the original version will prevail. + +If a section in the Document is Entitled ``Acknowledgements'', +``Dedications'', or ``History'', the requirement (section 4) to Preserve +its Title (section 1) will typically require changing the actual +title. + +@item +TERMINATION + +You may not copy, modify, sublicense, or distribute the Document except +as expressly provided for under this License. Any other attempt to +copy, modify, sublicense or distribute the Document is void, and will +automatically terminate your rights under this License. However, +parties who have received copies, or rights, from you under this +License will not have their licenses terminated so long as such +parties remain in full compliance. + +@item +FUTURE REVISIONS OF THIS LICENSE + +The Free Software Foundation may publish new, revised versions +of the GNU Free Documentation License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. See +@uref{http://www.gnu.org/copyleft/}. + +Each version of the License is given a distinguishing version number. +If the Document specifies that a particular numbered version of this +License ``or any later version'' applies to it, you have the option of +following the terms and conditions either of that specified version or +of any later version that has been published (not as a draft) by the +Free Software Foundation. If the Document does not specify a version +number of this License, you may choose any version ever published (not +as a draft) by the Free Software Foundation. +@end enumerate + +@c @page +@c @appendixsubsec ADDENDUM: How to use this License for your documents + +@node How to use this License for your documents, , Copying This Manual, About this manual +@subsection How to use this License for your documents + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and +license notices just after the title page: + +@smallexample +@group + Copyright (C) @var{year} @var{your name}. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.2 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. +@end group +@end smallexample + +If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, +replace the ``with...Texts.'' line with this: + +@smallexample +@group + with the Invariant Sections being @var{list their titles}, with + the Front-Cover Texts being @var{list}, and with the Back-Cover Texts + being @var{list}. +@end group +@end smallexample + +If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + +If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of +free software license, such as the GNU General Public License, +to permit their use in free software. + +@c Local Variables: +@c ispell-local-pdict: "ispell-dict" +@c End: + diff --git a/fft.scm b/fft.scm deleted file mode 100644 index feefec8..0000000 --- a/fft.scm +++ /dev/null @@ -1,94 +0,0 @@ -;;;"fft.scm" Fast Fourier Transform -;Copyright (C) 1999, 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 -;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. - -;;;; See: -;;; Introduction to Algorithms (MIT Electrical -;;; Engineering and Computer Science Series) -;;; by Thomas H. Cormen, Charles E. Leiserson (Contributor), -;;; Ronald L. Rivest (Contributor) -;;; MIT Press; ISBN: 0-262-03141-8 (July 1990) - -;;; http://www.astro.virginia.edu/~eww6n/math/DiscreteFourierTransform.html -;;; differs in the direction of rotation of the complex unit vectors. - -(require 'array) -(require 'logical) - -;;@code{(require 'fft)} -;;@ftindex fft - -(define (fft:shuffle&scale new ara n scale) - (define lgn (integer-length (+ -1 n))) - (if (not (eqv? n (expt 2 lgn))) - (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) (reverse-bit-field k 0 lgn)))) - -(define (dft! ara n dir) - (define lgn (integer-length (+ -1 n))) - (define pi2i (* 0+8i (atan 1))) - (do ((s 1 (+ 1 s))) - ((> s lgn) ara) - (let* ((m (expt 2 s)) - (w_m (exp (* dir (/ pi2i m)))) - (m/2-1 (+ (quotient m 2) -1))) - (do ((j 0 (+ 1 j)) - (w 1 (* w w_m))) - ((> j m/2-1)) - (do ((k j (+ m k))) - ((>= k n)) - (let* ((k+m/2 (+ k m/2-1 1)) - (t (* w (array-ref ara k+m/2))) - (u (array-ref ara k))) - (array-set! ara (+ u t) k) - (array-set! ara (- u t) k+m/2))))))) - -;;@args array -;;@var{array} is an array of @code{(expt 2 n)} numbers. @code{fft} -;;returns an array of complex numbers comprising the -;;@dfn{Discrete Fourier Transform} of @var{array}. -(define (fft ara) - (define n (car (array-dimensions ara))) - (define new (apply make-array ara (array-dimensions ara))) - (dft! (fft:shuffle&scale new ara n 1) n 1)) - -;;@args array -;;@code{fft-1} returns an array of complex numbers comprising the -;;inverse Discrete Fourier Transform of @var{array}. -(define (fft-1 ara) - (define n (car (array-dimensions ara))) - (define new (apply make-array ara (array-dimensions ara))) - (dft! (fft:shuffle&scale new ara n (/ n)) n -1)) - -;;@noindent -;;@code{(fft-1 (fft @var{array}))} will return an array of values close to -;;@var{array}. -;; -;;@example -;;(fft '#(1 0+i -1 0-i 1 0+i -1 0-i)) @result{} -;; -;;#(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)) @result{} -;; -;;#(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) -;;@end example diff --git a/fft.txi b/fft.txi deleted file mode 100644 index 80c19e9..0000000 --- a/fft.txi +++ /dev/null @@ -1,34 +0,0 @@ -@code{(require 'fft)} -@ftindex fft - - -@defun fft array - -@var{array} is an array of @code{(expt 2 n)} numbers. @code{fft} -returns an array of complex numbers comprising the -@dfn{Discrete Fourier Transform} of @var{array}. -@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}. - -@example -(fft '#(1 0+i -1 0-i 1 0+i -1 0-i)) @result{} - -#(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)) @result{} - -#(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) -@end example diff --git a/gambit.init b/gambit.init index 5ca0d67..07841e6 100644 --- a/gambit.init +++ b/gambit.init @@ -155,9 +155,9 @@ thunk (lambda () (exchange old))))))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -362,12 +362,14 @@ (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 #\space 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 slib:error + (let ((error error)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (apply error args)))) ;; define these as appropriate for your system. (define slib:tab (integer->char 9)) @@ -21,7 +21,7 @@ (define getopt:char #\-) ;@ (define getopt:opt #f) -(define *argv* *argv*) +;;(define *argv* *argv*) (define *optind* 1) (define *optarg* 0) ;@ diff --git a/getparam.scm b/getparam.scm index da8ce04..21d7d39 100644 --- a/getparam.scm +++ b/getparam.scm @@ -104,7 +104,7 @@ (let ((str (string-copy (car alias)))) (do ((i (+ -1 (string-length str)) (+ -1 i))) ((negative? i) (cons str (cdr alias))) - (cond ((char=? #\ (string-ref str i)) + (cond ((char=? #\space (string-ref str i)) (string-set! str i #\-)))))) ((number? (car alias)) (set! positional? (car alias)) diff --git a/grapheps.ps b/grapheps.ps index 95f200e..db3b8b1 100644 --- a/grapheps.ps +++ b/grapheps.ps @@ -185,10 +185,12 @@ plotdict begin /YSCL plotrect 3 get YRNG aload pop exch sub div def /XOFF XOFF plotrect 0 get XSCL div sub def /YOFF YOFF plotrect 1 get YSCL div sub def - /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 {12} {10} ifelse 5 mul xuntrans def + /YTSCL plotrect 3 get YRNG aload pop exch sub abs find-tick-scale def + /YSTEP YTSCL 0 get 3 mod 0 eq {6} {8} ifelse 5 mul yuntrans + YSCL sign mul def + /XTSCL plotrect 2 get XRNG aload pop exch sub abs find-tick-scale def + /XSTEP XTSCL 0 get 3 mod 0 eq {12} {10} ifelse 5 mul xuntrans + XSCL sign mul def /YSTEPH YSTEP 2 div def /XSTEPH XSTEP 2 div def } bind def @@ -203,6 +205,8 @@ plotdict begin /yuntrans {YTSCL aload pop exch div mul} bind def /xuntrans {XTSCL aload pop exch div mul} bind def +/sign {dup 0 lt {pop -1} {0 gt {1} {0} ifelse} ifelse} bind def + /zero-in-range? {dup 0 get 0 le exch 1 get 0 ge and} bind def /y-axis @@ -245,7 +249,7 @@ bind def } bind def % Given the width (or height) and the data-span, returns an array of -% numerator and denominator (NUM DEN) +% numerator and denominator [NUM DEN] % % NUM will be 1, 2, 3, 4, 5, 6, or 8 times a power of ten. % DEN will be a power of ten. @@ -256,9 +260,9 @@ bind def /find-tick-scale {/DLTA exch def /ISIZ exch def /DEN 1 def - {DLTA ISIZ le {exit} if /DEN DEN 10 mul def /ISIZ ISIZ 10 mul def} loop + {DLTA abs ISIZ le {exit} if /DEN DEN 10 mul def /ISIZ ISIZ 10 mul def} loop /NUM 1 def - {DLTA 10 mul ISIZ ge {exit} if /NUM NUM 10 mul def /DLTA DLTA 10 mul def} loop + {DLTA abs 10 mul ISIZ ge {exit} if /NUM NUM 10 mul def /DLTA DLTA 10 mul def} loop [[8 6 5 4 3 2 1] {/MAX exch def MAX DLTA mul ISIZ le {MAX exit} if} forall NUM mul DEN] } bind def diff --git a/grapheps.scm b/grapheps.scm index d64262f..857829c 100644 --- a/grapheps.scm +++ b/grapheps.scm @@ -437,13 +437,13 @@ (scheme->ps x-coord " (" text ") " tick-width " rule-vertical")) ;;@body -;;Draws a horizontal 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 negative, then the ticks are -@3 long on the left side of @1; and -;;@2 and numeric legends are on the right. -(define (rule-horizontal x-coord text tick-height) - (scheme->ps x-coord " (" text ") " tick-height " rule-horizontal")) +;;Draws a horizontal ruler with Y coordinate @1 and labeled with +;;string @2. If @3 is positive, then the ticks are @3 long on the top +;;side of @1; and @2 and numeric legends are on the bottom. If @3 is +;;negative, then the ticks are -@3 long on the bottom side of @1; and +;;@2 and numeric legends are on the top. +(define (rule-horizontal y-coord text tick-height) + (scheme->ps y-coord " (" text ") " tick-height " rule-horizontal")) ;;@body ;;Draws the y-axis. @@ -541,7 +541,9 @@ (lambda (tmp) (cond ((procedure? (car args)) (apply graph:plot-function tmp args)) - ((array? (car args)) + ((or (array? (car args)) + (and (pair? (car args)) + (pair? (caar args)))) (apply graph:plot tmp args)) (else (let ((dats (apply functions->array args))) (graph:plot tmp dats "" "")))) diff --git a/grapheps.txi b/grapheps.txi index afa5ede..a889dd0 100644 --- a/grapheps.txi +++ b/grapheps.txi @@ -337,13 +337,13 @@ and numeric legends are on the right. @end defun -@defun rule-horizontal x-coord text tick-height +@defun rule-horizontal y-coord text tick-height -Draws a horizontal ruler with X coordinate @var{x-coord} and labeled with -string @var{text}. If @var{tick-height} is positive, then the ticks are @var{tick-height} long on the -right side of @var{x-coord}; and @var{text} and numeric legends are on the left. If @var{tick-height} -is negative, then the ticks are -@var{tick-height} long on the left side of @var{x-coord}; and -@var{text} and numeric legends are on the right. +Draws a horizontal ruler with Y coordinate @var{y-coord} and labeled with +string @var{text}. If @var{tick-height} is positive, then the ticks are @var{tick-height} long on the top +side of @var{y-coord}; and @var{text} and numeric legends are on the bottom. If @var{tick-height} is +negative, then the ticks are -@var{tick-height} long on the bottom side of @var{y-coord}; and +@var{text} and numeric legends are on the top. @end defun @@ -6,7 +6,6 @@ (if (string<? (version) "1.6") (define-module (ice-9 slib))) ; :no-backtrace (define slib-module (current-module)) -(define (defined? symbol) (module-defined? slib-module symbol)) (define base:define define) (define define @@ -59,6 +58,7 @@ (and (defined? 'getenv) (getenv "SCHEME_LIBRARY_PATH")) ;; Use this path if your scheme does not support GETENV ;; or if SCHEME_LIBRARY_PATH is not set. + "/usr/lib/slib/" (in-vicinity (implementation-vicinity) "slib/")))) (lambda () library-path))) @@ -75,8 +75,6 @@ (string-append home "/"))) (else home))))) ;@ -(define in-vicinity string-append) -;@ (define (user-vicinity) (case (software-type) ((vms) "[.]") @@ -144,9 +142,9 @@ thunk (lambda () (exchange old)))))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features (append '( source ;can load scheme source files @@ -239,9 +237,7 @@ (if (defined? 'char-ready?) '(char-ready?) - '()) - - *features*)) + '()))) ;;; (OUTPUT-PORT-WIDTH <port>) (define (output-port-width . arg) 79) @@ -261,13 +257,13 @@ ;; "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))))))) +(set! 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))))))) ;;; for line-i/o (use-modules (ice-9 popen)) @@ -279,13 +275,21 @@ (status:term-sig status) (status:stop-sig status)) (if (eof-object? line) "" line))))) - -(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))))) +;; rdelim was loaded by default in guile 1.6, but not in 1.8 +;; load it to get read-line, read-line! and write-line, +;; and re-export them for the benefit of loading this file from (ice-9 slib) +(cond ((string>=? (scheme-implementation-version) "1.8") + (use-modules (ice-9 rdelim)) + (re-export read-line) + (re-export read-line!) + (re-export write-line))) + +(set! 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. @@ -296,14 +300,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))) +(set! 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 (call-with-open-ports . ports) (define proc (car ports)) (cond ((procedure? proc) (set! ports (cdr ports))) @@ -314,6 +317,18 @@ (for-each close-port ports) ans)) +(if (not (defined? 'browse-url)) + ;; Nothing special to do for this, so straight from + ;; Template.scm. Maybe "sensible-browser" for a debian + ;; system would be worth trying too (and would be good on a + ;; tty). + (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))) @@ -323,14 +338,13 @@ ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can ;;; be returned by CHAR->INTEGER. -;;(define char-code-limit 256) +;; In Guile-1.8.0: (string>? (string #\000) (string #\200)) ==> #t +(if (string=? (version) "1.8.0") + (define char-code-limit 128)) ;;; MOST-POSITIVE-FIXNUM is used in modular.scm ;;(define most-positive-fixnum #x0FFFFFFF) -;;; Return argument -(define (identity x) x) - ;;; SLIB:EVAL is single argument eval using the top-level (user) environment. (define slib:eval (if (string<? (scheme-implementation-version) "1.5") @@ -475,7 +489,7 @@ (define bitwise-xor logxor) (define bitwise-and logand) (define bitwise-not lognot) -(define bit-count logcount) +;;(define bit-count logcount) (define bit-set? logbit?) (define any-bits-set? logtest) (define first-set-bit log2-binary-factors) @@ -493,19 +507,24 @@ (array-shape array))))) ;; 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)))))) +(set! make-array + (lambda (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 prot)) - (list->uniform-array 0 prot opt))) + (if (string<? (version) "1.8") + (lambda opt (if (null? opt) + (list->uniform-array 1 prot (list prot)) + (list->uniform-array 0 prot opt))) + (lambda opt (if (null? opt) + (list->uniform-array 1 prot (list prot)) + (list->uniform-array 0 prot (car opt))))) vector)) (define ac64 (make-uniform-wrapper "+i")) (define ac32 ac64) @@ -586,16 +605,9 @@ ;;; 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 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+) - ;;; rev2-procedures (define <? <) (define <=? <=) diff --git a/http-cgi.scm b/http-cgi.scm index f8f9793..bc328cf 100644 --- a/http-cgi.scm +++ b/http-cgi.scm @@ -79,7 +79,7 @@ (and content-length (set! content-length (string->number (cdr content-length)))) (and content-length - (let ((str (make-string content-length #\ ))) + (let ((str (make-string content-length #\space))) (do ((idx 0 (+ idx 1))) ((>= idx content-length) (if (>= idx (string-length str)) str (substring str 0 idx))) @@ -306,7 +306,7 @@ (and content-length (set! content-length (string->number content-length))) (and content-length - (let ((str (make-string content-length #\ ))) + (let ((str (make-string content-length #\space))) (do ((idx 0 (+ idx 1))) ((>= idx content-length) (if (>= idx (string-length str)) diff --git a/indexes.texi b/indexes.texi index 8733a05..f6d6992 100644 --- a/indexes.texi +++ b/indexes.texi @@ -8,10 +8,7 @@ @menu * Procedure and Macro Index:: * Variable Index:: -* Concept Index:: -@ifhtml -* SLIB:: Full Table of Contents -@end ifhtml +* Concept and Feature Index:: @end menu @end ifnotinfo @@ -20,36 +17,22 @@ @end ifnotinfo @unnumbered Procedure and Macro Index -This is an alphabetical list of all the procedures and macros in SLIB. +@c 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 +@node Variable Index, Concept and Feature Index, Procedure and Macro Index, Index @end ifnotinfo @unnumbered Variable Index -This is an alphabetical list of all the global variables in SLIB. +@c This is an alphabetical list of all the global variables in SLIB. @printindex vr @ifnotinfo -@node Concept Index, , Variable Index, Index +@node Concept and Feature 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 index 95caa8d..241a2d8 100644 --- a/jscheme.init +++ b/jscheme.init @@ -157,9 +157,9 @@ (exchange old) val)))) -;;@ *FEATURES* should be set to a list of symbols describing features +;;@ SLIB:FEATURES should be set to a list of symbols describing features ;;; of this implementation. Suggestions for features are: -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -388,12 +388,14 @@ (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 #\space 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 slib:error + (let ((error error)) + (lambda 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))) diff --git a/macscheme.init b/macscheme.init index 8edfc00..ab717d4 100644 --- a/macscheme.init +++ b/macscheme.init @@ -1,4 +1,4 @@ -;;;"macscheme.init" Configuration of *features* for MacScheme -*-scheme-*- +;;;"macscheme.init" Configuration of slib:features for MacScheme -*-scheme-*- ;;; Author: Aubrey Jaffer ;;; ;;; This code is in the public domain. @@ -103,9 +103,9 @@ (exchange old) val)))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -315,13 +315,14 @@ (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 #\space cep) (write x cep)) args)))) ;;; define an error procedure for the library (define slib:error - (lambda args - (if (provided? 'trace) (print-call-stack (current-error-port))) - (cerror "Error: " args))) + (let ((cerror cerror)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (cerror "Error: " args)))) ;;; define these as appropriate for your system. (define slib:tab #\tab) diff --git a/math-integer.scm b/math-integer.scm new file mode 100644 index 0000000..1ce70f8 --- /dev/null +++ b/math-integer.scm @@ -0,0 +1,102 @@ +; "math-integer.scm": mathematical functions restricted to exact integers +; Copyright (C) 2006 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 'logical) ; srfi-60 + +;;@code{(require 'math-integer)} +;;@ftindex math-integer + +;;@body +;;Returns @1 raised to the power @2 if that result is an exact +;;integer; otherwise signals an error. +;; +;;@code{(integer-expt 0 @2)} +;; +;;returns 1 for @2 equal to 0; +;;returns 0 for positive integer @2; +;;signals an error otherwise. +(define (integer-expt n1 n2) + (cond ((and (exact? n1) (integer? n1) + (exact? n2) (integer? n2) + (not (and (not (<= -1 n1 1)) (negative? n2)))) + (expt n1 n2)) + (else (slib:error 'integer-expt n1 n2)))) + +;;@body +;;Returns the largest exact integer whose power of @1 is less than or +;;equal to @2. If @1 or @2 is not a positive exact integer, then +;;@0 signals an error. +(define (integer-log base k) + (define (ilog m b k) + (cond ((< k b) k) + (else + (set! n (+ n m)) + (let ((q (ilog (+ m m) (* b b) (quotient k b)))) + (cond ((< q b) q) + (else (set! n (+ m n)) + (quotient q b))))))) + (define n 1) + (define (eigt? k j) (and (exact? k) (integer? k) (> k j))) + (cond ((not (and (eigt? base 1) (eigt? k 0))) + (slib:error 'integer-log base k)) + ((< k base) 0) + (else (ilog 1 base (quotient k base)) n))) + +;;;; http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/math/isqrt/isqrt.txt +;;; Akira Kurihara +;;; School of Mathematics +;;; Japan Women's University + +;;@args k +;;For non-negative integer @1 returns the largest integer whose square +;;is less than or equal to @1; otherwise signals an error. +(define integer-sqrt + (let ((table '#(0 + 1 1 1 + 2 2 2 2 2 + 3 3 3 3 3 3 3 + 4 4 4 4 4 4 4 4 4)) + (square (lambda (x) (* x x)))) + (lambda (n) + (define (isqrt n) + (if (> n 24) + (let* ((len/4 (quotient (- (integer-length n) 1) 4)) + (top (isqrt (ash n (* -2 len/4)))) + (init (ash top len/4)) + (q (quotient n init)) + (iter (quotient (+ init q) 2))) + (cond ((odd? q) iter) + ((< (remainder n init) (square (- iter init))) (- iter 1)) + (else iter))) + (vector-ref table n))) + (if (and (exact? n) (integer? n) (not (negative? n))) + (isqrt n) + (slib:error 'integer-sqrt n))))) + +(define (must-be-exact-integer2 name proc) + (lambda (n1 n2) + (if (and (integer? n1) (integer? n2) (exact? n1) (exact? n2) + (not (zero? n2))) + (proc n1 n2) + (slib:error name n1 n2)))) +;;@body +;;are redefined so that they accept only exact-integer arguments. +(define quotient (must-be-exact-integer2 'quotient quotient)) +(define remainder (must-be-exact-integer2 'remainder remainder)) +(define modulo (must-be-exact-integer2 'modulo modulo)) diff --git a/math-integer.txi b/math-integer.txi new file mode 100644 index 0000000..b626a33 --- /dev/null +++ b/math-integer.txi @@ -0,0 +1,38 @@ +@code{(require 'math-integer)} +@ftindex math-integer + + +@defun integer-expt n1 n2 + +Returns @var{n1} raised to the power @var{n2} if that result is an exact +integer; otherwise signals an error. + +@code{(integer-expt 0 @var{n2})} + +returns 1 for @var{n2} equal to 0; +returns 0 for positive integer @var{n2}; +signals an error otherwise. +@end defun + + +@defun integer-log base k + +Returns the largest exact integer whose power of @var{base} is less than or +equal to @var{k}. If @var{base} or @var{k} is not a positive exact integer, then +@code{integer-log} signals an error. +@end defun + + +@defun integer-sqrt k + +For non-negative integer @var{k} returns the largest integer whose square +is less than or equal to @var{k}; otherwise signals an error. +@end defun + + +@defvar quotient +@defvarx remainder +@defvarx modulo + +are redefined so that they accept only exact-integer arguments. +@end defvar diff --git a/math-real.scm b/math-real.scm new file mode 100644 index 0000000..06971d2 --- /dev/null +++ b/math-real.scm @@ -0,0 +1,91 @@ +; "math-real.scm": mathematical functions restricted to real numbers +; Copyright (C) 2006 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. + +;@ +(define (quo x1 x2) (truncate (/ x1 x2))) +(define (rem x1 x2) (- x1 (* x2 (quo x1 x2)))) +(define (mod x1 x2) (- x1 (* x2 (floor (/ x1 x2))))) + +(define (must-be-real name proc) + (and proc + (lambda (x1) + (if (real? x1) (proc x1) (slib:error name x1))))) +(define (must-be-real+ name proc) + (and proc + (lambda (x1) + (if (and (real? x1) (>= x1 0)) + (proc x1) + (slib:error name x1))))) +(define (must-be-real-1+1 name proc) + (and proc + (lambda (x1) + (if (and (real? x1) (<= -1 x1 1)) + (proc x1) + (slib:error name x1))))) +;@ +(define ln (and (provided? 'real) log)) +(define abs (must-be-real 'abs abs)) +(define real-sin (must-be-real 'real-sin (and (provided? 'real) sin))) +(define real-cos (must-be-real 'real-cos (and (provided? 'real) cos))) +(define real-tan (must-be-real 'real-tan (and (provided? 'real) tan))) +(define real-exp (must-be-real 'real-exp (and (provided? 'real) exp))) +(define real-ln (must-be-real+ 'ln ln)) +(define real-sqrt (must-be-real+ 'real-sqrt (and (provided? 'real) sqrt))) +(define real-asin (must-be-real-1+1 'real-asin (and (provided? 'real) asin))) +(define real-acos (must-be-real-1+1 'real-acos (and (provided? 'real) acos))) + +(define (must-be-real2 name proc) + (and proc + (lambda (x1 x2) + (if (and (real? x1) (real? x2)) + (proc x1 x2) + (slib:error name x1 x2))))) +;@ +(define make-rectangular + (must-be-real2 'make-rectangular + (and (provided? 'complex) make-rectangular))) +(define make-polar + (must-be-real2 'make-polar (and (provided? 'complex) make-polar))) + +;@ +(define real-log + (and ln + (lambda (base x) + (if (and (real? x) (positive? x) (real? base) (positive? base)) + (/ (ln x) (ln base)) + (slib:error 'real-log base x))))) + +;@ +(define (real-expt x1 x2) + (cond ((and (real? x1) + (real? x2) + (or (not (negative? x1)) (integer? x2))) + (expt x1 x2)) + (else (slib:error 'real-expt x1 x2)))) + +;@ +(define real-atan + (and (provided? 'real) + (lambda (y . x) + (if (and (real? y) + (or (null? x) + (and (= 1 (length x)) + (real? (car x))))) + (apply atan y x) + (apply slib:error 'real-atan y x))))) diff --git a/mitscheme.init b/mitscheme.init index 6283230..be3df51 100644 --- a/mitscheme.init +++ b/mitscheme.init @@ -136,9 +136,9 @@ thunk (lambda () (exchange old))))))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -225,12 +225,12 @@ (define mit-scheme-has-r4rs-macros? (mit-scheme-release>= 7 7)) (if mit-scheme-has-r4rs-macros? - (set! *features* (cons 'macro *features*))) + (set! slib:features (cons 'macro slib:features))) (if (get-subsystem-version-string "6.001") ;; Runs code from "Structure and Interpretation of Computer ;; Programs" by Abelson and Sussman. - (set! *features* (cons 'sicp *features*))) + (set! slib:features (cons 'sicp slib:features))) (define current-time current-file-time) (define difftime -) @@ -413,12 +413,14 @@ (apply warn args)) ;; define an error procedure for the library -(define (slib:error first . args) - (if (provided? 'trace) (print-call-stack (current-error-port))) - (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 slib:error + (let ((error error)) + (lambda (first . args) + (if (provided? 'trace) (print-call-stack (current-error-port))) + (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")) diff --git a/mkclrnam.scm b/mkclrnam.scm index 3360a41..47acd1a 100644 --- a/mkclrnam.scm +++ b/mkclrnam.scm @@ -66,7 +66,7 @@ (define (load-rgb-txt path color-table) (cond ((not (file-exists? path)) (slib:error 'load-color-dictionary! 'file-exists? path))) - (write 'load-rgb-txt) (display #\ ) (write path) (newline) + (write 'load-rgb-txt) (display #\space) (write path) (newline) (let ((color-table:row-insert (color-table 'row:insert)) (color-table:row-retrieve (color-table 'row:retrieve)) (method-id #f)) diff --git a/mklibcat.scm b/mklibcat.scm index d26c821..19c5425 100644 --- a/mklibcat.scm +++ b/mklibcat.scm @@ -50,68 +50,68 @@ (library-vicinity) '( ;; null is the start of SLIB associations. - (null "null") - (aggregate "null") + (null source "null") + (aggregate source "null") (r2rs aggregate rev3-procedures rev2-procedures) (r3rs aggregate rev3-procedures) (r4rs aggregate rev4-optional-procedures) (r5rs aggregate values macro eval) - (rev4-optional-procedures "sc4opt") - (rev3-procedures "null") - (rev2-procedures "sc2") - (multiarg/and- "mularg") - (multiarg-apply "mulapply") - (rationalize "ratize") - (transcript "trnscrpt") - (with-file "withfile") - (dynamic-wind "dynwind") - (dynamic "dynamic") + (rev4-optional-procedures source "sc4opt") + (rev3-procedures source "null") + (rev2-procedures source "sc2") + (multiarg/and- source "mularg") + (multiarg-apply source "mulapply") + (rationalize source "ratize") + (transcript source "trnscrpt") + (with-file source "withfile") + (dynamic-wind source "dynwind") + (dynamic source "dynamic") (fluid-let defmacro "fluidlet") - (alist "alist") - (hash "hash") - (sierpinski "sierpinski") - (hilbert-fill "phil-spc") - (peano-fill "peanosfc") - (soundex "soundex") - (hash-table "hashtab") - (logical "logical") - (random "random") - (random-inexact "randinex") - (modular "modular") - (factor "factor") + (alist source "alist") + (hash source "hash") + (sierpinski source "sierpinski") + (hilbert-fill source "phil-spc") + (peano-fill source "peanosfc") + (soundex source "soundex") + (hash-table source "hashtab") + (logical source "logical") + (random source "random") + (random-inexact source "randinex") + (modular source "modular") + (factor source "factor") (primes factor) - (limit "limit") - (eps-graph "grapheps") - (charplot "charplot") - (sort "sort") + (limit source "limit") + (eps-graph source "grapheps") + (charplot source "charplot") + (sort source "sort") (tsort topological-sort) - (topological-sort "tsort") - (common-list-functions "comlist") - (tree "tree") - (coerce "coerce") - (format "format") - (generic-write "genwrite") - (pretty-print "pp") - (pprint-file "ppfile") - (object->string "obj2str") - (string-case "strcase") - (line-i/o "lineio") - (string-port "strport") - (getopt "getopt") - (qp "qp") - (eval "eval") - (record "record") - (synchk "synchk") - (defmacroexpand "defmacex") + (topological-sort source "tsort") + (common-list-functions source "comlist") + (tree source "tree") + (coerce source "coerce") + (format source "format") + (generic-write source "genwrite") + (pretty-print source "pp") + (pprint-file source "ppfile") + (object->string source "obj2str") + (string-case source "strcase") + (line-i/o source "lineio") + (string-port source "strport") + (getopt source "getopt") + (qp source "qp") + (eval source "eval") + (record source "record") + (synchk source "synchk") + (defmacroexpand source "defmacex") - (printf "printf") + (printf source "printf") (scanf defmacro "scanf") - (stdio-ports "stdio") + (stdio-ports source "stdio") (stdio aggregate scanf printf stdio-ports) (break defmacro "break") (trace defmacro "trace") - (debugf "debug") + (debugf source "debug") (debug aggregate trace break debugf) (delay promise) @@ -119,82 +119,84 @@ (macro-by-example defmacro "mbe") - (syntax-case "scainit") - (syntactic-closures "scmacro") - (macros-that-work "macwork") + (syntax-case source "scainit") + (syntactic-closures source "scmacro") + (macros-that-work source "macwork") (macro macro-by-example) - (object "object") + (object source "object") (yasos macro "yasyn") (oop yasos) - (collect "collectx") + (collect source "collectx") (structure syntax-case "structure") - (values "values") - (queue "queue") - (priority-queue "priorque") - (array "array") - (subarray "subarray") - (array-for-each "arraymap") - (array-interpolate "linterp") - (repl "repl") - (process "process") - (chapter-order "chap") - (posix-time "psxtime") - (common-lisp-time "cltime") - (time-core "timecore") + (values source "values") + (queue source "queue") + (priority-queue source "priorque") + (array source "array") + (subarray source "subarray") + (array-for-each source "arraymap") + (array-interpolate source "linterp") + (repl source "repl") + (process source "process") + (chapter-order source "chap") + (posix-time source "psxtime") + (common-lisp-time source "cltime") + (time-core source "timecore") (time-zone defmacro "timezone") - (relational-database "rdms") - (databases "dbutil") + (relational-database source "rdms") + (databases source "dbutil") (database-utilities databases) - (database-commands "dbcom") - (database-browse "dbrowse") - (database-interpolate "dbinterp") + (database-commands source "dbcom") + (database-browse source "dbrowse") + (database-interpolate source "dbinterp") (within-database macro "dbsyn") - (html-form "htmlform") - (alist-table "alistab") - (parameters "paramlst") - (getopt-parameters "getparam") - (read-command "comparse") - (batch "batch") - (glob "glob") + (html-form source "htmlform") + (alist-table source "alistab") + (parameters source "paramlst") + (getopt-parameters source "getparam") + (read-command source "comparse") + (batch source "batch") + (glob source "glob") (filename glob) - (crc "crc") - (fft "fft") - (wt-tree "wttree") - (string-search "strsrch") - (root "root") - (minimize "minimize") + (crc source "crc") + (dft source "dft") + (fft dft) + (Fourier-transform dft) + (wt-tree source "wttree") + (string-search source "strsrch") + (root source "root") + (minimize source "minimize") (precedence-parse defmacro "prec") (parse precedence-parse) - (commutative-ring "cring") - (self-set "selfset") - (determinant "determ") - (byte "byte") - (byte-number "bytenumb") - (tzfile "tzfile") - (schmooz "schmooz") + (commutative-ring source "cring") + (self-set source "selfset") + (determinant source "determ") + (byte source "byte") + (byte-number source "bytenumb") + (tzfile source "tzfile") + (schmooz source "schmooz") (transact defmacro "transact") (net-clients transact) - (db->html "db2html") + (db->html source "db2html") (http defmacro "http-cgi") (cgi http) (uri defmacro "uri") (uniform-resource-identifier uri) - (pnm "pnm") - (metric-units "simetrix") - (diff "differ") - (solid "solid") + (pnm source "pnm") + (metric-units source "simetrix") + (diff source "differ") + (solid source "solid") (vrml97 solid) (vrml vrml97) (color defmacro "color") - (color-space "colorspc") + (color-space source "colorspc") (cie color-space) - (color-names "colornam") + (color-names source "colornam") (color-database defmacro "mkclrnam") (resene color-names "clrnamdb.scm") (saturate color-names "clrnamdb.scm") (nbs-iscc color-names "clrnamdb.scm") - (daylight "daylight") - (matfile "matfile") + (daylight source "daylight") + (matfile source "matfile") (mat-file matfile) (spectral-tristimulus-values color-space) (cie1964 spectral-tristimulus-values "cie1964.xyz") @@ -202,14 +204,14 @@ (ciexyz cie1931) (cvs defmacro "cvs") (html-for-each defmacro "html4each") - (directory "dirs") + (directory source "dirs") (ncbi-dna defmacro "ncbi-dna") - (manifest "manifest") - (top-refs "top-refs") - (vet "vet") + (manifest source "manifest") + (top-refs source "top-refs") + (vet source "vet") (srfi-0 srfi) (srfi defmacro "srfi") - (srfi-1 "srfi-1") + (srfi-1 source "srfi-1") (and-let* srfi-2) (srfi-2 defmacro "srfi-2") (receive srfi-8) @@ -221,7 +223,11 @@ (srfi-60 logical) (guarded-cond-clause srfi-61) (srfi-61 macro "srfi-61") - (new-catalog "mklibcat") + (srfi-23 source "srfi-23") + (math-integer source "math-integer") + (math-real source "math-real") + (srfi-94 aggregate math-integer math-real) + (new-catalog source "mklibcat") )))) (let* ((req (in-vicinity (library-vicinity) (string-append "require" (scheme-file-suffix))))) diff --git a/modular.scm b/modular.scm index 052bf92..e77ced4 100644 --- a/modular.scm +++ b/modular.scm @@ -1,5 +1,5 @@ ;;;; "modular.scm", modular fixnum arithmetic for Scheme -;;; Copyright (C) 1991, 1993, 1995, 2001, 2002 Aubrey Jaffer +;;; Copyright (C) 1991, 1993, 1995, 2001, 2002, 2006 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,40 +17,9 @@ ;promotional, or sales literature without prior written consent in ;each case. -(require 'multiarg/and-) - ;;@code{(require 'modular)} ;;@ftindex modular -;;@body -;;These procedures implement the Common-Lisp functions of the same names. -;;The real number @var{x2} must be non-zero. -;;@code{mod} returns @code{(- @var{x1} (* @var{x2} (floor (/ @var{x1} @var{x2}))))}. -;;@code{rem} returns @code{(- @var{x1} (* @var{x2} (truncate (/ @var{x1} @var{x2}))))}. -;; -;;If @var{x1} and @var{x2} are integers, then @code{mod} behaves like -;;@code{modulo} and @code{rem} behaves like @code{remainder}. -;; -;;@format -;;@t{(mod -90 360) @result{} 270 -;;(rem -90 180) @result{} -90 -;; -;;(mod 540 360) @result{} 180 -;;(rem 540 360) @result{} 180 -;; -;;(mod (* 5/2 pi) (* 2 pi)) @result{} 1.5707963267948965 -;;(rem (* -5/2 pi) (* 2 pi)) @result{} -1.5707963267948965 -;;} -;;@end format -(define (mod x1 x2) - (if (and (integer? x1) (exact? x1) (integer? x2) (exact? x2)) - (modulo x1 x2) - (- x1 (* x2 (floor (/ x1 x2)))))) -(define (rem x1 x2) - (if (and (integer? x1) (exact? x1) (integer? x2) (exact? x2)) - (remainder x1 x2) - (- x1 (* x2 (truncate (/ x1 x2)))))) - ;;@args 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. @@ -59,30 +28,33 @@ (do ((r0 x r1) (r1 y (remainder r0 r1)) (u0 1 u1) (u1 0 (- u0 (* q u1))) (v0 0 v1) (v1 1 (- v0 (* q v1)))) - ;; (assert (= r0 (+ (* u0 x) (* v0 y)))) - ;; (assert (= r1 (+ (* u1 x) (* v1 y)))) ((zero? r1) (list r0 u0 v0)) (set! q (quotient r0 r1)))) (define modular:extended-euclid extended-euclid) ;;@body -;;Returns @code{(quotient (+ -1 n) -2)} for positive odd integer @var{n}. -(define (symmetric:modulus n) - (cond ((or (not (number? n)) (not (positive? n)) (even? n)) - (slib:error 'symmetric:modulus n)) - (else (quotient (+ -1 n) -2)))) +;;For odd positive integer @1, returns an object suitable for passing +;;as the first argument to @code{modular:} procedures, directing them +;;to return a symmetric modular number, ie. an @var{n} such that +;;@example +;;(<= (quotient @var{m} -2) @var{n} (quotient @var{m} 2) +;;@end example +(define (symmetric:modulus m) + (cond ((or (not (number? m)) (not (positive? m)) (even? m)) + (slib:error 'symmetric:modulus m)) + (else (quotient (+ -1 m) -2)))) ;;@args modulus ;;Returns the non-negative integer characteristic of the ring formed when ;;@var{modulus} is used with @code{modular:} procedures. -(define (modulus->integer m) - (cond ((negative? m) (- 1 m m)) +(define (modular:characteristic m) + (cond ((negative? m) (- 1 (+ m m))) ((zero? m) #f) (else m))) ;;@args modulus n -;;Returns the integer @code{(modulo @var{n} (modulus->integer +;;Returns the integer @code{(modulo @var{n} (modular:characteristic ;;@var{modulus}))} in the representation specified by @var{modulus}. (define modular:normalize (if (provided? 'bignum) @@ -115,17 +87,21 @@ ;;For all of these functions, if the first argument (@var{modulus}) is: ;;@table @code ;;@item positive? -;;Work as before. The result is between 0 and @var{modulus}. +;;Integers mod @var{modulus}. The result is between 0 and +;;@var{modulus}. ;; ;;@item zero? ;;The arguments are treated as integers. An integer is returned. -;; -;;@item negative? -;;The arguments and result are treated as members of the integers modulo -;;@code{(+ 1 (* -2 @var{modulus}))}, but with @dfn{symmetric} -;;representation; i.e. @code{(<= (- @var{modulus}) @var{n} -;;@var{modulus})}. ;;@end table +;; +;;@noindent +;;Otherwise, if @var{modulus} is a value returned by +;;@code{(symmetric:modulus @var{radix})}, then the arguments and +;;result are treated as members of the integers modulo @var{radix}, +;;but with @dfn{symmetric} representation; i.e. +;;@example +;;(<= (quotient @var{radix} 2) @var{n} (quotient (- -1 @var{radix}) 2) +;;@end example ;;@noindent ;;If all the arguments are fixnums the computation will use only fixnums. @@ -134,43 +110,44 @@ ;;Returns @code{#t} if there exists an integer n such that @var{k} * n ;;@equiv{} 1 mod @var{modulus}, and @code{#f} otherwise. (define (modular:invertable? m a) - (eqv? 1 (gcd (or (modulus->integer m) 0) a))) + (eqv? 1 (gcd (or (modular:characteristic m) 0) a))) ;;@args 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. (define (modular:invert m a) + (define (barf) (slib:error 'modular:invert "can't invert" m a)) (cond ((eqv? 1 (abs a)) a) ; unit (else - (let ((pm (modulus->integer m))) + (let ((pm (modular:characteristic m))) (cond (pm (let ((d (modular:extended-euclid (modular:normalize pm a) pm))) (if (= 1 (car d)) (modular:normalize m (cadr d)) - (slib:error 'modular:invert "can't invert" m a)))) - (else (slib:error 'modular:invert "can't invert" m a))))))) + (barf)))) + (else (barf))))))) ;;@args modulus n2 ;;Returns (@minus{}@var{n2}) mod @var{modulus}. (define (modular:negate m a) - (if (zero? a) 0 - (if (negative? m) (- a) - (- m a)))) + (cond ((zero? a) 0) + ((negative? m) (- a)) + (else (- m a)))) ;;; Being careful about overflow here ;;@args modulus n2 n3 ;;Returns (@var{n2} + @var{n3}) mod @var{modulus}. (define (modular:+ m a b) - (cond ((positive? m) - (modulo (+ (- a m) b) m)) + (cond ((positive? m) (modulo (+ (- a m) b) m)) ((zero? m) (+ a b)) + ;; m is negative ((negative? a) (if (negative? b) (let ((s (+ (- a m) b))) (if (negative? s) - (- s -1 m) + (- s (+ -1 m)) (+ s m))) (+ a b))) ((negative? b) (+ a b)) @@ -182,9 +159,7 @@ ;;@args modulus n2 n3 ;;Returns (@var{n2} @minus{} @var{n3}) mod @var{modulus}. (define (modular:- m a b) - (cond ((positive? m) (modulo (- a b) m)) - ((zero? m) (- a b)) - (else (modular:+ m a (- b))))) + (modular:+ m a (modular:negate m b))) ;;; See: L'Ecuyer, P. and Cote, S. "Implementing a Random Number Package ;;; with Splitting Facilities." ACM Transactions on Mathematical @@ -208,52 +183,53 @@ ((positive? m) (modulo (* a b) m)) (else (modular:normalize m (* a b))))) (lambda (m a b) - (let ((a0 a) - (p 0)) + (define a0 a) + (define p 0) + + (cond + ((zero? m) (* a b)) + ((negative? m) + ;; Need algorighm to work with symmetric representation. + (modular:normalize m (* a b))) + (else (cond - ((zero? m) (* a b)) - ((negative? m) - ;; This doesn't work for the full range of modulus M. - ;; Need algorighm to work with symmetric representation. - (modular:normalize m (* a b))) + ((< a modular:r)) + ((< b modular:r) (set! a b) (set! b a0) (set! a0 a)) (else - (cond - ((< a modular:r)) - ((< b modular:r) (set! a b) (set! b a0) (set! a0 a)) - (else - (set! a0 (modulo a modular:r)) - (let ((a1 (quotient a modular:r)) - (qh (quotient m modular:r)) - (rh (modulo m modular:r))) - (cond ((>= a1 modular:r) - (set! a1 (- a1 modular:r)) - (set! p (modulo (- (* modular:r (modulo b qh)) - (* (quotient b qh) rh)) m)))) - (cond ((not (zero? a1)) - (let ((q (quotient m a1))) - (set! p (- p (* (quotient b q) (modulo m a1)))) - (set! p (modulo (+ (if (positive? p) (- p m) p) - (* a1 (modulo b q))) m))))) - (set! p (modulo (- (* modular:r (modulo p qh)) - (* (quotient p qh) rh)) m))))) - (if (zero? a0) - p - (let ((q (quotient m a0))) - (set! p (- p (* (quotient b q) (modulo m a0)))) - (modulo (+ (if (positive? p) (- p m) p) - (* a0 (modulo b q))) m))))))))) + (set! a0 (modulo a modular:r)) + (let ((a1 (quotient a modular:r)) + (qh (quotient m modular:r)) + (rh (modulo m modular:r))) + (cond ((>= a1 modular:r) + (set! a1 (- a1 modular:r)) + (set! p (modulo (- (* modular:r (modulo b qh)) + (* (quotient b qh) rh)) m)))) + (cond ((not (zero? a1)) + (let ((q (quotient m a1))) + (set! p (- p (* (quotient b q) (modulo m a1)))) + (set! p (modulo (+ (if (positive? p) (- p m) p) + (* a1 (modulo b q))) m))))) + (set! p (modulo (- (* modular:r (modulo p qh)) + (* (quotient p qh) rh)) m))))) + (if (zero? a0) + p + (let ((q (quotient m a0))) + (set! p (- p (* (quotient b q) (modulo m a0)))) + (modulo (+ (if (positive? p) (- p m) p) + (* a0 (modulo b q))) m)))))))) ;;@args modulus n2 n3 ;;Returns (@var{n2} ^ @var{n3}) mod @var{modulus}. -(define (modular:expt m n xpn) - (cond ((= n 1) 1) - ((= n (- m 1)) (if (odd? xpn) n 1)) - ((zero? m) (expt n xpn)) +(define (modular:expt m base xpn) + (cond ((zero? m) (expt base xpn)) + ((= base 1) 1) + ((if (negative? m) (= -1 base) (= (- m 1) base)) + (if (odd? xpn) base 1)) ((negative? xpn) - (modular:expt m (modular:invert m n) (- xpn))) - ((zero? n) 0) + (modular:expt m (modular:invert m base) (- xpn))) + ((zero? base) 0) (else - (do ((x n (modular:* m x x)) + (do ((x base (modular:* m x x)) (j xpn (quotient j 2)) (acc 1 (if (even? j) acc (modular:* m x acc)))) ((<= j 1) diff --git a/modular.txi b/modular.txi index bf2cd52..666f52a 100644 --- a/modular.txi +++ b/modular.txi @@ -2,31 +2,6 @@ @ftindex modular -@defun mod x1 x2 -@defunx rem x1 x2 - -These procedures implement the Common-Lisp functions of the same names. -The real number @var{x2} must be non-zero. -@code{mod} returns @code{(- @var{x1} (* @var{x2} (floor (/ @var{x1} @var{x2}))))}. -@code{rem} returns @code{(- @var{x1} (* @var{x2} (truncate (/ @var{x1} @var{x2}))))}. - -If @var{x1} and @var{x2} are integers, then @code{mod} behaves like -@code{modulo} and @code{rem} behaves like @code{remainder}. - -@format -@t{(mod -90 360) @result{} 270 -(rem -90 180) @result{} -90 - -(mod 540 360) @result{} 180 -(rem 540 360) @result{} 180 - -(mod (* 5/2 pi) (* 2 pi)) @result{} 1.5707963267948965 -(rem (* -5/2 pi) (* 2 pi)) @result{} -1.5707963267948965 -} -@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}, @@ -34,13 +9,18 @@ Returns a list of 3 integers @code{(d x y)} such that d = gcd(@var{n1}, @end defun -@defun symmetric:modulus n +@defun symmetric:modulus m -Returns @code{(quotient (+ -1 n) -2)} for positive odd integer @var{n}. +For odd positive integer @var{m}, returns an object suitable for passing +as the first argument to @code{modular:} procedures, directing them +to return a symmetric modular number, ie. an @var{n} such that +@example +(<= (quotient @var{m} -2) @var{n} (quotient @var{m} 2) +@end example @end defun -@defun modulus->integer modulus +@defun modular:characteristic modulus Returns the non-negative integer characteristic of the ring formed when @var{modulus} is used with @code{modular:} procedures. @@ -49,7 +29,7 @@ Returns the non-negative integer characteristic of the ring formed when @defun modular:normalize modulus n -Returns the integer @code{(modulo @var{n} (modulus->integer +Returns the integer @code{(modulo @var{n} (modular:characteristic @var{modulus}))} in the representation specified by @var{modulus}. @end defun @@ -61,18 +41,22 @@ arguments are constrained by the following table: For all of these functions, if the first argument (@var{modulus}) is: @table @code @item positive? -Work as before. The result is between 0 and @var{modulus}. +Integers mod @var{modulus}. The result is between 0 and +@var{modulus}. @item zero? The arguments are treated as integers. An integer is returned. +@end table -@item negative? -The arguments and result are treated as members of the integers modulo -@code{(+ 1 (* -2 @var{modulus}))}, but with @dfn{symmetric} +@noindent +Otherwise, if @var{modulus} is a value returned by +@code{(symmetric:modulus @var{radix})}, then the arguments and +result are treated as members of the integers modulo @var{radix}, +but with @dfn{symmetric} representation; i.e. @cindex symmetric -representation; i.e. @code{(<= (- @var{modulus}) @var{n} -@var{modulus})}. -@end table +@example +(<= (quotient @var{radix} 2) @var{n} (quotient (- -1 @var{radix}) 2) +@end example @noindent If all the arguments are fixnums the computation will use only fixnums. diff --git a/peanosfc.scm b/peanosfc.scm index 5cac088..388be9f 100644 --- a/peanosfc.scm +++ b/peanosfc.scm @@ -1,5 +1,5 @@ ; "peanospc.scm": Peano space filling mapping -; Copyright (C) 2005 Aubrey Jaffer +; Copyright (C) 2005, 2006 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 @@ -26,24 +26,23 @@ ;;; Space filling curves and mathematical programming. ;;; Information and Control, 12:314-330, 1968. -(define (natural->tet-array scalar rank) - (do ((tets '() (cons (modulo scl 3) tets)) +(define (natural->trit-array scalar rank) + (do ((trits '() (cons (modulo scl 3) trits)) (scl scalar (quotient scl 3))) ((zero? scl) - (let* ((len (length tets)) - (depth (quotient (+ len rank -1) rank))) + (let ((depth (quotient (+ (length trits) rank -1) rank))) (define tra (make-array (A:fixZ8b 0) rank depth)) - (set! tets (reverse tets)) + (set! trits (reverse trits)) (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)))))) + (cond ((null? trits)) + (else (array-set! tra (car trits) rdx idx) + (set! trits (cdr trits)))))) tra)))) -(define (tet-array->natural tra) +(define (trit-array->natural tra) (define rank (car (array-dimensions tra))) (define depth (cadr (array-dimensions tra))) (define val 0) @@ -53,22 +52,20 @@ ((negative? rdx)) (set! val (+ (array-ref tra rdx idx) (* 3 val)))))) -(define (tet-array->coordinates tra) - (define rank (car (array-dimensions tra))) +(define (trit-array->natural-coordinates tra) (define depth (cadr (array-dimensions tra))) - (do ((rdx (+ -1 rank) (+ -1 rdx)) + (do ((rdx (+ -1 (car (array-dimensions tra))) (+ -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 (natural-coordinates->trit-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))) + (let ((tra (make-array (A:fixN8b 0) (length coords) depth))) (do ((rdx 0 (+ 1 rdx)) (cds coords (cdr cds))) ((null? cds)) @@ -82,63 +79,62 @@ (define parity 0) (define rank (car (array-dimensions tra))) (define depth (cadr (array-dimensions tra))) + (define rra (make-array (A:fixN8b 0) (car (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))) - (if (odd? tpar) (array-set! tra (- 2 v_ij) rdx idx)) - (set! parity (modulo (+ parity v_ij) 2)))))) + (let ((v_ij (array-ref tra rdx idx))) + (if (odd? (+ parity (array-ref rra rdx))) + (array-set! tra (- 2 v_ij) rdx idx)) + (set! parity (modulo (+ v_ij parity) 2)) + (array-set! rra (modulo (+ v_ij (array-ref rra rdx)) 2) rdx))))) ;;@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 (natural->peano-coordinates scalar rank) - (define tra (natural->tet-array scalar rank)) + (define tra (natural->trit-array scalar rank)) (peano-flip! tra) - (tet-array->coordinates tra)) + (trit-array->natural-coordinates tra)) ;;@body ;;Returns an exact nonnegative integer corresponding to @1, a list of ;;nonnegative integer coordinates. (define (peano-coordinates->natural coords) - (define tra (coordinates->tet-array coords)) + (define tra (natural-coordinates->trit-array coords)) (peano-flip! tra) - (tet-array->natural tra)) + (trit-array->natural tra)) ;;@body ;;Returns a list of @2 integer coordinates corresponding to exact ;;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 three^rank (expt 3 rank)) - (do ((edx 1 (* edx three^rank)) - (m 0 (+ 1 m))) + (define nine^rank (expt 9 rank)) + (do ((edx 1 (* edx nine^rank)) + (cdx 1 (* cdx 9))) ((>= (quotient edx 2) (abs scalar)) - (let ((tra (natural->tet-array (+ scalar (quotient edx 2)) rank)) - (offset (quotient (expt 3 m) 2))) + (let ((tra (natural->trit-array (+ scalar (quotient edx 2)) rank)) + (offset (quotient cdx 2))) (peano-flip! tra) - (map (lambda (k) (* (if (odd? m) -1 1) (- k offset))) - (tet-array->coordinates tra)))))) + (map (lambda (k) (- k offset)) + (trit-array->natural-coordinates tra)))))) ;;@body ;;Returns an exact integer corresponding to @1, a list of integer ;;coordinates. (define (peano-coordinates->integer coords) + (define nine^rank (expt 9 (length coords))) (define cobs (apply max (map abs coords))) - (let loop ((xpo 1)) - (define offset (quotient (expt 3 xpo) 2)) + (let loop ((edx 1) (cdx 1)) + (define offset (quotient cdx 2)) (if (>= offset cobs) - (let ((tra (coordinates->tet-array + (let ((tra (natural-coordinates->trit-array (map (lambda (elt) (+ elt offset)) coords)))) (peano-flip! tra) - ((if (odd? xpo) - +) - (- (tet-array->natural tra) - (quotient (expt 3 (* (length coords) xpo)) 2)))) - (loop (+ 1 xpo))))) + (- (trit-array->natural tra) + (quotient edx 2))) + (loop (* nine^rank edx) (* 9 cdx))))) diff --git a/plottest.scm b/plottest.scm deleted file mode 100644 index 0a1f1f6..0000000 --- a/plottest.scm +++ /dev/null @@ -1,46 +0,0 @@ -;"plottest.scm" test charplot.scm -;Copyright (C) 1992 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 'charplot) -(require 'random) -(require 'random-inexact) - -(define strophoid - (let ((l '())) - (do ((x -1.0 (+ x 0.05))) - ((> x 4.0)) - (let* ((a (/ (- 2 x) (+ 2 x)))) - (if (>= a 0.0) - (let* ((y (* x (sqrt a)))) - (set! l (cons (cons x y) l)) - (set! l (cons (cons x (- y)) l)))))) - l)) -(plot strophoid "x" "y") (newline) - -(histograph (do ((idx 99 (+ -1 idx)) - (lst '() (cons (* .02 (random:normal)) lst))) - ((negative? idx) lst)) - "normal") -(newline) - -(histograph (do ((idx 99 (+ -1 idx)) - (lst '() (cons (random 5) lst))) - ((negative? idx) lst)) - "random") -(newline) @@ -333,4 +333,5 @@ (else (slib:error 'pnm:array-write type 'unrecognized 'type)))) (call-with-open-ports (open-file port 'wb) - (lambda (port) (pnm:array-write type array maxval port))))) + (lambda (port) + (apply pnm:array-write type array maxval port comments))))) @@ -81,13 +81,13 @@ (do ((j (+ -1 tok:column) (+ -8 j))) ((> 8 j) (do ((i j (+ -1 i))) - ((>= 0 i)) - (display #\ ))) - (display slib:tab)) - (display "^ ") - (newline) - (for-each (lambda (x) (write x) (display #\ )) msgs) - (newline)) + ((>= 0 i) + (display "^ ") + (newline) + (for-each (lambda (x) (write x) (display #\space)) msgs) + (newline)) + (display #\space))) + (display slib:tab))) ;; Structure of lexical records. (define tok:make-rec cons) @@ -408,7 +408,7 @@ ((case fc ((#\-) (set! left-adjust #t) #f) ((#\+) (set! signed #t) #f) - ((#\ ) (set! blank #t) #f) + ((#\space) (set! blank #t) #f) ((#\#) (set! alternate-form #t) #f) ((#\0) (set! leading-0s #t) #f) (else #t))) @@ -454,18 +454,18 @@ ((<= width (string-length s)) s) (left-adjust (list - s (make-string (- width (string-length s)) #\ ))) + s (make-string (- width (string-length s)) #\space))) (else (list (make-string (- width (string-length s)) - (if leading-0s #\0 #\ )) + (if leading-0s #\0 #\space)) s)))) (loop (cdr args))))) ;; SLIB extension ((#\a #\A) ;#\a #\A are pretty-print - (require 'generic-write) (let ((os "") (pr precision)) + (require 'generic-write) (generic-write (car args) (not alternate-form) #f (cond ((and left-adjust (negative? pr)) @@ -502,15 +502,15 @@ (positive? sl))))) (cond ((and left-adjust (negative? precision)) (cond - ((> width pr) (out (make-string (- width pr) #\ ))))) + ((> width pr) (out (make-string (- width pr) #\space))))) (left-adjust (cond ((> width (- precision pr)) - (out (make-string (- width (- precision pr)) #\ ))))) + (out (make-string (- width (- precision pr)) #\space))))) ((not os)) ((<= width (string-length os)) (out os)) (else (and (out (make-string - (- width (string-length os)) #\ )) + (- width (string-length os)) #\space)) (out os))))) (loop (cdr args))) ((#\d #\D #\i #\I #\u #\U) diff --git a/pscheme.init b/pscheme.init index bc7a5e5..f2c35cf 100644 --- a/pscheme.init +++ b/pscheme.init @@ -1,6 +1,6 @@ -;;; "pscheme.init" SLIB init file for Pocket Scheme -*-scheme-*- +;;; "pscheme.init" SLIB init file for Pocket Scheme -*-scheme-*- ;;; Author: Ben Goetter <goetter@mazama.net> -;;; last revised for 1.1.0 on 16 October 2000 +;;; last revised for pscheme 1.3 and slib 3a3 on 5 April 2006 ;;; Initial work for 0.2.3 by Robert Goldman (goldman@htc.honeywell.com) ;;; SLIB orig Author: Aubrey Jaffer (agj @ alum.mit.edu) ;;; @@ -19,12 +19,8 @@ (define (scheme-implementation-home-page) "http://www.mazama.net/scheme/pscheme.htm") (define (implementation-vicinity) "\\Program Files\\Pocket Scheme\\") -(define (library-vicinity) (in-vicinity (implementation-vicinity) "slib\\")) -(define (home-vicinity) "\\My Documents\\") - -;(define (implementation-vicinity) "D:\\SRC\\PSCHEME\\BUILD\\TARGET\\X86\\NT\\DBG\\") -;(define (library-vicinity) "D:\\SRC\\SLIB\\") -;(define (home-vicinity) "D:\\SRC\\PSCHEME\\") +(define (library-vicinity) (in-vicinity (implementation-vicinity) "slib\\")) +(define (home-vicinity) "\\My Documents\\") ;@ (define in-vicinity string-append) ;@ @@ -93,110 +89,56 @@ (lambda () (set! old (exchange path))) thunk (lambda () (exchange old))))))) - -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB: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") - 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 - - 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 -; Undef this to get the SLIB TRACE macros -;;; 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 - +(define slib:features + '(source + r4rs + rev4-report + ieee-p1178 + rev4-optional-procedures + vicinity + srfi-59 + multiarg/and- + multiarg-apply + with-file + char-ready? + defmacro + rationalize + delay +; pscheme needs the R5RS arity-2 eval in order to define the following +; eval + dynamic-wind + full-continuation + srfi +; pscheme needs print-call-stack in order to define the following +; trace + system + string-port )) -;;; (OUTPUT-PORT-WIDTH <port>) -;;; (OUTPUT-PORT-HEIGHT <port>) -;; $BUGBUG completely bogus values. -(define (output-port-width . arg) 79) + +;; $BUGBUG completely bogus values. Need hooks into runtime to get better ones +;;@ (OUTPUT-PORT-WIDTH <port>) +(define (output-port-width . arg) 30) +;;@ (OUTPUT-PORT-HEIGHT <port>) (define (output-port-height . arg) 12) -;;; (TMPNAM) makes a temporary file name. +;;@ (TMPNAM) makes a temporary file name. (define tmpnam (let ((cntr 100)) (lambda () (set! cntr (+ 1 cntr)) (string-append "slib_" (number->string cntr))))) -;;; (FILE-EXISTS? <string>) -(define (file-exists? f) - (with-handlers (((lambda (x) #t) (lambda (x) #f))) - (close-input-port (open-input-file f)) - #t)) - -;; pscheme: current-error-port, delete-file, force-output already defined - +;; pscheme: current-error-port, delete-file, force-output, file-exists? already defined +;@ (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)) + ((r) (open-input-file filename)) + ((rb) (open-input-file filename 'lf-newline 'ascii)) + ((w) (open-output-file filename)) + ((wb) (open-output-file filename 'lf-newline 'ascii)) (else (slib:error 'open-file 'mode? modes)))) (define (port? obj) (or (input-port? port) (output-port? port))) (define (call-with-open-ports . ports) @@ -215,14 +157,18 @@ ((output-port? port) (close-output-port port)) (else (slib:error 'close-port 'port? port)))) +;;; $REVIEW - should pscheme make SLIB use its own binary I/O? + +;@ (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'"))) + (with-handlers + ;; the pscheme SYSTEM procedure raises an exn when it can't find the image to run. + ;; SYSTEM uses ShellExecuteEx where available, so we give it the document name to open + (((lambda (x) #t) (lambda (x) #f))) + (system url))) -;;; 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 ; (with-handlers ( @@ -238,21 +184,21 @@ ;;; So we patch it to 256. (define char-code-limit 256) -;;; MOST-POSITIVE-FIXNUM is used in modular.scm +;;@ MOST-POSITIVE-FIXNUM is used in modular.scm ;;; This is the most positive immediate-value fixnum in PScheme. (define most-positive-fixnum #x07FFFFFF) -;;; 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 defmacro in terms of our define-macro +;;@ Define defmacro in terms of our define-macro (define-macro (defmacro name args . body) `(define-macro (,name ,@args) ,@body)) @@ -261,82 +207,82 @@ ;(define macroexpand expand-macro) ;(define macroexpand-1 expand-macro-1) +;@ (define gentemp gensym) (define base:eval slib:eval) +;@ (define defmacro:eval slib:eval) -;; slib:eval-load definition moved to "require.scm" +;; slib:eval-load definition moved to "require.scm" +;@ (define (defmacro:load <pathname>) (slib:eval-load <pathname> defmacro:eval)) - +;@ (define slib:warn (lambda args (let ((port (current-error-port))) (display "Warn: " port) (for-each (lambda (x) (display x port)) args)))) -;;; Define an error procedure for the library +;;@ define an error procedure for the library (define slib:error error) -;;; As announced by feature string-port +;;@ As announced by feature string-port (define (call-with-output-string t) (let* ((p (open-output-string)) (r (t p)) (s (get-output-string p))) (close-output-port p) s)) - (define (call-with-input-string s t) (let* ((p (open-input-string s)) (r (t p))) (close-input-port p) r)) -;;; 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)) -;;; Support for older versions of Scheme. Not enough code for its own file. +;;@ 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 +;;@ 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 +;;@ Define SLIB:EXIT to be the implementation procedure to exit or ;;; return if exiting not supported. (define slib:exit exit) -;;; 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) (if (not (file-exists? f)) (set! f (string-append f (scheme-file-suffix)))) (load f)) -;;; (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 load) -;;; At this point SLIB:LOAD must be able to load SLIB files. +;;@ At this point SLIB:LOAD must be able to load SLIB files. (define slib:load slib:load-source) ;;; Pscheme and SLIB both define REQUIRE, so dispatch on argument type. -;;; The SLIB REQUIRE does accept strings, though this facility seems never to be used. (define pscheme:require require) (slib:load (in-vicinity (library-vicinity) "require")) (define slib:require require) @@ -53,7 +53,7 @@ (display " . ") (+ 3 (qp-obj cdrs (l-elt-room (- room 3) cdrs)))) ((< 11 room) - (display #\ ) + (display #\space) ((lambda (used) (+ (qp-pairs (cdr cdrs) (- room used)) used)) (+ 1 (qp-obj (car cdrs) (l-elt-room (- room 1) cdrs))))) @@ -69,7 +69,7 @@ (cond ((= (vector-length vect) i) 0) ((< 11 room) - (display #\ ) + (display #\space) ((lambda (used) (+ (qp-vect vect (+ i 1) (- room used)) used)) (+ 1 (qp-obj (vector-ref vect i) @@ -132,12 +132,12 @@ (lambda objs (cond ((not *qp-width*) - (for-each (lambda (x) (write x) (display #\ )) objs) + (for-each (lambda (x) (write x) (display #\space)) objs) (newline)) ((= 0 *qp-width*) (for-each (lambda (x) (if (procedure? x) (display "#[proc]") (write x)) - (display #\ )) objs)) + (display #\space)) objs)) (else (qp-pairs (cdr objs) (- *qp-width* diff --git a/require.scm b/require.scm index c8e8711..31d922d 100644 --- a/require.scm +++ b/require.scm @@ -17,7 +17,7 @@ ;promotional, or sales literature without prior written consent in ;each case. ;@ -(define *slib-version* "3a3") +(define *slib-version* "3a4") ;;;; MODULES ;@ @@ -76,7 +76,7 @@ (if (not *catalog*) (let ((slibcat (catalog:try-read (implementation-vicinity) "slibcat"))) (cond ((not (catalog/require-version-match? slibcat)) - (slib:load (in-vicinity (library-vicinity) "mklibcat")) + (slib:load-source (in-vicinity (library-vicinity) "mklibcat")) (set! slibcat (catalog:try-read (implementation-vicinity) "slibcat")))) (cond (slibcat @@ -84,8 +84,10 @@ (cadr (or (assq 'catalog:filter slibcat) '(#f identity)))) slibcat)))) - (set! *catalog* - (append (catalog:try-read (home-vicinity) "homecat") *catalog*)) + (and (home-vicinity) + (set! *catalog* + (append (catalog:try-read (home-vicinity) "homecat") + *catalog*))) (set! *catalog* (append (catalog:try-read (user-vicinity) "usercat") *catalog*)))) (and feature *catalog* (cdr (or (assq feature *catalog*) '(#f . #f))))) @@ -122,7 +124,7 @@ ;@ (define (provided? expression) (define feature-list (cons (scheme-implementation-type) - (cons (software-type) *features*))) + (cons (software-type) slib:features))) (define (provided? expression) (if (memq expression feature-list) #t (and *catalog* @@ -141,11 +143,11 @@ (slib:error 'slib:require 'unsupported 'feature feature)) ((symbol? path) (slib:provide feature) (slib:require path)) ((string? path) ;simple name - (and (not (eq? 'new-catalog feature)) (slib:provide feature)) + (if (not (eq? 'new-catalog feature)) (slib:provide feature)) (slib:load path)) (else ;dispatched loads - (slib:provide feature) (slib:require (car path)) + (if (not (eq? 'new-catalog feature)) (slib:provide feature)) (apply (case (car path) ((macro) macro:load) ((syntactic-closures) synclo:load) @@ -168,8 +170,8 @@ (if (slib:provided? feature?) (slib:require feature))) ;@ (define (provide feature) - (if (not (memq feature *features*)) - (set! *features* (cons feature *features*)))) + (if (not (memq feature slib:features)) + (set! slib:features (cons feature slib:features)))) ;@ (define slib:provide provide) @@ -181,11 +183,13 @@ (define require:provided? provided?) (define require:require require) -(if (and (string->number "0.0") (inexact? (string->number "0.0"))) - (slib:provide 'inexact)) +(let ((x (string->number "0.0"))) + (if (and x (inexact? x)) (slib:provide 'inexact))) (if (rational? (string->number "1/19")) (slib:provide 'rational)) -(if (real? (string->number "0.0")) (slib:provide 'real)) -(if (complex? (string->number "1+i")) (slib:provide 'complex)) +(let ((x (string->number "0.01"))) + (if (and (real? x) (not (integer? x))) (slib:provide 'real))) +(let ((z (string->number "0.01+i"))) + (if (and (complex? z) (not (real? z))) (slib:provide 'complex))) (let ((n (string->number "9999999999999999999999999999999"))) (if (and n (exact? n)) (slib:provide 'bignum))) @@ -224,7 +228,7 @@ (define report:print (lambda args - (for-each (lambda (x) (write x) (display #\ )) args) + (for-each (lambda (x) (write x) (display #\space)) args) (newline))) ;@ (define slib:report @@ -249,7 +253,7 @@ (scheme-implementation-version) 'on (software-type)))) (define slib:report-locations - (let ((features *features*)) + (let ((features slib:features)) (lambda args (define sit (scheme-implementation-type)) (define siv (string->symbol (scheme-implementation-version))) @@ -257,18 +261,18 @@ (report:print '(LIBRARY-VICINITY) 'is (library-vicinity)) (report:print '(SCHEME-FILE-SUFFIX) 'is (scheme-file-suffix)) (let* ((i (+ -1 5))) - (cond ((eq? (car features) (car *features*))) - (else (report:print 'loaded '*FEATURES* ':) (display slib:tab))) + (cond ((eq? (car features) (car slib:features))) + (else (report:print 'loaded 'SLIB:FEATURES ':) (display slib:tab))) (for-each (lambda (x) (cond ((eq? (car features) x) - (if (not (eq? (car features) (car *features*))) (newline)) - (report:print sit siv '*FEATURES* ':) + (if (not (eq? (car features) (car slib:features))) (newline)) + (report:print sit siv 'SLIB:FEATURES ':) (display slib:tab) (set! i (+ -1 5))) ((zero? i) (newline) (display slib:tab) (set! i (+ -1 5))) - ((not (= (+ -1 5) i)) (display #\ ))) + ((not (= (+ -1 5) i)) (display #\space))) (write x) (set! i (+ -1 i))) - *features*)) + slib:features)) (newline) (report:print sit siv '*CATALOG* ':) (catalog:get #f) @@ -51,19 +51,28 @@ ;;; School of Mathematics ;;; Japan Women's University ;@ -(define (integer-sqrt n) - (cond ((> n 24) (let* ((length/4 (quotient (- (integer-length n) 1) 4)) - (sqrt-top (integer-sqrt (ash n (* -2 length/4)))) - (init-value (ash sqrt-top length/4)) - (q (quotient n init-value)) - (iterated-value (quotient (+ init-value q) 2))) - (if (odd? q) iterated-value - (let ((m (- iterated-value init-value))) - (if (< (remainder n init-value) (* m m)) - (- iterated-value 1) - iterated-value))))) - ((> n 15) 4) ((> n 8) 3) ((> n 3) 2) ((> n 0) 1) ((> n -1) 0) - (else (slib:error 'integer-sqrt n)))) +(define integer-sqrt + (let ((table '#(0 + 1 1 1 + 2 2 2 2 2 + 3 3 3 3 3 3 3 + 4 4 4 4 4 4 4 4 4)) + (square (lambda (x) (* x x)))) + (lambda (n) + (define (isqrt n) + (if (> n 24) + (let* ((len/4 (quotient (- (integer-length n) 1) 4)) + (top (isqrt (ash n (* -2 len/4)))) + (init (ash top len/4)) + (q (quotient n init)) + (iter (quotient (+ init q) 2))) + (cond ((odd? q) iter) + ((< (remainder n init) (square (- iter init))) (- iter 1)) + (else iter))) + (vector-ref table n))) + (if (and (exact? n) (integer? n) (not (negative? n))) + (isqrt n) + (type-error 'integer-sqrt n))))) ;@ (define (newton:find-root f df/dx x_0 prec) @@ -174,7 +183,7 @@ (letrec ((stop? (cond ((procedure? prec) prec) ((and (integer? prec) (negative? prec)) - (lambda (x0 x1 fmax count) + (lambda (x0 f0 x1 f1 count) (>= count (- prec)))) (else (lambda (x0 f0 x1 f1 count) diff --git a/scheme2c.init b/scheme2c.init index 1bfbde4..ccc9a84 100644 --- a/scheme2c.init +++ b/scheme2c.init @@ -7,7 +7,7 @@ ;; NB this is for the 01nov91 (and, presumably, later ones, ;; although those may not need the bug fixes done at the end). ;; Earlier versions definitely aren't rev4 conformant. Check -;; `ieee-floating-point' and `system' in *features* for non-Sun un*x +;; `ieee-floating-point' and `system' in slib:features for non-Sun un*x ;; versions and `system' and the vicinity stuff (at least) for ;; non-un*x versions. @@ -126,9 +126,9 @@ (exchange old) val)))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -347,17 +347,16 @@ (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 #\space 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))) - (error 'slib-error: "~a" - (apply string-append - (map - (lambda (a) - (format " ~a" a)) - args)))) +(define slib:error + (let ((error error)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (error 'slib-error: "~a" + (apply string-append + (map (lambda (a) (format " ~a" a)) args)))))) ;; define these as appropriate for your system. (define slib:tab (integer->char 9)) diff --git a/scheme48.init b/scheme48.init index 0a91cf9..c7e91af 100644 --- a/scheme48.init +++ b/scheme48.init @@ -8,26 +8,33 @@ ,config ,load =scheme48/misc/packages.scm (define-structure slib-primitives - (export s48-modulo s48-atan s48-char->integer + (export s48-char->integer + s48-use! s48-getenv s48-current-time s48-time-seconds + (s48-access-mode :syntax) + s48-accessible? s48-system s48-current-error-port s48-force-output s48-with-handler s48-ascii->char 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 + (rename (char->integer s48-char->integer))) + ;; for `s48-use!' procedure + (subset ensures-loaded (ensure-loaded)) + (subset environments (environment-ref)) + (subset package-commands-internal (config-package)) + (subset package-mutation (package-open!)) + ;; primitives (modify posix (rename (current-time s48-current-time) (time-seconds s48-time-seconds) (lookup-environment-variable s48-getenv))) + (modify posix-files + (prefix s48-) + (expose access-mode accessible?)) (modify c-system-function (rename (system s48-system))) (modify i/o (rename (current-error-port s48-current-error-port) @@ -35,15 +42,14 @@ (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)) + (modify root-scheduler (rename (scheme-exit-now s48-exit)))) + (begin + ;; Here used to import builtin SRFI modules. + (define (s48-use! struct-name) + (let ((struc (environment-ref (config-package) struct-name))) + (ensure-loaded struc) + (package-open! (interaction-environment) (lambda () struc)))) + )) ,user ,open slib-primitives @@ -164,14 +170,14 @@ thunk (lambda () (exchange old))))))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") -;;; compiled ;can load compiled files - ;(SLIB:LOAD-COMPILED "filename") + compiled ;can load compiled files + ; here used for native modules vicinity srfi-59 @@ -223,7 +229,7 @@ ;Programs by Abelson and Sussman. defmacro ;has Common Lisp DEFMACRO ;;; record ;has user defined data structures - string-port ;has CALL-WITH-INPUT-STRING and +;;; string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING ;;; sort ;;; pretty-print @@ -259,14 +265,7 @@ ;;; (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))))) + (s48-accessible? f (s48-access-mode exists))) ;;; (DELETE-FILE <string>) (define (delete-file file-name) @@ -432,7 +431,8 @@ ;;; (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) +;;; See creation of "implcat" file at end of this file. +(define slib:load-compiled s48-use!) ;;; At this point SLIB:LOAD must be able to load SLIB files. (define slib:load slib:load-source) @@ -468,14 +468,6 @@ (define (program-arguments) (cons "scheme48" *args*)) ;@ -(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) @@ -483,9 +475,57 @@ (define (offset-time caltime offset) (+ caltime offset)) +;;; Scheme48-specific code +,push +,config + +;; 'record + +(define-interface slib-record-interface + (export record-modifier record-accessor record-constructor + record-predicate make-record-type)) + +(define-structure slib-record slib-record-interface + (open scheme record-types) + (files ((=scheme48 slib) record))) + +;; 'string-port + +(define-interface slib-string-port-interface + (export call-with-output-string call-with-input-string)) + +(define-structure slib-string-port slib-string-port-interface + (open scheme extended-ports) + (files ((=scheme48 slib) strport))) +,pop + +;;; Write slib.image (require #f) ,collect ,batch off -,dump slib.image "(slib 3a3)" +,dump slib.image "(slib 3a4)" + +;;; Put Scheme48-specific code into catalog +(call-with-output-file (in-vicinity (implementation-vicinity) "implcat") + (lambda (op) + (define (display* . args) + (for-each (lambda (arg) (display arg op)) args) + (newline op)) + (display* "(") + (for-each + (lambda (idx) + (define srfi + (string->symbol (string-append "srfi-" (number->string idx)))) + (display* " " (list srfi 'compiled srfi))) + '(1 2 5 6 7 8 9 11 13 14 16 17 23 25 26 27 28 31 34 35 36 37 42 45)) + (for-each + (lambda (f) + (define module + (string->symbol (string-append "slib-" (symbol->string f)))) + (display* " " (list f 'compiled module))) + '(record string-port)) + (display* ")"))) +(require 'new-catalog) + ,exit diff --git a/schmooz.scm b/schmooz.scm index 9755260..75ddfa7 100644 --- a/schmooz.scm +++ b/schmooz.scm @@ -42,7 +42,7 @@ (define qreport (lambda args - (for-each (lambda (x) (write x) (display #\ )) args) + (for-each (lambda (x) (write x) (display #\space)) args) (newline))) ;;; This allows us to test without generating files @@ -65,7 +65,7 @@ ((> 8 j) (do ((i j (- i 1))) ((>= 0 i)) - (display #\ *derived-txi*))) + (display #\space *derived-txi*))) (display #\ *derived-txi*)))) (for-each (lambda (a) (cond ((symbol? a) @@ -113,9 +113,9 @@ thunk (lambda () (exchange old))))))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -314,12 +314,14 @@ (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 #\space 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 slib:error + (let ((error error)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (apply error args)))) ;;; define these as appropriate for your system. (define slib:tab (ascii->char 9)) diff --git a/simetrix.scm b/simetrix.scm index caf858e..e066daf 100644 --- a/simetrix.scm +++ b/simetrix.scm @@ -1,5 +1,5 @@ ;;;; "simetrix.scm" SI Metric Interchange Format for Scheme -;;; Copyright (C) 2000, 2001 Aubrey Jaffer +;;; Copyright (C) 2000, 2001, 2006 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 @@ -112,7 +112,7 @@ ("B" pin "8.b") ("g" all #f) ("t" pos "Mg") - ("u" none "1.66053873e-27.kg") + ("u" none "1.66053886e-27.kg") ("mol" all #f) ("kat" all "mol/s") ("K" all #f) @@ -123,7 +123,7 @@ ("N" all "m.kg/s^2") ("Pa" all "N/m^2") ("J" all "N.m") - ("eV" all "1.602176462e-19.J") + ("eV" all "1.60217653e-19.J") ("W" all "J/s") ("Np" neg #f) ("dB" none ,(string-append (number->string (/ (log 10) 20)) ".Np")) @@ -36,7 +36,7 @@ and scores of others. .SH SEE ALSO The SLIB home-page: .br -http://swissnet.ai.mit.edu/~jaffer/SLIB.html +http://swiss.csail.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 @@ -33,7 +33,7 @@ AUTHORS SEE ALSO The SLIB home-page: - http://swissnet.ai.mit.edu/~jaffer/SLIB.html + http://swiss.csail.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 @@ -1,39 +1,51 @@ -This is slib.info, produced by makeinfo version 4.7 from slib.texi. +This is slib.info, produced by makeinfo version 4.8 from slib.texi. +This manual is for SLIB (version 3a4, October 2006), the portable | +Scheme library. | + | +Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, | +2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. | + | + Permission is granted to copy, distribute and/or modify this | + document under the terms of the GNU Free Documentation License, | + Version 1.2 or any later version published by the Free Software | + Foundation; with no Invariant Sections, with the Front-Cover Texts | + being "A GNU Manual," and with the Back-Cover Texts as in (a) | + below. A copy of the license is included in the section entitled | + "GNU Free Documentation License." | + | + (a) The FSF's Back-Cover Text is: "You have freedom to copy and | + modify this GNU Manual, like GNU software. Copies published by | + the Free Software Foundation raise funds for GNU development." | + | INFO-DIR-SECTION The Algorithmic Language Scheme START-INFO-DIR-ENTRY * SLIB: (slib). Scheme Library END-INFO-DIR-ENTRY - This file documents SLIB, the portable Scheme library. - - Copyright (C) 1993 Todd R. Eigenschink -Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -2002 Aubrey Jaffer - - Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. + +File: slib.info, Node: Top, Next: The Library System, Prev: (dir), Up: (dir) + | +SLIB | +**** | - Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. +This manual is for SLIB (version 3a4, October 2006), the portable | +Scheme library. | - 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. +Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, | +2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. | - -File: slib.info, Node: Top, Next: The Library System, Prev: (dir), Up: (dir) + Permission is granted to copy, distribute and/or modify this | + document under the terms of the GNU Free Documentation License, | + Version 1.2 or any later version published by the Free Software | + Foundation; with no Invariant Sections, with the Front-Cover Texts | + being "A GNU Manual," and with the Back-Cover Texts as in (a) | + below. A copy of the license is included in the section entitled | + "GNU Free Documentation License." | -"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 useful -packages for all Scheme implementations. Its catalog can be -transparently extended to accomodate packages specific to a site, -implementation, user, or directory. + (a) The FSF's Back-Cover Text is: "You have freedom to copy and | + modify this GNU Manual, like GNU software. Copies published by | + the Free Software Foundation raise funds for GNU development." | * Menu: @@ -53,6 +65,13 @@ File: slib.info, Node: The Library System, Next: Universal SLIB Procedures, P 1 The Library System ******************** +"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 useful | +packages for all Scheme implementations. Its catalog can be | +transparently extended to accomodate packages specific to a site, | +implementation, user, or directory. | + | * Menu: * Feature:: SLIB names. @@ -279,10 +298,10 @@ the actual pathnames of files can differ from installation to installation, SLIB builds a separate catalog for each implementation it is used with. -The definition of `*slib-version*' in SLIB file `require.scm' is | -checked against the catalog association of `*slib-version*' to | +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 | +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. @@ -853,7 +872,7 @@ implementations. implementation and the name of the operating system. An unspecified value is returned. - (slib:report-version) => slib "3a3" on scm "5b1" on unix | + (slib:report-version) => slib "3a4" on scm "5b1" on unix | -- Function: slib:report Displays the information of `(slib:report-version)' followed by @@ -868,15 +887,15 @@ implementations. (slib:report) => - slib "3a3" on scm "5b1" on unix | + slib "3a4" 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* : + loaded slib:features : | trace alist qp sort common-list-functions macro values getopt compiled - implementation *features* : + implementation slib:features : | bignum complex real rational inexact vicinity ed getenv tmpnam abort transcript with-file @@ -1122,7 +1141,7 @@ Language changes: (r4rs)Notes.). They are provided by all SLIB implementations. -- Constant: t - Derfined as `#t'. + Defined as `#t'. | -- Constant: nil Defined as `#f'. @@ -1154,11 +1173,11 @@ File: slib.info, Node: Scheme Syntax Extension Packages, Next: Textual Convers Syntax extensions (macros) included with SLIB. * Define-Structure:: 'structure -* Define-Record-Type:: 'define-record-type, 'srfi-9 | +* Define-Record-Type:: 'define-record-type, 'srfi-9 * Fluid-Let:: 'fluid-let -* Binding to multiple values:: 'receive, 'srfi-8 | -* Guarded LET* special form:: 'and-let*, 'srfi-2 | -* Guarded COND Clause:: 'guarded-cond-clause, 'srfi-61 | +* Binding to multiple values:: 'receive, 'srfi-8 +* Guarded LET* special form:: 'and-let*, 'srfi-2 +* Guarded COND Clause:: 'guarded-cond-clause, 'srfi-61 * Yasos:: 'yasos, 'oop, 'collect @@ -2016,7 +2035,7 @@ if there is some incompatibility that is not flagged as such. File: slib.info, Node: Define-Structure, Next: Define-Record-Type, Prev: Syntax-Case Macros, Up: Scheme Syntax Extension Packages - | + 3.7 Define-Structure ==================== @@ -2069,27 +2088,27 @@ a macro `define-structure'. Here is its documentation from Gambit 4.0: File: slib.info, Node: Define-Record-Type, Next: Fluid-Let, Prev: Define-Structure, Up: Scheme Syntax Extension Packages - | -3.8 Define-Record-Type | -====================== | - | -`(require 'define-record-type)' or `(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. | - | + +3.8 Define-Record-Type +====================== + +`(require 'define-record-type)' or `(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: Fluid-Let, Next: Binding to multiple values, Prev: Define-Record-Type, Up: Scheme Syntax Extension Packages - | -3.9 Fluid-Let | + +3.9 Fluid-Let ============= `(require 'fluid-let)' @@ -2113,81 +2132,81 @@ of its corresponding VARIABLE. File: slib.info, Node: Binding to multiple values, Next: Guarded LET* special form, Prev: Fluid-Let, Up: Scheme Syntax Extension Packages - | -3.10 Binding to multiple values | -=============================== | - | -`(require 'receive)' or `(require 'srfi-8)' | - | - -- Special Form: receive formals expression body ... | - `http://srfi.schemers.org/srfi-8/srfi-8.html' | - | + +3.10 Binding to multiple values +=============================== + +`(require 'receive)' or `(require 'srfi-8)' + + -- Special Form: receive formals expression body ... + `http://srfi.schemers.org/srfi-8/srfi-8.html' + File: slib.info, Node: Guarded LET* special form, Next: Guarded COND Clause, Prev: Binding to multiple values, Up: Scheme Syntax Extension Packages - | -3.11 Guarded LET* special form | -============================== | - | -`(require 'and-let*)' or `(require 'srfi-2)' | - | - -- Macro: and-let* claws body ... | - `http://srfi.schemers.org/srfi-2/srfi-2.html' | - | + +3.11 Guarded LET* special form +============================== + +`(require 'and-let*)' or `(require 'srfi-2)' + + -- Macro: and-let* claws body ... + `http://srfi.schemers.org/srfi-2/srfi-2.html' + File: slib.info, Node: Guarded COND Clause, Next: Yasos, Prev: Guarded LET* special form, Up: Scheme Syntax Extension Packages - | -3.12 Guarded COND Clause | -======================== | - | -`(require 'guarded-cond-clause)' or `(require 'srfi-61)' | - | - `http://srfi.schemers.org/srfi-61/srfi-61.html' | - | - -- library syntax: cond <clause1> <clause2> ... | - _Syntax:_ Each <clause> should be of the form | - | - (<test> <expression1> ...) | - | - where <test> is any expression. Alternatively, a <clause> may be | - of the form | - | - (<test> => <expression>) | - | - The <clause> production in the formal syntax of Scheme as written | - by R5RS in section 7.1.3 is extended with a new option: | - | - <clause> => (<generator> <guard> => <receiver>) | - | - where <generator>, <guard>, & <receiver> are all <expression>s. | - | - Clauses of this form have the following semantics: | - <generator> is evaluated. It may return arbitrarily many | - values. <Guard> is applied to an argument list containing | - the values in order that <generator> returned. If <guard> | - returns a true value for that argument list, <receiver> is | - applied with an equivalent argument list. If <guard> returns | - a false value, however, the clause is abandoned and the next | - one is tried. | - | - The last <clause> may be an "else clause," which has the form | - | - (else <expression1> <expression2> ...). | - | -This `port->char-list' procedure accepts an input port and returns a | -list of all the characters it produces until the end. | - | - (define (port->char-list port) | - (cond ((read-char port) char? | - => (lambda (c) (cons c (port->char-list port)))) | - (else '()))) | - | - (call-with-input-string "foo" port->char-list) ==> (#\f #\o #\o) | - | + +3.12 Guarded COND Clause +======================== + +`(require 'guarded-cond-clause)' or `(require 'srfi-61)' + + `http://srfi.schemers.org/srfi-61/srfi-61.html' + + -- library syntax: cond <clause1> <clause2> ... + _Syntax:_ Each <clause> should be of the form + + (<test> <expression1> ...) + + where <test> is any expression. Alternatively, a <clause> may be + of the form + + (<test> => <expression>) + + The <clause> production in the formal syntax of Scheme as written + by R5RS in section 7.1.3 is extended with a new option: + + <clause> => (<generator> <guard> => <receiver>) + + where <generator>, <guard>, & <receiver> are all <expression>s. + + Clauses of this form have the following semantics: + <generator> is evaluated. It may return arbitrarily many + values. <Guard> is applied to an argument list containing + the values in order that <generator> returned. If <guard> + returns a true value for that argument list, <receiver> is + applied with an equivalent argument list. If <guard> returns + a false value, however, the clause is abandoned and the next + one is tried. + + The last <clause> may be an "else clause," which has the form + + (else <expression1> <expression2> ...). + +This `port->char-list' procedure accepts an input port and returns a +list of all the characters it produces until the end. + + (define (port->char-list port) + (cond ((read-char port) char? + => (lambda (c) (cons c (port->char-list port)))) + (else '()))) + + (call-with-input-string "foo" port->char-list) ==> (#\f #\o #\o) + File: slib.info, Node: Yasos, Prev: Guarded COND Clause, Up: Scheme Syntax Extension Packages - | -3.13 Yasos | -========== | + +3.13 Yasos +========== `(require 'oop)' or `(require 'yasos)' @@ -2211,8 +2230,8 @@ on LISP and Functional Programming, July 1988 [ACM #552880]. File: slib.info, Node: Yasos terms, Next: Yasos interface, Prev: Yasos, Up: Yasos -3.13.1 Terms | ------------- | +3.13.1 Terms +------------ "Object" Any Scheme data object. @@ -2242,8 +2261,8 @@ _Disclaimer:_ File: slib.info, Node: Yasos interface, Next: Setters, Prev: Yasos terms, Up: Yasos -3.13.2 Interface | ----------------- | +3.13.2 Interface +---------------- -- Syntax: define-operation `('opname self arg ...`)' DEFAULT-BODY Defines a default behavior for data objects which don't handle the @@ -2288,8 +2307,8 @@ File: slib.info, Node: Yasos interface, Next: Setters, Prev: Yasos terms, Up File: slib.info, Node: Setters, Next: Yasos examples, Prev: Yasos interface, Up: Yasos -3.13.3 Setters | --------------- | +3.13.3 Setters +-------------- "Setters" implement "generalized locations" for objects associated with some sort of mutable state. A "getter" operation retrieves a value @@ -2346,8 +2365,8 @@ through `setf'. File: slib.info, Node: Yasos examples, Prev: Setters, Up: Yasos -3.13.4 Examples | ---------------- | +3.13.4 Examples +--------------- ;;; These definitions for PRINT and SIZE are ;;; already supplied by @@ -2529,9 +2548,9 @@ 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://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. +(`http://swiss.csail.mit.edu/~jaffer/JACAL') uses precedence-parse. | +Its grammar definitions in the file `jacal/English.scm' can serve as | +examples of use. | ---------- Footnotes ---------- @@ -2627,7 +2646,7 @@ variable (for use when calling `prec:parse'). The token DELIM may be a character, symbol, or string. A character DELIM argument will match only a character token; i.e. a - character for which no token-group is assigned. A symbols or + character for which no token-group is assigned. A symbol or | string will match only a token string; i.e. a token resulting from a token group. @@ -5792,16 +5811,18 @@ File: slib.info, Node: Mathematical Packages, Next: Database Packages, Prev: * Bit-Twiddling:: 'logical * Modular Arithmetic:: 'modular +* Irrational Integer Functions:: | +* Irrational Real Functions:: | * Prime Numbers:: 'factor * Random Numbers:: 'random -* Fast Fourier Transform:: 'fft +* Discrete Fourier Transform:: 'dft | * Cyclic Checksum:: 'crc * Graphing:: * Solid Modeling:: VRML97 * Color:: * Root Finding:: 'root * Minimizing:: 'minimize -* The Limit:: 'limit | +* The Limit:: 'limit * Commutative Rings:: 'commutative-ring * Matrix Algebra:: 'determinant @@ -5811,7 +5832,7 @@ File: slib.info, Node: Bit-Twiddling, Next: Modular Arithmetic, Prev: Mathema 5.1 Bit-Twiddling ================= -`(require 'logical)' +`(require 'logical)' or `(require 'srfi-60)' | The bit-twiddling functions are made available through the use of the `logical' package. `logical' is loaded by inserting `(require @@ -6037,61 +6058,45 @@ representation. Returns the integer coded by the BOOL1 ... arguments. -File: slib.info, Node: Modular Arithmetic, Next: Prime Numbers, Prev: Bit-Twiddling, Up: Mathematical Packages - +File: slib.info, Node: Modular Arithmetic, Next: Irrational Integer Functions, Prev: Bit-Twiddling, Up: Mathematical Packages + | 5.2 Modular Arithmetic ====================== `(require 'modular)' - - -- 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 - (/ X1 X2))))'. - - If X1 and X2 are integers, then `mod' behaves like `modulo' and - `rem' behaves like `remainder'. - - (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 Returns a list of 3 integers `(d x y)' such that d = gcd(N1, N2) = N1 * x + N2 * y. - -- Function: symmetric:modulus n - Returns `(quotient (+ -1 n) -2)' for positive odd integer N. + -- Function: symmetric:modulus m | + For odd positive integer M, returns an object suitable for passing | + as the first argument to `modular:' procedures, directing them to | + return a symmetric modular number, ie. an N such that | + (<= (quotient M -2) N (quotient M 2) | - -- Function: modulus->integer modulus + -- Function: modular:characteristic modulus | Returns the non-negative integer characteristic of the ring formed when MODULUS is used with `modular:' procedures. -- Function: modular:normalize modulus n - Returns the integer `(modulo N (modulus->integer MODULUS))' in the - representation specified by MODULUS. + Returns the integer `(modulo N (modular:characteristic MODULUS))' | + in the representation specified by MODULUS. | The rest of these functions assume normalized arguments; That is, the arguments are constrained by the following table: For all of these functions, if the first argument (MODULUS) is: `positive?' - Work as before. The result is between 0 and MODULUS. + Integers mod MODULUS. The result is between 0 and MODULUS. | `zero?' The arguments are treated as integers. An integer is returned. -`negative?' - The arguments and result are treated as members of the integers - modulo `(+ 1 (* -2 MODULUS))', but with "symmetric" representation; - i.e. `(<= (- MODULUS) N MODULUS)'. +Otherwise, if MODULUS is a value returned by `(symmetric:modulus | +RADIX)', then the arguments and result are treated as members of the | +integers modulo RADIX, but with "symmetric" representation; i.e. | + (<= (quotient RADIX 2) N (quotient (- -1 RADIX) 2) | If all the arguments are fixnums the computation will use only fixnums. @@ -6122,9 +6127,151 @@ If all the arguments are fixnums the computation will use only fixnums. Returns (N2 ^ N3) mod MODULUS. -File: slib.info, Node: Prime Numbers, Next: Random Numbers, Prev: Modular Arithmetic, Up: Mathematical Packages - -5.3 Prime Numbers +File: slib.info, Node: Irrational Integer Functions, Next: Irrational Real Functions, Prev: Modular Arithmetic, Up: Mathematical Packages + | +5.3 Irrational Integer Functions | +================================ | + | +`(require 'math-integer)' | + | + -- Function: integer-expt n1 n2 | + Returns N1 raised to the power N2 if that result is an exact | + integer; otherwise signals an error. | + | + `(integer-expt 0 N2)' | + | + returns 1 for N2 equal to 0; returns 0 for positive integer N2; | + signals an error otherwise. | + | + -- Function: integer-log base k | + Returns the largest exact integer whose power of BASE is less than | + or equal to K. If BASE or K is not a positive exact integer, then | + `integer-log' signals an error. | + | + -- Function: integer-sqrt k | + For non-negative integer K returns the largest integer whose square | + is less than or equal to K; otherwise signals an error. | + | + -- Variable: quotient | + -- Variable: remainder | + -- Variable: modulo | + are redefined so that they accept only exact-integer arguments. | + | + +File: slib.info, Node: Irrational Real Functions, Next: Prime Numbers, Prev: Irrational Integer Functions, Up: Mathematical Packages + | +5.4 Irrational Real Functions | +============================= | + | +`(require 'math-real)' | + | + Although this package defines real and complex functions, it is safe | +to load into an integer-only implementation; those functions will be | +defined to #f. | + | + -- Function: real-exp X | + -- Function: real-ln X | + -- Function: real-log Y X | + -- Function: real-sin X | + -- Function: real-cos X | + -- Function: real-tan X | + -- Function: real-asin X | + -- Function: real-acos X | + -- Function: real-atan X | + -- Function: atan Y X | + These procedures are part of every implementation that supports | + general real numbers; they compute the usual transcendental | + functions. `real-ln' computes the natural logarithm of X; | + `real-log' computes the logarithm of X base Y, which is `(/ | + (real-ln x) (real-ln y))'. If arguments X and Y are not both | + real; or if the correct result would not be real, then these | + procedures signal an error. | + | + | + -- Function: real-sqrt X | + For non-negative real X the result will be its positive square | + root; otherwise an error will be signaled. | + | + | + -- Function: real-expt x1 x2 | + Returns X1 raised to the power X2 if that result is a real number; | + otherwise signals an error. | + | + `(real-expt 0.0 X2)' | + | + * returns 1.0 for X2 equal to 0.0; | + | + * returns 0.0 for positive real X2; | + | + * signals an error otherwise. | + | + | + -- Function: quo x1 x2 | + -- Function: rem x1 x2 | + -- Function: mod x1 x2 | + X2 should be non-zero. | + | + (quo X1 X2) ==> N_Q | + (rem X1 X2) ==> X_R | + (mod X1 X2) ==> X_M | + | + where N_Q is X1/X2 rounded towards zero, 0 < |X_R| < |X2|, 0 < | + |X_M| < |X2|, X_R and X_M differ from X1 by a multiple of X2, X_R | + has the same sign as X1, and X_M has the same sign as X2. | + | + From this we can conclude that for X2 not equal to 0, | + | + (= X1 (+ (* X2 (quo X1 X2)) | + (rem X1 X2))) | + ==> #t | + | + provided all numbers involved in that computation are exact. | + | + (quo 2/3 1/5) ==> 3 | + (mod 2/3 1/5) ==> 1/15 | + | + (quo .666 1/5) ==> 3.0 | + (mod .666 1/5) ==> 65.99999999999995e-3 | + | + -- Function: ln Z | + These procedures are part of every implementation that supports | + general real numbers. `Ln' computes the natural logarithm of Z | + | + In general, the mathematical function ln is multiply defined. The | + value of ln Z is defined to be the one whose imaginary part lies | + in the range from -pi (exclusive) to pi (inclusive). | + | + | + -- Function: abs x | + For real argument X, `Abs' returns the absolute value of X' | + otherwise it signals an error. | + | + (abs -7) ==> 7 | + | + | + -- Function: make-rectangular x1 x2 | + -- Function: make-polar x3 x4 | + These procedures are part of every implementation that supports | + general complex numbers. Suppose X1, X2, X3, and X4 are real | + numbers and Z is a complex number such that | + | + Z = X1 + X2i = X3 . e^i X4 | + | + Then | + | + (make-rectangular X1 X2) ==> Z | + (make-polar X3 X4) ==> Z | + | + where -pi < x_angle <= pi with x_angle = X4 + 2pi n for some | + integer n. | + | + If an argument is not real, then these procedures signal an error. | + | + | + +File: slib.info, Node: Prime Numbers, Next: Random Numbers, Prev: Irrational Real Functions, Up: Mathematical Packages + | +5.5 Prime Numbers | ================= `(require 'factor)' @@ -6167,9 +6314,9 @@ the Solovay-Strassen primality test. See `(sort! (factor K) <)'. -File: slib.info, Node: Random Numbers, Next: Fast Fourier Transform, Prev: Prime Numbers, Up: Mathematical Packages - -5.4 Random Numbers +File: slib.info, Node: Random Numbers, Next: Discrete Fourier Transform, Prev: Prime Numbers, Up: Mathematical Packages + | +5.6 Random Numbers | ================== A pseudo-random number generator is only as good as the tests it passes. @@ -6191,7 +6338,7 @@ from sequential bytes, tests fail. With the seed File: slib.info, Node: Exact Random Numbers, Next: Inexact Random Numbers, Prev: Random Numbers, Up: Random Numbers -5.4.1 Exact Random Numbers +5.6.1 Exact Random Numbers | -------------------------- `(require 'random)' @@ -6243,7 +6390,7 @@ File: slib.info, Node: Exact Random Numbers, Next: Inexact Random Numbers, Pr File: slib.info, Node: Inexact Random Numbers, Prev: Exact Random Numbers, Up: Random Numbers -5.4.2 Inexact Random Numbers +5.6.2 Inexact Random Numbers | ---------------------------- `(require 'random-inexact)' @@ -6287,21 +6434,58 @@ File: slib.info, Node: Inexact Random Numbers, Prev: Exact Random Numbers, Up squares of the numbers is returned. -File: slib.info, Node: Fast Fourier Transform, Next: Cyclic Checksum, Prev: Random Numbers, Up: Mathematical Packages - -5.5 Fast Fourier Transform -========================== +File: slib.info, Node: Discrete Fourier Transform, Next: Cyclic Checksum, Prev: Random Numbers, Up: Mathematical Packages + | +5.7 Discrete Fourier Transform | +============================== | -`(require 'fft)' +`(require 'dft)' or `(require 'Fourier-transform)' | + `fft' and `fft-1' compute the Fast-Fourier-Transforms (O(n*log(n))) | +of arrays whose dimensions are all powers of 2. | + | + `sft' and `sft-1' compute the Discrete-Fourier-Transforms for all | +combinations of dimensions (O(n^2)). | + | + -- Function: sft array prot | + -- Function: sft array | + ARRAY is an array of positive rank. `sft' returns an array of | + type PROT (defaulting to ARRAY) of complex numbers comprising the | + "Discrete Fourier Transform" of ARRAY. | + | + -- Function: sft-1 array prot | + -- Function: sft-1 array | + ARRAY is an array of positive rank. `sft-1' returns an array of | + type PROT (defaulting to ARRAY) of complex numbers comprising the | + inverse Discrete Fourier Transform of ARRAY. | + | + -- Function: fft array prot | -- 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 is an array of positive rank whose dimensions are all powers | + of 2. `fft' returns an array of type PROT (defaulting to ARRAY) | + of complex numbers comprising the Discrete Fourier Transform of | + ARRAY. + -- Function: fft-1 array prot | -- Function: fft-1 array - `fft-1' returns an array of complex numbers comprising the inverse - Discrete Fourier Transform of ARRAY. + ARRAY is an array of positive rank whose dimensions are all powers | + of 2. `fft-1' returns an array of type PROT (defaulting to ARRAY) | + of complex numbers comprising the inverse Discrete Fourier | + Transform of ARRAY. | + | + `dft' and `dft-1' compute the discrete Fourier transforms using the | +best method for decimating each dimension. | + | + -- Function: dft array prot | + -- Function: dft array | + `dft' returns an array of type PROT (defaulting to ARRAY) of | + complex numbers comprising the Discrete Fourier Transform of ARRAY. | + | + -- Function: dft-1 array prot | + -- Function: dft-1 array | + `dft-1' returns an array of type PROT (defaulting to 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. @@ -6316,9 +6500,9 @@ File: slib.info, Node: Fast Fourier Transform, Next: Cyclic Checksum, Prev: R 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 - -5.6 Cyclic Checksum +File: slib.info, Node: Cyclic Checksum, Next: Graphing, Prev: Discrete Fourier Transform, Up: Mathematical Packages + | +5.8 Cyclic Checksum | =================== `(require 'crc)' Cyclic Redundancy Checks using Galois field GF(2) @@ -6506,7 +6690,7 @@ 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 -5.7 Graphing +5.9 Graphing | ============ * Menu: @@ -6517,7 +6701,7 @@ File: slib.info, Node: Graphing, Next: Solid Modeling, Prev: Cyclic Checksum, File: slib.info, Node: Character Plotting, Next: PostScript Graphing, Prev: Graphing, Up: Graphing -5.7.1 Character Plotting +5.9.1 Character Plotting | ------------------------ `(require 'charplot)' @@ -6630,7 +6814,7 @@ File: slib.info, Node: Character Plotting, Next: PostScript Graphing, Prev: G File: slib.info, Node: PostScript Graphing, Prev: Character Plotting, Up: Graphing -5.7.2 PostScript Graphing +5.9.2 PostScript Graphing | ------------------------- `(require 'eps-graph)' @@ -6681,7 +6865,7 @@ first ELT argument to the last. File: slib.info, Node: Column Ranges, Next: Drawing the Graph, Prev: PostScript Graphing, Up: PostScript Graphing -5.7.2.1 Column Ranges +5.9.2.1 Column Ranges | ..................... A "range" is a list of two numbers, the minimum and the maximum. Ranges @@ -6722,7 +6906,7 @@ can be given explicity or computed in PostScript by `column-range'. File: slib.info, Node: Drawing the Graph, Next: Graphics Context, Prev: Column Ranges, Up: PostScript Graphing -5.7.2.2 Drawing the Graph +5.9.2.2 Drawing the Graph | ......................... -- Function: plot-column array x-column y-column proc3s @@ -6780,7 +6964,7 @@ The glyphs and drawing styles available are: File: slib.info, Node: Graphics Context, Next: Rectangles, Prev: Drawing the Graph, Up: PostScript Graphing -5.7.2.3 Graphics Context +5.9.2.3 Graphics Context | ........................ -- Function: in-graphic-context arg ... @@ -6833,7 +7017,7 @@ 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 -5.7.2.4 Rectangles +5.9.2.4 Rectangles | .................. A "rectangle" is a list of 4 numbers; the first two elements are the x @@ -6873,7 +7057,7 @@ elements are the width and height of the rectangle. File: slib.info, Node: Legending, Next: Legacy Plotting, Prev: Rectangles, Up: PostScript Graphing -5.7.2.5 Legending +5.9.2.5 Legending | ................. -- Function: title-top title subtitle @@ -6909,13 +7093,13 @@ File: slib.info, Node: Legending, Next: Legacy Plotting, Prev: Rectangles, U 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 + -- Function: rule-horizontal y-coord text tick-height | + Draws a horizontal ruler with Y coordinate Y-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. + TICK-HEIGHT long on the top side of Y-COORD; and TEXT and numeric | + legends are on the bottom. If TICK-HEIGHT is negative, then the | + ticks are -TICK-HEIGHT long on the bottom side of Y-COORD; and | + TEXT and numeric legends are on the top. | -- Function: y-axis Draws the y-axis. @@ -6934,7 +7118,7 @@ File: slib.info, Node: Legending, Next: Legacy Plotting, Prev: Rectangles, U File: slib.info, Node: Legacy Plotting, Next: Example Graph, Prev: Legending, Up: PostScript Graphing -5.7.2.6 Legacy Plotting +5.9.2.6 Legacy Plotting | ....................... -- Variable: graph:dimensions @@ -6948,11 +7132,11 @@ File: slib.info, Node: Legacy Plotting, Next: Example Graph, Prev: Legending, range X1 to X2. If the optional integer argument NPTS is supplied, it specifies the number of points to evaluate FUNC at. - -- Function: x1 x2 npts func1 func2 ... | - Creates and displays an encapsulated PostScript graph of the | - one-argument functions FUNC1, FUNC2, ... over the range X1 to X2 | - at NPTS points. | - | + -- Function: x1 x2 npts func1 func2 ... + Creates and displays an encapsulated PostScript graph of the + one-argument functions FUNC1, FUNC2, ... over the range X1 to X2 + at NPTS points. + -- 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 @@ -6961,7 +7145,7 @@ File: slib.info, Node: Legacy Plotting, Next: Example Graph, Prev: Legending, File: slib.info, Node: Example Graph, Prev: Legacy Plotting, Up: PostScript Graphing -5.7.2.7 Example Graph +5.9.2.7 Example Graph | ..................... The file `am1.5.html', a table of solar irradiance, is fetched with @@ -7063,8 +7247,8 @@ scales. File: slib.info, Node: Solid Modeling, Next: Color, Prev: Graphing, Up: Mathematical Packages -5.8 Solid Modeling -================== +5.10 Solid Modeling | +=================== | `(require 'solid)' @@ -7274,6 +7458,11 @@ Object Primitives origin. APPEARANCE determines the surface properties of the returned object. + -- Function: solid:lumber geometry appearance | + Returns a box of the specified GEOMETRY, but with the y-axis of a | + texture specified in APPEARANCE being applied along the longest | + dimension in GEOMETRY. | + | -- Function: solid:cylinder radius height appearance -- Function: solid:cylinder radius height Returns a right cylinder with dimensions `(abs RADIUS)' and `(abs @@ -7330,6 +7519,15 @@ Object Primitives 3)' and `(4 5 6)': (solid:polyline '((1 2 3) (4 5 6)) (solid:color #f 0 #f 0 '(1 0 0))) + -- Function: solid:prism xz-array y appearance | + -- Function: solid:prism xz-array y | + XZ-ARRAY must be an N-by-2 array holding a sequence of coordinates | + tracing a non-intersecting clockwise loop in the x-z plane. | + `solid:prism' will close the sequence if the first and last | + coordinates are not the same. | + | + `solid:prism' returns a capped prism Y long. | + | -- Function: solid:basrelief width height depth colorray appearance -- Function: solid:basrelief width height depth appearance -- Function: solid:basrelief width height depth @@ -7485,8 +7683,8 @@ Spatial Transformations File: slib.info, Node: Color, Next: Root Finding, Prev: Solid Modeling, Up: Mathematical Packages -5.9 Color -========= +5.11 Color | +========== | `http://swiss.csail.mit.edu/~jaffer/Color' @@ -7508,8 +7706,8 @@ encountered in practice and the literature. File: slib.info, Node: Color Data-Type, Next: Color Spaces, Prev: Color, Up: Color -5.9.1 Color Data-Type ---------------------- +5.11.1 Color Data-Type | +---------------------- | `(require 'color)' @@ -7563,8 +7761,8 @@ File: slib.info, Node: Color Data-Type, Next: Color Spaces, Prev: Color, Up: -- Function: convert-color color e-sRGB precision Converts COLOR into SPACE at optional WHITE-POINT. -5.9.1.1 External Representation -............................... +5.11.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. @@ -7607,8 +7805,8 @@ sRGB #x<RRGGBB> syntactically valid notation for a color, then `string->color' returns #f. -5.9.1.2 White -............. +5.11.1.2 White | +.............. | We experience color relative to the illumination around us. CIEXYZ coordinates, although subject to uniform scaling, are objective. Thus @@ -7642,8 +7840,8 @@ device-dependent RGBi and RGB spaces of Xlib. File: slib.info, Node: Color Spaces, Next: Spectra, Prev: Color Data-Type, Up: Color -5.9.2 Color Spaces ------------------- +5.11.2 Color Spaces | +------------------- | Measurement-based Color Spaces .............................. @@ -7909,8 +8107,8 @@ ICC.1:1998-09: File: slib.info, Node: Spectra, Next: Color Difference Metrics, Prev: Color Spaces, Up: Color -5.9.3 Spectra -------------- +5.11.3 Spectra | +-------------- | The following functions compute colors from spectra, scale color luminance, and extract chromaticity. XYZ is used in the names of @@ -8123,8 +8321,8 @@ 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 -5.9.4 Color Difference Metrics ------------------------------- +5.11.4 Color Difference Metrics | +------------------------------- | `(require 'color-space)' @@ -8194,8 +8392,8 @@ to use a single value pass/fail tolerance for all shades. File: slib.info, Node: Color Conversions, Next: Color Names, Prev: Color Difference Metrics, Up: Color -5.9.5 Color Conversions ------------------------ +5.11.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 @@ -8265,8 +8463,8 @@ Do not convert e-sRGB precision through `e-sRGB->sRGB' then File: slib.info, Node: Color Names, Next: Daylight, Prev: Color Conversions, Up: Color -5.9.6 Color Names ------------------ +5.11.6 Color Names | +------------------ | `(require 'color-names)' @@ -8431,8 +8629,8 @@ program, then you must include its license with your program: File: slib.info, Node: Daylight, Prev: Color Names, Up: Color -5.9.7 Daylight --------------- +5.11.7 Daylight | +--------------- | `(require 'daylight)' @@ -8529,15 +8727,15 @@ turbidity values less than 1.3. File: slib.info, Node: Root Finding, Next: Minimizing, Prev: Color, Up: Mathematical Packages -5.10 Root Finding +5.12 Root Finding | ================= `(require 'root)' - -- Function: integer-sqrt y | - Given a non-negative integer Y, returns the largest integer whose | - square is less than or equal to Y. | - | + -- Function: integer-sqrt y + Given a non-negative integer Y, returns the largest integer whose + square is less than or equal to Y. + -- 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 @@ -8554,7 +8752,7 @@ File: slib.info, Node: Root Finding, Next: Minimizing, Prev: Color, Up: Math (ash 1 (quotient (integer-length y) 2)))) (integer-sqrt 15) => 4 - | + -- 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 @@ -8623,8 +8821,8 @@ Polynomials', IEEE Transactions on Circuits and Systems, Vol. 36, No. File: slib.info, Node: Minimizing, Next: The Limit, Prev: Root Finding, Up: Mathematical Packages - | -5.11 Minimizing + +5.13 Minimizing | =============== `(require 'minimize)' @@ -8670,108 +8868,108 @@ and Software' Prentice-Hall, 1989, ISBN 0-13-627258-4 File: slib.info, Node: The Limit, Next: Commutative Rings, Prev: Minimizing, Up: Mathematical Packages - | -5.12 The Limit | -============== | - | - -- library procedure: limit proc x1 x2 k | - -- library procedure: limit proc x1 x2 | - PROC must be a procedure taking a single inexact real argument. K | - is the number of points on which PROC will be called; it defaults | - to 8. | - | - If X1 is finite, then PROC must be continuous on the half-open | - interval: | - | - ( X1 .. X1+X2 ] | - | - And X2 should be chosen small enough so that PROC is expected to | - be monotonic or constant on arguments between X1 and X1 + X2. | - | - `Limit' computes the limit of PROC as its argument approaches X1 | - from X1 + X2. `Limit' returns a real number or real infinity or | - `#f'. | - | - If X1 is not finite, then X2 must be a finite nonzero real with | - the same sign as X1; in which case `limit' returns: | - | - `(limit (lambda (x) (proc (/ x))) 0.0 (/ X2) K)' | - | - `Limit' examines the magnitudes of the differences between | - successive values returned by PROC called with a succession of | - numbers from X1+X2/K to X1. | - | - If the magnitudes of differences are monotonically decreasing, then | - then the limit is extrapolated from the degree n polynomial passing | - through the samples returned by PROC. | - | - If the magnitudes of differences are increasing as fast or faster | - than a hyperbola matching at X1+X2, then a real infinity with sign | - the same as the differences is returned. | - | - If the magnitudes of differences are increasing more slowly than | - the hyperbola matching at X1+X2, then the limit is extrapolated | - from the quadratic passing through the three samples closest to X1. | - | - If the magnitudes of differences are not monotonic or are not | - completely within one of the above categories, then #f is returned. | - | - ;; constant | - (limit (lambda (x) (/ x x)) 0 1.0e-9) ==> 1.0 | - (limit (lambda (x) (expt 0 x)) 0 1.0e-9) ==> 0.0 | - (limit (lambda (x) (expt 0 x)) 0 -1.0e-9) ==> +inf.0 | - ;; linear | - (limit + 0 976.5625e-6) ==> 0.0 | - (limit - 0 976.5625e-6) ==> 0.0 | - ;; vertical point of inflection | - (limit sqrt 0 1.0e-18) ==> 0.0 | + +5.14 The Limit | +============== + + -- library procedure: limit proc x1 x2 k + -- library procedure: limit proc x1 x2 + PROC must be a procedure taking a single inexact real argument. K + is the number of points on which PROC will be called; it defaults + to 8. + + If X1 is finite, then PROC must be continuous on the half-open + interval: + + ( X1 .. X1+X2 ] + + And X2 should be chosen small enough so that PROC is expected to + be monotonic or constant on arguments between X1 and X1 + X2. + + `Limit' computes the limit of PROC as its argument approaches X1 + from X1 + X2. `Limit' returns a real number or real infinity or + `#f'. + + If X1 is not finite, then X2 must be a finite nonzero real with + the same sign as X1; in which case `limit' returns: + + `(limit (lambda (x) (proc (/ x))) 0.0 (/ X2) K)' + + `Limit' examines the magnitudes of the differences between + successive values returned by PROC called with a succession of + numbers from X1+X2/K to X1. + + If the magnitudes of differences are monotonically decreasing, then + then the limit is extrapolated from the degree n polynomial passing + through the samples returned by PROC. + + If the magnitudes of differences are increasing as fast or faster + than a hyperbola matching at X1+X2, then a real infinity with sign + the same as the differences is returned. + + If the magnitudes of differences are increasing more slowly than + the hyperbola matching at X1+X2, then the limit is extrapolated + from the quadratic passing through the three samples closest to X1. + + If the magnitudes of differences are not monotonic or are not + completely within one of the above categories, then #f is returned. + + ;; constant + (limit (lambda (x) (/ x x)) 0 1.0e-9) ==> 1.0 + (limit (lambda (x) (expt 0 x)) 0 1.0e-9) ==> 0.0 + (limit (lambda (x) (expt 0 x)) 0 -1.0e-9) ==> +inf.0 + ;; linear + (limit + 0 976.5625e-6) ==> 0.0 + (limit - 0 976.5625e-6) ==> 0.0 + ;; vertical point of inflection + (limit sqrt 0 1.0e-18) ==> 0.0 (limit (lambda (x) (* x (log x))) 0 1.0e-9) ==> -102.70578127633066e-12 (limit (lambda (x) (/ x (log x))) 0 1.0e-9) ==> 96.12123142321669e-15 - ;; limits tending to infinity | - (limit + +inf.0 1.0e9) ==> +inf.0 | - (limit + -inf.0 -1.0e9) ==> -inf.0 | - (limit / 0 1.0e-9) ==> +inf.0 | - (limit / 0 -1.0e-9) ==> -inf.0 | - (limit (lambda (x) (/ (log x) x)) 0 1.0e-9) ==> -inf.0 | - (limit (lambda (x) (/ (magnitude (log x)) x)) 0 -1.0e-9) | - ==> -inf.0 | - ;; limit doesn't exist | - (limit sin +inf.0 1.0e9) ==> #f | - (limit (lambda (x) (sin (/ x))) 0 1.0e-9) ==> #f | - (limit (lambda (x) (sin (/ x))) 0 -1.0e-9) ==> #f | - (limit (lambda (x) (/ (log x) x)) 0 -1.0e-9) ==> #f | - ;; conditionally convergent - return #f | - (limit (lambda (x) (/ (sin x) x)) +inf.0 1.0e222) | - ==> #f | - ;; asymptotes | - (limit / -inf.0 -1.0e222) ==> 0.0 | - (limit / +inf.0 1.0e222) ==> 0.0 | - (limit (lambda (x) (expt x x)) 0 1.0e-18) ==> 1.0 | - (limit (lambda (x) (sin (/ x))) +inf.0 1.0e222) ==> 0.0 | - (limit (lambda (x) (/ (+ (exp (/ x)) 1))) 0 1.0e-9) | - ==> 0.0 | - (limit (lambda (x) (/ (+ (exp (/ x)) 1))) 0 -1.0e-9) | - ==> 1.0 | - (limit (lambda (x) (real-part (expt (tan x) (cos x)))) (/ pi 2) 1.0e-9) | - ==> 1.0 | - ;; This example from the 1979 Macsyma manual grows so rapidly | - ;; that x2 must be less than 41. It correctly returns e^2. | - (limit (lambda (x) (expt (+ x (exp x) (exp (* 2 x))) (/ x))) +inf.0 40) | - ==> 7.3890560989306504 | - ;; LIMIT can calculate the proper answer when evaluation | - ;; of the function at the limit point does not: | + ;; limits tending to infinity + (limit + +inf.0 1.0e9) ==> +inf.0 + (limit + -inf.0 -1.0e9) ==> -inf.0 + (limit / 0 1.0e-9) ==> +inf.0 + (limit / 0 -1.0e-9) ==> -inf.0 + (limit (lambda (x) (/ (log x) x)) 0 1.0e-9) ==> -inf.0 + (limit (lambda (x) (/ (magnitude (log x)) x)) 0 -1.0e-9) + ==> -inf.0 + ;; limit doesn't exist + (limit sin +inf.0 1.0e9) ==> #f + (limit (lambda (x) (sin (/ x))) 0 1.0e-9) ==> #f + (limit (lambda (x) (sin (/ x))) 0 -1.0e-9) ==> #f + (limit (lambda (x) (/ (log x) x)) 0 -1.0e-9) ==> #f + ;; conditionally convergent - return #f + (limit (lambda (x) (/ (sin x) x)) +inf.0 1.0e222) + ==> #f + ;; asymptotes + (limit / -inf.0 -1.0e222) ==> 0.0 + (limit / +inf.0 1.0e222) ==> 0.0 + (limit (lambda (x) (expt x x)) 0 1.0e-18) ==> 1.0 + (limit (lambda (x) (sin (/ x))) +inf.0 1.0e222) ==> 0.0 + (limit (lambda (x) (/ (+ (exp (/ x)) 1))) 0 1.0e-9) + ==> 0.0 + (limit (lambda (x) (/ (+ (exp (/ x)) 1))) 0 -1.0e-9) + ==> 1.0 + (limit (lambda (x) (real-part (expt (tan x) (cos x)))) (/ pi 2) 1.0e-9) + ==> 1.0 + ;; This example from the 1979 Macsyma manual grows so rapidly + ;; that x2 must be less than 41. It correctly returns e^2. + (limit (lambda (x) (expt (+ x (exp x) (exp (* 2 x))) (/ x))) +inf.0 40) + ==> 7.3890560989306504 + ;; LIMIT can calculate the proper answer when evaluation + ;; of the function at the limit point does not: (tan (atan +inf.0)) ==> 16.331778728383844e15 - (limit tan (atan +inf.0) -1.0e-15) ==> +inf.0 | + (limit tan (atan +inf.0) -1.0e-15) ==> +inf.0 (tan (atan +inf.0)) ==> 16.331778728383844e15 - (limit tan (atan +inf.0) 1.0e-15) ==> -inf.0 | - ((lambda (x) (expt (exp (/ -1 x)) x)) 0) ==> 1.0 | - (limit (lambda (x) (expt (exp (/ -1 x)) x)) 0 1.0e-9) | - ==> 0.0 | - | + (limit tan (atan +inf.0) 1.0e-15) ==> -inf.0 + ((lambda (x) (expt (exp (/ -1 x)) x)) 0) ==> 1.0 + (limit (lambda (x) (expt (exp (/ -1 x)) x)) 0 1.0e-9) + ==> 0.0 + File: slib.info, Node: Commutative Rings, Next: Matrix Algebra, Prev: The Limit, Up: Mathematical Packages - | -5.13 Commutative Rings | + +5.15 Commutative Rings | ====================== Scheme provides a consistent and capable set of numeric functions. @@ -8837,7 +9035,7 @@ expressions are handled similarly. `remainder', `lcm', and `gcd'; but these work only for the more restrictive Euclidean (Unique Factorization) Domain. -5.14 Rules and Rulesets | +5.16 Rules and Rulesets | ======================= The "commutative-ring" package allows control of ring properties @@ -8911,7 +9109,7 @@ involving different non-numeric elements. (lambda (exp1 exp2) (apply + (map (lambda (trm) (* trm exp2)) (cdr exp1)))))) -5.15 How to Create a Commutative Ring | +5.17 How to Create a Commutative Ring | ===================================== The first step in creating your commutative ring is to write procedures @@ -9050,7 +9248,7 @@ objects. File: slib.info, Node: Matrix Algebra, Prev: Commutative Rings, Up: Mathematical Packages -5.16 Matrix Algebra | +5.18 Matrix Algebra | =================== `(require 'determinant)' @@ -9357,7 +9555,7 @@ missing. (every (lambda (c) (memv c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 - #\+ #\( #\ #\) #\-))) + #\+ #\( #\space #\) #\-))) | (string->list d)))) string)) @@ -11246,7 +11444,7 @@ File: slib.info, Node: Data Structures, Next: Sorting and Searching, Prev: Ot * Arrays:: 'array * Subarrays:: 'subarray * Array Mapping:: 'array-for-each -* Array Interpolation:: 'array-interpolate | +* Array Interpolation:: 'array-interpolate * Association Lists:: 'alist * Byte:: 'byte * Byte/Number Conversions:: 'byte-number @@ -11538,9 +11736,13 @@ File: slib.info, Node: Subarrays, Next: Array Mapping, Prev: Arrays, Up: Dat #2A((a b) (d e)) > (subarray ra #f '(1 2)) #2A((b c) (e f)) + > (subarray ra #f '(2 1)) | + #2A((c b) (f e)) | - -- Variable: subarray0 - Legacy alias for subarray. + Arrays can be reflected (reversed) using `subarray': | + | + > (subarray '#1A(a b c d e) '(4 0)) | + #1A(e d c b a) | -- Function: array-trim array trim ... Returns a subarray sharing contents with ARRAY except for slices @@ -11563,7 +11765,7 @@ File: slib.info, Node: Subarrays, Next: Array Mapping, Prev: Arrays, Up: Dat File: slib.info, Node: Array Mapping, Next: Array Interpolation, Prev: Subarrays, Up: Data Structures - | + 7.1.3 Array Mapping ------------------- @@ -11618,39 +11820,39 @@ File: slib.info, Node: Array Mapping, Next: Array Interpolation, Prev: Subarr File: slib.info, Node: Array Interpolation, Next: Association Lists, Prev: Array Mapping, Up: Data Structures - | -7.1.4 Array Interpolation | -------------------------- | - | -`(require 'array-interpolate)' | - | - -- Function: interpolate-array-ref ra x1 ... xj | - RA must be an array of rank j containing numbers. | - `interpolate-array-ref' returns a value interpolated from the | - nearest j-dimensional cube of elements of RA. | - | - (interpolate-array-ref '#2A:fixZ32b((1 2 3) (4 5 6)) 1 0.1) | - ==> 4.1 | - (interpolate-array-ref '#2A:fixZ32b((1 2 3) (4 5 6)) 0.5 0.25) | - ==> 2.75 | - | - -- Procedure: resample-array! ra1 ra2 | - RA1 and RA2 must be numeric arrays of equal rank. | - `resample-array!' sets RA1 to values interpolated from RA2 such | - that the values of elements at the corners of RA1 and RA2 are | - equal. | - | - (define ra (make-array (A:fixZ32b) 2 2)) | - (resample-array! ra '#2A:fixZ32b((1 2 3) (4 5 6))) | - ra ==> #2A:fixZ32b((1 3) (4 6)) | - (define ra (make-array (A:floR64b) 3 2)) | - (resample-array! ra '#2A:fixZ32b((1 2 3) (4 5 6))) | - ra ==> #2A:floR64b((1.0 3.0) (2.5 4.5) (4.0 6.0)) | - | + +7.1.4 Array Interpolation +------------------------- + +`(require 'array-interpolate)' + + -- Function: interpolate-array-ref ra x1 ... xj + RA must be an array of rank j containing numbers. + `interpolate-array-ref' returns a value interpolated from the + nearest j-dimensional cube of elements of RA. + + (interpolate-array-ref '#2A:fixZ32b((1 2 3) (4 5 6)) 1 0.1) + ==> 4.1 + (interpolate-array-ref '#2A:fixZ32b((1 2 3) (4 5 6)) 0.5 0.25) + ==> 2.75 + + -- Procedure: resample-array! ra1 ra2 + RA1 and RA2 must be numeric arrays of equal rank. + `resample-array!' sets RA1 to values interpolated from RA2 such + that the values of elements at the corners of RA1 and RA2 are + equal. + + (define ra (make-array (A:fixZ32b) 2 2)) + (resample-array! ra '#2A:fixZ32b((1 2 3) (4 5 6))) + ra ==> #2A:fixZ32b((1 3) (4 6)) + (define ra (make-array (A:floR64b) 3 2)) + (resample-array! ra '#2A:fixZ32b((1 2 3) (4 5 6))) + ra ==> #2A:floR64b((1.0 3.0) (2.5 4.5) (4.0 6.0)) + File: slib.info, Node: Association Lists, Next: Byte, Prev: Array Interpolation, Up: Data Structures - | -7.1.5 Association Lists | + +7.1.5 Association Lists ----------------------- `(require 'alist)' @@ -11706,7 +11908,7 @@ tables for improved performance. File: slib.info, Node: Byte, Next: Byte/Number Conversions, Prev: Association Lists, Up: Data Structures -7.1.6 Byte | +7.1.6 Byte ---------- `(require 'byte)' @@ -11752,6 +11954,16 @@ concerned. -- Function: bytes-copy bytes Returns a newly allocated copy of the given BYTES. + -- Function: subbytes bytes start end | + BYTES must be a bytes, and START and END must be exact integers | + satisfying | + | + 0 <= START <= END <= (bytes-length BYTES). | + | + `subbytes' returns a newly allocated bytes formed from the bytes of | + BYTES beginning with index START (inclusive) and ending with index | + END (exclusive). | + | -- Procedure: bytes-reverse! bytes Reverses the order of byte-array BYTES. @@ -11810,24 +12022,24 @@ Byte/Number Conversions:: are always big-endian. 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 +`subbytes-read!' and `subbytes-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 + -- Procedure: subbytes-read! string start end port | + -- Procedure: subbytes-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. + `subbytes-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. + -- Function: subbytes-write string start end port | + -- Function: subbytes-write string start end | + `subbytes-write' writes `(abs (- START END))' bytes to output-port | + PORT. The first byte written is index START of STRING. | + `subbytes-write' returns the number of bytes written. | PORT may be omitted, in which case it defaults to the value returned by `current-output-port'. @@ -11835,7 +12047,7 @@ and END determines the order of writing. File: slib.info, Node: Byte/Number Conversions, Next: MAT-File Format, Prev: Byte, Up: Data Structures -7.1.7 Byte/Number Conversions | +7.1.7 Byte/Number Conversions ----------------------------- `(require 'byte-number)' @@ -11877,8 +12089,8 @@ determines the signedness of the number. calculates and returns the value of BYTES interpreted as a big-endian IEEE 4-byte (32-bit) number. - (bytes->ieee-float (bytes 0 0 0 0)) => 0.0 | - (bytes->ieee-float (bytes #x80 0 0 0)) => -0.0 | + (bytes->ieee-float (bytes 0 0 0 0)) => 0.0 + (bytes->ieee-float (bytes #x80 0 0 0)) => -0.0 (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 @@ -11887,8 +12099,8 @@ determines the signedness of the number. (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)) => -inf.0 | - (bytes->ieee-float (bytes #x7f #x80 0 0)) => +inf.0 | + (bytes->ieee-float (bytes #xff #x80 0 0)) => -inf.0 + (bytes->ieee-float (bytes #x7f #x80 0 0)) => +inf.0 (bytes->ieee-float (bytes #x7f #x80 0 1)) => 0/0 -- Function: bytes->ieee-double bytes @@ -11897,8 +12109,8 @@ determines the signedness of the number. 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 #x80 0 0 0 0 0 0 0)) => -0.0 | - (bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) => 2.0 | + (bytes->ieee-double (bytes #x80 0 0 0 0 0 0 0)) => -0.0 + (bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) => 2.0 (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 @@ -11906,8 +12118,8 @@ determines the signedness of the number. (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)) => -inf.0 | - (bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) => +inf.0 | + (bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0)) => -inf.0 + (bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) => +inf.0 (bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0)) => 0/0 -- Function: ieee-float->bytes x @@ -11932,8 +12144,8 @@ determines the signedness of the number. Returns a 8-element byte-array encoding the IEEE double-precision floating-point of X. - (bytes->list (ieee-double->bytes 0.0)) => (0 0 0 0 0 0 0 0) | - (bytes->list (ieee-double->bytes -0.0)) => (128 0 0 0 0 0 0 0) | + (bytes->list (ieee-double->bytes 0.0)) => (0 0 0 0 0 0 0 0) + (bytes->list (ieee-double->bytes -0.0)) => (128 0 0 0 0 0 0 0) (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) @@ -11945,8 +12157,8 @@ determines the signedness of the number. (bytes->list (ieee-double->bytes 4.0e-324)) => ( 0 0 0 0 0 0 0 1) - (bytes->list (ieee-double->bytes -inf.0)) => (255 240 0 0 0 0 0 0) | - (bytes->list (ieee-double->bytes +inf.0)) => (127 240 0 0 0 0 0 0) | + (bytes->list (ieee-double->bytes -inf.0)) => (255 240 0 0 0 0 0 0) + (bytes->list (ieee-double->bytes +inf.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 @@ -11993,7 +12205,7 @@ enables the full range of numbers as keys in File: slib.info, Node: MAT-File Format, Next: Portable Image Files, Prev: Byte/Number Conversions, Up: Data Structures -7.1.8 MAT-File Format | +7.1.8 MAT-File Format --------------------- `(require 'matfile)' @@ -12024,7 +12236,7 @@ awaits a sample file. File: slib.info, Node: Portable Image Files, Next: Collections, Prev: MAT-File Format, Up: Data Structures -7.1.9 Portable Image Files | +7.1.9 Portable Image Files -------------------------- `(require 'pnm)' @@ -12073,8 +12285,8 @@ File: slib.info, Node: Portable Image Files, Next: Collections, Prev: MAT-Fil File: slib.info, Node: Collections, Next: Dynamic Data Type, Prev: Portable Image Files, Up: Data Structures -7.1.10 Collections | ------------------- | +7.1.10 Collections +------------------ `(require 'collect)' @@ -12242,7 +12454,7 @@ operations. File: slib.info, Node: Dynamic Data Type, Next: Hash Tables, Prev: Collections, Up: Data Structures -7.1.11 Dynamic Data Type | +7.1.11 Dynamic Data Type ------------------------ `(require 'dynamic)' @@ -12277,7 +12489,7 @@ File: slib.info, Node: Dynamic Data Type, Next: Hash Tables, Prev: Collection File: slib.info, Node: Hash Tables, Next: Object, Prev: Dynamic Data Type, Up: Data Structures -7.1.12 Hash Tables | +7.1.12 Hash Tables ------------------ `(require 'hash-table)' @@ -12342,7 +12554,7 @@ should be `eq?', `eqv?', `equal?', `=', `char=?', `char-ci=?', File: slib.info, Node: Object, Next: Priority Queues, Prev: Hash Tables, Up: Data Structures -7.1.13 Macroless Object System | +7.1.13 Macroless Object System ------------------------------ `(require 'object)' @@ -12351,7 +12563,7 @@ File: slib.info, Node: Object, Next: Priority Queues, Prev: Hash Tables, Up: (whumeniu@datap.ca). Conceptual Tributes: *Note Yasos::, MacScheme's %object, CLOS, Lack of R4RS macros. -7.1.14 Concepts | +7.1.14 Concepts --------------- OBJECT @@ -12381,7 +12593,7 @@ PREDICATE A object's method asscociated with a generic-predicate. Returns `#t'. -7.1.15 Procedures | +7.1.15 Procedures ----------------- -- Function: make-object ancestor ... @@ -12421,7 +12633,7 @@ PREDICATE GENERIC-METHOD. If no associated method exists an error is flagged. -7.1.16 Examples | +7.1.16 Examples --------------- (require 'object) @@ -12480,7 +12692,7 @@ PREDICATE (imigrate! self) self) -7.1.16.1 Inverter Documentation | +7.1.16.1 Inverter Documentation ............................... Inheritance: @@ -12493,7 +12705,7 @@ Inheritance: <inverter>::invert <inverter>::inverter? -7.1.16.2 Number Documention | +7.1.16.2 Number Documention ........................... Inheritance @@ -12504,7 +12716,7 @@ Inheritance <number>::value <number>::set-value! -7.1.16.3 Inverter code | +7.1.16.3 Inverter code ...................... (require 'object) @@ -12568,7 +12780,7 @@ Inheritance File: slib.info, Node: Priority Queues, Next: Queues, Prev: Object, Up: Data Structures -7.1.17 Priority Queues | +7.1.17 Priority Queues ---------------------- `(require 'priority-queue)' @@ -12595,7 +12807,7 @@ Algorithms' by T. Cormen, C. Leiserson, R. Rivest. 1989 MIT Press. File: slib.info, Node: Queues, Next: Records, Prev: Priority Queues, Up: Data Structures -7.1.18 Queues | +7.1.18 Queues ------------- `(require 'queue)' @@ -12639,7 +12851,7 @@ rear, and removed from the front (i.e., they are what are often called File: slib.info, Node: Records, Prev: Queues, Up: Data Structures -7.1.19 Records | +7.1.19 Records -------------- `(require 'record)' @@ -13385,6 +13597,8 @@ File: slib.info, Node: Sorting, Next: Topological Sort, Prev: Chapter Orderin `(require 'sort)' + [by Richard A. O'Keefe, 1991] | + | Many Scheme systems provide some kind of sorting functions. They do not, however, always provide the _same_ sorting functions, and those that I have had the opportunity to test provided inefficient ones (a @@ -13452,6 +13666,17 @@ converge on a single interface, and this may serve as a hint. The argument order for all functions has been chosen to be as close to Common LISP as made sense, in order to avoid NIH-itis. + The code of `merge' and `merge!' could have been quite a bit simpler, | +but they have been coded to reduce the amount of work done per | +iteration. (For example, we only have one `null?' test per iteration.) | + | + I gave serious consideration to producing Common-LISP-compatible | +functions. However, Common LISP's `sort' is our `sort!' (well, in fact | +Common LISP's `stable-sort' is our `sort!'; merge sort is _fast_ as | +well as stable!) so adapting CL code to Scheme takes a bit of work | +anyway. I did, however, appeal to CL to determine the _order_ of the | +arguments. | + | Each of the five functions has a required _last_ parameter which is a comparison function. A comparison function `f' is a function of 2 arguments which acts like `<'. For example, @@ -13464,66 +13689,60 @@ 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'. + [Addendum by Aubrey Jaffer, 2006] | + | + These procedures are stable when called with predicates which return | +`#f' when applied to identical arguments. These procedures have | +asymptotic time and space needs no larger than O(N*log(N)), where N is | +the sum of the lengths of the sequence arguments. | + | + All five functions take an optional KEY argument corresponding to a | +CL-style `&key' argument. A LESS? predicate with a KEY argument | +behaves like: | + | + (lambda (x y) (LESS? (KEY x) (KEY y))) | + | + The `!' variants sort in place; `sort!' returns its SEQUENCE argument. | + | -- Function: sorted? sequence less? + -- Function: sorted? sequence less? key | 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 or array | + (including vectors and strings). | -- Function: merge list1 list2 less? - This merges two lists, producing a completely new list as result. - I gave serious consideration to producing a Common-LISP-compatible - version. However, Common LISP's `sort' is our `sort!' (well, in - fact Common LISP's `stable-sort' is our `sort!', merge sort is - _fast_ as well as stable!) so adapting CL code to Scheme takes a - bit of work anyway. I did, however, appeal to CL to determine the - _order_ of the arguments. - - -- Procedure: merge! list1 list2 less? - Merges two lists, re-using the pairs of LIST1 and LIST2 to build - the result. If the code is compiled, and LESS? constructs no new - pairs, no pairs at all will be allocated. The first pair of the - result will be either the first pair of LIST1 or the first pair of - LIST2, but you can't predict which. - - The code of `merge' and `merge!' could have been quite a bit - simpler, but they have been coded to reduce the amount of work - done per iteration. (For example, we only have one `null?' test - per iteration.) + -- Function: merge list1 list2 less? key | + Merges two sorted lists, returning a freshly allocated list as its | + result. | + -- Function: merge! list1 list2 less? | + -- Function: merge! list1 list2 less? key | + Merges two sorted lists, re-using the pairs of LIST1 and LIST2 to | + build the result. If `merge!' is compiled, then no new pairs will | + be allocated. The first pair of the result will be either the | + first pair of LIST1 or the first pair of LIST2. | -- 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? - 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. - - Some people have been confused about how to use `sort!', thinking - that it doesn't return a value. It needs to be pointed out that - (set! slist (sort! slist <)) - is the proper usage, not - (sort! slist <) - - Note that these functions do _not_ accept a CL-style `:key' argument. -A simple device for obtaining the same expressiveness is to define - - (define (keyed less? key) - (lambda (x y) (less? (key x) (key y)))) - and then, when you would have written - (sort a-sequence #'my-less :key #'my-key) - in Common LISP, just write - (sort! a-sequence (keyed my-less? my-key)) - in Scheme. + -- Function: sort sequence less? key | + Accepts a list or array (including vectors and strings) for | + SEQUENCE; and returns a completely new sequence which is sorted | + according to LESS?. The returned sequence is the same type as the | + argument SEQUENCE. Given valid arguments, it is always the case | + that: | + + (sorted? (sort SEQUENCE LESS?) LESS?) => #t | + + -- Function: sort! sequence less? | + -- Function: sort! sequence less? key | + Returns SEQUENCE which has been mutated to order its elements | + according to LESS?. If the argument SEQUENCE is a list and | + `sort!' is compiled, then no new pairs will be allocated. If the | + argument SEQUENCE is an array (including vectors and strings), | + then the sorted elements are returned in the array SEQUENCE. | File: slib.info, Node: Topological Sort, Next: Hashing, Prev: Sorting, Up: Sorting and Searching @@ -13706,7 +13925,7 @@ of Hilbert space-filling curves. 7.2.7.3 Bitwise Lamination .......................... - | + -- 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. @@ -13725,28 +13944,28 @@ File: slib.info, Node: Peano Space-Filling Curve, Next: Sierpinski Curve, Pre 7.2.7.4 Peano Space-Filling Curve ................................. -`(require 'peano-fill)' | - | - -- Function: natural->peano-coordinates scalar rank | +`(require 'peano-fill)' + + -- Function: natural->peano-coordinates scalar rank Returns a list of RANK nonnegative integer coordinates corresponding to exact nonnegative integer SCALAR. The lists - returned by `natural->peano-coordinates' for SCALAR arguments 0 | + returned by `natural->peano-coordinates' for SCALAR arguments 0 and 1 will differ in the first element. - -- Function: peano-coordinates->natural coords | + -- Function: peano-coordinates->natural coords Returns an exact nonnegative integer corresponding to COORDS, a list of nonnegative integer coordinates. - -- Function: integer->peano-coordinates scalar rank | - Returns a list of RANK integer coordinates corresponding to exact | - 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 integer corresponding to COORDS, a list of integer | - coordinates. | - | + -- Function: integer->peano-coordinates scalar rank + Returns a list of RANK integer coordinates corresponding to exact + 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 integer corresponding to COORDS, a list of integer + coordinates. + File: slib.info, Node: Sierpinski Curve, Prev: Peano Space-Filling Curve, Up: Space-Filling Curves @@ -14134,11 +14353,11 @@ File: slib.info, Node: Line I/O, Next: Multi-Processing, Prev: String Ports, `system->line' returns a string containing the first line of output from TMP. - `system->line' is intended to be a portable method for getting | - one-line results from programs like `pwd', `whoami', `hostname', | - `which', `identify', and `cksum'. Its behavior when called with | - programs which generate lots of output is unspecified. | - | + `system->line' is intended to be a portable method for getting + one-line results from programs like `pwd', `whoami', `hostname', + `which', `identify', and `cksum'. Its behavior when called with + programs which generate lots of output is unspecified. + File: slib.info, Node: Multi-Processing, Next: Metric Units, Prev: Line I/O, Up: Procedures @@ -14742,7 +14961,7 @@ File: slib.info, Node: SRFI, Prev: Values, Up: Standards Support Implements "Scheme Request For Implementation" (SRFI) as described at `http://srfi.schemers.org/' - | + -- Macro: cond-expand <clause1> <clause2> ... _Syntax:_ Each <clause> should be of the form @@ -14763,27 +14982,29 @@ Implements "Scheme Request For Implementation" (SRFI) as described at * Menu: -* SRFI-1:: list-processing | +* SRFI-1:: list-processing + + * SRFI-2 *Note Guarded LET* special form:: + + * SRFI-8 *Note Binding to multiple values:: + + * SRFI-9 *Note Define-Record-Type:: + + * SRFI-23 `(define error slib:error)' | - * SRFI-2 *Note Guarded LET* special form:: | - | - * SRFI-8 *Note Binding to multiple values:: | - | - * SRFI-9 *Note Define-Record-Type:: | - | * SRFI-47 *Note Arrays:: | - | + + * SRFI-63 *Note Arrays:: + * SRFI-59 *Note Vicinity:: | | - * SRFI-63 *Note Arrays:: | - | - * SRFI-60 *Note Bit-Twiddling:: | - | - * SRFI-61 *Note Guarded COND Clause:: | + * SRFI-60 *Note Bit-Twiddling:: + + * SRFI-61 *Note Guarded COND Clause:: File: slib.info, Node: SRFI-1, Prev: SRFI, Up: SRFI - | + 7.4.13.1 SRFI-1 ............... @@ -15006,7 +15227,7 @@ its list arguments. File: slib.info, Node: Session Support, Next: System Interface, Prev: Standards Support, Up: Other Packages - | + 7.5 Session Support =================== @@ -15593,10 +15814,12 @@ File: slib.info, Node: About SLIB, Next: Index, Prev: Other Packages, Up: To More people than I can name have contributed to SLIB. Thanks to all of you! - SLIB 3a3, released February 2006. | + SLIB 3a4, released October 2006. | Aubrey Jaffer <agj @ alum.mit.edu> - Hyperactive Software - The Maniac Inside! - `http://swiss.csail.mit.edu/~jaffer/SLIB.html' + | + Current information about SLIB can be found on SLIB's "WWW" home page: | + | + `http://swiss.csail.mit.edu/~jaffer/SLIB' | * Menu: @@ -15976,6 +16199,11 @@ File: slib.info, Node: About this manual, Prev: Copyrights, Up: About SLIB 8.6 About this manual ===================== +* Menu: | + | +* Copying This Manual:: | +* How to use this License for your documents:: | + | * 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. @@ -15988,16 +16216,449 @@ File: slib.info, Node: About this manual, Prev: Copyrights, Up: About SLIB package. +File: slib.info, Node: Copying This Manual, Next: How to use this License for your documents, Prev: About this manual, Up: About this manual + | +8.6.1 Copying This Manual | +------------------------- | + | + Version 1.2, November 2002 | + | + Copyright (C) 2000,2001,2002 Free Software Foundation, Inc. | + 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA | + | + Everyone is permitted to copy and distribute verbatim copies | + of this license document, but changing it is not allowed. | + | + 0. PREAMBLE | + | + The purpose of this License is to make a manual, textbook, or other | + functional and useful document "free" in the sense of freedom: to | + assure everyone the effective freedom to copy and redistribute it, | + with or without modifying it, either commercially or | + noncommercially. Secondarily, this License preserves for the | + author and publisher a way to get credit for their work, while not | + being considered responsible for modifications made by others. | + | + This License is a kind of "copyleft", which means that derivative | + works of the document must themselves be free in the same sense. | + It complements the GNU General Public License, which is a copyleft | + license designed for free software. | + | + We have designed this License in order to use it for manuals for | + free software, because free software needs free documentation: a | + free program should come with manuals providing the same freedoms | + that the software does. But this License is not limited to | + software manuals; it can be used for any textual work, regardless | + of subject matter or whether it is published as a printed book. | + We recommend this License principally for works whose purpose is | + instruction or reference. | + | + 1. APPLICABILITY AND DEFINITIONS | + | + This License applies to any manual or other work, in any medium, | + that contains a notice placed by the copyright holder saying it | + can be distributed under the terms of this License. Such a notice | + grants a world-wide, royalty-free license, unlimited in duration, | + to use that work under the conditions stated herein. The | + "Document", below, refers to any such manual or work. Any member | + of the public is a licensee, and is addressed as "you". You | + accept the license if you copy, modify or distribute the work in a | + way requiring permission under copyright law. | + | + A "Modified Version" of the Document means any work containing the | + Document or a portion of it, either copied verbatim, or with | + modifications and/or translated into another language. | + | + A "Secondary Section" is a named appendix or a front-matter section | + of the Document that deals exclusively with the relationship of the | + publishers or authors of the Document to the Document's overall | + subject (or to related matters) and contains nothing that could | + fall directly within that overall subject. (Thus, if the Document | + is in part a textbook of mathematics, a Secondary Section may not | + explain any mathematics.) The relationship could be a matter of | + historical connection with the subject or with related matters, or | + of legal, commercial, philosophical, ethical or political position | + regarding them. | + | + The "Invariant Sections" are certain Secondary Sections whose | + titles are designated, as being those of Invariant Sections, in | + the notice that says that the Document is released under this | + License. If a section does not fit the above definition of | + Secondary then it is not allowed to be designated as Invariant. | + The Document may contain zero Invariant Sections. If the Document | + does not identify any Invariant Sections then there are none. | + | + The "Cover Texts" are certain short passages of text that are | + listed, as Front-Cover Texts or Back-Cover Texts, in the notice | + that says that the Document is released under this License. A | + Front-Cover Text may be at most 5 words, and a Back-Cover Text may | + be at most 25 words. | + | + A "Transparent" copy of the Document means a machine-readable copy, | + represented in a format whose specification is available to the | + general public, that is suitable for revising the document | + straightforwardly with generic text editors or (for images | + composed of pixels) generic paint programs or (for drawings) some | + widely available drawing editor, and that is suitable for input to | + text formatters or for automatic translation to a variety of | + formats suitable for input to text formatters. A copy made in an | + otherwise Transparent file format whose markup, or absence of | + markup, has been arranged to thwart or discourage subsequent | + modification by readers is not Transparent. An image format is | + not Transparent if used for any substantial amount of text. A | + copy that is not "Transparent" is called "Opaque". | + | + Examples of suitable formats for Transparent copies include plain | + ASCII without markup, Texinfo input format, LaTeX input format, | + SGML or XML using a publicly available DTD, and | + standard-conforming simple HTML, PostScript or PDF designed for | + human modification. Examples of transparent image formats include | + PNG, XCF and JPG. Opaque formats include proprietary formats that | + can be read and edited only by proprietary word processors, SGML or | + XML for which the DTD and/or processing tools are not generally | + available, and the machine-generated HTML, PostScript or PDF | + produced by some word processors for output purposes only. | + | + The "Title Page" means, for a printed book, the title page itself, | + plus such following pages as are needed to hold, legibly, the | + material this License requires to appear in the title page. For | + works in formats which do not have any title page as such, "Title | + Page" means the text near the most prominent appearance of the | + work's title, preceding the beginning of the body of the text. | + | + A section "Entitled XYZ" means a named subunit of the Document | + whose title either is precisely XYZ or contains XYZ in parentheses | + following text that translates XYZ in another language. (Here XYZ | + stands for a specific section name mentioned below, such as | + "Acknowledgements", "Dedications", "Endorsements", or "History".) | + To "Preserve the Title" of such a section when you modify the | + Document means that it remains a section "Entitled XYZ" according | + to this definition. | + | + The Document may include Warranty Disclaimers next to the notice | + which states that this License applies to the Document. These | + Warranty Disclaimers are considered to be included by reference in | + this License, but only as regards disclaiming warranties: any other | + implication that these Warranty Disclaimers may have is void and | + has no effect on the meaning of this License. | + | + 2. VERBATIM COPYING | + | + You may copy and distribute the Document in any medium, either | + commercially or noncommercially, provided that this License, the | + copyright notices, and the license notice saying this License | + applies to the Document are reproduced in all copies, and that you | + add no other conditions whatsoever to those of this License. You | + may not use technical measures to obstruct or control the reading | + or further copying of the copies you make or distribute. However, | + you may accept compensation in exchange for copies. If you | + distribute a large enough number of copies you must also follow | + the conditions in section 3. | + | + You may also lend copies, under the same conditions stated above, | + and you may publicly display copies. | + | + 3. COPYING IN QUANTITY | + | + If you publish printed copies (or copies in media that commonly | + have printed covers) of the Document, numbering more than 100, and | + the Document's license notice requires Cover Texts, you must | + enclose the copies in covers that carry, clearly and legibly, all | + these Cover Texts: Front-Cover Texts on the front cover, and | + Back-Cover Texts on the back cover. Both covers must also clearly | + and legibly identify you as the publisher of these copies. The | + front cover must present the full title with all words of the | + title equally prominent and visible. You may add other material | + on the covers in addition. Copying with changes limited to the | + covers, as long as they preserve the title of the Document and | + satisfy these conditions, can be treated as verbatim copying in | + other respects. | + | + If the required texts for either cover are too voluminous to fit | + legibly, you should put the first ones listed (as many as fit | + reasonably) on the actual cover, and continue the rest onto | + adjacent pages. | + | + If you publish or distribute Opaque copies of the Document | + numbering more than 100, you must either include a | + machine-readable Transparent copy along with each Opaque copy, or | + state in or with each Opaque copy a computer-network location from | + which the general network-using public has access to download | + using public-standard network protocols a complete Transparent | + copy of the Document, free of added material. If you use the | + latter option, you must take reasonably prudent steps, when you | + begin distribution of Opaque copies in quantity, to ensure that | + this Transparent copy will remain thus accessible at the stated | + location until at least one year after the last time you | + distribute an Opaque copy (directly or through your agents or | + retailers) of that edition to the public. | + | + It is requested, but not required, that you contact the authors of | + the Document well before redistributing any large number of | + copies, to give them a chance to provide you with an updated | + version of the Document. | + | + 4. MODIFICATIONS | + | + You may copy and distribute a Modified Version of the Document | + under the conditions of sections 2 and 3 above, provided that you | + release the Modified Version under precisely this License, with | + the Modified Version filling the role of the Document, thus | + licensing distribution and modification of the Modified Version to | + whoever possesses a copy of it. In addition, you must do these | + things in the Modified Version: | + | + A. Use in the Title Page (and on the covers, if any) a title | + distinct from that of the Document, and from those of | + previous versions (which should, if there were any, be listed | + in the History section of the Document). You may use the | + same title as a previous version if the original publisher of | + that version gives permission. | + | + B. List on the Title Page, as authors, one or more persons or | + entities responsible for authorship of the modifications in | + the Modified Version, together with at least five of the | + principal authors of the Document (all of its principal | + authors, if it has fewer than five), unless they release you | + from this requirement. | + | + C. State on the Title page the name of the publisher of the | + Modified Version, as the publisher. | + | + D. Preserve all the copyright notices of the Document. | + | + E. Add an appropriate copyright notice for your modifications | + adjacent to the other copyright notices. | + | + F. Include, immediately after the copyright notices, a license | + notice giving the public permission to use the Modified | + Version under the terms of this License, in the form shown in | + the Addendum below. | + | + G. Preserve in that license notice the full lists of Invariant | + Sections and required Cover Texts given in the Document's | + license notice. | + | + H. Include an unaltered copy of this License. | + | + I. Preserve the section Entitled "History", Preserve its Title, | + and add to it an item stating at least the title, year, new | + authors, and publisher of the Modified Version as given on | + the Title Page. If there is no section Entitled "History" in | + the Document, create one stating the title, year, authors, | + and publisher of the Document as given on its Title Page, | + then add an item describing the Modified Version as stated in | + the previous sentence. | + | + J. Preserve the network location, if any, given in the Document | + for public access to a Transparent copy of the Document, and | + likewise the network locations given in the Document for | + previous versions it was based on. These may be placed in | + the "History" section. You may omit a network location for a | + work that was published at least four years before the | + Document itself, or if the original publisher of the version | + it refers to gives permission. | + | + K. For any section Entitled "Acknowledgements" or "Dedications", | + Preserve the Title of the section, and preserve in the | + section all the substance and tone of each of the contributor | + acknowledgements and/or dedications given therein. | + | + L. Preserve all the Invariant Sections of the Document, | + unaltered in their text and in their titles. Section numbers | + or the equivalent are not considered part of the section | + titles. | + | + M. Delete any section Entitled "Endorsements". Such a section | + may not be included in the Modified Version. | + | + N. Do not retitle any existing section to be Entitled | + "Endorsements" or to conflict in title with any Invariant | + Section. | + | + O. Preserve any Warranty Disclaimers. | + | + If the Modified Version includes new front-matter sections or | + appendices that qualify as Secondary Sections and contain no | + material copied from the Document, you may at your option | + designate some or all of these sections as invariant. To do this, | + add their titles to the list of Invariant Sections in the Modified | + Version's license notice. These titles must be distinct from any | + other section titles. | + | + You may add a section Entitled "Endorsements", provided it contains | + nothing but endorsements of your Modified Version by various | + parties--for example, statements of peer review or that the text | + has been approved by an organization as the authoritative | + definition of a standard. | + | + You may add a passage of up to five words as a Front-Cover Text, | + and a passage of up to 25 words as a Back-Cover Text, to the end | + of the list of Cover Texts in the Modified Version. Only one | + passage of Front-Cover Text and one of Back-Cover Text may be | + added by (or through arrangements made by) any one entity. If the | + Document already includes a cover text for the same cover, | + previously added by you or by arrangement made by the same entity | + you are acting on behalf of, you may not add another; but you may | + replace the old one, on explicit permission from the previous | + publisher that added the old one. | + | + The author(s) and publisher(s) of the Document do not by this | + License give permission to use their names for publicity for or to | + assert or imply endorsement of any Modified Version. | + | + 5. COMBINING DOCUMENTS | + | + You may combine the Document with other documents released under | + this License, under the terms defined in section 4 above for | + modified versions, provided that you include in the combination | + all of the Invariant Sections of all of the original documents, | + unmodified, and list them all as Invariant Sections of your | + combined work in its license notice, and that you preserve all | + their Warranty Disclaimers. | + | + The combined work need only contain one copy of this License, and | + multiple identical Invariant Sections may be replaced with a single | + copy. If there are multiple Invariant Sections with the same name | + but different contents, make the title of each such section unique | + by adding at the end of it, in parentheses, the name of the | + original author or publisher of that section if known, or else a | + unique number. Make the same adjustment to the section titles in | + the list of Invariant Sections in the license notice of the | + combined work. | + | + In the combination, you must combine any sections Entitled | + "History" in the various original documents, forming one section | + Entitled "History"; likewise combine any sections Entitled | + "Acknowledgements", and any sections Entitled "Dedications". You | + must delete all sections Entitled "Endorsements." | + | + 6. COLLECTIONS OF DOCUMENTS | + | + You may make a collection consisting of the Document and other | + documents released under this License, and replace the individual | + copies of this License in the various documents with a single copy | + that is included in the collection, provided that you follow the | + rules of this License for verbatim copying of each of the | + documents in all other respects. | + | + You may extract a single document from such a collection, and | + distribute it individually under this License, provided you insert | + a copy of this License into the extracted document, and follow | + this License in all other respects regarding verbatim copying of | + that document. | + | + 7. AGGREGATION WITH INDEPENDENT WORKS | + | + A compilation of the Document or its derivatives with other | + separate and independent documents or works, in or on a volume of | + a storage or distribution medium, is called an "aggregate" if the | + copyright resulting from the compilation is not used to limit the | + legal rights of the compilation's users beyond what the individual | + works permit. When the Document is included in an aggregate, this | + License does not apply to the other works in the aggregate which | + are not themselves derivative works of the Document. | + | + If the Cover Text requirement of section 3 is applicable to these | + copies of the Document, then if the Document is less than one half | + of the entire aggregate, the Document's Cover Texts may be placed | + on covers that bracket the Document within the aggregate, or the | + electronic equivalent of covers if the Document is in electronic | + form. Otherwise they must appear on printed covers that bracket | + the whole aggregate. | + | + 8. TRANSLATION | + | + Translation is considered a kind of modification, so you may | + distribute translations of the Document under the terms of section | + 4. Replacing Invariant Sections with translations requires special | + permission from their copyright holders, but you may include | + translations of some or all Invariant Sections in addition to the | + original versions of these Invariant Sections. You may include a | + translation of this License, and all the license notices in the | + Document, and any Warranty Disclaimers, provided that you also | + include the original English version of this License and the | + original versions of those notices and disclaimers. In case of a | + disagreement between the translation and the original version of | + this License or a notice or disclaimer, the original version will | + prevail. | + | + If a section in the Document is Entitled "Acknowledgements", | + "Dedications", or "History", the requirement (section 4) to | + Preserve its Title (section 1) will typically require changing the | + actual title. | + | + 9. TERMINATION | + | + You may not copy, modify, sublicense, or distribute the Document | + except as expressly provided for under this License. Any other | + attempt to copy, modify, sublicense or distribute the Document is | + void, and will automatically terminate your rights under this | + License. However, parties who have received copies, or rights, | + from you under this License will not have their licenses | + terminated so long as such parties remain in full compliance. | + | + 10. FUTURE REVISIONS OF THIS LICENSE | + | + The Free Software Foundation may publish new, revised versions of | + the GNU Free Documentation License from time to time. Such new | + versions will be similar in spirit to the present version, but may | + differ in detail to address new problems or concerns. See | + `http://www.gnu.org/copyleft/'. | + | + Each version of the License is given a distinguishing version | + number. If the Document specifies that a particular numbered | + version of this License "or any later version" applies to it, you | + have the option of following the terms and conditions either of | + that specified version or of any later version that has been | + published (not as a draft) by the Free Software Foundation. If | + the Document does not specify a version number of this License, | + you may choose any version ever published (not as a draft) by the | + Free Software Foundation. | + | + +File: slib.info, Node: How to use this License for your documents, Prev: Copying This Manual, Up: About this manual + | +8.6.2 How to use this License for your documents | +------------------------------------------------ | + | +To use this License in a document you have written, include a copy of | +the License in the document and put the following copyright and license | +notices just after the title page: | + | + Copyright (C) YEAR YOUR NAME. | + Permission is granted to copy, distribute and/or modify this document | + under the terms of the GNU Free Documentation License, Version 1.2 | + or any later version published by the Free Software Foundation; | + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover | + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. | + | + If you have Invariant Sections, Front-Cover Texts and Back-Cover | +Texts, replace the "with...Texts." line with this: | + | + with the Invariant Sections being LIST THEIR TITLES, with | + the Front-Cover Texts being LIST, and with the Back-Cover Texts | + being LIST. | + | + If you have Invariant Sections without Cover Texts, or some other | +combination of the three, merge those two alternatives to suit the | +situation. | + | + If your document contains nontrivial examples of program code, we | +recommend releasing these examples in parallel under your choice of | +free software license, such as the GNU General Public License, to | +permit their use in free software. | + | + 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: @@ -16032,6 +16693,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * a:flor32b: Arrays. (line 173) * a:flor64b: Arrays. (line 169) * abort: Session Support. (line 9) +* abs: Irrational Real Functions. | + (line 86) | * absolute-path?: URI. (line 102) * absolute-uri?: URI. (line 98) * add-command-tables: Database Extension. (line 11) @@ -16054,8 +16717,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * alist-map: Association Lists. (line 48) * alist-remover: Association Lists. (line 39) * alist-table: The Base. (line 12) -* and-let*: Guarded LET* special form. | - (line 9) | +* and-let*: Guarded LET* special form. + (line 9) * and?: Non-List functions. (line 7) * any: SRFI-1. (line 156) * any-bits-set?: Bit-Twiddling. (line 64) @@ -16078,12 +16741,14 @@ This is an alphabetical list of all the procedures and macros in SLIB. * array-rank: Arrays. (line 44) * array-ref: Arrays. (line 136) * array-set!: Arrays. (line 139) -* array-trim: Subarrays. (line 44) +* array-trim: Subarrays. (line 48) | * 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) +* atan: Irrational Real Functions. | + (line 22) | * atom?: Non-List functions. (line 30) * batch:call-with-output-script: Batch. (line 47) * batch:command: Batch. (line 64) @@ -16098,9 +16763,9 @@ This is an alphabetical list of all the procedures and macros in SLIB. * 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-and: Bit-Twiddling. (line 19) * bitwise-if: Bit-Twiddling. (line 56) -* bitwise-ior: Bit-Twiddling. (line 28) | +* bitwise-ior: Bit-Twiddling. (line 28) * bitwise-merge: Bit-Twiddling. (line 57) * bitwise-not: Bit-Twiddling. (line 46) * bitwise-xor: Bit-Twiddling. (line 37) @@ -16120,7 +16785,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. * byte-set!: Byte. (line 18) * bytes: Byte. (line 32) * bytes->ieee-double: Byte/Number Conversions. - (line 60) | + (line 60) * bytes->ieee-float: Byte/Number Conversions. (line 41) * bytes->integer: Byte/Number Conversions. @@ -16128,8 +16793,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * 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) +* bytes-reverse: Byte. (line 63) | +* bytes-reverse!: Byte. (line 60) | * 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) @@ -16224,8 +16889,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * command:modify-table: HTML Tables. (line 87) * concatenate: SRFI-1. (line 90) * concatenate!: SRFI-1. (line 91) -* cond: Guarded COND Clause. (line 11) | -* cond-expand: SRFI. (line 12) | +* cond: Guarded COND Clause. (line 11) +* cond-expand: SRFI. (line 12) * cons*: SRFI-1. (line 22) * continue: Breakpoints. (line 20) * convert-color: Color Data-Type. (line 54) @@ -16251,10 +16916,10 @@ This is an alphabetical list of all the procedures and macros in SLIB. * 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 <1>: Byte. (line 84) | * current-input-port: Ruleset Definition and Use. (line 57) -* current-output-port: Byte. (line 66) +* current-output-port: Byte. (line 76) | * current-time: Time and Date. (line 20) * cvs-directories: CVS. (line 14) * cvs-files: CVS. (line 9) @@ -16274,7 +16939,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. * define-macro: Within-database. (line 58) * define-operation: Yasos interface. (line 7) * define-predicate: Yasos interface. (line 12) -* define-record-type: Define-Record-Type. (line 12) | +* define-record-type: Define-Record-Type. (line 12) * define-structure: Define-Structure. (line 12) * define-syntax: Macro by Example. (line 39) * define-table: Within-database. (line 26) @@ -16285,7 +16950,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. * defmacro:load: Defmacro. (line 19) * defmacro?: Defmacro. (line 27) * delaminate-list: Hilbert Space-Filling Curve. - (line 89) | + (line 89) * delay: Promises. (line 15) * delete: Destructive list operations. (line 58) @@ -16305,6 +16970,10 @@ This is an alphabetical list of all the procedures and macros in SLIB. * dequeue!: Queues. (line 28) * dequeue-all!: Queues. (line 36) * determinant: Matrix Algebra. (line 18) +* dft: Discrete Fourier Transform. | + (line 44) | +* dft-1: Discrete Fourier Transform. | + (line 49) | * diff:edit-length: Sequence Comparison. (line 64) * diff:edits: Sequence Comparison. (line 45) * diff:longest-common-subsequence: Sequence Comparison. (line 32) @@ -16338,17 +17007,17 @@ This is an alphabetical list of all the procedures and macros in SLIB. * exports<-info-index: Top-level Variable References. (line 35) * expt: Miscellany. (line 20) -* extended-euclid: Modular Arithmetic. (line 28) +* extended-euclid: Modular Arithmetic. (line 9) | * 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. - (line 14) +* fft: Discrete Fourier Transform. | + (line 27) | +* fft-1: Discrete Fourier Transform. | + (line 34) | * fifth: SRFI-1. (line 61) * file->color-dictionary: Color Names. (line 68) * file->definitions: Module Manifests. (line 72) @@ -16491,17 +17160,17 @@ This is an alphabetical list of all the procedures and macros in SLIB. * identifier?: Syntactic Closures. (line 334) * identity: Miscellany. (line 9) * ieee-byte-collate: Byte/Number Conversions. - (line 151) | + (line 151) * ieee-byte-collate!: Byte/Number Conversions. - (line 142) | + (line 142) * ieee-byte-decollate: Byte/Number Conversions. - (line 155) | + (line 155) * ieee-byte-decollate!: Byte/Number Conversions. - (line 147) | + (line 147) * ieee-double->bytes: Byte/Number Conversions. - (line 97) | + (line 97) * ieee-float->bytes: Byte/Number Conversions. - (line 79) | + (line 79) * illuminant-map: Spectra. (line 77) * illuminant-map->XYZ: Spectra. (line 82) * implementation-vicinity: Vicinity. (line 42) @@ -16516,15 +17185,21 @@ This is an alphabetical list of all the procedures and macros in SLIB. (line 30) * integer->list: Bit-Twiddling. (line 215) * integer->peano-coordinates: Peano Space-Filling Curve. - (line 19) | + (line 19) * integer-byte-collate: Byte/Number Conversions. - (line 136) | + (line 136) * integer-byte-collate!: Byte/Number Conversions. - (line 130) | + (line 130) +* integer-expt: Irrational Integer Functions. | + (line 9) | * integer-length: Bit-Twiddling. (line 88) -* integer-sqrt: Root Finding. (line 9) | +* integer-log: Irrational Integer Functions. | + (line 18) | +* integer-sqrt <1>: Root Finding. (line 9) | +* integer-sqrt: Irrational Integer Functions. | + (line 23) | * interaction-environment: Eval. (line 51) -* interpolate-array-ref: Array Interpolation. (line 9) | +* interpolate-array-ref: Array Interpolation. (line 9) * interpolate-from-table: Database Interpolation. (line 13) * intersection: Lists as sets. (line 32) @@ -16559,7 +17234,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. * light:directional: Solid Modeling. (line 122) * light:point: Solid Modeling. (line 158) * light:spot: Solid Modeling. (line 176) -* limit: The Limit. (line 7) | +* limit: The Limit. (line 7) * list*: List construction. (line 18) * list->array: Arrays. (line 88) * list->bytes: Byte. (line 40) @@ -16572,6 +17247,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * list-tail: Rev4 Optional Procedures. (line 12) * list=: SRFI-1. (line 48) +* ln: Irrational Real Functions. | + (line 77) | * load->path: Module Manifests. (line 63) * load-ciexyz: Spectra. (line 37) * load-color-dictionary: Color Names. (line 52) @@ -16640,6 +17317,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. (line 17) * make-object: Object. (line 46) * make-parameter-list: Parameter lists. (line 23) +* make-polar: Irrational Real Functions. | + (line 94) | * make-predicate!: Object. (line 72) * make-prever on base-table: Base ISAM Operations. (line 25) @@ -16651,6 +17330,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * make-random-state: Exact Random Numbers. (line 44) * make-record-type: Records. (line 12) +* make-rectangular: Irrational Real Functions. | + (line 93) | * make-relational-system: Relational Database Objects. (line 11) * make-ruleset: Commutative Rings. (line 82) @@ -16679,29 +17360,30 @@ This is an alphabetical list of all the procedures and macros in SLIB. * 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) +* merge: Sorting. (line 126) | +* merge!: Sorting. (line 131) | * 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) +* mod: Irrational Real Functions. | + (line 52) | +* modular:*: Modular Arithmetic. (line 61) | +* modular:+: Modular Arithmetic. (line 55) | +* modular:-: Modular Arithmetic. (line 58) | +* modular:characteristic: Modular Arithmetic. (line 19) | +* modular:expt: Modular Arithmetic. (line 67) | +* modular:invert: Modular Arithmetic. (line 48) | +* modular:invertable?: Modular Arithmetic. (line 44) | +* modular:negate: Modular Arithmetic. (line 52) | +* modular:normalize: Modular Arithmetic. (line 23) | * mrna<-cdna: NCBI-DNA. (line 15) * must-be-first: Batch. (line 128) * must-be-last: Batch. (line 133) -* natural->peano-coordinates: Peano Space-Filling Curve. | - (line 9) | +* natural->peano-coordinates: Peano Space-Filling Curve. + (line 9) * ncbi:read-dna-sequence: NCBI-DNA. (line 7) * ncbi:read-file: NCBI-DNA. (line 11) * nconc: Destructive list operations. (line 10) -* newton:find-integer-root: Root Finding. (line 13) | +* newton:find-integer-root: Root Finding. (line 13) * newton:find-root: Root Finding. (line 30) * ninth: SRFI-1. (line 65) * not-pair?: SRFI-1. (line 46) @@ -16726,7 +17408,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. * open-database on relational-system: Relational Database Objects. (line 45) * open-database!: Using Databases. (line 68) -* open-file <1>: Byte. (line 57) +* open-file <1>: Byte. (line 67) | * open-file: Input/Output. (line 18) * open-table: Using Databases. (line 107) * open-table on base-table: Base Tables. (line 16) @@ -16756,9 +17438,9 @@ This is an alphabetical list of all the procedures and macros in SLIB. * path->uri: URI. (line 95) * pathname->vicinity: Vicinity. (line 25) * peano-coordinates->integer: Peano Space-Filling Curve. - (line 25) | -* peano-coordinates->natural: Peano Space-Filling Curve. | - (line 15) | + (line 25) +* peano-coordinates->natural: Peano Space-Filling Curve. + (line 15) * plot <1>: Legacy Plotting. (line 11) * plot: Character Plotting. (line 17) * plot-column: Drawing the Graph. (line 7) @@ -16832,6 +17514,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * queue-push!: Queues. (line 22) * queue-rear: Queues. (line 42) * queue?: Queues. (line 16) +* quo: Irrational Real Functions. | + (line 50) | * random: Exact Random Numbers. (line 9) * random:exp: Inexact Random Numbers. @@ -16847,16 +17531,38 @@ This is an alphabetical list of all the procedures and macros in SLIB. * random:uniform: Inexact Random Numbers. (line 9) * rationalize: Rationalize. (line 9) -* read-byte: Byte. (line 69) -* read-bytes: Byte. (line 87) +* read-byte: Byte. (line 79) | +* read-bytes: Byte. (line 97) | * 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: Binding to multiple values. | - (line 9) | +* real-acos: Irrational Real Functions. | + (line 20) | +* real-asin: Irrational Real Functions. | + (line 19) | +* real-atan: Irrational Real Functions. | + (line 21) | +* real-cos: Irrational Real Functions. | + (line 17) | +* real-exp: Irrational Real Functions. | + (line 13) | +* real-expt: Irrational Real Functions. | + (line 37) | +* real-ln: Irrational Real Functions. | + (line 14) | +* real-log: Irrational Real Functions. | + (line 15) | +* real-sin: Irrational Real Functions. | + (line 16) | +* real-sqrt: Irrational Real Functions. | + (line 32) | +* real-tan: Irrational Real Functions. | + (line 18) | +* receive: Binding to multiple values. + (line 9) * record-accessor: Records. (line 41) * record-constructor: Records. (line 22) * record-modifier: Records. (line 50) @@ -16866,7 +17572,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * reduce: Collections. (line 71) * reduce-init: Lists as sequences. (line 61) * reduce-right: SRFI-1. (line 120) -* rem: Modular Arithmetic. (line 10) +* rem: Irrational Real Functions. | + (line 51) | * remove <1>: SRFI-1. (line 135) * remove: Lists as sets. (line 153) * remove!: SRFI-1. (line 139) @@ -16881,7 +17588,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. * require <1>: Catalog Creation. (line 48) * require: Require. (line 25) * require-if: Require. (line 40) -* resample-array!: Array Interpolation. (line 19) | +* resample-array!: Array Interpolation. (line 19) * resene: Color Names. (line 129) * restrict-table on relational-database: Database Operations. (line 77) * reverse!: SRFI-1. (line 93) @@ -16943,6 +17650,10 @@ This is an alphabetical list of all the procedures and macros in SLIB. * setter: Setters. (line 22) * setup-plot: Column Ranges. (line 22) * seventh: SRFI-1. (line 63) +* sft: Discrete Fourier Transform. | + (line 15) | +* sft-1: Discrete Fourier Transform. | + (line 21) | * si:conversion-factor: Metric Units. (line 160) * singleton-wt-tree: Construction of Weight-Balanced Trees. (line 58) @@ -16966,33 +17677,35 @@ This is an alphabetical list of all the procedures and macros in SLIB. * 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:arrow: Solid Modeling. (line 413) | +* solid:basrelief: Solid Modeling. (line 285) | * 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) +* solid:center-array-of: Solid Modeling. (line 404) | +* solid:center-pile-of: Solid Modeling. (line 409) | +* solid:center-row-of: Solid Modeling. (line 400) | +* solid:color: Solid Modeling. (line 327) | +* solid:cone: Solid Modeling. (line 235) | +* solid:cylinder: Solid Modeling. (line 220) | +* solid:disk: Solid Modeling. (line 228) | +* solid:ellipsoid: Solid Modeling. (line 253) | +* solid:font: Solid Modeling. (line 365) | +* solid:lumber: Solid Modeling. (line 215) | +* solid:polyline: Solid Modeling. (line 262) | +* solid:prism: Solid Modeling. (line 276) | +* solid:pyramid: Solid Modeling. (line 241) | +* solid:rotation: Solid Modeling. (line 432) | +* solid:scale: Solid Modeling. (line 428) | +* solid:sphere: Solid Modeling. (line 247) | +* solid:text: Solid Modeling. (line 308) | +* solid:texture: Solid Modeling. (line 344) | +* solid:translation: Solid Modeling. (line 423) | * 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) +* sort: Sorting. (line 138) | +* sort!: Sorting. (line 148) | +* sorted?: Sorting. (line 116) | * soundex: Soundex. (line 9) * span: SRFI-1. (line 148) * span!: SRFI-1. (line 150) @@ -17033,15 +17746,16 @@ This is an alphabetical list of all the procedures and macros in SLIB. * StudlyCapsExpand: String-Case. (line 29) * sub-vicinity: Vicinity. (line 73) * subarray: Subarrays. (line 9) +* subbytes: Byte. (line 50) | +* subbytes-read!: Byte. (line 122) | +* subbytes-write: Byte. (line 131) | * 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-move-right!: Rev2 Procedures. (line 14) | * substring?: String Search. (line 19) * substv: Tree Operations. (line 13) * sunlight-chromaticity: Daylight. (line 65) @@ -17049,7 +17763,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. * 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) +* symmetric:modulus: Modular Arithmetic. (line 13) | * sync-base on base-table: The Base. (line 53) * sync-database: Using Databases. (line 82) * sync-database on relational-database: Database Operations. (line 37) @@ -17149,8 +17863,8 @@ This is an alphabetical list of all the procedures and macros in SLIB. * 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-byte: Byte. (line 72) | +* write-bytes: Byte. (line 108) | * write-database: Using Databases. (line 79) * write-database on relational-database: Database Operations. (line 26) * write-line: Line I/O. (line 29) @@ -17207,7 +17921,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. * wt-tree/union: Advanced Operations on Weight-Balanced Trees. (line 25) * x-axis: Legending. (line 51) -* x1: Legacy Plotting. (line 18) | +* x1: Legacy Plotting. (line 18) * xcons: SRFI-1. (line 15) * xRGB->CIEXYZ: Color Conversions. (line 51) * xrgb->color: Color Spaces. (line 215) @@ -17222,9 +17936,7 @@ This is an alphabetical list of all the procedures and macros in SLIB. Variable Index ************** - -This is an alphabetical list of all the global variables in SLIB. - + | * Menu: @@ -17270,6 +17982,8 @@ This is an alphabetical list of all the global variables in SLIB. * graph:dimensions: Legacy Plotting. (line 7) * graphrect: Rectangles. (line 26) * leftedge: Legending. (line 22) +* modulo: Irrational Integer Functions. | + (line 29) | * most-positive-fixnum: Configuration. (line 15) * nil: Miscellany. (line 70) * number-wt-type: Construction of Weight-Balanced Trees. @@ -17277,6 +17991,10 @@ This is an alphabetical list of all the global variables in SLIB. * plotrect: Rectangles. (line 22) * prime:prngs: Prime Numbers. (line 9) * prime:trials: Prime Numbers. (line 24) +* quotient: Irrational Integer Functions. | + (line 27) | +* remainder: Irrational Integer Functions. | + (line 28) | * rightedge: Legending. (line 23) * slib:form-feed: Configuration. (line 29) * slib:tab: Configuration. (line 26) @@ -17287,8 +18005,7 @@ This is an alphabetical list of all the global variables in SLIB. * stdout: Standard Formatted I/O. (line 22) * string-wt-type: Construction of Weight-Balanced Trees. - (line 45) -* subarray0: Subarrays. (line 41) + (line 45) | * t: Miscellany. (line 67) * tok:decimal-digits: Token definition. (line 41) * tok:lower-case: Token definition. (line 48) @@ -17304,7 +18021,7 @@ Concept and Feature Index * Menu: -* =>: Guarded COND Clause. (line 21) | +* =>: Guarded COND Clause. (line 21) * aggregate <1>: Module Semantics. (line 20) * aggregate: Library Catalogs. (line 24) * alarm: Multi-Processing. (line 10) @@ -17314,10 +18031,10 @@ Concept and Feature Index (line 23) * alist-table <2>: The Base. (line 12) * alist-table: Base Table. (line 16) -* and-let*: Guarded LET* special form. | - (line 6) | +* and-let*: Guarded LET* special form. + (line 6) * ange-ftp: URI. (line 118) -* appearance: Solid Modeling. (line 320) +* appearance: Solid Modeling. (line 334) | * array: Arrays. (line 6) * array-for-each: Array Mapping. (line 6) * association function: Association Lists. (line 17) @@ -17328,7 +18045,8 @@ Concept and Feature Index * base: URI. (line 39) * base-table: Base Table. (line 6) * batch: Batch. (line 6) -* binary: Byte. (line 56) +* bignum: Feature. (line 13) | +* binary: Byte. (line 66) | * binary trees: Weight-Balanced Trees. (line 8) * binary trees, as discrete maps: Weight-Balanced Trees. @@ -17371,6 +18089,7 @@ Concept and Feature Index * commutative-ring: Commutative Rings. (line 11) * compiled: Library Catalogs. (line 21) * compiling: Module Conventions. (line 11) +* complex: Feature. (line 13) | * Coordinated Universal Time: Posix Time. (line 13) * copyright: Copyrights. (line 6) * crc: Cyclic Checksum. (line 6) @@ -17385,17 +18104,19 @@ Concept and Feature Index * db->html: HTML Tables. (line 6) * debug <1>: Breakpoints. (line 11) * debug: Debug. (line 6) -* define-record-type: Define-Record-Type. (line 6) | +* define-record-type: Define-Record-Type. (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) +* dft, Fourier-transform: Discrete Fourier Transform. | + (line 6) | * diff: Sequence Comparison. (line 6) * directory: Directories. (line 6) -* Discrete Fourier Transform: Fast Fourier Transform. - (line 11) +* Discrete Fourier Transform: Discrete Fourier Transform. | + (line 18) | * discrete maps, using binary trees: Weight-Balanced Trees. (line 52) * DrScheme: Installation. (line 103) @@ -17410,11 +18131,10 @@ Concept and Feature Index * eval: Eval. (line 6) * exchanger: Miscellany. (line 31) * factor: Prime Numbers. (line 6) -* feature <1>: About this manual. (line 13) +* FDL, GNU Free Documentation License: Copying This Manual. (line 6) | +* feature <1>: About this manual. (line 18) | * feature <2>: Require. (line 18) -* feature: Feature. (line 6) -* fft: Fast Fourier Transform. - (line 6) +* feature: Feature. (line 6) | * File Transfer Protocol: URI. (line 113) * file-lock: Transactions. (line 32) * filename: Filenames. (line 6) @@ -17434,7 +18154,7 @@ Concept and Feature Index * glob: Filenames. (line 6) * Gray code: Hilbert Space-Filling Curve. (line 52) -* guarded-cond-clause: Guarded COND Clause. (line 6) | +* guarded-cond-clause: Guarded COND Clause. (line 6) * Guile: Installation. (line 119) * hash: Hashing. (line 6) * hash-table: Hash Tables. (line 6) @@ -17454,7 +18174,8 @@ Concept and Feature Index * ICC Profile: Color Spaces. (line 191) * implcat: Catalog Vicinities. (line 23) * indexed-sequential-access-method: Byte/Number Conversions. - (line 127) | + (line 127) +* inexact: Feature. (line 13) | * infix: Rule Types. (line 19) * Info: Top-level Variable References. (line 32) @@ -17493,6 +18214,10 @@ Concept and Feature Index * match-keys: Match-Keys. (line 6) * matchfix: Rule Types. (line 39) * matfile: MAT-File Format. (line 6) +* math-integer: Irrational Integer Functions. | + (line 6) | +* math-real: Irrational Real Functions. | + (line 6) | * matlab: MAT-File Format. (line 6) * metric-units: Metric Units. (line 6) * minimize: Minimizing. (line 6) @@ -17527,8 +18252,8 @@ Concept and Feature Index (line 22) * pbm-raw: Portable Image Files. (line 22) -* peano-fill: Peano Space-Filling Curve. | - (line 6) | +* peano-fill: Peano Space-Filling Curve. + (line 6) * pgm: Portable Image Files. (line 26) * pgm-raw: Portable Image Files. @@ -17576,10 +18301,12 @@ Concept and Feature Index * random-inexact: Inexact Random Numbers. (line 6) * range: Column Ranges. (line 6) +* rational: Feature. (line 13) | * rationalize: Rationalize. (line 6) * read-command: Command Line. (line 6) -* receive: Binding to multiple values. | - (line 6) | +* real: Feature. (line 13) | +* receive: Binding to multiple values. + (line 6) * record: Records. (line 6) * rectangle: Rectangles. (line 6) * relational-database: Relational Database. (line 6) @@ -17635,12 +18362,22 @@ Concept and Feature Index * srfi: SRFI. (line 6) * SRFI-1: SRFI-1. (line 8) * srfi-1: SRFI-1. (line 6) -* srfi-2: Guarded LET* special form. | - (line 6) | -* srfi-61: Guarded COND Clause. (line 6) | -* srfi-8: Binding to multiple values. | - (line 6) | -* srfi-9: Define-Record-Type. (line 6) | +* srfi-2 <1>: SRFI. (line 33) | +* srfi-2: Guarded LET* special form. + (line 6) +* srfi-23: SRFI. (line 37) | +* srfi-47: SRFI. (line 39) | +* srfi-59: SRFI. (line 43) | +* srfi-60 <1>: SRFI. (line 45) | +* srfi-60: Bit-Twiddling. (line 6) | +* srfi-61 <1>: SRFI. (line 47) | +* srfi-61: Guarded COND Clause. (line 6) +* srfi-63: SRFI. (line 41) | +* srfi-8 <1>: SRFI. (line 33) | +* srfi-8: Binding to multiple values. + (line 6) +* srfi-9 <1>: SRFI. (line 35) | +* srfi-9: Define-Record-Type. (line 6) * sRGB: Color Spaces. (line 189) * stdio: Standard Formatted I/O. (line 14) @@ -17650,7 +18387,7 @@ Concept and Feature Index * subarray: Subarrays. (line 6) * sun: Daylight. (line 6) * sunlight: Daylight. (line 6) -* symmetric: Modular Arithmetic. (line 54) +* symmetric: Modular Arithmetic. (line 38) | * syntactic-closures <1>: Syntactic Closures. (line 6) * syntactic-closures: Library Catalogs. (line 46) * syntax tree: Precedence Parsing Overview. @@ -17706,238 +18443,242 @@ Concept and Feature Index Tag Table: -Node: Top1038 -Node: The Library System1818 -Node: Feature2115 -Ref: Feature-Footnote-14358 -Node: Require4694 -Node: Library Catalogs7107 -Node: Catalog Creation8538 -Node: Catalog Vicinities10959 -Node: Compiling Scheme13719 -Node: Module Conventions14369 -Ref: Module Conventions-Footnote-115790 -Node: Module Manifests16040 -Node: Module Semantics21512 -Node: Top-level Variable References23130 -Ref: Top-level Variable References-Footnote-125205 -Node: Module Analysis25530 -Node: Universal SLIB Procedures26635 -Node: Vicinity27250 -Node: Configuration31105 -Node: Input/Output34071 -Node: System37476 -Node: Miscellany40627 -Node: Scheme Syntax Extension Packages42714 -Node: Defmacro43747 -Node: R4RS Macros45723 -Node: Macro by Example46987 -Node: Macros That Work49885 -Node: Syntactic Closures55879 -Node: Syntax-Case Macros73407 -Node: Define-Structure77338 -Node: Define-Record-Type79393 -Node: Fluid-Let80880 -Node: Binding to multiple values81995 -Node: Guarded LET* special form82859 -Node: Guarded COND Clause83733 -Node: Yasos87706 -Node: Yasos terms88735 -Node: Yasos interface89907 -Node: Setters92129 -Node: Yasos examples94918 -Node: Textual Conversion Packages98004 -Node: Precedence Parsing98805 -Node: Precedence Parsing Overview99490 -Ref: Precedence Parsing Overview-Footnote-195777 -Node: Rule Types101126 -Node: Ruleset Definition and Use102581 -Node: Token definition104965 -Node: Nud and Led Definition107573 -Node: Grammar Rule Definition110034 -Node: Format117630 -Node: Format Interface117885 -Node: Format Specification119635 -Node: Standard Formatted I/O130580 -Node: Standard Formatted Output131168 -Node: Standard Formatted Input140626 -Node: Programs and Arguments147303 -Node: Getopt147811 -Node: Command Line154358 -Node: Parameter lists157556 -Node: Getopt Parameter lists161462 -Node: Filenames164703 -Node: Batch168613 -Node: HTML176437 -Node: HTML Tables182879 -Node: HTTP and CGI189411 -Node: Parsing HTML193960 -Node: URI196467 -Node: Printing Scheme201139 -Node: Generic-Write201458 -Node: Object-To-String202874 -Node: Pretty-Print203293 -Node: Time and Date206278 -Node: Time Zone207335 -Node: Posix Time212077 -Node: Common-Lisp Time214245 -Node: Time Infrastructure215871 -Node: NCBI-DNA216222 -Node: Schmooz217570 -Node: Mathematical Packages221806 -Node: Bit-Twiddling222539 -Node: Modular Arithmetic230610 -Node: Prime Numbers233491 -Node: Random Numbers235188 -Node: Exact Random Numbers236026 -Node: Inexact Random Numbers238298 -Node: Fast Fourier Transform240132 -Node: Cyclic Checksum241044 -Node: Graphing248670 -Node: Character Plotting248865 -Node: PostScript Graphing254377 -Node: Column Ranges256156 -Node: Drawing the Graph257635 -Node: Graphics Context258730 -Node: Rectangles260549 -Node: Legending261996 -Node: Legacy Plotting264225 -Node: Example Graph265438 -Node: Solid Modeling269805 -Node: Color288722 -Node: Color Data-Type289556 -Ref: Color Data-Type-Footnote-1288023 -Node: Color Spaces293941 -Ref: Color Spaces-Footnote-1298022 -Node: Spectra303858 -Node: Color Difference Metrics312621 -Node: Color Conversions315301 -Node: Color Names317443 -Node: Daylight324377 -Node: Root Finding329064 -Node: Minimizing333343 -Ref: Minimizing-Footnote-1329543 -Node: The Limit335464 -Node: Commutative Rings343411 -Node: Matrix Algebra355056 -Node: Database Packages356262 -Node: Relational Database356545 -Node: Using Databases357412 -Node: Table Operations363918 -Node: Single Row Operations365129 -Node: Match-Keys367372 -Node: Multi-Row Operations369451 -Node: Indexed Sequential Access Methods371842 -Node: Sequential Index Operations372850 -Node: Table Administration375206 -Node: Database Interpolation376073 -Node: Embedded Commands377175 -Node: Database Extension378749 -Node: Command Intrinsics380874 -Node: Define-tables Example382436 -Node: The *commands* Table384086 -Node: Command Service386364 -Node: Command Example388326 -Node: Database Macros392879 -Node: Within-database393764 -Node: Within-database Example396671 -Node: Database Browser398458 -Node: Relational Infrastructure399534 -Node: Base Table399838 -Node: The Base402346 -Node: Base Tables405464 -Node: Base Field Types406940 -Node: Composite Keys407723 -Node: Base Record Operations409777 -Node: Match Keys411505 -Node: Aggregate Base Operations412386 -Node: Base ISAM Operations413451 -Node: Catalog Representation414769 -Node: Relational Database Objects417438 -Node: Database Operations420082 -Node: Weight-Balanced Trees423791 -Node: Construction of Weight-Balanced Trees427677 -Node: Basic Operations on Weight-Balanced Trees431143 -Node: Advanced Operations on Weight-Balanced Trees434010 -Node: Indexing Operations on Weight-Balanced Trees440051 -Node: Other Packages443892 -Node: Data Structures444421 -Node: Arrays445291 -Node: Subarrays453978 -Node: Array Mapping456083 -Node: Array Interpolation458572 -Node: Association Lists461008 -Node: Byte463419 -Node: Byte/Number Conversions468737 -Node: MAT-File Format476441 -Node: Portable Image Files477778 -Node: Collections479461 -Node: Dynamic Data Type485715 -Node: Hash Tables487049 -Node: Object489698 -Node: Priority Queues498377 -Node: Queues499289 -Node: Records500600 -Node: Sorting and Searching504175 -Node: Common List Functions504868 -Node: List construction505325 -Node: Lists as sets507040 -Node: Lists as sequences513578 -Node: Destructive list operations518805 -Node: Non-List functions521483 -Node: Tree Operations522572 -Node: Chapter Ordering524265 -Node: Sorting525912 -Node: Topological Sort531753 -Node: Hashing533461 -Node: Space-Filling Curves534478 -Node: Hilbert Space-Filling Curve534782 -Node: Peano Space-Filling Curve538751 -Node: Sierpinski Curve540450 -Node: Soundex542914 -Node: String Search544512 -Node: Sequence Comparison547085 -Node: Procedures550215 -Node: Type Coercion550743 -Node: String-Case551175 -Node: String Ports553002 -Node: Line I/O553774 -Node: Multi-Processing555954 -Node: Metric Units557072 -Node: Standards Support565351 -Node: RnRS566147 -Node: With-File567370 -Node: Transcripts567646 -Node: Rev2 Procedures567980 -Node: Rev4 Optional Procedures569713 -Node: Multi-argument / and -570182 -Node: Multi-argument Apply570592 -Node: Rationalize570929 -Node: Promises572091 -Node: Dynamic-Wind572537 -Node: Eval573805 -Node: Values577150 -Node: SRFI577965 -Node: SRFI-1580198 -Node: Session Support584837 -Node: Repl585490 -Node: Quick Print586786 -Node: Debug588092 -Node: Breakpoints588999 -Node: Trace591041 -Node: System Interface594267 -Node: Directories594838 -Node: Transactions596331 -Node: CVS601842 -Node: Extra-SLIB Packages603009 -Node: About SLIB605318 -Node: Installation606070 -Node: The SLIB script611962 -Node: Porting612425 -Ref: Porting-Footnote-1599966 -Node: Coding Guidelines613989 -Node: Copyrights616403 -Node: About this manual619772 -Node: Index620323 +Node: Top1638 +Node: The Library System3412 +Node: Feature4269 +Ref: Feature-Footnote-15275 +Node: Require6848 +Node: Library Catalogs9261 +Node: Catalog Creation10692 +Node: Catalog Vicinities13067 +Node: Compiling Scheme15827 +Node: Module Conventions16477 +Ref: Module Conventions-Footnote-116707 +Node: Module Manifests18148 +Node: Module Semantics23620 +Node: Top-level Variable References25238 +Ref: Top-level Variable References-Footnote-126122 +Node: Module Analysis27638 +Node: Universal SLIB Procedures28743 +Node: Vicinity29358 +Node: Configuration33213 +Node: Input/Output36271 +Node: System39676 +Node: Miscellany42827 +Node: Scheme Syntax Extension Packages44971 +Node: Defmacro45909 +Node: R4RS Macros47885 +Node: Macro by Example49149 +Node: Macros That Work52047 +Node: Syntactic Closures58041 +Node: Syntax-Case Macros75569 +Node: Define-Structure79500 +Node: Define-Record-Type81476 +Node: Fluid-Let82109 +Node: Binding to multiple values83079 +Node: Guarded LET* special form83441 +Node: Guarded COND Clause83793 +Node: Yasos85578 +Node: Yasos terms86390 +Node: Yasos interface87428 +Node: Setters89524 +Node: Yasos examples92183 +Node: Textual Conversion Packages95141 +Node: Precedence Parsing95942 +Node: Precedence Parsing Overview96627 +Ref: Precedence Parsing Overview-Footnote-196693 +Node: Rule Types98343 +Node: Ruleset Definition and Use99798 +Node: Token definition102195 +Node: Nud and Led Definition104803 +Node: Grammar Rule Definition107264 +Node: Format114860 +Node: Format Interface115115 +Node: Format Specification116865 +Node: Standard Formatted I/O127810 +Node: Standard Formatted Output128398 +Node: Standard Formatted Input137856 +Node: Programs and Arguments144533 +Node: Getopt145041 +Node: Command Line151588 +Node: Parameter lists154786 +Node: Getopt Parameter lists158692 +Node: Filenames161933 +Node: Batch165843 +Node: HTML173667 +Node: HTML Tables180109 +Node: HTTP and CGI186641 +Node: Parsing HTML191190 +Node: URI193697 +Node: Printing Scheme198369 +Node: Generic-Write198688 +Node: Object-To-String200104 +Node: Pretty-Print200523 +Node: Time and Date203508 +Node: Time Zone204565 +Node: Posix Time209307 +Node: Common-Lisp Time211475 +Node: Time Infrastructure213101 +Node: NCBI-DNA213452 +Node: Schmooz214800 +Node: Mathematical Packages219036 +Node: Bit-Twiddling219931 +Node: Modular Arithmetic228060 +Node: Irrational Integer Functions230919 +Node: Irrational Real Functions233383 +Node: Prime Numbers242242 +Node: Random Numbers244087 +Node: Exact Random Numbers245069 +Node: Inexact Random Numbers247394 +Node: Discrete Fourier Transform249279 +Node: Cyclic Checksum253463 +Node: Graphing261232 +Node: Character Plotting261494 +Node: PostScript Graphing267061 +Node: Column Ranges268894 +Node: Drawing the Graph270431 +Node: Graphics Context271580 +Node: Rectangles273454 +Node: Legending274962 +Node: Legacy Plotting277350 +Node: Example Graph278418 +Node: Solid Modeling282843 +Node: Color303002 +Node: Color Data-Type303976 +Ref: Color Data-Type-Footnote-1295346 +Node: Color Spaces308705 +Ref: Color Spaces-Footnote-1305347 +Node: Spectra318744 +Node: Color Difference Metrics327639 +Node: Color Conversions330417 +Node: Color Names332671 +Node: Daylight339729 +Node: Root Finding344546 +Node: Minimizing348629 +Ref: Minimizing-Footnote-1336878 +Node: The Limit350735 +Node: Commutative Rings355670 +Node: Matrix Algebra367236 +Node: Database Packages368442 +Node: Relational Database368725 +Node: Using Databases369592 +Node: Table Operations376098 +Node: Single Row Operations377309 +Node: Match-Keys379570 +Node: Multi-Row Operations381649 +Node: Indexed Sequential Access Methods384040 +Node: Sequential Index Operations385048 +Node: Table Administration387404 +Node: Database Interpolation388271 +Node: Embedded Commands389373 +Node: Database Extension390947 +Node: Command Intrinsics393072 +Node: Define-tables Example394634 +Node: The *commands* Table396284 +Node: Command Service398562 +Node: Command Example400524 +Node: Database Macros405077 +Node: Within-database405962 +Node: Within-database Example408869 +Node: Database Browser410656 +Node: Relational Infrastructure411732 +Node: Base Table412036 +Node: The Base414544 +Node: Base Tables417662 +Node: Base Field Types419138 +Node: Composite Keys419921 +Node: Base Record Operations421975 +Node: Match Keys423703 +Node: Aggregate Base Operations424584 +Node: Base ISAM Operations425649 +Node: Catalog Representation426967 +Node: Relational Database Objects429636 +Node: Database Operations432280 +Node: Weight-Balanced Trees435989 +Node: Construction of Weight-Balanced Trees439875 +Node: Basic Operations on Weight-Balanced Trees443341 +Node: Advanced Operations on Weight-Balanced Trees446208 +Node: Indexing Operations on Weight-Balanced Trees452249 +Node: Other Packages456090 +Node: Data Structures456619 +Node: Arrays457460 +Node: Subarrays466147 +Node: Array Mapping468676 +Node: Array Interpolation471086 +Node: Association Lists472350 +Node: Byte474626 +Node: Byte/Number Conversions480872 +Node: MAT-File Format488342 +Node: Portable Image Files489621 +Node: Collections491251 +Node: Dynamic Data Type497383 +Node: Hash Tables498662 +Node: Object501250 +Node: Priority Queues509533 +Node: Queues510388 +Node: Records511633 +Node: Sorting and Searching515143 +Node: Common List Functions515836 +Node: List construction516293 +Node: Lists as sets518008 +Node: Lists as sequences524546 +Node: Destructive list operations529773 +Node: Non-List functions532451 +Node: Tree Operations533540 +Node: Chapter Ordering535233 +Node: Sorting536880 +Node: Topological Sort544651 +Node: Hashing546359 +Node: Space-Filling Curves547376 +Node: Hilbert Space-Filling Curve547680 +Node: Peano Space-Filling Curve551570 +Node: Sierpinski Curve552676 +Node: Soundex555140 +Node: String Search556738 +Node: Sequence Comparison559311 +Node: Procedures562441 +Node: Type Coercion562969 +Node: String-Case563401 +Node: String Ports565228 +Node: Line I/O566000 +Node: Multi-Processing568049 +Node: Metric Units569167 +Node: Standards Support577446 +Node: RnRS578242 +Node: With-File579465 +Node: Transcripts579741 +Node: Rev2 Procedures580075 +Node: Rev4 Optional Procedures581808 +Node: Multi-argument / and -582277 +Node: Multi-argument Apply582687 +Node: Rationalize583024 +Node: Promises584186 +Node: Dynamic-Wind584632 +Node: Eval585900 +Node: Values589245 +Node: SRFI590060 +Node: SRFI-1591550 +Node: Session Support596110 +Node: Repl596684 +Node: Quick Print597980 +Node: Debug599286 +Node: Breakpoints600193 +Node: Trace602235 +Node: System Interface605461 +Node: Directories606032 +Node: Transactions607525 +Node: CVS613036 +Node: Extra-SLIB Packages614203 +Node: About SLIB616512 +Node: Installation617485 +Node: The SLIB script623377 +Node: Porting623840 +Ref: Porting-Footnote-1608048 +Node: Coding Guidelines625404 +Node: Copyrights627818 +Node: About this manual631187 +Node: Copying This Manual632138 +Node: How to use this License for your documents664205 +Node: Index666885 End Tag Table @@ -1,12 +1,12 @@ Summary: platform independent library for scheme Name: slib -Version: 3a3 -Release: 2 +Version: 3a4 +Release: 1 Group: Development/Languages BuildArch: noarch Packager: Aubrey Jaffer <agj@alum.mit.edu> -Copyright: distributable, see individual files for copyright +License: distributable, see individual files for copyright Vendor: Aubrey Jaffer <agj @ alum.mit.edu> Provides: slib @@ -41,6 +41,10 @@ mkdir -p ${RPM_BUILD_ROOT}%{_bindir} cp *.scm *.init *.xyz *.txt grapheps.ps Makefile ${RPM_BUILD_ROOT}%{_datadir}/slib mkdir -p ${RPM_BUILD_ROOT}%{_infodir} install -m644 slib.info.gz ${RPM_BUILD_ROOT}%{_infodir} +make prefix=${RPM_BUILD_ROOT}%{prefix}/ \ + mandir=${RPM_BUILD_ROOT}%{_mandir}/ \ + infodir=${RPM_BUILD_ROOT}%{_infodir}/ \ + pinstall echo '#! /bin/sh' > ${RPM_BUILD_ROOT}%{_bindir}/slib echo SCHEME_LIBRARY_PATH=%{_datadir}/slib/ >> ${RPM_BUILD_ROOT}%{_bindir}/slib @@ -89,8 +93,9 @@ rm -f srcdir.mk slib.image %{_datadir}/slib/resenecolours.txt %{_datadir}/slib/grapheps.ps %{_infodir}/slib.info.gz -# The Makefile is included as it is useful for building documentation. +# The Makefile is of limited utility without all the texinfo files. %{_datadir}/slib/Makefile +%{_mandir}/man1/slib.1.gz %doc ANNOUNCE README COPYING FAQ ChangeLog %changelog @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename slib.info -@settitle SLIB +@settitle slib @include version.txi @setchapternewpage on @c Choices for setchapternewpage are {on,off,odd}. @@ -11,6 +11,31 @@ @syncodeindex tp cp @c %**end of header +@copying +@noindent +This manual is for SLIB (version @value{SLIBVERSION}, @value{SLIBDATE}), +the portable Scheme library. + +@noindent +@c Copyright (C) 1993 Todd R. Eigenschink@* +Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, +2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.2 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,'' +and with the Back-Cover Texts as in (a) below. A copy of the +license is included in the section entitled ``GNU Free Documentation +License.'' + +(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify +this GNU Manual, like GNU software. Copies published by the Free +Software Foundation raise funds for GNU development.'' +@end quotation +@end copying + @dircategory The Algorithmic Language Scheme @direntry * SLIB: (slib). Scheme Library @@ -23,95 +48,23 @@ @parskip 4pt plus 1pt @end iftex -@ifinfo -This file documents SLIB, the portable Scheme library. - -Copyright (C) 1993 Todd R. Eigenschink@* -Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Aubrey Jaffer - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). - -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the author. -@end ifinfo - -@node Top, The Library System, (dir), (dir) - @titlepage @title SLIB @subtitle The Portable Scheme Library -@subtitle Version @value{SLIBVERSION} -@author by Aubrey Jaffer +@subtitle Version @value{SLIBVERSION}, @value{SLIBDATE} +@author Aubrey Jaffer @page - -@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. - -@noindent -More people than I can name have contributed to SLIB. Thanks to all of -you! -@sp 1 -@quotation -SLIB @value{SLIBVERSION}, released @value{SLIBDATE}.@* -Aubrey Jaffer <agj @@ alum.mit.edu>@* -@ifset html -<A HREF="http://swiss.csail.mit.edu/~jaffer/SLIB.html"> -@end ifset -@url{http://swiss.csail.mit.edu/~jaffer/SLIB.html} -@ifset html -</A> -@end ifset -@end quotation - @vskip 0pt plus 1filll -Copyright @copyright{} 1993 Todd R. Eigenschink@* -Copyright @copyright{} 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000 Aubrey Jaffer - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the author. +@insertcopying @end titlepage +@contents + @ifnottex -@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 ifnottex +@node Top, The Library System, (dir), (dir) +@top SLIB + +@insertcopying @menu * The Library System:: How to use and customize. @@ -124,10 +77,19 @@ implementation, user, or directory. * About SLIB:: Install, etc. * Index:: @end menu +@end ifnottex @node The Library System, Universal SLIB Procedures, Top, Top @chapter The Library System +@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. + @menu * Feature:: SLIB names. * Require:: @@ -152,6 +114,12 @@ are properties of the Scheme implementation being used. The following @dfn{intrinsic feature}s detail what sort of numbers are available from an implementation: +@ftindex inexact +@ftindex rational +@ftindex real +@ftindex complex +@ftindex bignum + @itemize @bullet @item 'inexact @@ -220,14 +188,14 @@ Informs SLIB that @var{feature} is supported in this session. (provided? 'foo) @result{} #t @end example -@c @defvar *features* +@c @defvar slib:features @c Is a list of symbols denoting features present in this implementation. -@c @var{*features*} can grow as modules are @code{require}d. -@c @footnote{The variables @var{*modules*} and @var{*features*} were +@c @var{slib:features} can grow as modules are @code{require}d. +@c @footnote{The variables @var{*modules*} and @var{slib:features} were @c originally modeled on variables of the same names in common-lisp. But @c the distinction between features native to an implementation versus @c those provided by loading files was not useful. The symbols in -@c @var{*features*} now indicate the presence of a capability regardless +@c @var{slib:features} now indicate the presence of a capability regardless @c of how it was provided.} @c @end defvar @@ -865,11 +833,11 @@ slib "@value{SLIBVERSION}" 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* : +loaded slib:features : trace alist qp sort common-list-functions macro values getopt compiled -implementation *features* : +implementation slib:features : bignum complex real rational inexact vicinity ed getenv tmpnam abort transcript with-file @@ -1149,7 +1117,7 @@ The following procedures were present in Scheme until R4RS They are provided by all SLIB implementations. @defvr Constant t -Derfined as @code{#t}. +Defined as @code{#t}. @end defvr @defvr Constant nil @@ -2740,7 +2708,7 @@ call graph of grammar rules effectively instantiate the sytnax tree. @noindent The JACAL symbolic math system -(@url{http://swiss.csail.mit.edu/~jaffer/JACAL.html}) uses +(@url{http://swiss.csail.mit.edu/~jaffer/JACAL}) uses @t{precedence-parse}. Its grammar definitions in the file @file{jacal/English.scm} can serve as examples of use. @@ -2867,10 +2835,10 @@ The @var{ruleset} argument must be a list of rules as constructed by @code{prec:define-grammar} and extracted from @var{*syn-defs*}. The token @var{delim} may be a character, symbol, or string. A -character @var{delim} argument will match only a character token; i.e. a -character for which no token-group is assigned. A symbols or string -will match only a token string; i.e. a token resulting from a token -group. +character @var{delim} argument will match only a character token; +i.e. a character for which no token-group is assigned. A symbol or +string will match only a token string; i.e. a token resulting from a +token group. @code{prec:parse} reads a @var{ruleset} grammar expression delimited by @var{delim} from the given input @var{port}. @code{prec:parse} @@ -4817,9 +4785,11 @@ match the arguments to @code{encode-universal-time}. @menu * Bit-Twiddling:: 'logical * Modular Arithmetic:: 'modular +* Irrational Integer Functions:: +* Irrational Real Functions:: * Prime Numbers:: 'factor * Random Numbers:: 'random -* Fast Fourier Transform:: 'fft +* Discrete Fourier Transform:: 'dft * Cyclic Checksum:: 'crc * Graphing:: * Solid Modeling:: VRML97 @@ -4835,8 +4805,9 @@ match the arguments to @code{encode-universal-time}. @node Bit-Twiddling, Modular Arithmetic, Mathematical Packages, Mathematical Packages @section Bit-Twiddling -@code{(require 'logical)} +@code{(require 'logical)} or @code{(require 'srfi-60)} @ftindex logical +@ftindex srfi-60 @noindent The bit-twiddling functions are made available through the use of the @@ -5114,13 +5085,168 @@ Returns the integer coded by the @var{bool1} @dots{} arguments. -@node Modular Arithmetic, Prime Numbers, Bit-Twiddling, Mathematical Packages +@node Modular Arithmetic, Irrational Integer Functions, Bit-Twiddling, Mathematical Packages @section Modular Arithmetic @include modular.txi -@node Prime Numbers, Random Numbers, Modular Arithmetic, Mathematical Packages +@node Irrational Integer Functions, Irrational Real Functions, Modular Arithmetic, Mathematical Packages +@section Irrational Integer Functions + +@include math-integer.txi + + +@node Irrational Real Functions, Prime Numbers, Irrational Integer Functions, Mathematical Packages +@section Irrational Real Functions + +@code{(require 'math-real)} +@ftindex math-real + +Although this package defines real and complex functions, it is safe +to load into an integer-only implementation; those functions will be +defined to #f. + +@defun real-exp @var{x} +@defunx real-ln @var{x} +@defunx real-log @var{y} @var{x} +@defunx real-sin @var{x} +@defunx real-cos @var{x} +@defunx real-tan @var{x} +@defunx real-asin @var{x} +@defunx real-acos @var{x} +@defunx real-atan @var{x} +@defunx atan @var{y} @var{x} + +These procedures are part of every implementation that supports +general real numbers; they compute the usual transcendental functions. +@samp{real-ln} computes the natural logarithm of @var{x}; +@samp{real-log} computes the logarithm of @var{x} base @var{y}, which +is @code{(/ (real-ln x) (real-ln y))}. If arguments @var{x} and +@var{y} are not both real; or if the correct result would not be real, +then these procedures signal an error. + +@end defun + + +@defun real-sqrt @var{x} + +For non-negative real @var{x} the result will be its positive square +root; otherwise an error will be signaled. + +@end defun + + +@defun real-expt x1 x2 + +Returns @var{x1} raised to the power @var{x2} if that result is a real +number; otherwise signals an error. + +@code{(real-expt 0.0 @var{x2})} + +@itemize @bullet +@item +returns 1.0 for @var{x2} equal to 0.0; +@item +returns 0.0 for positive real @var{x2}; +@item +signals an error otherwise. +@end itemize + +@end defun + + +@defun quo x1 x2 +@defunx rem x1 x2 +@defunx mod x1 x2 + +@var{x2} should be non-zero. + +@example + (quo @var{x1} @var{x2}) ==> @var{n_q} + (rem @var{x1} @var{x2}) ==> @var{x_r} + (mod @var{x1} @var{x2}) ==> @var{x_m} +@end example + +where @var{n_q} is @var{x1}/@var{x2} rounded towards zero, +0 < |@var{x_r}| < |@var{x2}|, 0 < |@var{x_m}| < |@var{x2}|, @var{x_r} +and @var{x_m} differ from @var{x1} by a multiple of @var{x2}, +@var{x_r} has the same sign as @var{x1}, and @var{x_m} has the same +sign as @var{x2}. + +From this we can conclude that for @var{x2} not equal to 0, + +@example + (= @var{x1} (+ (* @var{x2} (quo @var{x1} @var{x2})) + (rem @var{x1} @var{x2}))) + ==> #t +@end example + +provided all numbers involved in that computation are exact. + +@example + (quo 2/3 1/5) ==> 3 + (mod 2/3 1/5) ==> 1/15 + + (quo .666 1/5) ==> 3.0 + (mod .666 1/5) ==> 65.99999999999995e-3 +@end example +@end defun + + +@defun ln @var{z} + +These procedures are part of every implementation that supports +general real numbers. +@samp{Ln} computes the natural logarithm of @var{z} + +In general, the mathematical function ln is multiply defined. The +value of ln @var{z} is defined to be the one whose imaginary part lies +in the range from -pi (exclusive) to pi (inclusive). + +@end defun + + +@defun abs x + +For real argument @var{x}, @samp{Abs} returns the absolute value of +@var{x}' otherwise it signals an error. + +@format +@t{(abs -7) ==> 7 +} +@end format + +@end defun + +@defun make-rectangular x1 x2 +@defunx make-polar x3 x4 + +These procedures are part of every implementation that supports +general complex numbers. Suppose @var{x1}, @var{x2}, @var{x3}, and +@var{x4} are real numbers and @var{z} is a complex number such that + + +@center @var{z} = @var{x1} + @var{x2}@w{i} = @var{x3} . e^@w{i} @var{x4} + +Then + +@format +@t{(make-rectangular @var{x1} @var{x2}) ==> @var{z} +(make-polar @var{x3} @var{x4}) ==> @var{z} +} +@end format + +where -pi < x_angle <= pi with x_angle = @var{x4} + 2pi n +for some integer n. + +If an argument is not real, then these procedures signal an error. + +@end defun + + + +@node Prime Numbers, Random Numbers, Irrational Real Functions, Mathematical Packages @section Prime Numbers @code{(require 'factor)} @@ -5130,7 +5256,7 @@ Returns the integer coded by the @var{bool1} @dots{} arguments. @include factor.txi -@node Random Numbers, Fast Fourier Transform, Prime Numbers, Mathematical Packages +@node Random Numbers, Discrete Fourier Transform, Prime Numbers, Mathematical Packages @section Random Numbers @cindex RNG @@ -5164,13 +5290,13 @@ tests pass. @include randinex.txi -@node Fast Fourier Transform, Cyclic Checksum, Random Numbers, Mathematical Packages -@section Fast Fourier Transform +@node Discrete Fourier Transform, Cyclic Checksum, Random Numbers, Mathematical Packages +@section Discrete Fourier Transform -@include fft.txi +@include dft.txi -@node Cyclic Checksum, Graphing, Fast Fourier Transform, Mathematical Packages +@node Cyclic Checksum, Graphing, Discrete Fourier Transform, Mathematical Packages @section Cyclic Checksum @code{(require 'crc)} @@ -6852,7 +6978,7 @@ signaled. The value returned is unspecified. (every (lambda (c) (memv c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 - #\+ #\( #\ #\) #\-))) + #\+ #\( #\space #\) #\-))) (string->list d)))) string)) @end group @@ -10195,6 +10321,8 @@ pair. (Called @code{atom} in Common LISP.) @code{(require 'sort)} @ftindex sort +[by Richard A. O'Keefe, 1991] + Many Scheme systems provide some kind of sorting functions. They do not, however, always provide the @emph{same} sorting functions, and those that I have had the opportunity to test provided inefficient ones @@ -10275,6 +10403,18 @@ converge on a single interface, and this may serve as a hint. The argument order for all functions has been chosen to be as close to Common LISP as made sense, in order to avoid NIH-itis. +The code of @code{merge} and @code{merge!} could have been quite a bit +simpler, but they have been coded to reduce the amount of work done per +iteration. (For example, we only have one @code{null?} test per +iteration.) + +I gave serious consideration to producing Common-LISP-compatible +functions. However, Common LISP's @code{sort} is our @code{sort!} +(well, in fact Common LISP's @code{stable-sort} is our @code{sort!}; +merge sort is @emph{fast} as well as stable!) so adapting CL code to +Scheme takes a bit of work anyway. I did, however, appeal to CL to +determine the @emph{order} of the arguments. + Each of the five functions has a required @emph{last} parameter which is a comparison function. A comparison function @code{f} is a function of 2 arguments which acts like @code{<}. For example, @@ -10290,86 +10430,75 @@ The standard functions @code{<}, @code{>}, @code{char<?}, @code{char>?}, comparison functions. Think of @code{(less? x y)} as saying when @code{x} must @emph{not} precede @code{y}. +[Addendum by Aubrey Jaffer, 2006] + +These procedures are stable when called with predicates which return +@code{#f} when applied to identical arguments. These procedures have +asymptotic time and space needs no larger than @i{O(N*log(N))}, where +@i{N} is the sum of the lengths of the sequence arguments. + +All five functions take an optional @var{key} argument corresponding +to a CL-style @samp{&key} argument. A @var{less?} predicate with a +@var{key} argument behaves like: + +@lisp +(lambda (x y) (@var{less?} (@var{key} x) (@var{key} y))) +@end lisp + +@c The @var{key} argument should be called at most one time for each +@c element. + +The @samp{!} variants sort in place; @code{sort!} returns its +@var{sequence} argument. + @defun sorted? sequence less? -Returns @code{#t} when the sequence argument is in non-decreasing order -according to @var{less?} (that is, there is no adjacent pair @code{@dots{} x -y @dots{}} for which @code{(less? y x)}). +@defunx sorted? sequence less? key +Returns @code{#t} when the sequence argument is in non-decreasing +order according to @var{less?} (that is, there is no adjacent pair +@code{@dots{} x y @dots{}} for which @code{(less? y x)}). Returns @code{#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 or array +(including vectors and strings). @end defun @defun merge list1 list2 less? -This merges two lists, producing a completely new list as result. I -gave serious consideration to producing a Common-LISP-compatible -version. However, Common LISP's @code{sort} is our @code{sort!} (well, -in fact Common LISP's @code{stable-sort} is our @code{sort!}, merge sort -is @emph{fast} as well as stable!) so adapting CL code to Scheme takes a -bit of work anyway. I did, however, appeal to CL to determine the -@emph{order} of the arguments. -@end defun - -@deffn {Procedure} merge! list1 list2 less? -Merges two lists, re-using the pairs of @var{list1} and @var{list2} to -build the result. If the code is compiled, and @var{less?} constructs -no new pairs, no pairs at all will be allocated. The first pair of the -result will be either the first pair of @var{list1} or the first pair of -@var{list2}, but you can't predict which. - -The code of @code{merge} and @code{merge!} could have been quite a bit -simpler, but they have been coded to reduce the amount of work done per -iteration. (For example, we only have one @code{null?} test per -iteration.) - -@end deffn +@defunx merge list1 list2 less? key +Merges two sorted lists, returning a freshly allocated list as its +result. +@end defun -@defun 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 @code{(sorted? (sort sequence less?) less?)}. The original -sequence is not altered in any way. The new sequence shares its -@emph{elements} with the old one; no elements are copied. +@defun merge! list1 list2 less? +@defunx merge! list1 list2 less? key +Merges two sorted lists, re-using the pairs of @var{list1} and +@var{list2} to build the result. If @code{merge!} is compiled, then +no new pairs will be allocated. The first pair of the result will be +either the first pair of @var{list1} or the first pair of @var{list2}. @end defun -@deffn {Procedure} sort! sequence less? -Returns its sorted result in the original boxes. If the original -sequence is a list, no new storage is allocated at all. If the -original sequence is a vector or string, the sorted elements are put -back in the same vector or string. +@defun sort sequence less? +@defunx sort sequence less? key +Accepts a list or array (including vectors and strings) for +@var{sequence}; and returns a completely new sequence which is sorted +according to @var{less?}. The returned sequence is the same type as +the argument @var{sequence}. Given valid arguments, it is always the +case that: -Some people have been confused about how to use @code{sort!}, thinking -that it doesn't return a value. It needs to be pointed out that -@lisp -(set! slist (sort! slist <)) -@end lisp -@noindent -is the proper usage, not @lisp -(sort! slist <) +(sorted? (sort @var{sequence} @var{less?}) @var{less?}) @result{} #t @end lisp -@end deffn +@end defun -Note that these functions do @emph{not} accept a CL-style @samp{:key} -argument. A simple device for obtaining the same expressiveness is to -define +@defun sort! sequence less? +@defunx sort! sequence less? key +Returns @var{sequence} which has been mutated to order its elements +according to @var{less?}. If the argument @var{sequence} is a list +and @code{sort!} is compiled, then no new pairs will be allocated. If +the argument @var{sequence} is an array (including vectors and +strings), then the sorted elements are returned in the array +@var{sequence}. +@end defun -@lisp -(define (keyed less? key) - (lambda (x y) (less? (key x) (key y)))) -@end lisp -@noindent -and then, when you would have written -@lisp -(sort a-sequence #'my-less :key #'my-key) -@end lisp -@noindent -in Common LISP, just write -@lisp -(sort! a-sequence (keyed my-less? my-key)) -@end lisp -@noindent -in Scheme. @node Topological Sort, Hashing, Sorting, Sorting and Searching @subsection Topological Sort @@ -11379,13 +11508,23 @@ unspecified. @end menu @itemize @bullet +@ftindex srfi-2 @item SRFI-2 @ref{Guarded LET* special form} +@ftindex srfi-8 @item SRFI-8 @ref{Binding to multiple values} +@ftindex srfi-9 @item SRFI-9 @ref{Define-Record-Type} +@ftindex srfi-23 +@item SRFI-23 @code{(define error slib:error)} +@ftindex srfi-47 @item SRFI-47 @ref{Arrays} -@item SRFI-59 @ref{Vicinity} +@ftindex srfi-63 @item SRFI-63 @ref{Arrays} +@ftindex srfi-59 +@item SRFI-59 @ref{Vicinity} +@ftindex srfi-60 @item SRFI-60 @ref{Bit-Twiddling} +@ftindex srfi-61 @item SRFI-61 @ref{Guarded COND Clause} @end itemize @@ -11882,7 +12021,6 @@ http://www.sci.toyama-u.ac.jp/~iwao/Scheme/Jfilter/index.html @node About SLIB, Index, Other Packages, Top @chapter About SLIB -@ifnottex @noindent More people than I can name have contributed to SLIB. Thanks to all of you! @@ -11890,10 +12028,13 @@ you! @quotation SLIB @value{SLIBVERSION}, released @value{SLIBDATE}.@* Aubrey Jaffer <agj @@ alum.mit.edu>@* -@i{Hyperactive Software} -- The Maniac Inside!@* -@url{http://swiss.csail.mit.edu/~jaffer/SLIB.html} +@c @i{Hyperactive Software} -- The Maniac Inside!@* @end quotation -@end ifnottex + +Current information about SLIB can be found on SLIB's @dfn{WWW} home +page: + +@center @url{http://swiss.csail.mit.edu/~jaffer/SLIB} @menu * Installation:: How to install SLIB on your system. @@ -12322,6 +12463,11 @@ nothing to undermine it in the future. @node About this manual, , Copyrights, About SLIB @section About this manual +@menu +* Copying This Manual:: +* How to use this License for your documents:: +@end menu + @itemize @bullet @item Entries that are labeled as Functions are called for their return @@ -12339,6 +12485,8 @@ At the beginning of each section, there is a line that looks like using the package. @end itemize +@include fdl.texi + @ifinfo @node Index, , About SLIB, Top @unnumbered Index @@ -570,6 +570,22 @@ (solid:node "Box" (sprintf #f "size %s" (coordinate3string geom))))) +;;@body +;;Returns a box of the specified @1, but with the y-axis of a texture +;;specified in @2 being applied along the longest dimension in @1. +(define (solid:lumber geometry appearance) + (define x (car geometry)) + (define y (cadr geometry)) + (define z (caddr geometry)) + (cond ((and (>= y x) (>= y z)) + (solid:box geometry appearance)) + ((and (>= x y) (>= x z)) + (solid:rotation '(0 0 1) 90 + (solid:box (list y x z) appearance))) + (else + (solid:rotation '(1 0 0) 90 + (solid:box (list x z y) appearance))))) + ;;@args radius height appearance ;;@args radius height ;;Returns a right cylinder with dimensions @code{(abs @1)} and @code{(abs @2)} @@ -693,6 +709,48 @@ ((negative? idx) (apply string-append lst))))))) +;;@args xz-array y appearance +;;@args xz-array y +;;@1 must be an @var{n}-by-2 array holding a sequence of coordinates +;;tracing a non-intersecting clockwise loop in the x-z plane. @0 will +;;close the sequence if the first and last coordinates are not the +;;same. +;; +;;@0 returns a capped prism @2 long. +(define (solid:prism xz-array y . appearance) + (define y/2 (/ y 2)) + (define dims (array-dimensions xz-array)) + ;;(define (sfbool bool) (if bool "TRUE" "FALSE")) + (if (not (eqv? 2 (cadr dims))) (slib:error 'solid:prism 'dimensions dims)) + (sprintf #f + "\ +Shape { + %s + geometry Extrusion { + convex FALSE + endCap TRUE + beginCap TRUE + spine [0 %g 0, 0 %g 0] + crossSection [%s] + } +} +" + (if (null? appearance) "" (car appearance)) + (- y/2) y/2 + (do ((str (if (and (= (array-ref xz-array (+ -1 (car dims)) 0) + (array-ref xz-array 0 0)) + (= (array-ref xz-array (+ -1 (car dims)) 1) + (array-ref xz-array 0 1))) + "" + (sprintf #f "%g, %g\n" + (array-ref xz-array (+ -1 (car dims)) 0) + (array-ref xz-array (+ -1 (car dims)) 1))) + (string-append str (sprintf #f " %g, %g\n" + (array-ref xz-array idx 0) + (array-ref xz-array idx 1)))) + (idx 0 (+ 1 idx))) + ((>= idx (car dims)) str)))) + ;;@args width height depth colorray appearance ;;@args width height depth appearance ;;@args width height depth @@ -287,6 +287,13 @@ returned object. @end defun +@defun solid:lumber geometry appearance + +Returns a box of the specified @var{geometry}, but with the y-axis of a texture +specified in @var{appearance} being applied along the longest dimension in @var{geometry}. +@end defun + + @defun solid:cylinder radius height appearance @@ -368,6 +375,19 @@ The following code will return a red line between points at @end defun +@defun solid:prism xz-array y appearance + + +@defunx solid:prism xz-array y +@var{xz-array} must be an @var{n}-by-2 array holding a sequence of coordinates +tracing a non-intersecting clockwise loop in the x-z plane. @code{solid:prism} will +close the sequence if the first and last coordinates are not the +same. + +@code{solid:prism} returns a capped prism @var{y} long. +@end defun + + @defun solid:basrelief width height depth colorray appearance @@ -8,15 +8,31 @@ ;;; Updated: 19 June 1995 ;;; (sort, sort!, sorted?): Generalized to strings by jaffer: 2003-09-09 ;;; (sort, sort!, sorted?): Generalized to arrays by jaffer: 2003-10-04 +;;; jaffer: 2006-10-08: +;;; (sort, sort!, sorted?, merge, merge!): Added optional KEY argument. (require 'array) +(define (rank-1-array->list array) + (define dimensions (array-dimensions array)) + (do ((idx (+ -1 (car dimensions)) (+ -1 idx)) + (lst '() (cons (array-ref array idx) lst))) + ((< idx 0) lst))) + +(define (sort:make-predicate caller less? opt-key) + (case (length opt-key) + ((0) less?) + ((1) (let ((key (car opt-key))) + (lambda (a b) (less? (key a) (key b))))) + (else (slib:error caller 'too-many-args (cdr opt-key))))) + ;;; (sorted? sequence less?) ;;; is true when sequence is a list (x0 x1 ... xm) or a vector #(x0 ... xm) ;;; such that for all 1 <= i <= m, ;;; (not (less? (list-ref list i) (list-ref list (- i 1)))). ;@ -(define (sorted? seq less?) +(define (sorted? seq less? . opt-key) + (set! less? (sort:make-predicate 'sorted? less? opt-key)) (cond ((null? seq) #t) ((array? seq) (let ((dims (array-dimensions seq))) @@ -39,7 +55,8 @@ ;;; interleaved so that (sorted? (merge a b less?) less?). ;;; Note: this does _not_ accept arrays. See below. ;@ -(define (merge a b less?) +(define (merge a b less? . opt-key) + (set! less? (sort:make-predicate 'merge less? opt-key)) (cond ((null? a) b) ((null? b) a) (else (let loop ((x (car a)) (a (cdr a)) (y (car b)) (b (cdr b))) @@ -54,12 +71,7 @@ (cons x (cons y b)) (cons x (loop (car a) (cdr a) y b)))))))) -;;; (merge! a b less?) -;;; takes two sorted lists a and b and smashes their cdr fields to form a -;;; single sorted list including the elements of both. -;;; Note: this does _not_ accept arrays. -;@ -(define (merge! a b less?) +(define (sort:merge! a b less?) (define (loop r a b) (if (less? (car b) (car a)) (begin @@ -86,13 +98,15 @@ (loop a (cdr a) b)) a))) -;;; (sort! sequence less?) -;;; sorts the list, array, or string sequence destructively. It uses -;;; a version of merge-sort invented, to the best of my knowledge, by -;;; David H. D. Warren, and first used in the DEC-10 Prolog system. -;;; R. A. O'Keefe adapted it to work destructively in Scheme. +;;; (merge! a b less?) +;;; takes two sorted lists a and b and smashes their cdr fields to form a +;;; single sorted list including the elements of both. +;;; Note: this does _not_ accept arrays. ;@ -(define (sort! seq less?) +(define (merge! a b less? . opt-key) + (sort:merge! a b (sort:make-predicate 'merge! less? opt-key))) + +(define (sort:sort! seq less?) (define (step n) (cond ((> n 2) (let* ((j (quotient n 2)) @@ -128,11 +142,23 @@ (else ;; otherwise, assume it is a list (step (length seq))))) -(define (rank-1-array->list array) - (define dimensions (array-dimensions array)) - (do ((idx (+ -1 (car dimensions)) (+ -1 idx)) - (lst '() (cons (array-ref array idx) lst))) - ((< idx 0) lst))) +;;; (sort! sequence less?) +;;; sorts the list, array, or string sequence destructively. It uses +;;; a version of merge-sort invented, to the best of my knowledge, by +;;; David H. D. Warren, and first used in the DEC-10 Prolog system. +;;; R. A. O'Keefe adapted it to work destructively in Scheme. +;;; A. Jaffer modified to always return the original pair. +;@ +(define (sort! seq less? . opt-key) + (define ret (sort:sort! seq (sort:make-predicate 'sort! less? opt-key))) + (if (not (eq? ret seq)) + (do ((crt ret (cdr crt))) + ((eq? (cdr crt) seq) + (set-cdr! crt ret) + (let ((scar (car seq)) (scdr (cdr seq))) + (set-car! seq (car ret)) (set-cdr! seq (cdr ret)) + (set-car! ret scar) (set-cdr! ret scdr))))) + seq) ;;; (sort sequence less?) ;;; sorts a array, string, or list non-destructively. It does this @@ -141,12 +167,9 @@ ;;; allocated" except for sharing structure with "the last argument", ;;; so (append x '()) ought to be a standard way of copying a list x. ;@ -(define (sort seq less?) - (cond ((vector? seq) - (list->vector (sort:sort! (vector->list seq) less?))) - ((string? seq) - (list->string (sort:sort! (string->list seq) less?))) - ((array? seq) +(define (sort seq less? . opt-key) + (set! less? (sort:make-predicate 'sort less? opt-key)) + (cond ((array? seq) (let ((dimensions (array-dimensions seq))) (define newra (apply make-array seq dimensions)) (do ((sorted (sort:sort! (rank-1-array->list seq) less?) @@ -155,6 +178,3 @@ ((null? sorted) newra) (array-set! newra (car sorted) i)))) (else (sort:sort! (append seq '()) less?)))) - -(define sort:merge! merge!) -(define sort:sort! sort!) @@ -259,9 +259,9 @@ (if (null? list) ridentity (let red ((l (cdr list)) (ridentity (car list))) - (if (null? list) + (if (null? l) ridentity - (f ridentity (red (cdr list) (car list))))))) + (f ridentity (red (cdr l) (car l))))))) ;;; We stop when CLIST1 runs out, not when any list runs out. ;;@args f clist1 clist2 ... diff --git a/srfi-23.scm b/srfi-23.scm new file mode 100644 index 0000000..33d4da0 --- /dev/null +++ b/srfi-23.scm @@ -0,0 +1 @@ +(define error slib:error) diff --git a/strcase.scm b/strcase.scm index d099bb6..5925354 100644 --- a/strcase.scm +++ b/strcase.scm @@ -53,8 +53,9 @@ (lambda (str) (string->symbol (s2cis str))))) ;@ (define symbol-append - (let ((s2cis (if (equal? "x" (symbol->string 'x)) - string-downcase string-upcase))) + (let ((s2cis (cond ((equal? "x" (symbol->string 'X)) string-downcase) + ((equal? "X" (symbol->string 'x)) string-upcase) + (else identity)))) (lambda args (string->symbol (apply string-append diff --git a/subarray.scm b/subarray.scm index 152ccbb..9f84583 100644 --- a/subarray.scm +++ b/subarray.scm @@ -52,6 +52,15 @@ ;;#2A((a b) (d e)) ;;> (subarray ra #f '(1 2)) ;;#2A((b c) (e f)) +;;> (subarray ra #f '(2 1)) +;;#2A((c b) (f e)) +;;@end example +;; +;;Arrays can be reflected (reversed) using @0: +;; +;;@example +;;> (subarray '#1A(a b c d e) '(4 0)) +;;#1A(e d c b a) ;;@end example (define (subarray array . selects) (apply make-shared-array array @@ -68,7 +77,10 @@ ((list? (car sels)) (loop (cdr sels) (cdr args) - (cons (+ (car args) (caar sels)) lst))) + (cons (if (< (cadar sels) (caar sels)) + (+ (- (caar sels) (car args))) + (+ (caar sels) (car args))) + lst))) (else (loop (cdr sels) (cdr args) (cons (car args) lst)))))) (let loop ((sels selects) @@ -88,15 +100,12 @@ ((list? (car sels)) (loop (cdr sels) (cdr dims) - (cons (list 0 (- (cadar sels) (caar sels))) ndims))) + (cons (list 0 (abs (- (cadar sels) (caar sels)))) + ndims))) (else (loop (cdr sels) (cdr dims) (cons (car sels) ndims))))))) ;;@body -;;Legacy alias for @r{subarray}. -(define subarray0 subarray) - -;;@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 diff --git a/subarray.txi b/subarray.txi index 1a0545f..17e5a48 100644 --- a/subarray.txi +++ b/subarray.txi @@ -33,14 +33,18 @@ shared. #2A((a b) (d e)) > (subarray ra #f '(1 2)) #2A((b c) (e f)) +> (subarray ra #f '(2 1)) +#2A((c b) (f e)) @end example -@end defun +Arrays can be reflected (reversed) using @code{subarray}: -@defvar subarray0 +@example +> (subarray '#1A(a b c d e) '(4 0)) +#1A(e d c b a) +@end example +@end defun -Legacy alias for @r{subarray}. -@end defvar @defun array-trim array trim @dots{} @@ -120,9 +120,9 @@ (exchange old) val)))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -358,12 +358,14 @@ (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 #\space 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 slib:error + (let ((error error)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (apply error args)))) ;;; define these as appropriate for your system. (define slib:tab #\tab) diff --git a/top-refs.scm b/top-refs.scm index 0c88ba5..1d7438a 100644 --- a/top-refs.scm +++ b/top-refs.scm @@ -41,7 +41,7 @@ (define (top-refs:warn proc msg . more) (for-each display (list "WARN:" proc ": " msg " ")) - (for-each (lambda (x) (write x) (display #\ )) + (for-each (lambda (x) (write x) (display #\space)) more) (newline)) ;;@body @@ -71,12 +71,12 @@ (cdar debug:call-stack)) (cdr debug:call-stack)) (cons (list 1 name) debug:call-stack))) - (do ((i trace:indent (+ -1 i))) ((zero? i)) (display #\ )) + (do ((i trace:indent (+ -1 i))) ((zero? i)) (display #\space)) (apply qpn CALL name args) (set! trace:indent (modulo (+ 1 trace:indent) 16)) (let ((ans (apply function args))) (set! trace:indent (modulo (+ -1 trace:indent) 16)) - (do ((i trace:indent (+ -1 i))) ((zero? i)) (display #\ )) + (do ((i trace:indent (+ -1 i))) ((zero? i)) (display #\space)) (qpn RETN name ans) (set! debug:call-stack cs) ans))) @@ -92,6 +92,6 @@ (cond ((>= pos (bytes-length abbrevs)) (slib:warn 'tzfile:read "format error" abbrevs) #f) ((zero? (byte-ref abbrevs pos)) - (substring abbrevs (vector-ref rec 0) pos)) + (subbytes abbrevs (vector-ref rec 0) pos)) (else (loop (+ 1 pos)))))))) (list path mode-table leap-seconds transition-times transition-types))))) diff --git a/umbscheme.init b/umbscheme.init index f531605..3d2e3a9 100644 --- a/umbscheme.init +++ b/umbscheme.init @@ -122,9 +122,9 @@ (exchange old) val)))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -314,12 +314,14 @@ (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 #\space 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 slib:error + (let ((error error)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (apply error args)))) ;;; define these as appropriate for your system. (define slib:tab (integer->char 9)) diff --git a/version.txi b/version.txi index 1c1c2d8..c605f5a 100644 --- a/version.txi +++ b/version.txi @@ -1,2 +1,2 @@ -@set SLIBVERSION 3a3 -@set SLIBDATE February 2006 +@set SLIBVERSION 3a4 +@set SLIBDATE October 2006 @@ -104,13 +104,13 @@ (else (output-port-width)))) (define spacer (case (length margins) ((3) (caddr margins)) - (else #\ ))) + (else #\space))) (cond ((>= left-margin right-margin) (slib:error 'code-walk-justify " left margin must be smaller than right: " margins))) (let ((cur left-margin) - (lms (make-string left-margin #\ ))) + (lms (make-string left-margin #\space))) (display lms) (for-each (lambda (obj) @@ -124,7 +124,7 @@ (set! cur (+ objl left-margin)) (display lms) (display obj)) (else - (display #\ ) + (display #\space) (display obj) (set! cur (+ 1 objl cur)))))) lst))) @@ -1,4 +1,4 @@ -;;; "vscm.init" Configuration of *features* for VSCM -*-scheme-*- +;;; "vscm.init" Configuration of slib:features for VSCM -*-scheme-*- ;;; Author: Aubrey Jaffer ;;; ;;; This code is in the public domain. @@ -154,9 +154,9 @@ (exchange old) val)))) -;;@ *FEATURES* is a list of symbols naming the (SLIB) features +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features ;;; initially supported by this implementation. -(define *features* +(define slib:features '( source ;can load scheme source files ;(SLIB:LOAD-SOURCE "filename") @@ -429,12 +429,14 @@ (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 #\space cep) (write x cep)) args)))) ;;; define an error procedure for the library -(define (slib:error . argl) - (if (provided? 'trace) (print-call-stack (current-error-port))) - (error argl)) +(define slib:error + (let ((error error)) + (lambda args + (if (provided? 'trace) (print-call-stack (current-error-port))) + (error args)))) ;;; define these as appropriate for your system. (define slib:tab #\Tab) |