summaryrefslogtreecommitdiffstats
path: root/require.scm
diff options
context:
space:
mode:
authorThomas Bushnell, BSG <tb@debian.org>2005-11-02 14:55:21 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:32 -0800
commit34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73 (patch)
tree1189d06a81277bcf8539b0260a69a19f6038effb /require.scm
parent611b3db17894e5fdc0db3d49eaf6743d27b44233 (diff)
parent5145dd3aa0c02c9fc496d1432fc4410674206e1d (diff)
downloadslib-34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73.tar.gz
slib-34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73.zip
Import Debian changes 3a2-1debian/3a2-1
slib (3a2-1) unstable; urgency=low * New upstream release. * Acknowledge NMU. (Closes: #281809) * Makefile: Don't hack Makefile; use rules instead. * debian/rules: Set on make invocations: prefix, htmldir, TEXI2HTML. * debian/rules (clean): Clean more stuff here. * Makefile: Comment out old rule for $(htmldir)slib_toc.html. Instead, specify directly that the texi2html invocation produces that file. * debian/rules (binary-indep): Find web files in slib subdir. * debian/control (Build-Depends-Indep): Go back to using scm.
Diffstat (limited to 'require.scm')
-rw-r--r--require.scm97
1 files changed, 28 insertions, 69 deletions
diff --git a/require.scm b/require.scm
index a11cbf5..ec97d7a 100644
--- a/require.scm
+++ b/require.scm
@@ -1,5 +1,5 @@
;;;; Implementation of VICINITY and MODULES for Scheme
-;Copyright (C) 1991, 1992, 1993, 1994, 1997, 2002, 2003 Aubrey Jaffer
+;Copyright (C) 1991, 1992, 1993, 1994, 1997, 2002, 2003, 2005 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
@@ -17,69 +17,7 @@
;promotional, or sales literature without prior written consent in
;each case.
;@
-(define *SLIB-VERSION* "3a1")
-;@
-(define (user-vicinity)
- (case (software-type)
- ((VMS) "[.]")
- (else "")))
-;@
-(define *load-pathname* #f)
-;@
-(define vicinity:suffix?
- (let ((suffi
- (case (software-type)
- ((AMIGA) '(#\: #\/))
- ((MACOS THINKC) '(#\:))
- ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/))
- ((NOSVE) '(#\: #\.))
- ((UNIX COHERENT PLAN9) '(#\/))
- ((VMS) '(#\: #\])))))
- (lambda (chr) (and (memv chr suffi) #t))))
-;@
-(define (pathname->vicinity pathname)
- (let loop ((i (- (string-length pathname) 1)))
- (cond ((negative? i) "")
- ((vicinity:suffix? (string-ref pathname i))
- (substring pathname 0 (+ i 1)))
- (else (loop (- i 1))))))
-(define (program-vicinity)
- (if *load-pathname*
- (pathname->vicinity *load-pathname*)
- (slib:error 'program-vicinity " called; use slib:load to load")))
-;@
-(define sub-vicinity
- (case (software-type)
- ((VMS) (lambda
- (vic name)
- (let ((l (string-length vic)))
- (if (or (zero? (string-length vic))
- (not (char=? #\] (string-ref vic (- l 1)))))
- (string-append vic "[" name "]")
- (string-append (substring vic 0 (- l 1))
- "." name "]")))))
- (else (let ((*vicinity-suffix*
- (case (software-type)
- ((NOSVE) ".")
- ((MACOS THINKC) ":")
- ((MS-DOS WINDOWS ATARIST OS/2) "\\")
- ((UNIX COHERENT PLAN9 AMIGA) "/"))))
- (lambda (vic name)
- (string-append vic name *vicinity-suffix*))))))
-;@
-(define (make-vicinity <pathname>) <pathname>)
-
-(define (slib:pathnameize-load *old-load*)
- (lambda (<pathname> . extra)
- (let ((old-load-pathname *load-pathname*))
- (set! *load-pathname* <pathname>)
- (apply *old-load* (cons <pathname> extra))
- (set! *load-pathname* old-load-pathname))))
-
-(set! slib:load-source
- (slib:pathnameize-load slib:load-source))
-(set! slib:load
- (slib:pathnameize-load slib:load))
+(define *SLIB-VERSION* "3a2")
;;;; MODULES
;@
@@ -183,7 +121,8 @@
(feval expression))
;@
(define (provided? expression)
- (define feature-list (cons (software-type) *features*))
+ (define feature-list (cons (scheme-implementation-type)
+ (cons (software-type) *features*)))
(define (provided? expression)
(if (memq expression feature-list) #t
(and *catalog*
@@ -242,7 +181,6 @@
(define require:provided? provided?)
(define require:require require)
-(slib:provide 'vicinity)
(if (and (string->number "0.0") (inexact? (string->number "0.0")))
(slib:provide 'inexact))
(if (rational? (string->number "1/19")) (slib:provide 'rational))
@@ -253,6 +191,7 @@
(cond
((slib:provided? 'srfi)
+ (slib:provide 'srfi-59)
(do ((idx 0 (+ 1 idx))
(srfis (symbol->string 'srfi-)))
((> idx 100))
@@ -260,11 +199,33 @@
(if (slib:eval `(cond-expand (,srfi #t) (else #f)))
(slib:provide srfi))))))
+(define (slib:pathnameize-load *old-load*)
+ (lambda (<pathname> . extra)
+ (with-load-pathname <pathname>
+ (lambda ()
+ (apply *old-load* (cons <pathname> extra))))))
+
+(set! slib:load-source
+ (slib:pathnameize-load slib:load-source))
+(set! slib:load
+ (slib:pathnameize-load slib:load))
+
+;@
+(define (slib:eval-load <pathname> evl)
+ (if (not (file-exists? <pathname>))
+ (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+ (call-with-input-file <pathname>
+ (lambda (port)
+ (with-load-pathname <pathname>
+ (lambda ()
+ (do ((o (read port) (read port)))
+ ((eof-object? o))
+ (evl o)))))))
+
(define report:print
(lambda args
(for-each (lambda (x) (write x) (display #\ )) args)
(newline)))
-
;@
(define slib:report
(let ((slib:report (lambda () (slib:report-version) (slib:report-locations))))
@@ -295,8 +256,6 @@
(report:print '(IMPLEMENTATION-VICINITY) 'is (implementation-vicinity))
(report:print '(LIBRARY-VICINITY) 'is (library-vicinity))
(report:print '(SCHEME-FILE-SUFFIX) 'is (scheme-file-suffix))
- (cond (*load-pathname*
- (report:print '*LOAD-PATHNAME* 'is *load-pathname*)))
(let* ((i (+ -1 5)))
(cond ((eq? (car features) (car *features*)))
(else (report:print 'loaded '*FEATURES* ':) (display slib:tab)))