diff options
Diffstat (limited to 'require.scm')
| -rw-r--r-- | require.scm | 97 |
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))) |