diff options
| -rw-r--r-- | ChangeLog | 84 | ||||
| -rw-r--r-- | DrScheme.init | 30 | ||||
| -rw-r--r-- | Makefile | 20 | ||||
| -rw-r--r-- | README | 2 | ||||
| -rw-r--r-- | RScheme.init | 42 | ||||
| -rw-r--r-- | STk.init | 30 | ||||
| -rw-r--r-- | Template.scm | 44 | ||||
| -rw-r--r-- | alistab.scm | 2 | ||||
| -rw-r--r-- | batch.scm | 8 | ||||
| -rw-r--r-- | bigloo.init | 38 | ||||
| -rw-r--r-- | bytenumb.scm | 45 | ||||
| -rw-r--r-- | bytenumb.txi | 25 | ||||
| -rw-r--r-- | chez.init | 36 | ||||
| -rw-r--r-- | debian/changelog | 7 | ||||
| -rw-r--r-- | dirs.scm | 16 | ||||
| -rw-r--r-- | elk.init | 42 | ||||
| -rw-r--r-- | gambit.init | 58 | ||||
| -rw-r--r-- | guile.init | 97 | ||||
| -rw-r--r-- | http-cgi.scm | 4 | ||||
| -rw-r--r-- | jscheme.init | 39 | ||||
| -rw-r--r-- | limit.scm | 129 | ||||
| -rw-r--r-- | limit.texi | 101 | ||||
| -rw-r--r-- | lineio.scm | 5 | ||||
| -rw-r--r-- | lineio.txi | 5 | ||||
| -rw-r--r-- | linterp.scm | 90 | ||||
| -rw-r--r-- | linterp.txi | 36 | ||||
| -rw-r--r-- | macscheme.init | 28 | ||||
| -rw-r--r-- | matfile.scm | 7 | ||||
| -rw-r--r-- | mitscheme.init | 30 | ||||
| -rw-r--r-- | mkclrnam.scm | 2 | ||||
| -rw-r--r-- | mklibcat.scm | 9 | ||||
| -rw-r--r-- | peanosfc.scm | 49 | ||||
| -rw-r--r-- | peanosfc.txi | 24 | ||||
| -rw-r--r-- | phil-spc.scm | 77 | ||||
| -rw-r--r-- | phil-spc.txi | 28 | ||||
| -rw-r--r-- | prec.scm | 2 | ||||
| -rw-r--r-- | pscheme.init | 26 | ||||
| -rw-r--r-- | require.scm | 10 | ||||
| -rw-r--r-- | root.scm | 28 | ||||
| -rw-r--r-- | scheme2c.init | 46 | ||||
| -rw-r--r-- | scheme48.init | 28 | ||||
| -rw-r--r-- | scsh.init | 30 | ||||
| -rw-r--r-- | slib.spec | 106 | ||||
| -rw-r--r-- | slib.texi | 218 | ||||
| -rw-r--r-- | srfi-61.scm | 49 | ||||
| -rw-r--r-- | srfi.scm | 9 | ||||
| -rw-r--r-- | srfi.txi | 9 | ||||
| -rw-r--r-- | t3.init | 26 | ||||
| -rw-r--r-- | transact.scm | 22 | ||||
| -rw-r--r-- | umbscheme.init | 44 | ||||
| -rw-r--r-- | vscm.init | 42 |
51 files changed, 1318 insertions, 666 deletions
@@ -1,3 +1,87 @@ +2005-12-01 Aubrey Jaffer <agj@alum.mit.edu> + + * require.scm, mklibcat.scm, mkclrnam.scm, alistab.scm, Makefile: + Downcased *slib-version* symbol. + + * guile.init (home-vicinity): Check for getenv first. + (*features*): Fixed array, system, etc. + (system->line): Fixed return status (thanks to Rob Browning). + (guile:wrap-case-insensitive): Removed; sources now case clean. + + * dirs.scm, transact.scm, batch.scm, prec.scm, + Template.scm, *.init: Downcased all software-type symbols. + +2005-11-26 Aubrey Jaffer <agj@alum.mit.edu> + + * guile.init (system->line): Added features line-i/o and hash. + (implementation-vicinity): Fixed to parent directory of ice-9. + +2005-11-01 Aubrey Jaffer <agj@alum.mit.edu> + + * peanosfc.scm (peano-coordinates->natural) + (natural->peano-coordinates): Non-negative versions. + +2005-10-29 Aubrey Jaffer <agj@alum.mit.edu> + + * bytenumb.scm (bytes->ieee-float, bytes->ieee-double) + (ieee-float->bytes, ieee-double->bytes): Fixed for -0.0. + +2005-10-25 Aubrey Jaffer <agj@alum.mit.edu> + + * bytenumb.scm (ieee-float->bytes, ieee-double->bytes): Handle 0/0 + in srfi-70 arithmetic. + +2005-10-18 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (SRFI): Added table mapping SRFI to feature. + (Scheme Syntax Extension Packages): Moved most SRFIs here. + + * mklibcat.scm (and-let*, receive, define-record-type) + (guarded-cond-clause): Added aliases for srfi-2, srfi-8, srfi-9, + and srfi-61. + + * srfi.scm: Removed comments about copyright. + + * slib.spec (%post): Commented out install-info. + + * Makefile (srfiles): Most srfi-* moved from txiscms. + (srfiles): Added srfi-61. + +2005-10-17 Ivan Shmakov + + * srfi-61.scm (cond): Added extension. + + * mklibcat.scm (srfi-61): Added. + +2005-10-16 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Root Finding): integer-sqrt changed to floor of sqrt. + + * root.scm (integer-sqrt): Changed to algorithm attributed to + Bradley Lucier by Steve VanDevender. + +2005-09-25 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.spec: Updated from RedHat version from Jindrich Novy. + + * guile.init (sub-vicinity): Downcased software-type symbols. + +2005-08-16 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (The Limit): Added. + +2005-08-09 Aubrey Jaffer <agj@alum.mit.edu> + + * slib.texi (Array Mapping): Added. + + * linterp.scm (interpolate-array-ref, resample-array!): Added. + +2005-07-28 Aubrey Jaffer <agj@alum.mit.edu> + + * phil-spc.scm (hilbert-coordinates->integer): nbits calculation + was missing (incorrectly used rank). + (bitwise-laminate, bitwise-delaminate): Removed unused functions. + 2005-06-22 Aubrey Jaffer <agj@alum.mit.edu> * slib.spec (install): Make slib executable. diff --git a/DrScheme.init b/DrScheme.init index 8cce2e9..ca4ec17 100644 --- a/DrScheme.init +++ b/DrScheme.init @@ -9,16 +9,16 @@ ;@ (define (software-type) (case (system-type) - [(unix macosx) 'UNIX] - [(windows) 'MS-DOS] - [(macos) 'MACOS] + [(unix macosx) 'unix] + [(windows) 'ms-dos] + [(macos) 'macos] [else (system-type)])) ;@ (define in-vicinity string-append) ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -26,12 +26,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -50,7 +50,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -60,10 +60,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -17,7 +17,7 @@ srcdir.mk: .. Makefile include srcdir.mk VERSION = 3a2 -RELEASE = 1 +RELEASE = 2 rpm_prefix=/usr/src/redhat/ prefix = /usr/local/ @@ -90,14 +90,14 @@ lfiles = sort.scm comlist.scm logical.scm revfiles = sc4opt.scm sc4sc3.scm sc2.scm mularg.scm mulapply.scm \ trnscrpt.scm withfile.scm dynwind.scm promise.scm \ values.scm eval.scm null.scm -afiles = charplot.scm root.scm cring.scm selfset.scm \ +afiles = charplot.scm root.scm cring.scm selfset.scm limit.scm \ timecore.scm psxtime.scm cltime.scm timezone.scm tzfile.scm bfiles = fluidlet.scm object.scm recobj.scm yasyn.scm collect.scm collectx.scm scfiles = r4rsyn.scm scmacro.scm synclo.scm synrul.scm synchk.scm \ repl.scm macwork.scm mwexpand.scm mwdenote.scm mwsynrul.scm scafiles = scainit.scm scaglob.scm scamacr.scm scaoutp.scm scaexpp.scm \ structure.scm -srfiles = srfi-9.scm +srfiles = srfi-2.scm srfi-8.scm srfi-9.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 \ @@ -109,28 +109,28 @@ 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-2.scm srfi-8.scm\ + srfi.scm srfi-1.scm\ pnm.scm http-cgi.scm htmlform.scm html4each.scm db2html.scm uri.scm\ fft.scm solid.scm random.scm randinex.scm obj2str.scm ncbi-dna.scm\ minimize.scm factor.scm determ.scm daylight.scm colornam.scm\ mkclrnam.scm color.scm subarray.scm dbutil.scm array.scm transact.scm\ arraymap.scm phil-spc.scm lineio.scm differ.scm cvs.scm tree.scm\ coerce.scm byte.scm bytenumb.scm matfile.scm tsort.scm manifest.scm\ - peanosfc.scm + peanosfc.scm linterp.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-2.txi srfi-8.txi\ + srfi.txi srfi-1.txi\ pnm.txi http-cgi.txi htmlform.txi html4each.txi db2html.txi uri.txi\ fft.txi solid.txi random.txi randinex.txi obj2str.txi ncbi-dna.txi\ minimize.txi factor.txi determ.txi daylight.txi colornam.txi\ mkclrnam.txi color.txi subarray.txi dbutil.txi array.txi transact.txi\ arraymap.txi phil-spc.txi lineio.txi differ.txi cvs.txi tree.txi\ coerce.txi byte.txi bytenumb.txi matfile.txi tsort.txi manifest.txi\ - peanosfc.txi + peanosfc.txi linterp.txi % = `echo $(txiscms) | sed 's%.scm%.txi%g'` -texifiles = schmooz.texi indexes.texi object.texi format.texi +texifiles = schmooz.texi indexes.texi object.texi format.texi limit.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 \ @@ -362,7 +362,7 @@ $(dest)slib-psd.tar.gz: psdtemp/slib new: echo `date -I` \ Aubrey Jaffer \ \<`whoami`@`hostname`\>> change echo>> change - echo \ \* require.scm \(*SLIB-VERSION*\): Bumped from $(VERSION) to $(ver).>>change + echo \ \* require.scm \(*slib-version*\): Bumped from $(VERSION) to $(ver).>>change echo>> change cat ChangeLog >> change mv -f change ChangeLog @@ -386,7 +386,7 @@ new: $(DOSCM)dist/mkdisk.bat $(CHPAT) $(VERSION) $(ver) README slib.texi require.scm Makefile \ $(htmldir)SLIB.html slib.spec scheme48.init - cvs commit -lm '(*SLIB-VERSION*): Bumped from $(VERSION) to $(ver).' + cvs commit -lm '(*slib-version*): Bumped from $(VERSION) to $(ver).' cvs tag -lF slib$(ver) tagfiles = README version.txi slib.texi $(texifiles) \ @@ -74,6 +74,7 @@ The maintainer can be reached at agj @ alum.mit.edu. `factor.scm' has factor. `root.scm' has Newton's and Laguerre's methods for finding roots. `minimize.scm' has Golden Section Search for minimum value. + `limit.scm' computes one-sided limits. `cring.scm' extend + and * to custom commutative rings. `selfset.scm' sets single letter identifiers to their symbols. `determ.scm' compute determinant of list of lists. @@ -157,6 +158,7 @@ The maintainer can be reached at agj @ alum.mit.edu. `process.scm' has multi-processing primitives. `array.scm' has multi-dimensional arrays. `subarray.scm' has subarray and accessory procedures. + `linterp.scm' has interpolate-array-ref and resample-array!. `arraymap.scm' has array-map!, array-for-each, and array-indexes. `sort.scm' has sorted?, sort, sort!, merge, and merge!. diff --git a/RScheme.init b/RScheme.init index d04e4dc..292b963 100644 --- a/RScheme.init +++ b/RScheme.init @@ -9,7 +9,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -33,9 +33,9 @@ (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/local/lib/rs/0.7.1/") - ((VMS) "scheme$src:") - ((MS-DOS) "C:\\scheme\\"))) + ((unix) "/usr/local/lib/rs/0.7.1/") + ((vms) "scheme$src:") + ((ms-dos) "C:\\scheme\\"))) ;;; (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. @@ -48,9 +48,9 @@ ;; Use this path if your scheme does not support GETENV ;; or if SCHEME_LIBRARY_PATH is not set. (case (software-type) - ((UNIX) "/usr/lib/slib/") - ((VMS) "lib$scheme:") - ((MS-DOS) "C:\\SLIB\\") + ((unix) "/usr/lib/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -61,7 +61,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -71,7 +71,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -79,12 +79,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -103,7 +103,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -113,10 +113,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -361,7 +361,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) @@ -7,7 +7,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -42,7 +42,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -52,7 +52,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -60,12 +60,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -84,7 +84,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -94,10 +94,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -312,7 +312,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) diff --git a/Template.scm b/Template.scm index b35f8e5..d24f984 100644 --- a/Template.scm +++ b/Template.scm @@ -4,8 +4,8 @@ ;;; 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) +;;; 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. @@ -25,9 +25,9 @@ ;;; implementation reside. (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/local/src/scheme/") - ((VMS) "scheme$src:") - ((MS-DOS) "C:\\scheme\\"))) + ((unix) "/usr/local/src/scheme/") + ((vms) "scheme$src:") + ((ms-dos) "C:\\scheme\\"))) ;;@ (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. @@ -39,9 +39,9 @@ ;; 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\\") + ((unix) "/usr/local/lib/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -52,7 +52,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -63,7 +63,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -71,12 +71,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -95,7 +95,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -105,10 +105,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -364,7 +364,7 @@ ;;@ Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) diff --git a/alistab.scm b/alistab.scm index e8999bf..f8a5f70 100644 --- a/alistab.scm +++ b/alistab.scm @@ -61,7 +61,7 @@ (else #f))) (lambda (port) (display (string-append - ";;; \"" outfile "\" SLIB " *SLIB-VERSION* + ";;; \"" outfile "\" SLIB " *slib-version* " alist-table database -*-scheme-*-") port) (newline port) (newline port) @@ -32,7 +32,7 @@ (lambda (str) 1))) (define system:success? (case (software-type) - ((VMS) (lambda (int) (eqv? 1 int))) + ((vms) (lambda (int) (eqv? 1 int))) (else zero?))) ;;(trace system system:success? exit quit slib:exit) @@ -471,7 +471,7 @@ ) ;@ (define *operating-system* - (cond ((and (eq? 'UNIX (software-type)) (provided? 'system)) + (cond ((and (eq? 'unix (software-type)) (provided? 'system)) (let* ((file-name (tmpnam)) (uname (and (system (string-append "uname > " file-name)) (call-with-input-file file-name read))) @@ -480,11 +480,11 @@ (cond ((and ustr (> (string-length ustr) 5) (string-ci=? "cygwin" (substring ustr 0 6))) - 'GNU-WIN32) + 'gnu-win32) ((and ustr (> (string-length ustr) 4) (string-ci=? "mingw" (substring ustr 0 5))) - 'GNU-WIN32) + 'gnu-win32) (ustr uname) (else (software-type))))) (else (software-type)))) diff --git a/bigloo.init b/bigloo.init index af34546..eb607bb 100644 --- a/bigloo.init +++ b/bigloo.init @@ -5,7 +5,7 @@ ;;@ (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;@ (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -26,8 +26,8 @@ ;;; implementation reside. (define (implementation-vicinity) (case (software-type) - ((UNIX) (string-append *default-lib-dir* "/")) - ((MS-DOS) "C:\\scheme\\") + ((unix) (string-append *default-lib-dir* "/")) + ((ms-dos) "C:\\scheme\\") (else ""))) ;;@ (library-vicinity) should be defined to be the pathname of the @@ -40,12 +40,12 @@ ;; Use this path if your scheme does not support GETENV ;; or if SCHEME_LIBRARY_PATH is not set. (case (software-type) - ((UNIX) (cond ((directory? "/usr/share/slib/") + ((unix) (cond ((directory? "/usr/share/slib/") "/usr/share/slib/") ((directory? "/usr/local/lib/slib/") "/usr/local/lib/slib/") (else ""))) - ((MS-DOS) "C:\\SLIB\\") + ((ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -56,7 +56,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -66,7 +66,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -74,12 +74,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -98,7 +98,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -108,10 +108,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -355,7 +355,7 @@ ;;@ Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) diff --git a/bytenumb.scm b/bytenumb.scm index 7febf64..cb9b5c5 100644 --- a/bytenumb.scm +++ b/bytenumb.scm @@ -103,11 +103,11 @@ (idx (+ -2 len) (+ -1 idx))) ((<= idx 1) (set! F (/ (+ (logand #x7F (byte-ref bytes 1)) (/ F 256)) 128)) - (cond ((< 0 E 255) (* (if S -1 1) (expt 2 (- E 127)) (+ 1 F))) + (cond ((< 0 E 255) (* (if S (- one) one) (expt 2 (- E 127)) (+ 1 F))) ((zero? E) (if (zero? F) (if S (- zero) zero) - (* (if S -1 1) (expt 2 -126) F))) + (* (if S (- one) one) (expt 2 -126) F))) ;; E must be 255 ((not (zero? F)) (/ zero zero)) (else (/ (if S (- one) one) zero)))))) @@ -117,6 +117,8 @@ ;; 0 1 8 9 31 ;;@example +;;(bytes->ieee-float (bytes 0 0 0 0)) @result{} 0.0 +;;(bytes->ieee-float (bytes #x80 0 0 0)) @result{} -0.0 ;;(bytes->ieee-float (bytes #x40 0 0 0)) @result{} 2.0 ;;(bytes->ieee-float (bytes #x40 #xd0 0 0)) @result{} 6.5 ;;(bytes->ieee-float (bytes #xc0 #xd0 0 0)) @result{} -6.5 @@ -125,8 +127,8 @@ ;;(bytes->ieee-float (bytes 0 #x40 0 0)) @result{} 5.877471754111437e-39 ;;(bytes->ieee-float (bytes 0 0 0 1)) @result{} 1.401298464324817e-45 ;; -;;(bytes->ieee-float (bytes #xff #x80 0 0)) @result{} -1/0 -;;(bytes->ieee-float (bytes #x7f #x80 0 0)) @result{} 1/0 +;;(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 ;;@end example @@ -147,11 +149,11 @@ (idx (+ -2 len) (+ -1 idx))) ((<= idx 1) (set! F (/ (+ (logand #x0F (byte-ref bytes 1)) (/ F 256)) 16)) - (cond ((< 0 E 2047) (* (if S -1 1) (expt 2 (- E 1023)) (+ 1 F))) + (cond ((< 0 E 2047) (* (if S (- one) one) (expt 2 (- E 1023)) (+ 1 F))) ((zero? E) (if (zero? F) (if S (- zero) zero) - (* (if S -1 1) (expt 2 -1022) F))) + (* (if S (- one) one) (expt 2 -1022) F))) ;; E must be 2047 ((not (zero? F)) (/ zero zero)) (else (/ (if S (- one) one) zero)))))) @@ -162,7 +164,8 @@ ;;@example ;;(bytes->ieee-double (bytes 0 0 0 0 0 0 0 0)) @result{} 0.0 -;;(bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) @result{} 2 +;;(bytes->ieee-double (bytes #x80 0 0 0 0 0 0 0)) @result{} -0.0 +;;(bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) @result{} 2.0 ;;(bytes->ieee-double (bytes #x40 #x1A 0 0 0 0 0 0)) @result{} 6.5 ;;(bytes->ieee-double (bytes #xC0 #x1A 0 0 0 0 0 0)) @result{} -6.5 ;; @@ -170,8 +173,8 @@ ;;(bytes->ieee-double (bytes 0 4 0 0 0 0 0 0)) @result{} 5.562684646268003e-309 ;;(bytes->ieee-double (bytes 0 0 0 0 0 0 0 1)) @result{} 4.0e-324 ;; -;;(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0)) @result{} -1/0 -;;(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) @result{} 1/0 +;;(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0)) @result{} -inf.0 +;;(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) @result{} +inf.0 ;;(bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0)) @result{} 0/0 ;;@end example @@ -183,11 +186,11 @@ (exactify (if (provided? 'inexact) inexact->exact identity))) (lambda (flt) (define byts (make-bytes 4 0)) - (define S (negative? flt)) + (define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt)))) (define (scale flt scl) (cond ((zero? scl) (out (/ flt 2) scl)) - ((zero? flt) byts) - ((>= flt 16) + ((zero? flt) (if S (byte-set! byts 0 #x80)) byts) + ((or (not (real? flt)) (>= flt 16)) (let ((flt/16 (/ flt 16))) (cond ((= flt/16 flt) (byte-set! byts 0 (if S #xFF #x7F)) @@ -211,6 +214,8 @@ (byte-set! byts idx val))) (scale (abs 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) ;;(bytes->list (ieee-float->bytes 2.0)) @result{} (64 0 0 0) ;;(bytes->list (ieee-float->bytes 6.5)) @result{} (64 208 0 0) ;;(bytes->list (ieee-float->bytes -6.5)) @result{} (192 208 0 0) @@ -219,8 +224,8 @@ ;;(bytes->list (ieee-float->bytes 5.877471754111438e-39)) @result{} ( 0 64 0 0) ;;(bytes->list (ieee-float->bytes 1.401298464324817e-45)) @result{} ( 0 0 0 1) ;; -;;(bytes->list (ieee-float->bytes -1/0)) @result{} (255 128 0 0) -;;(bytes->list (ieee-float->bytes 1/0)) @result{} (127 128 0 0) +;;(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) ;;@end example @@ -233,11 +238,11 @@ (exactify (if (provided? 'inexact) inexact->exact identity))) (lambda (flt) (define byts (make-bytes 8 0)) - (define S (negative? flt)) + (define S (and (real? flt) (negative? (if (zero? flt) (/ flt) flt)))) (define (scale flt scl) (cond ((zero? scl) (out (/ flt 2) scl)) - ((zero? flt) byts) - ((>= flt 16) + ((zero? flt) (if S (byte-set! byts 0 #x80)) byts) + ((or (not (real? flt)) (>= flt 16)) (let ((flt/16 (/ flt 16))) (cond ((= flt/16 flt) (byte-set! byts 0 (if S #xFF #x7F)) @@ -261,6 +266,8 @@ (byte-set! byts idx val))) (scale (abs 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) ;;(bytes->list (ieee-double->bytes 2.0)) @result{} (64 0 0 0 0 0 0 0) ;;(bytes->list (ieee-double->bytes 6.5)) @result{} (64 26 0 0 0 0 0 0) ;;(bytes->list (ieee-double->bytes -6.5)) @result{} (192 26 0 0 0 0 0 0) @@ -272,8 +279,8 @@ ;;(bytes->list (ieee-double->bytes 4.0e-324)) ;; @result{} ( 0 0 0 0 0 0 0 1) ;; -;;(bytes->list (ieee-double->bytes -1/0)) @result{} (255 240 0 0 0 0 0 0) -;;(bytes->list (ieee-double->bytes 1/0)) @result{} (127 240 0 0 0 0 0 0) +;;(bytes->list (ieee-double->bytes -inf.0)) @result{} (255 240 0 0 0 0 0 0) +;;(bytes->list (ieee-double->bytes +inf.0)) @result{} (127 240 0 0 0 0 0 0) ;;(bytes->list (ieee-double->bytes 0/0)) @result{} (127 248 0 0 0 0 0 0) ;;@end example diff --git a/bytenumb.txi b/bytenumb.txi index 9be7630..97f9b26 100644 --- a/bytenumb.txi +++ b/bytenumb.txi @@ -53,6 +53,8 @@ value of @var{bytes} interpreted as a big-endian IEEE 4-byte (32-bit) number. @end defun @example +(bytes->ieee-float (bytes 0 0 0 0)) @result{} 0.0 +(bytes->ieee-float (bytes #x80 0 0 0)) @result{} -0.0 (bytes->ieee-float (bytes #x40 0 0 0)) @result{} 2.0 (bytes->ieee-float (bytes #x40 #xd0 0 0)) @result{} 6.5 (bytes->ieee-float (bytes #xc0 #xd0 0 0)) @result{} -6.5 @@ -61,8 +63,8 @@ value of @var{bytes} interpreted as a big-endian IEEE 4-byte (32-bit) number. (bytes->ieee-float (bytes 0 #x40 0 0)) @result{} 5.877471754111437e-39 (bytes->ieee-float (bytes 0 0 0 1)) @result{} 1.401298464324817e-45 -(bytes->ieee-float (bytes #xff #x80 0 0)) @result{} -1/0 -(bytes->ieee-float (bytes #x7f #x80 0 0)) @result{} 1/0 +(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 @end example @@ -75,7 +77,8 @@ value of @var{bytes} interpreted as a big-endian IEEE 8-byte (64-bit) number. @example (bytes->ieee-double (bytes 0 0 0 0 0 0 0 0)) @result{} 0.0 -(bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) @result{} 2 +(bytes->ieee-double (bytes #x80 0 0 0 0 0 0 0)) @result{} -0.0 +(bytes->ieee-double (bytes #x40 0 0 0 0 0 0 0)) @result{} 2.0 (bytes->ieee-double (bytes #x40 #x1A 0 0 0 0 0 0)) @result{} 6.5 (bytes->ieee-double (bytes #xC0 #x1A 0 0 0 0 0 0)) @result{} -6.5 @@ -83,8 +86,8 @@ value of @var{bytes} interpreted as a big-endian IEEE 8-byte (64-bit) number. (bytes->ieee-double (bytes 0 4 0 0 0 0 0 0)) @result{} 5.562684646268003e-309 (bytes->ieee-double (bytes 0 0 0 0 0 0 0 1)) @result{} 4.0e-324 -(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0)) @result{} -1/0 -(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) @result{} 1/0 +(bytes->ieee-double (bytes #xFF #xF0 0 0 0 0 0 0)) @result{} -inf.0 +(bytes->ieee-double (bytes #x7F #xF0 0 0 0 0 0 0)) @result{} +inf.0 (bytes->ieee-double (bytes #x7F #xF8 0 0 0 0 0 0)) @result{} 0/0 @end example @@ -96,6 +99,8 @@ floating-point of @var{x}. @end defun @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) (bytes->list (ieee-float->bytes 2.0)) @result{} (64 0 0 0) (bytes->list (ieee-float->bytes 6.5)) @result{} (64 208 0 0) (bytes->list (ieee-float->bytes -6.5)) @result{} (192 208 0 0) @@ -104,8 +109,8 @@ floating-point of @var{x}. (bytes->list (ieee-float->bytes 5.877471754111438e-39)) @result{} ( 0 64 0 0) (bytes->list (ieee-float->bytes 1.401298464324817e-45)) @result{} ( 0 0 0 1) -(bytes->list (ieee-float->bytes -1/0)) @result{} (255 128 0 0) -(bytes->list (ieee-float->bytes 1/0)) @result{} (127 128 0 0) +(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) @end example @@ -117,6 +122,8 @@ floating-point of @var{x}. @end defun @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) (bytes->list (ieee-double->bytes 2.0)) @result{} (64 0 0 0 0 0 0 0) (bytes->list (ieee-double->bytes 6.5)) @result{} (64 26 0 0 0 0 0 0) (bytes->list (ieee-double->bytes -6.5)) @result{} (192 26 0 0 0 0 0 0) @@ -128,8 +135,8 @@ floating-point of @var{x}. (bytes->list (ieee-double->bytes 4.0e-324)) @result{} ( 0 0 0 0 0 0 0 1) -(bytes->list (ieee-double->bytes -1/0)) @result{} (255 240 0 0 0 0 0 0) -(bytes->list (ieee-double->bytes 1/0)) @result{} (127 240 0 0 0 0 0 0) +(bytes->list (ieee-double->bytes -inf.0)) @result{} (255 240 0 0 0 0 0 0) +(bytes->list (ieee-double->bytes +inf.0)) @result{} (127 240 0 0 0 0 0 0) (bytes->list (ieee-double->bytes 0/0)) @result{} (127 248 0 0 0 0 0 0) @end example @@ -8,7 +8,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -40,9 +40,9 @@ ;; 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\\") + ((unix) "/usr/local/lib/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -53,7 +53,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -63,7 +63,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -71,12 +71,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -95,7 +95,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -105,10 +105,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -357,7 +357,7 @@ ;;; file suffix. (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) diff --git a/debian/changelog b/debian/changelog index 9bbed5f..f76c88a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +slib (3a2-3) unstable; urgency=low + + * Brought all source files up-to-date with upstream CVS. + Repeat changes from version 3a2-1 in Makefile. + + -- Thomas Bushnell, BSG <tb@debian.org> Sun, 4 Dec 2005 20:03:34 -0800 + slib (3a2-2) unstable; urgency=low * Conflict with libguile9 <= 1:1.4-26 and guile-1.6-libs <= 1.6.7-1.1. @@ -33,12 +33,12 @@ ;;If @0 cannot be supported by the platform, then #f is returned. (define current-directory (case (software-type) - ;;((AMIGA) ) - ;;((MACOS THINKC) ) - ((MS-DOS WINDOWS ATARIST OS/2) (lambda () (system->line "cd"))) - ;;((NOSVE) ) - ((UNIX COHERENT PLAN9) (lambda () (system->line "pwd"))) - ;;((VMS) ) + ;;((amiga) ) + ;;((macos thinkc) ) + ((ms-dos windows atarist os/2) (lambda () (system->line "cd"))) + ;;((nosve) ) + ((unix coherent plan9) (lambda () (system->line "pwd"))) + ;;((vms) ) (else #f))) ;;@body @@ -49,9 +49,9 @@ (define (dir:lister dirname tmp) (case (software-type) - ((UNIX COHERENT PLAN9) + ((unix coherent plan9) (zero? (system (string-append "ls '" dirname "' > " tmp)))) - ((MS-DOS WINDOWS OS/2 ATARIST) + ((ms-dos windows os/2 atarist) (zero? (system (string-append "DIR /B \"" dirname "\" > " tmp)))) (else (slib:error (software-type) 'list?)))) @@ -16,7 +16,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -37,9 +37,9 @@ ;;; implementation reside. (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/share/elk/") - ((VMS) "scheme$src:") - ((MS-DOS) "C:\\scheme\\"))) + ((unix) "/usr/share/elk/") + ((vms) "scheme$src:") + ((ms-dos) "C:\\scheme\\"))) ;;; (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. @@ -52,9 +52,9 @@ (or (getenv "SCHEME_LIBRARY_PATH") ;; Uses this path if SCHEME_LIBRARY_PATH is not defined. (case (software-type) - ((UNIX) "/usr/local/lib/slib/") - ((VMS) "lib$scheme:") - ((MS-DOS) "C:\\SLIB\\") + ((unix) "/usr/local/lib/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -65,7 +65,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -75,7 +75,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -83,12 +83,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -107,7 +107,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -117,10 +117,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -400,7 +400,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) diff --git a/gambit.init b/gambit.init index d50edae..5ca0d67 100644 --- a/gambit.init +++ b/gambit.init @@ -13,8 +13,8 @@ ;;; gsi should be invoked with -:s option to Ignore case when reading ;;; symbols (per R5RS). -(define (software-type) 'MACOS) ; for MacGambit. -(define (software-type) 'UNIX) ; for Unix platforms. +(define (software-type) 'macos) ; for MacGambit. +(define (software-type) 'unix) ; for Unix platforms. (define (scheme-implementation-type) 'gambit) @@ -35,11 +35,11 @@ ;;; implementation reside. (define implementation-vicinity (case (software-type) - ((UNIX) (lambda () "/usr/local/share/gambc/")) - ((VMS) (lambda () "scheme$src:")) - ((MS-DOS) (lambda () "C:\\scheme\\")) - ((WINDOWS) (lambda () "c:/scheme/")) - ((MACOS) + ((unix) (lambda () "/usr/local/share/gambc/")) + ((vms) (lambda () "scheme$src:")) + ((ms-dos) (lambda () "C:\\scheme\\")) + ((windows) (lambda () "c:/scheme/")) + ((macos) (let ((arg0 (list-ref (argv) 0))) (let loop ((i (- (string-length arg0) 1))) (cond ((negative? i) "") @@ -61,11 +61,11 @@ ;; Use this path if your scheme does not support GETENV ;; or if SCHEME_LIBRARY_PATH is not set. (case (software-type) - ((UNIX) "/usr/local/lib/slib/") - ((MACOS) (string-append (implementation-vicinity) "slib:")) - ((AMIGA) "dh0:scm/Library/") - ((VMS) "lib$scheme:") - ((WINDOWS MS-DOS) "C:\\SLIB\\") + ((unix) "/usr/local/lib/slib/") + ((macos) (string-append (implementation-vicinity) "slib:")) + ((amiga) "dh0:scm/Library/") + ((vms) "lib$scheme:") + ((windows ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -76,22 +76,22 @@ (let ((home (getenv "HOME"))) (if home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) (else home)) (case (software-type) - ((VMS) "~:") - ((WINDOWS) "~/") - ((MACOS) "~:") + ((vms) "~:") + ((windows) "~/") + ((macos) "~:") (else #f))))) ;@ (define in-vicinity string-append) ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -99,12 +99,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -123,7 +123,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -133,10 +133,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -391,7 +391,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) @@ -45,9 +45,9 @@ ;;; the directory where any auxillary files to your Scheme ;;; implementation reside. (define implementation-vicinity - (let* ((path (or (%search-load-path "slib/require.scm") - (error "Could not find slib/require.scm in " %load-path))) - (vic (substring path 0 (- (string-length path) 16)))) + (let* ((path (or (%search-load-path "ice-9/q.scm") + (error "Could not find ice-9/q.scm in " %load-path))) + (vic (substring path 0 (- (string-length path) 11)))) (lambda () vic))) ;;; (library-vicinity) should be defined to be the pathname of the @@ -66,7 +66,7 @@ ;;; directory, the directory which typically contains files which ;;; customize a computer environment for a user. (define (home-vicinity) - (let ((home (getenv "HOME"))) + (let ((home (and (defined? 'getenv) (getenv "HOME")))) (and home (case (software-type) ((unix coherent ms-dos) ;V7 unix has a / on HOME @@ -79,7 +79,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) ;@ (define vicinity:suffix? @@ -111,7 +111,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -121,10 +121,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -190,6 +190,7 @@ ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? ;;; object-hash ;has OBJECT-HASH + hash ;HASH, HASHV, HASHQ full-continuation ;can return multiple times ;;; ieee-floating-point ;conforms to IEEE Standard 754-1985 @@ -206,6 +207,7 @@ ;;; record ;has user defined data structures string-port ;has CALL-WITH-INPUT-STRING and ;CALL-WITH-OUTPUT-STRING + line-i/o ;;; sort ;;; pretty-print ;;; object->string @@ -213,7 +215,7 @@ ;;; trace ;has macros: TRACE and UNTRACE ;;; compiler ;has (COMPILER) ;;; ed ;(ED) is editor -;;; system ;posix (system <string>) + system ;posix (system <string>) ;;; getenv ;posix (getenv <string>) ;;; program-arguments ;returns list of strings (argv) ;;; current-time ;returns time in seconds since 1/1/1970 @@ -223,6 +225,8 @@ logical random ;Random numbers + array + array-for-each ) (if (defined? 'getenv) @@ -233,22 +237,10 @@ '(current-time) '()) - (if (defined? 'system) - '(system) - '()) - - (if (defined? 'array?) - '(array) - '()) - (if (defined? 'char-ready?) '(char-ready?) '()) - (if (defined? 'array-for-each) - '(array-for-each) - '()) - *features*)) ;;; (OUTPUT-PORT-WIDTH <port>) @@ -277,16 +269,17 @@ (+ 128 (or (status:term-sig st) (status:stop-sig st))))))) -;;; (TMPNAM) makes a temporary file name. -;;(define tmpnam (let ((cntr 100)) -;; (lambda () (set! cntr (+ 1 cntr)) -;; (string-append "slib_" (number->string cntr))))) - -;;; (FILE-EXISTS? <string>) -;;(define (file-exists? f) #f) +;;; for line-i/o +(use-modules (ice-9 popen)) +(define (system->line command . tmp) + (let ((ipip (open-input-pipe command))) + (define line (read-line ipip)) + (let ((status (close-pipe ipip))) + (and (or (eqv? 0 (status:exit-val status)) + (status:term-sig status) + (status:stop-sig status)) + (if (eof-object? line) "" line))))) -;;; (DELETE-FILE <string>) -;;(define (delete-file f) #f) (define delete-file (let ((guile-core-delete-file delete-file)) (lambda (filename) @@ -354,29 +347,31 @@ ;;; Here for backward compatability ;;(define scheme-file-suffix ;; (let ((suffix (case (software-type) -;; ((NOSVE) "_scm") +;; ((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 (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 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 (<pathname>) - (load-file (string-append <pathname> (scheme-file-suffix)))))) +;;; (define slib:load +;;; (let ((load-file (guile:wrap-case-insensitive load))) +;;; (lambda (<pathname>) +;;; (load-file (string-append <pathname> (scheme-file-suffix)))))) +(define (slib:load <pathname>) + (load (string-append <pathname> (scheme-file-suffix)))) (define slib:load-source slib:load) @@ -524,9 +519,9 @@ (define A:floR32b ar32) (define A:floR16b ar32) ;; decimal flonums -(define A:flor128d ar64) -(define A:flor64d ar64) -(define A:flor32d ar32) +(define A:floR128d ar64) +(define A:floR64d ar64) +(define A:floR32d ar32) ;; fixnums (define A:fixZ64b as64) (define A:fixZ32b as32) diff --git a/http-cgi.scm b/http-cgi.scm index 1dd1c07..abdb3fa 100644 --- a/http-cgi.scm +++ b/http-cgi.scm @@ -90,7 +90,7 @@ (else #f))) (define (http:status-line status-code reason) - (sprintf #f "HTTP/1.1 %d %s%s" status-code reason http:crlf)) + (sprintf #f "HTTP/1.0 %d %s%s" status-code reason http:crlf)) ;;@body Returns a string containing lines for each element of @1; the ;;@code{car} of which is followed by @samp{: }, then the @code{cdr}. @@ -126,7 +126,7 @@ (sprintf #f "<A HREF=http://swiss.csail.mit.edu/~jaffer/SLIB.html>SLIB</A> %s server" - (if (getenv "SERVER_PROTOCOL") "CGI/1.1" "HTTP/1.1")))) + (if (getenv "SERVER_PROTOCOL") "CGI/1.0" "HTTP/1.0")))) (string-append (http:status-line status-code reason-phrase) (http:content '(("Content-Type" . "text/html")) diff --git a/jscheme.init b/jscheme.init index 88c1623..95caa8d 100644 --- a/jscheme.init +++ b/jscheme.init @@ -21,11 +21,10 @@ ;;@ (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -;; (define (software-type) 'UNIX) (define (software-type) (if (.startsWith (System.getProperty "os.name") "Windows") - 'MS-DOS - 'UNIX)) + 'ms-dos + 'unix)) ;;@ (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -45,7 +44,7 @@ ;;; implementation reside. (define implementation-vicinity (let ((implvic (case (software-type) - ((MS-DOS) "C:\\TEMP\\") + ((ms-dos) "C:\\TEMP\\") (else "/tmp/")))) (lambda () implvic))) @@ -72,9 +71,9 @@ ;; 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\\") + ((unix) "/usr/local/lib/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -85,7 +84,7 @@ (define home (or (getenv "HOME") (getenv "user.home"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -95,7 +94,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -103,12 +102,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -127,7 +126,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -137,10 +136,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ diff --git a/limit.scm b/limit.scm new file mode 100644 index 0000000..8c67e8f --- /dev/null +++ b/limit.scm @@ -0,0 +1,129 @@ +;;; "limit.scm" Scheme Implementation of one-side limit algorithm. +;Copyright 2005 Aubrey Jaffer +; +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. +; +;1. Any copy made of this software must include this copyright notice +;in full. +; +;2. I have made no warranty or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +;;@code{(require 'limit)} + +(define (inv-root f1 f2 f3 prec) + (define f1^2 (* f1 f1)) + (define f2^2 (* f2 f2)) + (define f3^2 (expt f3 2)) + (require 'root) ; SLIB + (newton:find-root (lambda (f0) + (+ (- (* (expt f0 2) f1)) + (* f0 f1^2) + (* (- (* 2 (expt f0 2)) (* 3 f1^2)) f2) + (* (+ (- (* 2 f0)) (* 3 f1)) f2^2) + (* (- (+ (- (expt f0 2)) (* 2 f1^2)) f2^2) + f3) + (* (+ (- f0 (* 2 f1)) f2) f3^2))) + (lambda (f0) + (+ (- (+ (* -2 f0 f1) f1^2 (* 4 f0 f2)) + (* 2 f2^2) + (* 2 f0 f3)) + f3^2)) + f1 + prec)) + +(define (invintp f1 f2 f3) + (define f1^2 (* f1 f1)) + (define f2^2 (* f2 f2)) + (define f3^2 (expt f3 2)) + (let ((c (+ (* -3 f1^2 f2) + (* 3 f1 f2^2) + (* (- (* 2 f1^2) f2^2) f3) + (* (- f2 (* 2 f1)) f3^2))) + (b (+ (- f1^2 (* 2 f2^2)) f3^2)) + (a (- (* 2 f2) f1 f3))) + (define disc (- (* b b) (* 4 a c))) + ;;(printf "discriminant: %g\n" disc) + (if (negative? (real-part disc)) + (/ b -2 a) + (let ((sqrt-disc (sqrt disc))) + (define root+ (/ (- sqrt-disc b) 2 a)) + (define root- (/ (+ sqrt-disc b) -2 a)) + (if (< (magnitude (- root+ f1)) (magnitude (- root- f1))) + root+ + root-))))) + +(define (extrapolate-0 fs) + (define n (length fs)) + (define (choose n k) + (do ((kdx 1 (+ 1 kdx)) + (prd 1 (/ (* (- n kdx -1) prd) kdx))) + ((> kdx k) prd))) + (do ((k 1 (+ 1 k)) + (lst fs (cdr lst)) + (L 0 (+ (* -1 (expt -1 k) (choose n k) (car lst)) L))) + ((null? lst) L))) + +(define (sequence->limit proc sequence) + (define lval (proc (car sequence))) + (if (finite? lval) + (let ((val (proc (cadr sequence)))) + (define h_n*nsamps (* (length sequence) (magnitude (- val lval)))) + (if (finite? val) + (let loop ((sequence (cddr sequence)) + (fxs (list val lval)) + (trend #f) + (ldelta (- val lval)) + (jdx (+ -1 (length sequence)))) + (cond ((null? sequence) + (case trend + ((diverging) (and (real? val) (/ ldelta 0.0))) + ((bounded) (invintp val lval (caddr fxs))) + (else (cond ((zero? ldelta) val) + ((not (real? val)) #f) + (else (extrapolate-0 fxs)))))) + (else + (set! lval val) + (set! val (proc (car sequence))) + ;;(printf "f(%12g)=%12g; delta=%12g hyp=%12g j=%3d %s\n" (car sequence) val (- val lval) (/ h_n*nsamps jdx) jdx (or trend "")) + (if (finite? val) + (let ((delta (- val lval))) + (define h_j (/ h_n*nsamps jdx)) + (cond ((case trend + ((converging) (<= (magnitude delta) h_j)) + ((bounded) (<= (magnitude ldelta) (magnitude delta))) + ((diverging) (>= (magnitude delta) h_j)) + (else #f)) + (loop (cdr sequence) (cons val fxs) trend delta (+ -1 jdx))) + (trend #f) + (else + (loop (cdr sequence) (cons val fxs) + (cond ((> (magnitude delta) h_j) 'diverging) + ((< (magnitude ldelta) (magnitude delta)) 'bounded) + (else 'converging)) + delta (+ -1 jdx))))) + (and (eq? trend 'diverging) val))))) + (and (real? val) val))) + (and (real? lval) lval))) + +(define (limit proc x1 x2 . k) + (set! k (if (null? k) 8 (car k))) + (cond ((not (finite? x2)) (slib:error 'limit 'infinite 'x2 x2)) + ((not (finite? x1)) + (or (positive? (* x1 x2)) (slib:error 'limit 'start 'mismatch x1 x2)) + (limit (lambda (x) (proc (/ x))) 0.0 (/ x2) k)) + ((= x1 (+ x1 x2)) (slib:error 'limit 'null 'range x1 (+ x1 x2))) + (else (let ((dec (/ x2 k))) + (do ((x (+ x1 x2 0.0) (- x dec)) + (cnt (+ -1 k) (+ -1 cnt)) + (lst '() (cons x lst))) + ((negative? cnt) + (sequence->limit proc (reverse lst)))))))) diff --git a/limit.texi b/limit.texi new file mode 100644 index 0000000..0a3a64c --- /dev/null +++ b/limit.texi @@ -0,0 +1,101 @@ +@settitle The limit procedure + +@deffn {library procedure} limit proc x1 x2 k +@deffnx {library procedure} limit proc x1 x2 + +@var{Proc} must be a procedure taking a single inexact real argument. +@var{K} is the number of points on which @var{proc} will be called; it +defaults to 8. + +If @var{x1} is finite, then @var{Proc} must be continuous on the +half-open interval: + + ( @var{x1} .. @var{x1}+@var{x2} ] + +And @var{x2} should be chosen small enough so that @var{proc} is +expected to be monotonic or constant on arguments between @var{x1} and +@var{x1} + @var{x2}. + +@code{Limit} computes the limit of @var{proc} as its argument +approaches @var{x1} from @var{x1} + @var{x2}. +@code{Limit} returns a real number or real infinity or @samp{#f}. + +If @var{x1} is not finite, then @var{x2} must be a finite nonzero real +with the same sign as @var{x1}; in which case @code{limit} returns: + +@code{(limit (lambda (x) (proc (/ x))) 0.0 (/ @var{x2}) @var{k})} + +@code{Limit} examines the magnitudes of the differences between +successive values returned by @var{proc} called with a succession of +numbers from @var{x1}+@var{x2}/@var{k} to @var{x1}. + +If the magnitudes of differences are monotonically decreasing, then +then the limit is extrapolated from the degree n polynomial passing +through the samples returned by @var{proc}. + +If the magnitudes of differences are increasing as fast or faster than +a hyperbola matching at @var{x1}+@var{x2}, then a real infinity with +sign the same as the differences is returned. + +If the magnitudes of differences are increasing more slowly than the +hyperbola matching at @var{x1}+@var{x2}, then the limit is +extrapolated from the quadratic passing through the three samples +closest to @var{x1}. + +If the magnitudes of differences are not monotonic or are not +completely within one of the above categories, then #f is returned. +@end deffn + +@example +;; constant +(limit (lambda (x) (/ x x)) 0 1.0e-9) ==> 1.0 +(limit (lambda (x) (expt 0 x)) 0 1.0e-9) ==> 0.0 +(limit (lambda (x) (expt 0 x)) 0 -1.0e-9) ==> +inf.0 +;; linear +(limit + 0 976.5625e-6) ==> 0.0 +(limit - 0 976.5625e-6) ==> 0.0 +;; vertical point of inflection +(limit sqrt 0 1.0e-18) ==> 0.0 +(limit (lambda (x) (* x (log x))) 0 1.0e-9) ==> -102.70578127633066e-12 +(limit (lambda (x) (/ x (log x))) 0 1.0e-9) ==> 96.12123142321669e-15 +;; limits tending to infinity +(limit + +inf.0 1.0e9) ==> +inf.0 +(limit + -inf.0 -1.0e9) ==> -inf.0 +(limit / 0 1.0e-9) ==> +inf.0 +(limit / 0 -1.0e-9) ==> -inf.0 +(limit (lambda (x) (/ (log x) x)) 0 1.0e-9) ==> -inf.0 +(limit (lambda (x) (/ (magnitude (log x)) x)) 0 -1.0e-9) + ==> -inf.0 +;; limit doesn't exist +(limit sin +inf.0 1.0e9) ==> #f +(limit (lambda (x) (sin (/ x))) 0 1.0e-9) ==> #f +(limit (lambda (x) (sin (/ x))) 0 -1.0e-9) ==> #f +(limit (lambda (x) (/ (log x) x)) 0 -1.0e-9) ==> #f +;; conditionally convergent - return #f +(limit (lambda (x) (/ (sin x) x)) +inf.0 1.0e222) + ==> #f +;; asymptotes +(limit / -inf.0 -1.0e222) ==> 0.0 +(limit / +inf.0 1.0e222) ==> 0.0 +(limit (lambda (x) (expt x x)) 0 1.0e-18) ==> 1.0 +(limit (lambda (x) (sin (/ x))) +inf.0 1.0e222) ==> 0.0 +(limit (lambda (x) (/ (+ (exp (/ x)) 1))) 0 1.0e-9) + ==> 0.0 +(limit (lambda (x) (/ (+ (exp (/ x)) 1))) 0 -1.0e-9) + ==> 1.0 +(limit (lambda (x) (real-part (expt (tan x) (cos x)))) (/ pi 2) 1.0e-9) + ==> 1.0 +;; This example from the 1979 Macsyma manual grows so rapidly +;; that x2 must be less than 41. It correctly returns e^2. +(limit (lambda (x) (expt (+ x (exp x) (exp (* 2 x))) (/ x))) +inf.0 40) + ==> 7.3890560989306504 +;; LIMIT can calculate the proper answer when evaluation +;; of the function at the limit point does not: +(tan (atan +inf.0)) ==> 16.331778728383844e15 +(limit tan (atan +inf.0) -1.0e-15) ==> +inf.0 +(tan (atan +inf.0)) ==> 16.331778728383844e15 +(limit tan (atan +inf.0) 1.0e-15) ==> -inf.0 +((lambda (x) (expt (exp (/ -1 x)) x)) 0) ==> 1.0 +(limit (lambda (x) (expt (exp (/ -1 x)) x)) 0 1.0e-9) + ==> 0.0 +@end example @@ -75,6 +75,11 @@ ;;a temporary file. @0 calls @code{system} with @1 as argument, ;;redirecting stdout to file @2. @0 returns a string containing the ;;first line of output from @2. +;; +;;@0 is intended to be a portable method for getting one-line results +;;from programs like @code{pwd}, @code{whoami}, @code{hostname}, +;;@code{which}, @code{identify}, and @code{cksum}. Its behavior when +;;called with programs which generate lots of output is unspecified. (define (system->line command . tmp) (require 'filename) (cond ((null? tmp) @@ -46,5 +46,10 @@ which case it defaults to the value returned by a temporary file. @code{system->line} calls @code{system} with @var{command} as argument, redirecting stdout to file @var{tmp}. @code{system->line} returns a string containing the first line of output from @var{tmp}. + +@code{system->line} is intended to be a portable method for getting one-line results +from programs like @code{pwd}, @code{whoami}, @code{hostname}, +@code{which}, @code{identify}, and @code{cksum}. Its behavior when +called with programs which generate lots of output is unspecified. @end defun diff --git a/linterp.scm b/linterp.scm new file mode 100644 index 0000000..5be2b36 --- /dev/null +++ b/linterp.scm @@ -0,0 +1,90 @@ +;;; "linterp.scm" Interpolate array access. +;Copyright 2005 Aubrey Jaffer +; +;Permission to copy this software, to modify it, to redistribute it, +;to distribute modified versions, and to use it for any purpose is +;granted, subject to the following restrictions and understandings. +; +;1. Any copy made of this software must include this copyright notice +;in full. +; +;2. I have made no warranty or representation that the operation of +;this software will be error-free, and I am under no obligation to +;provide any services, by way of maintenance, update, or otherwise. +; +;3. In conjunction with products arising from the use of this +;material, there shall be no use of my name in any advertising, +;promotional, or sales literature without prior written consent in +;each case. + +;;@code{(require 'array-interpolate)} + +(require 'array) +(require 'subarray) +(require 'array-for-each) + +;;@args ra x1 ... xj +;; +;;@1 must be an array of rank j containing numbers. @0 returns a +;;value interpolated from the nearest j-dimensional cube of elements +;;of @1. +;; +;;@example +;;(interpolate-array-ref '#2A:fixZ32b((1 2 3) (4 5 6)) 1 0.1) +;; ==> 4.1 +;;(interpolate-array-ref '#2A:fixZ32b((1 2 3) (4 5 6)) 0.5 0.25) +;; ==> 2.75 +;;@end example +(define (interpolate-array-ref ra . xs) + (define (mix rat x1 x2) (+ (* (- 1 rat) x1) (* rat x2))) + (define (iar ra xs dims) + (define x1 (car xs)) + (define b1 (car dims)) + (define idx (inexact->exact (floor (car xs)))) + (define dim-1 (+ -1 (car dims))) + (set! xs (cdr xs)) + (set! dims (cdr dims)) + (cond ((<= x1 0) (if (null? xs) + (array-ref ra 0) + (iar (subarray ra idx) xs dims))) + ((>= x1 dim-1) (if (null? xs) + (array-ref ra dim-1) + (iar (subarray ra dim-1) xs dims))) + ((integer? x1) (if (null? xs) + (array-ref ra idx) + (iar (subarray ra idx) xs dims))) + ((null? xs) (mix (- x1 idx) + (array-ref ra idx) + (array-ref ra (+ 1 idx)))) + (else (mix (- x1 idx) + (iar (subarray ra idx) xs dims) + (iar (subarray ra (+ 1 idx)) xs dims))))) + (if (null? xs) + (array-ref ra) + (iar ra xs (array-dimensions ra)))) + +;;@args ra1 ra2 +;; +;;@1 and @2 must be numeric arrays of equal rank. @0 sets @1 to +;;values interpolated from @2 such that the values of elements at the +;;corners of @1 and @2 are equal. +;; +;;@example +;;(define ra (make-array (A:fixZ32b) 2 2)) +;;(resample-array! ra '#2A:fixZ32b((1 2 3) (4 5 6))) +;;ra ==> #2A:fixZ32b((1 3) (4 6)) +;;(define ra (make-array (A:floR64b) 3 2)) +;;(resample-array! ra '#2A:fixZ32b((1 2 3) (4 5 6))) +;;ra ==> #2A:floR64b((1.0 3.0) (2.5 4.5) (4.0 6.0)) +;;@end example +(define (resample-array! ra1 ra2) + (define scales (map (lambda (rd1 rd2) + (if (<= rd1 1) + 0 + (/ (+ -1 rd2) (+ -1 rd1)))) + (array-dimensions ra1) + (array-dimensions ra2))) + (array-index-map! ra1 + (lambda idxs + (apply interpolate-array-ref ra2 + (map * scales idxs))))) diff --git a/linterp.txi b/linterp.txi new file mode 100644 index 0000000..14861f6 --- /dev/null +++ b/linterp.txi @@ -0,0 +1,36 @@ +@code{(require 'array-interpolate)} + + +@defun interpolate-array-ref ra x1 @dots{} xj + + +@var{ra} must be an array of rank j containing numbers. @code{interpolate-array-ref} returns a +value interpolated from the nearest j-dimensional cube of elements +of @var{ra}. + +@example +(interpolate-array-ref '#2A:fixZ32b((1 2 3) (4 5 6)) 1 0.1) + ==> 4.1 +(interpolate-array-ref '#2A:fixZ32b((1 2 3) (4 5 6)) 0.5 0.25) + ==> 2.75 +@end example +@end defun + + +@deffn {Procedure} resample-array! ra1 ra2 + + +@var{ra1} and @var{ra2} must be numeric arrays of equal rank. @code{resample-array!} sets @var{ra1} to +values interpolated from @var{ra2} such that the values of elements at the +corners of @var{ra1} and @var{ra2} are equal. + +@example +(define ra (make-array (A:fixZ32b) 2 2)) +(resample-array! ra '#2A:fixZ32b((1 2 3) (4 5 6))) +ra ==> #2A:fixZ32b((1 3) (4 6)) +(define ra (make-array (A:floR64b) 3 2)) +(resample-array! ra '#2A:fixZ32b((1 2 3) (4 5 6))) +ra ==> #2A:floR64b((1.0 3.0) (2.5 4.5) (4.0 6.0)) +@end example +@end deffn + diff --git a/macscheme.init b/macscheme.init index 60ee387..8edfc00 100644 --- a/macscheme.init +++ b/macscheme.init @@ -7,7 +7,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'MACOS) +(define (software-type) 'macos) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -40,7 +40,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -48,12 +48,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -72,7 +72,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -82,10 +82,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -343,7 +343,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) diff --git a/matfile.scm b/matfile.scm index a7a96a6..49c603b 100644 --- a/matfile.scm +++ b/matfile.scm @@ -122,7 +122,8 @@ (else (slib:error 'p 'type d-prot))) mrows ncols)) ((text) (make-array "." mrows ncols)) - ((sparse) (slib:error 'sparse '?))))) + ((sparse) (slib:error 'sparse '?)))) + (d-endn*leng (* -1 d-endn d-leng))) (do ((idx 0 (+ 1 idx))) ((>= idx namlen)) (string-set! namstr idx (read-char port))) @@ -133,7 +134,7 @@ ((>= jdx ncols)) (do ((idx 0 (+ 1 idx))) ((>= idx mrows)) - (array-set! mat (d-conv (read-bytes (* d-endn d-leng) port)) + (array-set! mat (d-conv (read-bytes d-endn*leng port)) idx jdx))) (if imagf (do ((jdx 0 (+ 1 jdx))) @@ -141,7 +142,7 @@ (do ((idx 0 (+ 1 idx))) ((>= idx mrows)) (array-set! mat - (+ (* (d-conv (read-bytes (* d-endn d-leng) port)) + (+ (* (d-conv (read-bytes d-endn*leng port)) +i) (array-ref mat idx jdx)) idx jdx)))) diff --git a/mitscheme.init b/mitscheme.init index 9768155..6283230 100644 --- a/mitscheme.init +++ b/mitscheme.init @@ -9,7 +9,7 @@ ;;; (software-type) should be set to the generic operating system type. (define (software-type) - (if (eq? 'unix microcode-id/operating-system) 'UNIX 'MS-DOS)) + (if (eq? 'unix microcode-id/operating-system) 'unix 'ms-dos)) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -56,8 +56,8 @@ (or (getenv "SCHEME_LIBRARY_PATH") ;; Use this path if your scheme does not support GETENV. (case (software-type) - ((MS-DOS) "c:\\slib\\") - ((UNIX) "/usr/local/lib/slib/") + ((ms-dos) "c:\\slib\\") + ((unix) "/usr/local/lib/slib/") (else ""))))) (lambda () library-path))) @@ -72,7 +72,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -80,12 +80,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -104,7 +104,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -114,10 +114,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ diff --git a/mkclrnam.scm b/mkclrnam.scm index 3e0c553..3360a41 100644 --- a/mkclrnam.scm +++ b/mkclrnam.scm @@ -60,7 +60,7 @@ (require 'filename) (call-with-tmpnam (lambda (file) - (system (string-append "wget -c -O" file " -USLIB" *SLIB-VERSION* " " url)) + (system (string-append "wget -c -O" file " -USLIB" *slib-version* " " url)) (apply file->color-dictionary file table-name rdb)))) (define (load-rgb-txt path color-table) diff --git a/mklibcat.scm b/mklibcat.scm index 2047f86..d26c821 100644 --- a/mklibcat.scm +++ b/mklibcat.scm @@ -80,6 +80,7 @@ (modular "modular") (factor "factor") (primes factor) + (limit "limit") (eps-graph "grapheps") (charplot "charplot") (sort "sort") @@ -133,6 +134,7 @@ (array "array") (subarray "subarray") (array-for-each "arraymap") + (array-interpolate "linterp") (repl "repl") (process "process") (chapter-order "chap") @@ -208,17 +210,22 @@ (srfi-0 srfi) (srfi defmacro "srfi") (srfi-1 "srfi-1") + (and-let* srfi-2) (srfi-2 defmacro "srfi-2") + (receive srfi-8) (srfi-8 macro "srfi-8") + (define-record-type srfi-9) (srfi-9 macro "srfi-9") (srfi-47 array) (srfi-63 array) (srfi-60 logical) + (guarded-cond-clause srfi-61) + (srfi-61 macro "srfi-61") (new-catalog "mklibcat") )))) (let* ((req (in-vicinity (library-vicinity) (string-append "require" (scheme-file-suffix))))) - (write* (cons '*SLIB-VERSION* (or (slib:version req) *SLIB-VERSION*)))) + (write* (cons '*slib-version* (or (slib:version req) *slib-version*)))) (display* ")") (let ((load-if-exists diff --git a/peanosfc.scm b/peanosfc.scm index 4a4039a..8c1e1a9 100644 --- a/peanosfc.scm +++ b/peanosfc.scm @@ -19,17 +19,20 @@ (require 'array) +;;@code{(require 'peano-fill)} +;;@ftindex peano-fill + ;;; A. R. Butz. ;;; Space filling curves and mathematical programming. ;;; Information and Control, 12:314-330, 1968. -(define (integer->tet-array scalar rank) +(define (natural->tet-array scalar rank) (do ((tets '() (cons (modulo scl 3) tets)) (scl scalar (quotient scl 3))) ((zero? scl) (let* ((len (length tets)) (depth (quotient (+ len rank -1) rank))) - (define tra (make-array (A:fixN8b 0) rank depth)) + (define tra (make-array (A:fixZ8b 0) rank depth)) (set! tets (reverse tets)) (do ((idx (+ -1 depth) (+ -1 idx))) ((negative? idx)) @@ -40,7 +43,7 @@ (set! tets (cdr tets)))))) tra)))) -(define (tet-array->integer tra) +(define (tet-array->natural tra) (define rank (car (array-dimensions tra))) (define depth (cadr (array-dimensions tra))) (define val 0) @@ -95,15 +98,47 @@ ;;Returns a list of @2 nonnegative integer coordinates corresponding ;;to exact nonnegative integer @1. The lists returned by @0 for @1 ;;arguments 0 and 1 will differ in the first element. -(define (integer->peano-coordinates scalar rank) - (define tra (integer->tet-array scalar rank)) +(define (natural->peano-coordinates scalar rank) + (define tra (natural->tet-array scalar rank)) (peano-flip! tra) (tet-array->coordinates tra)) ;;@body ;;Returns an exact nonnegative integer corresponding to @1, a list of ;;nonnegative integer coordinates. -(define (peano-coordinates->integer coords) +(define (peano-coordinates->natural coords) (define tra (coordinates->tet-array coords)) (peano-flip! tra) - (tet-array->integer tra)) + (tet-array->natural tra)) + +;;@body +;;Returns a list of @2 integer coordinates corresponding to exact +;;integer @1. The lists returned by @0 for @1 arguments 0 and 1 will +;;differ in the first element. +(define (integer->peano-coordinates scalar rank) + (define three^rank (expt 3 rank)) + (do ((edx 1 (* edx three^rank)) + (m 0 (+ 1 m))) + ((>= (quotient edx 2) (abs scalar)) + (let ((tra (natural->tet-array (+ scalar (quotient edx 2)) rank)) + (offset (quotient (expt 3 m) 2))) + (peano-flip! tra) + (map (lambda (k) (* (if (odd? m) -1 1) (- k offset))) + (tet-array->coordinates tra)))))) + +;;@body +;;Returns an exact integer corresponding to @1, a list of integer +;;coordinates. +(define (peano-coordinates->integer coords) + (define cobs (apply max (map abs coords))) + (let loop ((xpo 1)) + (define offset (quotient (expt 3 xpo) 2)) + (if (>= offset cobs) + (let ((tra (coordinates->tet-array + (map (lambda (elt) (+ elt offset)) + coords)))) + (peano-flip! tra) + ((if (odd? xpo) - +) + (- (tet-array->natural tra) + (quotient (expt 3 (* (length coords) xpo)) 2)))) + (loop (+ 1 xpo))))) diff --git a/peanosfc.txi b/peanosfc.txi index 10cc256..5550ebb 100644 --- a/peanosfc.txi +++ b/peanosfc.txi @@ -1,15 +1,33 @@ +@code{(require 'peano-fill)} +@ftindex peano-fill -@defun integer->peano-coordinates scalar rank + +@defun natural->peano-coordinates scalar rank Returns a list of @var{rank} nonnegative integer coordinates corresponding -to exact nonnegative integer @var{scalar}. The lists returned by @code{integer->peano-coordinates} for @var{scalar} +to exact nonnegative integer @var{scalar}. The lists returned by @code{natural->peano-coordinates} for @var{scalar} arguments 0 and 1 will differ in the first element. @end defun -@defun peano-coordinates->integer coords +@defun peano-coordinates->natural coords Returns an exact nonnegative integer corresponding to @var{coords}, a list of nonnegative integer coordinates. @end defun + +@defun integer->peano-coordinates scalar rank + +Returns a list of @var{rank} integer coordinates corresponding to exact +integer @var{scalar}. The lists returned by @code{integer->peano-coordinates} for @var{scalar} arguments 0 and 1 will +differ in the first element. +@end defun + + +@defun peano-coordinates->integer coords + +Returns an exact integer corresponding to @var{coords}, a list of integer +coordinates. +@end defun + diff --git a/phil-spc.scm b/phil-spc.scm index 65863da..ec0bc0f 100644 --- a/phil-spc.scm +++ b/phil-spc.scm @@ -1,5 +1,5 @@ ; "phil-spc.scm": Hilbert space filling mapping -; Copyright (C) 2003 Aubrey Jaffer +; Copyright (C) 2003, 2005 Aubrey Jaffer ; ;Permission to copy this software, to modify it, to redistribute it, ;to distribute modified versions, and to use it for any purpose is @@ -95,21 +95,28 @@ ;;of non-negative integer coordinates. (define (hilbert-coordinates->integer coords . nbits) (define rank (length coords)) - (let ((lst (delaminate-list rank (map integer->gray-code coords))) - (rnkhib (ash 1 (+ -1 rank)))) - (define (loop lst rotation flipbit scalar) - (if (null? lst) - (gray-code->integer scalar) - (let ((chnk (rotate-bit-field (logxor flipbit (car lst)) - (- rotation) 0 rank))) - (loop (cdr lst) - (modulo (+ (log2-binary-factors chnk) 2 rotation) rank) - (ash 1 rotation) - (logior (logxor rnkhib chnk) (ash scalar rank)))))) - (loop (cdr lst) - (modulo (+ (log2-binary-factors (car lst)) 2) rank) - 1 - (car lst)))) + (set! nbits (if (null? nbits) + (* (quotient (+ -1 rank (integer-length (apply max coords))) + rank) + rank) + (car nbits))) + (if (zero? nbits) + 0 + (let ((lst (delaminate-list nbits (map integer->gray-code coords))) + (rnkhib (ash 1 (+ -1 rank)))) + (define (loop lst rotation flipbit scalar) + (if (null? lst) + (gray-code->integer scalar) + (let ((chnk (rotate-bit-field (logxor flipbit (car lst)) + (- rotation) 0 rank))) + (loop (cdr lst) + (modulo (+ (log2-binary-factors chnk) 2 rotation) rank) + (ash 1 rotation) + (logior (logxor rnkhib chnk) (ash scalar rank)))))) + (loop (cdr lst) + (modulo (+ (log2-binary-factors (car lst)) 2) rank) + 1 + (car lst))))) ;;@subsubsection Gray code ;; @@ -183,44 +190,6 @@ ;;@subsubsection Bitwise Lamination ;;@cindex lamination -;;@args k1 @dots{} -;;Returns an integer composed of the bits of @var{k1} @dots{} interlaced -;;in argument order. Given @var{k1}, @dots{} @var{kn}, the n low-order -;;bits of the returned value will be the lowest-order bit of each -;;argument. -;; -;;@args count k -;;Returns a list of @var{count} integers comprised of every @var{count}h -;;bit of the integer @var{k}. -;; -;;@example -;;(map (lambda (k) (number->string k 2)) -;; (bitwise-delaminate 4 #x7654)) -;; @result{} ("0" "1111" "1100" "1010") -;;(number->string (bitwise-laminate 0 #b1111 #b1100 #b1010) 16) -;; @result{} "7654" -;@end example -;; -;;For any non-negative integers @var{k} and @var{count}: -;;@example -;;(eqv? k (bitwise-laminate (bitwise-delaminate count k))) -;;@end example -(define (bitwise-laminate . ks) - (define nks (length ks)) - (define nbs (apply max (map integer-length ks))) - (do ((kdx (+ -1 nbs) (+ -1 kdx)) - (ibs 0 (+ (list->integer (map (lambda (k) (logbit? kdx k)) ks)) - (arithmetic-shift ibs nks)))) - ((negative? kdx) ibs))) -(define (bitwise-delaminate count k) - (define nbs (* count (+ 1 (quotient (integer-length k) count)))) - (do ((kdx (- nbs count) (- kdx count)) - (lst (vector->list (make-vector count 0)) - (map (lambda (k bool) (+ (if bool 1 0) (arithmetic-shift k 1))) - lst - (integer->list (arithmetic-shift k (- kdx)) count)))) - ((negative? kdx) lst))) - ;;@body ;; ;;Returns a list of @var{count} integers comprised of the @var{j}th diff --git a/phil-spc.txi b/phil-spc.txi index ac1743c..62b1bae 100644 --- a/phil-spc.txi +++ b/phil-spc.txi @@ -110,34 +110,6 @@ corresponding predicate of @var{k1} and @var{k2}. @cindex lamination -@defun bitwise-laminate k1 @dots{} -@defunx bitwise-delaminate count k - -Returns an integer composed of the bits of @var{k1} @dots{} interlaced -in argument order. Given @var{k1}, @dots{} @var{kn}, the n low-order -bits of the returned value will be the lowest-order bit of each -argument. - - -@defunx bitwise-laminate count k -Returns a list of @var{count} integers comprised of every @var{count}h -bit of the integer @var{k}. - -@example -(map (lambda (k) (number->string k 2)) - (bitwise-delaminate 4 #x7654)) - @result{} ("0" "1111" "1100" "1010") -(number->string (bitwise-laminate 0 #b1111 #b1100 #b1010) 16) - @result{} "7654" -@end example - -For any non-negative integers @var{k} and @var{count}: -@example -(eqv? k (bitwise-laminate (bitwise-delaminate count k))) -@end example -@end defun - - @defun delaminate-list count ks @@ -432,7 +432,7 @@ ;;; On MS-DOS systems, <ctrl>-Z (26) needs to be ignored in order to ;;; avoid problems at end of files. (case (software-type) - ((MS-DOS) + ((ms-dos) (if (not (char-whitespace? (integer->char 26))) (prec:define-grammar (tok:char-group 0 (integer->char 26) #f)) ))) diff --git a/pscheme.init b/pscheme.init index a4012d2..bc7a5e5 100644 --- a/pscheme.init +++ b/pscheme.init @@ -30,7 +30,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -38,12 +38,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -62,7 +62,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -72,10 +72,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -316,7 +316,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) diff --git a/require.scm b/require.scm index ec97d7a..8ea6bb5 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* "3a2") +(define *slib-version* "3a2") ;;;; MODULES ;@ @@ -28,11 +28,11 @@ (let ((expr (and (file-exists? path) (call-with-input-file path (lambda (port) (read port)))))) (and (list? expr) (= 3 (length expr)) - (eq? (car expr) 'define) (eq? (cadr expr) '*SLIB-VERSION*) + (eq? (car expr) 'define) (eq? (cadr expr) '*slib-version*) (string? (caddr expr)) (caddr expr)))) (define (catalog/require-version-match? slibcat) - (let* ((apair (assq '*SLIB-VERSION* slibcat)) + (let* ((apair (assq '*slib-version* slibcat)) (req (in-vicinity (library-vicinity) (string-append "require" (scheme-file-suffix)))) (reqvers (slib:version req))) @@ -40,7 +40,7 @@ (slib:warn "can't find " req) #f) ((not apair) #f) ((not (equal? reqvers (cdr apair))) #f) - ((not (equal? reqvers *SLIB-VERSION*)) + ((not (equal? reqvers *slib-version*)) (slib:warn "The loaded " req " is stale.") #t) (else #t)))) @@ -245,7 +245,7 @@ (define slib:report-version (lambda () (report:print - 'SLIB *SLIB-VERSION* 'on (scheme-implementation-type) + 'SLIB *slib-version* 'on (scheme-implementation-type) (scheme-implementation-version) 'on (software-type)))) (define slib:report-locations @@ -40,11 +40,31 @@ (next-fx (f next-x))) (cond ((>= (abs next-fx) (abs fx)) x) (else (loop next-x next-fx))))))))))) + +;;(define (integer-sqrt y) +;; (newton:find-integer-root (lambda (x) (- (* x x) y)) +;; (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 y) - (newton:find-integer-root (lambda (x) (- (* x x) y)) - (lambda (x) (* 2 x)) - (ash 1 (quotient (integer-length y) 2)))) +(define (integer-sqrt n) + (cond ((> n 24) (let* ((length/4 (quotient (- (integer-length n) 1) 4)) + (sqrt-top (integer-sqrt (ash n (* -2 length/4)))) + (init-value (ash sqrt-top length/4)) + (q (quotient n init-value)) + (iterated-value (quotient (+ init-value q) 2))) + (if (odd? q) iterated-value + (let ((m (- iterated-value init-value))) + (if (< (remainder n init-value) (* m m)) + (- iterated-value 1) + iterated-value))))) + ((> n 15) 4) ((> n 8) 3) ((> n 3) 2) ((> n 0) 1) ((> n -1) 0) + (else (slib:error 'integer-sqrt n)))) + ;@ (define (newton:find-root f df/dx x_0 prec) (if (and (negative? prec) (integer? prec)) diff --git a/scheme2c.init b/scheme2c.init index 057dc76..1bfbde4 100644 --- a/scheme2c.init +++ b/scheme2c.init @@ -13,7 +13,7 @@ ;; Of course, if you make serious use of library functions you'll want ;; to compile them and use Scheme->C modules. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -31,18 +31,18 @@ (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/local/lib/scheme/") - ((VMS) "scheme$src:") - ((MS-DOS) "C:\\scheme\\"))) + ((unix) "/usr/local/lib/scheme/") + ((vms) "scheme$src:") + ((ms-dos) "C:\\scheme\\"))) ;;; (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 (case (software-type) - ((UNIX) "/usr/local/lib/slib/") - ((VMS) "lib$scheme:") - ((MS-DOS) "C:\\SLIB\\") + ((unix) "/usr/local/lib/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") (else "")))) (lambda () library-path))) @@ -53,7 +53,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -63,7 +63,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -71,12 +71,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -95,7 +95,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -105,10 +105,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -229,13 +229,13 @@ ;;; (FILE-EXISTS? <string>) (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 <string>) (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 @@ -400,7 +400,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) diff --git a/scheme48.init b/scheme48.init index 8f91d54..2b14f30 100644 --- a/scheme48.init +++ b/scheme48.init @@ -52,7 +52,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -100,7 +100,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -108,12 +108,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -132,7 +132,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -142,10 +142,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -422,7 +422,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (case (software-type) - ((NOSVE) (lambda () "_scm")) + ((nosve) (lambda () "_scm")) (else (lambda () ".scm")))) ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever @@ -5,7 +5,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -39,7 +39,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -49,7 +49,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -57,12 +57,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -81,7 +81,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -91,10 +91,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -345,7 +345,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) @@ -1,23 +1,18 @@ -%define name slib -%define version 3a2 -%define release 1 - -Name: %{name} -Release: %{release} -Version: %{version} +Summary: platform independent library for scheme +Name: slib +Version: 3a2 +Release: 2 +Group: Development/Languages +BuildArch: noarch Packager: Aubrey Jaffer <agj@alum.mit.edu> Copyright: distributable, see individual files for copyright Vendor: Aubrey Jaffer <agj @ alum.mit.edu> -Group: Development/Tools Provides: slib -BuildArch: noarch -Summary: platform independent library for scheme Source: ftp://swiss.csail.mit.edu/pub/scm/slib%{version}.zip URL: http://swiss.csail.mit.edu/~jaffer/SLIB.html -BuildRoot: %{_tmppath}/%{name}%{version} -Prefix: /usr +BuildRoot: %{_tmppath}/%{name}-%{version}-root %description "SLIB" is a portable library for the programming language Scheme. @@ -27,73 +22,92 @@ packages for all Scheme implementations. Its catalog can be transparently extended to accomodate packages specific to a site, implementation, user, or directory. -%define __os_install_post /usr/lib/rpm/brp-compress - %prep -%setup -n slib -c -T -cd .. -unzip ${RPM_SOURCE_DIR}/slib%{version}.zip +%setup -q -n %{name} +for i in *; do + cp -f ${i} ${i}.orig + sed -s "s,/usr/local/lib,%{_datadir},g" < ${i} > ${i}.orig + sed -s "s,/usr/lib,%{_datadir},g" < ${i}.orig > ${i} + sed -s "s,/usr/local,/usr,g" < ${i}.orig > ${i} + rm -f ${i}.orig +done %build -gzip -f slib.info +gzip -9nf slib.info %install -mkdir -p ${RPM_BUILD_ROOT}%{prefix}/lib/slib -mkdir -p ${RPM_BUILD_ROOT}%{prefix}/bin -cp -r *.scm *.init *.xyz saturate.txt resenecolours.txt grapheps.ps Makefile ${RPM_BUILD_ROOT}%{prefix}/lib/slib -mkdir -p ${RPM_BUILD_ROOT}/usr/info -cp slib.info.gz ${RPM_BUILD_ROOT}/usr/info - -echo '#! /bin/sh' > ${RPM_BUILD_ROOT}%{prefix}/bin/slib -echo SCHEME_LIBRARY_PATH=%{prefix}/lib/slib/ >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib -echo export SCHEME_LIBRARY_PATH >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib -echo VERSION=%{version} >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib -echo "S48_VICINITY=\"%{prefix}/lib/scheme48\";export S48_VICINITY" >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib -cat slib.sh >> ${RPM_BUILD_ROOT}%{prefix}/bin/slib -chmod +x ${RPM_BUILD_ROOT}%{prefix}/bin/slib +mkdir -p ${RPM_BUILD_ROOT}%{_datadir}/slib +mkdir -p ${RPM_BUILD_ROOT}%{_bindir} +cp *.scm *.init *.xyz *.txt grapheps.ps Makefile ${RPM_BUILD_ROOT}%{_datadir}/slib +mkdir -p ${RPM_BUILD_ROOT}%{_infodir} +install -m644 slib.info.gz ${RPM_BUILD_ROOT}%{_infodir} + +echo '#! /bin/sh' > ${RPM_BUILD_ROOT}%{_bindir}/slib +echo SCHEME_LIBRARY_PATH=%{_datadir}/slib/ >> ${RPM_BUILD_ROOT}%{_bindir}/slib +echo export SCHEME_LIBRARY_PATH >> ${RPM_BUILD_ROOT}%{_bindir}/slib +echo VERSION=%{version} >> ${RPM_BUILD_ROOT}%{_bindir}/slib +echo "S48_VICINITY=\"%{_datadir}/scheme48\";export S48_VICINITY" >> ${RPM_BUILD_ROOT}%{_bindir}/slib +cat slib.sh >> ${RPM_BUILD_ROOT}%{_bindir}/slib +chmod +x ${RPM_BUILD_ROOT}%{_bindir}/slib %clean rm -rf ${RPM_BUILD_ROOT} %post -/sbin/install-info /usr/info/slib.info.gz /usr/info/dir +# /sbin/install-info ${RPM_BUILD_ROOT}%{_infodir}/slib.info.gz %{_infodir}/dir # This symlink is made as in the spec file of Robert J. Meier. if [ -L /usr/share/guile/slib ]; then rm /usr/share/guile/slib - ln -s %{prefix}/lib/slib /usr/share/guile/slib + ln -s %{_datadir}/slib /usr/share/guile/slib fi # Rebuild catalogs for as many implementations as possible. export PATH=$PATH:/usr/local/bin echo PATH=${PATH} -cd %{prefix}/lib/slib/ +cd %{_datadir}/slib/ make catalogs +# %postun +# if [ $1 = 0 ]; then +# /sbin/install-info --delete %{_infodir}/slib.info.gz %{_infodir}/dir +# fi + %preun -cd %{prefix}/lib/slib/ +cd %{_datadir}/slib/ rm -f srcdir.mk slib.image %files %defattr(-, root, root) -%{prefix}/bin/slib -%dir %{prefix}/lib/slib -%{prefix}/lib/slib/*.scm -%{prefix}/lib/slib/*.init -%{prefix}/lib/slib/cie1931.xyz -%{prefix}/lib/slib/cie1964.xyz -%{prefix}/lib/slib/saturate.txt -%{prefix}/lib/slib/resenecolours.txt -%{prefix}/lib/slib/grapheps.ps -/usr/info/slib.info.gz +%{_bindir}/slib +%dir %{_datadir}/slib +%{_datadir}/slib/*.scm +%{_datadir}/slib/*.init +%{_datadir}/slib/cie1931.xyz +%{_datadir}/slib/cie1964.xyz +%{_datadir}/slib/nbs-iscc.txt +%{_datadir}/slib/saturate.txt +%{_datadir}/slib/resenecolours.txt +%{_datadir}/slib/grapheps.ps +%{_infodir}/slib.info.gz # The Makefile is included as it is useful for building documentation. -%{prefix}/lib/slib/Makefile +%{_datadir}/slib/Makefile %doc ANNOUNCE README COPYING FAQ ChangeLog %changelog +* Sun Sep 25 2005 Aubrey Jaffer <agj@alum.mit.edu> +- Updated from RedHat version from Jindrich Novy. + +* Fri Jun 22 2005 Aubrey Jaffer <agj@alum.mit.edu> +- slib.spec (install): Make slib executable. + * Sat Jun 18 2004 Aubrey Jaffer <agj@alum.mit.edu> - Fixed for RPMbuild version 4.3.1 - Make slib executable. +* Thu Nov 03 2002 Aubrey Jaffer <agj@alum.mit.edu> +- slib.spec (%post): Improved catalog-building scripts. +- Make clrnamdb.scm. + * Wed Mar 14 2001 Radey Shouman <shouman@ne.mediaone.net> - Adapted from the spec file of R. J. Meier. @@ -412,11 +412,11 @@ installation to installation, SLIB builds a separate catalog for each implementation it is used with. @noindent -The definition of @code{*SLIB-VERSION*} in SLIB file +The definition of @code{*slib-version*} in SLIB file @file{require.scm} is checked against the catalog association of -@code{*SLIB-VERSION*} to ascertain when versions have changed. It is +@code{*slib-version*} to ascertain when versions have changed. It is a reasonable practice to change the definition of -@code{*SLIB-VERSION*} whenever the library is changed. If multiple +@code{*slib-version*} whenever the library is changed. If multiple implementations of Scheme use SLIB, remember that recompiling one @file{slibcat} will update only that implementation's catalog. @@ -1183,7 +1183,11 @@ Returns the last pair in the list @var{l}. Example: Syntax extensions (macros) included with SLIB. * Define-Structure:: 'structure +* Define-Record-Type:: 'define-record-type, 'srfi-9 * Fluid-Let:: 'fluid-let +* Binding to multiple values:: 'receive, 'srfi-8 +* Guarded LET* special form:: 'and-let*, 'srfi-2 +* Guarded COND Clause:: 'guarded-cond-clause, 'srfi-61 * Yasos:: 'yasos, 'oop, 'collect @end menu @@ -2132,7 +2136,7 @@ Send bug reports, comments, suggestions, and questions to Kent Dybvig -@node Define-Structure, Fluid-Let, Syntax-Case Macros, Scheme Syntax Extension Packages +@node Define-Structure, Define-Record-Type, Syntax-Case Macros, Scheme Syntax Extension Packages @section Define-Structure @code{(require 'structure)} @@ -2195,8 +2199,30 @@ red @end deffn +@node Define-Record-Type, Fluid-Let, Define-Structure, Scheme Syntax Extension Packages +@section Define-Record-Type -@node Fluid-Let, Yasos, Define-Structure, Scheme Syntax Extension Packages +@code{(require 'define-record-type)} or @code{(require 'srfi-9)} +@ftindex srfi-9 +@ftindex define-record-type + +@url{http://srfi.schemers.org/srfi-9/srfi-9.html} + +@defspec define-record-type <type-name> (<constructor-name> <field-tag> ...) <predicate-name> <field-spec> ... + +Where +@lisp +<field-spec> @equiv{} (<field-tag> <accessor-name>) + @equiv{} (<field-tag> <accessor-name> <modifier-name>) + +@end lisp + +@code{define-record-type} is a syntax wrapper for the SLIB +@code{record} module. +@end defspec + + +@node Fluid-Let, Binding to multiple values, Define-Record-Type, Scheme Syntax Extension Packages @section Fluid-Let @code{(require 'fluid-let)} @@ -2224,7 +2250,107 @@ by the rules of lexical scoping) of its corresponding @var{variable}. -@node Yasos, , Fluid-Let, Scheme Syntax Extension Packages +@node Binding to multiple values, Guarded LET* special form, Fluid-Let, Scheme Syntax Extension Packages +@section Binding to multiple values + +@code{(require 'receive)} or @code{(require 'srfi-8)} +@ftindex srfi-8 +@ftindex receive + +@defspec receive formals expression body @dots{} + +@url{http://srfi.schemers.org/srfi-8/srfi-8.html} +@end defspec + + + +@node Guarded LET* special form, Guarded COND Clause, Binding to multiple values, Scheme Syntax Extension Packages +@section Guarded LET* special form + +@code{(require 'and-let*)} or @code{(require 'srfi-2)} +@ftindex srfi-2 +@ftindex and-let* + +@defmac and-let* claws body @dots{} + +@url{http://srfi.schemers.org/srfi-2/srfi-2.html} +@end defmac + + +@node Guarded COND Clause, Yasos, Guarded LET* special form, Scheme Syntax Extension Packages +@section Guarded COND Clause + +@code{(require 'guarded-cond-clause)} or @code{(require 'srfi-61)} +@ftindex srfi-61 +@ftindex guarded-cond-clause + +@url{http://srfi.schemers.org/srfi-61/srfi-61.html} + +@deffn {library syntax} cond <clause1> <clause2> @dots{} + +@emph{Syntax:} +Each @r{<clause>} should be of the form + +@format +@t{(@r{<test>} @r{<expression1>} @dots{}) +} +@end format + +where @r{<test>} is any expression. Alternatively, a @r{<clause>} may be +of the form + +@format +@t{(@r{<test>} => @r{<expression>}) +} +@end format + +The @r{<clause>} production in the formal syntax of Scheme as +written by R5RS in section 7.1.3 is extended with a new option: +@cindex @w{=>} + +@format +@t{@r{<clause>} => (@r{<generator>} @r{<guard>} => @r{<receiver>}) +} +@end format + +where @r{<generator>}, @r{<guard>}, & @r{<receiver>} are all +@r{<expression>}s. + +@quotation +Clauses of this form have the following semantics: @r{<generator>} is +evaluated. It may return arbitrarily many values. @r{<Guard>} is +applied to an argument list containing the values in order that +@r{<generator>} returned. If @r{<guard>} returns a true value for +that argument list, @r{<receiver>} is applied with an equivalent +argument list. If @r{<guard>} returns a false value, however, the +clause is abandoned and the next one is tried. +@end quotation + +The last @r{<clause>} may be +an ``else clause,'' which has the form + +@format +@t{(else @r{<expression1>} @r{<expression2>} @dots{})@r{.} +} +@end format +@end deffn + +@noindent +This @code{port->char-list} procedure accepts an input port and +returns a list of all the characters it produces until the end. + +@example +(define (port->char-list port) + (cond ((read-char port) char? + => (lambda (c) (cons c (port->char-list port)))) + (else '()))) + +(call-with-input-string "foo" port->char-list) ==> (#\f #\o #\o) +@end example + + + +@node Yasos, , Guarded COND Clause, Scheme Syntax Extension Packages @section Yasos @c Much of the documentation in this section was written by Dave Love @@ -2516,6 +2642,8 @@ value is unspecified. @result{} 2 @end lisp + + @node Textual Conversion Packages, Mathematical Packages, Scheme Syntax Extension Packages, Top @chapter Textual Conversion Packages @@ -4698,6 +4826,7 @@ match the arguments to @code{encode-universal-time}. * Color:: * Root Finding:: 'root * Minimizing:: 'minimize +* The Limit:: 'limit * Commutative Rings:: 'commutative-ring * Matrix Algebra:: 'determinant @end menu @@ -6183,6 +6312,11 @@ Resene Paints Ltd. @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 @@ -6203,11 +6337,6 @@ To find the closest integer to a given integer's square root: @end example @end defun -@defun integer-sqrt y -Given a non-negative integer @var{y}, returns the rounded square-root of -@var{y}. -@end defun - @defun newton:find-root f df/dx x0 prec Given real valued procedures @var{f}, @var{df/dx} of one (real) argument, initial real value @var{x0} for which @var{df/dx}(@var{x0}) is @@ -6287,7 +6416,7 @@ iterations performed so far. @var{prec} should return non-false if the iteration should be stopped. @end defun -@node Minimizing, Commutative Rings, Root Finding, Mathematical Packages +@node Minimizing, The Limit, Root Finding, Mathematical Packages @section Minimizing @code{(require 'minimize)} @@ -6296,7 +6425,13 @@ if the iteration should be stopped. @include minimize.txi -@node Commutative Rings, Matrix Algebra, Minimizing, Mathematical Packages +@node The Limit, Commutative Rings, Minimizing, Mathematical Packages +@section The Limit + +@include limit.texi + + +@node Commutative Rings, Matrix Algebra, The Limit, Mathematical Packages @section Commutative Rings Scheme provides a consistent and capable set of numeric functions. @@ -8835,6 +8970,7 @@ operation is equivalent to * Arrays:: 'array * Subarrays:: 'subarray * Array Mapping:: 'array-for-each +* Array Interpolation:: 'array-interpolate * Association Lists:: 'alist * Byte:: 'byte * Byte/Number Conversions:: 'byte-number @@ -8864,13 +9000,19 @@ operation is equivalent to @include subarray.txi -@node Array Mapping, Association Lists, Subarrays, Data Structures +@node Array Mapping, Array Interpolation, Subarrays, Data Structures @subsection Array Mapping @include arraymap.txi -@node Association Lists, Byte, Array Mapping, Data Structures +@node Array Interpolation, Association Lists, Array Mapping, Data Structures +@subsection Array Interpolation + +@include linterp.txi + + +@node Association Lists, Byte, Array Interpolation, Data Structures @subsection Association Lists @include alist.txi @@ -11234,48 +11376,24 @@ unspecified. @menu * SRFI-1:: list-processing -* SRFI-2:: guarded LET* special form -* SRFI-8:: Binding to multiple values -* SRFI-9:: Defining Record Types @end menu -SRFI-47 is the same as @ref{Arrays}. +@itemize @bullet +@item SRFI-2 @ref{Guarded LET* special form} +@item SRFI-8 @ref{Binding to multiple values} +@item SRFI-9 @ref{Define-Record-Type} +@item SRFI-47 @ref{Arrays} +@item SRFI-59 @ref{Vicinity} +@item SRFI-63 @ref{Arrays} +@item SRFI-60 @ref{Bit-Twiddling} +@item SRFI-61 @ref{Guarded COND Clause} +@end itemize -@node SRFI-1, SRFI-2, SRFI, SRFI +@node SRFI-1, , SRFI, SRFI @subsubsection SRFI-1 @include srfi-1.txi -@node SRFI-2, SRFI-8, SRFI-1, SRFI -@subsubsection SRFI-2 - -@include srfi-2.txi - -@node SRFI-8, SRFI-9, SRFI-2, SRFI -@subsubsection SRFI-8 - -@include srfi-8.txi - -@node SRFI-9, , SRFI-8, SRFI -@subsubsection SRFI-9 - -@code{(require 'srfi-9)} -@ftindex srfi-9 - -@url{http://srfi.schemers.org/srfi-9/srfi-9.html} - -@defspec define-record-type <type-name> (<constructor-name> <field-tag> ...) <predicate-name> <field spec> ... - -Where -@lisp -<field-spec> @equiv{} (<field-tag> <accessor-name>) - @equiv{} (<field-tag> <accessor-name> <modifier-name>) - -@end lisp - -@code{define-record-type} is a syntax wrapper for the SLIB -@code{record} module. -@end defspec @node Session Support, System Interface, Standards Support, Other Packages diff --git a/srfi-61.scm b/srfi-61.scm new file mode 100644 index 0000000..015320b --- /dev/null +++ b/srfi-61.scm @@ -0,0 +1,49 @@ +;;; "srfi-61.scm" -- A more general cond clause -*- Scheme -*- + +;;; Public domain +;;; Author: Taylor Campbell +;;; URL:http://srfi.schemers.org/srfi-61/srfi-61.html + +;@ +(define-syntax cond + (syntax-rules (=> else) + + ((cond (else else1 else2 ...)) + ;; The (IF #T (BEGIN ...)) wrapper ensures that there may be no + ;; internal definitions in the body of the clause. R5RS mandates + ;; this in text (by referring to each subform of the clauses as + ;; <expression>) but not in its reference implementation of COND, + ;; which just expands to (BEGIN ...) with no (IF #T ...) wrapper. + (if #t (begin else1 else2 ...))) + + ((cond (test => receiver) more-clause ...) + (let ((T test)) + (cond/maybe-more T + (receiver T) + more-clause ...))) + + ((cond (generator guard => receiver) more-clause ...) + (call-with-values (lambda () generator) + (lambda T + (cond/maybe-more (apply guard T) + (apply receiver T) + more-clause ...)))) + + ((cond (test) more-clause ...) + (let ((T test)) + (cond/maybe-more T T more-clause ...))) + + ((cond (test body1 body2 ...) more-clause ...) + (cond/maybe-more test + (begin body1 body2 ...) + more-clause ...)))) + +(define-syntax cond/maybe-more + (syntax-rules () + ((cond/maybe-more test consequent) + (if test + consequent)) + ((cond/maybe-more test consequent clause ...) + (if test + consequent + (cond clause ...))))) @@ -22,15 +22,6 @@ ;; ;;@noindent Implements @dfn{Scheme Request For Implementation} (SRFI) as ;;described at @url{http://srfi.schemers.org/} -;; -;;@noindent The Copyright terms of each SRFI states: -;;@quotation -;;"However, this document itself may not be modified in any way, ..." -;;@end quotation -;; -;;@noindent Therefore, the specification of SRFI constructs must not be -;;quoted without including the complete SRFI document containing -;;discussion and a sample implementation program. ;;@args <clause1> <clause2> @dots{} ;; @@ -5,15 +5,6 @@ @cindex Scheme Request For Implementation described at @url{http://srfi.schemers.org/} -@noindent The Copyright terms of each SRFI states: -@quotation -"However, this document itself may not be modified in any way, ..." -@end quotation - -@noindent Therefore, the specification of SRFI constructs must not be -quoted without including the complete SRFI document containing -discussion and a sample implementation program. - @defmac cond-expand <clause1> <clause2> @dots{} @@ -10,7 +10,7 @@ ;;; This is provided with ABSOLUTELY NO GUARANTEE. (herald t3) -(define (software-type) 'UNIX) +(define (software-type) 'unix) (define (scheme-implementation-type) 'T) @@ -52,7 +52,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -60,12 +60,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -89,7 +89,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -99,10 +99,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ diff --git a/transact.scm b/transact.scm index 83b37a7..3533aa3 100644 --- a/transact.scm +++ b/transact.scm @@ -148,7 +148,7 @@ (define (file-lock:certificate path) (or (case (software-type) - ((UNIX COHERENT PLAN9) + ((unix coherent plan9) (emacs-lock:certificate (emacs-lock:path path))) (else #f)) (word-lock:certificate (word-lock:path path)))) @@ -225,7 +225,7 @@ (not (file-lock:certificate path)) (let ((wl (word:lock! path email))) (case (software-type) - ((UNIX COHERENT PLAN9) + ((unix coherent plan9) ;; file-system may not support symbolic links. (or (and (provided? 'current-time) (emacs:lock! path email)) wl)) @@ -252,7 +252,7 @@ (let ((e-path (emacs-lock:path path))) (define e-cert (emacs-lock:certificate e-path)) (case (software-type) - ((UNIX COHERENT PLAN9) + ((unix coherent plan9) (cond ((not (equal? e-cert certificate)) (slib:warn 'file-unlock! e-path 'mismatch certificate) #f) @@ -354,8 +354,8 @@ (+ 2 (length args)) 'args)))) (define backup-style (if (null? args) #f (car args))) (define move (case (software-type) - ((UNIX COHERENT PLAN9) "mv -f") - ((MS-DOS WINDOWS OS/2 ATARIST) "MOVE /Y") + ((unix coherent plan9) "mv -f") + ((ms-dos windows os/2 atarist) "MOVE /Y") (else (slib:error (software-type) 'move?)))) (define (move? tmpfn path) (eqv? 0 (system (sprintf #f "%s %#a %#a" move tmpfn path)))) @@ -471,13 +471,13 @@ (define hostname (getenv "HOSTNAME")) ;with domain (cond ((and user hostname) (string-append user "@" hostname)) (else (case (software-type) - ;;((AMIGA) ) - ;;((MACOS THINKC) ) - ((MS-DOS WINDOWS OS/2 ATARIST) + ;;((amiga) ) + ;;((macos thinkc) ) + ((ms-dos windows os/2 atarist) (windows:user-email-address user hostname)) - ;;((NOSVE) ) - ;;((VMS) ) - ((UNIX COHERENT PLAN9) + ;;((nosve) ) + ;;((vms) ) + ((unix coherent plan9) (call-with-tmpnam (lambda (tmp) (if (not user) (set! user (system->line "whoami" tmp))) diff --git a/umbscheme.init b/umbscheme.init index 9794d80..f531605 100644 --- a/umbscheme.init +++ b/umbscheme.init @@ -9,7 +9,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -30,9 +30,9 @@ ;;; implementation reside. (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/lib/umb-scheme/") - ((VMS) "scheme$src:") - ((MS-DOS) "C:\\scheme\\"))) + ((unix) "/usr/lib/umb-scheme/") + ((vms) "scheme$src:") + ((ms-dos) "C:\\scheme\\"))) ;;; (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. @@ -44,9 +44,9 @@ ;; Use this path if your scheme does not support GETENV ;; or if SCHEME_LIBRARY_PATH is not set. (case (software-type) - ((UNIX) "/usr/lib/umb-scheme/slib/") - ((VMS) "lib$scheme:") - ((MS-DOS) "C:\\SLIB\\") + ((unix) "/usr/lib/umb-scheme/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -59,7 +59,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -67,12 +67,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -91,7 +91,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -101,10 +101,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -219,7 +219,7 @@ ;;(define (file-exists? f) #f) (define file-exists? (case (software-type) - ((UNIX) + ((unix) (lambda (f) (zero? (system (string-append "test -r " f))))) (else @@ -229,7 +229,7 @@ ;;(define (delete-file f) #f) (define delete-file (case (software-type) - ((UNIX) + ((unix) (lambda (f) (zero? (system (string-append "rm " f))))) (else @@ -344,7 +344,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) @@ -36,7 +36,7 @@ ;;; (software-type) should be set to the generic operating system type. ;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported. -(define (software-type) 'UNIX) +(define (software-type) 'unix) ;;; (scheme-implementation-type) should return the name of the scheme ;;; implementation loading this file. @@ -57,9 +57,9 @@ ;;; implementation reside. (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/local/src/scheme/") - ((VMS) "scheme$src:") - ((MS-DOS) "C:\\scheme\\"))) + ((unix) "/usr/local/src/scheme/") + ((vms) "scheme$src:") + ((ms-dos) "C:\\scheme\\"))) ;;; (library-vicinity) should be defined to be the pathname of the ;;; directory where files of Scheme library functions reside. @@ -68,9 +68,9 @@ (or (getenv "SCHEME_LIBRARY_PATH") ;; Uses this path if SCHEME_LIBRARY_PATH is not set. (case (software-type) - ((UNIX) "/usr/local/lib/slib/") - ((VMS) "lib$scheme:") - ((MS-DOS) "C:\\SLIB\\") + ((unix) "/usr/local/lib/slib/") + ((vms) "lib$scheme:") + ((ms-dos) "C:\\SLIB\\") (else ""))))) (lambda () library-path))) @@ -81,7 +81,7 @@ (let ((home (getenv "HOME"))) (and home (case (software-type) - ((UNIX COHERENT MS-DOS) ;V7 unix has a / on HOME + ((unix coherent ms-dos) ;V7 unix has a / on HOME (if (eqv? #\/ (string-ref home (+ -1 (string-length home)))) home (string-append home "/"))) @@ -91,7 +91,7 @@ ;@ (define (user-vicinity) (case (software-type) - ((VMS) "[.]") + ((vms) "[.]") (else ""))) (define *load-pathname* #f) @@ -99,12 +99,12 @@ (define vicinity:suffix? (let ((suffi (case (software-type) - ((AMIGA) '(#\: #\/)) - ((MACOS THINKC) '(#\:)) - ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/)) - ((NOSVE) '(#\: #\.)) - ((UNIX COHERENT PLAN9) '(#\/)) - ((VMS) '(#\: #\])) + ((amiga) '(#\: #\/)) + ((macos thinkc) '(#\:)) + ((ms-dos windows atarist os/2) '(#\\ #\/)) + ((nosve) '(#\: #\.)) + ((unix coherent plan9) '(#\/)) + ((vms) '(#\: #\])) (else (slib:warn "require.scm" 'unknown 'software-type (software-type)) "/")))) @@ -123,7 +123,7 @@ ;@ (define sub-vicinity (case (software-type) - ((VMS) (lambda + ((vms) (lambda (vic name) (let ((l (string-length vic))) (if (or (zero? (string-length vic)) @@ -133,10 +133,10 @@ "." name "]"))))) (else (let ((*vicinity-suffix* (case (software-type) - ((NOSVE) ".") - ((MACOS THINKC) ":") - ((MS-DOS WINDOWS ATARIST OS/2) "\\") - ((UNIX COHERENT PLAN9 AMIGA) "/")))) + ((nosve) ".") + ((macos thinkc) ":") + ((ms-dos windows atarist os/2) "\\") + ((unix coherent plan9 amiga) "/")))) (lambda (vic name) (string-append vic name *vicinity-suffix*)))))) ;@ @@ -463,7 +463,7 @@ ;;; Here for backward compatability (define scheme-file-suffix (let ((suffix (case (software-type) - ((NOSVE) "_scm") + ((nosve) "_scm") (else ".scm")))) (lambda () suffix))) |