summaryrefslogtreecommitdiffstats
path: root/require.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
commit5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch)
tree540afc30c51da085f5bd8ec3f4c89f6496e7900d /require.scm
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.tar.gz
slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.zip
Import Upstream version 3a2upstream/3a2
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)))