From 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:38 -0800 Subject: Import Upstream version 3a5 --- ANNOUNCE | 165 +-- ChangeLog | 318 +++++ DrScheme.init | 3 +- FAQ | 38 +- Makefile | 158 ++- README | 7 +- RScheme.init | 3 + STk.init | 3 + Template.scm | 3 + array.scm | 106 +- array.txi | 140 +- arraymap.scm | 44 +- arraymap.txi | 16 + batch.scm | 3 +- bigloo.init | 27 + bytenumb.scm | 47 +- bytenumb.txi | 7 +- clrnamdb.scm | 2 +- collect.scm | 31 +- collectx.scm | 39 +- colorspc.scm | 6 +- comparse.scm | 4 +- comparse.txi | 4 +- cring.scm | 266 ++-- dbinterp.scm | 8 +- dbutil.scm | 3 +- dbutil.txi | 3 +- determ.scm | 48 +- determ.txi | 18 + differ.scm | 44 +- elk.init | 5 +- gambit.init | 32 + grapheps.ps | 17 +- guile.init | 164 ++- hash.scm | 37 +- jscheme.init | 56 +- kawa.init | 391 ++++++ logical.scm | 8 +- macscheme.init | 3 + manifest.scm | 8 +- mitscheme.init | 10 +- mkclrnam.scm | 15 +- mklibcat.scm | 6 + modular.scm | 44 +- mularg.scm | 4 +- mwdenote.scm | 8 + mwexpand.scm | 3 + ncbi-dna.scm | 3 + ncbi-dna.txi | 3 + pscheme.init | 5 +- qp.scm | 4 +- require.scm | 79 +- root.scm | 28 - scheme2c.init | 7 +- scheme48.init | 17 +- schmooz.scm | 16 +- scsh.init | 6 + sisc.init | 348 +++++ slib.1 | 2 +- slib.doc | 17 +- slib.info | 3857 ++++++++++++++++++++++++++++++++++---------------------- slib.nsi | 771 +++++++++++ slib.sh | 21 +- slib.spec | 4 +- slib.texi | 405 +++--- solid.scm | 6 +- solid.txi | 6 +- sort.scm | 236 ++-- srfi-1.scm | 17 +- srfi-1.txi | 5 +- srfi-11.scm | 38 + t3.init | 3 + trnscrpt.scm | 40 +- umbscheme.init | 7 +- version.txi | 4 +- vscm.init | 13 +- withfile.scm | 34 +- wttree.scm | 68 +- xml-parse.scm | 2025 +++++++++++++++++++++++++++++ xml-parse.txi | 1010 +++++++++++++++ 80 files changed, 8703 insertions(+), 2777 deletions(-) create mode 100644 kawa.init create mode 100644 sisc.init create mode 100644 slib.nsi create mode 100644 srfi-11.scm create mode 100644 xml-parse.scm create mode 100644 xml-parse.txi diff --git a/ANNOUNCE b/ANNOUNCE index d672c9a..16b583d 100644 --- a/ANNOUNCE +++ b/ANNOUNCE @@ -1,12 +1,12 @@ -This message announces the availability of Scheme Library release slib3a4. +This message announces the availability of Scheme Library release slib3a5. SLIB is a portable Scheme library providing compatibiliy and utility functions for all standard Scheme 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. +Scheme, RScheme, scheme->C, Scheme48, SCM, SCM Mac, scsh, SISC, Stk, +T3.1, umb-scheme, and VSCM. SLIB is free software. It has a Permissive-Non-Warranty license (http://swiss.csail.mit.edu/~jaffer/SLIB_COPYING.txt). @@ -20,148 +20,81 @@ Links to distributions of SLIB and related softwares are at the end of this message. -=-=- -slib3a4 news: +slib3a5 news: -+ Discreet Fourier Transforms of any rank. + * Jerry van Dijk wrote NSIS scripts to created MS-Windows installers. -+ Added SRFI-94 and SRFI-23 + * Robert Babbit updated "guile.init" for Guile 1.8. -From Ivan Shmakov + * Taylor R. Campbell updated "mitscheme.init" for versions after 7.7.1. - * scheme48.init (file-exists?): Much simplified. + * Ivan Shmakov rewrote scheme48(.init) delete-file using Posix unlink. -From Kevin Ryde + * Stéphane Rollandin fixed problem with macros-that-work. - * guile.init: Fixed line-i/o in Guile >= 1.8. +* Draft SRFI-96 "SRFI Prerequisites" + (http://srfi.schemers.org/srfi-96/srfi-96.html) specifies the + interface between implementations and the SLIB library system. - * srfi-1.scm (reduce-right): Was infinite loop. +* Added support for Kawa and SISC. -From Ben Goetter +* SSAX (xml-parse) module ported from SSAX 5.1 (http://ssax.sourceforge.net/). - * pscheme.init: Revised for Pscheme 1.3. +* Sort package compatibly upgraded to SRFI-95. -From Aubrey Jaffer +* Added features SRFI-11 (let-values) and SRFI-28 (format). - * 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". +* file-position is procedure to set and retrieve file position. - * 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. +* Fixed Guile array? in "guile.init". - * tzfile.scm (tzfile:read): Use subbytes instead of subarray. - * byte.scm (subbytes): Added. - (subbytes-read!, subbytes-write): Renamed from substring-... +* jscheme.init (scheme-implementation-version): 7.2. + (gcd, lcm, round, atan, expt): Fixed some R5RS non-conformances. - * slib.texi (Irrational Real Functions) - (Irrational Integer Functions): Sections added. - * math-integer.scm, math-real.scm: Added SRFI-94. +* elk.init (delete-file): Quoted filename to system. +* scheme2c.init (delete-file, file-exists?): Quoted filename to system. +* scheme48.init (delete-file): Quoted filename to system. +* umbscheme.init (file-exists?, delete-file): Quoted filename to system. +* vscm.init (file-exists?): Quoted filename to system. - * slib.texi (Feature): Indexed number-system attribute features. - * require.scm: Tightened number-system attribute features. +* slib.sh (Kawa): Now supported. - * 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. +* require.scm: Check up to SRFI-150. - * srfi-23.scm (error): Added. +* Makefile (srcdir.mk): Removed. +(install*): Added $(DESTDIR) prefix. +* Makefile: Changed to use "mkdir -p" (per Marijn Schouten). - * simetrix.scm (SI:unit-infos): Updated u and eV to CODATA-2002. +* integer-sqrt moved from "root.scm" to "math-integer.scm". - * peanosfc.scm (peano-coordinates->integer) - (integer->peano-coordinates): Fixed; were broken for rank != 2. +* arraymap.scm (array-index-for-each): Added. - * subarray.scm (subarray): Handle reverse index ranges. +* schmooz.scm (schmooz): Put generated .txi files in current directory. +(pathname->local-filename): Added complement to pathname->vicinity. - * pnm.scm (pnm:array-write): Don't lose comments when recursing. +* determ.scm (matrix:sum, matrix:difference): Added. +(matrix:product): Extended to multiplication by scalar. - * slib.spec (%files): Added man1/slib.1.gz. +* logical.scm (logcount): Simplified in terms of bitwise-bit-count. +(bitwise-bit-count): Added; returns negative integer for negative input. - * grapheps.ps (sign): Cleaner than inline code. - (setup-plot): Now handles decreasing axes. - * grapheps.scm (plot): Handle list of lists data. +* slib.texi: Eliminated cover texts from GFDL. - * root.scm (integer-sqrt): Streamlined. - (secant:find-root-1): Fixed internal argument mismatch - for number-of-iterations case. +* collect.scm (reduce): Support both comlist (2-argument) variant +and the collect (> 2-argument) variant. +* srfi-1.scm (reduce): Support both comlist (2-argument) variant +and the SRFI-1 (3-argument) variant. - * 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. +* bytenumb.scm (ieee-float->bytes, ieee-double->bytes): Test for 0 +and 0/0 only once; changed abs to magnitude to work with 0/0. -=-=- SLIB is available from: - 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 + http://swiss.csail.mit.edu/ftpdir/scm/slib3a5.zip + http://swiss.csail.mit.edu/ftpdir/scm/slib-3a5-1.noarch.rpm + swiss.csail.mit.edu:/pub/scm/slib3a5.zip + swiss.csail.mit.edu:/pub/scm/slib-3a5-1.noarch.rpm SLIB-PSD is a portable debugger for Scheme (requires emacs editor): http://swiss.csail.mit.edu/ftpdir/scm/slib-psd1-3.tar.gz diff --git a/ChangeLog b/ChangeLog index 15aaad9..2e36b02 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,321 @@ +2007-11-28 Aubrey Jaffer + + * slib.sh (Usage): Updated implementation list. + + * slib.texi (The SLIB script): Updated implementation list. + +2007-11-27 Aubrey Jaffer + + (slib:load): Broken for Guile-1.6.7; conditioned 1.8 code. + +2007-11-27 Rob Browning + + * guile.init (implementation-vicinity): Just (%site-dir). + (file-position, gentemp): module-replace! + (library-vicinity): Try (%search-load-path "slib/guile.init"). + +2007-11-23 Aubrey Jaffer + + * require.scm (*slib-version*): Bumped from 3a4 to 3a5. + + * Makefile (new): Update jacal.texi. + +2007-11-22 Aubrey Jaffer + + * mkclrnam.scm (load-rgb-txt): Added parser for + Color-Naming-Experiment. + +2007-11-03 Aubrey Jaffer + + * slib.texi (Input/Output): Added file-position. + + * elk.init, jscheme.init, kawa.init, macscheme.init, + mitscheme.init, RScheme.init, bigloo.init, guile.init, + pscheme.init, scheme2c.init, scheme48.init, scsh.init, sisc.init, + STk.init, Template.scm, gambit.init, t3.init, umbscheme.init, + vscm.init (file-position): Added procedure to set and retrieve + file position. + +2007-10-20 Aubrey Jaffer + + * DrScheme.init (slib:require): Removed superfluous definition. + +2007-10-13 Aubrey Jaffer + + * slib.texi (System): Cleaned up browse-url entry. + + * require.scm: Check up to srfi-150. + +2007-09-23 Aubrey Jaffer + + * guile.init (array?): Put in fix for (array? 'foo) returning #t. + +2007-09-23 Robert Babbit + + * guile.init (system, delete-file, open-file, make-array): Changed + from SET! to DEFINE and added Guile 1.8 module magic. + +2007-09-04 Aubrey Jaffer + + * sisc.init: SISC has defmacro, but not macroexpand. + +2007-09-03 Aubrey Jaffer + + * Makefile (srcdir.mk): Removed. + (install*): Added $(DESTDIR) prefix. + (ifiles): Added sisc.init. + + * ANNOUNCE, README, slib.sh, slib.texi: Added SISC. + + * sisc.init: Added. + (slib:features): Added string-port. + +2007-08-29 Aubrey Jaffer + + * dbinterp.scm (dbinterp:memoize): LAST-PAIR replaces LIST-TAIL. + (interpolate-from-table): Removed memoizing from get, isam-prev. + + * mklibcat.scm, slib.texi, FAQ (SRFI): Added srfi-28. + +2007-08-26 Aubrey Jaffer + + * FAQ (SRFI): Added section. + + * slib.texi (SRFI): Added srfi-94 and srfi-95. + + * Makefile (release): Update $(htmldir)SLIB.FAQ. + +2007-08-24 Aubrey Jaffer + + * slib.texi (SRFI): Added 94 and 95. + +2007-08-16 Aubrey Jaffer + + * array.scm (A:floR*b): Argument letter z --> x. + (A:flo*d): Corrected typo (was A:flo*b); argument letter z --> q. + (A:*): Coded TeXinfo explicitly to preserve procedure name case. + +2007-07-24 Aubrey Jaffer + + * schmooz.scm (pathname->local-filename): Renamed from + pathname->filename; put returned filename in user-vicinity. + +2007-07-22 Aubrey Jaffer + + * schmooz.scm (pathname->filename): Added; complement to + pathname->vicinity. + (schmooz): Put generated .txi files in current directory. + + * Makefile (slib.fn): Removed. + +2007-06-24 Aubrey Jaffer + + * determ.scm (matrix:sum, matrix:difference): Added. + (matrix:product): Extended to multiplication by scalar. + +2007-06-18 Aubrey Jaffer + + * Makefile (ifiles): Added kawa.init. + + * kawa.init: Added. getenv not available; so library-vicinity is + hard-wired. + + * slib.texi (Bit-Twiddling): Added r6rs bitwise-bit-count. + (Feature): Added kawa. + + * logical.scm (bitwise-bit-count): Added; returns negative integer + for negative input. + (logcount): Simplified in terms of bitwise-bit-count. + +2007-06-08 Aubrey Jaffer + + * Makefile: Changed to use "mkdir -p" (per Marijn Schouten). + +2007-05-31 Aubrey Jaffer + + * arraymap.scm (array-index-for-each): Added. + (array-index-map!): Implemented in terms of array-index-for-each. + +2007-05-01 Aubrey Jaffer + + * xml-parse.scm: Finished converting documentation to schmooz. + + * mklibcat.scm (ssax): Added alias for xml-parse. + +2007-04-30 Aubrey Jaffer + + * xml-parse.scm (ssax:init-buffer): Made reentrant. + (ssax:make-parser): Added argument length check. + +2007-04-29 Aubrey Jaffer + + * slib.texi (Parsing XML): Added. + + * Makefile (txiscms): Added xml-parse. + + * xml-parse.scm: Added (demacroized from public-domain SSAX 5.1). + +2007-04-28 Aubrey Jaffer + + * Makefile (slib.html): Make in unix for w32install because MinGW + chokes on @syncodeindex. + +2007-04-26 Aubrey Jaffer + + * mklibcat.scm (let-values): Added as alias for srfi-11. + + * hash.scm: Reordered definitions to suit Kawa. + +2007-04-25 Aubrey Jaffer + + * slib.texi (Binding to multiple values): srfi-11 added. + + * srfi-11.scm: Added (http://srfi.schemers.org/srfi-11/srfi-11.html). + +2007-04-19 Aubrey Jaffer + + * comparse.scm, dbutil.scm, slib.texi, solid.scm: Don't break @ref + fields over lines. + + * batch.scm (batch:initialize!): Keep atari.st for legacy code. + +2007-04-13 Aubrey Jaffer + + * slib.sh (Kawa): Now supported. + + * withfile.scm, trnscrpt.scm: Changed shadow bindings to not + duplicate top-level names. + + * require.scm (slib:require, slib:require-if, slib:provide, + slib:provided?): Reordered defines so Kawa loads successfully. + +2007-04-07 Aubrey Jaffer + + * differ.scm (diff:edits): Finding edits needs a larger fp array + than finding edit-length. + +2007-03-28 Aubrey Jaffer + + * batch.scm (batch:initialize!): atari.st --> atari-st. + + * manifest.scm (feature->export-alist): path.scm --> path_scm. + + * cring.scm, wttree.scm: Replaced . with _ in identifier names for + R4RS compatibility. + + * collect.scm (reduce): Support both comlist (2-argument) variant + and the collect (> 2-argument) variant. + + * srfi-1.scm (reduce): Support both comlist (2-argument) variant + and the SRFI-1 (3-argument) variant. + +2007-03-26 Aubrey Jaffer + + * slib.texi (Sorting): Added srfi-95. + + * require.scm (slib:report, slib:report-locations): Changed shadow + bindings to not duplicate top-level names. Code cleanup. + + * root.scm (integer-sqrt): Removed (now in "math-integer.scm"). + + * mularg.scm (/, -): Removed gratuitous shadow binding. + + * mklibcat.scm (srfi-95): Added alias for sort. + +2007-03-05 Jerry van Dijk + + * Makefile (w32install): Added target. + + * slib.nsi: NSIS Windows installer script. + +2007-03-05 Aubrey Jaffer + + * jscheme.init (force-output): Fixed typo. + (scheme-implementation-version): 7.2. + (gcd, lcm, round, atan, expt): Fixed some R5RS non-conformances. + +2007-02-09 Taylor R. Campbell + + * mitscheme.init: TRANSFORMER-ITEM/EXPANDER is changed to + STRIP-KEYWORD-VALUE-ITEM. + +2007-01-28 Aubrey Jaffer + + * guile.init (gentemp): Added because Guile deprecates it and puts + space in symbol name. + +2007-01-03 Aubrey Jaffer + + * bytenumb.scm (ieee-float->bytes, ieee-double->bytes): Test for 0 + and 0/0 only once. + +2006-12-20 Aubrey Jaffer + + * bytenumb.scm (ieee-float->bytes, ieee-double->bytes): Changed + abs to magnitude to work with 0/0. + +2006-12-06 Aubrey Jaffer + + * qp.scm (qpn, qpr): Don't protect (capture) qp. + +2006-11-23 Aubrey Jaffer + + * slib.texi (Sorting): Removed outdated survey of implementations. + + * sort.scm (sort:sort-list!): Don't do key-wrap! unless given key + argument. + +2006-11-22 Ivan Shmakov + + * scheme48.init (delete-file): Rewrote using Posix unlink. + +2006-11-17 Aubrey Jaffer + + * elk.init (delete-file): Quoted filename to system. + + * scheme2c.init (delete-file, file-exists?): Quoted filename to + system. + + * scheme48.init (delete-file): Quoted filename to system. + + * umbscheme.init (file-exists?, delete-file): Quoted filename to + system. + + * vscm.init (file-exists?): Quoted filename to system. + + * batch.scm (batch:call-with-output-script): Quoted filename + argument to chmod. + +2006-11-10 Stéphane Rollandin + + * mwdenote.scm (mw:denote-of-define-macro, mw:denote-of-defmacro): + Added. + + * mwexpand.scm (mw:expand): Don't expand DEFINE-MACRO args specs. + +2006-11-06 Aubrey Jaffer + + * slib.texi (Sorting): Made asymptotic constraints more detailed. + + * slib.texi (Sorting): Updated for limited KEY arg calling. + +2006-11-05 Aubrey Jaffer + + * sort.scm (sorted?, merge, merge!, sort, sort!): Call KEY arg at + most once per element. + +2006-11-04 Aubrey Jaffer + + * modular.scm (modular:*): Normalize inputs. + +2006-11-01 Aubrey Jaffer + + * slib.texi: Eliminated cover texts from GFDL. + +2006-10-29 Aubrey Jaffer + + * grapheps.ps (fudge3): Abstracted divisible-by-3 mess. + 2006-10-21 Aubrey Jaffer * require.scm (*slib-version*): Bumped from 3a3 to 3a4. diff --git a/DrScheme.init b/DrScheme.init index c18ea18..d921cec 100644 --- a/DrScheme.init +++ b/DrScheme.init @@ -399,7 +399,6 @@ (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) [_ @@ -416,5 +415,5 @@ (cond ((stringC, -Scheme48, SCM, SCM Mac, scsh, Stk, T3.1, umb-scheme, and VSCM. +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. [] How can I obtain SLIB? @@ -46,7 +47,7 @@ Several times a year. [] What is the latest version? -The version as of this writing is slib3a4. The latest documentation +The version as of this writing is slib3a5. The latest documentation is available online at: http://swiss.csail.mit.edu/~jaffer/SLIB.html @@ -206,3 +207,30 @@ As explained in the Repl entry in slib.info (or slib.texi): (require 'macro) (require 'repl) (repl:top-level macro:eval) + + SRFI + +[] What is SRFI? + +"Scheme Requests for Implementation" is a process and informal +standard for defining extensions to Scheme. + +[] Which SRFIs does SLIB support? + +These can be REQUIREd by the listed (srfi) feature name: + +srfi-0: Feature-based conditional expansion construct +srfi-1: List Library +srfi-2: AND-LET*: an AND with local bindings, a guarded LET* special form +srfi-8: receive: Binding to multiple values +srfi-9: Defining Record Types +srfi-11: Syntax for receiving multiple values +srfi-23: Error reporting mechanism +srfi-28: Basic Format Strings +srfi-47: Array +srfi-59: Vicinity +srfi-60: Integers as Bits +srfi-61: A more general cond clause +srfi-63: Homogeneous and Heterogeneous Arrays +srfi-94: Type-Restricted Numerical Functions +srfi-95: Sorting and Merging diff --git a/Makefile b/Makefile index 5a43f84..3b2c6c5 100644 --- a/Makefile +++ b/Makefile @@ -11,12 +11,7 @@ intro: @echo -make slib.info -srcdir.mk: .. Makefile - echo "srcdir = `pwd`/" > srcdir.mk -#srcdir=$(HOME)/slib/ -include srcdir.mk - -VERSION = 3a4 +VERSION = 3a5 RELEASE = 1 rpm_prefix=$(HOME)/rpmbuild/ @@ -106,8 +101,8 @@ install48: $(IMAGE48) $(S48SLIB)strport.scm $(S48SLIB)record.scm $(INSTALL_DATA) $(IMAGE48) $(S48LIB) (echo '#! /bin/sh';\ echo exec $(RUNNABLE) -i '$(S48LIB)$(IMAGE48)' \"\$$\@\") \ - > $(bindir)slib48 - chmod +x $(bindir)slib48 + > $(DESTDIR)$(bindir)slib48 + chmod +x $(DESTDIR)$(bindir)slib48 ffiles = format.scm printf.scm genwrite.scm pp.scm \ ppfile.scm strcase.scm debug.scm trace.scm \ @@ -125,7 +120,7 @@ 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-23.scm srfi-61.scm +srfiles = srfi-2.scm srfi-8.scm srfi-9.scm srfi-11.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 \ @@ -137,7 +132,7 @@ gfiles = colorspc.scm cie1931.xyz cie1964.xyz resenecolours.txt saturate.txt \ txiscms =grapheps.scm glob.scm getparam.scm \ vet.scm top-refs.scm hashtab.scm chap.scm comparse.scm\ alist.scm ratize.scm modular.scm dirs.scm priorque.scm queue.scm\ - srfi.scm srfi-1.scm\ + srfi.scm srfi-1.scm xml-parse.scm\ pnm.scm http-cgi.scm htmlform.scm html4each.scm db2html.scm uri.scm\ dft.scm solid.scm random.scm randinex.scm obj2str.scm ncbi-dna.scm\ minimize.scm factor.scm determ.scm daylight.scm colornam.scm\ @@ -148,7 +143,7 @@ txiscms =grapheps.scm glob.scm getparam.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\ + srfi.txi srfi-1.txi xml-parse.txi\ pnm.txi http-cgi.txi htmlform.txi html4each.txi db2html.txi uri.txi\ dft.txi solid.txi random.txi randinex.txi obj2str.txi ncbi-dna.txi\ minimize.txi factor.txi determ.txi daylight.txi colornam.txi\ @@ -156,17 +151,17 @@ txifiles =grapheps.txi glob.txi getparam.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 math-integer.txi -% = `echo $(txiscms) | sed 's%.scm%.txi%g'` +#txifiles = `echo $(txiscms) | sed 's%.scm%.txi%g'` 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 \ - Bev2slib.scm slib.spec slib.sh grapheps.ps + Bev2slib.scm slib.spec slib.sh grapheps.ps slib.nsi 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 \ + scheme2c.init scheme48.init gambit.init t3.init vscm.init \ + scm.init scsh.init sisc.init pscheme.init STk.init kawa.init \ RScheme.init DrScheme.init umbscheme.init guile.init jscheme.init tfiles = macrotst.scm dwindtst.scm formatst.scm sfiles = $(ffiles) $(lfiles) $(revfiles) $(afiles) $(scfiles) $(efiles) \ @@ -175,31 +170,39 @@ allfiles = $(docfiles) $(mkfiles) $(ifiles) $(sfiles) $(tfiles) $(bfiles) \ slib.doc clrnamdb.scm pinstall: slib.1 - test -d $(mandir) || mkdir $(mandir) - test -d $(man1dir) || mkdir $(man1dir) - -cp slib.1 $(man1dir) + test -d $(DESTDIR)$(mandir) || mkdir $(DESTDIR)$(mandir) + test -d $(DESTDIR)$(man1dir) || mkdir $(DESTDIR)$(man1dir) + -cp slib.1 $(DESTDIR)$(man1dir) install: pinstall clrnamdb.scm - test -d $(libdir) || mkdir $(libdir) - test -d $(libslibdir) || mkdir $(libslibdir) - -cp $(ifiles) $(sfiles) $(bfiles) $(mkfiles) clrnamdb.scm $(libslibdir) - test -d $(bindir) || mkdir $(bindir) - echo '#! /bin/sh' > $(bindir)slib - echo SCHEME_LIBRARY_PATH=$(libslibdir) >> $(bindir)slib - echo export SCHEME_LIBRARY_PATH >> $(bindir)slib - echo VERSION=$(VERSION) >> $(bindir)slib - echo "S48_VICINITY=\"$(S48LIB)\";export S48_VICINITY" >> $(bindir)slib - cat slib.sh >> $(bindir)slib - chmod +x $(bindir)slib + test -d $(DESTDIR)$(libdir) || mkdir $(DESTDIR)$(libdir) + test -d $(DESTDIR)$(libslibdir) || mkdir $(DESTDIR)$(libslibdir) + -cp $(ifiles) $(sfiles) $(bfiles) $(mkfiles) clrnamdb.scm $(DESTDIR)$(libslibdir) + test -d $(DESTDIR)$(bindir) || mkdir $(DESTDIR)$(bindir) + echo '#! /bin/sh' > $(DESTDIR)$(bindir)slib + echo SCHEME_LIBRARY_PATH=$(DESTDIR)$(libslibdir) >> $(DESTDIR)$(bindir)slib + echo S48_VICINITY=$(S48LIB) >> $(DESTDIR)$(bindir)slib + echo VERSION=$(VERSION) >> $(DESTDIR)$(bindir)slib + echo export SCHEME_LIBRARY_PATH S48_VICINITY >> $(DESTDIR)$(bindir)slib + cat slib.sh >> $(DESTDIR)$(bindir)slib + chmod +x $(DESTDIR)$(bindir)slib uninstall: - -(cd $(libslibdir); rm $(ifiles) $(sfiles) $(bfiles) $(mkfiles) clrnamdb.scm) - -rm $(bindir)slib - -rm $(man1dir)slib.1 + -(cd $(DESTDIR)$(libslibdir); rm $(ifiles) $(sfiles) $(bfiles) $(mkfiles) clrnamdb.scm) + -rm $(DESTDIR)$(bindir)slib + -rm $(DESTDIR)$(man1dir)slib.1 slib.doc: slib.1 nroff -man $< | ul -tunknown >$@ +slib.html: slib.texi + makeinfo --html --no-split --no-warn --force slib.texi + +## to build a windows installer +## make sure makeinfo and NSIS are available on the commandline +w32install: slib.html + makensis slib.nsi + #### Stuff for maintaining SLIB below #### ver = $(VERSION) @@ -224,17 +227,14 @@ $(txifiles): $(txiscms) schmooz.scm 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 + texi2dvi -b -c slib.texi xdvi: slib.dvi xdvi -s 4 slib.dvi pdf: $(htmldir)slib.pdf $(htmldir)slib.pdf: version.txi slib.texi $(txifiles) $(texifiles) # dvipdf slib.dvi # doesn't have links! - texi2pdf -b -c $(srcdir)slib.texi + texi2pdf -b -c slib.texi mv slib.pdf $(htmldir) xpdf: $(htmldir)slib.pdf xpdf $(htmldir)slib.pdf @@ -257,17 +257,18 @@ slib.info: slib$(VERSION).info then infobar $(PREVDOCS)slib.info slib$(VERSION).info slib.info;\ else cp slib$(VERSION).info slib.info;fi info: installinfo -installinfo: $(infodir)slib.info -$(infodir)slib.info: slib.info - cp -p slib.info $(infodir)slib.info - -install-info $(infodir)slib.info $(infodir)dir - -rm $(infodir)slib.info.gz +installinfo: $(DESTDIR)$(infodir)slib.info +$(DESTDIR)$(infodir)slib.info: slib.info + mkdir -p $(DESTDIR)$(infodir) + cp -p slib.info $(DESTDIR)$(infodir)slib.info + -install-info $(DESTDIR)$(infodir)slib.info $(DESTDIR)$(infodir)dir + -rm $(DESTDIR)$(infodir)slib.info.gz infoz: installinfoz -installinfoz: $(infodir)slib.info.gz -$(infodir)slib.info.gz: $(infodir)slib.info - gzip -f $(infodir)slib.info +installinfoz: $(DESTDIR)$(infodir)slib.info.gz +$(DESTDIR)$(infodir)slib.info.gz: $(DESTDIR)$(infodir)slib.info + gzip -f $(DESTDIR)$(infodir)slib.info -docs: $(infodir)slib.info.gz $(htmldir)slib_toc.html slib.dvi \ +docs: $(DESTDIR)$(infodir)slib.info.gz $(htmldir)slib_toc.html slib.dvi \ $(htmldir)slib.pdf slib.doc xdvi -s 4 slib.dvi @@ -276,23 +277,21 @@ CHPAT=$(HOME)/bin/chpat RSYNC=rsync --rsync-path=bin/rsync -bav UPLOADEE=swissnet_upload dest = $(HOME)/dist/ -DOSCM = /misc/usb1/scm/ +DOSCM = /c/Voluntocracy/dist/ temp/slib: $(allfiles) -rm -rf temp - mkdir temp - mkdir temp/slib + mkdir -p temp/slib ln $(allfiles) temp/slib infotemp/slib: slib.info -rm -rf infotemp - mkdir infotemp - mkdir infotemp/slib + mkdir -p infotemp/slib ln slib.info slib.info-* infotemp/slib #For change-barred HTML. prevdocs: $(PREVDOCS)slib_toc.html $(PREVDOCS)slib.info $(PREVDOCS)slib_toc.html: -$(PREVDOCS)slib.info: srcdir.mk Makefile +$(PREVDOCS)slib.info: Makefile cd $(PREVDOCS); unzip -ao $(dest)slib*.zip rm $(PREVDOCS)slib/slib.info cd $(PREVDOCS)slib; make slib.info; make slib_toc.html @@ -307,27 +306,15 @@ $(dest)slib.info.zip: infotemp/slib release: dist pdf tar.gz # rpm cvs tag -F slib$(VERSION) cp ANNOUNCE $(htmldir)SLIB_ANNOUNCE.txt - cp COPYING $(htmldir)SLIB_COPYING.txt + cp COPYING $(htmldir)SLIB_COPYING.txt + cp FAQ $(htmldir)SLIB.FAQ $(RSYNC) $(htmldir)SLIB.html $(htmldir)SLIB_ANNOUNCE.txt \ $(htmldir)SLIB_COPYING.txt $(UPLOADEE):public_html/ $(RSYNC) $(dest)README $(dest)slib$(VERSION).zip \ - $(dest)slib$(VERSION).tar.gz $(htmldir)slib.pdf \ + $(dest)slib$(VERSION).tar.gz \ $(dest)slib-$(VERSION)-$(RELEASE).noarch.rpm \ $(dest)slib-$(VERSION)-$(RELEASE).src.rpm $(UPLOADEE):dist/ # upload $(dest)README $(dest)slib$(VERSION).zip ftp.gnu.org:gnu/jacal/ -# $(MAKE) indiana -indiana: - upload $(dest)slib$(VERSION).zip ftp@ftp.cs.indiana.edu:/pub/scheme-repository/incoming - echo -e \ - 'I have uploaded slib$(VERSION).zip to ftp.cs.indiana.edu:/pub/scheme-repository/incoming\n' \ - 'for placement into ftp.cs.indiana.edu:/pub/scheme-repository/code/lib/' \ - | mail -s 'SLIB upload' -b jaffer scheme-repository-request@cs.indiana.edu - -postnews: - echo -e "Newsgroups: comp.lang.scheme\n" | cat - ANNOUNCE | \ - inews -h -O -S \ - -f "announce@voluntocracy.org (Aubrey Jaffer & Radey Shouman)" \ - -t "SLIB$(VERSION) Released" -d world upzip: $(HOME)/pub/slib.zip $(RSYNC) $(HOME)/pub/slib.zip $(UPLOADEE):pub/ @@ -358,10 +345,11 @@ slib.com: temp/slib zip: slib.zip slib.zip: temp/slib $(makedev) DEST=../ PROD=slib zip -doszip: $(DOSCM)dist/slib$(VERSION).zip -$(DOSCM)dist/slib$(VERSION).zip: temp/slib - $(makedev) DEST=$(DOSCM)dist/ PROD=slib ver=$(VERSION) zip - zip -d $(DOSCM)dist/slib$(VERSION).zip slib/slib.info +doszip: $(DOSCM)slib$(VERSION).zip +$(DOSCM)slib$(VERSION).zip: temp/slib slib.html + $(makedev) DEST=$(DOSCM) PROD=slib ver=$(VERSION) zip + -cd ..; zip -9ur $(DOSCM)slib$(VERSION).zip slib/slib.html + zip -d $(DOSCM)slib$(VERSION).zip slib/slib.info pubzip: temp/slib $(makedev) DEST=$(HOME)/pub/ PROD=slib zip @@ -379,9 +367,7 @@ psdocfiles=article.bbl article.tex manual.bbl manual.tex quick-intro.tex psdtemp/slib: -rm -rf psdtemp - mkdir psdtemp - mkdir psdtemp/slib - mkdir psdtemp/slib/psd + mkdir -p psdtemp/slib/psd cd psd; ln $(psdfiles) ../psdtemp/slib/psd mkdir psdtemp/slib/psd/doc cd psd/doc; ln $(psdocfiles) ../../psdtemp/slib/psd/doc @@ -397,26 +383,28 @@ new: echo>> change cat ChangeLog >> change mv -f change ChangeLog - $(CHPAT) slib$(VERSION) slib$(ver) ANNOUNCE FAQ ../scm/ANNOUNCE \ + $(CHPAT) slib$(VERSION) slib$(ver) ANNOUNCE FAQ README \ + ../scm/ANNOUNCE \ ../jacal/ANNOUNCE ../wb/README ../wb/ANNOUNCE \ ../synch/ANNOUNCE \ $(htmldir)README.html ../dist/README \ $(htmldir)JACAL.html \ $(htmldir)SCM.html \ - $(htmldir)SIMSYNCH.html ../scm/scm.texi \ - $(DOSCM)dist/install.bat $(DOSCM)dist/makefile \ - $(DOSCM)dist/mkdisk.bat + $(htmldir)SIMSYNCH.html ../scm/scm.texi ../jacal/jacal.texi \ + $(DOSCM)install.bat $(DOSCM)makefile \ + $(DOSCM)mkdisk.bat $(CHPAT) slib-$(VERSION) slib-$(ver) ANNOUNCE FAQ ../scm/ANNOUNCE \ ../jacal/ANNOUNCE ../wb/README ../wb/ANNOUNCE \ ../synch/ANNOUNCE \ $(htmldir)README.html ../dist/README \ $(htmldir)JACAL.html \ $(htmldir)SCM.html \ - $(htmldir)SIMSYNCH.html ../scm/scm.texi \ - $(DOSCM)dist/install.bat $(DOSCM)dist/makefile \ - $(DOSCM)dist/mkdisk.bat - $(CHPAT) $(VERSION) $(ver) README slib.texi require.scm Makefile \ - $(htmldir)SLIB.html slib.spec scheme48.init + $(htmldir)SIMSYNCH.html ../scm/scm.texi ../jacal/jacal.texi \ + $(DOSCM)install.bat $(DOSCM)makefile \ + $(DOSCM)mkdisk.bat + $(CHPAT) $(VERSION) $(ver) require.scm Makefile \ + $(htmldir)SLIB.html slib.spec scheme48.init \ + slib.nsi ../scm/scm.nsi cvs commit -lm '(*slib-version*): Bumped from $(VERSION) to $(ver).' cvs tag -lF slib$(ver) @@ -438,7 +426,7 @@ clean: distclean: realclean realclean: -rm -f *~ *.bak *.orig *.rej TAGS core a.out *.o \#* - -rm -f slib.info* slib.?? slib.??? - -rm -rf *temp + -rm -f slib.info* slib.?? slib.html + -rm -rf *temp SLIB-*.exe realempty: temp/slib -rm -f $(allfiles) diff --git a/README b/README index d969fc7..d92b83a 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -This directory contains the distribution of Scheme Library slib3a4. +This directory contains the distribution of Scheme Library slib3a5. 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. @@ -29,12 +29,14 @@ The maintainer can be reached at agj @ alum.mit.edu. `scheme48.init' is a configuration file for Scheme48. `scsh.init' is a configuration file for Scheme-Shell `scm.init' is a configuration file for SCM. + `sisc.init' is a configuration file for SISC. `t3.init' is a configuration file for T3.1 in Scheme mode. `STk.init' is a configuration file for STk. `umbscheme.init' is a configuration file for umb-scheme. `vscm.init' is a configuration file for VSCM. `guile.init' is a configuration file for guile. `jscheme.init' is a configuration file for JScheme. + `kawa.init' is a configuration file for Kawa. `mklibcat.scm' builds the *catalog* cache. `require.scm' has code which allows system independent access to the library files. @@ -113,6 +115,7 @@ The maintainer can be reached at agj @ alum.mit.edu. pages. `http-cgi.scm' serves WWW pages with HTTP or CGI. `html4each.scm' parses HTML files. + `xml-parse.scm' parses XML files. `dirs.scm' maps over directory filenames. `uri.scm' encodes and decodes Uniform Resource Identifiers. `dbrowse.scm' browses relational databases. @@ -209,7 +212,7 @@ The maintainer can be reached at agj @ alum.mit.edu. Unpacking the SLIB Distribution ------------------------------- -If the SLIB distribution is a Linux RPM, it will create the SLIB +If the SLIB distribution is a GNU/Linux RPM, it will create the SLIB directory `/usr/share/slib'. If the SLIB distribution is a ZIP file, unzip the distribution to diff --git a/RScheme.init b/RScheme.init index 544bca1..87aacdb 100644 --- a/RScheme.init +++ b/RScheme.init @@ -211,6 +211,9 @@ )) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) diff --git a/STk.init b/STk.init index 4ff9cf4..a53fb7c 100644 --- a/STk.init +++ b/STk.init @@ -193,6 +193,9 @@ )) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) diff --git a/Template.scm b/Template.scm index 74fb7ea..b006f7a 100644 --- a/Template.scm +++ b/Template.scm @@ -204,6 +204,9 @@ )) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;@ (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) diff --git a/array.scm b/array.scm index ff05fd0..4cf93b3 100644 --- a/array.scm +++ b/array.scm @@ -400,96 +400,116 @@ ((or (zero? num) (negative? n)) (zero? num)))))) -;;@args z -;;@args +;;@defun A:floC128b z +;;@defunx A:floC128b ;;Returns an inexact 128.bit flonum complex uniform-array prototype. +;;@end defun (define A:floC128b (make-prototype-checker 'A:floC128b complex? vector)) -;;@args z -;;@args +;;@defun A:floC64b z +;;@defunx A:floC64b ;;Returns an inexact 64.bit flonum complex uniform-array prototype. +;;@end defun (define A:floC64b (make-prototype-checker 'A:floC64b complex? vector)) -;;@args z -;;@args +;;@defun A:floC32b z +;;@defunx A:floC32b ;;Returns an inexact 32.bit flonum complex uniform-array prototype. +;;@end defun (define A:floC32b (make-prototype-checker 'A:floC32b complex? vector)) -;;@args z -;;@args +;;@defun A:floC16b z +;;@defunx A:floC16b ;;Returns an inexact 16.bit flonum complex uniform-array prototype. +;;@end defun (define A:floC16b (make-prototype-checker 'A:floC16b complex? vector)) -;;@args z -;;@args +;;@defun A:floR128b x +;;@defunx A:floR128b ;;Returns an inexact 128.bit flonum real uniform-array prototype. +;;@end defun (define A:floR128b (make-prototype-checker 'A:floR128b real? vector)) -;;@args z -;;@args +;;@defun A:floR64b x +;;@defunx A:floR64b ;;Returns an inexact 64.bit flonum real uniform-array prototype. +;;@end defun (define A:floR64b (make-prototype-checker 'A:floR64b real? vector)) -;;@args z -;;@args +;;@defun A:floR32b x +;;@defunx A:floR32b ;;Returns an inexact 32.bit flonum real uniform-array prototype. +;;@end defun (define A:floR32b (make-prototype-checker 'A:floR32b real? vector)) -;;@args z -;;@args +;;@defun A:floR16b x +;;@defunx A:floR16b ;;Returns an inexact 16.bit flonum real uniform-array prototype. +;;@end defun (define A:floR16b (make-prototype-checker 'A:floR16b real? vector)) -;;@args z -;;@args +;;@defun A:floR128d q +;;@defunx A:floR128d ;;Returns an exact 128.bit decimal flonum rational uniform-array prototype. -(define A:floR128b (make-prototype-checker 'A:floR128b real? vector)) -;;@args z -;;@args +;;@end defun +(define A:floR128d (make-prototype-checker 'A:floR128d real? vector)) +;;@defun A:floR64d q +;;@defunx A:floR64d ;;Returns an exact 64.bit decimal flonum rational uniform-array prototype. -(define A:floR64b (make-prototype-checker 'A:floR64b real? vector)) -;;@args z -;;@args +;;@end defun +(define A:floR64d (make-prototype-checker 'A:floR64d real? vector)) +;;@defun A:floR32d q +;;@defunx A:floR32d ;;Returns an exact 32.bit decimal flonum rational uniform-array prototype. -(define A:floR32b (make-prototype-checker 'A:floR32b real? vector)) +;;@end defun +(define A:floR32d (make-prototype-checker 'A:floR32d real? vector)) -;;@args n -;;@args +;;@defun A:fixZ64b n +;;@defunx A:fixZ64b ;;Returns an exact binary fixnum uniform-array prototype with at least ;;64 bits of precision. +;;@end defun (define A:fixZ64b (make-prototype-checker 'A:fixZ64b (integer-bytes?? -8) vector)) -;;@args n -;;@args +;;@defun A:fixZ32b n +;;@defunx A:fixZ32b ;;Returns an exact binary fixnum uniform-array prototype with at least ;;32 bits of precision. +;;@end defun (define A:fixZ32b (make-prototype-checker 'A:fixZ32b (integer-bytes?? -4) vector)) -;;@args n -;;@args +;;@defun A:fixZ16b n +;;@defunx A:fixZ16b ;;Returns an exact binary fixnum uniform-array prototype with at least ;;16 bits of precision. +;;@end defun (define A:fixZ16b (make-prototype-checker 'A:fixZ16b (integer-bytes?? -2) vector)) -;;@args n -;;@args +;;@defun A:fixZ8b n +;;@defunx A:fixZ8b ;;Returns an exact binary fixnum uniform-array prototype with at least ;;8 bits of precision. +;;@end defun (define A:fixZ8b (make-prototype-checker 'A:fixZ8b (integer-bytes?? -1) vector)) -;;@args k -;;@args +;;@defun A:fixN64b k +;;@defunx A:fixN64b ;;Returns an exact non-negative binary fixnum uniform-array prototype with at ;;least 64 bits of precision. +;;@end defun (define A:fixN64b (make-prototype-checker 'A:fixN64b (integer-bytes?? 8) vector)) -;;@args k -;;@args +;;@defun A:fixN32b k +;;@defunx A:fixN32b ;;Returns an exact non-negative binary fixnum uniform-array prototype with at ;;least 32 bits of precision. +;;@end defun (define A:fixN32b (make-prototype-checker 'A:fixN32b (integer-bytes?? 4) vector)) -;;@args k -;;@args +;;@defun A:fixN16b k +;;@defunx A:fixN16b ;;Returns an exact non-negative binary fixnum uniform-array prototype with at ;;least 16 bits of precision. +;;@end defun (define A:fixN16b (make-prototype-checker 'A:fixN16b (integer-bytes?? 2) vector)) -;;@args k -;;@args +;;@defun A:fixN8b k +;;@defunx A:fixN8b ;;Returns an exact non-negative binary fixnum uniform-array prototype with at ;;least 8 bits of precision. +;;@end defun (define A:fixN8b (make-prototype-checker 'A:fixN8b (integer-bytes?? 1) vector)) -;;@args bool -;;@args +;;@defun A:bool bool +;;@defunx A:bool ;;Returns a boolean uniform-array prototype. +;;@end defun (define A:bool (make-prototype-checker 'A:bool boolean? vector)) diff --git a/array.txi b/array.txi index a00ab97..7a2d85f 100644 --- a/array.txi +++ b/array.txi @@ -203,171 +203,111 @@ uniform-array type is supported by the implementation, then it is returned; defaulting to the next larger precision type; resorting finally to vector. - -@defun a:floc128b z - - -@defunx a:floc128b +@defun A:floC128b z +@defunx A:floC128b Returns an inexact 128.bit flonum complex uniform-array prototype. @end defun - -@defun a:floc64b z - - -@defunx a:floc64b +@defun A:floC64b z +@defunx A:floC64b Returns an inexact 64.bit flonum complex uniform-array prototype. @end defun - -@defun a:floc32b z - - -@defunx a:floc32b +@defun A:floC32b z +@defunx A:floC32b Returns an inexact 32.bit flonum complex uniform-array prototype. @end defun - -@defun a:floc16b z - - -@defunx a:floc16b +@defun A:floC16b z +@defunx A:floC16b Returns an inexact 16.bit flonum complex uniform-array prototype. @end defun - -@defun a:flor128b z - - -@defunx a:flor128b +@defun A:floR128b x +@defunx A:floR128b Returns an inexact 128.bit flonum real uniform-array prototype. @end defun - -@defun a:flor64b z - - -@defunx a:flor64b +@defun A:floR64b x +@defunx A:floR64b Returns an inexact 64.bit flonum real uniform-array prototype. @end defun - -@defun a:flor32b z - - -@defunx a:flor32b +@defun A:floR32b x +@defunx A:floR32b Returns an inexact 32.bit flonum real uniform-array prototype. @end defun - -@defun a:flor16b z - - -@defunx a:flor16b +@defun A:floR16b x +@defunx A:floR16b Returns an inexact 16.bit flonum real uniform-array prototype. @end defun - -@defun a:flor128b z - - -@defunx a:flor128b +@defun A:floR128d q +@defunx A:floR128d Returns an exact 128.bit decimal flonum rational uniform-array prototype. @end defun - -@defun a:flor64b z - - -@defunx a:flor64b +@defun A:floR64d q +@defunx A:floR64d Returns an exact 64.bit decimal flonum rational uniform-array prototype. @end defun - -@defun a:flor32b z - - -@defunx a:flor32b +@defun A:floR32d q +@defunx A:floR32d Returns an exact 32.bit decimal flonum rational uniform-array prototype. @end defun - -@defun a:fixz64b n - - -@defunx a:fixz64b +@defun A:fixZ64b n +@defunx A:fixZ64b Returns an exact binary fixnum uniform-array prototype with at least 64 bits of precision. @end defun - -@defun a:fixz32b n - - -@defunx a:fixz32b +@defun A:fixZ32b n +@defunx A:fixZ32b Returns an exact binary fixnum uniform-array prototype with at least 32 bits of precision. @end defun - -@defun a:fixz16b n - - -@defunx a:fixz16b +@defun A:fixZ16b n +@defunx A:fixZ16b Returns an exact binary fixnum uniform-array prototype with at least 16 bits of precision. @end defun - -@defun a:fixz8b n - - -@defunx a:fixz8b +@defun A:fixZ8b n +@defunx A:fixZ8b Returns an exact binary fixnum uniform-array prototype with at least 8 bits of precision. @end defun - -@defun a:fixn64b k - - -@defunx a:fixn64b +@defun A:fixN64b k +@defunx A:fixN64b Returns an exact non-negative binary fixnum uniform-array prototype with at least 64 bits of precision. @end defun - -@defun a:fixn32b k - - -@defunx a:fixn32b +@defun A:fixN32b k +@defunx A:fixN32b Returns an exact non-negative binary fixnum uniform-array prototype with at least 32 bits of precision. @end defun - -@defun a:fixn16b k - - -@defunx a:fixn16b +@defun A:fixN16b k +@defunx A:fixN16b Returns an exact non-negative binary fixnum uniform-array prototype with at least 16 bits of precision. @end defun - -@defun a:fixn8b k - - -@defunx a:fixn8b +@defun A:fixN8b k +@defunx A:fixN8b Returns an exact non-negative binary fixnum uniform-array prototype with at least 8 bits of precision. @end defun - -@defun a:bool bool - - -@defunx a:bool +@defun A:bool bool +@defunx A:bool Returns a boolean uniform-array prototype. @end defun diff --git a/arraymap.scm b/arraymap.scm index 2c88eb8..bfac855 100644 --- a/arraymap.scm +++ b/arraymap.scm @@ -87,6 +87,34 @@ (array-index-map! ra0 list) ra0)) +;;@args array proc +;;applies @var{proc} to the indices of each element of @var{array} in +;;turn. The value returned and the order of application are +;;unspecified. +;; +;;One can implement @var{array-index-map!} as +;;@example +;;(define (array-index-map! ra fun) +;; (array-index-for-each +;; ra +;; (lambda is (apply array-set! ra (apply fun is) is)))) +;;@end example +(define (array-index-for-each ra fun) + (define (ramap rdims inds) + (if (null? (cdr rdims)) + (do ((i (+ -1 (car rdims)) (+ -1 i)) + (is (cons (+ -1 (car rdims)) inds) + (cons (+ -1 i) inds))) + ((negative? i)) + (apply fun is)) + (let ((crdims (cdr rdims))) + (do ((i (+ -1 (car rdims)) (+ -1 i))) + ((negative? i)) + (ramap crdims (cons i inds)))))) + (if (zero? (array-rank ra)) + (fun) + (ramap (reverse (array-dimensions ra)) '()))) + ;;@args array proc ;;applies @var{proc} to the indices of each element of @var{array} in ;;turn, storing the result in the corresponding element. The value @@ -107,20 +135,8 @@ ;; v)) ;;@end example (define (array-index-map! ra fun) - (define (ramap rdims inds) - (if (null? (cdr rdims)) - (do ((i (+ -1 (car rdims)) (+ -1 i)) - (is (cons (+ -1 (car rdims)) inds) - (cons (+ -1 i) inds))) - ((negative? i)) - (apply array-set! ra (apply fun is) is)) - (let ((crdims (cdr rdims))) - (do ((i (+ -1 (car rdims)) (+ -1 i))) - ((negative? i)) - (ramap crdims (cons i inds)))))) - (if (zero? (array-rank ra)) - (array-set! ra (fun)) - (ramap (reverse (array-dimensions ra)) '()))) + (array-index-for-each ra + (lambda is (apply array-set! ra (apply fun is) is)))) ;;@args destination source ;;Copies every element from vector or array @var{source} to the diff --git a/arraymap.txi b/arraymap.txi index 2547eaf..ce082a6 100644 --- a/arraymap.txi +++ b/arraymap.txi @@ -41,6 +41,22 @@ Returns an array of lists of indexes for @var{array} such that, if @end defun +@defun array-index-for-each array proc + +applies @var{proc} to the indices of each element of @var{array} in +turn. The value returned and the order of application are +unspecified. + +One can implement @var{array-index-map!} as +@example +(define (array-index-map! ra fun) + (array-index-for-each + ra + (lambda is (apply array-set! ra (apply fun is) is)))) +@end example +@end defun + + @deffn {Procedure} array-index-map! array proc applies @var{proc} to the indices of each element of @var{array} in diff --git a/batch.scm b/batch.scm index 0219562..14117d0 100644 --- a/batch.scm +++ b/batch.scm @@ -259,7 +259,7 @@ ((unix) ((cond ((and (string? name) (provided? 'system)) (lambda (proc) (let ((ans (call-with-output-file name proc))) - (system (string-append "chmod +x " name)) + (system (string-append "chmod +x '" name "'")) ans))) ((output-port? name) (lambda (proc) (proc name))) (else (lambda (proc) (proc (current-output-port))))) @@ -426,6 +426,7 @@ (apple2 *unknown*) (arm *unknown*) (atari.st *unknown*) + (atari-st *unknown*) (cdc *unknown*) (celerity *unknown*) (concurrent *unknown*) diff --git a/bigloo.init b/bigloo.init index dfe8e2f..13ad86d 100644 --- a/bigloo.init +++ b/bigloo.init @@ -215,6 +215,33 @@ ;;; OBJ->STRING returns strings with control characters. ;;(define (object->string x) (obj->string x)) +;; input-port-position port bigloo procedure +;; output-port-position port bigloo procedure +;; +;; Returns the current position (a character number), in the port. +;; +;; set-input-port-position! port pos bigloo procedure +;; set-output-port-position! port pos bigloo procedure +;; +;; These functions set the file position indicator for port. The new +;; position, measured in bytes, is specified by pos. It is an error to +;; seek a port that cannot be changed (for instance, a string or a +;; console port). The result of these functions is unspecified. An error +;; is raised if the position cannot be changed. + +;;@ (FILE-POSITION . ) +(define (file-position port . k) + (if (null? k) + ((if (output-port? port) + output-port-position + input-port-position) + port) + (apply + (if (output-port? port) + set-output-port-position! + set-input-port-position!) + port k))) + ;;@ (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) diff --git a/bytenumb.scm b/bytenumb.scm index cb9b5c5..053a433 100644 --- a/bytenumb.scm +++ b/bytenumb.scm @@ -130,6 +130,7 @@ ;;(bytes->ieee-float (bytes #xff #x80 0 0)) @result{} -inf.0 ;;(bytes->ieee-float (bytes #x7f #x80 0 0)) @result{} +inf.0 ;;(bytes->ieee-float (bytes #x7f #x80 0 1)) @result{} 0/0 +;;(bytes->ieee-float (bytes #x7f #xc0 0 0)) @result{} 0/0 ;;@end example ;;@body @@ -189,12 +190,11 @@ (define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt)))) (define (scale flt scl) (cond ((zero? scl) (out (/ flt 2) scl)) - ((zero? flt) (if S (byte-set! byts 0 #x80)) byts) - ((or (not (real? flt)) (>= flt 16)) + ((>= flt 16) (let ((flt/16 (/ flt 16))) (cond ((= flt/16 flt) (byte-set! byts 0 (if S #xFF #x7F)) - (byte-set! byts 1 (if (= flt (* zero flt)) #xC0 #x80)) + (byte-set! byts 1 #x80) byts) (else (scale flt/16 (+ scl 4)))))) ((>= flt 2) (scale (/ flt 2) (+ scl 1))) @@ -212,7 +212,14 @@ (byte-set! byts 0 (+ (if S 128 0) (ash scl -1))) byts) (byte-set! byts idx val))) - (scale (abs flt) 127)))) + (set! flt (magnitude flt)) + (cond ((zero? flt) (if S (byte-set! byts 0 #x80)) byts) + ((or (not (real? flt)) + (not (= flt flt))) + (byte-set! byts 0 (if S #xFF #x7F)) + (byte-set! byts 1 #xC0) + byts) + (else (scale flt 127)))))) ;;@example ;;(bytes->list (ieee-float->bytes 0.0)) @result{} (0 0 0 0) ;;(bytes->list (ieee-float->bytes -0.0)) @result{} (128 0 0 0) @@ -226,7 +233,7 @@ ;; ;;(bytes->list (ieee-float->bytes -inf.0)) @result{} (255 128 0 0) ;;(bytes->list (ieee-float->bytes +inf.0)) @result{} (127 128 0 0) -;;(bytes->list (ieee-float->bytes 0/0)) @result{} (127 128 0 1) +;;(bytes->list (ieee-float->bytes 0/0)) @result{} (127 192 0 0) ;;@end example @@ -241,12 +248,11 @@ (define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt)))) (define (scale flt scl) (cond ((zero? scl) (out (/ flt 2) scl)) - ((zero? flt) (if S (byte-set! byts 0 #x80)) byts) - ((or (not (real? flt)) (>= flt 16)) + ((>= flt 16) (let ((flt/16 (/ flt 16))) (cond ((= flt/16 flt) (byte-set! byts 0 (if S #xFF #x7F)) - (byte-set! byts 1 (if (= flt (* zero flt)) #xF8 #xF0)) + (byte-set! byts 1 #xF0) byts) (else (scale flt/16 (+ scl 4)))))) ((>= flt 2) (scale (/ flt 2) (+ scl 1))) @@ -264,7 +270,14 @@ (byte-set! byts 0 (+ (if S 128 0) (ash scl -4))) byts) (byte-set! byts idx val))) - (scale (abs flt) 1023)))) + (set! flt (magnitude flt)) + (cond ((zero? flt) (if S (byte-set! byts 0 #x80)) byts) + ((or (not (real? flt)) + (not (= flt flt))) + (byte-set! byts 0 #x7F) + (byte-set! byts 1 #xF8) + byts) + (else (scale flt 1023)))))) ;;@example ;;(bytes->list (ieee-double->bytes 0.0)) @result{} (0 0 0 0 0 0 0 0) ;;(bytes->list (ieee-double->bytes -0.0)) @result{} (128 0 0 0 0 0 0 0) @@ -315,7 +328,7 @@ ;;@body ;;Modifies @1 so that @code{stringieee-float (bytes #xff #x80 0 0)) @result{} -inf.0 (bytes->ieee-float (bytes #x7f #x80 0 0)) @result{} +inf.0 (bytes->ieee-float (bytes #x7f #x80 0 1)) @result{} 0/0 +(bytes->ieee-float (bytes #x7f #xc0 0 0)) @result{} 0/0 @end example @@ -111,7 +112,7 @@ floating-point of @var{x}. (bytes->list (ieee-float->bytes -inf.0)) @result{} (255 128 0 0) (bytes->list (ieee-float->bytes +inf.0)) @result{} (127 128 0 0) -(bytes->list (ieee-float->bytes 0/0)) @result{} (127 128 0 1) +(bytes->list (ieee-float->bytes 0/0)) @result{} (127 192 0 0) @end example @@ -180,7 +181,7 @@ byte-vectors matches numerical order. @code{ieee-byte-collate!} returns @var{by @deffn {Procedure} ieee-byte-decollate! byte-vector -Given @var{byte-vector} modified by @code{IEEE-byte-collate!}, reverses the @var{byte-vector} +Given @var{byte-vector} modified by @code{ieee-byte-collate!}, reverses the @var{byte-vector} modifications. @end deffn @@ -194,7 +195,7 @@ floating-point byte-vectors matches numerical order. @defun ieee-byte-decollate byte-vector -Given @var{byte-vector} returned by @code{IEEE-byte-collate}, reverses the @var{byte-vector} +Given @var{byte-vector} returned by @code{ieee-byte-collate}, reverses the @var{byte-vector} modifications. @end defun diff --git a/clrnamdb.scm b/clrnamdb.scm index e75a48d..d1ed549 100644 --- a/clrnamdb.scm +++ b/clrnamdb.scm @@ -1,4 +1,4 @@ -;;; "/usr/local/lib/slib/clrnamdb.scm" SLIB 3a3 alist-table database -*-scheme-*- +;;; "/usr/local/lib/slib/clrnamdb.scm" SLIB 3a4 alist-table database -*-scheme-*- ( (10 diff --git a/collect.scm b/collect.scm index 05bc2cf..d4ccb6f 100644 --- a/collect.scm +++ b/collect.scm @@ -117,20 +117,23 @@ ) ;@ (define (reduce . ) - (let ( (max+1 (collect:size (car ))) - (generators (map collect:gen-elts )) - ) - (let loop ( (count 0) ) - (cond - ((< count max+1) - (set! - (apply (map (lambda (g) (g)) generators))) - (loop (collect:add1 count)) - ) - (else ) - ) ) -) ) - + (define (reduce-init pred? init lst) + (if (null? lst) + init + (reduce-init pred? (pred? init (car lst)) (cdr lst)))) + (if (null? ) + (cond ((null? ) ) + ((null? (cdr )) (car )) + (else (reduce-init (car ) (cdr )))) + (let ((max+1 (collect:size (car ))) + (generators (map collect:gen-elts ))) + (let loop ((count 0)) + (cond + ((< count max+1) + (set! + (apply (map (lambda (g) (g)) generators))) + (loop (collect:add1 count))) + (else )))))) ;;@ pred true for every elt? diff --git a/collectx.scm b/collectx.scm index 7ba46b9..5ca0ca5 100644 --- a/collectx.scm +++ b/collectx.scm @@ -132,18 +132,33 @@ ;@ (define reduce (lambda (!1 !1 . !1) - (let ((max+1!2 (collect:size (car !1))) - (generators!2 - (map collect:gen-elts !1))) - (let loop!4 ((count!3 0)) - (cond ((< count!3 max+1!2) - (set! !1 - (apply !1 - !1 - (map (lambda (g!5) (g!5)) generators!2))) - (loop!4 (collect:add1 count!3))) - (else !1)))))) - + (letrec ((reduce-init!3 + (lambda (pred?!8 init!8 lst!8) + (if (null? lst!8) + init!8 + (reduce-init!3 + pred?!8 + (pred?!8 init!8 (car lst!8)) + (cdr lst!8)))))) + (if (null? !1) + (cond ((null? !1) !1) + ((null? (cdr !1)) (car !1)) + (else + (reduce-init!3 + !1 + (car !1) + (cdr !1)))) + (let ((max+1!4 (collect:size (car !1))) + (generators!4 + (map collect:gen-elts !1))) + (let loop!6 ((count!5 0)) + (cond ((< count!5 max+1!4) + (set! !1 + (apply !1 + !1 + (map (lambda (g!7) (g!7)) generators!4))) + (loop!6 (collect:add1 count!5))) + (else !1)))))))) ;;@ pred true for every elt? diff --git a/colorspc.scm b/colorspc.scm index 814149b..723a197 100644 --- a/colorspc.scm +++ b/colorspc.scm @@ -85,8 +85,8 @@ (define (CIEXYZ->xRGB xyz) (sRGB->xRGB (CIEXYZ->sRGB xyz))) ;;; http://www.pima.net/standards/it10/PIMA7667/PIMA7667-2001.PDF -;;; Photography ­ Electronic still picture imaging ­ -;;; Extended sRGB color encoding ­ e-sRGB +;;; Photography - Electronic still picture imaging - +;;; Extended sRGB color encoding - e-sRGB (define e-sRGB-log (lambda (sv) @@ -210,7 +210,7 @@ ;;; v* = 13 L* ( v' - vn' ) ;;; The quantities un' and vn' refer to the reference white or the light -;;; source; for the 2° observer and illuminant C, un' = 0.2009, vn' = +;;; source; for the 2.o observer and illuminant C, un' = 0.2009, vn' = ;;; 0.4610. Equations for u' and v' are given below: ;;; u' = 4 X / (X + 15 Y + 3 Z) diff --git a/comparse.scm b/comparse.scm index 5dc1a50..3dacf50 100644 --- a/comparse.scm +++ b/comparse.scm @@ -122,8 +122,8 @@ ;;@key{newline} were not there. ;;@item @samp{"} ;;The characters up to the next unescaped @key{"} are taken literally, -;;according to [R4RS] rules for literal strings (@pxref{Strings, , ,r4rs, -;;Revised(4) Scheme}). +;;according to [R4RS] rules for literal strings +;;(@pxref{Strings, , ,r4rs, Revised(4) Scheme}). ;;@item @samp{(}, @samp{%'} ;;One scheme expression is @code{read} starting with this character. The ;;@code{read} expression is evaluated, converted to a string diff --git a/comparse.txi b/comparse.txi index 7ae8e3b..0026f94 100644 --- a/comparse.txi +++ b/comparse.txi @@ -38,8 +38,8 @@ characters after the @key{newline} as though the backslash and @key{newline} were not there. @item @samp{"} The characters up to the next unescaped @key{"} are taken literally, -according to [R4RS] rules for literal strings (@pxref{Strings, , ,r4rs, -Revised(4) Scheme}). +according to [R4RS] rules for literal strings +(@pxref{Strings, , ,r4rs, Revised(4) Scheme}). @item @samp{(}, @samp{%'} One scheme expression is @code{read} starting with this character. The @code{read} expression is evaluated, converted to a string diff --git a/cring.scm b/cring.scm index 76459a2..6f33027 100644 --- a/cring.scm +++ b/cring.scm @@ -127,144 +127,144 @@ ;;; Converts * argument list to CR internal form (define (cr*-args->fcts args) ;;(print (cons 'cr*-args->fcts args) '==>) - (let loop ((args args) (pow 1) (nums 1) (arg.exps '())) - ;;(print (list 'loop args pow nums denoms arg.exps) '==>) - (cond ((null? args) (cons nums arg.exps)) + (let loop ((args args) (pow 1) (nums 1) (arg_exps '())) + ;;(print (list 'loop args pow nums denoms arg_exps) '==>) + (cond ((null? args) (cons nums arg_exps)) ((number? (car args)) (let ((num^pow (number^ (car args) (abs pow)))) (if (negative? pow) (loop (cdr args) pow (number/ (number* num^pow nums)) - arg.exps) - (loop (cdr args) pow (number* num^pow nums) arg.exps)))) + arg_exps) + (loop (cdr args) pow (number* num^pow nums) arg_exps)))) ;; Associative Rule ((is-term-op? (car args) '*) (loop (append (cdar args) (cdr args)) - pow nums arg.exps)) + pow nums arg_exps)) ;; Do singlet - ((and (is-term-op? (car args) '-) (= 2 (length (car args)))) ;;(print 'got-here (car args)) - (set! arg.exps (loop (cdar args) pow (number- nums) arg.exps)) + (set! arg_exps (loop (cdar args) pow (number- nums) arg_exps)) (loop (cdr args) pow - (car arg.exps) - (cdr arg.exps))) + (car arg_exps) + (cdr arg_exps))) ((and (is-term-op? (car args) '/) (= 2 (length (car args)))) ;; Do singlet / ;;(print 'got-here=cr+ (car args)) - (set! arg.exps (loop (cdar args) (number- pow) nums arg.exps)) + (set! arg_exps (loop (cdar args) (number- pow) nums arg_exps)) (loop (cdr args) pow - (car arg.exps) - (cdr arg.exps))) + (car arg_exps) + (cdr arg_exps))) ((is-term-op? (car args) '/) ;; Do multi-arg / ;;(print 'doing '/ (cddar args) (number- pow)) - (set! arg.exps - (loop (cddar args) (number- pow) nums arg.exps)) + (set! arg_exps + (loop (cddar args) (number- pow) nums arg_exps)) ;;(print 'finishing '/ (cons (cadar args) (cdr args)) pow) (loop (cons (cadar args) (cdr args)) pow - (car arg.exps) - (cdr arg.exps))) + (car arg_exps) + (cdr arg_exps))) ;; Pull out numeric exponents as powers ((and (is-term-op? (car args) '^) (= 3 (length (car args))) (number? (caddar args))) - (set! arg.exps (loop (list (cadar args)) + (set! arg_exps (loop (list (cadar args)) (number* pow (caddar args)) nums - arg.exps)) - (loop (cdr args) pow (car arg.exps) (cdr arg.exps))) + arg_exps)) + (loop (cdr args) pow (car arg_exps) (cdr arg_exps))) ;; combine with same terms - ((assoc (car args) arg.exps) + ((assoc (car args) arg_exps) => (lambda (pair) (set-cdr! pair (number+ pow (cdr pair))) - (loop (cdr args) pow nums arg.exps))) - ;; Add new term to arg.exps + (loop (cdr args) pow nums arg_exps))) + ;; Add new term to arg_exps (else (loop (cdr args) pow nums - (cons (cons (car args) pow) arg.exps)))))) + (cons (cons (car args) pow) arg_exps)))))) ;;; Converts + argument list to CR internal form (define (cr+-args->trms args) - (let loop ((args args) (cof 1) (numbers 0) (arg.exps '())) - (cond ((null? args) (cons numbers arg.exps)) + (let loop ((args args) (cof 1) (numbers 0) (arg_exps '())) + (cond ((null? args) (cons numbers arg_exps)) ((number? (car args)) (loop (cdr args) cof (number+ (number* (car args) cof) numbers) - arg.exps)) + arg_exps)) ;; Associative Rule ((is-term-op? (car args) '+) (loop (append (cdar args) (cdr args)) cof numbers - arg.exps)) + arg_exps)) ;; Idempotent singlet * ((and (is-term-op? (car args) '*) (= 2 (length (car args)))) (loop (cons (cadar args) (cdr args)) cof numbers - arg.exps)) + arg_exps)) ((and (is-term-op? (car args) '-) (= 2 (length (car args)))) ;; Do singlet - - (set! arg.exps (loop (cdar args) (number- cof) numbers arg.exps)) - (loop (cdr args) cof (car arg.exps) (cdr arg.exps))) + (set! arg_exps (loop (cdar args) (number- cof) numbers arg_exps)) + (loop (cdr args) cof (car arg_exps) (cdr arg_exps))) ;; Pull out numeric factors as coefficients ((and (is-term-op? (car args) '*) (some number? (cdar args))) ;;(print 'got-here (car args) '=> (cons '* (remove-if number? (cdar args)))) - (set! arg.exps + (set! arg_exps (loop (list (cons '* (remove-if number? (cdar args)))) (apply number* cof (remove-if-not number? (cdar args))) numbers - arg.exps)) - (loop (cdr args) cof (car arg.exps) (cdr arg.exps))) + arg_exps)) + (loop (cdr args) cof (car arg_exps) (cdr arg_exps))) ((is-term-op? (car args) '-) ;; Do multi-arg - - (set! arg.exps (loop (cddar args) (number- cof) numbers arg.exps)) + (set! arg_exps (loop (cddar args) (number- cof) numbers arg_exps)) (loop (cons (cadar args) (cdr args)) cof - (car arg.exps) - (cdr arg.exps))) + (car arg_exps) + (cdr arg_exps))) ;; combine with same terms - ((assoc (car args) arg.exps) + ((assoc (car args) arg_exps) => (lambda (pair) (set-cdr! pair (number+ cof (cdr pair))) - (loop (cdr args) cof numbers arg.exps))) - ;; Add new term to arg.exps + (loop (cdr args) cof numbers arg_exps))) + ;; Add new term to arg_exps (else (loop (cdr args) cof numbers - (cons (cons (car args) cof) arg.exps)))))) + (cons (cons (car args) cof) arg_exps)))))) ;;; Converts + or * internal form to Scheme expression -(define (cr-terms->form op ident inv-op higher-op res.cofs) - (define (negative-cof? fct.cof) - (negative? (cdr fct.cof))) +(define (cr-terms->form op ident inv-op higher-op res_cofs) + (define (negative-cof? fct_cof) + (negative? (cdr fct_cof))) (define (finish exprs) (if (null? exprs) ident (if (null? (cdr exprs)) (car exprs) (cons op exprs)))) - (define (do-terms sign fct.cofs) + (define (do-terms sign fct_cofs) (expression-sort - (map (lambda (fct.cof) - (define cof (number* sign (cdr fct.cof))) - (cond ((eqv? 1 cof) (car fct.cof)) - ((number? (car fct.cof)) (number* cof (car fct.cof))) - ((is-term-op? (car fct.cof) higher-op) + (map (lambda (fct_cof) + (define cof (number* sign (cdr fct_cof))) + (cond ((eqv? 1 cof) (car fct_cof)) + ((number? (car fct_cof)) (number* cof (car fct_cof))) + ((is-term-op? (car fct_cof) higher-op) (if (eq? higher-op '^) - (list '^ (cadar fct.cof) (* cof (caddar fct.cof))) - (cons higher-op (cons cof (cdar fct.cof))))) - ((eqv? -1 cof) (list inv-op (car fct.cof))) - (else (list higher-op (car fct.cof) cof)))) - fct.cofs))) - (let* ((all.cofs (remove-if (lambda (fct.cof) - (or (zero? (cdr fct.cof)) - (eqv? ident (car fct.cof)))) - res.cofs)) - (cofs (map cdr all.cofs)) + (list '^ (cadar fct_cof) (* cof (caddar fct_cof))) + (cons higher-op (cons cof (cdar fct_cof))))) + ((eqv? -1 cof) (list inv-op (car fct_cof))) + (else (list higher-op (car fct_cof) cof)))) + fct_cofs))) + (let* ((all_cofs (remove-if (lambda (fct_cof) + (or (zero? (cdr fct_cof)) + (eqv? ident (car fct_cof)))) + res_cofs)) + (cofs (map cdr all_cofs)) (some-positive? (some positive? cofs))) - ;;(print op 'positive? some-positive? 'negative? (some negative? cofs) all.cofs) + ;;(print op 'positive? some-positive? 'negative? (some negative? cofs) all_cofs) (cond ((and some-positive? (some negative? cofs)) (append (list inv-op (finish (do-terms - 1 (remove-if negative-cof? all.cofs)))) - (do-terms -1 (remove-if-not negative-cof? all.cofs)))) - (some-positive? (finish (do-terms 1 all.cofs))) + 1 (remove-if negative-cof? all_cofs)))) + (do-terms -1 (remove-if-not negative-cof? all_cofs)))) + (some-positive? (finish (do-terms 1 all_cofs))) ((not (some negative? cofs)) ident) - (else (list inv-op (finish (do-terms -1 all.cofs))))))) + (else (list inv-op (finish (do-terms -1 all_cofs))))))) (define (* . args) (cond @@ -282,12 +282,12 @@ (ans (cr-terms->form '* 1 '/ '^ (apply - (lambda (numeric red.cofs res.cofs) + (lambda (numeric red_cofs res_cofs) (set! num numeric) (append ;;(list (cons (abs numeric) 1)) - red.cofs - res.cofs)) + red_cofs + res_cofs)) (cr1 '* number* '^ '/ (car in) (cdr in)))))) (cond ((number0? (+ -1 num)) ans) ((number? ans) (number* num ans)) @@ -312,14 +312,14 @@ (car in) (cr-terms->form '+ 0 '- '* - (apply (lambda (numeric red.cofs res.cofs) + (apply (lambda (numeric red_cofs res_cofs) (append (list (if (and (number? numeric) (negative? numeric)) (cons (abs numeric) -1) (cons numeric 1))) - red.cofs - res.cofs)) + red_cofs + res_cofs)) (cr1 '+ number+ '* '- (car in) (cdr in))))))))) (define (- arg1 . args) @@ -353,8 +353,8 @@ ;; class if not. (define (cr1 op number-op hop inv-op numeric in) - (define red.pows '()) - (define res.pows '()) + (define red_pows '()) + (define res_pows '()) (define (cring:apply-rule->terms exp1 exp2) ;(display op) (let ((ans (cring:apply-rule op exp1 exp2))) (cond ((not ans) #f) @@ -365,101 +365,101 @@ (cond ((not ans) #f) ((number? ans) (list ans)) (else (list (cons ans 1)))))) - (let loop.arg.pow.s ((arg (caar in)) (pow (cdar in)) (arg.pows (cdr in))) - (define (arg-loop arg.pows) - (cond ((not (null? arg.pows)) - (loop.arg.pow.s (caar arg.pows) (cdar arg.pows) (cdr arg.pows))) - (else (list numeric red.pows res.pows)))) ; Actually return! - (define (merge-res tmp.pows multiplicity) - (cond ((null? tmp.pows)) - ((number? (car tmp.pows)) + (let loop_arg_pow_s ((arg (caar in)) (pow (cdar in)) (arg_pows (cdr in))) + (define (arg-loop arg_pows) + (cond ((not (null? arg_pows)) + (loop_arg_pow_s (caar arg_pows) (cdar arg_pows) (cdr arg_pows))) + (else (list numeric red_pows res_pows)))) ; Actually return! + (define (merge-res tmp_pows multiplicity) + (cond ((null? tmp_pows)) + ((number? (car tmp_pows)) (do ((m (number+ -1 (abs multiplicity)) (number+ -1 m)) - (n numeric (number-op n (abs (car tmp.pows))))) + (n numeric (number-op n (abs (car tmp_pows))))) ((negative? m) (set! numeric n))) - (merge-res (cdr tmp.pows) multiplicity)) - ((or (assoc (car tmp.pows) res.pows) - (assoc (car tmp.pows) arg.pows)) + (merge-res (cdr tmp_pows) multiplicity)) + ((or (assoc (car tmp_pows) res_pows) + (assoc (car tmp_pows) arg_pows)) => (lambda (pair) (set-cdr! pair (number+ - pow (number-op multiplicity (cdar tmp.pows)))) - (merge-res (cdr tmp.pows) multiplicity))) - ((assoc (car tmp.pows) red.pows) + pow (number-op multiplicity (cdar tmp_pows)))) + (merge-res (cdr tmp_pows) multiplicity))) + ((assoc (car tmp_pows) red_pows) => (lambda (pair) - (set! arg.pows - (cons (cons (caar tmp.pows) + (set! arg_pows + (cons (cons (caar tmp_pows) (number+ (cdr pair) - (number* multiplicity (cdar tmp.pows)))) - arg.pows)) + (number* multiplicity (cdar tmp_pows)))) + arg_pows)) (set-cdr! pair 0) - (merge-res (cdr tmp.pows) multiplicity))) - (else (set! arg.pows - (cons (cons (caar tmp.pows) - (number* multiplicity (cdar tmp.pows))) - arg.pows)) - (merge-res (cdr tmp.pows) multiplicity)))) - (define (try-fct.pow fct.pow) - ;;(print 'try-fct.pow fct.pow op 'arg arg 'pow pow) - (cond ((or (zero? (cdr fct.pow)) (number? (car fct.pow))) #f) - ((not (and (number? pow) (number? (cdr fct.pow)) - (integer? pow) ;(integer? (cdr fct.pow)) + (merge-res (cdr tmp_pows) multiplicity))) + (else (set! arg_pows + (cons (cons (caar tmp_pows) + (number* multiplicity (cdar tmp_pows))) + arg_pows)) + (merge-res (cdr tmp_pows) multiplicity)))) + (define (try-fct_pow fct_pow) + ;;(print 'try-fct_pow fct_pow op 'arg arg 'pow pow) + (cond ((or (zero? (cdr fct_pow)) (number? (car fct_pow))) #f) + ((not (and (number? pow) (number? (cdr fct_pow)) + (integer? pow) ;(integer? (cdr fct_pow)) )) #f) ;;((zero? pow) (slib:error "Don't try exp-0 terms") #f) - ;;((or (number? arg) (number? (car fct.pow))) - ;; (slib:error 'found-number arg fct.pow) #f) - ((and (positive? pow) (positive? (cdr fct.pow)) - (or (cring:apply-rule->terms arg (car fct.pow)) - (cring:apply-rule->terms (car fct.pow) arg))) + ;;((or (number? arg) (number? (car fct_pow))) + ;; (slib:error 'found-number arg fct_pow) #f) + ((and (positive? pow) (positive? (cdr fct_pow)) + (or (cring:apply-rule->terms arg (car fct_pow)) + (cring:apply-rule->terms (car fct_pow) arg))) => (lambda (terms) ;;(print op op terms) - (let ((multiplicity (min pow (cdr fct.pow)))) - (set-cdr! fct.pow (number- (cdr fct.pow) multiplicity)) + (let ((multiplicity (min pow (cdr fct_pow)))) + (set-cdr! fct_pow (number- (cdr fct_pow) multiplicity)) (set! pow (number- pow multiplicity)) (merge-res terms multiplicity)))) - ((and (negative? pow) (negative? (cdr fct.pow)) - (or (cring:apply-rule->terms arg (car fct.pow)) - (cring:apply-rule->terms (car fct.pow) arg))) + ((and (negative? pow) (negative? (cdr fct_pow)) + (or (cring:apply-rule->terms arg (car fct_pow)) + (cring:apply-rule->terms (car fct_pow) arg))) => (lambda (terms) ;;(print inv-op inv-op terms) - (let ((multiplicity (max pow (cdr fct.pow)))) - (set-cdr! fct.pow (number+ (cdr fct.pow) multiplicity)) + (let ((multiplicity (max pow (cdr fct_pow)))) + (set-cdr! fct_pow (number+ (cdr fct_pow) multiplicity)) (set! pow (number+ pow multiplicity)) (merge-res terms multiplicity)))) - ((and (positive? pow) (negative? (cdr fct.pow)) - (cring:apply-inv-rule->terms arg (car fct.pow))) + ((and (positive? pow) (negative? (cdr fct_pow)) + (cring:apply-inv-rule->terms arg (car fct_pow))) => (lambda (terms) ;;(print op inv-op terms) - (let ((multiplicity (min pow (number- (cdr fct.pow))))) - (set-cdr! fct.pow (number+ (cdr fct.pow) multiplicity)) + (let ((multiplicity (min pow (number- (cdr fct_pow))))) + (set-cdr! fct_pow (number+ (cdr fct_pow) multiplicity)) (set! pow (number- pow multiplicity)) (merge-res terms multiplicity)))) - ((and (negative? pow) (positive? (cdr fct.pow)) - (cring:apply-inv-rule->terms (car fct.pow) arg)) + ((and (negative? pow) (positive? (cdr fct_pow)) + (cring:apply-inv-rule->terms (car fct_pow) arg)) => (lambda (terms) ;;(print inv-op op terms) - (let ((multiplicity (max (number- pow) (cdr fct.pow)))) - (set-cdr! fct.pow (number- (cdr fct.pow) multiplicity)) + (let ((multiplicity (max (number- pow) (cdr fct_pow)))) + (set-cdr! fct_pow (number- (cdr fct_pow) multiplicity)) (set! pow (number+ pow multiplicity)) (merge-res terms multiplicity)))) (else #f))) - ;;(print op numeric 'arg arg 'pow pow 'arg.pows arg.pows 'red.pows red.pows 'res.pows res.pows) - ;;(trace arg-loop cring:apply-rule->terms merge-res try-fct.pow) (set! *qp-width* 333) + ;;(print op numeric 'arg arg 'pow pow 'arg_pows arg_pows 'red_pows red_pows 'res_pows res_pows) + ;;(trace arg-loop cring:apply-rule->terms merge-res try-fct_pow) (set! *qp-width* 333) (cond ((or (zero? pow) (eqv? 1 arg)) ;(number? arg) arg seems to always be 1 - (arg-loop arg.pows)) - ((assoc arg res.pows) => (lambda (pair) + (arg-loop arg_pows)) + ((assoc arg res_pows) => (lambda (pair) (set-cdr! pair (number+ pow (cdr pair))) - (arg-loop arg.pows))) + (arg-loop arg_pows))) ((and (> (abs pow) 1) (cring:apply-rule->terms arg arg)) => (lambda (terms) (merge-res terms (quotient pow 2)) (if (odd? pow) - (loop.arg.pow.s arg 1 arg.pows) - (arg-loop arg.pows)))) - ((or (some try-fct.pow res.pows) (some try-fct.pow arg.pows)) - (loop.arg.pow.s arg pow arg.pows)) - (else (set! res.pows (cons (cons arg pow) res.pows)) - (arg-loop arg.pows))))) + (loop_arg_pow_s arg 1 arg_pows) + (arg-loop arg_pows)))) + ((or (some try-fct_pow res_pows) (some try-fct_pow arg_pows)) + (loop_arg_pow_s arg pow arg_pows)) + (else (set! res_pows (cons (cons arg pow) res_pows)) + (arg-loop arg_pows))))) (define (cring:try-rule op sop1 sop2 exp1 exp2) (and *ruleset* diff --git a/dbinterp.scm b/dbinterp.scm index 2bd4e20..3444fbb 100644 --- a/dbinterp.scm +++ b/dbinterp.scm @@ -17,12 +17,10 @@ ;promotional, or sales literature without prior written consent in ;each case. -(require 'rev4-optional-procedures) ; list-tail - ;;; The procedures returned by MEMOIZE are not reentrant! (define (dbinterp:memoize proc k) (define recent (vector->list (make-vector k '(#f)))) - (let ((tailr (list-tail recent (+ -1 k)))) + (let ((tailr (last-pair recent))) (lambda args (define asp (assoc args recent)) (if asp @@ -35,8 +33,8 @@ ;;@ This procedure works only for tables with a single primary key. (define (interpolate-from-table table column) - (define get (dbinterp:memoize (table 'get column) 3)) - (define prev (dbinterp:memoize (table 'isam-prev) 3)) + (define get (table 'get column)) + (define prev (table 'isam-prev)) (define next (table 'isam-next)) (dbinterp:memoize (lambda (x) diff --git a/dbutil.scm b/dbutil.scm index 5df7b49..7df51ce 100644 --- a/dbutil.scm +++ b/dbutil.scm @@ -381,8 +381,7 @@ ;;@body ;;Adds the domain rows @2 @dots{} to the @samp{*domains-data*} table -;;in @1. The format of the row is given in @ref{Catalog -;;Representation}. +;;in @1. The format of the row is given in @ref{Catalog Representation}. ;; ;;@example ;;(define-domains rdb '(permittivity #f complex? c64 #f)) diff --git a/dbutil.txi b/dbutil.txi index fae8bb6..f7af3af 100644 --- a/dbutil.txi +++ b/dbutil.txi @@ -162,8 +162,7 @@ filename, and the lock certificate (if locked). @defun define-domains rdb row5 @dots{} Adds the domain rows @var{row5} @dots{} to the @samp{*domains-data*} table -in @var{rdb}. The format of the row is given in @ref{Catalog -Representation}. +in @var{rdb}. The format of the row is given in @ref{Catalog Representation}. @example (define-domains rdb '(permittivity #f complex? c64 #f)) diff --git a/determ.scm b/determ.scm index 0962e4a..30dabbc 100644 --- a/determ.scm +++ b/determ.scm @@ -114,18 +114,46 @@ matrix)))) ;;@body -;;Returns the product of matrices @1 and @2. -(define (matrix:product m1 m2) +;;Returns the element-wise sum of matricies @1 and @2. +(define (matrix:sum m1 m2) (define mat1 (matrix->lists m1)) (define mat2 (matrix->lists m2)) - (define (dot-product v1 v2) (apply + (map * v1 v2))) - (coerce-like-arg - (map (lambda (arow) - (apply map - (lambda bcol (dot-product bcol arow)) - mat2)) - mat1) - m1)) + (coerce-like-arg (map (lambda (row1 row2) (map + row1 row2)) mat1 mat2) + m1)) + +;;@body +;;Returns the element-wise difference of matricies @1 and @2. +(define (matrix:difference m1 m2) + (define mat1 (matrix->lists m1)) + (define mat2 (matrix->lists m2)) + (coerce-like-arg (map (lambda (row1 row2) (map - row1 row2)) mat1 mat2) + m1)) + +(define (matrix:scale m1 scl) + (coerce-like-arg (map (lambda (row1) (map (lambda (x) (* scl x)) row1)) + (matrix->lists m1)) + m1)) + +;;@args m1 m2 +;;Returns the product of matrices @1 and @2. +;;@args m1 z +;;Returns matrix @var{m1} times scalar @var{z}. +;;@args z m1 +;;Returns matrix @var{m1} times scalar @var{z}. +(define (matrix:product m1 m2) + (cond ((number? m1) (matrix:scale m2 m1)) + ((number? m2) (matrix:scale m1 m2)) + (else + (let ((mat1 (matrix->lists m1)) + (mat2 (matrix->lists m2))) + (define (dot-product v1 v2) (apply + (map * v1 v2))) + (coerce-like-arg + (map (lambda (arow) + (apply map + (lambda bcol (dot-product bcol arow)) + mat2)) + mat1) + m1))))) ;;@body ;;@1 must be a square matrix. diff --git a/determ.txi b/determ.txi index 1d89164..51ec1c9 100644 --- a/determ.txi +++ b/determ.txi @@ -38,9 +38,27 @@ element. @end defun +@defun matrix:sum m1 m2 + +Returns the element-wise sum of matricies @var{m1} and @var{m2}. +@end defun + + +@defun matrix:difference m1 m2 + +Returns the element-wise difference of matricies @var{m1} and @var{m2}. +@end defun + + @defun matrix:product m1 m2 Returns the product of matrices @var{m1} and @var{m2}. + +@defunx matrix:product m1 z +Returns matrix @var{m1} times scalar @var{z}. + +@defunx matrix:product z m1 +Returns matrix @var{m1} times scalar @var{z}. @end defun diff --git a/differ.scm b/differ.scm index 6acc253..bd363d4 100644 --- a/differ.scm +++ b/differ.scm @@ -1,5 +1,5 @@ ;;;; "differ.scm" O(NP) Sequence Comparison Algorithm. -;;; Copyright (C) 2001, 2002, 2003, 2004 Aubrey Jaffer +;;; Copyright (C) 2001, 2002, 2003, 2004, 2007 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 @@ -188,11 +188,10 @@ (let ((b-splt (diff:mid-split len-b RR CC tcst))) (define est-c (array-ref CC b-splt)) (define est-r (array-ref RR (- len-b b-splt))) - ;;(set! splts (cons (/ b-splt (max .1 len-b)) splts)) - ;;(display "A: ") (array-for-each display (fp:subarray A start-a mid-a)) (display " + ") (array-for-each display (fp:subarray A mid-a end-a)) (newline) - ;;(display "B: ") (array-for-each display (fp:subarray B start-b end-b)) (newline) + ;;(display "A: ") (array-for-each display (fp:subarray A start-a mid-a)) (display " + ") (array-for-each display (fp:subarray A mid-a end-a)) (newline) + ;;(display "B: ") (array-for-each display (fp:subarray B start-b end-b)) (newline) ;;(print 'cc cc) (print 'rr (fp:subarray RR (+ 1 len-b) 0)) - ;;(print (make-string (+ 7 (* 2 b-splt)) #\-) '^ (list b-splt)) + ;;(print (make-string (+ 12 (* 2 b-splt)) #\-) '^ (list b-splt)) (check-cost! 'CC est-c (diff2et fp fpoff CCRR A start-a mid-a @@ -372,23 +371,22 @@ (define (diff:edits A B . p-lim) (define M (car (array-dimensions A))) (define N (car (array-dimensions B))) - (set! p-lim (if (null? p-lim) -1 (car p-lim))) - (let ((fp (make-array (A:fixZ32b) (if (negative? p-lim) - (+ 3 M N) - (+ 3 (abs (- N M)) p-lim p-lim))))) - (define est (if (< N M) - (diff2editlen fp B A p-lim) - (diff2editlen fp A B p-lim))) - (and est - (let ((edits (make-array (A:fixZ32b) est)) - (CCRR (make-array (A:fixZ32b) (* 2 (+ (max M N) 1))))) - (cond ((< N M) - (diff2edits! edits fp CCRR B A) - (diff:invert-edits! edits)) - (else - (diff2edits! edits fp CCRR A B))) - ;;(diff:order-edits! edits est) - edits)))) + (define est (diff:edit-length A B (if (null? p-lim) -1 (car p-lim)))) + (and est + (let ((CCRR (make-array (A:fixZ32b) (* 2 (+ (max M N) 1)))) + (edits (make-array (A:fixZ32b) est))) + (define fp (make-array (A:fixZ32b) + (+ (max (- N (quotient M 2)) + (- M (quotient N 2))) + (- est (abs (- N M))) ; 2 * p-lim + 3))) + (cond ((< N M) + (diff2edits! edits fp CCRR B A) + (diff:invert-edits! edits)) + (else + (diff2edits! edits fp CCRR A B))) + ;;(diff:order-edits! edits est) + edits))) ;;@args array1 array2 p-lim ;;@args array1 array2 @@ -423,4 +421,4 @@ ;; ; e c h p q r ;;@end example -;;(trace-all "/home/jaffer/slib/differ.scm")(set! *qp-width* 333)(untrace fp:run fp:subarray) +;;(trace-all "/home/jaffer/slib/differ.scm")(set! *qp-width* 999)(untrace fp:run) ; fp:subarray diff --git a/elk.init b/elk.init index 09dc940..e85a908 100644 --- a/elk.init +++ b/elk.init @@ -241,10 +241,13 @@ ;;; (FILE-EXISTS? ) already here. ;;; (DELETE-FILE ) -(define (delete-file f) (system (string-append "rm " f))) +(define (delete-file f) (system (string-append "rm '" f "'"))) ;------------ +;;@ (FILE-POSITION . k) +(define (file-position . args) #f) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) diff --git a/gambit.init b/gambit.init index 07841e6..e431160 100644 --- a/gambit.init +++ b/gambit.init @@ -243,6 +243,38 @@ (define (offset-time caltime offset) (seconds->time (+ (time->seconds caltime) offset))) +;; procedure: input-port-byte-position port [position [whence]] +;; procedure: output-port-byte-position port [position [whence]] +;; +;; When called with a single argument these procedures return the +;; byte position where the next I/O operation would take place in the +;; file attached to the given port (relative to the beginning of the +;; file). When called with two or three arguments, the byte position +;; for subsequent I/O operations on the given port is changed to +;; position, which must be an exact integer. When whence is omitted +;; or is 0, the position is relative to the beginning of the file. +;; When whence is 1, the position is relative to the current byte +;; position of the file. When whence is 2, the position is relative +;; to the end of the file. The return value is the new byte position. +;; On most operating systems the byte position for reading and writing +;; of a given bidirectional port are the same. +;; +;; When input-port-byte-position is called to change the byte +;; position of an input-port, all input buffers will be flushed so +;; that the next byte read will be the one at the given position. +;; +;; When output-port-byte-position is called to change the byte +;; position of an output-port, there is an implicit call to +;; force-output before the position is changed. + +;;@ (FILE-POSITION . ) +(define (file-position port . k) + (apply (if (output-port? port) + output-port-byte-position + input-port-byte-position) + port + k)) + ;;; (OUTPUT-PORT-WIDTH ) ;; (define (output-port-width . arg) 79) diff --git a/grapheps.ps b/grapheps.ps index db3b8b1..4d41fd9 100644 --- a/grapheps.ps +++ b/grapheps.ps @@ -47,6 +47,9 @@ plotdict begin /YSTEP 0 def /YSTEPH 0 def /YTSCL 0 def +/STP3 0 def +/STP2 0 def +/SCL 0 def /graphrect 0 def /plotrect 0 def @@ -165,6 +168,14 @@ plotdict begin } repeat } bind def +/fudge3 % SCL STP3 STP2 +{ + /STP2 exch def /STP3 exch def /SCL exch def + SCL 3 mod 0 eq {STP3} {STP2} ifelse +%% leads to range error in CVS. +% SCL abs 3000 gt {STP2} {SCL 3 mod 0 eq {STP3} {STP2} ifelse} ifelse +} bind def + % The arguments are: % [ MIN-X MIN-Y DELTA-X DELTA-Y ] whole graph rectangle % [ MIN-COLJ MAX-COLJ ] Numerical range of plot data @@ -186,11 +197,9 @@ plotdict begin /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 abs find-tick-scale def - /YSTEP YTSCL 0 get 3 mod 0 eq {6} {8} ifelse 5 mul yuntrans - YSCL sign mul def + /YSTEP YTSCL 0 get 6 8 fudge3 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 + /XSTEP XTSCL 0 get 12 10 fudge3 5 mul xuntrans XSCL sign mul def /YSTEPH YSTEP 2 div def /XSTEPH XSTEP 2 div def } bind def diff --git a/guile.init b/guile.init index 9cf6ed4..e51381a 100644 --- a/guile.init +++ b/guile.init @@ -3,7 +3,7 @@ ;;; ;;; This code is in the public domain. -(if (string . ) +(define (file-position port . args) + (if (null? args) + (ftell port) + (seek port (car args) SEEK_SET))) +(if (string>=? (scheme-implementation-version) "1.8") + (module-replace! (current-module) '(file-position))) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) @@ -257,13 +271,17 @@ ;; "status:stop-sig" shouldn't arise here, since system shouldn't be ;; calling waitpid with WUNTRACED, but allow for it anyway, just in ;; case. -(set! system +(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))))))) +;; This has to be done after the definition so that the original +;; binding will still be visible during the definition. +(if (string>=? (scheme-implementation-version) "1.8") + (module-replace! (current-module) '(system))) ;;; for line-i/o (use-modules (ice-9 popen)) @@ -284,12 +302,16 @@ (re-export read-line!) (re-export write-line))) -(set! delete-file +(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))))) +;; This has to be done after the definition so that the original +;; binding will still be visible during the definition. +(if (string>=? (scheme-implementation-version) "1.8") + (module-replace! (current-module) '(delete-file))) ;;; FORCE-OUTPUT flushes any pending output on optional arg output port ;;; use this definition if your system doesn't have such a procedure. @@ -300,13 +322,18 @@ (define (make-exchanger obj) (lambda (rep) (let ((old obj)) (set! obj rep) old))) -(set! open-file +(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))))) +;; This has to be done after the definition so that the original +;; binding will still be visible during the definition. +(if (string>=? (scheme-implementation-version) "1.8") + (module-replace! (current-module) '(open-file))) + (define (call-with-open-ports . ports) (define proc (car ports)) (cond ((procedure? proc) (set! ports (cdr ports))) @@ -358,48 +385,52 @@ ;;; return if exiting not supported. (define slib:exit quit) -;;; Here for backward compatability -;;(define scheme-file-suffix -;; (let ((suffix (case (software-type) -;; ((nosve) "_scm") -;; (else ".scm")))) -;; (lambda () suffix))) - -;;; (define (guile:wrap-case-insensitive proc) -;;; (lambda args -;;; (save-module-excursion -;;; (lambda () -;;; (set-current-module slib-module) -;;; (let ((old (read-options))) -;;; (dynamic-wind -;;; (lambda () (read-enable 'case-insensitive)) -;;; (lambda () (apply proc args)) -;;; (lambda () (read-options old)))))))) - -;;; (define read (guile:wrap-case-insensitive read)) - -;;; (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 -;;; (let ((load-file (guile:wrap-case-insensitive load))) -;;; (lambda () -;;; (load-file (string-append (scheme-file-suffix)))))) -(define (slib:load-helper loader) - (lambda (name) - (save-module-excursion - (lambda () - (set-current-module slib-module) - (let ((errinfo (catch 'system-error - (lambda () (loader name) #f) - (lambda args args)))) - (if (and errinfo - (catch 'system-error - (lambda () (loader (string-append name ".scm")) #f) - (lambda args args))) - (apply throw errinfo))))))) -(define slib:load (slib:load-helper load)) -(define slib:load-from-path (slib:load-helper load-from-path)) - +(cond ((string>=? (scheme-implementation-version) "1.8") + (define (slib:load-helper loader) + (lambda (name) + (save-module-excursion + (lambda () + (set-current-module slib-module) + (let ((errinfo (catch 'system-error + (lambda () (loader name) #f) + (lambda args args)))) + (if (and errinfo + (catch 'system-error + (lambda () (loader (string-append name ".scm")) #f) + (lambda args args))) + (apply throw errinfo))))))) + (define slib:load (slib:load-helper load)) + (define slib:load-from-path (slib:load-helper load-from-path)) + ) + (else + ;;Here for backward compatability + (define scheme-file-suffix + (let ((suffix (case (software-type) + ((nosve) "_scm") + (else ".scm")))) + (lambda () suffix))) + + (define (guile:wrap-case-insensitive proc) + (lambda args + (save-module-excursion + (lambda () + (set-current-module slib-module) + (let ((old (read-options))) + (dynamic-wind + (lambda () (read-enable 'case-insensitive)) + (lambda () (apply proc args)) + (lambda () (read-options old)))))))) + + (define read (guile:wrap-case-insensitive read)) + + (define slib:load + (let ((load-file (guile:wrap-case-insensitive load))) + (lambda () + (load-file (string-append (scheme-file-suffix)))))) + )) + +;;;(SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever +;;;suffix all the module files in SLIB have. See feature 'SOURCE. (define slib:load-source slib:load) ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced @@ -412,6 +443,15 @@ (define (defmacro:expand* x) (require 'defmacroexpand) (apply defmacro:expand* x '())) +;@ +(define gentemp + (let ((*gensym-counter* -1)) + (lambda () + (set! *gensym-counter* (+ *gensym-counter* 1)) + (string->symbol + (string-append "slib:G" (number->string *gensym-counter*)))))) +(if (string>=? (scheme-implementation-version) "1.8") + (module-replace! (current-module) '(gentemp))) ;;; If your implementation provides R4RS macros: (define macro:eval slib:eval) @@ -507,13 +547,18 @@ (array-shape array))))) ;; DIMENSIONS->UNIFORM-ARRAY and list->uniform-array in Guile-1.6.4 ;; cannot make empty arrays. -(set! make-array +(define 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))))))) +;; This has to be done after the definition so that the original +;; binding will still be visible during the definition. +(if (string>=? (scheme-implementation-version) "1.8") + (module-replace! (current-module) '(make-array))) + (define create-array make-array) (define (make-uniform-wrapper prot) (if (string? prot) (set! prot (string->number prot))) @@ -602,6 +647,18 @@ (if (not (defined? 'random:chunk)) (define (random:chunk sta) (random 256 sta))) +;;; workaround for Guile 1.6.7 bug +(cond ((or (array? 'guile) (array? '(1 6 7))) + (define array? + (let ((old-array? array?)) + (lambda (obj) + (and (old-array? obj) + (not (or (list? obj) + (symbol? obj) + (record? obj))))))) + (if (string>=? (scheme-implementation-version) "1.8") + (module-replace! (current-module) '(array?))))) + ;;; 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)) @@ -615,4 +672,7 @@ (define >? >) (define >=? >=) +(if (string>=? (scheme-implementation-version) "1.8") + (module-replace! (current-module) '(provide provided?))) + (slib:load (in-vicinity (library-vicinity) "require")) diff --git a/hash.scm b/hash.scm index fbee264..c2d8f5c 100644 --- a/hash.scm +++ b/hash.scm @@ -17,24 +17,6 @@ ;promotional, or sales literature without prior written consent in ;each case. -(define (hash:hash-symbol sym n) - (hash:hash-string (symbol->string sym) n)) - -;;; This can overflow on implemenatations where inexacts have a larger -;;; range than exact integers. -(define hash:hash-number - (if (provided? 'inexact) - (lambda (num n) - (if (integer? num) - (modulo (if (exact? num) num (inexact->exact num)) n) - (hash:hash-string-ci - (number->string (if (exact? num) (exact->inexact num) num)) - n))) - (lambda (num n) - (if (integer? num) - (modulo num n) - (hash:hash-string-ci (number->string num) n))))) - (define (hash:hash-string-ci str n) (let ((len (string-length str))) (if (> len 5) @@ -57,6 +39,25 @@ h))))) (define hash:hash-string hash:hash-string-ci) + +(define (hash:hash-symbol sym n) + (hash:hash-string (symbol->string sym) n)) + +;;; This can overflow on implemenatations where inexacts have a larger +;;; range than exact integers. +(define hash:hash-number + (if (provided? 'inexact) + (lambda (num n) + (if (integer? num) + (modulo (if (exact? num) num (inexact->exact num)) n) + (hash:hash-string-ci + (number->string (if (exact? num) (exact->inexact num) num)) + n))) + (lambda (num n) + (if (integer? num) + (modulo num n) + (hash:hash-string-ci (number->string num) n))))) + ;@ (define (hash obj n) (let hs ((d 10) (obj obj)) diff --git a/jscheme.init b/jscheme.init index 241a2d8..9e568b7 100644 --- a/jscheme.init +++ b/jscheme.init @@ -37,7 +37,7 @@ ;;@ (scheme-implementation-version) should return a string describing ;;; the version the scheme implementation loading this file. -(define (scheme-implementation-version) "6.2") +(define (scheme-implementation-version) "7.2") ;;@ (implementation-vicinity) should be defined to be the pathname of ;;; the directory where any auxillary files to your Scheme @@ -235,6 +235,9 @@ )) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;@ (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) @@ -262,9 +265,9 @@ ;;@ FORCE-OUTPUT flushes any pending output on optional arg output port ;;; use this definition if your system doesn't have such a procedure. -(define (force-output . arg) - (.flush (if (pair? arg) (car args) - (current-output-port)))) +(define (force-output . args) + (.flush (if (pair? args) (car args) + (current-output-port)))) ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string ;;; port versions of CALL-WITH-*PUT-FILE. @@ -289,6 +292,51 @@ ;;@ SLIB:EVAL is single argument eval using the top-level (user) environment. (define slib:eval eval) +;;;; Fix numeric functions (per R5RS) + +(define gcd + (let ((gcd gcd)) + (lambda args (if (null? args) 0 (apply gcd args))))) + +(define lcm + (let ((lcm lcm)) + (lambda args (if (null? args) 1 (apply lcm args))))) + +(define round + (let ((round round)) + (lambda (x) (if (inexact? x) + (exact->inexact (round x)) + (round x))))) + +(define atan + (let ((atan atan)) + (lambda (z . y) + (if (null? y) + (atan z) + (atan (/ z (car y))))))) + +(define (integer-expt n k) + (if (= 1 (abs n)) + (if (even? k) (* n n) n) + (do ((x n (* x x)) + (j k (quotient j 2)) + (acc 1 (if (even? j) acc (* x acc)))) + ((<= j 1) + (case j + ((0) acc) + ((1) (* x acc)) + (else (slib:error 'integer-expt n k))))))) + +(define expt + (let ((expt expt)) + (lambda (z1 z2) + (cond ((and (exact? z2) + (exact? z1) + (not (and (zero? z1) (negative? z2)))) + (integer-expt z1 z2)) + ((zero? z2) (+ 1 (* z1 z2))) + (else (expt z1 z2)))))) + ;; If your implementation provides R4RS macros: ;(define macro:eval slib:eval) ;(define macro:load load) diff --git a/kawa.init b/kawa.init new file mode 100644 index 0000000..4a261c0 --- /dev/null +++ b/kawa.init @@ -0,0 +1,391 @@ +;;; "kawa.init" SLIB initialization for Kawa -*-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. +(define (software-type) 'unix) + +;;@ (scheme-implementation-type) should return the name of the scheme +;;; implementation loading this file. +(define (scheme-implementation-type) 'kawa) + +;;@ (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.gnu.org/software/kawa") + +;;@ (scheme-implementation-version) should return a string describing +;;; the version the scheme implementation loading this file. +(define scheme-implementation-version scheme-implementation-version) + +;;@ (implementation-vicinity) should be defined to be the pathname of +;;; the directory where any auxillary files to your Scheme +;;; implementation reside. +(define (implementation-vicinity) + (case (software-type) + ((unix) "/usr/local/src/kawa/") + ;;((vms) "scheme$src:") + ((ms-dos) "C:\\kawa\\"))) + +;;@ (library-vicinity) should be defined to be the pathname of the +;;; directory where files of Scheme library functions reside. +(define library-vicinity + (let ((library-path + (or + ;; Use this getenv if your implementation supports it. + ;;(getenv "SCHEME_LIBRARY_PATH") + ;; Use this path if your scheme does not support GETENV + ;; or if SCHEME_LIBRARY_PATH is not set. + (case (software-type) + ((unix) "/usr/local/lib/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") + (else ""))))) + (lambda () library-path))) + +;;@ (home-vicinity) should return the vicinity of the user's HOME +;;; directory, the directory which typically contains files which +;;; customize a computer environment for a user. +(define (home-vicinity) + (let ((home ((primitive-static-method "getProperty" + ()) + 'user.home))) + (and home + (case (software-type) + ((unix coherent ms-dos) ;V7 unix has a / on HOME + (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) + home + (string-append home "/"))) + (else home))))) + +;@ +(define in-vicinity string-append) +;@ +(define (user-vicinity) + (case (software-type) + ((vms) "[.]") + (else ""))) + +(define *load-pathname* #f) +;@ +(define vicinity:suffix? + (let ((suffi + (case (software-type) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) + (else + (slib:warn "require.scm" 'unknown 'software-type (software-type)) + "/")))) + (lambda (chr) (and (memv chr suffi) #t)))) +;@ +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) +(define (program-vicinity) + (if *load-pathname* + (pathname->vicinity *load-pathname*) + (slib:error 'program-vicinity " called; use slib:load to load"))) +;@ +(define sub-vicinity + (case (software-type) + ((vms) (lambda + (vic name) + (let ((l (string-length vic))) + (if (or (zero? (string-length vic)) + (not (char=? #\] (string-ref vic (- l 1))))) + (string-append vic "[" name "]") + (string-append (substring vic 0 (- l 1)) + "." name "]"))))) + (else (let ((*vicinity-suffix* + (case (software-type) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) + (lambda (vic name) + (string-append vic name *vicinity-suffix*)))))) +;@ +(define (make-vicinity ) ) +;@ +(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))))))) + +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. +(define slib: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 + fluid-let +;;; sort +;;; pretty-print +;;; object->string + format ;Common-lisp output formatting + trace ;has macros: TRACE and UNTRACE +;;; compiler ;has (COMPILER) +;;; ed ;(ED) is editor + system ;posix (system ) +;;; getenv ;posix (getenv ) +;;; program-arguments ;returns list of strings (argv) +;;; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + + )) + +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + +;;@ (OUTPUT-PORT-WIDTH ) +(define (output-port-width . arg) 79) + +;;@ (OUTPUT-PORT-HEIGHT ) +(define (output-port-height . arg) 24) + +;;@ (CURRENT-ERROR-PORT) +(define current-error-port + (let ((port (current-output-port))) + (lambda () port))) + +;;@ (TMPNAM) makes a temporary file name. +(define tmpnam (let ((cntr 100)) + (lambda () (set! cntr (+ 1 cntr)) + (string-append "slib_" (number->string cntr))))) + +;;@ (FILE-EXISTS? ) +;;(define (file-exists? f) #f) + +;;@ (DELETE-FILE ) +;;(define (delete-file f) #f) + +;;@ FORCE-OUTPUT flushes any pending output on optional arg output port +;;; use this definition if your system doesn't have such a procedure. +;;(define (force-output . arg) #t) + +;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string +;;; port versions of CALL-WITH-*PUT-FILE. + +;;@ "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 #xFFFFFFFF) + +;;@ 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 ) + (slib:eval-load 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 + (if (provided? 'trace) (print-call-stack (current-error-port))) + (apply error args)))) +;@ +(define (make-exchanger obj) + (lambda (rep) (let ((old obj)) (set! obj rep) old))) +(define (open-file filename modes) + (case modes + ((r rb) (open-input-file filename)) + ((w wb) (open-output-file filename)) + (else (slib:error 'open-file 'mode? modes)))) +(define (port? obj) (or (input-port? obj) (output-port? obj))) +(define (call-with-open-ports . ports) + (define proc (car ports)) + (cond ((procedure? proc) (set! ports (cdr ports))) + (else (set! ports (reverse ports)) + (set! proc (car ports)) + (set! ports (reverse (cdr ports))))) + (let ((ans (apply proc ports))) + (for-each close-port ports) + ans)) +(define (close-port port) + (cond ((input-port? port) + (close-input-port port) + (if (output-port? port) (close-output-port port))) + ((output-port? port) (close-output-port port)) + (else (slib:error 'close-port 'port? port)))) +;@ +(define (browse-url url) + (define (try cmd end) (zero? (system (string-append cmd url end)))) + (or (try "netscape-remote -remote 'openURL(" ")'") + (try "netscape -remote 'openURL(" ")'") + (try "netscape '" "'&") + (try "netscape '" "'"))) + +;;@ define these as appropriate for your system. +(define slib:tab (integer->char 9)) +(define slib:form-feed (integer->char 12)) + +;;@ Support for older versions of Scheme. Not enough code for its own file. +(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)) +(define t #t) +(define nil #f) + +;;@ Define these if your implementation's syntax can support it and if +;;; they are not already defined. +;(define (1+ n) (+ n 1)) +;(define (-1+ n) (+ n -1)) +;(define 1- -1+) + +;;@ Define SLIB:EXIT to be the implementation procedure to exit or +;;; return if exiting not supported. +(define slib:exit (lambda args #f)) + +;;@ Here for backward compatability +(define scheme-file-suffix + (let ((suffix (case (software-type) + ((nosve) "_scm") + (else ".scm")))) + (lambda () suffix))) + +;;@ (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever +;;; suffix all the module files in SLIB have. See feature 'SOURCE. +(define (slib:load-source f) (load (string-append f ".scm"))) + +;;@ (SLIB:LOAD-COMPILED "foo") should load the file that was produced +;;; by compiling "foo.scm" if this implementation can compile files. +;;; See feature 'COMPILED. +(define slib:load-compiled load) + +;;@ At this point SLIB:LOAD must be able to load SLIB files. +(define slib:load slib:load-source) + +(slib:load (in-vicinity (library-vicinity) "require")) diff --git a/logical.scm b/logical.scm index 5ea47f5..71e73b9 100644 --- a/logical.scm +++ b/logical.scm @@ -172,7 +172,7 @@ (else (intlen (logical:ash-4 n) (+ 4 tot))))))) (lambda (n) (intlen n 0)))) ;@ -(define logcount +(define bitwise-bit-count (letrec ((logcnt (lambda (n tot) (if (zero? n) tot @@ -182,10 +182,14 @@ (modulo n 16)) tot)))))) (lambda (n) - (cond ((negative? n) (logcnt (lognot n) 0)) + (cond ((negative? n) (lognot (logcnt (lognot n) 0))) ((positive? n) (logcnt n 0)) (else 0))))) ;@ +(define (logcount n) + (cond ((negative? n) (bitwise-bit-count (lognot n))) + (else (bitwise-bit-count n)))) +;@ (define (log2-binary-factors n) (+ -1 (integer-length (logand n (- n))))) diff --git a/macscheme.init b/macscheme.init index ab717d4..c922bfc 100644 --- a/macscheme.init +++ b/macscheme.init @@ -180,6 +180,9 @@ )) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) diff --git a/manifest.scm b/manifest.scm index be55ea7..aa15e6e 100644 --- a/manifest.scm +++ b/manifest.scm @@ -332,10 +332,10 @@ (define (f2e feature) (define path (cdr (or (assq feature catalog) '(#f . #f)))) (define (return path) - (define path.scm (string-append path (scheme-file-suffix))) - (cond ((file-exists? path.scm) - (cons path.scm (file->exports path.scm))) - (else (slib:warn 'feature->export-alist 'path? path.scm) + (define path_scm (string-append path (scheme-file-suffix))) + (cond ((file-exists? path_scm) + (cons path_scm (file->exports path_scm))) + (else (slib:warn 'feature->export-alist 'path? path_scm) (list path)))) (cond ((not path) '()) ((symbol? path) (f2e path)) diff --git a/mitscheme.init b/mitscheme.init index be3df51..97d1efc 100644 --- a/mitscheme.init +++ b/mitscheme.init @@ -236,6 +236,12 @@ (define difftime -) (define offset-time +) +;;@ (FILE-POSITION . ) +(define (file-position port . args) + (if (null? args) + (port-position port) + (apply set-port-position! port args))) + ;;; (OUTPUT-PORT-WIDTH ) (define output-port-width output-port/x-size) @@ -366,7 +372,7 @@ form))))))) (if mit-scheme-has-r4rs-macros? (let ((e (->environment '(runtime syntactic-closures)))) - (let ((transformer-item/expander (access transformer-item/expander e)) + (let ((strip-keyword-value-item (access strip-keyword-value-item e)) (expander-item/expander (access expander-item/expander e)) (expander-item/environment (access expander-item/environment e))) (finish @@ -378,7 +384,7 @@ (environment-lookup-macro user-initial-environment a))))) (lambda (item form) - (let ((item (transformer-item/expander item))) + (let ((item (strip-keyword-value-item item))) ((expander-item/expander item) form user-initial-environment diff --git a/mkclrnam.scm b/mkclrnam.scm index 47acd1a..341f6eb 100644 --- a/mkclrnam.scm +++ b/mkclrnam.scm @@ -1,5 +1,5 @@ ;;; "mkclrnam.scm" create color name databases -;Copyright 2001, 2002, 2003 Aubrey Jaffer +;Copyright 2001, 2002, 2003, 2007 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 @@ -94,6 +94,15 @@ (display method-id) (newline) (set! parse-rgb-line method)))))) (list + (lambda (line) + (define use #f) + (case (sscanf line "%[^;]; red=%d, green=%d, blue=%d; hex=%6x; %[^.].%s" + name r g b rgbx use junk) + ((6) + (set! method-id 'm6e) + (list (check-match line (xrgb->color rgbx) (color:sRGB r g b)) + (color-name:canonicalize name))) + (else #f))) (lambda (line) (define en #f) (define fr #f) (define de #f) (define es #f) (define cz #f) (define hu #f) @@ -153,7 +162,7 @@ (lambda (line) (case (sscanf line "\" Resene %[^\"]\" %d %d %d %s" name r g b junk) - ((4) (set! method-id 'm4b) + ((4) (set! method-id 'm4d) (list (check-match line (color:sRGB r g b)) (color-name:canonicalize name))) (else #f))) @@ -215,7 +224,7 @@ (set! *idx* (+ 1 *idx*)) (color-table:row-insert (list name (car colin) *idx*))) - (else (slib:warn 'collision name oclin))))) + (else (slib:warn 'collision colin oclin))))) (cdr colin)))))))))) ;;@noindent diff --git a/mklibcat.scm b/mklibcat.scm index 19c5425..fe3368f 100644 --- a/mklibcat.scm +++ b/mklibcat.scm @@ -84,6 +84,7 @@ (eps-graph source "grapheps") (charplot source "charplot") (sort source "sort") + (srfi-95 sort) (tsort topological-sort) (topological-sort source "tsort") (common-list-functions source "comlist") @@ -218,6 +219,9 @@ (srfi-8 macro "srfi-8") (define-record-type srfi-9) (srfi-9 macro "srfi-9") + (let-values srfi-11) + (srfi-11 macro "srfi-11") + (srfi-28 format) (srfi-47 array) (srfi-63 array) (srfi-60 logical) @@ -227,6 +231,8 @@ (math-integer source "math-integer") (math-real source "math-real") (srfi-94 aggregate math-integer math-real) + (ssax xml-parse) + (xml-parse source "xml-parse") (new-catalog source "mklibcat") )))) (let* ((req (in-vicinity (library-vicinity) diff --git a/modular.scm b/modular.scm index e77ced4..78c78bb 100644 --- a/modular.scm +++ b/modular.scm @@ -185,32 +185,34 @@ (lambda (m a b) (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))) + (modular:normalize m (* (modular:normalize m a) + (modular:normalize m b)))) (else - (cond - ((< a modular:r)) - ((< b modular:r) (set! a b) (set! b a0) (set! a0 a)) - (else - (set! a0 (modulo a modular:r)) - (let ((a1 (quotient a modular:r)) - (qh (quotient m modular:r)) - (rh (modulo m modular:r))) - (cond ((>= a1 modular:r) - (set! a1 (- a1 modular:r)) - (set! p (modulo (- (* modular:r (modulo b qh)) - (* (quotient b qh) rh)) m)))) - (cond ((not (zero? a1)) - (let ((q (quotient m a1))) - (set! p (- p (* (quotient b q) (modulo m a1)))) - (set! p (modulo (+ (if (positive? p) (- p m) p) - (* a1 (modulo b q))) m))))) - (set! p (modulo (- (* modular:r (modulo p qh)) - (* (quotient p qh) rh)) m))))) + (set! a (modulo a m)) + (set! b (modulo b m)) + (set! a0 a) + (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))) diff --git a/mularg.scm b/mularg.scm index 4bfac03..e1bc5af 100644 --- a/mularg.scm +++ b/mularg.scm @@ -6,5 +6,5 @@ ((null? (cdr ds)) (op d1 (car ds))) (else (for-each (lambda (d) (set! d1 (op d1 d))) ds) d1)))) ;@ -(define / (let ((/ /)) (mul:argumentizer /))) -(define - (let ((- -)) (mul:argumentizer -))) +(define / (mul:argumentizer /)) +(define - (mul:argumentizer -)) diff --git a/mwdenote.scm b/mwdenote.scm index def1d4d..f7db72b 100644 --- a/mwdenote.scm +++ b/mwdenote.scm @@ -42,6 +42,8 @@ (set! . (special set!)) (begin . (special begin)) (define . (special define)) + (define-macro . (special define-macro)) ;; @@ added stef + (defmacro . (special defmacro)) ;; @@ added stef (case . (special case)) ;; @@ added wdc (let . (special let)) ;; @@ added KAD (let* . (special let*)) ;; @@ " @@ -136,6 +138,12 @@ (define mw:denote-of-define-syntax (mw:syntax-lookup mw:standard-syntax-environment 'define-syntax)) +(define mw:denote-of-define-macro + (mw:syntax-lookup mw:standard-syntax-environment 'define-macro)) ;; @@ stef + +(define mw:denote-of-defmacro + (mw:syntax-lookup mw:standard-syntax-environment 'defmacro)) ;; @@ stef + (define mw:denote-of-let-syntax (mw:syntax-lookup mw:standard-syntax-environment 'let-syntax)) diff --git a/mwexpand.scm b/mwexpand.scm index 07acf1d..719b899 100644 --- a/mwexpand.scm +++ b/mwexpand.scm @@ -154,6 +154,9 @@ ((eq? keyword mw:denote-of-letrec) (mw:letrec exp env)) ((eq? keyword mw:denote-of-quasiquote) (mw:quasiquote exp env)) ((eq? keyword mw:denote-of-do) (mw:do exp env)) + ; @@ leave alone define-macro args specs -- stef + ((eq? keyword mw:denote-of-define-macro) exp) + ((eq? keyword mw:denote-of-defmacro) exp) ((or (eq? keyword mw:denote-of-define) (eq? keyword mw:denote-of-define-syntax)) ;; slight hack to allow expansion into defines -KenD diff --git a/ncbi-dna.scm b/ncbi-dna.scm index 03fff65..d5fc5ca 100644 --- a/ncbi-dna.scm +++ b/ncbi-dna.scm @@ -24,6 +24,9 @@ (require 'array-for-each) (require-if 'compiling 'printf) ;used by cDNA:report-base-count +;;@code{(require 'ncbi-dma)} +;;@ftindex ncbi-dma + (define (ncbi:read-DNA-line port) (define lst (scanf-read-list " %d %[acgt] %[acgt] %[acgt] %[acgt] %[acgt] %[acgt]" port)) diff --git a/ncbi-dna.txi b/ncbi-dna.txi index 160b9ee..de64ea2 100644 --- a/ncbi-dna.txi +++ b/ncbi-dna.txi @@ -1,3 +1,6 @@ +@code{(require 'ncbi-dma)} +@ftindex ncbi-dma + @defun ncbi:read-dna-sequence port diff --git a/pscheme.init b/pscheme.init index f2c35cf..11c0125 100644 --- a/pscheme.init +++ b/pscheme.init @@ -117,8 +117,11 @@ string-port )) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) -;; $BUGBUG completely bogus values. Need hooks into runtime to get better ones +;; $BUGBUG completely bogus values. Need hooks into runtime to get +;; better ones ;;@ (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 30) ;;@ (OUTPUT-PORT-HEIGHT ) diff --git a/qp.scm b/qp.scm index 2feda2f..b772d89 100644 --- a/qp.scm +++ b/qp.scm @@ -144,10 +144,10 @@ (qp-obj (car objs) (l-elt-room *qp-width* objs)))))))))) ;@ (define qpn - (let ((newline newline) (apply apply) (qp qp)) + (let ((newline newline) (apply apply)) (lambda objs (apply qp objs) (newline)))) ;@ (define qpr - (let ((- -) (apply apply) (length length) (list-ref list-ref) (qpn qpn)) + (let ((- -) (apply apply) (length length) (list-ref list-ref)) (lambda objs (apply qpn objs) (list-ref objs (- (length objs) 1))))) diff --git a/require.scm b/require.scm index 31d922d..613038e 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* "3a4") +(define *slib-version* "3a5") ;;;; MODULES ;@ @@ -122,7 +122,7 @@ (else (bail expression)))) (feval expression)) ;@ -(define (provided? expression) +(define (slib:provided? expression) (define feature-list (cons (scheme-implementation-type) (cons (software-type) slib:features))) (define (provided? expression) @@ -133,7 +133,11 @@ (else #f)))))) (feature-eval expression provided?)) ;@ -(define (require feature) +(define (slib:provide feature) + (if (not (memq feature slib:features)) + (set! slib:features (cons feature slib:features)))) +;@ +(define (slib:require feature) (cond ((not feature) (set! *catalog* #f)) ((slib:provided? feature)) @@ -166,22 +170,14 @@ (else (slib:error "unknown package loader" path))) (if (list? path) (cdr path) (list (cdr path)))))))))) ;@ -(define (require-if feature? feature) +(define (slib:require-if feature? feature) (if (slib:provided? feature?) (slib:require feature))) -;@ -(define (provide feature) - (if (not (memq feature slib:features)) - (set! slib:features (cons feature slib:features)))) ;@ -(define slib:provide provide) -(define slib:provided? provided?) -(define slib:require require) -(define slib:require-if require-if) -;;; Legacy -(define require:provide provide) -(define require:provided? provided?) -(define require:require require) +(define provide slib:provide) +(define provided? slib:provided?) +(define require slib:require) +(define require-if slib:require-if) (let ((x (string->number "0.0"))) (if (and x (inexact? x)) (slib:provide 'inexact))) @@ -198,7 +194,7 @@ (slib:provide 'srfi-59) (do ((idx 0 (+ 1 idx)) (srfis (symbol->string 'srfi-))) - ((> idx 100)) + ((> idx 150)) (let ((srfi (string->symbol (string-append srfis (number->string idx))))) (if (slib:eval `(cond-expand (,srfi #t) (else #f))) (slib:provide srfi)))))) @@ -226,34 +222,31 @@ ((eof-object? o)) (evl o))))))) -(define report:print - (lambda args - (for-each (lambda (x) (write x) (display #\space)) args) - (newline))) +(define (report:print . args) + (for-each (lambda (x) (write x) (display #\space)) args) + (newline)) ;@ -(define slib:report - (let ((slib:report (lambda () (slib:report-version) (slib:report-locations)))) - (lambda args - (cond ((null? args) (slib:report)) - ((not (string? (car args))) - (slib:report-version) (slib:report-locations #t)) - ((slib:provided? 'transcript) - (transcript-on (car args)) - (slib:report) - (transcript-off)) - ((slib:provided? 'with-file) - (with-output-to-file (car args) slib:report)) - (else (slib:report)))))) +(define (slib:report . args) + (define rpt (lambda () (slib:report-version) (slib:report-locations))) + (cond ((null? args) (rpt)) + ((not (string? (car args))) + (slib:report-version) (slib:report-locations #t)) + ((slib:provided? 'transcript) + (transcript-on (car args)) + (rpt) + (transcript-off)) + ((slib:provided? 'with-file) + (with-output-to-file (car args) rpt)) + (else (rpt)))) ;@ -(define slib:report-version - (lambda () - (report:print - 'SLIB *slib-version* 'on (scheme-implementation-type) - (scheme-implementation-version) 'on (software-type)))) +(define (slib:report-version) + (report:print + 'SLIB *slib-version* 'on (scheme-implementation-type) + (scheme-implementation-version) 'on (software-type))) (define slib:report-locations - (let ((features slib:features)) + (let ((lfeatures slib:features)) ; Capture load-time value (lambda args (define sit (scheme-implementation-type)) (define siv (string->symbol (scheme-implementation-version))) @@ -261,12 +254,12 @@ (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 slib:features))) + (cond ((eq? (car lfeatures) (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 slib:features))) (newline)) + (cond ((eq? (car lfeatures) x) + (if (not (eq? (car lfeatures) (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))) diff --git a/root.scm b/root.scm index 7045e54..667f05f 100644 --- a/root.scm +++ b/root.scm @@ -46,34 +46,6 @@ ;; (lambda (x) (* 2 x)) ;; (ash 1 (quotient (integer-length y) 2)))) -;;;; 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 -;@ -(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) (if (and (negative? prec) (integer? prec)) diff --git a/scheme2c.init b/scheme2c.init index ccc9a84..80b91d1 100644 --- a/scheme2c.init +++ b/scheme2c.init @@ -208,6 +208,9 @@ (define pretty-print pp) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) @@ -229,13 +232,13 @@ ;;; (FILE-EXISTS? ) (define (file-exists? f) (case (software-type) - ((unix) (zero? (system (string-append "test -f " f)))) + ((unix) (zero? (system (string-append "test -f '" f "'")))) (else (slib:error "FILE-EXISTS? not defined for " software-type)))) ;;; (DELETE-FILE ) (define (delete-file f) (case (software-type) - ((unix) (zero? (system (string-append "rm " f)))) + ((unix) (zero? (system (string-append "rm '" f "'")))) (else (slib:error "DELETE-FILE not defined for " software-type)))) ;;; FORCE-OUTPUT flushes any pending output on optional arg output port diff --git a/scheme48.init b/scheme48.init index c7e91af..202c7bb 100644 --- a/scheme48.init +++ b/scheme48.init @@ -13,6 +13,7 @@ s48-getenv s48-current-time s48-time-seconds (s48-access-mode :syntax) s48-accessible? + s48-unlink s48-system s48-current-error-port s48-force-output @@ -34,7 +35,7 @@ (lookup-environment-variable s48-getenv))) (modify posix-files (prefix s48-) - (expose access-mode accessible?)) + (expose access-mode accessible? unlink)) (modify c-system-function (rename (system s48-system))) (modify i/o (rename (current-error-port s48-current-error-port) @@ -247,6 +248,9 @@ )) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) @@ -269,7 +273,14 @@ ;;; (DELETE-FILE ) (define (delete-file file-name) - (system (string-append "rm " file-name))) + (call-with-current-continuation + (lambda (k) + (s48-with-handler + (lambda (condition decline) + (k #f)) + (lambda () + (s48-unlink file-name) + #t))))) ;;; FORCE-OUTPUT flushes any pending output on optional arg output port ;;; use this definition if your system doesn't have such a procedure. @@ -504,7 +515,7 @@ ,collect ,batch off -,dump slib.image "(slib 3a4)" +,dump slib.image "(slib 3a5)" ;;; Put Scheme48-specific code into catalog (call-with-output-file (in-vicinity (implementation-vicinity) "implcat") diff --git a/schmooz.scm b/schmooz.scm index 75ddfa7..39785f3 100644 --- a/schmooz.scm +++ b/schmooz.scm @@ -359,6 +359,15 @@ ((not (and (char? chr) (not (char-whitespace? chr)))) str) (read-char port))) +(define (pathname->local-filename path) + (define vic (pathname->vicinity path)) + (define plen (string-length path)) + (let ((vlen (string-length vic))) + (if (and (substring? vic path) + (< vlen plen)) + (in-vicinity (user-vicinity) (substring path vlen plen)) + (slib:error 'pathname->local-filename path)))) + ;;;@ SCHMOOZ files. (define schmooz (let* ((scheme-file? (filename:match-ci?? "*??scm")) @@ -400,9 +409,12 @@ (define sl (string-length file)) (cond ((texi-file? file) (schmooz-texi-file file)) ((scheme-file? file) - (schmooz-scm-file file (scm->txi file))) + (schmooz-scm-file + file (pathname->local-filename (scm->txi file)))) (else (schmooz-scm-file - file (string-append file ".txi"))))) + file + (pathname->local-filename + (string-append file ".txi")))))) files)))) ;;; SCHMOOZ-TOPS - schmooz top level forms. diff --git a/scsh.init b/scsh.init index b4af555..0815825 100644 --- a/scsh.init +++ b/scsh.init @@ -190,6 +190,12 @@ )) +;;@ (FILE-POSITION . ) +(define (file-position port . args) + (if (null? args) + (tell port) + (apply seek port args))) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) diff --git a/sisc.init b/sisc.init new file mode 100644 index 0000000..a042bb7 --- /dev/null +++ b/sisc.init @@ -0,0 +1,348 @@ +;;; "sisc.init" Initialization for SLIB for SISC-1.16.6 -*-scheme-*- +;;; Author: matthias@sorted.org (Matthias Radestock) +;;; +;;; Based on: +;;; "Template.scm" configuration template of *features* for Scheme +;;; Author: Aubrey Jaffer +;;; +;;; This code is in the public domain. + +;;;TODO: +;;; * implement |system| + +;;;;import vicinity support +;;(require-extension (srfi 59)) + +;;; srfi-59 +(define (program-vicinity) + (current-directory)) + +(define (library-vicinity) + (string-append + (or (getenv "sisc.slib") + (getenv "sisc.lib") + (error "You must define the sisc.slib or sisc.lib property")) + "/")) + +(define (implementation-vicinity) + (string-append + (or (getenv "sisc.home") + (error "You must define the sisc.home property")) + "/")) + +(define (user-vicinity) "") + +(define (home-vicinity) + (string-append + (or (getenv "user.home") + (error "You must define the user.home property")) + "/")) + +(define in-vicinity normalize-url) + +(define (sub-vicinity vicinity name) + (string-append vicinity name "/")) + +(define (make-vicinity pathname) pathname) + +(define (pathname->vicinity pathname) + (let loop ((i (- (string-length pathname) 1))) + (cond ((negative? i) "") + ((vicinity:suffix? (string-ref pathname i)) + (substring pathname 0 (+ i 1))) + (else (loop (- i 1)))))) + +(define (vicinity:suffix? chr) + (eqv? chr #\/)) +;;; end srfi-59 + +;;@ (software-type) should be set to the generic operating system type. +;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. +(define (software-type) + (define (string-starts-with-ci? s1 s2) + (let ([l (string-length s2)]) + (and (not (< (string-length s1) l)) + (string-ci=? (substring s1 0 l) s2)))) + (let ([osn (getenv "os.name")]) + (cond [(string-starts-with-ci? osn "win") 'ms-dos] + [(string-starts-with-ci? osn "mac") 'macos] + [(string-starts-with-ci? osn "os/2") 'os2] + [(string-starts-with-ci? osn "openvms") 'vms] + [(string-starts-with-ci? osn "vax") 'vax] + [else 'unix]))) + +;;@ (scheme-implementation-type) should return the name of the scheme +;;; implementation loading this file. +(define (scheme-implementation-type) 'sisc) + +;;@ (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://sisc.sourceforge.net/") + +;;@ (scheme-implementation-version) should return a string describing +;;; the version the scheme implementation loading this file. +(define (scheme-implementation-version) + (getprop 'version (get-symbolic-environment '*sisc*))) + +;@ +(define (with-load-pathname path thunk) + (parameterize + ([current-url path]) + (thunk))) + +;;@ SLIB:FEATURES is a list of symbols naming the (SLIB) features +;;; initially supported by this implementation. +(define slib: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 +;;; trace ;has macros: TRACE and UNTRACE +;;; compiler ;has (COMPILER) +;;; ed ;(ED) is editor +;;; system ;posix (system ) +;;; getenv ;posix (getenv ) +;;; program-arguments ;returns list of strings (argv) + current-time ;returns time in seconds since 1/1/1970 + + ;;; Implementation Specific features + )) + +;;; import SISC record support, to stop SLIB using its own +(import record) + +(import string-io) + +;;@ +(define (current-time) (quotient (system-time) 1000)) +;;@ +(define object-hash hash-code) + +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + +;;@ (OUTPUT-PORT-WIDTH ) +(define (output-port-width . arg) + (let ((env-width-string (getenv "COLUMNS"))) + (if (and env-width-string + (let loop ((remaining (string-length env-width-string))) + (or (zero? remaining) + (let ((next (- remaining 1))) + (and (char-numeric? (string-ref env-width-string + next)) + (loop next)))))) + (- (string->number env-width-string) 1) + 79))) + +;;@ (OUTPUT-PORT-HEIGHT ) +(define (output-port-height . arg) + (let ((env-height-string (getenv "LINES"))) + (if (and env-height-string + (let loop ((remaining (string-length env-height-string))) + (or (zero? remaining) + (let ((next (- remaining 1))) + (and (char-numeric? (string-ref env-height-string + next)) + (loop next)))))) + (string->number env-height-string) + 24))) + +;;@ (CURRENT-ERROR-PORT) +(define current-error-port + (let ((port (current-output-port))) + (lambda () port))) + +;;@ (TMPNAM) makes a temporary file name. +(define tmpnam + (let ((cntr 100)) + (lambda () + (set! cntr (+ 1 cntr)) + (let ((tmp (string-append "slib_" (number->string cntr)))) + (if (file-exists? tmp) (tmpnam) tmp))))) + +;;@ (FILE-EXISTS? ) +;;(define (file-exists? f) #f) + +;;@ (DELETE-FILE ) +(define (delete-file f) #f) + +;;@ FORCE-OUTPUT flushes any pending output on optional arg output port +;;; use this definition if your system doesn't have such a procedure. +(define force-output flush-output-port) + +;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string +;;; port versions of CALL-WITH-*PUT-FILE. + +;;@ "rationalize" adjunct procedures. +;;(define (find-ratio x e) +;; (let ((rat (rationalize x e))) +;; (list (numerator rat) (denominator rat)))) +;;(define (find-ratio-between x y) +;; (find-ratio (/ (+ x y) 2) (/ (- x y) 2))) + +;;@ CHAR-CODE-LIMIT is one greater than the largest integer which can +;;; be returned by CHAR->INTEGER. +(define char-code-limit 65536) + +;;@ MOST-POSITIVE-FIXNUM is used in modular.scm +(define most-positive-fixnum (- (ashl 1 31) 1)) + +;;@ Return argument +(define (identity x) x) + +;;@ SLIB:EVAL is single argument eval using the top-level (user) environment. +(define slib:eval eval) + +;@ +(define slib:warn + (lambda args + (let ((cep (current-error-port))) + (if (provided? 'trace) (print-call-stack cep)) + (display "Warn: " cep) + (for-each (lambda (x) (display #\ cep) (write x cep)) args)))) + +;;@ define an error procedure for the library +(define (slib:error . args) + (if (provided? 'trace) (print-call-stack (current-error-port))) + (let loop ([l args] + [f ""]) + (if (null? l) + (apply error f args) + (loop (cdr l) (string-append f " ~a"))))) +;@ +(define (make-exchanger obj) + (lambda (rep) (let ((old obj)) (set! obj rep) old))) +(define (open-file filename modes) + (case modes + ((r rb) (open-input-file filename)) + ((w wb) (open-output-file filename)) + (else (slib:error 'open-file 'mode? modes)))) +;;;(define (port? obj) (or (input-port? port) (output-port? port))) +(define (call-with-open-ports . ports) + (define proc (car ports)) + (cond ((procedure? proc) (set! ports (cdr ports))) + (else (set! ports (reverse ports)) + (set! proc (car ports)) + (set! ports (reverse (cdr ports))))) + (let ((ans (apply proc ports))) + (for-each close-port ports) + ans)) +(define (close-port port) + (cond ((input-port? port) + (close-input-port port) + (if (output-port? port) (close-output-port port))) + ((output-port? port) (close-output-port port)) + (else (slib:error 'close-port 'port? port)))) +;@ +(define (browse-url url) + (define (try cmd end) (zero? (system (string-append cmd url end)))) + (or (try "netscape-remote -remote 'openURL(" ")'") + (try "netscape -remote 'openURL(" ")'") + (try "netscape '" "'&") + (try "netscape '" "'"))) + +;;@ define these as appropriate for your system. +(define slib:tab #\tab) +(define slib:form-feed #\page) + +;;@ Support for older versions of Scheme. Not enough code for its own file. +(define (last-pair l) (if (pair? (cdr l)) (last-pair (cdr l)) l)) +(define t #t) +(define nil #f) + +;;@ Define these if your implementation's syntax can support it and if +;;; they are not already defined. +(define (1+ n) (+ n 1)) +(define (-1+ n) (+ n -1)) +(define 1- -1+) + +;;@ Define SLIB:EXIT to be the implementation procedure to exit or +;;; return if exiting not supported. +(define slib:exit exit) + +;;@ Here for backward compatability +(define scheme-file-suffix + (let ((suffix (case (software-type) + ((NOSVE) "_scm") + (else ".scm")))) + (lambda () suffix))) + +;;@ (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever +;;; suffix all the module files in SLIB have. See feature 'SOURCE. +(define (slib:load-source f) (load (string-append f (scheme-file-suffix)))) + +;;@ (SLIB:LOAD-COMPILED "foo") should load the file that was produced +;;; by compiling "foo.scm" if this implementation can compile files. +;;; See feature 'COMPILED. +(define slib:load-compiled load) + +;;@ At this point SLIB:LOAD must be able to load SLIB files. +(define slib:load slib:load-source) + +;; If your implementation provides R4RS macros: +(define macro:eval slib:eval) +(define macro:load load) + +;@ +(define gentemp gensym) + +;@ +(define defmacro:load slib:load-source) + +(slib:load (in-vicinity (library-vicinity) "require")) diff --git a/slib.1 b/slib.1 index 4bb1424..aa548ba 100644 --- a/slib.1 +++ b/slib.1 @@ -5,7 +5,7 @@ SLIB \- Scheme Library .SH SYNOPSIS .B slib -[ scm | gsi | mzscheme | guile | slib48 | scheme48 | scmlit ] +[ scheme | scm | gsi | mzscheme | guile | scheme48 | scmlit | elk | sisc | kawa ] .br .sp 0.3 .SH DESCRIPTION diff --git a/slib.doc b/slib.doc index fb607f1..e42783e 100644 --- a/slib.doc +++ b/slib.doc @@ -6,18 +6,19 @@ NAME SLIB - Scheme Library SYNOPSIS - slib [ scm | gsi | mzscheme | guile | slib48 | scheme48 | scmlit ] + slib [ scheme | scm | gsi | mzscheme | guile | scheme48 | scmlit | elk + | sisc | kawa ] DESCRIPTION "SLIB" is a portable library for the programming language "Scheme". It - provides a platform independent framework for using "packages" of - Scheme procedures and syntax. As distributed, SLIB contains many use- - ful packages. Its catalog can be transparently extended to accomodate + provides a platform independent framework for using "packages" of + Scheme procedures and syntax. As distributed, SLIB contains many use- + ful packages. Its catalog can be transparently extended to accomodate packages specific to a site, implementation, user, or directory. OPTIONS - The optional argument to the slib script is the Scheme implementation - to run. Absent the argument, it searches for implementations in the + The optional argument to the slib script is the Scheme implementation + to run. Absent the argument, it searches for implementations in the above order. ENVIRONMENT VARIABLES @@ -35,8 +36,8 @@ SEE ALSO The SLIB home-page: 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 + The full documentation for slib is maintained as a Texinfo manual. If + the info and slib programs are properly installed at your site, the command info slib diff --git a/slib.info b/slib.info index 13c8d59..6535625 100644 --- a/slib.info +++ b/slib.info @@ -1,23 +1,18 @@ 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." | - | +This manual is for SLIB (version 3a5, November 2007), the portable | +Scheme library. + +Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, +2002, 2003, 2004, 2005, 2006, 2007 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, no Front-Cover Texts, and | + no Back-Cover Texts. A copy of the license is included in the | + section entitled "GNU Free Documentation License." | + INFO-DIR-SECTION The Algorithmic Language Scheme START-INFO-DIR-ENTRY * SLIB: (slib). Scheme Library @@ -25,27 +20,22 @@ END-INFO-DIR-ENTRY  File: slib.info, Node: Top, Next: The Library System, Prev: (dir), Up: (dir) - | -SLIB | -**** | -This manual is for SLIB (version 3a4, October 2006), the portable | -Scheme library. | +SLIB +**** -Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, | -2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. | +This manual is for SLIB (version 3a5, November 2007), the portable | +Scheme library. - 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." | +Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, +2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. | - (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." | + 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." | * Menu: @@ -65,13 +55,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. | - | +"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. @@ -149,8 +139,8 @@ The generalization of `provided?' for arbitrary features and catalog is (1) scheme-implementation-type is the name symbol of the running Scheme implementation (RScheme, |STk|, Bigloo, chez, Elk, gambit, -guile, JScheme, MacScheme, MITScheme, Pocket-Scheme, Scheme48, -Scheme->C, Scheme48, Scsh, T, umb-scheme, or Vscm). Dependence on +guile, JScheme, kawa, MacScheme, MITScheme, Pocket-Scheme, Scheme48, | +Scheme->C, Scheme48, Scsh, SISC, T, umb-scheme, or Vscm). Dependence on | scheme-implementation-type is almost always the wrong way to do things.  @@ -872,7 +862,7 @@ implementations. implementation and the name of the operating system. An unspecified value is returned. - (slib:report-version) => slib "3a4" on scm "5b1" on unix | + (slib:report-version) => slib "3a5" on scm "5b1" on unix | -- Function: slib:report Displays the information of `(slib:report-version)' followed by @@ -887,15 +877,15 @@ implementations. (slib:report) => - slib "3a4" on scm "5b1" on unix | + slib "3a5" 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 slib:features : | + loaded slib:features : trace alist qp sort common-list-functions macro values getopt compiled - implementation slib:features : | + implementation slib:features : bignum complex real rational inexact vicinity ed getenv tmpnam abort transcript with-file @@ -990,6 +980,19 @@ These procedures are provided by all implementations. omitted, in which case it defaults to the value returned by `(current-output-port)'. + -- Function: file-position port | + -- Function: file-position port #f | + PORT must be open to a file. `file-position' returns the current | + position of the character in PORT which will next be read or | + written. If the implementation does not support file-position, | + then `#f' is returned. | + | + -- Function: file-position port k | + PORT must be open to a file. `file-position' sets the current | + position in PORT which will next be read or written. If | + successful, `#f' is returned; otherwise `file-position' returns | + `#f'. | + | -- Function: output-port-width -- Function: output-port-width port Returns the width of PORT, which defaults to @@ -1058,21 +1061,21 @@ These procedures are provided by all implementations. If N is omitted or `#t', a success status is returned to the system (if possible). If N is `#f' a failure is returned to the system (if possible). If N is an integer, then N is returned to - the system (if possible). If the Scheme session cannot exit an - unspecified value is returned from `slib:exit'. + the system (if possible). If the Scheme session cannot exit, then | + an unspecified value is returned from `slib:exit'. | -- Function: browse-url url Web browsers have become so ubiquitous that programming languagues should support a uniform interface to them. - If a `netscape' browser is running, `browse-url' causes the - browser to display the page specified by string URL and returns #t. + If a browser is running, `browse-url' causes the browser to | + display the page specified by string URL and returns `#t'. | If the browser is not running, `browse-url' starts a browser displaying the argument URL. If the browser starts as a - background job, `browse-url' returns #t immediately; if the - browser starts as a foreground job, then `browse-url' returns #t - when the browser exits; otherwise it returns #f. + background job, `browse-url' returns `#t' immediately; if the | + browser starts as a foreground job, then `browse-url' returns `#t' | + when the browser exits; otherwise (if no browser) it returns `#f'. |  File: slib.info, Node: Miscellany, Prev: System, Up: Universal SLIB Procedures @@ -1092,16 +1095,7 @@ These procedures are provided by all implementations. => (foo bar) (map identity LST) == (copy-list LST) - - -- Function: expt n k - Returns N raised to the non-negative integer exponent K. - - Example: - (expt 2 5) - => 32 - (expt -3 3) - => -27 - + | 2.5.1 Mutual Exclusion ---------------------- @@ -1141,7 +1135,7 @@ Language changes: (r4rs)Notes.). They are provided by all SLIB implementations. -- Constant: t - Defined as `#t'. | + Defined as `#t'. -- Constant: nil Defined as `#f'. @@ -2141,6 +2135,12 @@ File: slib.info, Node: Binding to multiple values, Next: Guarded LET* special -- Special Form: receive formals expression body ... `http://srfi.schemers.org/srfi-8/srfi-8.html' + `(require 'let-values)' or `(require 'srfi-11)' | + | + -- Special Form: let-values ((formals expression) ...) body ... | + -- Special Form: let-values* ((formals expression) ...) body ... | + `http://srfi.schemers.org/srfi-11/srfi-11.html' | + |  File: slib.info, Node: Guarded LET* special form, Next: Guarded COND Clause, Prev: Binding to multiple values, Up: Scheme Syntax Extension Packages @@ -2479,6 +2479,7 @@ File: slib.info, Node: Textual Conversion Packages, Next: Mathematical Package * HTTP and CGI:: Serve WWW sites * Parsing HTML:: 'html-for-each * URI:: Uniform Resource Identifier +* Parsing XML:: 'parse-xml or 'ssax * Printing Scheme:: Nicely * Time and Date:: * NCBI-DNA:: DNA and protein sequences @@ -2548,9 +2549,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') 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 ---------- @@ -2646,7 +2647,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 symbol 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. @@ -2965,7 +2966,7 @@ File: slib.info, Node: Format, Next: Standard Formatted I/O, Prev: Precedence 4.2 Format (version 3.1) ======================== -`(require 'format)' +`(require 'format)' or `(require 'srfi-28)' | * Menu: @@ -4384,9 +4385,9 @@ currently uses 2 of these: * *unknown* -`batch.scm' uses 2 enhanced relational tables (*note Using Databases::) -to store information linking the names of `operating-system's to -`batch-dialect'es. +The `batch' module uses 2 enhanced relational tables (*note Using | +Databases::) to store information linking the names of | +`operating-system's to `batch-dialect'es. | -- Function: batch:initialize! database Defines `operating-system' and `batch-dialect' tables and adds the @@ -5073,8 +5074,8 @@ File: slib.info, Node: Parsing HTML, Next: URI, Prev: HTTP and CGI, Up: Text markup.  -File: slib.info, Node: URI, Next: Printing Scheme, Prev: Parsing HTML, Up: Textual Conversion Packages - +File: slib.info, Node: URI, Next: Parsing XML, Prev: Parsing HTML, Up: Textual Conversion Packages + | 4.10 URI ======== @@ -5203,9 +5204,820 @@ purpose. 3. remote-directory  -File: slib.info, Node: Printing Scheme, Next: Time and Date, Prev: URI, Up: Textual Conversion Packages - -4.11 Printing Scheme +File: slib.info, Node: Parsing XML, Next: Printing Scheme, Prev: URI, Up: Textual Conversion Packages + | +4.11 Parsing XML | +================ | + | +`(require 'xml-parse)' or `(require 'ssax)' | + | +The XML standard document referred to in this module is | +`http://www.w3.org/TR/1998/REC-xml-19980210.html'. | + | +The present frameworks fully supports the XML Namespaces Recommendation | +`http://www.w3.org/TR/REC-xml-names'. | + | +4.11.1 String Glue | +------------------ | + | + -- Function: ssax:reverse-collect-str list-of-frags | + Given the list of fragments (some of which are text strings), | + reverse the list and concatenate adjacent text strings. If | + LIST-OF-FRAGS has zero or one element, the result of the procedure | + is `equal?' to its argument. | + | + -- Function: ssax:reverse-collect-str-drop-ws list-of-frags | + Given the list of fragments (some of which are text strings), | + reverse the list and concatenate adjacent text strings while | + dropping "unsignificant" whitespace, that is, whitespace in front, | + behind and between elements. The whitespace that is included in | + character data is not affected. | + | + Use this procedure to "intelligently" drop "insignificant" | + whitespace in the parsed SXML. If the strict compliance with the | + XML Recommendation regarding the whitespace is desired, use the | + `ssax:reverse-collect-str' procedure instead. | + | +4.11.2 Character and Token Functions | +------------------------------------ | + | +The following functions either skip, or build and return tokens, | +according to inclusion or delimiting semantics. The list of characters | +to expect, include, or to break at may vary from one invocation of a | +function to another. This allows the functions to easily parse even | +context-sensitive languages. | + | + Exceptions are mentioned specifically. The list of expected | +characters (characters to skip until, or break-characters) may include | +an EOF "character", which is coded as symbol *eof* | + | + The input stream to parse is specified as a PORT, which is the last | +argument. | + | + -- Function: ssax:assert-current-char char-list string port | + Reads a character from the PORT and looks it up in the CHAR-LIST | + of expected characters. If the read character was found among | + expected, it is returned. Otherwise, the procedure writes a | + message using STRING as a comment and quits. | + | + -- Function: ssax:skip-while char-list port | + Reads characters from the PORT and disregards them, as long as they | + are mentioned in the CHAR-LIST. The first character (which may be | + EOF) peeked from the stream that is _not_ a member of the | + CHAR-LIST is returned. | + | + -- Function: ssax:init-buffer | + Returns an initial buffer for `ssax:next-token*' procedures. | + `ssax:init-buffer' may allocate a new buffer at each invocation. | + | + -- Function: ssax:next-token prefix-char-list break-char-list | + comment-string port | + Skips any number of the prefix characters (members of the | + PREFIX-CHAR-LIST), if any, and reads the sequence of characters up | + to (but not including) a break character, one of the | + BREAK-CHAR-LIST. | + | + The string of characters thus read is returned. The break | + character is left on the input stream. BREAK-CHAR-LIST may | + include the symbol `*eof*'; otherwise, EOF is fatal, generating an | + error message including a specified COMMENT-STRING. | + | +`ssax:next-token-of' is similar to `ssax:next-token' except that it | +implements an inclusion rather than delimiting semantics. | + | + -- Function: ssax:next-token-of inc-charset port | + Reads characters from the PORT that belong to the list of | + characters INC-CHARSET. The reading stops at the first character | + which is not a member of the set. This character is left on the | + stream. All the read characters are returned in a string. | + | + -- Function: ssax:next-token-of pred port | + Reads characters from the PORT for which PRED (a procedure of one | + argument) returns non-#f. The reading stops at the first | + character for which PRED returns #f. That character is left on | + the stream. All the results of evaluating of PRED up to #f are | + returned in a string. | + | + PRED is a procedure that takes one argument (a character or the | + EOF object) and returns a character or #f. The returned character | + does not have to be the same as the input argument to the PRED. | + For example, | + | + (ssax:next-token-of (lambda (c) | + (cond ((eof-object? c) #f) | + ((char-alphabetic? c) (char-downcase c)) + (else #f))) | + (current-input-port)) | + | + will try to read an alphabetic token from the current input port, | + and return it in lower case. | + | + -- Function: ssax:read-string len port | + Reads LEN characters from the PORT, and returns them in a string. | + If EOF is encountered before LEN characters are read, a shorter | + string will be returned. | + | +4.11.3 Data Types | +----------------- | + | +`TAG-KIND' | + A symbol `START', `END', `PI', `DECL', `COMMENT', `CDSECT', or | + `ENTITY-REF' that identifies a markup token | + | +`UNRES-NAME' | + a name (called GI in the XML Recommendation) as given in an XML | + document for a markup token: start-tag, PI target, attribute name. | + If a GI is an NCName, UNRES-NAME is this NCName converted into a | + Scheme symbol. If a GI is a QName, `UNRES-NAME' is a pair of | + symbols: `(PREFIX . LOCALPART)'. | + | +`RES-NAME' | + An expanded name, a resolved version of an `UNRES-NAME'. For an | + element or an attribute name with a non-empty namespace URI, | + `RES-NAME' is a pair of symbols, `(URI-SYMB . LOCALPART)'. | + Otherwise, it's a single symbol. | + | +`ELEM-CONTENT-MODEL' | + A symbol: | + `ANY' | + anything goes, expect an END tag. | + | + `EMPTY-TAG' | + no content, and no END-tag is coming | + | + `EMPTY' | + no content, expect the END-tag as the next token | + | + `PCDATA' | + expect character data only, and no children elements | + | + `MIXED' | + | + `ELEM-CONTENT' | + | +`URI-SYMB' | + A symbol representing a namespace URI - or other symbol chosen by | + the user to represent URI. In the former case, `URI-SYMB' is | + created by %-quoting of bad URI characters and converting the | + resulting string into a symbol. | + | +`NAMESPACES' | + A list representing namespaces in effect. An element of the list | + has one of the following forms: | + | + `(PREFIX URI-SYMB . URI-SYMB) or' | + | + `(PREFIX USER-PREFIX . URI-SYMB)' | + USER-PREFIX is a symbol chosen by the user to represent the | + URI. | + | + `(#f USER-PREFIX . URI-SYMB)' | + Specification of the user-chosen prefix and a URI-SYMBOL. | + | + `(*DEFAULT* USER-PREFIX . URI-SYMB)' | + Declaration of the default namespace | + | + `(*DEFAULT* #f . #f)' | + Un-declaration of the default namespace. This notation | + represents overriding of the previous declaration | + | + | + A NAMESPACES list may contain several elements for the same PREFIX. | + The one closest to the beginning of the list takes effect. | + | +`ATTLIST' | + An ordered collection of (NAME . VALUE) pairs, where NAME is a | + RES-NAME or an UNRES-NAME. The collection is an ADT. | + | +`STR-HANDLER' | + A procedure of three arguments: STRING1 STRING2 SEED returning a | + new SEED. The procedure is supposed to handle a chunk of | + character data STRING1 followed by a chunk of character data | + STRING2. STRING2 is a short string, often `"\n"' and even `""'. | + | +`ENTITIES' | + An assoc list of pairs: | + (NAMED-ENTITY-NAME . NAMED-ENTITY-BODY) | + | + where NAMED-ENTITY-NAME is a symbol under which the entity was | + declared, NAMED-ENTITY-BODY is either a string, or (for an | + external entity) a thunk that will return an input port (from which | + the entity can be read). NAMED-ENTITY-BODY may also be #f. This | + is an indication that a NAMED-ENTITY-NAME is currently being | + expanded. A reference to this NAMED-ENTITY-NAME will be an error: | + violation of the WFC nonrecursion. | + | +`XML-TOKEN' | + This record represents a markup, which is, according to the XML | + Recommendation, "takes the form of start-tags, end-tags, | + empty-element tags, entity references, character references, | + comments, CDATA section delimiters, document type declarations, and | + processing instructions." | + | + kind | + a TAG-KIND | + | + head | + an UNRES-NAME. For XML-TOKENs of kinds 'COMMENT and 'CDSECT, | + the head is #f. | + | + For example, | +

=> kind=START, head=P | +

=> kind=END, head=P | +
=> kind=EMPTY-EL, head=BR | + => kind=DECL, head=DOCTYPE | + => kind=PI, head=xml | + &my-ent; => kind=ENTITY-REF, head=my-ent | + | + Character references are not represented by xml-tokens as these | + references are transparently resolved into the corresponding | + characters. | + | +`XML-DECL' | + The record represents a datatype of an XML document: the list of | + declared elements and their attributes, declared notations, list of | + replacement strings or loading procedures for parsed general | + entities, etc. Normally an XML-DECL record is created from a DTD | + or an XML Schema, although it can be created and filled in in many | + other ways (e.g., loaded from a file). | + | + ELEMS | + an (assoc) list of decl-elem or #f. The latter instructs the | + parser to do no validation of elements and attributes. | + | + DECL-ELEM | + declaration of one element: | + | + `(ELEM-NAME ELEM-CONTENT DECL-ATTRS)' | + | + ELEM-NAME is an UNRES-NAME for the element. | + | + ELEM-CONTENT is an ELEM-CONTENT-MODEL. | + | + DECL-ATTRS is an `ATTLIST', of `(ATTR-NAME . VALUE)' | + associations. | + | + This element can declare a user procedure to handle parsing | + of an element (e.g., to do a custom validation, or to build a | + hash of IDs as they're encountered). | + | + DECL-ATTR | + an element of an `ATTLIST', declaration of one attribute: | + | + `(ATTR-NAME CONTENT-TYPE USE-TYPE DEFAULT-VALUE)' | + | + ATTR-NAME is an UNRES-NAME for the declared attribute. | + | + CONTENT-TYPE is a symbol: `CDATA', `NMTOKEN', `NMTOKENS', ... | + or a list of strings for the enumerated type. | + | + USE-TYPE is a symbol: `REQUIRED', `IMPLIED', or `FIXED'. | + | + DEFAULT-VALUE is a string for the default value, or #f if not | + given. | + | + | + | +4.11.4 Low-Level Parsers and Scanners | +------------------------------------- | + | +These procedures deal with primitive lexical units (Names, whitespaces, | +tags) and with pieces of more generic productions. Most of these | +parsers must be called in appropriate context. For example, | +`ssax:complete-start-tag' must be called only when the start-tag has | +been detected and its GI has been read. | + | + -- Function: ssax:skip-s port | + Skip the S (whitespace) production as defined by | + [3] S ::= (#x20 | #x09 | #x0D | #x0A) | + | + `ssax:skip-s' returns the first not-whitespace character it | + encounters while scanning the PORT. This character is left on the | + input stream. | + | + -- Function: ssax:read-ncname port | + Read a NCName starting from the current position in the PORT and | + return it as a symbol. | + | + [4] NameChar ::= Letter | Digit | '.' | '-' | '_' | ':' | + | CombiningChar | Extender | + [5] Name ::= (Letter | '_' | ':') (NameChar)* | + | + This code supports the XML Namespace Recommendation REC-xml-names, | + which modifies the above productions as follows: | + | + [4] NCNameChar ::= Letter | Digit | '.' | '-' | '_' | + | CombiningChar | Extender | + [5] NCName ::= (Letter | '_') (NCNameChar)* | + | + As the Rec-xml-names says, | + | + "An XML document conforms to this specification if all other | + tokens [other than element types and attribute names] in the | + document which are required, for XML conformance, to match | + the XML production for Name, match this specification's | + production for NCName." | + | + Element types and attribute names must match the production QName, | + defined below. | + | + -- Function: ssax:read-qname port | + Read a (namespace-) Qualified Name, QName, from the current | + position in PORT; and return an UNRES-NAME. | + | + From REC-xml-names: | + [6] QName ::= (Prefix ':')? LocalPart | + [7] Prefix ::= NCName | + [8] LocalPart ::= NCName | + | + -- Function: ssax:read-markup-token port | + This procedure starts parsing of a markup token. The current | + position in the stream must be `<'. This procedure scans enough | + of the input stream to figure out what kind of a markup token it | + is seeing. The procedure returns an XML-TOKEN structure | + describing the token. Note, generally reading of the current | + markup is not finished! In particular, no attributes of the | + start-tag token are scanned. | + | + Here's a detailed break out of the return values and the position | + in the PORT when that particular value is returned: | + | + PI-token | + only PI-target is read. To finish the Processing-Instruction | + and disregard it, call `ssax:skip-pi'. `ssax:read-attributes' | + may be useful as well (for PIs whose content is | + attribute-value pairs). | + | + END-token | + The end tag is read completely; the current position is right | + after the terminating `>' character. | + | + COMMENT | + is read and skipped completely. The current position is | + right after `-->' that terminates the comment. | + | + CDSECT | + The current position is right after `' combination that terminates PI. | + | + [16] PI ::= '' Char*)))? '?>' | + | + -- Function: ssax:skip-internal-dtd port | + The current pos in the port is inside an internal DTD subset (e.g., | + after reading `#\[' that begins an internal DTD subset) Skip until | + the `]>' combination that terminates this DTD. | + | + -- Function: ssax:read-cdata-body port str-handler seed | + This procedure must be called after we have read a string | + `' combination is the end of the CDATA section. `>' is | + treated as an embedded `>' character. | + | + * `<' and `&' are not specially recognized (and are not | + expanded)! | + | + | + -- Function: ssax:read-char-ref port | + [66] CharRef ::= '&#' [0-9]+ ';' | + | '&#x' [0-9a-fA-F]+ ';' | + | + This procedure must be called after we we have read `&#' that | + introduces a char reference. The procedure reads this reference | + and returns the corresponding char. The current position in PORT | + will be after the `;' that terminates the char reference. | + | + Faults detected: | + WFC: XML-Spec.html#wf-Legalchar | + | + According to Section `4.1 Character and Entity References' of the | + XML Recommendation: | + | + "[Definition: A character reference refers to a specific | + character in the ISO/IEC 10646 character set, for example one | + not directly accessible from available input devices.]" | + | + | + -- Function: ssax:handle-parsed-entity port name entities | + content-handler str-handler seed | + Expands and handles a parsed-entity reference. | + | + NAME is a symbol, the name of the parsed entity to expand. | + CONTENT-HANDLER is a procedure of arguments PORT, ENTITIES, and | + SEED that returns a seed. STR-HANDLER is called if the entity in | + question is a pre-declared entity. | + | + `ssax:handle-parsed-entity' returns the result returned by | + CONTENT-HANDLER or STR-HANDLER. | + | + Faults detected: | + WFC: XML-Spec.html#wf-entdeclared | + WFC: XML-Spec.html#norecursion | + | + -- Function: attlist-add attlist name-value | + Add a NAME-VALUE pair to the existing ATTLIST, preserving its | + sorted ascending order; and return the new list. Return #f if a | + pair with the same name already exists in ATTLIST | + | + -- Function: attlist-remove-top attlist | + Given an non-null ATTLIST, return a pair of values: the top and | + the rest. | + | + -- Function: ssax:read-attributes port entities | + This procedure reads and parses a production "Attribute". | + | + [41] Attribute ::= Name Eq AttValue | + [10] AttValue ::= '"' ([^<&"] | Reference)* '"' | + | "'" ([^<&'] | Reference)* "'" | + [25] Eq ::= S? '=' S? | + | + The procedure returns an ATTLIST, of Name (as UNRES-NAME), Value | + (as string) pairs. The current character on the PORT is a | + non-whitespace character that is not an NCName-starting character. | + | + Note the following rules to keep in mind when reading an | + "AttValue": | + | + Before the value of an attribute is passed to the application | + or checked for validity, the XML processor must normalize it | + as follows: | + | + * A character reference is processed by appending the | + referenced character to the attribute value. | + | + * An entity reference is processed by recursively | + processing the replacement text of the entity. The | + named entities `amp', `lt', `gt', `quot', and `apos' are | + pre-declared. | + | + * A whitespace character (#x20, #x0D, #x0A, #x09) is | + processed by appending #x20 to the normalized value, | + except that only a single #x20 is appended for a | + "#x0D#x0A" sequence that is part of an external parsed | + entity or the literal entity value of an internal parsed | + entity. | + | + * Other characters are processed by appending them to the | + normalized value. | + | + | + | + Faults detected: | + WFC: XML-Spec.html#CleanAttrVals | + WFC: XML-Spec.html#uniqattspec | + | + -- Function: ssax:resolve-name port unres-name namespaces | + apply-default-ns? | + Convert an UNRES-NAME to a RES-NAME, given the appropriate | + NAMESPACES declarations. The last parameter, APPLY-DEFAULT-NS?, | + determines if the default namespace applies (for instance, it does | + not for attribute names). | + | + Per REC-xml-names/#nsc-NSDeclared, the "xml" prefix is considered | + pre-declared and bound to the namespace name | + "http://www.w3.org/XML/1998/namespace". | + | + `ssax:resolve-name' tests for the namespace constraints: | + `http://www.w3.org/TR/REC-xml-names/#nsc-NSDeclared' | + | + -- Function: ssax:complete-start-tag tag port elems entities namespaces | + Complete parsing of a start-tag markup. `ssax:complete-start-tag' | + must be called after the start tag token has been read. TAG is an | + UNRES-NAME. ELEMS is an instance of the ELEMS slot of XML-DECL; | + it can be #f to tell the function to do _no_ validation of | + elements and their attributes. | + | + `ssax:complete-start-tag' returns several values: | + * ELEM-GI: a RES-NAME. | + | + * ATTRIBUTES: element's attributes, an ATTLIST of (RES-NAME . | + STRING) pairs. The list does NOT include xmlns attributes. | + | + * NAMESPACES: the input list of namespaces amended with | + namespace (re-)declarations contained within the start-tag | + under parsing | + | + * ELEM-CONTENT-MODEL | + | + On exit, the current position in PORT will be the first character | + after `>' that terminates the start-tag markup. | + | + Faults detected: | + VC: XML-Spec.html#enum | + VC: XML-Spec.html#RequiredAttr | + VC: XML-Spec.html#FixedAttr | + VC: XML-Spec.html#ValueType | + WFC: XML-Spec.html#uniqattspec (after namespaces prefixes are | + resolved) | + VC: XML-Spec.html#elementvalid | + WFC: REC-xml-names/#dt-NSName | + | + _Note_: although XML Recommendation does not explicitly say it, | + xmlns and xmlns: attributes don't have to be declared (although | + they can be declared, to specify their default value). | + | + -- Function: ssax:read-external-id port | + Parses an ExternalID production: | + | + [75] ExternalID ::= 'SYSTEM' S SystemLiteral | + | 'PUBLIC' S PubidLiteral S SystemLiteral | + [11] SystemLiteral ::= ('"' [^"]* '"') | ("'" [^']* "'") | + [12] PubidLiteral ::= '"' PubidChar* '"' | + | "'" (PubidChar - "'")* "'" | + [13] PubidChar ::= #x20 | #x0D | #x0A | [a-zA-Z0-9] | + | [-'()+,./:=?;!*#@$_%] | + | + Call `ssax:read-external-id' when an ExternalID is expected; that | + is, the current character must be either #\S or #\P that starts | + correspondingly a SYSTEM or PUBLIC token. `ssax:read-external-id' | + returns the SYSTEMLITERAL as a string. A PUBIDLITERAL is | + disregarded if present. | + | +4.11.5 Mid-Level Parsers and Scanners | +------------------------------------- | + | +These procedures parse productions corresponding to the whole | +(document) entity or its higher-level pieces (prolog, root element, | +etc). | + | + -- Function: ssax:scan-misc port | + Scan the Misc production in the context: | + | + [1] document ::= prolog element Misc* | + [22] prolog ::= XMLDecl? Misc* (doctypedec l Misc*)? | + [27] Misc ::= Comment | PI | S | + | + Call `ssax:scan-misc' in the prolog or epilog contexts. In these | + contexts, whitespaces are completely ignored. The return value | + from `ssax:scan-misc' is either a PI-token, a DECL-token, a START | + token, or *EOF*. Comments are ignored and not reported. | + | + -- Function: ssax:read-char-data port expect-eof? str-handler iseed | + Read the character content of an XML document or an XML element. | + | + [43] content ::= | + (element | CharData | Reference | CDSect | PI | Comment)* | + | + To be more precise, `ssax:read-char-data' reads CharData, expands | + CDSect and character entities, and skips comments. | + `ssax:read-char-data' stops at a named reference, EOF, at the | + beginning of a PI, or a start/end tag. | + | + EXPECT-EOF? is a boolean indicating if EOF is normal; i.e., the | + character data may be terminated by the EOF. EOF is normal while | + processing a parsed entity. | + | + ISEED is an argument passed to the first invocation of STR-HANDLER. | + | + `ssax:read-char-data' returns two results: SEED and TOKEN. The | + SEED is the result of the last invocation of STR-HANDLER, or the | + original ISEED if STR-HANDLER was never called. | + | + TOKEN can be either an eof-object (this can happen only if | + EXPECT-EOF? was #t), or: | + * an xml-token describing a START tag or an END-tag; For a | + start token, the caller has to finish reading it. | + | + * an xml-token describing the beginning of a PI. It's up to an | + application to read or skip through the rest of this PI; | + | + * an xml-token describing a named entity reference. | + | + | + CDATA sections and character references are expanded inline and | + never returned. Comments are silently disregarded. | + | + As the XML Recommendation requires, all whitespace in character | + data must be preserved. However, a CR character (#x0D) must be | + disregarded if it appears before a LF character (#x0A), or replaced | + by a #x0A character otherwise. See Secs. 2.10 and 2.11 of the XML | + Recommendation. See also the canonical XML Recommendation. | + | + -- Function: ssax:assert-token token kind gi error-cont | + Make sure that TOKEN is of anticipated KIND and has anticipated | + GI. Note that the GI argument may actually be a pair of two | + symbols, Namespace-URI or the prefix, and of the localname. If | + the assertion fails, ERROR-CONT is evaluated by passing it three | + arguments: TOKEN KIND GI. The result of ERROR-CONT is returned. | + | +4.11.6 High-level Parsers | +------------------------- | + | +These procedures are to instantiate a SSAX parser. A user can | +instantiate the parser to do the full validation, or no validation, or | +any particular validation. The user specifies which PI he wants to be | +notified about. The user tells what to do with the parsed character | +and element data. The latter handlers determine if the parsing follows | +a SAX or a DOM model. | + | + -- Function: ssax:make-pi-parser my-pi-handlers | + Create a parser to parse and process one Processing Element (PI). | + | + MY-PI-HANDLERS is an association list of pairs `(PI-TAG . | + PI-HANDLER)' where PI-TAG is an NCName symbol, the PI target; and | + PI-HANDLER is a procedure taking arguments PORT, PI-TAG, and SEED. | + | + PI-HANDLER should read the rest of the PI up to and including the | + combination `?>' that terminates the PI. The handler should | + return a new seed. One of the PI-TAGs may be the symbol | + `*DEFAULT*'. The corresponding handler will handle PIs that no | + other handler will. If the *DEFAULT* PI-TAG is not specified, | + `ssax:make-pi-parser' will assume the default handler that skips | + the body of the PI. | + | + `ssax:make-pi-parser' returns a procedure of arguments PORT, | + PI-TAG, and SEED; that will parse the current PI according to | + MY-PI-HANDLERS. | + | + -- Function: ssax:make-elem-parser my-new-level-seed my-finish-element | + my-char-data-handler my-pi-handlers | + Create a parser to parse and process one element, including its | + character content or children elements. The parser is typically | + applied to the root element of a document. | + | + MY-NEW-LEVEL-SEED | + is a procedure taking arguments: | + | + ELEM-GI ATTRIBUTES NAMESPACES EXPECTED-CONTENT SEED | + | + where ELEM-GI is a RES-NAME of the element about to be | + processed. | + | + MY-NEW-LEVEL-SEED is to generate the seed to be passed to | + handlers that process the content of the element. | + | + MY-FINISH-ELEMENT | + is a procedure taking arguments: | + | + ELEM-GI ATTRIBUTES NAMESPACES PARENT-SEED SEED | + | + MY-FINISH-ELEMENT is called when parsing of ELEM-GI is | + finished. The SEED is the result from the last content | + parser (or from MY-NEW-LEVEL-SEED if the element has the | + empty content). PARENT-SEED is the same seed as was passed | + to MY-NEW-LEVEL-SEED. MY-FINISH-ELEMENT is to generate a | + seed that will be the result of the element parser. | + | + MY-CHAR-DATA-HANDLER | + is a STR-HANDLER as described in Data Types above. | + | + MY-PI-HANDLERS | + is as described for `ssax:make-pi-handler' above. | + | + | + The generated parser is a procedure taking arguments: | + | + START-TAG-HEAD PORT ELEMS ENTITIES NAMESPACES PRESERVE-WS? SEED | + | + The procedure must be called after the start tag token has been | + read. START-TAG-HEAD is an UNRES-NAME from the start-element tag. | + ELEMS is an instance of ELEMS slot of XML-DECL. | + | + Faults detected: | + VC: XML-Spec.html#elementvalid | + WFC: XML-Spec.html#GIMatch | + | + -- Function: ssax:make-parser user-handler-tag user-handler ... | + Create an XML parser, an instance of the XML parsing framework. | + This will be a SAX, a DOM, or a specialized parser depending on the | + supplied user-handlers. | + | + `ssax:make-parser' takes an even number of arguments; | + USER-HANDLER-TAG is a symbol that identifies a procedure (or | + association list for `PROCESSING-INSTRUCTIONS') (USER-HANDLER) | + that follows the tag. Given below are tags and signatures of the | + corresponding procedures. Not all tags have to be specified. If | + some are omitted, reasonable defaults will apply. | + | + `DOCTYPE' | + handler-procedure: PORT DOCNAME SYSTEMID INTERNAL-SUBSET? SEED | + | + If INTERNAL-SUBSET? is #t, the current position in the port is | + right after we have read `[' that begins the internal DTD | + subset. We must finish reading of this subset before we | + return (or must call `skip-internal-dtd' if we aren't | + interested in reading it). PORT at exit must be at the first | + symbol after the whole DOCTYPE declaration. | + | + The handler-procedure must generate four values: | + | + ELEMS ENTITIES NAMESPACES SEED | + | + ELEMS is as defined for the ELEMS slot of XML-DECL. It may be | + #f to switch off validation. NAMESPACES will typically | + contain USER-PREFIXes for selected URI-SYMBs. The default | + handler-procedure skips the internal subset, if any, and | + returns `(values #f '() '() seed)'. | + | + `UNDECL-ROOT' | + procedure: ELEM-GI SEED | + | + where ELEM-GI is an UNRES-NAME of the root element. This | + procedure is called when an XML document under parsing | + contains _no_ DOCTYPE declaration. | + | + The handler-procedure, as a DOCTYPE handler procedure above, | + must generate four values: | + | + ELEMS ENTITIES NAMESPACES SEED | + | + The default handler-procedure returns (values #f '() '() seed) | + | + `DECL-ROOT' | + procedure: ELEM-GI SEED | + | + where ELEM-GI is an UNRES-NAME of the root element. This | + procedure is called when an XML document under parsing does | + contains the DOCTYPE declaration. The handler-procedure must | + generate a new SEED (and verify that the name of the root | + element matches the doctype, if the handler so wishes). The | + default handler-procedure is the identity function. | + | + `NEW-LEVEL-SEED' | + procedure: see ssax:make-elem-parser, my-new-level-seed | + | + `FINISH-ELEMENT' | + procedure: see ssax:make-elem-parser, my-finish-element | + | + `CHAR-DATA-HANDLER' | + procedure: see ssax:make-elem-parser, my-char-data-handler | + | + `PROCESSING-INSTRUCTIONS' | + association list as is passed to `ssax:make-pi-parser'. The | + default value is '() | + | + | + The generated parser is a procedure of arguments PORT and SEED. | + | + This procedure parses the document prolog and then exits to an | + element parser (created by `ssax:make-elem-parser') to handle the | + rest. | + | + [1] document ::= prolog element Misc* | + [22] prolog ::= XMLDecl? Misc* (doctypedec | Misc*)? | + [27] Misc ::= Comment | PI | S | + [28] doctypedecl ::= '' | + [29] markupdecl ::= elementdecl | AttlistDecl | + | EntityDecl | + | NotationDecl | PI | + | Comment | + | +4.11.7 Parsing XML to SXML | +-------------------------- | + | + -- Function: ssax:xml->sxml port namespace-prefix-assig | + This is an instance of the SSAX parser that returns an SXML | + representation of the XML document to be read from PORT. | + NAMESPACE-PREFIX-ASSIG is a list of `(USER-PREFIX . URI-STRING)' | + that assigns USER-PREFIXes to certain namespaces identified by | + particular URI-STRINGs. It may be an empty list. | + `ssax:xml->sxml' returns an SXML tree. The port points out to the | + first character after the root element. | + | + +File: slib.info, Node: Printing Scheme, Next: Time and Date, Prev: Parsing XML, Up: Textual Conversion Packages + | +4.12 Printing Scheme | ==================== * Menu: @@ -5217,7 +6029,7 @@ File: slib.info, Node: Printing Scheme, Next: Time and Date, Prev: URI, Up:  File: slib.info, Node: Generic-Write, Next: Object-To-String, Prev: Printing Scheme, Up: Printing Scheme -4.11.1 Generic-Write +4.12.1 Generic-Write | -------------------- `(require 'generic-write)' @@ -5260,7 +6072,7 @@ printing, output to a string and truncated output.  File: slib.info, Node: Object-To-String, Next: Pretty-Print, Prev: Generic-Write, Up: Printing Scheme -4.11.2 Object-To-String +4.12.2 Object-To-String | ----------------------- `(require 'object->string)' @@ -5275,7 +6087,7 @@ File: slib.info, Node: Object-To-String, Next: Pretty-Print, Prev: Generic-Wr  File: slib.info, Node: Pretty-Print, Prev: Object-To-String, Up: Printing Scheme -4.11.3 Pretty-Print +4.12.3 Pretty-Print | ------------------- `(require 'pretty-print)' @@ -5366,7 +6178,7 @@ thus can reduce loading time. The following will write into  File: slib.info, Node: Time and Date, Next: NCBI-DNA, Prev: Printing Scheme, Up: Textual Conversion Packages -4.12 Time and Date +4.13 Time and Date | ================== * Menu: @@ -5399,7 +6211,7 @@ Scheme datatypes.  File: slib.info, Node: Time Zone, Next: Posix Time, Prev: Time and Date, Up: Time and Date -4.12.1 Time Zone +4.13.1 Time Zone | ---------------- (require 'time-zone) @@ -5526,7 +6338,7 @@ compatability. Because of shared state they are not thread-safe.  File: slib.info, Node: Posix Time, Next: Common-Lisp Time, Prev: Time Zone, Up: Time and Date -4.12.2 Posix Time +4.13.2 Posix Time | ----------------- (require 'posix-time) @@ -5598,7 +6410,7 @@ File: slib.info, Node: Posix Time, Next: Common-Lisp Time, Prev: Time Zone,  File: slib.info, Node: Common-Lisp Time, Next: Time Infrastructure, Prev: Posix Time, Up: Time and Date -4.12.3 Common-Lisp Time +4.13.3 Common-Lisp Time | ----------------------- -- Function: get-decoded-time @@ -5648,7 +6460,7 @@ File: slib.info, Node: Common-Lisp Time, Next: Time Infrastructure, Prev: Pos  File: slib.info, Node: Time Infrastructure, Prev: Common-Lisp Time, Up: Time and Date -4.12.4 Time Infrastructure +4.13.4 Time Infrastructure | -------------------------- `(require 'time-core)' @@ -5664,9 +6476,11 @@ File: slib.info, Node: Time Infrastructure, Prev: Common-Lisp Time, Up: Time  File: slib.info, Node: NCBI-DNA, Next: Schmooz, Prev: Time and Date, Up: Textual Conversion Packages -4.13 NCBI-DNA +4.14 NCBI-DNA | ============= +`(require 'ncbi-dma)' | + | -- Function: ncbi:read-dna-sequence port Reads the NCBI-format DNA sequence following the word `ORIGIN' from PORT. @@ -5705,7 +6519,7 @@ sequence with the `BASE COUNT' line preceding the sequence from NCBI.  File: slib.info, Node: Schmooz, Prev: NCBI-DNA, Up: Textual Conversion Packages -4.14 Schmooz +4.15 Schmooz | ============ "Schmooz" is a simple, lightweight markup language for interspersing @@ -5811,11 +6625,11 @@ File: slib.info, Node: Mathematical Packages, Next: Database Packages, Prev: * Bit-Twiddling:: 'logical * Modular Arithmetic:: 'modular -* Irrational Integer Functions:: | -* Irrational Real Functions:: | +* Irrational Integer Functions:: +* Irrational Real Functions:: * Prime Numbers:: 'factor * Random Numbers:: 'random -* Discrete Fourier Transform:: 'dft | +* Discrete Fourier Transform:: 'dft * Cyclic Checksum:: 'crc * Graphing:: * Solid Modeling:: VRML97 @@ -5832,7 +6646,7 @@ File: slib.info, Node: Bit-Twiddling, Next: Modular Arithmetic, Prev: Mathema 5.1 Bit-Twiddling ================= -`(require 'logical)' or `(require 'srfi-60)' | +`(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 @@ -5898,8 +6712,7 @@ representation. 5.1.2 Integer Properties ------------------------ - -- Function: logcount n - -- Function: bit-count n + -- Function: logcount n | Returns the number of bits in integer N. If integer is positive, the 1-bits in its binary representation are counted. If negative, the 0-bits in its two's-complement binary representation are @@ -5913,6 +6726,17 @@ representation. (logcount -2) => 1 +On `discuss@r6rs.org' Ben Harris credits Simon Tatham with the idea to | +have `bitwise-bit-count' return a negative count for negative inputs. | +Alan Bawden came up with the succinct invariant. | + | + -- Function: bitwise-bit-count n | + If N is non-negative, this procedure returns the number of 1 bits | + in the two's-complement representation of N. Otherwise it returns | + the result of the following computation: | + | + (bitwise-not (bitwise-bit-count (bitwise-not N))) | + | -- Function: integer-length n Returns the number of bits neccessary to represent N. @@ -6059,44 +6883,44 @@ representation.  File: slib.info, Node: Modular Arithmetic, Next: Irrational Integer Functions, Prev: Bit-Twiddling, Up: Mathematical Packages - | + 5.2 Modular Arithmetic ====================== `(require 'modular)' - | + -- Function: extended-euclid n1 n2 Returns a list of 3 integers `(d x y)' such that d = gcd(N1, N2) = N1 * x + N2 * y. - -- Function: symmetric:modulus 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: 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: modular:characteristic 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 (modular:characteristic 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?' - Integers mod MODULUS. 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. -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) | +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. @@ -6128,150 +6952,150 @@ If all the arguments are fixnums the computation will use only fixnums.  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. | - | + +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. | - | - | + +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 | + +5.5 Prime Numbers ================= `(require 'factor)' @@ -6315,8 +7139,8 @@ the Solovay-Strassen primality test. See  File: slib.info, Node: Random Numbers, Next: Discrete Fourier Transform, Prev: Prime Numbers, Up: Mathematical Packages - | -5.6 Random Numbers | + +5.6 Random Numbers ================== A pseudo-random number generator is only as good as the tests it passes. @@ -6338,7 +7162,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.6.1 Exact Random Numbers | +5.6.1 Exact Random Numbers -------------------------- `(require 'random)' @@ -6390,7 +7214,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.6.2 Inexact Random Numbers | +5.6.2 Inexact Random Numbers ---------------------------- `(require 'random-inexact)' @@ -6435,57 +7259,57 @@ File: slib.info, Node: Inexact Random Numbers, Prev: Exact Random Numbers, Up  File: slib.info, Node: Discrete Fourier Transform, Next: Cyclic Checksum, Prev: Random Numbers, Up: Mathematical Packages - | -5.7 Discrete Fourier Transform | -============================== | -`(require 'dft)' or `(require 'Fourier-transform)' | +5.7 Discrete 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 | +`(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 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 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 prot -- Function: fft-1 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. | + 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. @@ -6501,8 +7325,8 @@ best method for decimating each dimension. |  File: slib.info, Node: Cyclic Checksum, Next: Graphing, Prev: Discrete Fourier Transform, Up: Mathematical Packages - | -5.8 Cyclic Checksum | + +5.8 Cyclic Checksum =================== `(require 'crc)' Cyclic Redundancy Checks using Galois field GF(2) @@ -6690,7 +7514,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.9 Graphing | +5.9 Graphing ============ * Menu: @@ -6701,7 +7525,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.9.1 Character Plotting | +5.9.1 Character Plotting ------------------------ `(require 'charplot)' @@ -6814,7 +7638,7 @@ File: slib.info, Node: Character Plotting, Next: PostScript Graphing, Prev: G  File: slib.info, Node: PostScript Graphing, Prev: Character Plotting, Up: Graphing -5.9.2 PostScript Graphing | +5.9.2 PostScript Graphing ------------------------- `(require 'eps-graph)' @@ -6865,7 +7689,7 @@ first ELT argument to the last.  File: slib.info, Node: Column Ranges, Next: Drawing the Graph, Prev: PostScript Graphing, Up: PostScript Graphing -5.9.2.1 Column Ranges | +5.9.2.1 Column Ranges ..................... A "range" is a list of two numbers, the minimum and the maximum. Ranges @@ -6906,7 +7730,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.9.2.2 Drawing the Graph | +5.9.2.2 Drawing the Graph ......................... -- Function: plot-column array x-column y-column proc3s @@ -6964,7 +7788,7 @@ The glyphs and drawing styles available are:  File: slib.info, Node: Graphics Context, Next: Rectangles, Prev: Drawing the Graph, Up: PostScript Graphing -5.9.2.3 Graphics Context | +5.9.2.3 Graphics Context ........................ -- Function: in-graphic-context arg ... @@ -7017,7 +7841,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.9.2.4 Rectangles | +5.9.2.4 Rectangles .................. A "rectangle" is a list of 4 numbers; the first two elements are the x @@ -7057,7 +7881,7 @@ elements are the width and height of the rectangle.  File: slib.info, Node: Legending, Next: Legacy Plotting, Prev: Rectangles, Up: PostScript Graphing -5.9.2.5 Legending | +5.9.2.5 Legending ................. -- Function: title-top title subtitle @@ -7093,13 +7917,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 y-coord text tick-height | - Draws a horizontal ruler with Y coordinate Y-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 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. | + 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. @@ -7118,7 +7942,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.9.2.6 Legacy Plotting | +5.9.2.6 Legacy Plotting ....................... -- Variable: graph:dimensions @@ -7145,7 +7969,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.9.2.7 Example Graph | +5.9.2.7 Example Graph ..................... The file `am1.5.html', a table of solar irradiance, is fetched with @@ -7247,8 +8071,8 @@ scales.  File: slib.info, Node: Solid Modeling, Next: Color, Prev: Graphing, Up: Mathematical Packages -5.10 Solid Modeling | -=================== | +5.10 Solid Modeling +=================== `(require 'solid)' @@ -7458,11 +8282,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: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 @@ -7519,15 +8343,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: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 @@ -7683,8 +8507,8 @@ Spatial Transformations  File: slib.info, Node: Color, Next: Root Finding, Prev: Solid Modeling, Up: Mathematical Packages -5.11 Color | -========== | +5.11 Color +========== `http://swiss.csail.mit.edu/~jaffer/Color' @@ -7706,8 +8530,8 @@ encountered in practice and the literature.  File: slib.info, Node: Color Data-Type, Next: Color Spaces, Prev: Color, Up: Color -5.11.1 Color Data-Type | ----------------------- | +5.11.1 Color Data-Type +---------------------- `(require 'color)' @@ -7761,8 +8585,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.11.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. @@ -7805,8 +8629,8 @@ sRGB #x syntactically valid notation for a color, then `string->color' returns #f. -5.11.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 @@ -7840,8 +8664,8 @@ device-dependent RGBi and RGB spaces of Xlib.  File: slib.info, Node: Color Spaces, Next: Spectra, Prev: Color Data-Type, Up: Color -5.11.2 Color Spaces | -------------------- | +5.11.2 Color Spaces +------------------- Measurement-based Color Spaces .............................. @@ -8107,8 +8931,8 @@ ICC.1:1998-09:  File: slib.info, Node: Spectra, Next: Color Difference Metrics, Prev: Color Spaces, Up: Color -5.11.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 @@ -8321,8 +9145,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.11.4 Color Difference Metrics | -------------------------------- | +5.11.4 Color Difference Metrics +------------------------------- `(require 'color-space)' @@ -8392,8 +9216,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.11.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 @@ -8463,8 +9287,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.11.6 Color Names | ------------------- | +5.11.6 Color Names +------------------ `(require 'color-names)' @@ -8629,8 +9453,8 @@ program, then you must include its license with your program:  File: slib.info, Node: Daylight, Prev: Color Names, Up: Color -5.11.7 Daylight | ---------------- | +5.11.7 Daylight +--------------- `(require 'daylight)' @@ -8727,15 +9551,11 @@ turbidity values less than 1.3.  File: slib.info, Node: Root Finding, Next: Minimizing, Prev: Color, Up: Mathematical Packages -5.12 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: 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 @@ -8822,7 +9642,7 @@ 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.13 Minimizing | +5.13 Minimizing =============== `(require 'minimize)' @@ -8869,7 +9689,7 @@ 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.14 The Limit | +5.14 The Limit ============== -- library procedure: limit proc x1 x2 k @@ -8969,7 +9789,7 @@ File: slib.info, Node: The Limit, Next: Commutative Rings, Prev: Minimizing,  File: slib.info, Node: Commutative Rings, Next: Matrix Algebra, Prev: The Limit, Up: Mathematical Packages -5.15 Commutative Rings | +5.15 Commutative Rings ====================== Scheme provides a consistent and capable set of numeric functions. @@ -9035,7 +9855,7 @@ expressions are handled similarly. `remainder', `lcm', and `gcd'; but these work only for the more restrictive Euclidean (Unique Factorization) Domain. -5.16 Rules and Rulesets | +5.16 Rules and Rulesets ======================= The "commutative-ring" package allows control of ring properties @@ -9109,7 +9929,7 @@ involving different non-numeric elements. (lambda (exp1 exp2) (apply + (map (lambda (trm) (* trm exp2)) (cdr exp1)))))) -5.17 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 @@ -9248,7 +10068,7 @@ objects.  File: slib.info, Node: Matrix Algebra, Prev: Commutative Rings, Up: Mathematical Packages -5.18 Matrix Algebra | +5.18 Matrix Algebra =================== `(require 'determinant)' @@ -9274,9 +10094,21 @@ linear-algebra texts, this package uses 0-based coordinates. Returns a copy of MATRIX flipped over the diagonal containing the 1,1 element. + -- Function: matrix:sum m1 m2 | + Returns the element-wise sum of matricies M1 and M2. | + | + -- Function: matrix:difference m1 m2 | + Returns the element-wise difference of matricies M1 and M2. | + | -- Function: matrix:product m1 m2 Returns the product of matrices M1 and M2. + -- Function: matrix:product m1 z | + Returns matrix M1 times scalar Z. | + | + -- Function: matrix:product z m1 | + Returns matrix M1 times scalar Z. | + | -- Function: matrix:inverse matrix MATRIX must be a square matrix. If MATRIX is singlar, then `matrix:inverse' returns #f; otherwise `matrix:inverse' returns the @@ -9555,7 +10387,7 @@ missing. (every (lambda (c) (memv c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 - #\+ #\( #\space #\) #\-))) | + #\+ #\( #\space #\) #\-))) (string->list d)))) string)) @@ -11606,95 +12438,95 @@ uniform-array type is supported by the implementation, then it is returned; defaulting to the next larger precision type; resorting finally to vector. - -- Function: a:floc128b z - -- Function: a:floc128b + -- Function: A:floC128b z | + -- Function: A:floC128b | Returns an inexact 128.bit flonum complex uniform-array prototype. - -- Function: a:floc64b z - -- Function: a:floc64b + -- Function: A:floC64b z | + -- Function: A:floC64b | Returns an inexact 64.bit flonum complex uniform-array prototype. - -- Function: a:floc32b z - -- Function: a:floc32b + -- Function: A:floC32b z | + -- Function: A:floC32b | Returns an inexact 32.bit flonum complex uniform-array prototype. - -- Function: a:floc16b z - -- Function: a:floc16b + -- Function: A:floC16b z | + -- Function: A:floC16b | Returns an inexact 16.bit flonum complex uniform-array prototype. - -- Function: a:flor128b z - -- Function: a:flor128b + -- Function: A:floR128b x | + -- Function: A:floR128b | Returns an inexact 128.bit flonum real uniform-array prototype. - -- Function: a:flor64b z - -- Function: a:flor64b + -- Function: A:floR64b x | + -- Function: A:floR64b | Returns an inexact 64.bit flonum real uniform-array prototype. - -- Function: a:flor32b z - -- Function: a:flor32b + -- Function: A:floR32b x | + -- Function: A:floR32b | Returns an inexact 32.bit flonum real uniform-array prototype. - -- Function: a:flor16b z - -- Function: a:flor16b + -- Function: A:floR16b x | + -- Function: A:floR16b | Returns an inexact 16.bit flonum real uniform-array prototype. - -- Function: a:flor128b z - -- Function: a:flor128b + -- Function: A:floR128d q | + -- Function: A:floR128d | Returns an exact 128.bit decimal flonum rational uniform-array prototype. - -- Function: a:flor64b z - -- Function: a:flor64b + -- Function: A:floR64d q | + -- Function: A:floR64d | Returns an exact 64.bit decimal flonum rational uniform-array prototype. - -- Function: a:flor32b z - -- Function: a:flor32b + -- Function: A:floR32d q | + -- Function: A:floR32d | Returns an exact 32.bit decimal flonum rational uniform-array prototype. - -- Function: a:fixz64b n - -- Function: a:fixz64b + -- Function: A:fixZ64b n | + -- Function: A:fixZ64b | Returns an exact binary fixnum uniform-array prototype with at least 64 bits of precision. - -- Function: a:fixz32b n - -- Function: a:fixz32b + -- Function: A:fixZ32b n | + -- Function: A:fixZ32b | Returns an exact binary fixnum uniform-array prototype with at least 32 bits of precision. - -- Function: a:fixz16b n - -- Function: a:fixz16b + -- Function: A:fixZ16b n | + -- Function: A:fixZ16b | Returns an exact binary fixnum uniform-array prototype with at least 16 bits of precision. - -- Function: a:fixz8b n - -- Function: a:fixz8b + -- Function: A:fixZ8b n | + -- Function: A:fixZ8b | Returns an exact binary fixnum uniform-array prototype with at least 8 bits of precision. - -- Function: a:fixn64b k - -- Function: a:fixn64b + -- Function: A:fixN64b k | + -- Function: A:fixN64b | Returns an exact non-negative binary fixnum uniform-array prototype with at least 64 bits of precision. - -- Function: a:fixn32b k - -- Function: a:fixn32b + -- Function: A:fixN32b k | + -- Function: A:fixN32b | Returns an exact non-negative binary fixnum uniform-array prototype with at least 32 bits of precision. - -- Function: a:fixn16b k - -- Function: a:fixn16b + -- Function: A:fixN16b k | + -- Function: A:fixN16b | Returns an exact non-negative binary fixnum uniform-array prototype with at least 16 bits of precision. - -- Function: a:fixn8b k - -- Function: a:fixn8b + -- Function: A:fixN8b k | + -- Function: A:fixN8b | Returns an exact non-negative binary fixnum uniform-array prototype with at least 8 bits of precision. - -- Function: a:bool bool - -- Function: a:bool + -- Function: A:bool bool | + -- Function: A:bool | Returns a boolean uniform-array prototype.  @@ -11736,13 +12568,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)) | + > (subarray ra #f '(2 1)) + #2A((c b) (f e)) - Arrays can be reflected (reversed) using `subarray': | - | - > (subarray '#1A(a b c d e) '(4 0)) | - #1A(e d c b a) | + 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 @@ -11796,6 +12628,16 @@ File: slib.info, Node: Array Mapping, Next: Array Interpolation, Prev: Subarr a list of indexes for which ARRAY is defined, (equal? LI (apply array-ref (array-indexes ARRAY) LI)). + -- Function: array-index-for-each array proc | + applies PROC to the indices of each element of ARRAY in turn. The | + value returned and the order of application are unspecified. | + | + One can implement ARRAY-INDEX-MAP! as | + (define (array-index-map! ra fun) | + (array-index-for-each | + ra | + (lambda is (apply array-set! ra (apply fun is) is)))) | + | -- Procedure: array-index-map! array proc applies PROC to the indices of each element of ARRAY in turn, storing the result in the corresponding element. The value @@ -11954,16 +12796,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). | - | + -- 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. @@ -12022,24 +12864,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'. -`subbytes-read!' and `subbytes-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: subbytes-read! string start end port | - -- Procedure: subbytes-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. - `subbytes-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: 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. | + -- 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'. @@ -12102,6 +12944,7 @@ determines the signedness of the number. (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 + (bytes->ieee-float (bytes #x7f #xc0 0 0)) => 0/0 | -- Function: bytes->ieee-double bytes BYTES must be a 8-element byte-array. `bytes->ieee-double' @@ -12138,7 +12981,7 @@ determines the signedness of the number. (bytes->list (ieee-float->bytes -inf.0)) => (255 128 0 0) (bytes->list (ieee-float->bytes +inf.0)) => (127 128 0 0) - (bytes->list (ieee-float->bytes 0/0)) => (127 128 0 1) + (bytes->list (ieee-float->bytes 0/0)) => (127 192 0 0) -- Function: ieee-double->bytes x Returns a 8-element byte-array encoding the IEEE double-precision @@ -12191,7 +13034,7 @@ enables the full range of numbers as keys in `ieee-byte-collate!' returns BYTE-VECTOR. -- Procedure: ieee-byte-decollate! byte-vector - Given BYTE-VECTOR modified by `IEEE-byte-collate!', reverses the + Given BYTE-VECTOR modified by `ieee-byte-collate!', reverses the | BYTE-VECTOR modifications. -- Function: ieee-byte-collate byte-vector @@ -12199,7 +13042,7 @@ enables the full range of numbers as keys in IEEE floating-point byte-vectors matches numerical order. -- Function: ieee-byte-decollate byte-vector - Given BYTE-VECTOR returned by `IEEE-byte-collate', reverses the + Given BYTE-VECTOR returned by `ieee-byte-collate', reverses the | BYTE-VECTOR modifications.  @@ -12354,9 +13197,7 @@ operations. -- Function: reduce proc seed collection1 ... A generalization of the list-based `reduce-init' (*note Lists as - sequences::) to collections which will shadow the list-based - version if `(require 'collect)' follows `(require - 'common-list-functions)' (*note Common List Functions::). + sequences::) to collections. | Examples: (reduce + 0 (vector 1 2 3)) @@ -12364,6 +13205,9 @@ operations. (reduce union '() '((a b c) (b c d) (d a))) => (c b d a). + `Reduce' called with two arguments will work as does the procedure | + of the same name from *Note Common List Functions::). | + | -- Function: any? pred collection1 ... A generalization of the list-based `some' (*note Lists as sequences::) to collections. @@ -13595,154 +14439,88 @@ File: slib.info, Node: Sorting, Next: Topological Sort, Prev: Chapter Orderin 7.2.4 Sorting ------------- -`(require 'sort)' +`(require 'sort)' or `(require 'srfi-95)' | - [by Richard A. O'Keefe, 1991] | + [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 -common blunder is to use quicksort which does not perform well). - - Because `sort' and `sort!' are not in the standard, there is very -little agreement about what these functions look like. For example, -Dybvig says that Chez Scheme provides - (merge predicate list1 list2) - (merge! predicate list1 list2) - (sort predicate list) - (sort! predicate list) - while MIT Scheme 7.1, following Common LISP, offers unstable - (sort list predicate) - TI PC Scheme offers - (sort! list/vector predicate?) - and Elk offers - (sort list/vector predicate?) - (sort! list/vector predicate?) - - Here is a comprehensive catalogue of the variations I have found. - - 1. Both `sort' and `sort!' may be provided. - - 2. `sort' may be provided without `sort!'. - - 3. `sort!' may be provided without `sort'. - - 4. Neither may be provided. - - 5. The sequence argument may be either a list or a vector. - - 6. The sequence argument may only be a list. - - 7. The sequence argument may only be a vector. - - 8. The comparison function may be expected to behave like `<'. - - 9. The comparison function may be expected to behave like `<='. - - 10. The interface may be `(sort predicate? sequence)'. - - 11. The interface may be `(sort sequence predicate?)'. - - 12. The interface may be `(sort sequence &optional (predicate? <))'. - - 13. The sort may be stable. - - 14. The sort may be unstable. - - All of this variation really does not help anybody. A nice simple -merge sort is both stable and fast (quite a lot faster than _quick_ -sort). - I am providing this source code with no restrictions at all on its use -(but please retain D.H.D.Warren's credit for the original idea). You -may have to rename some of these functions in order to use them in a -system which already provides incompatible or inferior sorts. For each -of the functions, only the top-level define needs to be edited to do -that. - - I could have given these functions names which would not clash with -any Scheme that I know of, but I would like to encourage implementors to -converge on a single interface, and this may serve as a hint. The -argument order for all functions has been chosen to be as close to -Common LISP as made sense, in order to avoid NIH-itis. - - 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, +(but please retain D.H.D.Warren's credit for the original idea). | - (not (f x x)) - (and (f x y) (f y z)) == (f x z) + 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. + | The standard functions `<', `>', `char?', `char-ci?', `string?', `string-ci?' 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))) | + [Addendum by Aubrey Jaffer, 2006] + + These procedures are stable when called with predicates which return +`#f' when applied to identical arguments. | | - The `!' variants sort in place; `sort!' returns its SEQUENCE argument. | + The `sorted?', `merge', and `merge!' procedures consume asymptotic | +time and space no larger than O(N), where N is the sum of the lengths | +of the sequence arguments. The `sort' and `sort!' procedures consume | +asymptotic time and space no larger than O(N*log(N)), where N is the | +length of the sequence argument. | + + 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))) + + All five functions will call the KEY argument at most once per | +element. | | + The `!' variants sort in place; `sort!' returns its SEQUENCE argument. + -- Function: sorted? sequence less? - -- Function: sorted? sequence less? key | + -- 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 or array | - (including vectors and strings). | + pair. It is an error if the sequence is not a list or array + (including vectors and strings). -- Function: merge list1 list2 less? - -- Function: merge list1 list2 less? key | - Merges two sorted lists, returning a freshly allocated list as its | - result. | + -- 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: 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. The result will be either LIST1 or LIST2. | -- Function: sort sequence less? - -- 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. | + -- 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 list, array, vector, or string SEQUENCE which has been | + mutated to order its elements according to LESS?. Given valid | + arguments, it is always the case that: | + | + (sorted? (sort! SEQUENCE LESS?) LESS?) => #t |  File: slib.info, Node: Topological Sort, Next: Hashing, Prev: Sorting, Up: Sorting and Searching @@ -14990,18 +15768,27 @@ Implements "Scheme Request For Implementation" (SRFI) as described at * SRFI-9 *Note Define-Record-Type:: - * SRFI-23 `(define error slib:error)' | + * SRFI-11 *Note Binding to multiple values:: | + | + * SRFI-23 `(define error slib:error)' + + * SRFI-28 *Note Format:: | * SRFI-47 *Note Arrays:: | - * SRFI-63 *Note Arrays:: + * SRFI-59 *Note Vicinity:: - * SRFI-59 *Note Vicinity:: | - | * SRFI-60 *Note Bit-Twiddling:: - * SRFI-61 *Note Guarded COND Clause:: + * SRFI-61 *Note Guarded COND Clause:: + * SRFI-63 *Note Arrays:: | + | + * SRFI-94 *Note Irrational Integer Functions:: and *Note Irrational + Real Functions:: | + | + * SRFI-95 *Note Sorting:: | + |  File: slib.info, Node: SRFI-1, Prev: SRFI, Up: SRFI @@ -15120,8 +15907,7 @@ Fold and Unfold -- Function: pair-fold-right kons knil clist1 clist2 ... - -- Function: reduce f ridentity list - -- Function: reduce-right f ridentity list + -- Function: reduce arg ... | -- Procedure: map! f clist1 clist2 ... @@ -15814,12 +16600,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 3a4, released October 2006. | + SLIB 3a5, released November 2007. | Aubrey Jaffer - | - Current information about SLIB can be found on SLIB's "WWW" home page: | - | - `http://swiss.csail.mit.edu/~jaffer/SLIB' | + + Current information about SLIB can be found on SLIB's "WWW" home page: + + `http://swiss.csail.mit.edu/~jaffer/SLIB' * Menu: @@ -15853,7 +16639,7 @@ There are five parts to installation: 8.1.1 Unpacking the SLIB Distribution ------------------------------------- -If the SLIB distribution is a Linux RPM, it will create the SLIB +If the SLIB distribution is a GNU/Linux RPM, it will create the SLIB | directory `/usr/share/slib'. If the SLIB distribution is a ZIP file, unzip the distribution to @@ -16009,8 +16795,8 @@ File: slib.info, Node: The SLIB script, Next: Porting, Prev: Installation, U SLIB comes with shell script for Unix platforms. - slib [ scm | gsi | mzscheme | guile | slib48 | scheme48 | scmlit ] - + slib [ scheme | scm | gsi | mzscheme | guile | + | scheme48 | scmlit | elk | sisc | kawa ] | Starts an interactive Scheme-with-SLIB session. @@ -16199,11 +16985,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:: | - | +* 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. @@ -16217,448 +17003,448 @@ File: slib.info, Node: About this manual, Prev: Copyrights, Up: About SLIB  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. | - | + +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 | + +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. | - | + 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 ************************* - | + [index] * Menu: @@ -16675,26 +17461,29 @@ Procedure and Macro Index * =?: Rev2 Procedures. (line 47) * >=?: Rev2 Procedures. (line 49) * >?: Rev2 Procedures. (line 48) -* a:bool: Arrays. (line 236) -* a:fixn16b: Arrays. (line 226) -* a:fixn32b: Arrays. (line 221) -* a:fixn64b: Arrays. (line 216) -* a:fixn8b: Arrays. (line 231) -* a:fixz16b: Arrays. (line 206) -* a:fixz32b: Arrays. (line 201) -* a:fixz64b: Arrays. (line 196) -* a:fixz8b: Arrays. (line 211) -* a:floc128b: Arrays. (line 149) -* a:floc16b: Arrays. (line 161) -* a:floc32b: Arrays. (line 157) -* a:floc64b: Arrays. (line 153) -* a:flor128b: Arrays. (line 165) -* a:flor16b: Arrays. (line 177) -* a:flor32b: Arrays. (line 173) -* a:flor64b: Arrays. (line 169) +* A:bool: Arrays. (line 236) +* A:fixN16b: Arrays. (line 226) +* A:fixN32b: Arrays. (line 221) +* A:fixN64b: Arrays. (line 216) +* A:fixN8b: Arrays. (line 231) +* A:fixZ16b: Arrays. (line 206) +* A:fixZ32b: Arrays. (line 201) +* A:fixZ64b: Arrays. (line 196) +* A:fixZ8b: Arrays. (line 211) +* A:floC128b: Arrays. (line 149) +* A:floC16b: Arrays. (line 161) +* A:floC32b: Arrays. (line 157) +* A:floC64b: Arrays. (line 153) +* A:floR128b: Arrays. (line 165) +* A:floR128d: Arrays. (line 181) +* A:floR16b: Arrays. (line 177) +* A:floR32b: Arrays. (line 173) +* A:floR32d: Arrays. (line 191) +* A:floR64b: Arrays. (line 169) +* A:floR64d: Arrays. (line 186) * abort: Session Support. (line 9) -* abs: Irrational Real Functions. | - (line 86) | +* abs: Irrational Real Functions. + (line 86) * absolute-path?: URI. (line 102) * absolute-uri?: URI. (line 98) * add-command-tables: Database Extension. (line 11) @@ -16708,10 +17497,10 @@ Procedure and Macro Index * alist->wt-tree: Construction of Weight-Balanced Trees. (line 65) * alist-associator: Association Lists. (line 28) -* alist-cons: SRFI-1. (line 178) -* alist-copy: SRFI-1. (line 180) -* alist-delete: SRFI-1. (line 182) -* alist-delete!: SRFI-1. (line 185) +* alist-cons: SRFI-1. (line 177) +* alist-copy: SRFI-1. (line 179) +* alist-delete: SRFI-1. (line 181) +* alist-delete!: SRFI-1. (line 184) * alist-for-each: Association Lists. (line 53) * alist-inquirer: Association Lists. (line 23) * alist-map: Association Lists. (line 48) @@ -16720,36 +17509,39 @@ Procedure and Macro Index * and-let*: Guarded LET* special form. (line 9) * and?: Non-List functions. (line 7) -* any: SRFI-1. (line 156) +* any: SRFI-1. (line 155) * any-bits-set?: Bit-Twiddling. (line 64) -* any?: Collections. (line 83) +* any?: Collections. (line 84) * append!: Rev2 Procedures. (line 36) * append-reverse: SRFI-1. (line 95) * append-reverse!: SRFI-1. (line 96) * apply: Multi-argument Apply. (line 12) -* arithmetic-shift: Bit-Twiddling. (line 182) +* arithmetic-shift: Bit-Twiddling. (line 192) * array->list: Arrays. (line 101) * array->vector: Arrays. (line 124) * array-dimensions: Arrays. (line 48) * array-for-each: Array Mapping. (line 25) * array-in-bounds?: Arrays. (line 133) -* array-index-map!: Array Mapping. (line 34) +* array-index-for-each: Array Mapping. (line 34) +* array-index-map!: Array Mapping. (line 44) * array-indexes: Array Mapping. (line 29) * array-map: Array Mapping. (line 17) * array-map!: Array Mapping. (line 9) * array-rank: Arrays. (line 44) * array-ref: Arrays. (line 136) * array-set!: Arrays. (line 139) -* array-trim: Subarrays. (line 48) | -* array:copy!: Array Mapping. (line 50) +* array-trim: Subarrays. (line 48) +* array:copy!: Array Mapping. (line 60) * 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) | +* ash: Bit-Twiddling. (line 191) +* assoc: SRFI-1. (line 174) +* atan: Irrational Real Functions. + (line 22) * atom?: Non-List functions. (line 30) +* attlist-add: Parsing XML. (line 451) +* attlist-remove-top: Parsing XML. (line 456) * batch:call-with-output-script: Batch. (line 47) * batch:command: Batch. (line 64) * batch:comment: Batch. (line 95) @@ -16760,20 +17552,20 @@ Procedure and Macro Index * batch:run-script: Batch. (line 88) * batch:try-chopped-command: Batch. (line 76) * batch:try-command: Batch. (line 72) -* bit-count: Bit-Twiddling. (line 74) -* bit-field: Bit-Twiddling. (line 156) -* bit-set?: Bit-Twiddling. (line 135) +* bit-field: Bit-Twiddling. (line 166) +* bit-set?: Bit-Twiddling. (line 145) * bitwise-and: Bit-Twiddling. (line 19) +* bitwise-bit-count: Bit-Twiddling. (line 91) * bitwise-if: Bit-Twiddling. (line 56) * bitwise-ior: Bit-Twiddling. (line 28) * bitwise-merge: Bit-Twiddling. (line 57) * bitwise-not: Bit-Twiddling. (line 46) * bitwise-xor: Bit-Twiddling. (line 37) * blackbody-spectrum: Spectra. (line 125) -* booleans->integer: Bit-Twiddling. (line 229) +* booleans->integer: Bit-Twiddling. (line 239) * break <1>: Breakpoints. (line 28) -* break: SRFI-1. (line 152) -* break!: SRFI-1. (line 154) +* break: SRFI-1. (line 151) +* break!: SRFI-1. (line 153) * break-all: Debug. (line 31) * breakf: Breakpoints. (line 47) * breakpoint: Breakpoints. (line 16) @@ -16785,7 +17577,7 @@ Procedure and Macro Index * byte-set!: Byte. (line 18) * bytes: Byte. (line 32) * bytes->ieee-double: Byte/Number Conversions. - (line 60) + (line 61) | * bytes->ieee-float: Byte/Number Conversions. (line 41) * bytes->integer: Byte/Number Conversions. @@ -16793,8 +17585,8 @@ Procedure and Macro Index * bytes->list: Byte. (line 36) * bytes-copy: Byte. (line 47) * bytes-length: Byte. (line 29) -* bytes-reverse: Byte. (line 63) | -* bytes-reverse!: Byte. (line 60) | +* 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) @@ -16808,8 +17600,8 @@ Procedure and Macro Index * catalog->html: HTML Tables. (line 49) * catalog-id on base-table: Base Tables. (line 30) * catalog:read: Catalog Vicinities. (line 57) -* cdna:base-count: NCBI-DNA. (line 35) -* cdna:report-base-count: NCBI-DNA. (line 39) +* cdna:base-count: NCBI-DNA. (line 37) +* cdna:report-base-count: NCBI-DNA. (line 41) * cgi:serve-query: HTTP and CGI. (line 69) * chap:next-string: Chapter Ordering. (line 29) * chap:string<=?: Chapter Ordering. (line 25) @@ -16845,7 +17637,7 @@ Procedure and Macro Index (line 61) * CMC:DE*: Color Difference Metrics. (line 65) -* codons<-cdna: NCBI-DNA. (line 18) +* codons<-cdna: NCBI-DNA. (line 20) * coerce: Type Coercion. (line 12) * collection?: Collections. (line 36) * color->ciexyz: Color Spaces. (line 34) @@ -16894,8 +17686,8 @@ Procedure and Macro Index * cons*: SRFI-1. (line 22) * continue: Breakpoints. (line 20) * convert-color: Color Data-Type. (line 54) -* copy-bit: Bit-Twiddling. (line 144) -* copy-bit-field: Bit-Twiddling. (line 167) +* copy-bit: Bit-Twiddling. (line 154) +* copy-bit-field: Bit-Twiddling. (line 177) * copy-list: List construction. (line 32) * copy-random-state: Exact Random Numbers. (line 29) @@ -16916,10 +17708,10 @@ Procedure and Macro Index * ctime: Posix Time. (line 68) * current-directory: Directories. (line 9) * current-error-port: Input/Output. (line 70) -* current-input-port <1>: Byte. (line 84) | +* current-input-port <1>: Byte. (line 84) * current-input-port: Ruleset Definition and Use. (line 57) -* current-output-port: Byte. (line 76) | +* current-output-port: Byte. (line 76) * current-time: Time and Date. (line 20) * cvs-directories: CVS. (line 14) * cvs-files: CVS. (line 9) @@ -16959,8 +17751,8 @@ Procedure and Macro Index * delete* on base-table: Aggregate Base Operations. (line 11) * delete-domain on relational-database: Command Intrinsics. (line 39) -* delete-duplicates: SRFI-1. (line 166) -* delete-duplicates!: SRFI-1. (line 169) +* delete-duplicates: SRFI-1. (line 165) +* delete-duplicates!: SRFI-1. (line 168) * delete-file: Input/Output. (line 14) * delete-if: Destructive list operations. (line 59) @@ -16970,10 +17762,10 @@ Procedure and Macro Index * 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) | +* 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) @@ -16996,28 +17788,27 @@ Procedure and Macro Index * e-sRGB->sRGB: Color Conversions. (line 60) * eighth: SRFI-1. (line 64) * emacs:backup-name: Transactions. (line 73) -* empty?: Collections. (line 99) +* empty?: Collections. (line 100) * encode-universal-time: Common-Lisp Time. (line 40) * enqueue!: Queues. (line 25) * equal? <1>: Byte. (line 44) * equal?: Arrays. (line 19) * eval: Eval. (line 9) * every: Lists as sets. (line 91) -* every?: Collections. (line 91) +* every?: Collections. (line 92) * exports<-info-index: Top-level Variable References. - (line 35) -* expt: Miscellany. (line 20) -* extended-euclid: Modular Arithmetic. (line 9) | + (line 35) | +* 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: Discrete Fourier Transform. | - (line 27) | -* fft-1: Discrete Fourier Transform. | - (line 34) | +* 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) @@ -17028,6 +17819,7 @@ Procedure and Macro Index * file-exists?: Input/Output. (line 9) * file-lock!: Transactions. (line 52) * file-lock-owner: Transactions. (line 48) +* file-position: Input/Output. (line 81) * file-unlock!: Transactions. (line 62) * filename:match-ci??: Filenames. (line 10) * filename:match??: Filenames. (line 9) @@ -17035,16 +17827,16 @@ Procedure and Macro Index * filename:substitute??: Filenames. (line 34) * fill-empty-parameters: Parameter lists. (line 51) * fill-rect: Rectangles. (line 30) -* filter: SRFI-1. (line 129) -* filter!: SRFI-1. (line 131) -* find: SRFI-1. (line 144) +* filter: SRFI-1. (line 128) +* filter!: SRFI-1. (line 130) +* find: SRFI-1. (line 143) * find-if: Lists as sets. (line 138) * find-ratio: Rationalize. (line 20) * find-ratio-between: Rationalize. (line 27) * find-string-from-port?: String Search. (line 30) -* find-tail: SRFI-1. (line 146) +* find-tail: SRFI-1. (line 145) * first: SRFI-1. (line 53) -* first-set-bit: Bit-Twiddling. (line 100) +* first-set-bit: Bit-Twiddling. (line 110) * fluid-let: Fluid-Let. (line 9) * fold: SRFI-1. (line 111) * fold-right: SRFI-1. (line 113) @@ -17160,17 +17952,17 @@ Procedure and Macro Index * identifier?: Syntactic Closures. (line 334) * identity: Miscellany. (line 9) * ieee-byte-collate: Byte/Number Conversions. - (line 151) + (line 152) | * ieee-byte-collate!: Byte/Number Conversions. - (line 142) + (line 143) | * ieee-byte-decollate: Byte/Number Conversions. - (line 155) + (line 156) | * ieee-byte-decollate!: Byte/Number Conversions. - (line 147) + (line 148) | * ieee-double->bytes: Byte/Number Conversions. - (line 97) + (line 98) | * ieee-float->bytes: Byte/Number Conversions. - (line 79) + (line 80) | * illuminant-map: Spectra. (line 77) * illuminant-map->XYZ: Spectra. (line 82) * implementation-vicinity: Vicinity. (line 42) @@ -17183,21 +17975,20 @@ Procedure and Macro Index (line 62) * integer->hilbert-coordinates: Hilbert Space-Filling Curve. (line 30) -* integer->list: Bit-Twiddling. (line 215) +* integer->list: Bit-Twiddling. (line 225) * integer->peano-coordinates: Peano Space-Filling Curve. (line 19) * integer-byte-collate: Byte/Number Conversions. - (line 136) + (line 137) | * integer-byte-collate!: Byte/Number Conversions. - (line 130) -* integer-expt: Irrational Integer Functions. | - (line 9) | -* integer-length: Bit-Twiddling. (line 88) -* integer-log: Irrational Integer Functions. | + (line 131) | +* integer-expt: Irrational Integer Functions. + (line 9) +* integer-length: Bit-Twiddling. (line 98) +* integer-log: Irrational Integer Functions. (line 18) | -* integer-sqrt <1>: Root Finding. (line 9) | -* integer-sqrt: Irrational Integer Functions. | - (line 23) | +* integer-sqrt: Irrational Integer Functions. + (line 23) * interaction-environment: Eval. (line 51) * interpolate-array-ref: Array Interpolation. (line 9) * interpolate-from-table: Database Interpolation. @@ -17222,12 +18013,16 @@ Procedure and Macro Index (line 25) * L*u*v*->CIEXYZ: Color Conversions. (line 34) * l*u*v*->color: Color Spaces. (line 102) -* laguerre:find-polynomial-root: Root Finding. (line 58) -* laguerre:find-root: Root Finding. (line 47) +* laguerre:find-polynomial-root: Root Finding. (line 54) +* laguerre:find-root: Root Finding. (line 43) * last <1>: SRFI-1. (line 83) * last: Lists as sequences. (line 111) -* last-pair: Miscellany. (line 73) +* last-pair: Miscellany. (line 64) * length+: SRFI-1. (line 88) +* let-values: Binding to multiple values. + (line 14) | +* let-values*: Binding to multiple values. + (line 15) | * library-vicinity: Vicinity. (line 39) * light:ambient: Solid Modeling. (line 110) * light:beam: Solid Modeling. (line 144) @@ -17238,42 +18033,42 @@ Procedure and Macro Index * list*: List construction. (line 18) * list->array: Arrays. (line 88) * list->bytes: Byte. (line 40) -* list->integer: Bit-Twiddling. (line 221) +* list->integer: Bit-Twiddling. (line 231) * list-copy: SRFI-1. (line 24) -* list-index: SRFI-1. (line 158) +* list-index: SRFI-1. (line 157) * list-of??: Lists as sets. (line 120) * list-table-definition: Using Databases. (line 167) * list-tabulate: SRFI-1. (line 18) * list-tail: Rev4 Optional Procedures. (line 12) * list=: SRFI-1. (line 48) -* ln: Irrational Real Functions. | - (line 77) | +* ln: Irrational Real Functions. + (line 77) * load->path: Module Manifests. (line 63) * load-ciexyz: Spectra. (line 37) * load-color-dictionary: Color Names. (line 52) * localtime: Posix Time. (line 39) -* log2-binary-factors: Bit-Twiddling. (line 99) +* log2-binary-factors: Bit-Twiddling. (line 109) * logand: Bit-Twiddling. (line 18) -* logbit?: Bit-Twiddling. (line 134) +* logbit?: Bit-Twiddling. (line 144) * logcount: Bit-Twiddling. (line 73) * logior: Bit-Twiddling. (line 27) * lognot: Bit-Twiddling. (line 45) * logtest: Bit-Twiddling. (line 63) * logxor: Bit-Twiddling. (line 36) -* lset-adjoin: SRFI-1. (line 197) -* lset-diff+intersection: SRFI-1. (line 207) -* lset-diff+intersection!: SRFI-1. (line 222) -* lset-difference: SRFI-1. (line 203) -* lset-difference!: SRFI-1. (line 216) -* lset-intersection: SRFI-1. (line 201) -* lset-intersection!: SRFI-1. (line 214) -* lset-union: SRFI-1. (line 199) -* lset-union!: SRFI-1. (line 218) -* lset-xor: SRFI-1. (line 205) -* lset-xor!: SRFI-1. (line 220) -* lset<=: SRFI-1. (line 191) -* lset=: SRFI-1. (line 195) +* lset-adjoin: SRFI-1. (line 196) +* lset-diff+intersection: SRFI-1. (line 206) +* lset-diff+intersection!: SRFI-1. (line 221) +* lset-difference: SRFI-1. (line 202) +* lset-difference!: SRFI-1. (line 215) +* lset-intersection: SRFI-1. (line 200) +* lset-intersection!: SRFI-1. (line 213) +* lset-union: SRFI-1. (line 198) +* lset-union!: SRFI-1. (line 217) +* lset-xor: SRFI-1. (line 204) +* lset-xor!: SRFI-1. (line 219) +* lset<=: SRFI-1. (line 190) +* lset=: SRFI-1. (line 194) * macro:eval <1>: Syntax-Case Macros. (line 14) * macro:eval <2>: Syntactic Closures. (line 14) * macro:eval <3>: Macros That Work. (line 18) @@ -17298,7 +18093,7 @@ Procedure and Macro Index * make-command-server: Command Service. (line 7) * make-directory: Directories. (line 17) * make-dynamic: Dynamic Data Type. (line 9) -* make-exchanger: Miscellany. (line 37) +* make-exchanger: Miscellany. (line 28) * make-generic-method: Object. (line 57) * make-generic-predicate: Object. (line 62) * make-getter on base-table: Base Record Operations. @@ -17317,8 +18112,8 @@ Procedure and Macro Index (line 17) * make-object: Object. (line 46) * make-parameter-list: Parameter lists. (line 23) -* make-polar: Irrational Real Functions. | - (line 94) | +* make-polar: Irrational Real Functions. + (line 94) * make-predicate!: Object. (line 72) * make-prever on base-table: Base ISAM Operations. (line 25) @@ -17330,8 +18125,8 @@ Procedure and Macro Index * make-random-state: Exact Random Numbers. (line 44) * make-record-type: Records. (line 12) -* make-rectangular: Irrational Real Functions. | - (line 93) | +* make-rectangular: Irrational Real Functions. + (line 93) * make-relational-system: Relational Database Objects. (line 11) * make-ruleset: Commutative Rings. (line 82) @@ -17346,7 +18141,7 @@ Procedure and Macro Index (line 51) * make-wt-tree-type: Construction of Weight-Balanced Trees. (line 19) -* map!: SRFI-1. (line 122) +* map!: SRFI-1. (line 121) * map-elts: Collections. (line 40) * map-key on base-table: Aggregate Base Operations. (line 22) @@ -17355,36 +18150,38 @@ Procedure and Macro Index * matfile:read: MAT-File Format. (line 19) * matrix->array: Matrix Algebra. (line 15) * matrix->lists: Matrix Algebra. (line 12) -* matrix:inverse: Matrix Algebra. (line 33) -* matrix:product: Matrix Algebra. (line 30) +* matrix:difference: Matrix Algebra. (line 33) +* matrix:inverse: Matrix Algebra. (line 45) +* matrix:product: Matrix Algebra. (line 36) +* matrix:sum: Matrix Algebra. (line 30) * mdbm:report: Using Databases. (line 94) -* member: SRFI-1. (line 160) +* member: SRFI-1. (line 159) * member-if: Lists as sets. (line 62) -* merge: Sorting. (line 126) | -* merge!: Sorting. (line 131) | +* merge: Sorting. (line 62) +* merge!: Sorting. (line 67) * mktime: Posix Time. (line 54) -* 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) +* 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 17) * must-be-first: Batch. (line 128) * must-be-last: Batch. (line 133) * natural->peano-coordinates: Peano Space-Filling Curve. (line 9) -* ncbi:read-dna-sequence: NCBI-DNA. (line 7) -* ncbi:read-file: NCBI-DNA. (line 11) +* ncbi:read-dna-sequence: NCBI-DNA. (line 9) +* ncbi:read-file: NCBI-DNA. (line 13) * nconc: Destructive list operations. (line 10) -* newton:find-integer-root: Root Finding. (line 13) -* newton:find-root: Root Finding. (line 30) +* newton:find-integer-root: Root Finding. (line 9) +* newton:find-root: Root Finding. (line 26) * ninth: SRFI-1. (line 65) * not-pair?: SRFI-1. (line 46) * notany: Lists as sets. (line 105) @@ -17408,7 +18205,7 @@ Procedure and Macro Index * open-database on relational-system: Relational Database Objects. (line 45) * open-database!: Using Databases. (line 68) -* open-file <1>: Byte. (line 67) | +* 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) @@ -17420,20 +18217,20 @@ Procedure and Macro Index (line 10) * os->batch-dialect: Batch. (line 138) * outline-rect: Rectangles. (line 33) -* output-port-height: Input/Output. (line 87) -* output-port-width: Input/Output. (line 81) +* output-port-height: Input/Output. (line 100) +* output-port-width: Input/Output. (line 94) * overcast-sky-color-xyy: Daylight. (line 74) -* p<-cdna: NCBI-DNA. (line 27) +* p<-cdna: NCBI-DNA. (line 29) * pad-range: Column Ranges. (line 13) * pair-fold: SRFI-1. (line 115) * pair-fold-right: SRFI-1. (line 117) -* pair-for-each: SRFI-1. (line 124) +* pair-for-each: SRFI-1. (line 123) * parameter-list->arglist: Parameter lists. (line 86) * parameter-list-expand: Parameter lists. (line 41) * parameter-list-ref: Parameter lists. (line 26) * parse-ftp-address: URI. (line 117) -* partition: SRFI-1. (line 133) -* partition!: SRFI-1. (line 137) +* partition: SRFI-1. (line 132) +* partition!: SRFI-1. (line 136) * partition-page: Rectangles. (line 16) * path->uri: URI. (line 95) * pathname->vicinity: Vicinity. (line 25) @@ -17502,7 +18299,7 @@ Procedure and Macro Index * program-vicinity: Vicinity. (line 30) * project-table on relational-database: Database Operations. (line 76) * proper-list?: SRFI-1. (line 38) -* protein<-cdna: NCBI-DNA. (line 23) +* protein<-cdna: NCBI-DNA. (line 25) * provide: Feature. (line 58) * provided?: Feature. (line 30) * qp: Quick Print. (line 19) @@ -17514,8 +18311,8 @@ Procedure and Macro Index * queue-push!: Queues. (line 22) * queue-rear: Queues. (line 42) * queue?: Queues. (line 16) -* quo: Irrational Real Functions. | - (line 50) | +* quo: Irrational Real Functions. + (line 50) * random: Exact Random Numbers. (line 9) * random:exp: Inexact Random Numbers. @@ -17531,36 +18328,36 @@ Procedure and Macro Index * random:uniform: Inexact Random Numbers. (line 9) * rationalize: Rationalize. (line 9) -* read-byte: Byte. (line 79) | -* read-bytes: Byte. (line 97) | +* 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) -* 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) | +* 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) @@ -17571,12 +18368,11 @@ Procedure and Macro Index * reduce <2>: Lists as sequences. (line 19) * reduce: Collections. (line 71) * reduce-init: Lists as sequences. (line 61) -* reduce-right: SRFI-1. (line 120) -* rem: Irrational Real Functions. | - (line 51) | -* remove <1>: SRFI-1. (line 135) +* rem: Irrational Real Functions. + (line 51) +* remove <1>: SRFI-1. (line 134) * remove: Lists as sets. (line 153) -* remove!: SRFI-1. (line 139) +* remove!: SRFI-1. (line 138) * remove-duplicates: Lists as sets. (line 199) * remove-if: Lists as sets. (line 166) * remove-if-not: Lists as sets. (line 177) @@ -17592,10 +18388,10 @@ Procedure and Macro Index * resene: Color Names. (line 129) * restrict-table on relational-database: Database Operations. (line 77) * reverse!: SRFI-1. (line 93) -* reverse-bit-field: Bit-Twiddling. (line 206) +* reverse-bit-field: Bit-Twiddling. (line 216) * RGB709->CIEXYZ: Color Conversions. (line 30) * rgb709->color: Color Spaces. (line 46) -* rotate-bit-field: Bit-Twiddling. (line 192) +* rotate-bit-field: Bit-Twiddling. (line 202) * row:delete on relational-table: Single Row Operations. (line 50) * row:delete* on relational-table: Multi-Row Operations. @@ -17633,8 +18429,8 @@ Procedure and Macro Index * scene:viewpoints: Solid Modeling. (line 88) * scheme-report-environment: Eval. (line 28) * schmooz: Schmooz. (line 16) -* secant:find-bracketed-root: Root Finding. (line 71) -* secant:find-root: Root Finding. (line 70) +* secant:find-bracketed-root: Root Finding. (line 67) +* secant:find-root: Root Finding. (line 66) * second: SRFI-1. (line 55) * seed->random-state: Exact Random Numbers. (line 35) @@ -17646,19 +18442,19 @@ Procedure and Macro Index * set-linedash: Graphics Context. (line 39) * set-linewidth: Graphics Context. (line 34) * set-margin-templates: Legending. (line 27) -* Setter: Collections. (line 107) +* Setter: Collections. (line 108) * 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) | +* 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) * sixth: SRFI-1. (line 62) -* size <1>: Collections. (line 104) +* size <1>: Collections. (line 105) * size: Yasos interface. (line 41) * sky-color-xyy: Daylight. (line 85) * slib:error: System. (line 45) @@ -17677,38 +18473,38 @@ Procedure and Macro Index * solar-declination: Daylight. (line 21) * solar-hour: Daylight. (line 14) * solar-polar: Daylight. (line 23) -* solid:arrow: Solid Modeling. (line 413) | -* solid:basrelief: Solid Modeling. (line 285) | +* 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 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) | +* 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 138) | -* sort!: Sorting. (line 148) | -* sorted?: Sorting. (line 116) | +* sort: Sorting. (line 72) +* sort!: Sorting. (line 82) +* sorted?: Sorting. (line 52) * soundex: Soundex. (line 9) -* span: SRFI-1. (line 148) -* span!: SRFI-1. (line 150) +* span: SRFI-1. (line 147) +* span!: SRFI-1. (line 149) * spectrum->chromaticity: Spectra. (line 111) * spectrum->XYZ: Spectra. (line 85) * split-at: SRFI-1. (line 80) @@ -17719,6 +18515,35 @@ Procedure and Macro Index * srgb->color: Color Spaces. (line 195) * sRGB->e-sRGB: Color Conversions. (line 59) * sRGB->xRGB: Color Conversions. (line 53) +* ssax:assert-current-char: Parsing XML. (line 52) +* ssax:assert-token: Parsing XML. (line 630) +* ssax:complete-start-tag: Parsing XML. (line 517) +* ssax:handle-parsed-entity: Parsing XML. (line 436) +* ssax:init-buffer: Parsing XML. (line 64) +* ssax:make-elem-parser: Parsing XML. (line 667) +* ssax:make-parser: Parsing XML. (line 714) +* ssax:make-pi-parser: Parsing XML. (line 647) +* ssax:next-token: Parsing XML. (line 69) +* ssax:next-token-of: Parsing XML. (line 83) +* ssax:read-attributes: Parsing XML. (line 460) +* ssax:read-cdata-body: Parsing XML. (line 385) +* ssax:read-char-data: Parsing XML. (line 589) +* ssax:read-char-ref: Parsing XML. (line 415) +* ssax:read-external-id: Parsing XML. (line 553) +* ssax:read-markup-token: Parsing XML. (line 328) +* ssax:read-ncname: Parsing XML. (line 293) +* ssax:read-pi-body-as-string: Parsing XML. (line 373) +* ssax:read-qname: Parsing XML. (line 319) +* ssax:read-string: Parsing XML. (line 110) +* ssax:resolve-name: Parsing XML. (line 504) +* ssax:reverse-collect-str: Parsing XML. (line 18) +* ssax:reverse-collect-str-drop-ws: Parsing XML. (line 24) +* ssax:scan-misc: Parsing XML. (line 577) +* ssax:skip-internal-dtd: Parsing XML. (line 380) +* ssax:skip-pi: Parsing XML. (line 370) +* ssax:skip-s: Parsing XML. (line 285) +* ssax:skip-while: Parsing XML. (line 58) +* ssax:xml->sxml: Parsing XML. (line 803) * sscanf: Standard Formatted Input. (line 15) * stack: Trace. (line 49) @@ -17746,16 +18571,16 @@ Procedure and Macro Index * 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) | +* 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-move-right!: Rev2 Procedures. (line 14) * substring?: String Search. (line 19) * substv: Tree Operations. (line 13) * sunlight-chromaticity: Daylight. (line 65) @@ -17763,7 +18588,7 @@ Procedure and Macro Index * 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 13) | +* 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) @@ -17863,8 +18688,8 @@ Procedure and Macro Index * 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 72) | -* write-bytes: Byte. (line 108) | +* 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) @@ -17936,7 +18761,7 @@ Procedure and Macro Index Variable Index ************** - | + [index] * Menu: @@ -17982,19 +18807,19 @@ Variable Index * graph:dimensions: Legacy Plotting. (line 7) * graphrect: Rectangles. (line 26) * leftedge: Legending. (line 22) -* modulo: Irrational Integer Functions. | - (line 29) | +* modulo: Irrational Integer Functions. + (line 29) * most-positive-fixnum: Configuration. (line 15) -* nil: Miscellany. (line 70) +* nil: Miscellany. (line 61) * number-wt-type: Construction of Weight-Balanced Trees. (line 39) * 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) | +* 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) @@ -18005,8 +18830,8 @@ Variable Index * stdout: Standard Formatted I/O. (line 22) * string-wt-type: Construction of Weight-Balanced Trees. - (line 45) | -* t: Miscellany. (line 67) + (line 45) +* t: Miscellany. (line 58) * tok:decimal-digits: Token definition. (line 41) * tok:lower-case: Token definition. (line 48) * tok:upper-case: Token definition. (line 44) @@ -18034,19 +18859,21 @@ Concept and Feature Index * and-let*: Guarded LET* special form. (line 6) * ange-ftp: URI. (line 118) -* appearance: Solid Modeling. (line 334) | +* appearance: Solid Modeling. (line 334) * array: Arrays. (line 6) * array-for-each: Array Mapping. (line 6) * association function: Association Lists. (line 17) +* Attribute: Parsing XML. (line 460) * attribute-value: HTML. (line 10) +* AttValue: Parsing XML. (line 472) * Auto-sharing: Using Databases. (line 25) * balanced binary trees: Weight-Balanced Trees. (line 8) * base: URI. (line 39) * base-table: Base Table. (line 6) * batch: Batch. (line 6) -* bignum: Feature. (line 13) | -* binary: Byte. (line 66) | +* bignum: Feature. (line 13) +* binary: Byte. (line 66) * binary trees: Weight-Balanced Trees. (line 8) * binary trees, as discrete maps: Weight-Balanced Trees. @@ -18085,11 +18912,11 @@ Concept and Feature Index * commentfix: Rule Types. (line 35) * common-list-functions <1>: Common List Functions. (line 6) -* common-list-functions: Collections. (line 74) +* common-list-functions: Collections. (line 81) * commutative-ring: Commutative Rings. (line 11) * compiled: Library Catalogs. (line 21) * compiling: Module Conventions. (line 11) -* complex: Feature. (line 13) | +* complex: Feature. (line 13) * Coordinated Universal Time: Posix Time. (line 13) * copyright: Copyrights. (line 6) * crc: Cyclic Checksum. (line 6) @@ -18111,12 +18938,12 @@ Concept and Feature Index * delim: Rule Types. (line 47) * dequeues: Queues. (line 10) * determinant: Matrix Algebra. (line 6) -* dft, Fourier-transform: Discrete Fourier Transform. | - (line 6) | +* dft, Fourier-transform: Discrete Fourier Transform. + (line 6) * diff: Sequence Comparison. (line 6) * directory: Directories. (line 6) -* Discrete Fourier Transform: Discrete Fourier Transform. | - (line 18) | +* Discrete Fourier Transform: Discrete Fourier Transform. + (line 18) * discrete maps, using binary trees: Weight-Balanced Trees. (line 52) * DrScheme: Installation. (line 103) @@ -18129,16 +18956,17 @@ Concept and Feature Index * EUC: Extra-SLIB Packages. (line 53) * Euclidean Domain: Commutative Rings. (line 67) * eval: Eval. (line 6) -* exchanger: Miscellany. (line 31) +* exchanger: Miscellany. (line 22) * factor: Prime Numbers. (line 6) -* FDL, GNU Free Documentation License: Copying This Manual. (line 6) | -* feature <1>: About this manual. (line 18) | +* 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) | +* feature: Feature. (line 6) * File Transfer Protocol: URI. (line 113) * file-lock: Transactions. (line 32) * filename: Filenames. (line 6) * fluid-let: Fluid-Let. (line 6) +* fold: Parsing XML. (line 400) * form: HTML. (line 63) * format: Format. (line 6) * Gambit-C: Installation. (line 116) @@ -18174,8 +19002,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) -* inexact: Feature. (line 13) | + (line 128) | +* inexact: Feature. (line 13) * infix: Rule Types. (line 19) * Info: Top-level Variable References. (line 32) @@ -18195,6 +19023,8 @@ Concept and Feature Index (line 88) * Left Denotation, led: Nud and Led Definition. (line 13) +* let-values: Binding to multiple values. + (line 11) | * Lightness: Color Spaces. (line 71) * line-i: Line I/O. (line 6) * list-processing library: SRFI-1. (line 8) @@ -18214,10 +19044,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) | +* 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) @@ -18233,6 +19063,7 @@ Concept and Feature Index (line 6) * MzScheme: Installation. (line 104) * nary: Rule Types. (line 23) +* ncbi-dma: NCBI-DNA. (line 6) * new-catalog: Catalog Creation. (line 48) * nofix: Rule Types. (line 11) * null: HTML Tables. (line 92) @@ -18301,10 +19132,10 @@ Concept and Feature Index * random-inexact: Inexact Random Numbers. (line 6) * range: Column Ranges. (line 6) -* rational: Feature. (line 13) | +* rational: Feature. (line 13) * rationalize: Rationalize. (line 6) * read-command: Command Line. (line 6) -* real: Feature. (line 13) | +* real: Feature. (line 13) * receive: Binding to multiple values. (line 6) * record: Records. (line 6) @@ -18362,22 +19193,29 @@ Concept and Feature Index * srfi: SRFI. (line 6) * SRFI-1: SRFI-1. (line 8) * srfi-1: SRFI-1. (line 6) -* srfi-2 <1>: SRFI. (line 33) | +* srfi-11 <1>: SRFI. (line 37) +* srfi-11: Binding to multiple values. + (line 11) | +* 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-23: SRFI. (line 39) +* srfi-28: SRFI. (line 41) +* srfi-47: SRFI. (line 43) +* srfi-59: SRFI. (line 45) +* srfi-60 <1>: SRFI. (line 47) +* srfi-60: Bit-Twiddling. (line 6) +* srfi-61 <1>: SRFI. (line 49) * srfi-61: Guarded COND Clause. (line 6) -* srfi-63: SRFI. (line 41) | -* srfi-8 <1>: SRFI. (line 33) | +* srfi-63: SRFI. (line 51) +* srfi-8 <1>: SRFI. (line 33) * srfi-8: Binding to multiple values. (line 6) -* srfi-9 <1>: SRFI. (line 35) | +* srfi-9 <1>: SRFI. (line 35) * srfi-9: Define-Record-Type. (line 6) +* srfi-94: SRFI. (line 53) +* srfi-95 <1>: SRFI. (line 56) +* srfi-95: Sorting. (line 6) * sRGB: Color Spaces. (line 189) * stdio: Standard Formatted I/O. (line 14) @@ -18387,7 +19225,7 @@ Concept and Feature Index * subarray: Subarrays. (line 6) * sun: Daylight. (line 6) * sunlight: Daylight. (line 6) -* symmetric: Modular Arithmetic. (line 38) | +* symmetric: Modular Arithmetic. (line 38) * syntactic-closures <1>: Syntactic Closures. (line 6) * syntactic-closures: Library Catalogs. (line 46) * syntax tree: Precedence Parsing Overview. @@ -18443,242 +19281,243 @@ Concept and Feature Index  Tag Table: -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 +Node: Top889 +Node: The Library System2001 +Node: Feature2668 +Ref: Feature-Footnote-14767 +Node: Require5277 +Node: Library Catalogs7690 +Node: Catalog Creation9121 +Node: Catalog Vicinities11496 +Node: Compiling Scheme14256 +Node: Module Conventions14906 +Ref: Module Conventions-Footnote-116211 +Node: Module Manifests16577 +Node: Module Semantics22049 +Node: Top-level Variable References23667 +Ref: Top-level Variable References-Footnote-125626 +Node: Module Analysis26067 +Node: Universal SLIB Procedures27172 +Node: Vicinity27787 +Node: Configuration31642 +Node: Input/Output34614 +Node: System39059 +Node: Miscellany42321 +Node: Scheme Syntax Extension Packages44303 +Node: Defmacro45241 +Node: R4RS Macros47217 +Node: Macro by Example48481 +Node: Macros That Work51379 +Node: Syntactic Closures57373 +Node: Syntax-Case Macros74901 +Node: Define-Structure78832 +Node: Define-Record-Type80808 +Node: Fluid-Let81441 +Node: Binding to multiple values82411 +Node: Guarded LET* special form83253 +Node: Guarded COND Clause83605 +Node: Yasos85390 +Node: Yasos terms86202 +Node: Yasos interface87240 +Node: Setters89336 +Node: Yasos examples91995 +Node: Textual Conversion Packages94953 +Node: Precedence Parsing95806 +Node: Precedence Parsing Overview96491 +Ref: Precedence Parsing Overview-Footnote-196872 +Node: Rule Types98121 +Node: Ruleset Definition and Use99576 +Node: Token definition101959 +Node: Nud and Led Definition104567 +Node: Grammar Rule Definition107028 +Node: Format114624 +Node: Format Interface114938 +Node: Format Specification116688 +Node: Standard Formatted I/O127633 +Node: Standard Formatted Output128221 +Node: Standard Formatted Input137679 +Node: Programs and Arguments144356 +Node: Getopt144864 +Node: Command Line151411 +Node: Parameter lists154609 +Node: Getopt Parameter lists158515 +Node: Filenames161756 +Node: Batch165666 +Node: HTML173574 +Node: HTML Tables180016 +Node: HTTP and CGI186548 +Node: Parsing HTML191097 +Node: URI193604 +Node: Parsing XML198351 +Node: Printing Scheme263178 +Node: Generic-Write263643 +Node: Object-To-String265118 +Node: Pretty-Print265593 +Node: Time and Date268638 +Node: Time Zone269756 +Node: Posix Time274561 +Node: Common-Lisp Time276791 +Node: Time Infrastructure278473 +Node: NCBI-DNA278877 +Node: Schmooz280451 +Node: Mathematical Packages284754 +Node: Bit-Twiddling285509 +Node: Modular Arithmetic294513 +Node: Irrational Integer Functions296944 +Node: Irrational Real Functions297973 +Node: Prime Numbers301577 +Node: Random Numbers303281 +Node: Exact Random Numbers304123 +Node: Inexact Random Numbers306395 +Node: Discrete Fourier Transform308229 +Node: Cyclic Checksum310664 +Node: Graphing318294 +Node: Character Plotting318489 +Node: PostScript Graphing324001 +Node: Column Ranges325780 +Node: Drawing the Graph327259 +Node: Graphics Context328354 +Node: Rectangles330173 +Node: Legending331620 +Node: Legacy Plotting333849 +Node: Example Graph334861 +Node: Solid Modeling339228 +Node: Color358737 +Node: Color Data-Type359573 +Ref: Color Data-Type-Footnote-1328920 +Node: Color Spaces363964 +Ref: Color Spaces-Footnote-1338921 +Node: Spectra373883 +Node: Color Difference Metrics382648 +Node: Color Conversions385330 +Node: Color Names387474 +Node: Daylight394410 +Node: Root Finding399099 +Node: Minimizing403058 +Ref: Minimizing-Footnote-1370311 +Node: The Limit405100 +Node: Commutative Rings409970 +Node: Matrix Algebra421381 +Node: Database Packages423487 +Node: Relational Database423770 +Node: Using Databases424637 +Node: Table Operations431143 +Node: Single Row Operations432354 +Node: Match-Keys434601 +Node: Multi-Row Operations436680 +Node: Indexed Sequential Access Methods439071 +Node: Sequential Index Operations440079 +Node: Table Administration442435 +Node: Database Interpolation443302 +Node: Embedded Commands444404 +Node: Database Extension445978 +Node: Command Intrinsics448103 +Node: Define-tables Example449665 +Node: The *commands* Table451315 +Node: Command Service453593 +Node: Command Example455555 +Node: Database Macros460108 +Node: Within-database460993 +Node: Within-database Example463900 +Node: Database Browser465687 +Node: Relational Infrastructure466763 +Node: Base Table467067 +Node: The Base469575 +Node: Base Tables472693 +Node: Base Field Types474169 +Node: Composite Keys474952 +Node: Base Record Operations477006 +Node: Match Keys478734 +Node: Aggregate Base Operations479615 +Node: Base ISAM Operations480680 +Node: Catalog Representation481998 +Node: Relational Database Objects484667 +Node: Database Operations487311 +Node: Weight-Balanced Trees491020 +Node: Construction of Weight-Balanced Trees494906 +Node: Basic Operations on Weight-Balanced Trees498372 +Node: Advanced Operations on Weight-Balanced Trees501239 +Node: Indexing Operations on Weight-Balanced Trees507280 +Node: Other Packages511121 +Node: Data Structures511650 +Node: Arrays512491 +Node: Subarrays523379 +Node: Array Mapping525621 +Node: Array Interpolation528831 +Node: Association Lists530095 +Node: Byte532371 +Node: Byte/Number Conversions537964 +Node: MAT-File Format545535 +Node: Portable Image Files546814 +Node: Collections548444 +Node: Dynamic Data Type554710 +Node: Hash Tables555989 +Node: Object558577 +Node: Priority Queues566860 +Node: Queues567715 +Node: Records568960 +Node: Sorting and Searching572470 +Node: Common List Functions573163 +Node: List construction573620 +Node: Lists as sets575335 +Node: Lists as sequences581873 +Node: Destructive list operations587100 +Node: Non-List functions589778 +Node: Tree Operations590867 +Node: Chapter Ordering592560 +Node: Sorting594207 +Node: Topological Sort598492 +Node: Hashing600200 +Node: Space-Filling Curves601217 +Node: Hilbert Space-Filling Curve601521 +Node: Peano Space-Filling Curve605411 +Node: Sierpinski Curve606517 +Node: Soundex608981 +Node: String Search610579 +Node: Sequence Comparison613152 +Node: Procedures616282 +Node: Type Coercion616810 +Node: String-Case617242 +Node: String Ports619069 +Node: Line I/O619841 +Node: Multi-Processing621890 +Node: Metric Units623008 +Node: Standards Support631287 +Node: RnRS632083 +Node: With-File633306 +Node: Transcripts633582 +Node: Rev2 Procedures633916 +Node: Rev4 Optional Procedures635649 +Node: Multi-argument / and -636118 +Node: Multi-argument Apply636528 +Node: Rationalize636865 +Node: Promises638027 +Node: Dynamic-Wind638473 +Node: Eval639741 +Node: Values643086 +Node: SRFI643901 +Node: SRFI-1645988 +Node: Session Support650546 +Node: Repl651120 +Node: Quick Print652416 +Node: Debug653722 +Node: Breakpoints654629 +Node: Trace656671 +Node: System Interface659897 +Node: Directories660468 +Node: Transactions661961 +Node: CVS667472 +Node: Extra-SLIB Packages668639 +Node: About SLIB670948 +Node: Installation671733 +Node: The SLIB script677640 +Node: Porting678193 +Ref: Porting-Footnote-1639950 +Node: Coding Guidelines679757 +Node: Copyrights682171 +Node: About this manual685540 +Node: Copying This Manual686172 +Node: How to use this License for your documents707206 +Node: Index708724  End Tag Table diff --git a/slib.nsi b/slib.nsi new file mode 100644 index 0000000..d16a460 --- /dev/null +++ b/slib.nsi @@ -0,0 +1,771 @@ +; Install SLIB on Windows for current user +; Basic script generated by the HM NIS Edit Script Wizard. +; Augmented by Jerry van Dijk, february 2007 +; placed in the public domain + +; *** version numbers *** +!define PRODUCT_VERSION "3a5-1" + +; ----------------[ NO CHANGES BELOW ]---------------- + +; *** unless files are added or removed *** +; *** remember to edit both 'file' and 'delete' sections! + +; *** registry settings *** +!define KEY_VERSION "version" +!define SLIB_KEY "Software\Voluntocracy\slib" + +; *** environment variables *** +!define SlibEnvVar "SCHEME_LIBRARY_PATH" + +; HM NIS Edit Wizard helper defines +!define PRODUCT_NAME "SLIB" +!define PRODUCT_COMPANY "Voluntocracy" +!define PRODUCT_PUBLISHER "Aubrey Jaffer" +!define PRODUCT_WEB_SITE "http://swissnet.ai.mit.edu/~jaffer/SLIB" +!define PRODUCT_DIR_REGKEY "Software\Microsoft\Windows\CurrentVersion\App Paths\slib-${PRODUCT_VERSION}.exe" +!define PRODUCT_UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\${PRODUCT_NAME}" +!define PRODUCT_UNINST_ROOT_KEY "HKLM" +!define PRODUCT_STARTMENU_REGVAL "NSIS:StartMenuDir" + +; MUI 1.67 compatible ------ +!include "MUI.nsh" + +; MUI Settings +!define MUI_ABORTWARNING +!define MUI_ICON "${NSISDIR}\Contrib\Graphics\Icons\modern-install.ico" +!define MUI_UNICON "${NSISDIR}\Contrib\Graphics\Icons\modern-uninstall.ico" + +; Welcome page +!insertmacro MUI_PAGE_WELCOME + +; License page +!insertmacro MUI_PAGE_LICENSE "COPYING" + +; Directory page +!insertmacro MUI_PAGE_DIRECTORY + +; Start menu page +var ICONS_GROUP +!define MUI_STARTMENUPAGE_NODISABLE +!define MUI_STARTMENUPAGE_DEFAULTFOLDER "slib" +!define MUI_STARTMENUPAGE_REGISTRY_ROOT "${PRODUCT_UNINST_ROOT_KEY}" +!define MUI_STARTMENUPAGE_REGISTRY_KEY "${PRODUCT_UNINST_KEY}" +!define MUI_STARTMENUPAGE_REGISTRY_VALUENAME "${PRODUCT_STARTMENU_REGVAL}" +!insertmacro MUI_PAGE_STARTMENU Application $ICONS_GROUP + +; Instfiles page +!insertmacro MUI_PAGE_INSTFILES + +; Finish page +!insertmacro MUI_PAGE_FINISH + +; Uninstaller pages +!insertmacro MUI_UNPAGE_INSTFILES + +; Language files +!insertmacro MUI_LANGUAGE "English" + +; MUI end ------ + +Name "${PRODUCT_NAME} ${PRODUCT_VERSION}" +OutFile "SLIB-${PRODUCT_VERSION}.exe" +InstallDir "$PROGRAMFILES\slib" +InstallDirRegKey ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_DIR_REGKEY}" "" +ShowInstDetails show +ShowUnInstDetails show + +; Check for existing older install +Function .onInit + ReadRegStr $0 ${PRODUCT_UNINST_ROOT_KEY} "${SLIB_KEY}" "${KEY_VERSION}" + StrCmp $0 '' +5 0 + StrCmp $0 ${PRODUCT_VERSION} +4 0 + MessageBox MB_OK|MB_ICONSTOP "You already have SLIB version $0 installed. Please uninstall this first." + Abort +FunctionEnd + +Section "MainSection" SEC01 + SetOutPath "$INSTDIR" + SetOverwrite try + File "alist.scm" + File "alist.txi" + File "alistab.scm" + File "ANNOUNCE" + File "array.scm" + File "array.txi" + File "arraymap.scm" + File "arraymap.txi" + File "batch.scm" + File "Bev2slib.scm" + File "break.scm" + File "byte.scm" + File "byte.txi" + File "bytenumb.scm" + File "bytenumb.txi" + File "ChangeLog" + File "chap.scm" + File "chap.txi" + File "charplot.scm" + File "cie1931.xyz" + File "cie1964.xyz" + File "ciesia.dat" + File "ciesid65.dat" + File "clrnamdb.scm" + File "cltime.scm" + File "coerce.scm" + File "coerce.txi" + File "collect.scm" + File "collectx.scm" + File "color.scm" + File "color.txi" + File "colornam.scm" + File "colornam.txi" + File "colorspc.scm" + File "comlist.scm" + File "comparse.scm" + File "comparse.txi" + File "COPYING" + File "crc.scm" + File "cring.scm" + File "cvs.scm" + File "cvs.txi" + File "daylight.scm" + File "daylight.txi" + File "db2html.scm" + File "db2html.txi" + File "dbcom.scm" + File "dbinterp.scm" + File "dbrowse.scm" + File "dbsyn.scm" + File "dbutil.scm" + File "dbutil.txi" + File "debug.scm" + File "defmacex.scm" + File "determ.scm" + File "determ.txi" + File "dft.scm" + File "dft.txi" + File "differ.scm" + File "differ.txi" + File "dirs.scm" + File "dirs.txi" + File "dwindtst.scm" + File "dynamic.scm" + File "dynwind.scm" + File "eval.scm" + File "factor.scm" + File "factor.txi" + File "FAQ" + File "fdl.texi" + File "fluidlet.scm" + File "format.scm" + File "format.texi" + File "formatst.scm" + File "genwrite.scm" + File "getopt.scm" + File "getparam.scm" + File "getparam.txi" + File "glob.scm" + File "glob.txi" + File "grapheps.ps" + File "grapheps.scm" + File "grapheps.txi" + File "hash.scm" + File "hashtab.scm" + File "hashtab.txi" + File "html4each.scm" + File "html4each.txi" + File "htmlform.scm" + File "htmlform.txi" + File "http-cgi.scm" + File "http-cgi.txi" + File "indexes.texi" + File "limit.scm" + File "limit.texi" + File "lineio.scm" + File "lineio.txi" + File "linterp.scm" + File "linterp.txi" + File "logical.scm" + File "macrotst.scm" + File "macwork.scm" + File "Makefile" + File "manifest.scm" + File "manifest.txi" + File "matfile.scm" + File "matfile.txi" + File "math-integer.scm" + File "math-integer.txi" + File "math-real.scm" + File "mbe.scm" + File "minimize.scm" + File "minimize.txi" + File "mkclrnam.scm" + File "mkclrnam.txi" + File "mklibcat.scm" + File "modular.scm" + File "modular.txi" + File "mulapply.scm" + File "mularg.scm" + File "mwdenote.scm" + File "mwexpand.scm" + File "mwsynrul.scm" + File "nbs-iscc.txt" + File "ncbi-dna.scm" + File "ncbi-dna.txi" + File "null.scm" + File "obj2str.scm" + File "obj2str.txi" + File "object.scm" + File "object.texi" + File "paramlst.scm" + File "peanosfc.scm" + File "peanosfc.txi" + File "phil-spc.scm" + File "phil-spc.txi" + File "pnm.scm" + File "pnm.txi" + File "pp.scm" + File "ppfile.scm" + File "prec.scm" + File "printf.scm" + File "priorque.scm" + File "priorque.txi" + File "process.scm" + File "promise.scm" + File "psxtime.scm" + File "qp.scm" + File "queue.scm" + File "queue.txi" + File "r4rsyn.scm" + File "randinex.scm" + File "randinex.txi" + File "random.scm" + File "random.txi" + File "ratize.scm" + File "ratize.txi" + File "rdms.scm" + File "README" + File "recobj.scm" + File "record.scm" + File "repl.scm" + File "require.scm" + File "resenecolours.txt" + File "root.scm" + File "saturate.txt" + File "sc2.scm" + File "sc4opt.scm" + File "sc4sc3.scm" + File "scaexpp.scm" + File "scaglob.scm" + File "scainit.scm" + File "scamacr.scm" + File "scanf.scm" + File "scaoutp.scm" + File "schmooz.scm" + File "schmooz.texi" + File "scm.init" + File "scmacro.scm" + File "selfset.scm" + File "sierpinski.scm" + File "simetrix.scm" + File "slib.html" + File "slib.nsi" + File "slib.spec" + File "slib.texi" + File "solid.scm" + File "solid.txi" + File "sort.scm" + File "soundex.scm" + File "srfi-1.scm" + File "srfi-1.txi" + File "srfi-2.scm" + File "srfi-23.scm" + File "srfi-61.scm" + File "srfi-8.scm" + File "srfi-9.scm" + File "srfi.scm" + File "srfi.txi" + File "stdio.scm" + File "strcase.scm" + File "strport.scm" + File "strsrch.scm" + File "structure.scm" + File "subarray.scm" + File "subarray.txi" + File "syncase.sh" + File "synchk.scm" + File "synclo.scm" + File "synrul.scm" + File "Template.scm" + File "timecore.scm" + File "timezone.scm" + File "top-refs.scm" + File "top-refs.txi" + File "trace.scm" + File "transact.scm" + File "transact.txi" + File "tree.scm" + File "tree.txi" + File "trnscrpt.scm" + File "tsort.scm" + File "tsort.txi" + File "tzfile.scm" + File "uri.scm" + File "uri.txi" + File "values.scm" + File "version.txi" + File "vet.scm" + File "vet.txi" + File "withfile.scm" + File "wttest.scm" + File "wttree.scm" + File "yasyn.scm" + +; Shortcuts + !insertmacro MUI_STARTMENU_WRITE_BEGIN Application + CreateDirectory "$SMPROGRAMS\$ICONS_GROUP" + CreateShortCut "$SMPROGRAMS\$ICONS_GROUP\SLIB Manual.lnk" "$INSTDIR\slib.html" + !insertmacro MUI_STARTMENU_WRITE_END + +; Jaffer slib registry settings + WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${SLIB_KEY}" "${KEY_VERSION}" "${PRODUCT_VERSION}" + +; Jaffer slib environment variables + Push ${SlibEnvVar} + Push "$INSTDIR\" + Call WriteEnvStr + +SectionEnd + +Section -AdditionalIcons + !insertmacro MUI_STARTMENU_WRITE_BEGIN Application + WriteIniStr "$INSTDIR\${PRODUCT_NAME}.url" "InternetShortcut" "URL" "${PRODUCT_WEB_SITE}" + CreateShortCut "$SMPROGRAMS\$ICONS_GROUP\Website.lnk" "$INSTDIR\${PRODUCT_NAME}.url" + CreateShortCut "$SMPROGRAMS\$ICONS_GROUP\Uninstall.lnk" "$INSTDIR\uninst.exe" + !insertmacro MUI_STARTMENU_WRITE_END +SectionEnd + +Section -Post + WriteUninstaller "$INSTDIR\uninst.exe" + WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_DIR_REGKEY}" "" "$INSTDIR\slib-${PRODUCT_VERSION}.exe" + WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "DisplayName" "$(^Name)" + WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "UninstallString" "$INSTDIR\uninst.exe" + WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "DisplayIcon" "$INSTDIR\slib-${PRODUCT_VERSION}.exe" + WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "DisplayVersion" "${PRODUCT_VERSION}" + WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "URLInfoAbout" "${PRODUCT_WEB_SITE}" + WriteRegStr ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" "Publisher" "${PRODUCT_PUBLISHER}" +SectionEnd + +Function .onInstSuccess + IfRebootFlag 0 noreboot + MessageBox MB_YESNO|MB_ICONQUESTION|MB_DEFBUTTON1 "A reboot is required to finish the installation. Do you wish to reboot now?" IDNO noreboot + Reboot + noreboot: +FunctionEnd + +Function un.onUninstSuccess + HideWindow + MessageBox MB_ICONINFORMATION|MB_OK "$(^Name) was successfully removed from your computer." +FunctionEnd + +Function un.onInit + MessageBox MB_ICONQUESTION|MB_YESNO|MB_DEFBUTTON2 "Are you sure you want to completely remove $(^Name) and all of its components?" IDYES +2 + Abort +FunctionEnd + +Section Uninstall + !insertmacro MUI_STARTMENU_GETFOLDER "Application" $ICONS_GROUP + Delete "$INSTDIR\${PRODUCT_NAME}.url" + Delete "$INSTDIR\uninst.exe" + Delete "$INSTDIR\yasyn.scm" + Delete "$INSTDIR\wttree.scm" + Delete "$INSTDIR\wttest.scm" + Delete "$INSTDIR\withfile.scm" + Delete "$INSTDIR\vet.txi" + Delete "$INSTDIR\vet.scm" + Delete "$INSTDIR\version.txi" + Delete "$INSTDIR\values.scm" + Delete "$INSTDIR\uri.txi" + Delete "$INSTDIR\uri.scm" + Delete "$INSTDIR\tzfile.scm" + Delete "$INSTDIR\tsort.txi" + Delete "$INSTDIR\tsort.scm" + Delete "$INSTDIR\trnscrpt.scm" + Delete "$INSTDIR\tree.txi" + Delete "$INSTDIR\tree.scm" + Delete "$INSTDIR\transact.txi" + Delete "$INSTDIR\transact.scm" + Delete "$INSTDIR\trace.scm" + Delete "$INSTDIR\top-refs.txi" + Delete "$INSTDIR\top-refs.scm" + Delete "$INSTDIR\timezone.scm" + Delete "$INSTDIR\timecore.scm" + Delete "$INSTDIR\Template.scm" + Delete "$INSTDIR\synrul.scm" + Delete "$INSTDIR\synclo.scm" + Delete "$INSTDIR\synchk.scm" + Delete "$INSTDIR\syncase.sh" + Delete "$INSTDIR\subarray.txi" + Delete "$INSTDIR\subarray.scm" + Delete "$INSTDIR\structure.scm" + Delete "$INSTDIR\strsrch.scm" + Delete "$INSTDIR\strport.scm" + Delete "$INSTDIR\strcase.scm" + Delete "$INSTDIR\stdio.scm" + Delete "$INSTDIR\srfi.txi" + Delete "$INSTDIR\srfi.scm" + Delete "$INSTDIR\srfi-9.scm" + Delete "$INSTDIR\srfi-8.scm" + Delete "$INSTDIR\srfi-61.scm" + Delete "$INSTDIR\srfi-23.scm" + Delete "$INSTDIR\srfi-2.scm" + Delete "$INSTDIR\srfi-1.txi" + Delete "$INSTDIR\srfi-1.scm" + Delete "$INSTDIR\soundex.scm" + Delete "$INSTDIR\sort.scm" + Delete "$INSTDIR\solid.txi" + Delete "$INSTDIR\solid.scm" + Delete "$INSTDIR\slib.texi" + Delete "$INSTDIR\slib.spec" + Delete "$INSTDIR\slib.nsi" + Delete "$INSTDIR\slib.html" + Delete "$INSTDIR\simetrix.scm" + Delete "$INSTDIR\sierpinski.scm" + Delete "$INSTDIR\selfset.scm" + Delete "$INSTDIR\scmacro.scm" + Delete "$INSTDIR\scm.init" + Delete "$INSTDIR\schmooz.texi" + Delete "$INSTDIR\schmooz.scm" + Delete "$INSTDIR\scaoutp.scm" + Delete "$INSTDIR\scanf.scm" + Delete "$INSTDIR\scamacr.scm" + Delete "$INSTDIR\scainit.scm" + Delete "$INSTDIR\scaglob.scm" + Delete "$INSTDIR\scaexpp.scm" + Delete "$INSTDIR\sc4sc3.scm" + Delete "$INSTDIR\sc4opt.scm" + Delete "$INSTDIR\sc2.scm" + Delete "$INSTDIR\saturate.txt" + Delete "$INSTDIR\root.scm" + Delete "$INSTDIR\resenecolours.txt" + Delete "$INSTDIR\require.scm" + Delete "$INSTDIR\repl.scm" + Delete "$INSTDIR\record.scm" + Delete "$INSTDIR\recobj.scm" + Delete "$INSTDIR\README" + Delete "$INSTDIR\rdms.scm" + Delete "$INSTDIR\ratize.txi" + Delete "$INSTDIR\ratize.scm" + Delete "$INSTDIR\random.txi" + Delete "$INSTDIR\random.scm" + Delete "$INSTDIR\randinex.txi" + Delete "$INSTDIR\randinex.scm" + Delete "$INSTDIR\r4rsyn.scm" + Delete "$INSTDIR\queue.txi" + Delete "$INSTDIR\queue.scm" + Delete "$INSTDIR\qp.scm" + Delete "$INSTDIR\psxtime.scm" + Delete "$INSTDIR\promise.scm" + Delete "$INSTDIR\process.scm" + Delete "$INSTDIR\priorque.txi" + Delete "$INSTDIR\priorque.scm" + Delete "$INSTDIR\printf.scm" + Delete "$INSTDIR\prec.scm" + Delete "$INSTDIR\ppfile.scm" + Delete "$INSTDIR\pp.scm" + Delete "$INSTDIR\pnm.txi" + Delete "$INSTDIR\pnm.scm" + Delete "$INSTDIR\phil-spc.txi" + Delete "$INSTDIR\phil-spc.scm" + Delete "$INSTDIR\peanosfc.txi" + Delete "$INSTDIR\peanosfc.scm" + Delete "$INSTDIR\paramlst.scm" + Delete "$INSTDIR\object.texi" + Delete "$INSTDIR\object.scm" + Delete "$INSTDIR\obj2str.txi" + Delete "$INSTDIR\obj2str.scm" + Delete "$INSTDIR\null.scm" + Delete "$INSTDIR\ncbi-dna.txi" + Delete "$INSTDIR\ncbi-dna.scm" + Delete "$INSTDIR\nbs-iscc.txt" + Delete "$INSTDIR\mwsynrul.scm" + Delete "$INSTDIR\mwexpand.scm" + Delete "$INSTDIR\mwdenote.scm" + Delete "$INSTDIR\mularg.scm" + Delete "$INSTDIR\mulapply.scm" + Delete "$INSTDIR\modular.txi" + Delete "$INSTDIR\modular.scm" + Delete "$INSTDIR\mklibcat.scm" + Delete "$INSTDIR\mkclrnam.txi" + Delete "$INSTDIR\mkclrnam.scm" + Delete "$INSTDIR\minimize.txi" + Delete "$INSTDIR\minimize.scm" + Delete "$INSTDIR\mbe.scm" + Delete "$INSTDIR\math-real.scm" + Delete "$INSTDIR\math-integer.txi" + Delete "$INSTDIR\math-integer.scm" + Delete "$INSTDIR\matfile.txi" + Delete "$INSTDIR\matfile.scm" + Delete "$INSTDIR\manifest.txi" + Delete "$INSTDIR\manifest.scm" + Delete "$INSTDIR\Makefile" + Delete "$INSTDIR\macwork.scm" + Delete "$INSTDIR\macrotst.scm" + Delete "$INSTDIR\logical.scm" + Delete "$INSTDIR\linterp.txi" + Delete "$INSTDIR\linterp.scm" + Delete "$INSTDIR\lineio.txi" + Delete "$INSTDIR\lineio.scm" + Delete "$INSTDIR\limit.texi" + Delete "$INSTDIR\limit.scm" + Delete "$INSTDIR\indexes.texi" + Delete "$INSTDIR\http-cgi.txi" + Delete "$INSTDIR\http-cgi.scm" + Delete "$INSTDIR\htmlform.txi" + Delete "$INSTDIR\htmlform.scm" + Delete "$INSTDIR\html4each.txi" + Delete "$INSTDIR\html4each.scm" + Delete "$INSTDIR\hashtab.txi" + Delete "$INSTDIR\hashtab.scm" + Delete "$INSTDIR\hash.scm" + Delete "$INSTDIR\grapheps.txi" + Delete "$INSTDIR\grapheps.scm" + Delete "$INSTDIR\grapheps.ps" + Delete "$INSTDIR\glob.txi" + Delete "$INSTDIR\glob.scm" + Delete "$INSTDIR\getparam.txi" + Delete "$INSTDIR\getparam.scm" + Delete "$INSTDIR\getopt.scm" + Delete "$INSTDIR\genwrite.scm" + Delete "$INSTDIR\formatst.scm" + Delete "$INSTDIR\format.texi" + Delete "$INSTDIR\format.scm" + Delete "$INSTDIR\fluidlet.scm" + Delete "$INSTDIR\fdl.texi" + Delete "$INSTDIR\FAQ" + Delete "$INSTDIR\factor.txi" + Delete "$INSTDIR\factor.scm" + Delete "$INSTDIR\eval.scm" + Delete "$INSTDIR\dynwind.scm" + Delete "$INSTDIR\dynamic.scm" + Delete "$INSTDIR\dwindtst.scm" + Delete "$INSTDIR\dirs.txi" + Delete "$INSTDIR\dirs.scm" + Delete "$INSTDIR\differ.txi" + Delete "$INSTDIR\differ.scm" + Delete "$INSTDIR\dft.txi" + Delete "$INSTDIR\dft.scm" + Delete "$INSTDIR\determ.txi" + Delete "$INSTDIR\determ.scm" + Delete "$INSTDIR\defmacex.scm" + Delete "$INSTDIR\debug.scm" + Delete "$INSTDIR\dbutil.txi" + Delete "$INSTDIR\dbutil.scm" + Delete "$INSTDIR\dbsyn.scm" + Delete "$INSTDIR\dbrowse.scm" + Delete "$INSTDIR\dbinterp.scm" + Delete "$INSTDIR\dbcom.scm" + Delete "$INSTDIR\db2html.txi" + Delete "$INSTDIR\db2html.scm" + Delete "$INSTDIR\daylight.txi" + Delete "$INSTDIR\daylight.scm" + Delete "$INSTDIR\cvs.txi" + Delete "$INSTDIR\cvs.scm" + Delete "$INSTDIR\cring.scm" + Delete "$INSTDIR\crc.scm" + Delete "$INSTDIR\COPYING" + Delete "$INSTDIR\comparse.txi" + Delete "$INSTDIR\comparse.scm" + Delete "$INSTDIR\comlist.scm" + Delete "$INSTDIR\colorspc.scm" + Delete "$INSTDIR\colornam.txi" + Delete "$INSTDIR\colornam.scm" + Delete "$INSTDIR\color.txi" + Delete "$INSTDIR\color.scm" + Delete "$INSTDIR\collectx.scm" + Delete "$INSTDIR\collect.scm" + Delete "$INSTDIR\coerce.txi" + Delete "$INSTDIR\coerce.scm" + Delete "$INSTDIR\cltime.scm" + Delete "$INSTDIR\clrnamdb.scm" + Delete "$INSTDIR\ciesid65.dat" + Delete "$INSTDIR\ciesia.dat" + Delete "$INSTDIR\cie1964.xyz" + Delete "$INSTDIR\cie1931.xyz" + Delete "$INSTDIR\charplot.scm" + Delete "$INSTDIR\chap.txi" + Delete "$INSTDIR\chap.scm" + Delete "$INSTDIR\ChangeLog" + Delete "$INSTDIR\bytenumb.txi" + Delete "$INSTDIR\bytenumb.scm" + Delete "$INSTDIR\byte.txi" + Delete "$INSTDIR\byte.scm" + Delete "$INSTDIR\break.scm" + Delete "$INSTDIR\Bev2slib.scm" + Delete "$INSTDIR\batch.scm" + Delete "$INSTDIR\arraymap.txi" + Delete "$INSTDIR\arraymap.scm" + Delete "$INSTDIR\array.txi" + Delete "$INSTDIR\array.scm" + Delete "$INSTDIR\ANNOUNCE" + Delete "$INSTDIR\alistab.scm" + Delete "$INSTDIR\alist.txi" + Delete "$INSTDIR\alist.scm" + + Delete "$SMPROGRAMS\$ICONS_GROUP\Uninstall.lnk" + Delete "$SMPROGRAMS\$ICONS_GROUP\Website.lnk" + Delete "$SMPROGRAMS\$ICONS_GROUP\SLIB Manual.lnk" + + RMDir "$SMPROGRAMS\$ICONS_GROUP" + RMDir "$INSTDIR" + + ; remove Jaffer registry entries + DeleteRegKey ${PRODUCT_UNINST_ROOT_KEY} "${SLIB_KEY}" + + DeleteRegKey ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_UNINST_KEY}" + DeleteRegKey ${PRODUCT_UNINST_ROOT_KEY} "${PRODUCT_DIR_REGKEY}" + SetAutoClose true + + # remove the slib environment variables + Push ${SlibEnvVar} + Call un.DeleteEnvStr + +SectionEnd + +; ----------------[ ENVIRONMENT MANIPULATION ]---------------- + +!ifndef WriteEnvStr_RegKey + !ifdef ALL_USERS + !define WriteEnvStr_RegKey 'HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"' + !else + !define WriteEnvStr_RegKey 'HKCU "Environment"' + !endif +!endif + +# +# WriteEnvStr - Writes an environment variable +# Note: Win9x systems requires reboot +# +# Example: +# Push "HOMEDIR" # name +# Push "C:\New Home Dir\" # value +# Call WriteEnvStr +# +Function WriteEnvStr + Exch $1 ; $1 has environment variable value + Exch + Exch $0 ; $0 has environment variable name + Push $2 + + Call IsNT + Pop $2 + StrCmp $2 1 WriteEnvStr_NT + ; Not on NT + StrCpy $2 $WINDIR 2 ; Copy drive of windows (c:) + FileOpen $2 "$2\autoexec.bat" a + FileSeek $2 0 END + FileWrite $2 "$\r$\nSET $0=$1$\r$\n" + FileClose $2 + SetRebootFlag true + Goto WriteEnvStr_done + + WriteEnvStr_NT: + WriteRegExpandStr ${WriteEnvStr_RegKey} $0 $1 + SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000 + + WriteEnvStr_done: + Pop $2 + Pop $0 + Pop $1 +FunctionEnd + +# +# un.DeleteEnvStr - Removes an environment variable +# Note: Win9x systems requires reboot +# +# Example: +# Push "HOMEDIR" # name +# Call un.DeleteEnvStr +# +Function un.DeleteEnvStr + Exch $0 ; $0 now has the name of the variable + Push $1 + Push $2 + Push $3 + Push $4 + Push $5 + + Call un.IsNT + Pop $1 + StrCmp $1 1 DeleteEnvStr_NT + ; Not on NT + StrCpy $1 $WINDIR 2 + FileOpen $1 "$1\autoexec.bat" r + GetTempFileName $4 + FileOpen $2 $4 w + StrCpy $0 "SET $0=" + SetRebootFlag true + + DeleteEnvStr_dosLoop: + FileRead $1 $3 + StrLen $5 $0 + StrCpy $5 $3 $5 + StrCmp $5 $0 DeleteEnvStr_dosLoop + StrCmp $5 "" DeleteEnvStr_dosLoopEnd + FileWrite $2 $3 + Goto DeleteEnvStr_dosLoop + + DeleteEnvStr_dosLoopEnd: + FileClose $2 + FileClose $1 + StrCpy $1 $WINDIR 2 + Delete "$1\autoexec.bat" + CopyFiles /SILENT $4 "$1\autoexec.bat" + Delete $4 + Goto DeleteEnvStr_done + + DeleteEnvStr_NT: + DeleteRegValue ${WriteEnvStr_RegKey} $0 + SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000 + + DeleteEnvStr_done: + Pop $5 + Pop $4 + Pop $3 + Pop $2 + Pop $1 + Pop $0 +FunctionEnd + +; ----------------[ OS TYPE DETERMINATION ]---------------- + +# +# [un.]IsNT - Pushes 1 if running on NT, 0 if not +# +# Example: +# Call IsNT +# Pop $0 +# StrCmp $0 1 +3 +# MessageBox MB_OK "Not running on NT!" +# Goto +2 +# MessageBox MB_OK "Running on NT!" +# +!macro IsNT UN +Function ${UN}IsNT + Push $0 + ReadRegStr $0 HKLM "SOFTWARE\Microsoft\Windows NT\CurrentVersion" CurrentVersion + StrCmp $0 "" 0 IsNT_yes + ; we are not NT. + Pop $0 + Push 0 + Return + + IsNT_yes: + ; NT!!! + Pop $0 + Push 1 +FunctionEnd +!macroend +!insertmacro IsNT "" +!insertmacro IsNT "un." diff --git a/slib.sh b/slib.sh index 0186442..6948389 100755 --- a/slib.sh +++ b/slib.sh @@ -28,18 +28,17 @@ Usage: slib SCHEME Usage: slib - Initialize SLIB session using executable 'scheme', 'scm', - 'mzscheme', 'guile', 'gsi' or 'slib48'." + Initialize SLIB session using executable (MIT) 'scheme', 'scm', + 'gsi', 'mzscheme', 'guile', 'slib48', 'scmlit', 'elk', 'sisc', or + 'kawa'." case "$1" in -v | --ver*) echo slib "$VERSION"; exit 0;; - "") - if type scheme>/dev/null 2>&1; then - command=scheme + "") if type scheme>/dev/null 2>&1; then + command=scheme fi;; -*) echo "$usage"; exit 1;; - *) - command="$1" + *) command="$1" shift esac # If more arguments are supplied, then err out. @@ -62,6 +61,10 @@ if [ -z "$command" ]; then command=scmlit; implementation=scm elif type elk>/dev/null 2>&1; then command=elk; implementation=elk + elif type sisc>/dev/null 2>&1; then + command=sisc; implementation=ssc + elif type kawa>/dev/null 2>&1; then + command=kawa; implementation=kwa else echo No Scheme implementation found. exit 1 @@ -78,6 +81,8 @@ elif type $command>/dev/null 2>&1; then elif echo ${SPEW} | grep 'MzScheme' >/dev/null 2>&1; then implementation=plt elif echo ${SPEW} | grep 'Guile' >/dev/null 2>&1; then implementation=gui elif echo ${SPEW} | grep 'SCM' >/dev/null 2>&1; then implementation=scm + elif echo ${SPEW} | grep 'SISC' >/dev/null 2>&1; then implementation=ssc + elif echo ${SPEW} | grep 'Kawa' >/dev/null 2>&1; then implementation=kwa else implementation= fi else @@ -116,6 +121,8 @@ case $implementation in scm) exec $command -ip1 -l ${SCHEME_LIBRARY_PATH}scm.init "$@";; elk) exec $command -i -l ${SCHEME_LIBRARY_PATH}elk.init "$@";; gam) exec $command -:s ${SCHEME_LIBRARY_PATH}gambit.init - "$@";; + ssc) exec $command -e "(load \"${SCHEME_LIBRARY_PATH}sisc.init\")" -- "$@";; + kwa) exec $command -f ${SCHEME_LIBRARY_PATH}kawa.init -- "$@";; plt) exec $command -f ${SCHEME_LIBRARY_PATH}DrScheme.init "$@";; gui) exec $command -l ${SCHEME_LIBRARY_PATH}guile.init "$@";; mit) exec $command -load ${SCHEME_LIBRARY_PATH}mitscheme.init "$@";; diff --git a/slib.spec b/slib.spec index d651e75..0b3b7b6 100644 --- a/slib.spec +++ b/slib.spec @@ -1,6 +1,6 @@ Summary: platform independent library for scheme Name: slib -Version: 3a4 +Version: 3a5 Release: 1 Group: Development/Languages BuildArch: noarch @@ -78,7 +78,7 @@ make catalogs %preun cd %{_datadir}/slib/ -rm -f srcdir.mk slib.image +rm -f slib.image %files %defattr(-, root, root) diff --git a/slib.texi b/slib.texi index 3a5de3f..10f9f60 100644 --- a/slib.texi +++ b/slib.texi @@ -18,21 +18,16 @@ 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. +Copyright @copyright{} 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, +2002, 2003, 2004, 2005, 2006, 2007 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.'' +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 quotation @end copying @@ -148,8 +143,8 @@ returns @code{#t} if the symbol @var{feature} is the @code{software-type}, the @code{scheme-implementation-type} @footnote{scheme-implementation-type is the name symbol of the running Scheme implementation (RScheme, |STk|, Bigloo, chez, Elk, gambit, -guile, JScheme, MacScheme, MITScheme, Pocket-Scheme, Scheme48, -Scheme->C, Scheme48, Scsh, T, umb-scheme, or Vscm). Dependence on +guile, JScheme, kawa, MacScheme, MITScheme, Pocket-Scheme, Scheme48, +Scheme->C, Scheme48, Scsh, SISC, T, umb-scheme, or Vscm). Dependence on scheme-implementation-type is almost always the wrong way to do things.}, or if @var{feature} has been provided by a module already loaded; and @code{#f} otherwise. @@ -280,8 +275,8 @@ The catalog can also be queried using @code{slib:in-catalog?}. Returns a @code{CDR} of the catalog entry if one was found for the symbol @var{feature} in the alist @code{*catalog*} (and transitively through any symbol aliases encountered). Otherwise, returns -@code{#f}. The format of catalog entries is explained in @ref{Library -Catalogs}. +@code{#f}. The format of catalog entries is explained in +@ref{Library Catalogs}. @end defun @@ -636,14 +631,12 @@ constructs may be to treat @code{provided?} as a macro. @include top-refs.txi - @node Module Analysis, , Top-level Variable References, Compiling Scheme @subsection Module Analysis @include vet.txi - @node Universal SLIB Procedures, Scheme Syntax Extension Packages, The Library System, Top @chapter Universal SLIB Procedures @@ -660,7 +653,6 @@ implementations as part of the @samp{*.init} files or by * Miscellany:: @end menu - @node Vicinity, Configuration, Universal SLIB Procedures, Universal SLIB Procedures @section Vicinity @@ -767,7 +759,6 @@ variable is used for messages and @code{program-vicinity}. @end defun - @node Configuration, Input/Output, Vicinity, Universal SLIB Procedures @section Configuration @@ -854,6 +845,7 @@ implementation *catalog* : @end example @end defun + @node Input/Output, System, Configuration, Universal SLIB Procedures @section Input/Output @@ -940,6 +932,20 @@ omitted, in which case it defaults to the value returned by @code{(current-output-port)}. @end deffn +@defun file-position port +@defunx file-position port #f +@var{port} must be open to a file. @code{file-position} returns the +current position of the character in @var{port} which will next be +read or written. If the implementation does not support +file-position, then @code{#f} is returned. + +@defunx file-position port k +@var{port} must be open to a file. @code{file-position} sets the +current position in @var{port} which will next be read or written. If +successful, @code{#f} is returned; otherwise @code{file-position} +returns @code{#f}. +@end defun + @defun output-port-width @defunx output-port-width port @@ -1015,26 +1021,27 @@ loop. @deffn {Procedure} slib:exit n @deffnx {Procedure} slib:exit Exits from the Scheme session returning status @var{n} to the system. -If @var{n} is omitted or @code{#t}, a success status is returned to the -system (if possible). If @var{n} is @code{#f} a failure is returned to -the system (if possible). If @var{n} is an integer, then @var{n} is -returned to the system (if possible). If the Scheme session cannot exit -an unspecified value is returned from @code{slib:exit}. +If @var{n} is omitted or @code{#t}, a success status is returned to +the system (if possible). If @var{n} is @code{#f} a failure is +returned to the system (if possible). If @var{n} is an integer, then +@var{n} is returned to the system (if possible). If the Scheme +session cannot exit, then an unspecified value is returned from +@code{slib:exit}. @end deffn @defun browse-url url Web browsers have become so ubiquitous that programming languagues should support a uniform interface to them. -If a @samp{netscape} browser is running, @code{browse-url} causes the -browser to display the page specified by string @var{url} and returns -#t. +If a browser is running, @code{browse-url} causes the browser to +display the page specified by string @var{url} and returns @code{#t}. If the browser is not running, @code{browse-url} starts a browser displaying the argument @var{url}. If the browser starts as a -background job, @code{browse-url} returns #t immediately; if the -browser starts as a foreground job, then @code{browse-url} returns #t -when the browser exits; otherwise it returns #f. +background job, @code{browse-url} returns @code{#t} immediately; if +the browser starts as a foreground job, then @code{browse-url} returns +@code{#t} when the browser exits; otherwise (if no browser) it returns +@code{#f}. @end defun @@ -1057,18 +1064,6 @@ Example: @end lisp @end defun -@defun expt n k -Returns @var{n} raised to the non-negative integer exponent @var{k}. - -Example: -@lisp -(expt 2 5) - @result{} 32 -(expt -3 3) - @result{} -27 -@end lisp -@end defun - @subsection Mutual Exclusion @@ -1159,7 +1154,6 @@ Syntax extensions (macros) included with SLIB. * Yasos:: 'yasos, 'oop, 'collect @end menu - @node Defmacro, R4RS Macros, Scheme Syntax Extension Packages, Scheme Syntax Extension Packages @section Defmacro @@ -1222,6 +1216,7 @@ Returns the result of expanding all defmacros in scheme expression @var{e}. @end defun + @node R4RS Macros, Macro by Example, Defmacro, Scheme Syntax Extension Packages @section R4RS Macros @@ -1253,6 +1248,7 @@ code expressions and definitions may contain macro definitions. The @code{current-input-port} and @code{current-output-port}. @end deffn + @node Macro by Example, Macros That Work, R4RS Macros, Scheme Syntax Extension Packages @section Macro by Example @@ -1281,9 +1277,10 @@ natively supported (most implementations) @end itemize @subsection Caveat -These macros are not referentially transparent (@pxref{Macros, , ,r4rs, -Revised(4) Scheme}). Lexically scoped macros (i.e., @code{let-syntax} -and @code{letrec-syntax}) are not supported. In any case, the problem +These macros are not referentially transparent +(@pxref{Macros, , ,r4rs, Revised(4) Scheme}). Lexically scoped macros +(i.e., @code{let-syntax} and @code{letrec-syntax}) are not supported. +In any case, the problem of referential transparency gains poignancy only when @code{let-syntax} and @code{letrec-syntax} are used. So you will not be courting large-scale disaster unless you're using system-function names as local @@ -1334,6 +1331,7 @@ involved in the matching and is not considered a pattern variable or literal identifier. @end defmac + @node Macros That Work, Syntactic Closures, Macro by Example, Scheme Syntax Extension Packages @section Macros That Work @@ -1525,9 +1523,6 @@ or inserted identifiers, then the big chunk will be copied unnecessarily. That shouldn't matter very often. - - - @node Syntactic Closures, Syntax-Case Macros, Macros That Work, Scheme Syntax Extension Packages @section Syntactic Closures @@ -1979,9 +1974,6 @@ of this proposal is derived from an earlier proposal by Alan Bawden. - - - @node Syntax-Case Macros, Define-Structure, Syntactic Closures, Scheme Syntax Extension Packages @section Syntax-Case Macros @@ -2103,7 +2095,6 @@ Send bug reports, comments, suggestions, and questions to Kent Dybvig (dyb @@ iuvax.cs.indiana.edu). - @node Define-Structure, Define-Record-Type, Syntax-Case Macros, Scheme Syntax Extension Packages @section Define-Structure @@ -2167,6 +2158,7 @@ red @end deffn + @node Define-Record-Type, Fluid-Let, Define-Structure, Scheme Syntax Extension Packages @section Define-Record-Type @@ -2230,6 +2222,15 @@ by the rules of lexical scoping) of its corresponding @url{http://srfi.schemers.org/srfi-8/srfi-8.html} @end defspec +@code{(require 'let-values)} or @code{(require 'srfi-11)} +@ftindex srfi-11 +@ftindex let-values + +@defspec let-values ((formals expression) ...) body @dots{} +@defspecx let-values* ((formals expression) ...) body @dots{} + +@url{http://srfi.schemers.org/srfi-11/srfi-11.html} +@end defspec @node Guarded LET* special form, Guarded COND Clause, Binding to multiple values, Scheme Syntax Extension Packages @@ -2317,7 +2318,6 @@ returns a list of all the characters it produces until the end. @end example - @node Yasos, , Guarded COND Clause, Scheme Syntax Extension Packages @section Yasos @@ -2385,9 +2385,6 @@ reasonable). See the L&FP paper for some suggestions. @end table - - - @node Yasos interface, Setters, Yasos terms, Yasos @subsection Interface @@ -2440,9 +2437,6 @@ and by default id an error otherwise. Objects such as collections @end defun - - - @node Setters, Yasos examples, Yasos interface, Yasos @subsection Setters @@ -2508,9 +2502,6 @@ value is unspecified. @end deffn - - - @node Yasos examples, , Setters, Yasos @subsection Examples @@ -2611,7 +2602,6 @@ value is unspecified. @end lisp - @node Textual Conversion Packages, Mathematical Packages, Scheme Syntax Extension Packages, Top @chapter Textual Conversion Packages @@ -2625,13 +2615,13 @@ value is unspecified. * HTTP and CGI:: Serve WWW sites * Parsing HTML:: 'html-for-each * URI:: Uniform Resource Identifier +* Parsing XML:: 'parse-xml or 'ssax * Printing Scheme:: Nicely * Time and Date:: * NCBI-DNA:: DNA and protein sequences * Schmooz:: Documentation markup for Scheme programs @end menu - @node Precedence Parsing, Format, Textual Conversion Packages, Textual Conversion Packages @section Precedence Parsing @@ -2718,8 +2708,8 @@ The JACAL symbolic math system @noindent Here are the higher-level syntax types and an example of each. -Precedence considerations are omitted for clarity. See @ref{Grammar -Rule Definition} for full details. +Precedence considerations are omitted for clarity. +See @ref{Grammar Rule Definition} for full details. @deftp Grammar nofix bye exit @example bye @@ -2857,6 +2847,7 @@ from a closed port. @findex current-input-port @end defun + @node Token definition, Nud and Led Definition, Ruleset Definition and Use, Precedence Parsing @subsection Token definition @@ -3209,7 +3200,7 @@ The ruleset in effect before @var{tk} was parsed is restored; @ifset html @end ifset -@code{(require 'format)} +@code{(require 'format)} or @code{(require 'srfi-28)} @ftindex format @c The @file{format.scm} package was removed because it was not @@ -3219,7 +3210,6 @@ The ruleset in effect before @var{tk} was parsed is restored; @include format.texi - @node Standard Formatted I/O, Programs and Arguments, Format, Textual Conversion Packages @section Standard Formatted I/O @@ -3326,8 +3316,8 @@ if by increasing the precision. For @samp{%x} or @samp{%X}, prefix a leading @samp{0x} or @samp{0X} (respectively) to the result. This doesn't do anything useful for the @samp{%d}, @samp{%i}, or @samp{%u} conversions. Using this flag produces output which can be parsed by the -@code{scanf} functions with the @samp{%i} conversion (@pxref{Standard -Formatted Input}). +@code{scanf} functions with the @samp{%i} conversion +(@pxref{Standard Formatted Input}). @item @samp{0} @@ -3841,6 +3831,7 @@ errors. @end example @end defun + @node Command Line, Parameter lists, Getopt, Programs and Arguments @subsection Command Line @@ -4004,7 +3995,7 @@ system @end table @noindent -@file{batch.scm} uses 2 enhanced relational tables +The @samp{batch} module uses 2 enhanced relational tables (@pxref{Using Databases}) to store information linking the names of @code{operating-system}s to @code{batch-dialect}es. @@ -4252,14 +4243,19 @@ hello world @include html4each.txi -@node URI, Printing Scheme, Parsing HTML, Textual Conversion Packages +@node URI, Parsing XML, Parsing HTML, Textual Conversion Packages @section URI @include uri.txi +@node Parsing XML, Printing Scheme, URI, Textual Conversion Packages +@section Parsing XML -@node Printing Scheme, Time and Date, URI, Textual Conversion Packages +@include xml-parse.txi + + +@node Printing Scheme, Time and Date, Parsing XML, Textual Conversion Packages @section Printing Scheme @menu @@ -4268,7 +4264,6 @@ hello world * Pretty-Print:: 'pretty-print, 'pprint-file @end menu - @node Generic-Write, Object-To-String, Printing Scheme, Printing Scheme @subsection Generic-Write @@ -4317,7 +4312,6 @@ where @end deffn - @node Object-To-String, Pretty-Print, Generic-Write, Printing Scheme @subsection Object-To-String @@ -4440,6 +4434,7 @@ thus can reduce loading time. The following will write into (pprint-filter-file "code.scm" defmacro:expand* "exp-code.scm") @end lisp + @node Time and Date, NCBI-DNA, Printing Scheme, Textual Conversion Packages @section Time and Date @@ -4589,8 +4584,8 @@ Sets (and returns) the default time-zone to that specified by @code{tzset} also sets the variables @var{*timezone*}, @var{daylight?}, and @var{tzname}. This function is automatically called by the time -conversion procedures which depend on the time zone (@pxref{Time and -Date}). +conversion procedures which depend on the time zone +(@pxref{Time and Date}). @end defun @defvar *timezone* @@ -4750,6 +4745,7 @@ Notice that the values returned by @code{decode-universal-time} do not match the arguments to @code{encode-universal-time}. @end defun + @node Time Infrastructure, , Common-Lisp Time, Time and Date @subsection Time Infrastructure @@ -4778,7 +4774,6 @@ match the arguments to @code{encode-universal-time}. @include schmooz.texi - @node Mathematical Packages, Database Packages, Textual Conversion Packages, Top @chapter Mathematical Packages @@ -4801,7 +4796,6 @@ match the arguments to @code{encode-universal-time}. * Matrix Algebra:: 'determinant @end menu - @node Bit-Twiddling, Modular Arithmetic, Mathematical Packages, Mathematical Packages @section Bit-Twiddling @@ -4890,7 +4884,6 @@ of @var{mask} is 0. @subsection Integer Properties @defun logcount n -@defunx bit-count n Returns the number of bits in integer @var{n}. If integer is positive, the 1-bits in its binary representation are counted. If negative, the 0-bits in its two's-complement binary representation are counted. If 0, @@ -4907,6 +4900,22 @@ Example: @end lisp @end defun +@noindent +On @code{discuss@@r6rs.org} Ben Harris credits Simon Tatham with the +idea to have @code{bitwise-bit-count} return a negative count for +negative inputs. Alan Bawden came up with the succinct invariant. + +@defun bitwise-bit-count n +If @var{n} is non-negative, this procedure returns the number of 1 +bits in the two's-complement representation of @var{n}. Otherwise it +returns the result of the following computation: + +@lisp +(bitwise-not (bitwise-bit-count (bitwise-not @var{n}))) +@end lisp +@end defun + + @defun integer-length n Returns the number of bits neccessary to represent @var{n}. @@ -5083,8 +5092,6 @@ Returns the integer coded by the @var{bool1} @dots{} arguments. @end defun - - @node Modular Arithmetic, Irrational Integer Functions, Bit-Twiddling, Mathematical Packages @section Modular Arithmetic @@ -5245,7 +5252,6 @@ 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 @@ -5537,6 +5543,7 @@ in http://www.usb.org/developers/data/crcdes.pdf. @end defun + @node Graphing, Solid Modeling, Cyclic Checksum, Mathematical Packages @section Graphing @@ -5897,7 +5904,6 @@ temperatures around 5000.K. @include color.txi - @node Spectra, Color Difference Metrics, Color Spaces, Color @subsection Spectra @@ -6241,7 +6247,6 @@ perceptibility; the default, 2 and 1, for acceptability. @end defun - @node Color Conversions, Color Names, Color Difference Metrics, Color @subsection Color Conversions @@ -6332,7 +6337,6 @@ The integers @var{n1} and @var{n2} must be 10, 12, or 16. @end defun - @node Color Names, Daylight, Color Conversions, Color @subsection Color Names @@ -6431,18 +6435,12 @@ Resene Paints Ltd. @include daylight.txi - @node Root Finding, Minimizing, Color, Mathematical Packages @section Root Finding @code{(require 'root)} @ftindex root -@defun integer-sqrt y -Given a non-negative integer @var{y}, returns the largest integer -whose square is less than or equal to @var{y}. -@end defun - @defun newton:find-integer-root f df/dx x0 Given integer valued procedure @var{f}, its derivative (with respect to its argument) @var{df/dx}, and initial integer value @var{x0} for which @@ -6542,6 +6540,7 @@ iterations performed so far. @var{prec} should return non-false if the iteration should be stopped. @end defun + @node Minimizing, The Limit, Root Finding, Mathematical Packages @section Minimizing @@ -6551,6 +6550,7 @@ if the iteration should be stopped. @include minimize.txi + @node The Limit, Commutative Rings, Minimizing, Mathematical Packages @section The Limit @@ -6910,7 +6910,6 @@ Why relational database? For motivations and design issues see@* @include dbutil.txi - @node Table Operations, Database Interpolation, Using Databases, Relational Database @subsection Table Operations @@ -7246,6 +7245,7 @@ table. Subsequent operations to this table will signal an error. @end defop + @node Database Interpolation, Embedded Commands, Table Operations, Relational Database @subsection Database Interpolation @@ -7271,7 +7271,6 @@ associated with the smallest stored key is used. @end defun - @node Embedded Commands, Database Macros, Database Interpolation, Relational Database @subsection Embedded Commands @@ -7396,8 +7395,8 @@ Adds @var{domain-row} to the @dfn{domains} table if there is no row in the domains table associated with key @code{(car @var{domain-row})} and returns @code{#t}. Otherwise returns @code{#f}. -For the fields and layout of the domain table, @xref{Catalog -Representation}. Currently, these fields are +For the fields and layout of the domain table, +@xref{Catalog Representation}. Currently, these fields are @itemize @bullet @item domain-name @@ -7713,7 +7712,6 @@ ERROR: getopt->parameter-list "unrecognized option" "-?" @end example - @node Database Macros, Database Browser, Embedded Commands, Relational Database @subsection Database Macros @@ -7892,7 +7890,6 @@ without-documentation called @end example - @node Database Browser, , Database Macros, Relational Database @subsection Database Browser @@ -7942,7 +7939,6 @@ the symbol @var{table-name}. * Database Operations:: @end menu - @node Base Table, Catalog Representation, Relational Infrastructure, Relational Infrastructure @subsection Base Table @@ -8320,6 +8316,7 @@ which differs in column @var{index} or a lower indexed key; or false if no higher record is present. @end defop + @node Catalog Representation, Relational Database Objects, Base Table, Relational Infrastructure @subsection Catalog Representation @@ -8760,7 +8757,6 @@ associations as @var{alist}. This procedure is equivalent to: @end deffn - @node Basic Operations on Weight-Balanced Trees, Advanced Operations on Weight-Balanced Trees, Construction of Weight-Balanced Trees, Weight-Balanced Trees @subsection Basic Operations on Weight-Balanced Trees @@ -9090,8 +9086,6 @@ operation is equivalent to @node Data Structures, Sorting and Searching, Other Packages, Other Packages @section Data Structures - - @menu * Arrays:: 'array * Subarrays:: 'subarray @@ -9111,9 +9105,6 @@ operation is equivalent to * Records:: 'record @end menu - - - @node Arrays, Subarrays, Data Structures, Data Structures @subsection Arrays @@ -9264,12 +9255,7 @@ collection; they are potentially more efficient. @defun reduce proc seed collection1 @dots{} A generalization of the list-based @code{reduce-init} -(@pxref{Lists as sequences}) to collections which will shadow the -list-based version if @code{(require 'collect)} follows -@ftindex collect -@code{(require 'common-list-functions)} (@pxref{Common List -Functions}). -@ftindex common-list-functions +(@pxref{Lists as sequences}) to collections. Examples: @lisp @@ -9278,11 +9264,15 @@ Examples: (reduce union '() '((a b c) (b c d) (d a))) @result{} (c b d a). @end lisp + +@code{Reduce} called with two arguments will work as does the +procedure of the same name from @xref{Common List Functions}). +@ftindex common-list-functions @end defun @defun any? pred collection1 @dots{} -A generalization of the list-based @code{some} (@pxref{Lists as -sequences}) to collections. +A generalization of the list-based @code{some} +(@pxref{Lists as sequences}) to collections. Example: @lisp @@ -9383,9 +9373,6 @@ Here is a sample collection: @code{simple-table} which is also a @end lisp - - - @node Dynamic Data Type, Hash Tables, Collections, Data Structures @subsection Dynamic Data Type @@ -9424,15 +9411,12 @@ re-established by those continuations when they are invoked. The @code{dynamic-bind} macro is not implemented. - - @node Hash Tables, Object, Dynamic Data Type, Data Structures @subsection Hash Tables @include hashtab.txi - @node Object, Priority Queues, Hash Tables, Data Structures @subsection Macroless Object System @@ -9451,7 +9435,6 @@ The @code{dynamic-bind} macro is not implemented. @include queue.txi - @node Records, , Queues, Data Structures @subsection Records @@ -9583,7 +9566,6 @@ created the type represented by @var{rtd}. @end ignore - @node Sorting and Searching, Procedures, Data Structures, Other Packages @section Sorting and Searching @@ -9600,8 +9582,6 @@ created the type represented by @var{rtd}. * Sequence Comparison:: 'diff and longest-common-subsequence @end menu - - @node Common List Functions, Tree Operations, Sorting and Searching, Sorting and Searching @subsection Common List Functions @@ -9619,7 +9599,6 @@ optional arguments in some cases. * Non-List functions:: @end menu - @node List construction, Lists as sets, Common List Functions, Common List Functions @subsubsection List construction @@ -9683,10 +9662,6 @@ Example: @end defun - - - - @node Lists as sets, Lists as sequences, List construction, Common List Functions @subsubsection Lists as sets @@ -10152,7 +10127,6 @@ given identical arguments. @end example - @node Destructive list operations, Non-List functions, Lists as sequences, Common List Functions @subsubsection Destructive list operations @@ -10256,7 +10230,6 @@ The examples should suffice to show why this is the case. @end deffn - @node Non-List functions, , Destructive list operations, Common List Functions @subsubsection Non-List functions @@ -10318,90 +10291,14 @@ pair. (Called @code{atom} in Common LISP.) @node Sorting, Topological Sort, Chapter Ordering, Sorting and Searching @subsection Sorting -@code{(require 'sort)} +@code{(require 'sort)} or @code{(require 'srfi-95)} @ftindex sort +@ftindex srfi-95 [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 -(a common blunder is to use quicksort which does not perform well). - -Because @code{sort} and @code{sort!} are not in the standard, there is -very little agreement about what these functions look like. For -example, Dybvig says that Chez Scheme provides -@lisp -(merge predicate list1 list2) -(merge! predicate list1 list2) -(sort predicate list) -(sort! predicate list) -@end lisp -@noindent -while MIT Scheme 7.1, following Common LISP, offers unstable -@lisp -(sort list predicate) -@end lisp -@noindent -TI PC Scheme offers -@lisp -(sort! list/vector predicate?) -@end lisp -@noindent -and Elk offers -@lisp -(sort list/vector predicate?) -(sort! list/vector predicate?) -@end lisp - -Here is a comprehensive catalogue of the variations I have found. - -@enumerate -@item -Both @code{sort} and @code{sort!} may be provided. -@item -@code{sort} may be provided without @code{sort!}. -@item -@code{sort!} may be provided without @code{sort}. -@item -Neither may be provided. -@item -The sequence argument may be either a list or a vector. -@item -The sequence argument may only be a list. -@item -The sequence argument may only be a vector. -@item -The comparison function may be expected to behave like @code{<}. -@item -The comparison function may be expected to behave like @code{<=}. -@item -The interface may be @code{(sort predicate? sequence)}. -@item -The interface may be @code{(sort sequence predicate?)}. -@item -The interface may be @code{(sort sequence &optional (predicate? <))}. -@item -The sort may be stable. -@item -The sort may be unstable. -@end enumerate - -All of this variation really does not help anybody. A nice simple merge -sort is both stable and fast (quite a lot faster than @emph{quick} sort). - I am providing this source code with no restrictions at all on its use -(but please retain D.H.D.Warren's credit for the original idea). You -may have to rename some of these functions in order to use them in a -system which already provides incompatible or inferior sorts. For each -of the functions, only the top-level define needs to be edited to do -that. - -I could have given these functions names which would not clash with any -Scheme that I know of, but I would like to encourage implementors to -converge on a single interface, and this may serve as a hint. The -argument order for all functions has been chosen to be as close to -Common LISP as made sense, in order to avoid NIH-itis. +(but please retain D.H.D.Warren's credit for the original idea). 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 @@ -10415,15 +10312,6 @@ 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, - -@lisp -(not (f x x)) -(and (f x y) (f y z)) @equiv{} (f x z) -@end lisp - The standard functions @code{<}, @code{>}, @code{char?}, @code{char-ci?}, @code{string?}, @code{string-ci?} are suitable for use as @@ -10433,9 +10321,14 @@ comparison functions. Think of @code{(less? x y)} as saying when [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. +@code{#f} when applied to identical arguments. + +The @code{sorted?}, @code{merge}, and @code{merge!} procedures consume +asymptotic time and space no larger than @i{O(N)}, where @i{N} is the +sum of the lengths of the sequence arguments. +The @code{sort} and @code{sort!} procedures consume asymptotic time +and space no larger than @i{O(N*log(N))}, where @i{N} is the length of +the sequence argument. All five functions take an optional @var{key} argument corresponding to a CL-style @samp{&key} argument. A @var{less?} predicate with a @@ -10445,8 +10338,8 @@ to a CL-style @samp{&key} argument. A @var{less?} predicate with a (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. +All five functions will call the @var{key} argument at most once per +element. The @samp{!} variants sort in place; @code{sort!} returns its @var{sequence} argument. @@ -10471,9 +10364,8 @@ result. @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}. +@var{list2} to build the result. The result will be either +@var{list1} or @var{list2}. @end defun @defun sort sequence less? @@ -10491,12 +10383,13 @@ case that: @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}. +Returns list, array, vector, or string @var{sequence} which has been +mutated to order its elements according to @var{less?}. Given valid +arguments, it is always the case that: + +@lisp +(sorted? (sort! @var{sequence} @var{less?}) @var{less?}) @result{} #t +@end lisp @end defun @@ -10769,7 +10662,6 @@ up here. * Metric Units:: Portable manifest types for numeric values. @end menu - @node Type Coercion, String-Case, Procedures, Procedures @subsection Type Coercion @code{(require 'coerce)} @@ -10832,7 +10724,6 @@ lower-case character. @end defun - @node String Ports, Line I/O, String-Case, Procedures @subsection String Ports @@ -11179,6 +11070,7 @@ namely @code{values}, @code{macro}, and @code{eval}. Description found in R4RS. @end defun + @node Transcripts, Rev2 Procedures, With-File, Standards Support @subsection Transcripts @@ -11192,9 +11084,6 @@ Redefines @code{read-char}, @code{read}, @code{write-char}, @end defun - - - @node Rev2 Procedures, Rev4 Optional Procedures, Transcripts, Standards Support @subsection Rev2 Procedures @@ -11257,7 +11146,6 @@ trailing @samp{?}. @end defun - @node Rev4 Optional Procedures, Multi-argument / and -, Rev2 Procedures, Standards Support @subsection Rev4 Optional Procedures @@ -11280,17 +11168,14 @@ For the specification of these optional procedures, @end deffn - - - @node Multi-argument / and -, Multi-argument Apply, Rev4 Optional Procedures, Standards Support @subsection Multi-argument / and - @code{(require 'multiarg/and-)} @ftindex multiarg -For the specification of these optional forms, @xref{Numerical -operations, , ,r4rs, Revised(4) Scheme}. +For the specification of these optional forms, +@xref{Numerical operations, , ,r4rs, Revised(4) Scheme}. @defun / dividend divisor1 @dots{} @end defun @@ -11299,9 +11184,6 @@ operations, , ,r4rs, Revised(4) Scheme}. @end defun - - - @node Multi-argument Apply, Rationalize, Multi-argument / and -, Standards Support @subsection Multi-argument Apply @@ -11316,14 +11198,12 @@ For the specification of this optional form, @end defun - @node Rationalize, Promises, Multi-argument Apply, Standards Support @subsection Rationalize @include ratize.txi - @node Promises, Dynamic-Wind, Rationalize, Standards Support @subsection Promises @@ -11498,6 +11378,7 @@ not created by the @code{call-with-values} procedure is unspecified. @end defun + @node SRFI, , Values, Standards Support @subsection SRFI @@ -11514,27 +11395,35 @@ unspecified. @item SRFI-8 @ref{Binding to multiple values} @ftindex srfi-9 @item SRFI-9 @ref{Define-Record-Type} +@ftindex srfi-11 +@item SRFI-11 @ref{Binding to multiple values} @ftindex srfi-23 @item SRFI-23 @code{(define error slib:error)} +@ftindex srfi-28 +@item SRFI-28 @ref{Format} @ftindex srfi-47 @item SRFI-47 @ref{Arrays} -@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} +@ftindex srfi-63 +@item SRFI-63 @ref{Arrays} +@ftindex srfi-94 +@item SRFI-94 @ref{Irrational Integer Functions} and @ref{Irrational Real Functions} +@ftindex srfi-95 +@item SRFI-95 @ref{Sorting} @end itemize + @node SRFI-1, , SRFI, SRFI @subsubsection SRFI-1 @include srfi-1.txi - @node Session Support, System Interface, Standards Support, Other Packages @section Session Support @@ -11554,7 +11443,6 @@ is used by the @code{break} and @code{debug} packages. * Trace:: 'trace @end menu - @node Repl, Quick Print, Session Support, Session Support @subsection Repl @@ -11595,6 +11483,7 @@ catching lines and the following lines to your Scheme init file: (repl:top-level macro:eval) @end lisp + @node Quick Print, Debug, Repl, Session Support @subsection Quick Print @@ -11633,6 +11522,7 @@ procedures will be @code{write}n; procedures will be indicated by @samp{#[proc]}. @end defvar + @node Debug, Breakpoints, Quick Print, Session Support @subsection Debug @@ -11672,6 +11562,7 @@ Breakpoints (@pxref{Breakpoints}) all procedures @code{define}d at top-level in @file{file} @dots{}. @end deffn + @node Breakpoints, Trace, Debug, Session Support @subsection Breakpoints @@ -11752,6 +11643,7 @@ To unbreak, type @end lisp @end defun + @node Trace, , Breakpoints, Session Support @subsection Tracing @@ -12045,7 +11937,6 @@ page: * About this manual:: @end menu - @node Installation, The SLIB script, About SLIB, About SLIB @section Installation @@ -12075,7 +11966,7 @@ Build the SLIB catalog for the Scheme implementation. @subsection Unpacking the SLIB Distribution -If the SLIB distribution is a Linux RPM, it will create the SLIB +If the SLIB distribution is a GNU/Linux RPM, it will create the SLIB directory @file{/usr/share/slib}. If the SLIB distribution is a ZIP file, unzip the distribution to create @@ -12258,7 +12149,8 @@ e.g. mv dumpfile /usr/local/vscm/lib/scheme-boot SLIB comes with shell script for Unix platforms. @example -@exdent @b{ slib } [ scm | gsi | mzscheme | guile | slib48 | scheme48 | scmlit ] +@b{ slib } [ scheme | scm | gsi | mzscheme | guile + | scheme48 | scmlit | elk | sisc | kawa ] @end example @noindent @@ -12270,7 +12162,6 @@ implementation to run. Absent the argument, it searches for implementations in the above order. - @node Porting, Coding Guidelines, The SLIB script, About SLIB @section Porting @@ -12364,6 +12255,7 @@ Please @emph{do not} reformat the source code with your favorite beautifier, make 10 fixes, and send me the resulting source code. I do not have the time to fish through 10000 diffs to find your 10 real fixes. + @node Copyrights, About this manual, Coding Guidelines, About SLIB @section Copyrights @@ -12460,6 +12352,7 @@ nothing to undermine it in the future. @end flushleft @end quotation + @node About this manual, , Copyrights, About SLIB @section About this manual diff --git a/solid.scm b/solid.scm index 064e21e..8f99d83 100644 --- a/solid.scm +++ b/solid.scm @@ -160,9 +160,9 @@ ;;@body ;; -;;@1 is a list of color objects. Each may be of type @ref{Color -;;Data-Type, color}, a 24-bit sRGB integer, or a list of 3 numbers -;;between 0.0 and 1.0. +;;@1 is a list of color objects. Each may be of type +;;@ref{Color Data-Type, color}, a 24-bit sRGB integer, or a list of 3 +;;numbers between 0.0 and 1.0. ;; ;;@2 is a list of non-increasing angles the same length as ;;@1. Each angle is between 90 and -90 degrees. If 90 or -90 are not diff --git a/solid.txi b/solid.txi index 5f6657c..3251b13 100644 --- a/solid.txi +++ b/solid.txi @@ -56,9 +56,9 @@ enclosing the virtual world. @defun scene:sphere colors angles -@var{colors} is a list of color objects. Each may be of type @ref{Color -Data-Type, color}, a 24-bit sRGB integer, or a list of 3 numbers -between 0.0 and 1.0. +@var{colors} is a list of color objects. Each may be of type +@ref{Color Data-Type, color}, a 24-bit sRGB integer, or a list of 3 +numbers between 0.0 and 1.0. @var{angles} is a list of non-increasing angles the same length as @var{colors}. Each angle is between 90 and -90 degrees. If 90 or -90 are not diff --git a/sort.scm b/sort.scm index 1b96e4c..ab5f896 100644 --- a/sort.scm +++ b/sort.scm @@ -10,44 +10,38 @@ ;;; (sort, sort!, sorted?): Generalized to arrays by jaffer: 2003-10-04 ;;; jaffer: 2006-10-08: ;;; (sort, sort!, sorted?, merge, merge!): Added optional KEY argument. +;;; jaffer: 2006-11-05: +;;; (sorted?, merge, merge!, sort, sort!): Call KEY arg at most once +;;; per element. +;;; jaffer: 2007-01-29: Final SRFI-95. (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? . opt-key) - (set! less? (sort:make-predicate 'sorted? less? opt-key)) + (define key (if (null? opt-key) identity (car opt-key))) (cond ((null? seq) #t) ((array? seq) - (let ((dims (array-dimensions seq))) - (define dimax (+ -1 (car dims))) - (or (<= dimax 0) - (do ((i 1 (+ i 1))) - ((or (= i dimax) - (less? (array-ref seq i) - (array-ref seq (- i 1)))) - (= i dimax)))))) + (let ((dimax (+ -1 (car (array-dimensions seq))))) + (or (<= dimax 1) + (let loop ((idx (+ -1 dimax)) + (last (key (array-ref seq dimax)))) + (or (negative? idx) + (let ((nxt (key (array-ref seq idx)))) + (and (less? nxt last) + (loop (+ -1 idx) nxt)))))))) + ((null? (cdr seq)) #t) (else - (let loop ((last (car seq)) (next (cdr seq))) + (let loop ((last (key (car seq))) + (next (cdr seq))) (or (null? next) - (and (not (less? (car next) last)) - (loop (car next) (cdr next)))))))) + (let ((nxt (key (car next)))) + (and (not (less? nxt last)) + (loop nxt (cdr next))))))))) ;;; (merge a b less?) ;;; takes two lists a and b such that (sorted? a less?) and (sorted? b less?) @@ -56,109 +50,129 @@ ;;; Note: this does _not_ accept arrays. See below. ;@ (define (merge a b less? . opt-key) - (set! less? (sort:make-predicate 'merge less? opt-key)) + (define key (if (null? opt-key) identity (car opt-key))) (cond ((null? a) b) ((null? b) a) - (else (let loop ((x (car a)) (a (cdr a)) (y (car b)) (b (cdr b))) - ;; The loop handles the merging of non-empty lists. It has - ;; been written this way to save testing and car/cdring. - (if (less? y x) - (if (null? b) - (cons y (cons x a)) - (cons y (loop x a (car b) (cdr b)))) - ;; x <= y - (if (null? a) - (cons x (cons y b)) - (cons x (loop (car a) (cdr a) y b)))))))) + (else + (let loop ((x (car a)) (kx (key (car a))) (a (cdr a)) + (y (car b)) (ky (key (car b))) (b (cdr b))) + ;; The loop handles the merging of non-empty lists. It has + ;; been written this way to save testing and car/cdring. + (if (less? ky kx) + (if (null? b) + (cons y (cons x a)) + (cons y (loop x kx a (car b) (key (car b)) (cdr b)))) + ;; x <= y + (if (null? a) + (cons x (cons y b)) + (cons x (loop (car a) (key (car a)) (cdr a) y ky b)))))))) -(define (sort:merge! a b less?) - (define (loop r a b) - (if (less? (car b) (car a)) - (begin - (set-cdr! r b) - (if (null? (cdr b)) - (set-cdr! b a) - (loop b a (cdr b)))) - ;; (car a) <= (car b) - (begin - (set-cdr! r a) - (if (null? (cdr a)) - (set-cdr! a b) - (loop a (cdr a) b))))) +(define (sort:merge! a b less? key) + (define (loop r a kcara b kcarb) + (cond ((less? kcarb kcara) + (set-cdr! r b) + (if (null? (cdr b)) + (set-cdr! b a) + (loop b a kcara (cdr b) (key (cadr b))))) + (else ; (car a) <= (car b) + (set-cdr! r a) + (if (null? (cdr a)) + (set-cdr! a b) + (loop a (cdr a) (key (cadr a)) b kcarb))))) (cond ((null? a) b) ((null? b) a) - ((less? (car b) (car a)) - (if (null? (cdr b)) - (set-cdr! b a) - (loop b a (cdr b))) - b) - (else ; (car a) <= (car b) - (if (null? (cdr a)) - (set-cdr! a b) - (loop a (cdr a) b)) - a))) + (else + (let ((kcara (key (car a))) + (kcarb (key (car b)))) + (cond + ((less? kcarb kcara) + (if (null? (cdr b)) + (set-cdr! b a) + (loop b a kcara (cdr b) (key (cadr b)))) + b) + (else ; (car a) <= (car b) + (if (null? (cdr a)) + (set-cdr! a b) + (loop a (cdr a) (key (cadr a)) b kcarb)) + a)))))) -;;; (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? . opt-key) - (sort:merge! a b (sort:make-predicate 'merge! less? opt-key))) + (sort:merge! a b less? (if (null? opt-key) identity (car opt-key)))) -(define (sort:sort! seq less?) +(define (sort:sort-list! seq less? key) + (define keyer (if key car identity)) (define (step n) - (cond ((> n 2) - (let* ((j (quotient n 2)) - (a (step j)) - (k (- n j)) - (b (step k))) - (sort:merge! a b less?))) - ((= n 2) - (let ((x (car seq)) - (y (cadr seq)) - (p seq)) - (set! seq (cddr seq)) - (cond ((less? y x) - (set-car! p y) - (set-car! (cdr p) x))) - (set-cdr! (cdr p) '()) - p)) - ((= n 1) - (let ((p seq)) - (set! seq (cdr seq)) - (set-cdr! p '()) - p)) - (else - '()))) - (cond ((array? seq) - (let ((dims (array-dimensions seq)) - (vec seq)) - (set! seq (rank-1-array->list seq)) - (do ((p (step (car dims)) (cdr p)) - (i 0 (+ i 1))) - ((null? p) vec) - (array-set! vec (car p) i)))) - (else ;; otherwise, assume it is a list + (cond ((> n 2) (let* ((j (quotient n 2)) + (a (step j)) + (k (- n j)) + (b (step k))) + (sort:merge! a b less? keyer))) + ((= n 2) (let ((x (car seq)) + (y (cadr seq)) + (p seq)) + (set! seq (cddr seq)) + (cond ((less? (keyer y) (keyer x)) + (set-car! p y) + (set-car! (cdr p) x))) + (set-cdr! (cdr p) '()) + p)) + ((= n 1) (let ((p seq)) + (set! seq (cdr seq)) + (set-cdr! p '()) + p)) + (else '()))) + (define (key-wrap! lst) + (cond ((null? lst)) + (else (set-car! lst (cons (key (car lst)) (car lst))) + (key-wrap! (cdr lst))))) + (define (key-unwrap! lst) + (cond ((null? lst)) + (else (set-car! lst (cdar lst)) + (key-unwrap! (cdr lst))))) + (cond (key + (key-wrap! seq) + (set! seq (step (length seq))) + (key-unwrap! seq) + seq) + (else (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. +;;; A. Jaffer modified to always return the original list. ;@ (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) + (define key (if (null? opt-key) #f (car opt-key))) + (cond ((array? seq) + (let ((dims (array-dimensions seq))) + (do ((sorted (sort:sort-list! (rank-1-array->list seq) less? key) + (cdr sorted)) + (i 0 (+ i 1))) + ((null? sorted) seq) + (array-set! seq (car sorted) i)))) + (else ; otherwise, assume it is a list + (let ((ret (sort:sort-list! seq less? 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 @@ -168,13 +182,13 @@ ;;; so (append x '()) ought to be a standard way of copying a list x. ;@ (define (sort seq less? . opt-key) - (set! less? (sort:make-predicate 'sort less? opt-key)) + (define key (if (null? opt-key) #f (car 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?) + (let ((dims (array-dimensions seq))) + (define newra (apply make-array seq dims)) + (do ((sorted (sort:sort-list! (rank-1-array->list seq) less? key) (cdr sorted)) (i 0 (+ i 1))) ((null? sorted) newra) (array-set! newra (car sorted) i)))) - (else (sort:sort! (append seq '()) less?)))) + (else (sort:sort-list! (append seq '()) less? key)))) diff --git a/srfi-1.scm b/srfi-1.scm index 676cc90..98294b0 100644 --- a/srfi-1.scm +++ b/srfi-1.scm @@ -253,8 +253,17 @@ (f l (pair-fold-right f z (cdr l))))) ;;@body -(define (reduce f ridentity list) - (if (null? list) ridentity (fold f (car list) (cdr list)))) +(define reduce + (let ((comlist-reduce reduce)) + (lambda args + (apply (if (= 2 (length args)) + comlist-reduce + (lambda (f ridentity list) + (if (null? list) + ridentity + (fold f (car list) (cdr list))))) + args)))) + (define (reduce-right f ridentity list) (if (null? list) ridentity @@ -333,11 +342,11 @@ ;;@args pred list (define remove - (let ((comlist:remove remove)) + (let ((comlist-remove remove)) (lambda (pred l) (if (procedure? pred) (filter (lambda (x) (not (pred x))) l) - (comlist:remove pred l))))) ; 'remove' has incompatible semantics in comlist of SLIB! + (comlist-remove pred l))))) ; 'remove' has incompatible semantics in comlist of SLIB! ;;@args pred list (define (partition! p? l) diff --git a/srfi-1.txi b/srfi-1.txi index 4849703..3c589ce 100644 --- a/srfi-1.txi +++ b/srfi-1.txi @@ -216,12 +216,11 @@ Returns a circular list of @var{obj1}, @var{obj2}, @dots{}. @end defun -@defun reduce f ridentity list -@defunx reduce-right f ridentity list +@defun reduce arg @dots{} @end defun - + @deffn {Procedure} map! f clist1 clist2 @dots{} @end deffn diff --git a/srfi-11.scm b/srfi-11.scm new file mode 100644 index 0000000..366e12e --- /dev/null +++ b/srfi-11.scm @@ -0,0 +1,38 @@ +;;; This code is in the public domain. +;;; http://srfi.schemers.org/srfi-11/srfi-11.html +;;; by Lars T. Hansen 1999 + +(define-syntax let-values + (syntax-rules () + ((let-values (?binding ...) ?body0 ?body1 ...) + (let-values "bind" (?binding ...) () (begin ?body0 ?body1 ...))) + + ((let-values "bind" () ?tmps ?body) + (let ?tmps ?body)) + + ((let-values "bind" ((?b0 ?e0) ?binding ...) ?tmps ?body) + (let-values "mktmp" ?b0 ?e0 () (?binding ...) ?tmps ?body)) + + ((let-values "mktmp" () ?e0 ?args ?bindings ?tmps ?body) + (call-with-values + (lambda () ?e0) + (lambda ?args + (let-values "bind" ?bindings ?tmps ?body)))) + + ((let-values "mktmp" (?a . ?b) ?e0 (?arg ...) ?bindings (?tmp ...) ?body) + (let-values "mktmp" ?b ?e0 (?arg ... x) ?bindings (?tmp ... (?a x)) ?body)) + + ((let-values "mktmp" ?a ?e0 (?arg ...) ?bindings (?tmp ...) ?body) + (call-with-values + (lambda () ?e0) + (lambda (?arg ... . x) + (let-values "bind" ?bindings (?tmp ... (?a x)) ?body)))))) + +(define-syntax let*-values + (syntax-rules () + ((let*-values () ?body0 ?body1 ...) + (begin ?body0 ?body1 ...)) + + ((let*-values (?binding0 ?binding1 ...) ?body0 ?body1 ...) + (let-values (?binding0) + (let*-values (?binding1 ...) ?body0 ?body1 ...))))) diff --git a/t3.init b/t3.init index e501e10..b993882 100644 --- a/t3.init +++ b/t3.init @@ -268,6 +268,9 @@ (define program-arguments command-line) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;; (OUTPUT-PORT-WIDTH ) (define output-port-width (lambda x diff --git a/trnscrpt.scm b/trnscrpt.scm index aaec7cb..d801621 100644 --- a/trnscrpt.scm +++ b/trnscrpt.scm @@ -1,5 +1,5 @@ ; "trnscrpt.scm", transcript functions for Scheme. -; Copyright (c) 1992, 1993, 1995 Aubrey Jaffer +; Copyright (c) 1992, 1993, 1995, 2007 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 @@ -28,49 +28,49 @@ (set! transcript:port #f)) ;@ (define read-char - (let ((read-char read-char) (write-char write-char)) + (let ((rd-chr read-char) (wrt-chr write-char)) (lambda opt - (let ((ans (apply read-char opt))) + (let ((ans (apply rd-chr opt))) (cond ((eof-object? ans)) ((output-port? transcript:port) - (write-char ans transcript:port))) + (wrt-chr ans transcript:port))) ans)))) ;@ (define read - (let ((read read) (write write) (newline newline)) + (let ((rd read) (wrt write) (nwln newline)) (lambda opt - (let ((ans (apply read opt))) + (let ((ans (apply rd opt))) (cond ((eof-object? ans)) ((output-port? transcript:port) - (write ans transcript:port) + (wrt ans transcript:port) (if (eqv? #\newline (apply peek-char opt)) - (newline transcript:port)))) + (nwln transcript:port)))) ans)))) ;@ (define write-char - (let ((write-char write-char)) + (let ((wrt-chr write-char)) (lambda (obj . opt) - (apply write-char obj opt) + (apply wrt-chr obj opt) (if (output-port? transcript:port) - (write-char obj transcript:port))))) + (wrt-chr obj transcript:port))))) ;@ (define write - (let ((write write)) + (let ((wrt write)) (lambda (obj . opt) - (apply write obj opt) + (apply wrt obj opt) (if (output-port? transcript:port) - (write obj transcript:port))))) + (wrt obj transcript:port))))) ;@ (define display - (let ((display display)) + (let ((dspl display)) (lambda (obj . opt) - (apply display obj opt) + (apply dspl obj opt) (if (output-port? transcript:port) - (display obj transcript:port))))) + (dspl obj transcript:port))))) ;@ (define newline - (let ((newline newline)) + (let ((nwln newline)) (lambda opt - (apply newline opt) + (apply nwln opt) (if (output-port? transcript:port) - (newline transcript:port))))) + (nwln transcript:port))))) diff --git a/umbscheme.init b/umbscheme.init index 3d2e3a9..37cd4f2 100644 --- a/umbscheme.init +++ b/umbscheme.init @@ -199,6 +199,9 @@ )) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + ;;; (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) @@ -221,7 +224,7 @@ (case (software-type) ((unix) (lambda (f) - (zero? (system (string-append "test -r " f))))) + (zero? (system (string-append "test -r '" f "'"))))) (else (lambda (f) #f)))) @@ -231,7 +234,7 @@ (case (software-type) ((unix) (lambda (f) - (zero? (system (string-append "rm " f))))) + (zero? (system (string-append "rm '" f "'"))))) (else (lambda (f) #f)))) diff --git a/version.txi b/version.txi index c605f5a..065b02c 100644 --- a/version.txi +++ b/version.txi @@ -1,2 +1,2 @@ -@set SLIBVERSION 3a4 -@set SLIBDATE October 2006 +@set SLIBVERSION 3a5 +@set SLIBDATE November 2007 diff --git a/vscm.init b/vscm.init index 9a1462d..d005c7e 100644 --- a/vscm.init +++ b/vscm.init @@ -237,9 +237,15 @@ ;;; (define (program-arguments) command-line-arguments) -;;; (OUTPUT-PORT-WIDTH ) +;;@ (FILE-POSITION . ) +(define (file-position . args) #f) + +;;@ (OUTPUT-PORT-WIDTH ) (define (output-port-width . arg) 79) +;;@ (OUTPUT-PORT-HEIGHT ) +(define (output-port-height . arg) 24) + ;;; (CURRENT-ERROR-PORT) (define (current-error-port) (standard-port 2)) @@ -251,11 +257,10 @@ ;;; (FILE-EXISTS? ) (define (file-exists? f) - (system (string-append "test -f " f))) + (system (string-append "test -f '" f "'"))) ;;; (DELETE-FILE ) -(define (delete-file f) - (remove-file f)) +(define delete-file remove-file) ;;; FORCE-OUTPUT flushes any pending output on optional arg output port (define force-output flush) diff --git a/withfile.scm b/withfile.scm index f9e7226..fd527f8 100644 --- a/withfile.scm +++ b/withfile.scm @@ -1,5 +1,5 @@ ; "withfile.scm", with-input-from-file and with-output-to-file for Scheme -; Copyright (c) 1992, 1993 Aubrey Jaffer +; Copyright (c) 1992, 1993, 2007 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 @@ -42,41 +42,41 @@ (lambda() (set! withfile:current-output oport)))) ;@ (define peek-char - (let ((peek-char peek-char)) + (let ((pk-chr peek-char)) (lambda opt - (peek-char (if (null? opt) withfile:current-input (car opt)))))) + (pk-chr (if (null? opt) withfile:current-input (car opt)))))) ;@ (define read-char - (let ((read-char read-char)) + (let ((rd-chr read-char)) (lambda opt - (read-char (if (null? opt) withfile:current-input (car opt)))))) + (rd-chr (if (null? opt) withfile:current-input (car opt)))))) ;@ (define read - (let ((read read)) + (let ((rd read)) (lambda opt - (read (if (null? opt) withfile:current-input (car opt)))))) + (rd (if (null? opt) withfile:current-input (car opt)))))) ;@ (define write-char - (let ((write-char write-char)) + (let ((wrt-chr write-char)) (lambda (obj . opt) - (write-char obj (if (null? opt) withfile:current-output (car opt)))))) + (wrt-chr obj (if (null? opt) withfile:current-output (car opt)))))) ;@ (define write - (let ((write write)) + (let ((wrt write)) (lambda (obj . opt) - (write obj (if (null? opt) withfile:current-output (car opt)))))) + (wrt obj (if (null? opt) withfile:current-output (car opt)))))) ;@ (define display - (let ((display display)) + (let ((dspl display)) (lambda (obj . opt) - (display obj (if (null? opt) withfile:current-output (car opt)))))) + (dspl obj (if (null? opt) withfile:current-output (car opt)))))) ;@ (define newline - (let ((newline newline)) + (let ((nwln newline)) (lambda opt - (newline (if (null? opt) withfile:current-output (car opt)))))) + (nwln (if (null? opt) withfile:current-output (car opt)))))) ;@ (define force-output - (let ((force-output force-output)) + (let ((frc-otpt force-output)) (lambda opt - (force-output (if (null? opt) withfile:current-output (car opt)))))) + (frc-otpt (if (null? opt) withfile:current-output (car opt)))))) diff --git a/wttree.scm b/wttree.scm index 7d3e010..43620d6 100644 --- a/wttree.scm +++ b/wttree.scm @@ -247,52 +247,52 @@ (define (n-join k v l r) (make-node k v l r (fix:+ 1 (fix:+ (node/size l) (node/size r))))) - (define (single-l a.k a.v x r) + (define (single-l a_k a_v x r) (with-n-node r - (lambda (b.k b.v y z) (n-join b.k b.v (n-join a.k a.v x y) z)))) + (lambda (b_k b_v y z) (n-join b_k b_v (n-join a_k a_v x y) z)))) - (define (double-l a.k a.v x r) + (define (double-l a_k a_v x r) (with-n-node r - (lambda (c.k c.v r.l z) - (with-n-node r.l - (lambda (b.k b.v y1 y2) - (n-join b.k b.v - (n-join a.k a.v x y1) - (n-join c.k c.v y2 z))))))) - - (define (single-r b.k b.v l z) + (lambda (c_k c_v r_l z) + (with-n-node r_l + (lambda (b_k b_v y1 y2) + (n-join b_k b_v + (n-join a_k a_v x y1) + (n-join c_k c_v y2 z))))))) + + (define (single-r b_k b_v l z) (with-n-node l - (lambda (a.k a.v x y) (n-join a.k a.v x (n-join b.k b.v y z))))) + (lambda (a_k a_v x y) (n-join a_k a_v x (n-join b_k b_v y z))))) - (define (double-r c.k c.v l z) + (define (double-r c_k c_v l z) (with-n-node l - (lambda (a.k a.v x l.r) - (with-n-node l.r - (lambda (b.k b.v y1 y2) - (n-join b.k b.v - (n-join a.k a.v x y1) - (n-join c.k c.v y2 z))))))) + (lambda (a_k a_v x l_r) + (with-n-node l_r + (lambda (b_k b_v y1 y2) + (n-join b_k b_v + (n-join a_k a_v x y1) + (n-join c_k c_v y2 z))))))) ;; (define-integrable wt-tree-ratio 5) (define wt-tree-ratio 5) (define (t-join k v l r) (define (simple-join) (n-join k v l r)) - (let ((l.n (node/size l)) - (r.n (node/size r))) - (cond ((fix:< (fix:+ l.n r.n) 2) (simple-join)) - ((fix:> r.n (fix:* wt-tree-ratio l.n)) + (let ((l_n (node/size l)) + (r_n (node/size r))) + (cond ((fix:< (fix:+ l_n r_n) 2) (simple-join)) + ((fix:> r_n (fix:* wt-tree-ratio l_n)) ;; right is too big - (let ((r.l.n (node/size (node/l r))) - (r.r.n (node/size (node/r r)))) - (if (fix:< r.l.n r.r.n) + (let ((r_l_n (node/size (node/l r))) + (r_r_n (node/size (node/r r)))) + (if (fix:< r_l_n r_r_n) (single-l k v l r) (double-l k v l r)))) - ((fix:> l.n (fix:* wt-tree-ratio r.n)) + ((fix:> l_n (fix:* wt-tree-ratio r_n)) ;; left is too big - (let ((l.l.n (node/size (node/l l))) - (l.r.n (node/size (node/r l)))) - (if (fix:< l.r.n l.l.n) + (let ((l_l_n (node/size (node/l l))) + (l_r_n (node/size (node/r l)))) + (if (fix:< l_r_n l_l_n) (single-r k v l r) (double-r k v l r)))) (else @@ -345,10 +345,10 @@ (define (node/index node index) (define (loop node index) - (let ((size.l (node/size (node/l node)))) - (cond ((fix:< index size.l) (loop (node/l node) index)) - ((fix:> index size.l) (loop (node/r node) - (fix:- index (fix:+ 1 size.l)))) + (let ((size_l (node/size (node/l node)))) + (cond ((fix:< index size_l) (loop (node/l node) index)) + ((fix:> index size_l) (loop (node/r node) + (fix:- index (fix:+ 1 size_l)))) (else node)))) (let ((bound (node/size node))) (if (or (< index 0) diff --git a/xml-parse.scm b/xml-parse.scm new file mode 100644 index 0000000..6056220 --- /dev/null +++ b/xml-parse.scm @@ -0,0 +1,2025 @@ +;;;;"xml-parse" XML parsing and conversion to SXML (Scheme-XML) +;;; Copyright (C) 2007 Aubrey Jaffer +;;; 2007-04 jaffer: demacrofied from public-domain SSAX 5.1 +; +;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. + +;;@code{(require 'xml-parse)} or @code{(require 'ssax)} +;; +;;@noindent +;;The XML standard document referred to in this module is@* +;;@url{http://www.w3.org/TR/1998/REC-xml-19980210.html}. +;; +;;@noindent +;;The present frameworks fully supports the XML Namespaces +;;Recommendation@* +;;@url{http://www.w3.org/TR/REC-xml-names}. + +(require 'rev2-procedures) ; for substring-move-left! +(require 'string-search) +(require 'let-values) +(require 'values) +(require 'srfi-1) ; for fold-right, fold, cons* + +;;@subsection String Glue + +;;;; Three functions from SRFI-13 +; procedure string-concatenate-reverse STRINGS [FINAL END] +(define (ssax:string-concatenate-reverse strs final end) + (if (null? strs) (substring final 0 end) + (let* + ((total-len + (let loop ((len end) (lst strs)) + (if (null? lst) len + (loop (+ len (string-length (car lst))) (cdr lst))))) + (result (make-string total-len))) + (let loop ((len end) (j total-len) (str final) (lst strs)) + (substring-move-left! str 0 len result (- j len)) + (if (null? lst) result + (loop (string-length (car lst)) (- j len) + (car lst) (cdr lst))))))) +; string-concatenate/shared STRING-LIST -> STRING +(define (ssax:string-concatenate/shared strs) + (cond ((null? strs) "") ; Test for the fast path first + ((null? (cdr strs)) (car strs)) + (else + (let* + ((total-len + (let loop ((len (string-length (car strs))) (lst (cdr strs))) + (if (null? lst) len + (loop (+ len (string-length (car lst))) (cdr lst))))) + (result (make-string total-len))) + (let loop ((j 0) (str (car strs)) (lst (cdr strs))) + (substring-move-left! str 0 (string-length str) result j) + (if (null? lst) result + (loop (+ j (string-length str)) + (car lst) (cdr lst)))))))) +; string-concatenate-reverse/shared STRING-LIST [FINAL-STRING END] -> STRING +; We do not use the optional arguments of this procedure. Therefore, +; we do not implement them. See SRFI-13 for the complete +; implementation. +(define (ssax:string-concatenate-reverse/shared strs) + (cond ((null? strs) "") ; Test for the fast path first + ((null? (cdr strs)) (car strs)) + (else + (ssax:string-concatenate-reverse (cdr strs) + (car strs) + (string-length (car strs)))))) + + +;;@args list-of-frags +;; +;;Given the list of fragments (some of which are text strings), +;;reverse the list and concatenate adjacent text strings. If +;;LIST-OF-FRAGS has zero or one element, the result of the procedure +;;is @code{equal?} to its argument. +(define (ssax:reverse-collect-str fragments) + (cond + ((null? fragments) '()) ; a shortcut + ((null? (cdr fragments)) fragments) ; see the comment above + (else + (let loop ((fragments fragments) (result '()) (strs '())) + (cond + ((null? fragments) + (if (null? strs) + result + (cons (ssax:string-concatenate/shared strs) result))) + ((string? (car fragments)) + (loop (cdr fragments) result (cons (car fragments) strs))) + (else + (loop (cdr fragments) + (cons (car fragments) + (if (null? strs) + result + (cons (ssax:string-concatenate/shared strs) result))) + '()))))))) + +;;@args list-of-frags +;; +;;Given the list of fragments (some of which are text strings), +;;reverse the list and concatenate adjacent text strings while +;;dropping "unsignificant" whitespace, that is, whitespace in front, +;;behind and between elements. The whitespace that is included in +;;character data is not affected. +;; +;;Use this procedure to "intelligently" drop "insignificant" +;;whitespace in the parsed SXML. If the strict compliance with the +;;XML Recommendation regarding the whitespace is desired, use the +;;@code{ssax:reverse-collect-str} procedure instead. +(define (ssax:reverse-collect-str-drop-ws fragments) + ;; Test if a string is made of only whitespace. + ;; An empty string is considered made of whitespace as well + (define (string-whitespace? str) + (let ((len (string-length str))) + (cond ((zero? len) #t) + ((= 1 len) (char-whitespace? (string-ref str 0))) + (else + (let loop ((i 0)) + (or (>= i len) + (and (char-whitespace? (string-ref str i)) + (loop (+ 1 i))))))))) + (cond + ((null? fragments) '()) ; a shortcut + ((null? (cdr fragments)) ; another shortcut + (if (and (string? (car fragments)) (string-whitespace? (car fragments))) + '() ; remove trailing ws + fragments)) + (else + (let loop ((fragments fragments) (result '()) (strs '()) + (all-whitespace? #t)) + (cond + ((null? fragments) + (if all-whitespace? + result ; remove leading ws + (cons (ssax:string-concatenate/shared strs) result))) + ((string? (car fragments)) + (loop (cdr fragments) + result + (cons (car fragments) strs) + (and all-whitespace? (string-whitespace? (car fragments))))) + (else + (loop (cdr fragments) + (cons (car fragments) + (if all-whitespace? + result + (cons (ssax:string-concatenate/shared strs) result))) + '() + #t))))))) + +;;@subsection Character and Token Functions +;; +;;The following functions either skip, or build and return tokens, +;;according to inclusion or delimiting semantics. The list of +;;characters to expect, include, or to break at may vary from one +;;invocation of a function to another. This allows the functions to +;;easily parse even context-sensitive languages. +;; +;;Exceptions are mentioned specifically. The list of expected +;;characters (characters to skip until, or break-characters) may +;;include an EOF "character", which is coded as symbol *eof* +;; +;;The input stream to parse is specified as a PORT, which is the last +;;argument. + +;;@args char-list string port +;; +;;Reads a character from the @3 and looks it up in the +;;@1 of expected characters. If the read character was +;;found among expected, it is returned. Otherwise, the +;;procedure writes a message using @2 as a comment +;;and quits. +(define (ssax:assert-current-char expected-chars comment port) + (let ((c (read-char port))) + (if (memv c expected-chars) c + (slib:error port "Wrong character " c + " (0x" (if (eof-object? c) + "*eof*" + (number->string (char->integer c) 16)) ") " + comment ". " expected-chars " expected")))) + +;;@args char-list port +;; +;;Reads characters from the @2 and disregards them, as long as they +;;are mentioned in the @1. The first character (which may be EOF) +;;peeked from the stream that is @emph{not} a member of the @1 is +;;returned. +(define (ssax:skip-while skip-chars port) + (do ((c (peek-char port) (peek-char port))) + ((not (memv c skip-chars)) c) + (read-char port))) + +;;; Stream tokenizers +;; +;;Note: since we can't tell offhand how large the token being read is +;;going to be, we make a guess, pre-allocate a string, and grow it by +;;quanta if necessary. The quantum is always the length of the string +;;before it was extended the last time. Thus the algorithm does a +;;Fibonacci-type extension, which has been proven optimal. +;; +;;Size 32 turns out to be fairly good, on average. That policy is +;;good only when a Scheme system is multi-threaded with preemptive +;;scheduling, or when a Scheme system supports shared substrings. In +;;all the other cases, it's better for ssax:init-buffer to return the +;;same static buffer. ssax:next-token* functions return a copy (a +;;substring) of accumulated data, so the same buffer can be reused. +;;We shouldn't worry about an incoming token being too large: +;;ssax:next-token will use another chunk automatically. Still, the +;;best size for the static buffer is to allow most of the tokens to +;;fit in. Using a static buffer _dramatically_ reduces the amount of +;;produced garbage (e.g., during XML parsing). + +;;@body +;; +;;Returns an initial buffer for @code{ssax:next-token*} procedures. +;;@0 may allocate a new buffer at each invocation. +(define (ssax:init-buffer) (make-string 32)) + +;;;(define ssax:init-buffer +;;; (let ((buffer (make-string 512))) +;;; (lambda () buffer))) + +;;@args prefix-char-list break-char-list comment-string port +;; +;;Skips any number of the prefix characters (members of the @1), if +;;any, and reads the sequence of characters up to (but not including) +;;a break character, one of the @2. +;; +;;The string of characters thus read is returned. The break character +;;is left on the input stream. @2 may include the symbol @code{*eof*}; +;;otherwise, EOF is fatal, generating an error message including a +;;specified @3. +(define (ssax:next-token prefix-skipped-chars break-chars comment port) + (let outer ((buffer (ssax:init-buffer)) (filled-buffer-l '()) + (c (ssax:skip-while prefix-skipped-chars port))) + (let ((curr-buf-len (string-length buffer))) + (let loop ((i 0) (c c)) + (cond + ((memv c break-chars) + (if (null? filled-buffer-l) (substring buffer 0 i) + (ssax:string-concatenate-reverse filled-buffer-l buffer i))) + ((eof-object? c) + (if (memq '*eof* break-chars) ; was EOF expected? + (if (null? filled-buffer-l) (substring buffer 0 i) + (ssax:string-concatenate-reverse filled-buffer-l buffer i)) + (slib:error port "EOF while reading a token " comment))) + ((>= i curr-buf-len) + (outer (make-string curr-buf-len) + (cons buffer filled-buffer-l) c)) + (else + (string-set! buffer i c) + (read-char port) ; move to the next char + (loop (+ 1 i) (peek-char port)))))))) + +;;@noindent +;;@code{ssax:next-token-of} is similar to @code{ssax:next-token} +;;except that it implements an inclusion rather than delimiting +;;semantics. + +;;@args inc-charset port +;; +;;Reads characters from the @2 that belong to the list of characters +;;@1. The reading stops at the first character which is not a member +;;of the set. This character is left on the stream. All the read +;;characters are returned in a string. +;; +;;@args pred port +;; +;;Reads characters from the @2 for which @var{pred} (a procedure of +;;one argument) returns non-#f. The reading stops at the first +;;character for which @var{pred} returns #f. That character is left +;;on the stream. All the results of evaluating of @var{pred} up to #f +;;are returned in a string. +;; +;;@var{pred} is a procedure that takes one argument (a character or +;;the EOF object) and returns a character or #f. The returned +;;character does not have to be the same as the input argument to the +;;@var{pred}. For example, +;; +;;@example +;;(ssax:next-token-of (lambda (c) +;; (cond ((eof-object? c) #f) +;; ((char-alphabetic? c) (char-downcase c)) +;; (else #f))) +;; (current-input-port)) +;;@end example +;; +;;will try to read an alphabetic token from the current input port, +;;and return it in lower case. +(define (ssax:next-token-of incl-list/pred port) + (let* ((buffer (ssax:init-buffer)) + (curr-buf-len (string-length buffer))) + (if (procedure? incl-list/pred) + (let outer ((buffer buffer) (filled-buffer-l '())) + (let loop ((i 0)) + (if (>= i curr-buf-len) ; make sure we have space + (outer (make-string curr-buf-len) (cons buffer filled-buffer-l)) + (let ((c (incl-list/pred (peek-char port)))) + (if c + (begin + (string-set! buffer i c) + (read-char port) ; move to the next char + (loop (+ 1 i))) + ;; incl-list/pred decided it had had enough + (if (null? filled-buffer-l) (substring buffer 0 i) + (ssax:string-concatenate-reverse filled-buffer-l buffer i))))))) + + ;; incl-list/pred is a list of allowed characters + (let outer ((buffer buffer) (filled-buffer-l '())) + (let loop ((i 0)) + (if (>= i curr-buf-len) ; make sure we have space + (outer (make-string curr-buf-len) (cons buffer filled-buffer-l)) + (let ((c (peek-char port))) + (cond + ((not (memv c incl-list/pred)) + (if (null? filled-buffer-l) (substring buffer 0 i) + (ssax:string-concatenate-reverse filled-buffer-l buffer i))) + (else + (string-set! buffer i c) + (read-char port) ; move to the next char + (loop (+ 1 i)))))))) + ))) + +;;@body +;; +;;Reads @1 characters from the @2, and returns them in a string. If +;;EOF is encountered before @1 characters are read, a shorter string +;;will be returned. +(define (ssax:read-string len port) + (define buffer (make-string len)) + (do ((idx 0 (+ 1 idx))) + ((>= idx len) idx) + (let ((chr (read-char port))) + (cond ((eof-object? byt) + (set! idx (+ -1 idx)) + (set! len idx)) + (else (string-set! buffer idx chr)))))) + +;;@subsection Data Types +;; +;;@table @code +;; +;;@item TAG-KIND +;; +;;A symbol @samp{START}, @samp{END}, @samp{PI}, @samp{DECL}, +;;@samp{COMMENT}, @samp{CDSECT}, or @samp{ENTITY-REF} that identifies +;;a markup token +;; +;;@item UNRES-NAME +;; +;;a name (called GI in the XML Recommendation) as given in an XML +;;document for a markup token: start-tag, PI target, attribute name. +;;If a GI is an NCName, UNRES-NAME is this NCName converted into a +;;Scheme symbol. If a GI is a QName, @samp{UNRES-NAME} is a pair of +;;symbols: @code{(@var{PREFIX} . @var{LOCALPART})}. +;; +;;@item RES-NAME +;; +;;An expanded name, a resolved version of an @samp{UNRES-NAME}. For +;;an element or an attribute name with a non-empty namespace URI, +;;@samp{RES-NAME} is a pair of symbols, +;;@code{(@var{URI-SYMB} . @var{LOCALPART})}. +;;Otherwise, it's a single symbol. +;; +;;@item ELEM-CONTENT-MODEL +;; +;;A symbol: +;;@table @samp +;;@item ANY +;;anything goes, expect an END tag. +;;@item EMPTY-TAG +;;no content, and no END-tag is coming +;;@item EMPTY +;;no content, expect the END-tag as the next token +;;@item PCDATA +;;expect character data only, and no children elements +;;@item MIXED +;;@item ELEM-CONTENT +;;@end table +;; +;;@item URI-SYMB +;; +;;A symbol representing a namespace URI -- or other symbol chosen by +;;the user to represent URI. In the former case, @code{URI-SYMB} is +;;created by %-quoting of bad URI characters and converting the +;;resulting string into a symbol. +;; +;;@item NAMESPACES +;; +;;A list representing namespaces in effect. An element of the list +;;has one of the following forms: +;; +;;@table @code +;; +;;@item (@var{prefix} @var{uri-symb} . @var{uri-symb}) or +;; +;;@item (@var{prefix} @var{user-prefix} . @var{uri-symb}) +;;@var{user-prefix} is a symbol chosen by the user to represent the URI. +;; +;;@item (#f @var{user-prefix} . @var{uri-symb}) +;;Specification of the user-chosen prefix and a URI-SYMBOL. +;; +;;@item (*DEFAULT* @var{user-prefix} . @var{uri-symb}) +;;Declaration of the default namespace +;; +;;@item (*DEFAULT* #f . #f) +;;Un-declaration of the default namespace. This notation +;;represents overriding of the previous declaration +;; +;;@end table +;; +;;A NAMESPACES list may contain several elements for the same @var{prefix}. +;;The one closest to the beginning of the list takes effect. +;; +;;@item ATTLIST +;; +;;An ordered collection of (@var{NAME} . @var{VALUE}) pairs, where +;;@var{NAME} is a RES-NAME or an UNRES-NAME. The collection is an ADT. +;; +;;@item STR-HANDLER +;; +;;A procedure of three arguments: @var{string1} @var{string2} +;;@var{seed} returning a new @var{seed}. The procedure is supposed to +;;handle a chunk of character data @var{string1} followed by a chunk +;;of character data @var{string2}. @var{string2} is a short string, +;;often @samp{"\n"} and even @samp{""}. +;; +;;@item ENTITIES +;;An assoc list of pairs: +;;@lisp +;; (@var{named-entity-name} . @var{named-entity-body}) +;;@end lisp +;; +;;where @var{named-entity-name} is a symbol under which the entity was +;;declared, @var{named-entity-body} is either a string, or (for an +;;external entity) a thunk that will return an input port (from which +;;the entity can be read). @var{named-entity-body} may also be #f. +;;This is an indication that a @var{named-entity-name} is currently +;;being expanded. A reference to this @var{named-entity-name} will be +;;an error: violation of the WFC nonrecursion. +;; +;;@item XML-TOKEN +;; +;;This record represents a markup, which is, according to the XML +;;Recommendation, "takes the form of start-tags, end-tags, +;;empty-element tags, entity references, character references, +;;comments, CDATA section delimiters, document type declarations, and +;;processing instructions." +;; +;;@table @asis +;;@item kind +;;a TAG-KIND +;;@item head +;;an UNRES-NAME. For XML-TOKENs of kinds 'COMMENT and 'CDSECT, the +;;head is #f. +;;@end table +;; +;;For example, +;;@example +;;

=> kind=START, head=P +;;

=> kind=END, head=P +;;
=> kind=EMPTY-EL, head=BR +;; => kind=DECL, head=DOCTYPE +;; => kind=PI, head=xml +;;&my-ent; => kind=ENTITY-REF, head=my-ent +;;@end example +;; +;;Character references are not represented by xml-tokens as these +;;references are transparently resolved into the corresponding +;;characters. +;; +;;@item XML-DECL +;; +;;The record represents a datatype of an XML document: the list of +;;declared elements and their attributes, declared notations, list of +;;replacement strings or loading procedures for parsed general +;;entities, etc. Normally an XML-DECL record is created from a DTD or +;;an XML Schema, although it can be created and filled in in many +;;other ways (e.g., loaded from a file). +;; +;;@table @var +;;@item elems +;;an (assoc) list of decl-elem or #f. The latter instructs +;;the parser to do no validation of elements and attributes. +;; +;;@item decl-elem +;;declaration of one element: +;; +;;@code{(@var{elem-name} @var{elem-content} @var{decl-attrs})} +;; +;;@var{elem-name} is an UNRES-NAME for the element. +;; +;;@var{elem-content} is an ELEM-CONTENT-MODEL. +;; +;;@var{decl-attrs} is an @code{ATTLIST}, of +;;@code{(@var{attr-name} . @var{value})} associations. +;; +;;This element can declare a user procedure to handle parsing of an +;;element (e.g., to do a custom validation, or to build a hash of IDs +;;as they're encountered). +;; +;;@item decl-attr +;;an element of an @code{ATTLIST}, declaration of one attribute: +;; +;;@code{(@var{attr-name} @var{content-type} @var{use-type} @var{default-value})} +;; +;;@var{attr-name} is an UNRES-NAME for the declared attribute. +;; +;;@var{content-type} is a symbol: @code{CDATA}, @code{NMTOKEN}, +;;@code{NMTOKENS}, @dots{} or a list of strings for the enumerated +;;type. +;; +;;@var{use-type} is a symbol: @code{REQUIRED}, @code{IMPLIED}, or +;;@code{FIXED}. +;; +;;@var{default-value} is a string for the default value, or #f if not +;;given. +;; +;;@end table +;; +;;@end table + +;;see a function make-empty-xml-decl to make a XML declaration entry +;;suitable for a non-validating parsing. + +;;We define xml-token simply as a pair. +(define (make-xml-token kind head) (cons kind head)) +(define xml-token? pair?) +(define xml-token-kind car) +(define xml-token-head cdr) + +;;@subsection Low-Level Parsers and Scanners +;; +;;@noindent +;;These procedures deal with primitive lexical units (Names, +;;whitespaces, tags) and with pieces of more generic productions. +;;Most of these parsers must be called in appropriate context. For +;;example, @code{ssax:complete-start-tag} must be called only when the +;;start-tag has been detected and its GI has been read. + +(define char-return (integer->char 13)) +(define ssax:S-chars (map integer->char '(32 10 9 13))) + +;;@body +;; +;;Skip the S (whitespace) production as defined by +;;@example +;;[3] S ::= (#x20 | #x09 | #x0D | #x0A) +;;@end example +;; +;;@0 returns the first not-whitespace character it encounters while +;;scanning the @1. This character is left on the input stream. +(define (ssax:skip-S port) + (ssax:skip-while ssax:S-chars port)) + +;;Check to see if a-char may start a NCName +(define (ssax:ncname-starting-char? a-char) + (and (char? a-char) + (or (char-alphabetic? a-char) + (char=? #\_ a-char)))) + +;;@body +;; +;;Read a NCName starting from the current position in the @1 and +;;return it as a symbol. +;; +;;@example +;;[4] NameChar ::= Letter | Digit | '.' | '-' | '_' | ':' +;; | CombiningChar | Extender +;;[5] Name ::= (Letter | '_' | ':') (NameChar)* +;;@end example +;; +;;This code supports the XML Namespace Recommendation REC-xml-names, +;;which modifies the above productions as follows: +;; +;;@example +;;[4] NCNameChar ::= Letter | Digit | '.' | '-' | '_' +;; | CombiningChar | Extender +;;[5] NCName ::= (Letter | '_') (NCNameChar)* +;;@end example +;; +;;As the Rec-xml-names says, +;; +;;@quotation +;;"An XML document conforms to this specification if all other tokens +;;[other than element types and attribute names] in the document which +;;are required, for XML conformance, to match the XML production for +;;Name, match this specification's production for NCName." +;;@end quotation +;; +;;Element types and attribute names must match the production QName, +;;defined below. +(define (ssax:read-NCName port) + (let ((first-char (peek-char port))) + (or (ssax:ncname-starting-char? first-char) + (slib:error port "XMLNS [4] for '" first-char "'"))) + (string->symbol (ssax:next-token-of (lambda (c) + (cond + ((eof-object? c) #f) + ((char-alphabetic? c) c) + ((string-index "0123456789.-_" c) c) + (else #f))) + port))) + +;;@body +;; +;;Read a (namespace-) Qualified Name, QName, from the current position +;;in @1; and return an UNRES-NAME. +;; +;;From REC-xml-names: +;;@example +;;[6] QName ::= (Prefix ':')? LocalPart +;;[7] Prefix ::= NCName +;;[8] LocalPart ::= NCName +;;@end example +(define (ssax:read-QName port) + (let ((prefix-or-localpart (ssax:read-NCName port))) + (case (peek-char port) + ((#\:) ; prefix was given after all + (read-char port) ; consume the colon + (cons prefix-or-localpart (ssax:read-NCName port))) + (else prefix-or-localpart) ; Prefix was omitted + ))) + +;;The prefix of the pre-defined XML namespace +(define ssax:Prefix-XML (string->symbol "xml")) + +;;An UNRES-NAME that is postulated to be larger than anything that can +;;occur in a well-formed XML document. ssax:name-compare enforces +;;this postulate. +(define ssax:largest-unres-name (cons (string->symbol "#LARGEST-SYMBOL") + (string->symbol "#LARGEST-SYMBOL"))) + +;;Compare one RES-NAME or an UNRES-NAME with the other. +;;Return a symbol '<, '>, or '= depending on the result of +;;the comparison. +;;Names without @var{prefix} are always smaller than those with the @var{prefix}. +(define ssax:name-compare + (letrec ((symbol-compare + (lambda (symb1 symb2) + (cond + ((eq? symb1 symb2) '=) + ((stringstring symb1) (symbol->string symb2)) + '<) + (else '>))))) + (lambda (name1 name2) + (cond + ((symbol? name1) (if (symbol? name2) (symbol-compare name1 name2) + '<)) + ((symbol? name2) '>) + ((eq? name2 ssax:largest-unres-name) '<) + ((eq? name1 ssax:largest-unres-name) '>) + ((eq? (car name1) (car name2)) ; prefixes the same + (symbol-compare (cdr name1) (cdr name2))) + (else (symbol-compare (car name1) (car name2))))))) + +;;@args port +;; +;;This procedure starts parsing of a markup token. The current +;;position in the stream must be @samp{<}. This procedure scans +;;enough of the input stream to figure out what kind of a markup token +;;it is seeing. The procedure returns an XML-TOKEN structure +;;describing the token. Note, generally reading of the current markup +;;is not finished! In particular, no attributes of the start-tag +;;token are scanned. +;; +;;Here's a detailed break out of the return values and the position in +;;the PORT when that particular value is returned: +;; +;;@table @asis +;; +;;@item PI-token +;; +;;only PI-target is read. To finish the Processing-Instruction and +;;disregard it, call @code{ssax:skip-pi}. @code{ssax:read-attributes} +;;may be useful as well (for PIs whose content is attribute-value +;;pairs). +;; +;;@item END-token +;; +;;The end tag is read completely; the current position is right after +;;the terminating @samp{>} character. +;; +;;@item COMMENT +;; +;;is read and skipped completely. The current position is right after +;;@samp{-->} that terminates the comment. +;; +;;@item CDSECT +;; +;;The current position is right after @samp{" port)) + (slib:error port "XML [15], no -->")) + (make-xml-token 'COMMENT #f)) + ;; we have read ") "XML [42]" port) + val)) + ((#\?) (read-char port) (make-xml-token 'PI (ssax:read-NCName port))) + ((#\!) + (read-char port) + (case (peek-char port) + ((#\-) (read-char port) (skip-comment port)) + ((#\[) (read-char port) (read-cdata port)) + (else (make-xml-token 'DECL (ssax:read-NCName port))))) + (else (make-xml-token 'START (ssax:read-QName port))))))) + +;;@body +;; +;;The current position is inside a PI. Skip till the rest of the PI +(define (ssax:skip-pi port) + (if (not (find-string-from-port? "?>" port)) + (slib:error port "Failed to find ?> terminating the PI"))) + +;;@body +;; +;;The current position is right after reading the PITarget. We read +;;the body of PI and return is as a string. The port will point to +;;the character right after @samp{?>} combination that terminates PI. +;; +;;@example +;;[16] PI ::= '' Char*)))? '?>' +;;@end example +(define (ssax:read-pi-body-as-string port) + (ssax:skip-S port) ; skip WS after the PI target name + (ssax:string-concatenate/shared + (let loop () + (let ((pi-fragment + (ssax:next-token '() '(#\?) "reading PI content" port))) + (read-char port) + (if (eqv? #\> (peek-char port)) + (begin + (read-char port) + (cons pi-fragment '())) + (cons* pi-fragment "?" (loop))))))) + +;;@body +;; +;;The current pos in the port is inside an internal DTD subset (e.g., +;;after reading @samp{#\[} that begins an internal DTD subset) Skip +;;until the @samp{]>} combination that terminates this DTD. +(define (ssax:skip-internal-dtd port) + (slib:warn port "Internal DTD subset is not currently handled ") + (if (not (find-string-from-port? "]>" port)) + (slib:error port + "Failed to find ]> terminating the internal DTD subset"))) + +;;@args port str-handler seed +;; +;;This procedure must be called after we have read a string +;;@samp{} combination is the end of the CDATA section. +;;@samp{>} is treated as an embedded @samp{>} character. +;; +;;@item +;;@samp{<} and @samp{&} are not specially recognized (and are +;;not expanded)! +;; +;;@end itemize +(define ssax:read-cdata-body + (let ((cdata-delimiters (list char-return #\newline #\] #\&))) + (lambda (port str-handler seed) + (let loop ((seed seed)) + (let ((fragment (ssax:next-token '() cdata-delimiters "reading CDATA" port))) + ;; that is, we're reading the char after the 'fragment' + (case (read-char port) + ((#\newline) (loop (str-handler fragment #\newline seed))) + ((#\]) + (if (not (eqv? (peek-char port) #\])) + (loop (str-handler fragment "]" seed)) + (let check-after-second-braket + ((seed (if (string-null? fragment) seed + (str-handler fragment "" seed)))) + (read-char port) + (case (peek-char port) ; after the second bracket + ((#\>) (read-char port) seed) ; we have read "]]>" + ((#\]) (check-after-second-braket + (str-handler "]" "" seed))) + (else (loop (str-handler "]]" "" seed))))))) + ((#\&) ; Note that #\& within CDATA may stand for itself + (let ((ent-ref ; it does not have to start an entity ref + (ssax:next-token-of + (lambda (c) + (and (not (eof-object? c)) (char-alphabetic? c) c)) + port))) + (cond ; replace ">" with #\> + ((and (string=? "gt" ent-ref) (eqv? (peek-char port) #\;)) + (read-char port) + (loop (str-handler fragment ">" seed))) + (else + (loop + (str-handler ent-ref "" + (str-handler fragment "&" seed))))))) + (else ; Must be CR: if the next char is #\newline, skip it + (if (eqv? (peek-char port) #\newline) (read-char port)) + (loop (str-handler fragment #\newline seed))) + )))))) + +;;@body +;; +;;@example +;;[66] CharRef ::= '&#' [0-9]+ ';' +;; | '&#x' [0-9a-fA-F]+ ';' +;;@end example +;; +;;This procedure must be called after we we have read @samp{&#} that +;;introduces a char reference. The procedure reads this reference and +;;returns the corresponding char. The current position in PORT will +;;be after the @samp{;} that terminates the char reference. +;; +;;Faults detected:@* +;;WFC: XML-Spec.html#wf-Legalchar +;; +;;According to Section @cite{4.1 Character and Entity References} +;;of the XML Recommendation: +;; +;;@quotation +;;"[Definition: A character reference refers to a specific character +;;in the ISO/IEC 10646 character set, for example one not directly +;;accessible from available input devices.]" +;;@end quotation +;; +;;@c Therefore, we use a @code{ucscode->char} function to convert a +;;@c character code into the character -- *regardless* of the current +;;@c character encoding of the input stream. +(define (ssax:read-char-ref port) + (let* ((base (cond ((eqv? (peek-char port) #\x) (read-char port) 16) + (else 10))) + (name (ssax:next-token '() '(#\;) "XML [66]" port)) + (char-code (string->number name base))) + (read-char port) ; read the terminating #\; char + (if (integer? char-code) (integer->char char-code) + (slib:error port "[wf-Legalchar] broken for '" name "'")))) + +(define ssax:predefined-parsed-entities + `( + (,(string->symbol "amp") . "&") + (,(string->symbol "lt") . "<") + (,(string->symbol "gt") . ">") + (,(string->symbol "apos") . "'") + (,(string->symbol "quot") . "\"") + )) + +;;@body +;; +;;Expands and handles a parsed-entity reference. +;; +;;@2 is a symbol, the name of the parsed entity to expand. +;;@c entities - see ENTITIES +;;@4 is a procedure of arguments @var{port}, @var{entities}, and +;;@var{seed} that returns a seed. +;;@5 is called if the entity in question is a pre-declared entity. +;; +;;@0 returns the result returned by @4 or @5. +;; +;;Faults detected:@* +;;WFC: XML-Spec.html#wf-entdeclared@* +;;WFC: XML-Spec.html#norecursion +(define (ssax:handle-parsed-entity port name entities content-handler str-handler seed) + (cond ; First we check the list of the declared entities + ((assq name entities) => + (lambda (decl-entity) + (let ((ent-body (cdr decl-entity)) ; mark the list to prevent recursion + (new-entities (cons (cons name #f) entities))) + (cond + ((string? ent-body) + (call-with-input-string ent-body + (lambda (port) (content-handler port new-entities seed)))) + ((procedure? ent-body) + (let ((port (ent-body))) + (define val (content-handler port new-entities seed)) + (close-input-port port) + val)) + (else + (slib:error port "[norecursion] broken for " name)))))) + ((assq name ssax:predefined-parsed-entities) + => (lambda (decl-entity) + (str-handler (cdr decl-entity) "" seed))) + (else (slib:error port "[wf-entdeclared] broken for " name)))) + +;;;; The ATTLIST Abstract Data Type + +;;; Currently is implemented as an assoc list sorted in the ascending +;;; order of NAMES. + +(define attlist-fold fold) +(define attlist-null? null?) +(define attlist->alist identity) +(define (make-empty-attlist) '()) + +;;@body +;; +;;Add a @2 pair to the existing @1, preserving its sorted ascending +;;order; and return the new list. Return #f if a pair with the same +;;name already exists in @1 +(define (attlist-add attlist name-value) + (if (null? attlist) (cons name-value attlist) + (case (ssax:name-compare (car name-value) (caar attlist)) + ((=) #f) + ((<) (cons name-value attlist)) + (else (cons (car attlist) (attlist-add (cdr attlist) name-value))) + ))) + +;;@body +;; +;;Given an non-null @1, return a pair of values: the top and the rest. +(define (attlist-remove-top attlist) + (values (car attlist) (cdr attlist))) + +;;@args port entities +;; +;;This procedure reads and parses a production @dfn{Attribute}. +;; +;;@example +;;[41] Attribute ::= Name Eq AttValue +;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' +;; | "'" ([^<&'] | Reference)* "'" +;;[25] Eq ::= S? '=' S? +;;@end example +;; +;;The procedure returns an ATTLIST, of Name (as UNRES-NAME), Value (as +;;string) pairs. The current character on the @1 is a non-whitespace +;;character that is not an NCName-starting character. +;; +;;Note the following rules to keep in mind when reading an +;;@dfn{AttValue}: +;;@quotation +;;Before the value of an attribute is passed to the application or +;;checked for validity, the XML processor must normalize it as +;;follows: +;; +;;@itemize @bullet +;;@item +;;A character reference is processed by appending the referenced +;;character to the attribute value. +;; +;;@item +;;An entity reference is processed by recursively processing the +;;replacement text of the entity. The named entities @samp{amp}, +;;@samp{lt}, @samp{gt}, @samp{quot}, and @samp{apos} are pre-declared. +;; +;;@item +;;A whitespace character (#x20, #x0D, #x0A, #x09) is processed by +;;appending #x20 to the normalized value, except that only a single +;;#x20 is appended for a "#x0D#x0A" sequence that is part of an +;;external parsed entity or the literal entity value of an internal +;;parsed entity. +;; +;;@item +;;Other characters are processed by appending them to the normalized +;;value. +;; +;;@end itemize +;; +;;@end quotation +;; +;;Faults detected:@* +;;WFC: XML-Spec.html#CleanAttrVals@* +;;WFC: XML-Spec.html#uniqattspec +(define ssax:read-attributes ; ssax:read-attributes port entities + (let ((value-delimeters (append '(#\< #\&) ssax:S-chars))) + ;; Read the AttValue from the PORT up to the delimiter (which can + ;; be a single or double-quote character, or even a symbol *eof*). + ;; 'prev-fragments' is the list of string fragments, accumulated + ;; so far, in reverse order. Return the list of fragments with + ;; newly read fragments prepended. + (define (read-attrib-value delimiter port entities prev-fragments) + (let* ((new-fragments + (cons (ssax:next-token '() (cons delimiter value-delimeters) + "XML [10]" port) + prev-fragments)) + (cterm (read-char port))) + (cond + ((or (eof-object? cterm) (eqv? cterm delimiter)) + new-fragments) + ((eqv? cterm char-return) ; treat a CR and CRLF as a LF + (if (eqv? (peek-char port) #\newline) (read-char port)) + (read-attrib-value delimiter port entities + (cons " " new-fragments))) + ((memv cterm ssax:S-chars) + (read-attrib-value delimiter port entities + (cons " " new-fragments))) + ((eqv? cterm #\&) + (cond + ((eqv? (peek-char port) #\#) + (read-char port) + (read-attrib-value delimiter port entities + (cons (string (ssax:read-char-ref port)) new-fragments))) + (else + (read-attrib-value delimiter port entities + (read-named-entity port entities new-fragments))))) + (else (slib:error port "[CleanAttrVals] broken"))))) + + ;; we have read "&" that introduces a named entity reference. + ;; read this reference and return the result of normalizing of the + ;; corresponding string (that is, read-attrib-value is applied to + ;; the replacement text of the entity). The current position will + ;; be after ";" that terminates the entity reference + (define (read-named-entity port entities fragments) + (let ((name (ssax:read-NCName port))) + (ssax:assert-current-char '(#\;) "XML [68]" port) + (ssax:handle-parsed-entity port name entities + (lambda (port entities fragments) + (read-attrib-value '*eof* port entities fragments)) + (lambda (str1 str2 fragments) + (if (equal? "" str2) (cons str1 fragments) + (cons* str2 str1 fragments))) + fragments))) + + (lambda (port entities) + (let loop ((attr-list (make-empty-attlist))) + (if (not (ssax:ncname-starting-char? (ssax:skip-S port))) attr-list + (let ((name (ssax:read-QName port))) + (ssax:skip-S port) + (ssax:assert-current-char '(#\=) "XML [25]" port) + (ssax:skip-S port) + (let ((delimiter + (ssax:assert-current-char '(#\' #\" ) "XML [10]" port))) + (loop + (or (attlist-add attr-list + (cons name + (ssax:string-concatenate-reverse/shared + (read-attrib-value delimiter port entities + '())))) + (slib:error port "[uniqattspec] broken for " name)))))))) + )) + +;;@body +;; +;;Convert an @2 to a RES-NAME, given the appropriate @3 declarations. +;;The last parameter, @4, determines if the default namespace applies +;;(for instance, it does not for attribute names). +;; +;;Per REC-xml-names/#nsc-NSDeclared, the "xml" prefix is considered +;;pre-declared and bound to the namespace name +;;"http://www.w3.org/XML/1998/namespace". +;; +;;@0 tests for the namespace constraints:@* +;;@url{http://www.w3.org/TR/REC-xml-names/#nsc-NSDeclared} +(define (ssax:resolve-name port unres-name namespaces apply-default-ns?) + (cond + ((pair? unres-name) ; it's a QNAME + (cons + (cond + ((assq (car unres-name) namespaces) => cadr) + ((eq? (car unres-name) ssax:Prefix-XML) ssax:Prefix-XML) + (else + (slib:error port "[nsc-NSDeclared] broken; prefix " (car unres-name)))) + (cdr unres-name))) + (apply-default-ns? ; Do apply the default namespace, if any + (let ((default-ns (assq '*DEFAULT* namespaces))) + (if (and default-ns (cadr default-ns)) + (cons (cadr default-ns) unres-name) + unres-name))) ; no default namespace declared + (else unres-name))) ; no prefix, don't apply the default-ns + + +;;Procedure: ssax:uri-string->symbol URI-STR +;;Convert a URI-STR to an appropriate symbol +(define ssax:uri-string->symbol string->symbol) + + +;;@args tag port elems entities namespaces +;; +;;Complete parsing of a start-tag markup. @0 must be called after the +;;start tag token has been read. @1 is an UNRES-NAME. @3 is an +;;instance of the ELEMS slot of XML-DECL; it can be #f to tell the +;;function to do @emph{no} validation of elements and their +;;attributes. +;; +;;@0 returns several values: +;;@itemize @bullet +;;@item ELEM-GI: +;;a RES-NAME. +;;@item ATTRIBUTES: +;;element's attributes, an ATTLIST of (RES-NAME . STRING) pairs. +;;The list does NOT include xmlns attributes. +;;@item NAMESPACES: +;;the input list of namespaces amended with namespace +;;(re-)declarations contained within the start-tag under parsing +;;@item ELEM-CONTENT-MODEL +;;@end itemize +;; +;;On exit, the current position in @2 will be the first character +;;after @samp{>} that terminates the start-tag markup. +;; +;;Faults detected:@* +;;VC: XML-Spec.html#enum@* +;;VC: XML-Spec.html#RequiredAttr@* +;;VC: XML-Spec.html#FixedAttr@* +;;VC: XML-Spec.html#ValueType@* +;;WFC: XML-Spec.html#uniqattspec (after namespaces prefixes are resolved)@* +;;VC: XML-Spec.html#elementvalid@* +;;WFC: REC-xml-names/#dt-NSName +;; +;;@emph{Note}: although XML Recommendation does not explicitly say it, +;;xmlns and xmlns: attributes don't have to be declared (although they +;;can be declared, to specify their default value). +(define ssax:complete-start-tag + + (let ((xmlns (string->symbol "xmlns")) + (largest-dummy-decl-attr (list ssax:largest-unres-name #f #f #f))) + + ;; Scan through the attlist and validate it, against decl-attrs + ;; Return an assoc list with added fixed or implied attrs. + ;; Note that both attlist and decl-attrs are ATTLISTs, and therefore, + ;; sorted + (define (validate-attrs port attlist decl-attrs) + + ;; Check to see decl-attr is not of use type REQUIRED. Add + ;; the association with the default value, if any declared + (define (add-default-decl decl-attr result) + (let*-values + (((attr-name content-type use-type default-value) + (apply values decl-attr))) + (and (eq? use-type 'REQUIRED) + (slib:error port "[RequiredAttr] broken for" attr-name)) + (if default-value + (cons (cons attr-name default-value) result) + result))) + + (let loop ((attlist attlist) (decl-attrs decl-attrs) (result '())) + (if (attlist-null? attlist) + (attlist-fold add-default-decl result decl-attrs) + (let*-values + (((attr attr-others) + (attlist-remove-top attlist)) + ((decl-attr other-decls) + (if (attlist-null? decl-attrs) + (values largest-dummy-decl-attr decl-attrs) + (attlist-remove-top decl-attrs))) + ) + (case (ssax:name-compare (car attr) (car decl-attr)) + ((<) + (if (or (eq? xmlns (car attr)) + (and (pair? (car attr)) (eq? xmlns (caar attr)))) + (loop attr-others decl-attrs (cons attr result)) + (slib:error port "[ValueType] broken for " attr))) + ((>) + (loop attlist other-decls + (add-default-decl decl-attr result))) + (else ; matched occurrence of an attr with its declaration + (let*-values + (((attr-name content-type use-type default-value) + (apply values decl-attr))) + ;; Run some tests on the content of the attribute + (cond + ((eq? use-type 'FIXED) + (or (equal? (cdr attr) default-value) + (slib:error port "[FixedAttr] broken for " attr-name))) + ((eq? content-type 'CDATA) #t) ; everything goes + ((pair? content-type) + (or (member (cdr attr) content-type) + (slib:error port "[enum] broken for " attr-name "=" + (cdr attr)))) + (else + (slib:warn port "declared content type " content-type + " not verified yet"))) + (loop attr-others other-decls (cons attr result))))) + )))) + + + ;; Add a new namespace declaration to namespaces. + ;; First we convert the uri-str to a uri-symbol and search namespaces for + ;; an association (_ user-prefix . uri-symbol). + ;; If found, we return the argument namespaces with an association + ;; (prefix user-prefix . uri-symbol) prepended. + ;; Otherwise, we prepend (prefix uri-symbol . uri-symbol) + (define (add-ns port prefix uri-str namespaces) + (and (equal? "" uri-str) + (slib:error port "[dt-NSName] broken for " prefix)) + (let ((uri-symbol (ssax:uri-string->symbol uri-str))) + (let loop ((nss namespaces)) + (cond + ((null? nss) + (cons (cons* prefix uri-symbol uri-symbol) namespaces)) + ((eq? uri-symbol (cddar nss)) + (cons (cons* prefix (cadar nss) uri-symbol) namespaces)) + (else (loop (cdr nss))))))) + + ;; partition attrs into proper attrs and new namespace declarations + ;; return two values: proper attrs and the updated namespace declarations + (define (adjust-namespace-decl port attrs namespaces) + (let loop ((attrs attrs) (proper-attrs '()) (namespaces namespaces)) + (cond + ((null? attrs) (values proper-attrs namespaces)) + ((eq? xmlns (caar attrs)) ; re-decl of the default namespace + (loop (cdr attrs) proper-attrs + (if (equal? "" (cdar attrs)) ; un-decl of the default ns + (cons (cons* '*DEFAULT* #f #f) namespaces) + (add-ns port '*DEFAULT* (cdar attrs) namespaces)))) + ((and (pair? (caar attrs)) (eq? xmlns (caaar attrs))) + (loop (cdr attrs) proper-attrs + (add-ns port (cdaar attrs) (cdar attrs) namespaces))) + (else + (loop (cdr attrs) (cons (car attrs) proper-attrs) namespaces))))) + + ;; The body of the function + (lambda (tag-head port elems entities namespaces) + (let*-values + (((attlist) (ssax:read-attributes port entities)) + ((empty-el-tag?) + (begin + (ssax:skip-S port) + (and + (eqv? #\/ + (ssax:assert-current-char '(#\> #\/) "XML [40], XML [44], no '>'" port)) + (ssax:assert-current-char '(#\>) "XML [44], no '>'" port)))) + ((elem-content decl-attrs) ; see xml-decl for their type + (if elems ; elements declared: validate! + (cond + ((assoc tag-head elems) => + (lambda (decl-elem) ; of type xml-decl::decl-elem + (values + (if empty-el-tag? 'EMPTY-TAG (cadr decl-elem)) + (caddr decl-elem)))) + (else + (slib:error port "[elementvalid] broken, no decl for " tag-head))) + (values ; non-validating parsing + (if empty-el-tag? 'EMPTY-TAG 'ANY) + #f) ; no attributes declared + )) + ((merged-attrs) (if decl-attrs (validate-attrs port attlist decl-attrs) + (attlist->alist attlist))) + ((proper-attrs namespaces) + (adjust-namespace-decl port merged-attrs namespaces)) + ) + ;; build the return value + (values + (ssax:resolve-name port tag-head namespaces #t) + (fold-right + (lambda (name-value attlist) + (or + (attlist-add attlist + (cons (ssax:resolve-name port (car name-value) namespaces #f) + (cdr name-value))) + (slib:error port "[uniqattspec] after NS expansion broken for " + name-value))) + (make-empty-attlist) + proper-attrs) + namespaces + elem-content))))) + +;;@body +;; +;;Parses an ExternalID production: +;; +;;@example +;;[75] ExternalID ::= 'SYSTEM' S SystemLiteral +;; | 'PUBLIC' S PubidLiteral S SystemLiteral +;;[11] SystemLiteral ::= ('"' [^"]* '"') | ("'" [^']* "'") +;;[12] PubidLiteral ::= '"' PubidChar* '"' +;; | "'" (PubidChar - "'")* "'" +;;[13] PubidChar ::= #x20 | #x0D | #x0A | [a-zA-Z0-9] +;; | [-'()+,./:=?;!*#@@$_%] +;;@end example +;; +;;Call @0 when an ExternalID is expected; that is, the current +;;character must be either #\S or #\P that starts correspondingly a +;;SYSTEM or PUBLIC token. @0 returns the @var{SystemLiteral} as a +;;string. A @var{PubidLiteral} is disregarded if present. +(define (ssax:read-external-id port) + (let ((discriminator (ssax:read-NCName port))) + (ssax:assert-current-char ssax:S-chars "space after SYSTEM or PUBLIC" port) + (ssax:skip-S port) + (let ((delimiter + (ssax:assert-current-char '(#\' #\" ) "XML [11], XML [12]" port))) + (cond + ((eq? discriminator (string->symbol "SYSTEM")) + (let ((val (ssax:next-token '() (list delimiter) "XML [11]" port))) + (read-char port) ; reading the closing delim + val)) + ((eq? discriminator (string->symbol "PUBLIC")) + (let loop ((c (read-char port))) + (cond + ((eqv? c delimiter) c) + ((eof-object? c) + (slib:error port "Unexpected EOF while skipping until " delimiter)) + (else (loop (read-char port))))) + (ssax:assert-current-char ssax:S-chars "space after PubidLiteral" port) + (ssax:skip-S port) + (let* ((delimiter + (ssax:assert-current-char '(#\' #\" ) "XML [11]" port)) + (systemid + (ssax:next-token '() (list delimiter) "XML [11]" port))) + (read-char port) ; reading the closing delim + systemid)) + (else + (slib:error port "XML [75], " discriminator + " rather than SYSTEM or PUBLIC")))))) + + +;;@subsection Mid-Level Parsers and Scanners +;; +;;@noindent +;;These procedures parse productions corresponding to the whole +;;(document) entity or its higher-level pieces (prolog, root element, +;;etc). + +;;@body +;; +;;Scan the Misc production in the context: +;; +;;@example +;;[1] document ::= prolog element Misc* +;;[22] prolog ::= XMLDecl? Misc* (doctypedec l Misc*)? +;;[27] Misc ::= Comment | PI | S +;;@end example +;; +;;Call @0 in the prolog or epilog contexts. In these contexts, +;;whitespaces are completely ignored. The return value from @0 is +;;either a PI-token, a DECL-token, a START token, or *EOF*. Comments +;;are ignored and not reported. +(define (ssax:scan-misc port) + (let loop ((c (ssax:skip-S port))) + (cond + ((eof-object? c) c) + ((not (char=? c #\<)) + (slib:error port "XML [22], char '" c "' unexpected")) + (else + (let ((token (ssax:read-markup-token port))) + (case (xml-token-kind token) + ((COMMENT) (loop (ssax:skip-S port))) + ((PI DECL START) token) + (else + (slib:error port "XML [22], unexpected token of kind " + (xml-token-kind token) + )))))))) + +;;@args port expect-eof? str-handler iseed +;; +;;Read the character content of an XML document or an XML element. +;; +;;@example +;;[43] content ::= +;;(element | CharData | Reference | CDSect | PI | Comment)* +;;@end example +;; +;;To be more precise, @0 reads CharData, expands CDSect and character +;;entities, and skips comments. @0 stops at a named reference, EOF, +;;at the beginning of a PI, or a start/end tag. +;; +;;@2 is a boolean indicating if EOF is normal; i.e., the character +;;data may be terminated by the EOF. EOF is normal while processing a +;;parsed entity. +;; +;;@4 is an argument passed to the first invocation of @3. +;; +;;@0 returns two results: @var{seed} and @var{token}. The @var{seed} +;;is the result of the last invocation of @3, or the original @4 if @3 +;;was never called. +;; +;;@var{token} can be either an eof-object (this can happen only if @2 +;;was #t), or: +;;@itemize @bullet +;; +;;@item +;;an xml-token describing a START tag or an END-tag; +;;For a start token, the caller has to finish reading it. +;; +;;@item +;;an xml-token describing the beginning of a PI. It's up to an +;;application to read or skip through the rest of this PI; +;; +;;@item +;;an xml-token describing a named entity reference. +;; +;;@end itemize +;; +;;CDATA sections and character references are expanded inline and +;;never returned. Comments are silently disregarded. +;; +;;As the XML Recommendation requires, all whitespace in character data +;;must be preserved. However, a CR character (#x0D) must be +;;disregarded if it appears before a LF character (#x0A), or replaced +;;by a #x0A character otherwise. See Secs. 2.10 and 2.11 of the XML +;;Recommendation. See also the canonical XML Recommendation. +(define ssax:read-char-data + (let ((terminators-usual (list #\< #\& char-return)) + (terminators-usual-eof (list #\< '*eof* #\& char-return)) + (handle-fragment + (lambda (fragment str-handler seed) + (if (string-null? fragment) seed + (str-handler fragment "" seed))))) + (lambda (port expect-eof? str-handler seed) + ;; Very often, the first character we encounter is #\< + ;; Therefore, we handle this case in a special, fast path + (if (eqv? #\< (peek-char port)) + ;; The fast path + (let ((token (ssax:read-markup-token port))) + (case (xml-token-kind token) + ((START END) ; The most common case + (values seed token)) + ((CDSECT) + (let ((seed (ssax:read-cdata-body port str-handler seed))) + (ssax:read-char-data port expect-eof? str-handler seed))) + ((COMMENT) + (ssax:read-char-data port expect-eof? str-handler seed)) + (else + (values seed token)))) + ;; The slow path + (let ((char-data-terminators + (if expect-eof? terminators-usual-eof terminators-usual))) + (let loop ((seed seed)) + (let* ((fragment + (ssax:next-token '() char-data-terminators + "reading char data" port)) + (term-char (peek-char port)) ; one of char-data-terminators + ) + (if (eof-object? term-char) + (values + (handle-fragment fragment str-handler seed) + term-char) + (case term-char + ((#\<) + (let ((token (ssax:read-markup-token port))) + (case (xml-token-kind token) + ((CDSECT) + (loop + (ssax:read-cdata-body port str-handler + (handle-fragment fragment str-handler seed)))) + ((COMMENT) + (loop (handle-fragment fragment str-handler seed))) + (else + (values + (handle-fragment fragment str-handler seed) + token))))) + ((#\&) + (read-char port) + (case (peek-char port) + ((#\#) (read-char port) + (loop (str-handler fragment + (string (ssax:read-char-ref port)) + seed))) + (else + (let ((name (ssax:read-NCName port))) + (ssax:assert-current-char '(#\;) "XML [68]" port) + (values + (handle-fragment fragment str-handler seed) + (make-xml-token 'ENTITY-REF name)))))) + (else ; This must be a CR character + (read-char port) + (if (eqv? (peek-char port) #\newline) + (read-char port)) + (loop (str-handler fragment (string #\newline) seed)))) + )))))))) + +;;@body +;; +;;Make sure that @1 is of anticipated @2 and has anticipated @3. Note +;;that the @3 argument may actually be a pair of two symbols, +;;Namespace-URI or the prefix, and of the localname. If the assertion +;;fails, @4 is evaluated by passing it three arguments: @1 @2 @3. The +;;result of @4 is returned. +(define (ssax:assert-token token kind gi error-cont) + (or (and (xml-token? token) + (eq? kind (xml-token-kind token)) + (equal? gi (xml-token-head token))) + (error-cont token kind gi))) + +;;@subsection High-level Parsers +;; +;;These procedures are to instantiate a SSAX parser. A user can +;;instantiate the parser to do the full validation, or no validation, +;;or any particular validation. The user specifies which PI he wants +;;to be notified about. The user tells what to do with the parsed +;;character and element data. The latter handlers determine if the +;;parsing follows a SAX or a DOM model. + +;;@args my-pi-handlers +;; +;;Create a parser to parse and process one Processing Element (PI). +;; +;;@1 is an association list of pairs +;;@code{(@var{pi-tag} . @var{pi-handler})} where @var{pi-tag} is an +;;NCName symbol, the PI target; and @var{pi-handler} is a procedure +;;taking arguments @var{port}, @var{pi-tag}, and @var{seed}. +;; +;;@var{pi-handler} should read the rest of the PI up to and including +;;the combination @samp{?>} that terminates the PI. The handler +;;should return a new seed. One of the @var{pi-tag}s may be the +;;symbol @code{*DEFAULT*}. The corresponding handler will handle PIs +;;that no other handler will. If the *DEFAULT* @var{pi-tag} is not +;;specified, @0 will assume the default handler that skips the body of +;;the PI. +;; +;;@0 returns a procedure of arguments @var{port}, @var{pi-tag}, and +;;@var{seed}; that will parse the current PI according to @1. +(define (ssax:make-pi-parser handlers) + (lambda (port target seed) + (define pair (assv target handlers)) + (or pair (set! pair (assv '*DEFAULT* handlers))) + (cond ((not pair) + (slib:warn port "Skipping PI: " target #\newline) + (ssax:skip-pi port) + seed) + (else ((cdr pair) port target seed))))) + +;;syntax: ssax:make-elem-parser +;; my-new-level-seed my-finish-element my-char-data-handler my-pi-handlers + +;;@body +;; +;;Create a parser to parse and process one element, including its +;;character content or children elements. The parser is typically +;;applied to the root element of a document. +;; +;;@table @asis +;; +;;@item @1 +;;is a procedure taking arguments: +;; +;;@var{elem-gi} @var{attributes} @var{namespaces} @var{expected-content} @var{seed} +;; +;;where @var{elem-gi} is a RES-NAME of the element about to be +;;processed. +;; +;;@1 is to generate the seed to be passed to handlers that process the +;;content of the element. +;; +;;@item @2 +;;is a procedure taking arguments: +;; +;;@var{elem-gi} @var{attributes} @var{namespaces} @var{parent-seed} @var{seed} +;; +;;@2 is called when parsing of @var{elem-gi} is finished. +;;The @var{seed} is the result from the last content parser (or +;;from @1 if the element has the empty content). +;;@var{parent-seed} is the same seed as was passed to @1. +;;@2 is to generate a seed that will be the result +;;of the element parser. +;; +;;@item @3 +;;is a STR-HANDLER as described in Data Types above. +;; +;;@item @4 +;;is as described for @code{ssax:make-pi-handler} above. +;; +;;@end table +;; +;;The generated parser is a procedure taking arguments: +;; +;;@var{start-tag-head} @var{port} @var{elems} @var{entities} @var{namespaces} @var{preserve-ws?} @var{seed} +;; +;;The procedure must be called after the start tag token has been +;;read. @var{start-tag-head} is an UNRES-NAME from the start-element +;;tag. ELEMS is an instance of ELEMS slot of XML-DECL. +;; +;;Faults detected:@* +;;VC: XML-Spec.html#elementvalid@* +;;WFC: XML-Spec.html#GIMatch +(define (ssax:make-elem-parser my-new-level-seed my-finish-element + my-char-data-handler my-pi-handlers) + (lambda (start-tag-head port elems entities namespaces preserve-ws? seed) + (define xml-space-gi (cons ssax:Prefix-XML + (string->symbol "space"))) + (let handle-start-tag ((start-tag-head start-tag-head) + (port port) (entities entities) + (namespaces namespaces) + (preserve-ws? preserve-ws?) (parent-seed seed)) + (let*-values + (((elem-gi attributes namespaces expected-content) + (ssax:complete-start-tag start-tag-head port elems + entities namespaces)) + ((seed) + (my-new-level-seed elem-gi attributes + namespaces expected-content parent-seed))) + (case expected-content + ((EMPTY-TAG) + (my-finish-element + elem-gi attributes namespaces parent-seed seed)) + ((EMPTY) ; The end tag must immediately follow + (ssax:assert-token (and (eqv? #\< (ssax:skip-S port)) + (ssax:read-markup-token port)) + 'END + start-tag-head + (lambda (token exp-kind exp-head) + (slib:error port "[elementvalid] broken for " token + " while expecting " + exp-kind exp-head))) + (my-finish-element + elem-gi attributes namespaces parent-seed seed)) + (else ; reading the content... + (let ((preserve-ws? ; inherit or set the preserve-ws? flag + (cond ((assoc xml-space-gi attributes) => + (lambda (name-value) + (equal? "preserve" (cdr name-value)))) + (else preserve-ws?)))) + (let loop ((port port) (entities entities) + (expect-eof? #f) (seed seed)) + (let*-values + (((seed term-token) + (ssax:read-char-data port expect-eof? + my-char-data-handler seed))) + (if (eof-object? term-token) + seed + (case (xml-token-kind term-token) + ((END) + (ssax:assert-token term-token 'END start-tag-head + (lambda (token exp-kind exp-head) + (slib:error port "[GIMatch] broken for " + term-token " while expecting " + exp-kind exp-head))) + (my-finish-element + elem-gi attributes namespaces parent-seed seed)) + ((PI) + (let ((seed + ((ssax:make-pi-parser my-pi-handlers) + port (xml-token-head term-token) seed))) + (loop port entities expect-eof? seed))) + ((ENTITY-REF) + (let ((seed + (ssax:handle-parsed-entity + port (xml-token-head term-token) + entities + (lambda (port entities seed) + (loop port entities #t seed)) + my-char-data-handler + seed))) ; keep on reading the content after ent + (loop port entities expect-eof? seed))) + ((START) ; Start of a child element + (if (eq? expected-content 'PCDATA) + (slib:error port "[elementvalid] broken for " + elem-gi + " with char content only; unexpected token " + term-token)) + ;; Do other validation of the element content + (let ((seed + (handle-start-tag + (xml-token-head term-token) + port entities namespaces + preserve-ws? seed))) + (loop port entities expect-eof? seed))) + (else + (slib:error port "XML [43] broken for " + term-token)))))))) + ))) + )) + + +;;This is ssax:make-parser with all the (specialization) handlers given +;;as positional arguments. It is called by ssax:make-parser, see below +(define (ssax:make-parser/positional-args + *handler-DOCTYPE + *handler-UNDECL-ROOT + *handler-DECL-ROOT + *handler-NEW-LEVEL-SEED + *handler-FINISH-ELEMENT + *handler-CHAR-DATA-HANDLER + *handler-PROCESSING-INSTRUCTIONS) + (lambda (port seed) + ;; We must've just scanned the DOCTYPE token. Handle the + ;; doctype declaration and exit to + ;; scan-for-significant-prolog-token-2, and eventually, to the + ;; element parser. + (define (handle-decl port token-head seed) + (or (eq? (string->symbol "DOCTYPE") token-head) + (slib:error port "XML [22], expected DOCTYPE declaration, found " + token-head)) + (ssax:assert-current-char ssax:S-chars "XML [28], space after DOCTYPE" port) + (ssax:skip-S port) + (let*-values + (((docname) (ssax:read-QName port)) + ((systemid) + (and (ssax:ncname-starting-char? (ssax:skip-S port)) + (ssax:read-external-id port))) + ((internal-subset?) + (begin + (ssax:skip-S port) + (eqv? #\[ + (ssax:assert-current-char '(#\> #\[) + "XML [28], end-of-DOCTYPE" port)))) + ((elems entities namespaces seed) + (*handler-DOCTYPE port docname systemid internal-subset? seed))) + (scan-for-significant-prolog-token-2 port elems entities namespaces + seed))) + ;; Scan the leading PIs until we encounter either a doctype + ;; declaration or a start token (of the root element). In the + ;; latter two cases, we exit to the appropriate continuation + (define (scan-for-significant-prolog-token-1 port seed) + (let ((token (ssax:scan-misc port))) + (if (eof-object? token) + (slib:error port "XML [22], unexpected EOF") + (case (xml-token-kind token) + ((PI) + (let ((seed + ((ssax:make-pi-parser *handler-PROCESSING-INSTRUCTIONS) + port (xml-token-head token) seed))) + (scan-for-significant-prolog-token-1 port seed))) + ((DECL) (handle-decl port (xml-token-head token) seed)) + ((START) + (let*-values + (((elems entities namespaces seed) + (*handler-UNDECL-ROOT (xml-token-head token) seed))) + (element-parser (xml-token-head token) port elems + entities namespaces #f seed))) + (else (slib:error port "XML [22], unexpected markup " + token)))))) + ;; Scan PIs after the doctype declaration, till we encounter + ;; the start tag of the root element. After that we exit + ;; to the element parser + (define (scan-for-significant-prolog-token-2 port elems entities namespaces seed) + (let ((token (ssax:scan-misc port))) + (if (eof-object? token) + (slib:error port "XML [22], unexpected EOF") + (case (xml-token-kind token) + ((PI) + (let ((seed ((ssax:make-pi-parser *handler-PROCESSING-INSTRUCTIONS) + port (xml-token-head token) seed))) + (scan-for-significant-prolog-token-2 port elems entities + namespaces seed))) + ((START) + (element-parser (xml-token-head token) port elems + entities namespaces #f + (*handler-DECL-ROOT (xml-token-head token) seed))) + (else (slib:error port "XML [22], unexpected markup " + token)))))) + ;; A procedure start-tag-head port elems entities namespaces + ;; preserve-ws? seed + (define element-parser + (ssax:make-elem-parser *handler-NEW-LEVEL-SEED + *handler-FINISH-ELEMENT + *handler-CHAR-DATA-HANDLER + *handler-PROCESSING-INSTRUCTIONS)) + + ;; Get the ball rolling ... + (scan-for-significant-prolog-token-1 port seed) + )) + +(define DOCTYPE 'DOCTYPE) +(define UNDECL-ROOT 'UNDECL-ROOT) +(define DECL-ROOT 'DECL-ROOT) +(define NEW-LEVEL-SEED 'NEW-LEVEL-SEED) +(define FINISH-ELEMENT 'FINISH-ELEMENT) +(define CHAR-DATA-HANDLER 'CHAR-DATA-HANDLER) +(define PROCESSING-INSTRUCTIONS 'PROCESSING-INSTRUCTIONS) + +;;@args user-handler-tag user-handler ... +;; +;;Create an XML parser, an instance of the XML parsing framework. +;;This will be a SAX, a DOM, or a specialized parser depending on the +;;supplied user-handlers. +;; +;;@0 takes an even number of arguments; @1 is a symbol that identifies +;;a procedure (or association list for @code{PROCESSING-INSTRUCTIONS}) +;;(@2) that follows the tag. Given below are tags and signatures of +;;the corresponding procedures. Not all tags have to be specified. +;;If some are omitted, reasonable defaults will apply. +;; +;;@table @samp +;; +;;@item DOCTYPE +;;handler-procedure: @var{port} @var{docname} @var{systemid} @var{internal-subset?} @var{seed} +;; +;;If @var{internal-subset?} is #t, the current position in the port is +;;right after we have read @samp{[} that begins the internal DTD +;;subset. We must finish reading of this subset before we return (or +;;must call @code{skip-internal-dtd} if we aren't interested in +;;reading it). @var{port} at exit must be at the first symbol after +;;the whole DOCTYPE declaration. +;; +;;The handler-procedure must generate four values: +;;@quotation +;;@var{elems} @var{entities} @var{namespaces} @var{seed} +;;@end quotation +;; +;;@var{elems} is as defined for the ELEMS slot of XML-DECL. It may be +;;#f to switch off validation. @var{namespaces} will typically +;;contain @var{user-prefix}es for selected @var{uri-symb}s. The +;;default handler-procedure skips the internal subset, if any, and +;;returns @code{(values #f '() '() seed)}. +;; +;;@item UNDECL-ROOT +;;procedure: @var{elem-gi} @var{seed} +;; +;;where @var{elem-gi} is an UNRES-NAME of the root element. This +;;procedure is called when an XML document under parsing contains +;;@emph{no} DOCTYPE declaration. +;; +;;The handler-procedure, as a DOCTYPE handler procedure above, +;;must generate four values: +;;@quotation +;;@var{elems} @var{entities} @var{namespaces} @var{seed} +;;@end quotation +;; +;;The default handler-procedure returns (values #f '() '() seed) +;; +;;@item DECL-ROOT +;;procedure: @var{elem-gi} @var{seed} +;; +;;where @var{elem-gi} is an UNRES-NAME of the root element. This +;;procedure is called when an XML document under parsing does contains +;;the DOCTYPE declaration. The handler-procedure must generate a new +;;@var{seed} (and verify that the name of the root element matches the +;;doctype, if the handler so wishes). The default handler-procedure +;;is the identity function. +;; +;;@item NEW-LEVEL-SEED +;;procedure: see ssax:make-elem-parser, my-new-level-seed +;; +;;@item FINISH-ELEMENT +;;procedure: see ssax:make-elem-parser, my-finish-element +;; +;;@item CHAR-DATA-HANDLER +;;procedure: see ssax:make-elem-parser, my-char-data-handler +;; +;;@item PROCESSING-INSTRUCTIONS +;;association list as is passed to @code{ssax:make-pi-parser}. +;;The default value is '() +;; +;;@end table +;; +;;The generated parser is a procedure of arguments @var{port} and +;;@var{seed}. +;; +;;This procedure parses the document prolog and then exits to an +;;element parser (created by @code{ssax:make-elem-parser}) to handle +;;the rest. +;; +;;@example +;;[1] document ::= prolog element Misc* +;;[22] prolog ::= XMLDecl? Misc* (doctypedec | Misc*)? +;;[27] Misc ::= Comment | PI | S +;;[28] doctypedecl ::= '' +;;[29] markupdecl ::= elementdecl | AttlistDecl +;; | EntityDecl +;; | NotationDecl | PI +;; | Comment +;;@end example +(define ssax:make-parser + (let ((descriptors + `((DOCTYPE + ,(lambda (port docname systemid internal-subset? seed) + (cond (internal-subset? + (ssax:skip-internal-dtd port))) + (slib:warn port "DOCTYPE DECL " docname " " + systemid " found and skipped") + (values #f '() '() seed) + )) + (UNDECL-ROOT + ,(lambda (elem-gi seed) (values #f '() '() seed))) + (DECL-ROOT + ,(lambda (elem-gi seed) seed)) + (NEW-LEVEL-SEED) ; required + (FINISH-ELEMENT) ; required + (CHAR-DATA-HANDLER) ; required + (PROCESSING-INSTRUCTIONS ()) + ))) + (lambda proplist + (define count 0) + (if (odd? (length proplist)) + (slib:error 'ssax:make-parser "takes even number of arguments" + proplist)) + (let ((posititional-args + (map (lambda (spec) + (define ptail (member (car spec) proplist)) + (cond ((and ptail (odd? (length ptail))) + (slib:error 'ssax:make-parser 'bad 'argument ptail)) + (ptail + (set! count (+ 1 count)) + (cadr ptail)) + ((not (null? (cdr spec))) + (cadr spec)) + (else + (slib:error + 'ssax:make-parser 'missing (car spec) 'property)))) + descriptors))) + (if (= count (quotient (length proplist) 2)) + (apply ssax:make-parser/positional-args posititional-args) + (slib:error 'ssax:make-parser 'extra 'arguments proplist)))))) + +;;@subsection Parsing XML to SXML + +;;@body +;; +;;This is an instance of the SSAX parser that returns an SXML +;;representation of the XML document to be read from @1. @2 is a list +;;of @code{(@var{user-prefix} . @var{uri-string})} that assigns +;;@var{user-prefix}es to certain namespaces identified by particular +;;@var{uri-string}s. It may be an empty list. @0 returns an SXML +;;tree. The port points out to the first character after the root +;;element. +(define (ssax:xml->sxml port namespace-prefix-assig) + (define namespaces + (map (lambda (el) (cons* #f (car el) (ssax:uri-string->symbol (cdr el)))) + namespace-prefix-assig)) + (define (RES-NAME->SXML res-name) + (string->symbol + (string-append + (symbol->string (car res-name)) + ":" + (symbol->string (cdr res-name))))) + (let ((result + (reverse + ((ssax:make-parser + + 'DOCTYPE + (lambda (port docname systemid internal-subset? seed) + (cond (internal-subset? + (ssax:skip-internal-dtd port))) + (slib:warn port "DOCTYPE DECL " docname " " + systemid " found and skipped") + (values #f '() namespaces seed)) + + 'NEW-LEVEL-SEED + (lambda (elem-gi attributes namespaces expected-content seed) + '()) + + 'FINISH-ELEMENT + (lambda (elem-gi attributes namespaces parent-seed seed) + (define nseed (ssax:reverse-collect-str-drop-ws seed)) + (define attrs + (attlist-fold + (lambda (attr accum) + (cons (list (if (symbol? (car attr)) + (car attr) + (RES-NAME->SXML (car attr))) + (cdr attr)) + accum)) + '() attributes)) + (cons (cons (if (symbol? elem-gi) + elem-gi + (RES-NAME->SXML elem-gi)) + (if (null? attrs) + nseed + (cons (cons '@ attrs) nseed))) + parent-seed)) + + 'CHAR-DATA-HANDLER + (lambda (string1 string2 seed) + (if (string-null? string2) + (cons string1 seed) + (cons* string2 string1 seed))) + + 'UNDECL-ROOT + (lambda (elem-gi seed) + (values #f '() namespaces seed)) + + 'PROCESSING-INSTRUCTIONS + (list + (cons '*DEFAULT* + (lambda (port pi-tag seed) + (cons (list '*PROCESSING-INSTRUCTIONS* + pi-tag + (ssax:read-pi-body-as-string port)) + seed)))) + ) + port + '())))) + (cons '*TOP* + (if (null? namespace-prefix-assig) + result + (cons + (list '@ (cons '*NAMESPACES* + (map (lambda (ns) (list (car ns) (cdr ns))) + namespace-prefix-assig))) + result))))) diff --git a/xml-parse.txi b/xml-parse.txi new file mode 100644 index 0000000..365d914 --- /dev/null +++ b/xml-parse.txi @@ -0,0 +1,1010 @@ +@code{(require 'xml-parse)} or @code{(require 'ssax)} + +@noindent +The XML standard document referred to in this module is@* +@url{http://www.w3.org/TR/1998/REC-xml-19980210.html}. + +@noindent +The present frameworks fully supports the XML Namespaces +Recommendation@* +@url{http://www.w3.org/TR/REC-xml-names}. + +@subsection String Glue + + +@defun ssax:reverse-collect-str list-of-frags + + +Given the list of fragments (some of which are text strings), +reverse the list and concatenate adjacent text strings. If +LIST-OF-FRAGS has zero or one element, the result of the procedure +is @code{equal?} to its argument. +@end defun + + +@defun ssax:reverse-collect-str-drop-ws list-of-frags + + +Given the list of fragments (some of which are text strings), +reverse the list and concatenate adjacent text strings while +dropping "unsignificant" whitespace, that is, whitespace in front, +behind and between elements. The whitespace that is included in +character data is not affected. + +Use this procedure to "intelligently" drop "insignificant" +whitespace in the parsed SXML. If the strict compliance with the +XML Recommendation regarding the whitespace is desired, use the +@code{ssax:reverse-collect-str} procedure instead. +@end defun + +@subsection Character and Token Functions + +The following functions either skip, or build and return tokens, +according to inclusion or delimiting semantics. The list of +characters to expect, include, or to break at may vary from one +invocation of a function to another. This allows the functions to +easily parse even context-sensitive languages. + +Exceptions are mentioned specifically. The list of expected +characters (characters to skip until, or break-characters) may +include an EOF "character", which is coded as symbol *eof* + +The input stream to parse is specified as a PORT, which is the last +argument. + + +@defun ssax:assert-current-char char-list string port + + +Reads a character from the @var{port} and looks it up in the +@var{char-list} of expected characters. If the read character was +found among expected, it is returned. Otherwise, the +procedure writes a message using @var{string} as a comment +and quits. +@end defun + + +@defun ssax:skip-while char-list port + + +Reads characters from the @var{port} and disregards them, as long as they +are mentioned in the @var{char-list}. The first character (which may be EOF) +peeked from the stream that is @emph{not} a member of the @var{char-list} is +returned. +@end defun + + +@defun ssax:init-buffer + + +Returns an initial buffer for @code{ssax:next-token*} procedures. +@code{ssax:init-buffer} may allocate a new buffer at each invocation. +@end defun + + +@defun ssax:next-token prefix-char-list break-char-list comment-string port + + +Skips any number of the prefix characters (members of the @var{prefix-char-list}), if +any, and reads the sequence of characters up to (but not including) +a break character, one of the @var{break-char-list}. + +The string of characters thus read is returned. The break character +is left on the input stream. @var{break-char-list} may include the symbol @code{*eof*}; +otherwise, EOF is fatal, generating an error message including a +specified @var{comment-string}. +@end defun + +@noindent +@code{ssax:next-token-of} is similar to @code{ssax:next-token} +except that it implements an inclusion rather than delimiting +semantics. + + +@defun ssax:next-token-of inc-charset port + + +Reads characters from the @var{port} that belong to the list of characters +@var{inc-charset}. The reading stops at the first character which is not a member +of the set. This character is left on the stream. All the read +characters are returned in a string. + + +@defunx ssax:next-token-of pred port + +Reads characters from the @var{port} for which @var{pred} (a procedure of +one argument) returns non-#f. The reading stops at the first +character for which @var{pred} returns #f. That character is left +on the stream. All the results of evaluating of @var{pred} up to #f +are returned in a string. + +@var{pred} is a procedure that takes one argument (a character or +the EOF object) and returns a character or #f. The returned +character does not have to be the same as the input argument to the +@var{pred}. For example, + +@example +(ssax:next-token-of (lambda (c) + (cond ((eof-object? c) #f) + ((char-alphabetic? c) (char-downcase c)) + (else #f))) + (current-input-port)) +@end example + +will try to read an alphabetic token from the current input port, +and return it in lower case. +@end defun + + +@defun ssax:read-string len port + + +Reads @var{len} characters from the @var{port}, and returns them in a string. If +EOF is encountered before @var{len} characters are read, a shorter string +will be returned. +@end defun + +@subsection Data Types + +@table @code + +@item TAG-KIND + +A symbol @samp{START}, @samp{END}, @samp{PI}, @samp{DECL}, +@samp{COMMENT}, @samp{CDSECT}, or @samp{ENTITY-REF} that identifies +a markup token + +@item UNRES-NAME + +a name (called GI in the XML Recommendation) as given in an XML +document for a markup token: start-tag, PI target, attribute name. +If a GI is an NCName, UNRES-NAME is this NCName converted into a +Scheme symbol. If a GI is a QName, @samp{UNRES-NAME} is a pair of +symbols: @code{(@var{PREFIX} . @var{LOCALPART})}. + +@item RES-NAME + +An expanded name, a resolved version of an @samp{UNRES-NAME}. For +an element or an attribute name with a non-empty namespace URI, +@samp{RES-NAME} is a pair of symbols, +@code{(@var{URI-SYMB} . @var{LOCALPART})}. +Otherwise, it's a single symbol. + +@item ELEM-CONTENT-MODEL + +A symbol: +@table @samp +@item ANY +anything goes, expect an END tag. +@item EMPTY-TAG +no content, and no END-tag is coming +@item EMPTY +no content, expect the END-tag as the next token +@item PCDATA +expect character data only, and no children elements +@item MIXED +@item ELEM-CONTENT +@end table + +@item URI-SYMB + +A symbol representing a namespace URI -- or other symbol chosen by +the user to represent URI. In the former case, @code{URI-SYMB} is +created by %-quoting of bad URI characters and converting the +resulting string into a symbol. + +@item NAMESPACES + +A list representing namespaces in effect. An element of the list +has one of the following forms: + +@table @code + +@item (@var{prefix} @var{uri-symb} . @var{uri-symb}) or + +@item (@var{prefix} @var{user-prefix} . @var{uri-symb}) +@var{user-prefix} is a symbol chosen by the user to represent the URI. + +@item (#f @var{user-prefix} . @var{uri-symb}) +Specification of the user-chosen prefix and a URI-SYMBOL. + +@item (*DEFAULT* @var{user-prefix} . @var{uri-symb}) +Declaration of the default namespace + +@item (*DEFAULT* #f . #f) +Un-declaration of the default namespace. This notation +represents overriding of the previous declaration + +@end table + +A NAMESPACES list may contain several elements for the same @var{prefix}. +The one closest to the beginning of the list takes effect. + +@item ATTLIST + +An ordered collection of (@var{NAME} . @var{VALUE}) pairs, where +@var{NAME} is a RES-NAME or an UNRES-NAME. The collection is an ADT. + +@item STR-HANDLER + +A procedure of three arguments: @var{string1} @var{string2} +@var{seed} returning a new @var{seed}. The procedure is supposed to +handle a chunk of character data @var{string1} followed by a chunk +of character data @var{string2}. @var{string2} is a short string, +often @samp{"\n"} and even @samp{""}. + +@item ENTITIES +An assoc list of pairs: +@lisp + (@var{named-entity-name} . @var{named-entity-body}) +@end lisp + +where @var{named-entity-name} is a symbol under which the entity was +declared, @var{named-entity-body} is either a string, or (for an +external entity) a thunk that will return an input port (from which +the entity can be read). @var{named-entity-body} may also be #f. +This is an indication that a @var{named-entity-name} is currently +being expanded. A reference to this @var{named-entity-name} will be +an error: violation of the WFC nonrecursion. + +@item XML-TOKEN + +This record represents a markup, which is, according to the XML +Recommendation, "takes the form of start-tags, end-tags, +empty-element tags, entity references, character references, +comments, CDATA section delimiters, document type declarations, and +processing instructions." + +@table @asis +@item kind +a TAG-KIND +@item head +an UNRES-NAME. For XML-TOKENs of kinds 'COMMENT and 'CDSECT, the +head is #f. +@end table + +For example, +@example +

=> kind=START, head=P +

=> kind=END, head=P +
=> kind=EMPTY-EL, head=BR + => kind=DECL, head=DOCTYPE + => kind=PI, head=xml +&my-ent; => kind=ENTITY-REF, head=my-ent +@end example + +Character references are not represented by xml-tokens as these +references are transparently resolved into the corresponding +characters. + +@item XML-DECL + +The record represents a datatype of an XML document: the list of +declared elements and their attributes, declared notations, list of +replacement strings or loading procedures for parsed general +entities, etc. Normally an XML-DECL record is created from a DTD or +an XML Schema, although it can be created and filled in in many +other ways (e.g., loaded from a file). + +@table @var +@item elems +an (assoc) list of decl-elem or #f. The latter instructs +the parser to do no validation of elements and attributes. + +@item decl-elem +declaration of one element: + +@code{(@var{elem-name} @var{elem-content} @var{decl-attrs})} + +@var{elem-name} is an UNRES-NAME for the element. + +@var{elem-content} is an ELEM-CONTENT-MODEL. + +@var{decl-attrs} is an @code{ATTLIST}, of +@code{(@var{attr-name} . @var{value})} associations. + +This element can declare a user procedure to handle parsing of an +element (e.g., to do a custom validation, or to build a hash of IDs +as they're encountered). + +@item decl-attr +an element of an @code{ATTLIST}, declaration of one attribute: + +@code{(@var{attr-name} @var{content-type} @var{use-type} @var{default-value})} + +@var{attr-name} is an UNRES-NAME for the declared attribute. + +@var{content-type} is a symbol: @code{CDATA}, @code{NMTOKEN}, +@code{NMTOKENS}, @dots{} or a list of strings for the enumerated +type. + +@var{use-type} is a symbol: @code{REQUIRED}, @code{IMPLIED}, or +@code{FIXED}. + +@var{default-value} is a string for the default value, or #f if not +given. + +@end table + +@end table + +@subsection Low-Level Parsers and Scanners + +@noindent +These procedures deal with primitive lexical units (Names, +whitespaces, tags) and with pieces of more generic productions. +Most of these parsers must be called in appropriate context. For +example, @code{ssax:complete-start-tag} must be called only when the +start-tag has been detected and its GI has been read. + + +@defun ssax:skip-s port + + +Skip the S (whitespace) production as defined by +@example +[3] S ::= (#x20 | #x09 | #x0D | #x0A) +@end example + +@code{ssax:skip-s} returns the first not-whitespace character it encounters while +scanning the @var{port}. This character is left on the input stream. +@end defun + + +@defun ssax:read-ncname port + + +Read a NCName starting from the current position in the @var{port} and +return it as a symbol. + +@example +[4] NameChar ::= Letter | Digit | '.' | '-' | '_' | ':' + | CombiningChar | Extender +[5] Name ::= (Letter | '_' | ':') (NameChar)* +@end example + +This code supports the XML Namespace Recommendation REC-xml-names, +which modifies the above productions as follows: + +@example +[4] NCNameChar ::= Letter | Digit | '.' | '-' | '_' + | CombiningChar | Extender +[5] NCName ::= (Letter | '_') (NCNameChar)* +@end example + +As the Rec-xml-names says, + +@quotation +"An XML document conforms to this specification if all other tokens +[other than element types and attribute names] in the document which +are required, for XML conformance, to match the XML production for +Name, match this specification's production for NCName." +@end quotation + +Element types and attribute names must match the production QName, +defined below. +@end defun + + +@defun ssax:read-qname port + + +Read a (namespace-) Qualified Name, QName, from the current position +in @var{port}; and return an UNRES-NAME. + +From REC-xml-names: +@example +[6] QName ::= (Prefix ':')? LocalPart +[7] Prefix ::= NCName +[8] LocalPart ::= NCName +@end example +@end defun + + +@defun ssax:read-markup-token port + + +This procedure starts parsing of a markup token. The current +position in the stream must be @samp{<}. This procedure scans +enough of the input stream to figure out what kind of a markup token +it is seeing. The procedure returns an XML-TOKEN structure +describing the token. Note, generally reading of the current markup +is not finished! In particular, no attributes of the start-tag +token are scanned. + +Here's a detailed break out of the return values and the position in +the PORT when that particular value is returned: + +@table @asis + +@item PI-token + +only PI-target is read. To finish the Processing-Instruction and +disregard it, call @code{ssax:skip-pi}. @code{ssax:read-attributes} +may be useful as well (for PIs whose content is attribute-value +pairs). + +@item END-token + +The end tag is read completely; the current position is right after +the terminating @samp{>} character. + +@item COMMENT + +is read and skipped completely. The current position is right after +@samp{-->} that terminates the comment. + +@item CDSECT + +The current position is right after @samp{} combination that terminates PI. + +@example +[16] PI ::= '' Char*)))? '?>' +@end example +@end defun + + +@defun ssax:skip-internal-dtd port + + +The current pos in the port is inside an internal DTD subset (e.g., +after reading @samp{#\[} that begins an internal DTD subset) Skip +until the @samp{]>} combination that terminates this DTD. +@end defun + + +@defun ssax:read-cdata-body port str-handler seed + + +This procedure must be called after we have read a string +@samp{} combination is the end of the CDATA section. +@samp{>} is treated as an embedded @samp{>} character. + +@item +@samp{<} and @samp{&} are not specially recognized (and are +not expanded)! + +@end itemize +@end defun + + +@defun ssax:read-char-ref port + + +@example +[66] CharRef ::= '&#' [0-9]+ ';' + | '&#x' [0-9a-fA-F]+ ';' +@end example + +This procedure must be called after we we have read @samp{&#} that +introduces a char reference. The procedure reads this reference and +returns the corresponding char. The current position in PORT will +be after the @samp{;} that terminates the char reference. + +Faults detected:@* +WFC: XML-Spec.html#wf-Legalchar + +According to Section @cite{4.1 Character and Entity References} +of the XML Recommendation: + +@quotation +"[Definition: A character reference refers to a specific character +in the ISO/IEC 10646 character set, for example one not directly +accessible from available input devices.]" +@end quotation + +@c Therefore, we use a @code{ucscode->char} function to convert a +@c character code into the character -- *regardless* of the current +@c character encoding of the input stream. +@end defun + + +@defun ssax:handle-parsed-entity port name entities content-handler str-handler seed + + +Expands and handles a parsed-entity reference. + +@var{name} is a symbol, the name of the parsed entity to expand. +@c entities - see ENTITIES +@var{content-handler} is a procedure of arguments @var{port}, @var{entities}, and +@var{seed} that returns a seed. +@var{str-handler} is called if the entity in question is a pre-declared entity. + +@code{ssax:handle-parsed-entity} returns the result returned by @var{content-handler} or @var{str-handler}. + +Faults detected:@* +WFC: XML-Spec.html#wf-entdeclared@* +WFC: XML-Spec.html#norecursion +@end defun + + +@defun attlist-add attlist name-value + + +Add a @var{name-value} pair to the existing @var{attlist}, preserving its sorted ascending +order; and return the new list. Return #f if a pair with the same +name already exists in @var{attlist} +@end defun + + +@defun attlist-remove-top attlist + + +Given an non-null @var{attlist}, return a pair of values: the top and the rest. +@end defun + + +@defun ssax:read-attributes port entities + + +This procedure reads and parses a production @dfn{Attribute}. +@cindex Attribute + +@example +[41] Attribute ::= Name Eq AttValue +[10] AttValue ::= '"' ([^<&"] | Reference)* '"' + | "'" ([^<&'] | Reference)* "'" +[25] Eq ::= S? '=' S? +@end example + +The procedure returns an ATTLIST, of Name (as UNRES-NAME), Value (as +string) pairs. The current character on the @var{port} is a non-whitespace +character that is not an NCName-starting character. + +Note the following rules to keep in mind when reading an +@dfn{AttValue}: +@cindex AttValue +@quotation +Before the value of an attribute is passed to the application or +checked for validity, the XML processor must normalize it as +follows: + +@itemize @bullet +@item +A character reference is processed by appending the referenced +character to the attribute value. + +@item +An entity reference is processed by recursively processing the +replacement text of the entity. The named entities @samp{amp}, +@samp{lt}, @samp{gt}, @samp{quot}, and @samp{apos} are pre-declared. + +@item +A whitespace character (#x20, #x0D, #x0A, #x09) is processed by +appending #x20 to the normalized value, except that only a single +#x20 is appended for a "#x0D#x0A" sequence that is part of an +external parsed entity or the literal entity value of an internal +parsed entity. + +@item +Other characters are processed by appending them to the normalized +value. + +@end itemize + +@end quotation + +Faults detected:@* +WFC: XML-Spec.html#CleanAttrVals@* +WFC: XML-Spec.html#uniqattspec +@end defun + + +@defun ssax:resolve-name port unres-name namespaces apply-default-ns? + + +Convert an @var{unres-name} to a RES-NAME, given the appropriate @var{namespaces} declarations. +The last parameter, @var{apply-default-ns?}, determines if the default namespace applies +(for instance, it does not for attribute names). + +Per REC-xml-names/#nsc-NSDeclared, the "xml" prefix is considered +pre-declared and bound to the namespace name +"http://www.w3.org/XML/1998/namespace". + +@code{ssax:resolve-name} tests for the namespace constraints:@* +@url{http://www.w3.org/TR/REC-xml-names/#nsc-NSDeclared} +@end defun + + +@defun ssax:complete-start-tag tag port elems entities namespaces + + +Complete parsing of a start-tag markup. @code{ssax:complete-start-tag} must be called after the +start tag token has been read. @var{tag} is an UNRES-NAME. @var{elems} is an +instance of the ELEMS slot of XML-DECL; it can be #f to tell the +function to do @emph{no} validation of elements and their +attributes. + +@code{ssax:complete-start-tag} returns several values: +@itemize @bullet +@item ELEM-GI: +a RES-NAME. +@item ATTRIBUTES: +element's attributes, an ATTLIST of (RES-NAME . STRING) pairs. +The list does NOT include xmlns attributes. +@item NAMESPACES: +the input list of namespaces amended with namespace +(re-)declarations contained within the start-tag under parsing +@item ELEM-CONTENT-MODEL +@end itemize + +On exit, the current position in @var{port} will be the first character +after @samp{>} that terminates the start-tag markup. + +Faults detected:@* +VC: XML-Spec.html#enum@* +VC: XML-Spec.html#RequiredAttr@* +VC: XML-Spec.html#FixedAttr@* +VC: XML-Spec.html#ValueType@* +WFC: XML-Spec.html#uniqattspec (after namespaces prefixes are resolved)@* +VC: XML-Spec.html#elementvalid@* +WFC: REC-xml-names/#dt-NSName + +@emph{Note}: although XML Recommendation does not explicitly say it, +xmlns and xmlns: attributes don't have to be declared (although they +can be declared, to specify their default value). +@end defun + + +@defun ssax:read-external-id port + + +Parses an ExternalID production: + +@example +[75] ExternalID ::= 'SYSTEM' S SystemLiteral + | 'PUBLIC' S PubidLiteral S SystemLiteral +[11] SystemLiteral ::= ('"' [^"]* '"') | ("'" [^']* "'") +[12] PubidLiteral ::= '"' PubidChar* '"' + | "'" (PubidChar - "'")* "'" +[13] PubidChar ::= #x20 | #x0D | #x0A | [a-zA-Z0-9] + | [-'()+,./:=?;!*#@@$_%] +@end example + +Call @code{ssax:read-external-id} when an ExternalID is expected; that is, the current +character must be either #\S or #\P that starts correspondingly a +SYSTEM or PUBLIC token. @code{ssax:read-external-id} returns the @var{SystemLiteral} as a +string. A @var{PubidLiteral} is disregarded if present. +@end defun + +@subsection Mid-Level Parsers and Scanners + +@noindent +These procedures parse productions corresponding to the whole +(document) entity or its higher-level pieces (prolog, root element, +etc). + + +@defun ssax:scan-misc port + + +Scan the Misc production in the context: + +@example +[1] document ::= prolog element Misc* +[22] prolog ::= XMLDecl? Misc* (doctypedec l Misc*)? +[27] Misc ::= Comment | PI | S +@end example + +Call @code{ssax:scan-misc} in the prolog or epilog contexts. In these contexts, +whitespaces are completely ignored. The return value from @code{ssax:scan-misc} is +either a PI-token, a DECL-token, a START token, or *EOF*. Comments +are ignored and not reported. +@end defun + + +@defun ssax:read-char-data port expect-eof? str-handler iseed + + +Read the character content of an XML document or an XML element. + +@example +[43] content ::= +(element | CharData | Reference | CDSect | PI | Comment)* +@end example + +To be more precise, @code{ssax:read-char-data} reads CharData, expands CDSect and character +entities, and skips comments. @code{ssax:read-char-data} stops at a named reference, EOF, +at the beginning of a PI, or a start/end tag. + +@var{expect-eof?} is a boolean indicating if EOF is normal; i.e., the character +data may be terminated by the EOF. EOF is normal while processing a +parsed entity. + +@var{iseed} is an argument passed to the first invocation of @var{str-handler}. + +@code{ssax:read-char-data} returns two results: @var{seed} and @var{token}. The @var{seed} +is the result of the last invocation of @var{str-handler}, or the original @var{iseed} if @var{str-handler} +was never called. + +@var{token} can be either an eof-object (this can happen only if @var{expect-eof?} +was #t), or: +@itemize @bullet + +@item +an xml-token describing a START tag or an END-tag; +For a start token, the caller has to finish reading it. + +@item +an xml-token describing the beginning of a PI. It's up to an +application to read or skip through the rest of this PI; + +@item +an xml-token describing a named entity reference. + +@end itemize + +CDATA sections and character references are expanded inline and +never returned. Comments are silently disregarded. + +As the XML Recommendation requires, all whitespace in character data +must be preserved. However, a CR character (#x0D) must be +disregarded if it appears before a LF character (#x0A), or replaced +by a #x0A character otherwise. See Secs. 2.10 and 2.11 of the XML +Recommendation. See also the canonical XML Recommendation. +@end defun + + +@defun ssax:assert-token token kind gi error-cont + + +Make sure that @var{token} is of anticipated @var{kind} and has anticipated @var{gi}. Note +that the @var{gi} argument may actually be a pair of two symbols, +Namespace-URI or the prefix, and of the localname. If the assertion +fails, @var{error-cont} is evaluated by passing it three arguments: @var{token} @var{kind} @var{gi}. The +result of @var{error-cont} is returned. +@end defun + +@subsection High-level Parsers + +These procedures are to instantiate a SSAX parser. A user can +instantiate the parser to do the full validation, or no validation, +or any particular validation. The user specifies which PI he wants +to be notified about. The user tells what to do with the parsed +character and element data. The latter handlers determine if the +parsing follows a SAX or a DOM model. + + +@defun ssax:make-pi-parser my-pi-handlers + + +Create a parser to parse and process one Processing Element (PI). + +@var{my-pi-handlers} is an association list of pairs +@code{(@var{pi-tag} . @var{pi-handler})} where @var{pi-tag} is an +NCName symbol, the PI target; and @var{pi-handler} is a procedure +taking arguments @var{port}, @var{pi-tag}, and @var{seed}. + +@var{pi-handler} should read the rest of the PI up to and including +the combination @samp{?>} that terminates the PI. The handler +should return a new seed. One of the @var{pi-tag}s may be the +symbol @code{*DEFAULT*}. The corresponding handler will handle PIs +that no other handler will. If the *DEFAULT* @var{pi-tag} is not +specified, @code{ssax:make-pi-parser} will assume the default handler that skips the body of +the PI. + +@code{ssax:make-pi-parser} returns a procedure of arguments @var{port}, @var{pi-tag}, and +@var{seed}; that will parse the current PI according to @var{my-pi-handlers}. +@end defun + + +@defun ssax:make-elem-parser my-new-level-seed my-finish-element my-char-data-handler my-pi-handlers + + +Create a parser to parse and process one element, including its +character content or children elements. The parser is typically +applied to the root element of a document. + +@table @asis + +@item @var{my-new-level-seed} +is a procedure taking arguments: + +@var{elem-gi} @var{attributes} @var{namespaces} @var{expected-content} @var{seed} + +where @var{elem-gi} is a RES-NAME of the element about to be +processed. + +@var{my-new-level-seed} is to generate the seed to be passed to handlers that process the +content of the element. + +@item @var{my-finish-element} +is a procedure taking arguments: + +@var{elem-gi} @var{attributes} @var{namespaces} @var{parent-seed} @var{seed} + +@var{my-finish-element} is called when parsing of @var{elem-gi} is finished. +The @var{seed} is the result from the last content parser (or +from @var{my-new-level-seed} if the element has the empty content). +@var{parent-seed} is the same seed as was passed to @var{my-new-level-seed}. +@var{my-finish-element} is to generate a seed that will be the result +of the element parser. + +@item @var{my-char-data-handler} +is a STR-HANDLER as described in Data Types above. + +@item @var{my-pi-handlers} +is as described for @code{ssax:make-pi-handler} above. + +@end table + +The generated parser is a procedure taking arguments: + +@var{start-tag-head} @var{port} @var{elems} @var{entities} @var{namespaces} @var{preserve-ws?} @var{seed} + +The procedure must be called after the start tag token has been +read. @var{start-tag-head} is an UNRES-NAME from the start-element +tag. ELEMS is an instance of ELEMS slot of XML-DECL. + +Faults detected:@* +VC: XML-Spec.html#elementvalid@* +WFC: XML-Spec.html#GIMatch +@end defun + + +@defun ssax:make-parser user-handler-tag user-handler @dots{} + + +Create an XML parser, an instance of the XML parsing framework. +This will be a SAX, a DOM, or a specialized parser depending on the +supplied user-handlers. + +@code{ssax:make-parser} takes an even number of arguments; @var{user-handler-tag} is a symbol that identifies +a procedure (or association list for @code{PROCESSING-INSTRUCTIONS}) +(@var{user-handler}) that follows the tag. Given below are tags and signatures of +the corresponding procedures. Not all tags have to be specified. +If some are omitted, reasonable defaults will apply. + +@table @samp + +@item DOCTYPE +handler-procedure: @var{port} @var{docname} @var{systemid} @var{internal-subset?} @var{seed} + +If @var{internal-subset?} is #t, the current position in the port is +right after we have read @samp{[} that begins the internal DTD +subset. We must finish reading of this subset before we return (or +must call @code{skip-internal-dtd} if we aren't interested in +reading it). @var{port} at exit must be at the first symbol after +the whole DOCTYPE declaration. + +The handler-procedure must generate four values: +@quotation +@var{elems} @var{entities} @var{namespaces} @var{seed} +@end quotation + +@var{elems} is as defined for the ELEMS slot of XML-DECL. It may be +#f to switch off validation. @var{namespaces} will typically +contain @var{user-prefix}es for selected @var{uri-symb}s. The +default handler-procedure skips the internal subset, if any, and +returns @code{(values #f '() '() seed)}. + +@item UNDECL-ROOT +procedure: @var{elem-gi} @var{seed} + +where @var{elem-gi} is an UNRES-NAME of the root element. This +procedure is called when an XML document under parsing contains +@emph{no} DOCTYPE declaration. + +The handler-procedure, as a DOCTYPE handler procedure above, +must generate four values: +@quotation +@var{elems} @var{entities} @var{namespaces} @var{seed} +@end quotation + +The default handler-procedure returns (values #f '() '() seed) + +@item DECL-ROOT +procedure: @var{elem-gi} @var{seed} + +where @var{elem-gi} is an UNRES-NAME of the root element. This +procedure is called when an XML document under parsing does contains +the DOCTYPE declaration. The handler-procedure must generate a new +@var{seed} (and verify that the name of the root element matches the +doctype, if the handler so wishes). The default handler-procedure +is the identity function. + +@item NEW-LEVEL-SEED +procedure: see ssax:make-elem-parser, my-new-level-seed + +@item FINISH-ELEMENT +procedure: see ssax:make-elem-parser, my-finish-element + +@item CHAR-DATA-HANDLER +procedure: see ssax:make-elem-parser, my-char-data-handler + +@item PROCESSING-INSTRUCTIONS +association list as is passed to @code{ssax:make-pi-parser}. +The default value is '() + +@end table + +The generated parser is a procedure of arguments @var{port} and +@var{seed}. + +This procedure parses the document prolog and then exits to an +element parser (created by @code{ssax:make-elem-parser}) to handle +the rest. + +@example +[1] document ::= prolog element Misc* +[22] prolog ::= XMLDecl? Misc* (doctypedec | Misc*)? +[27] Misc ::= Comment | PI | S +[28] doctypedecl ::= '' +[29] markupdecl ::= elementdecl | AttlistDecl + | EntityDecl + | NotationDecl | PI + | Comment +@end example +@end defun + +@subsection Parsing XML to SXML + + +@defun ssax:xml->sxml port namespace-prefix-assig + + +This is an instance of the SSAX parser that returns an SXML +representation of the XML document to be read from @var{port}. @var{namespace-prefix-assig} is a list +of @code{(@var{user-prefix} . @var{uri-string})} that assigns +@var{user-prefix}es to certain namespaces identified by particular +@var{uri-string}s. It may be an empty list. @code{ssax:xml->sxml} returns an SXML +tree. The port points out to the first character after the root +element. +@end defun + -- cgit v1.2.3