mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
remove encoding of versions into the file system (for now?)
* module/ice-9/boot-9.scm (find-versioned-module): Remove. Still had some bugs (e.g. for "." in the path and in finding compiled files), did too much computation and statting, and we don't really want to promote versioning. Nor do we want to hard-code a particular encoding of versions in the file-system. Perhaps the real way to do this is to be extensible somehow. (try-module-autoload): Just dispatch to primitive-load-path in all cases. * module/rnrs * module/rnrs.scm: * module/rnrs/arithmetic/bitwise.scm: * module/rnrs/arithmetic/fixnums.scm: * module/rnrs/arithmetic/flonums.scm: * module/rnrs/base.scm: * module/rnrs/conditions.scm: * module/rnrs/control.scm: * module/rnrs/enums.scm: * module/rnrs/eval.scm: * module/rnrs/exceptions.scm: * module/rnrs/files.scm: * module/rnrs/hashtables.scm: * module/rnrs/io/simple.scm: * module/rnrs/lists.scm: * module/rnrs/mutable-pairs.scm: * module/rnrs/mutable-strings.scm: * module/rnrs/programs.scm: * module/rnrs/r5rs.scm: * module/rnrs/records/inspection.scm: * module/rnrs/records/procedural.scm: * module/rnrs/records/syntactic.scm: * module/rnrs/sorting.scm: * module/rnrs/syntax-case.scm: * module/rnrs/unicode.scm: Move these files, eliding the "6/" infix, so that they are in the normal (unversioned) module path.
This commit is contained in:
parent
e5602ce73e
commit
e44d2e4d98
26 changed files with 32 additions and 94 deletions
|
@ -258,32 +258,32 @@ SRFI_SOURCES = \
|
|||
srfi/srfi-98.scm
|
||||
|
||||
RNRS_SOURCES = \
|
||||
6/rnrs.scm \
|
||||
rnrs/6/base.scm \
|
||||
rnrs/6/conditions.scm \
|
||||
rnrs/6/control.scm \
|
||||
rnrs/6/enums.scm \
|
||||
rnrs/6/eval.scm \
|
||||
rnrs/6/exceptions.scm \
|
||||
rnrs/6/files.scm \
|
||||
rnrs/6/hashtables.scm \
|
||||
rnrs/6/lists.scm \
|
||||
rnrs/6/mutable-pairs.scm \
|
||||
rnrs/6/mutable-strings.scm \
|
||||
rnrs/6/programs.scm \
|
||||
rnrs/6/r5rs.scm \
|
||||
rnrs/6/sorting.scm \
|
||||
rnrs/6/syntax-case.scm \
|
||||
rnrs/6/unicode.scm \
|
||||
rnrs/arithmetic/6/bitwise.scm \
|
||||
rnrs/arithmetic/6/fixnums.scm \
|
||||
rnrs/arithmetic/6/flonums.scm \
|
||||
rnrs.scm \
|
||||
rnrs/base.scm \
|
||||
rnrs/conditions.scm \
|
||||
rnrs/control.scm \
|
||||
rnrs/enums.scm \
|
||||
rnrs/eval.scm \
|
||||
rnrs/exceptions.scm \
|
||||
rnrs/files.scm \
|
||||
rnrs/hashtables.scm \
|
||||
rnrs/lists.scm \
|
||||
rnrs/mutable-pairs.scm \
|
||||
rnrs/mutable-strings.scm \
|
||||
rnrs/programs.scm \
|
||||
rnrs/r5rs.scm \
|
||||
rnrs/sorting.scm \
|
||||
rnrs/syntax-case.scm \
|
||||
rnrs/unicode.scm \
|
||||
rnrs/arithmetic/bitwise.scm \
|
||||
rnrs/arithmetic/fixnums.scm \
|
||||
rnrs/arithmetic/flonums.scm \
|
||||
rnrs/bytevectors.scm \
|
||||
rnrs/io/6/simple.scm \
|
||||
rnrs/io/simple.scm \
|
||||
rnrs/io/ports.scm \
|
||||
rnrs/records/6/inspection.scm \
|
||||
rnrs/records/6/procedural.scm \
|
||||
rnrs/records/6/syntactic.scm
|
||||
rnrs/records/inspection.scm \
|
||||
rnrs/records/procedural.scm \
|
||||
rnrs/records/syntactic.scm
|
||||
|
||||
EXTRA_DIST += scripts/ChangeLog-2008
|
||||
EXTRA_DIST += scripts/README
|
||||
|
|
|
@ -2196,71 +2196,6 @@ If there is no handler at all, Guile prints an error and then exits."
|
|||
((not) (not (matches? (cadr version-ref))))
|
||||
(else (sub-versions-match? version-ref target))))))
|
||||
|
||||
(define (find-versioned-module dir-hint name version-ref roots)
|
||||
(define (subdir-pair-less pair1 pair2)
|
||||
(define (numlist-less lst1 lst2)
|
||||
(or (null? lst2)
|
||||
(and (not (null? lst1))
|
||||
(cond ((> (car lst1) (car lst2)) #t)
|
||||
((< (car lst1) (car lst2)) #f)
|
||||
(else (numlist-less (cdr lst1) (cdr lst2)))))))
|
||||
(not (numlist-less (car pair2) (car pair1))))
|
||||
(define (match-version-and-file pair)
|
||||
(and (version-matches? version-ref (car pair))
|
||||
(let ((filenames
|
||||
(filter (lambda (file)
|
||||
(let ((s (false-if-exception (stat file))))
|
||||
(and s (eq? (stat:type s) 'regular))))
|
||||
(map (lambda (ext)
|
||||
(string-append (cdr pair) name ext))
|
||||
%load-extensions))))
|
||||
(and (not (null? filenames))
|
||||
(cons (car pair) (car filenames))))))
|
||||
|
||||
(define (match-version-recursive root-pairs leaf-pairs)
|
||||
(define (filter-subdirs root-pairs ret)
|
||||
(define (filter-subdir root-pair dstrm subdir-pairs)
|
||||
(let ((entry (readdir dstrm)))
|
||||
(if (eof-object? entry)
|
||||
subdir-pairs
|
||||
(let* ((subdir (string-append (cdr root-pair) entry))
|
||||
(num (string->number entry))
|
||||
(num (and num (exact? num) (append (car root-pair)
|
||||
(list num)))))
|
||||
(if (and num (eq? (stat:type (stat subdir)) 'directory))
|
||||
(filter-subdir
|
||||
root-pair dstrm (cons (cons num (string-append subdir "/"))
|
||||
subdir-pairs))
|
||||
(filter-subdir root-pair dstrm subdir-pairs))))))
|
||||
|
||||
(or (and (null? root-pairs) ret)
|
||||
(let* ((rp (car root-pairs))
|
||||
(dstrm (false-if-exception (opendir (cdr rp)))))
|
||||
(if dstrm
|
||||
(let ((subdir-pairs (filter-subdir rp dstrm '())))
|
||||
(closedir dstrm)
|
||||
(filter-subdirs (cdr root-pairs)
|
||||
(or (and (null? subdir-pairs) ret)
|
||||
(append ret subdir-pairs))))
|
||||
(filter-subdirs (cdr root-pairs) ret)))))
|
||||
|
||||
(or (and (null? root-pairs) leaf-pairs)
|
||||
(let ((matching-subdir-pairs (filter-subdirs root-pairs '())))
|
||||
(match-version-recursive
|
||||
matching-subdir-pairs
|
||||
(append leaf-pairs (filter pair? (map match-version-and-file
|
||||
matching-subdir-pairs)))))))
|
||||
(define (make-root-pair root)
|
||||
(cons '() (string-append root "/" dir-hint)))
|
||||
|
||||
(let* ((root-pairs (map make-root-pair roots))
|
||||
(matches (if (null? version-ref)
|
||||
(filter pair? (map match-version-and-file root-pairs))
|
||||
'()))
|
||||
(matches (append matches (match-version-recursive root-pairs '()))))
|
||||
(and (null? matches) (error "No matching modules found."))
|
||||
(cdar (sort matches subdir-pair-less))))
|
||||
|
||||
(define (make-fresh-user-module)
|
||||
(let ((m (make-module)))
|
||||
(beautify-user-module! m)
|
||||
|
@ -2601,10 +2536,13 @@ module '(ice-9 q) '(make-q q-length))}."
|
|||
;; The initial environment when loading a module is a fresh
|
||||
;; user module.
|
||||
(set-current-module (make-fresh-user-module))
|
||||
(if version
|
||||
(load (find-versioned-module
|
||||
dir-hint name version %load-path))
|
||||
(primitive-load-path (in-vicinity dir-hint name) #f))
|
||||
;; Here we could allow some other search strategy (other than
|
||||
;; primitive-load-path), for example using versions encoded
|
||||
;; into the file system -- but then we would have to figure
|
||||
;; out how to locate the compiled file, do autocompilation,
|
||||
;; etc. Punt for now, and don't use versions when locating
|
||||
;; the file.
|
||||
(primitive-load-path (in-vicinity dir-hint name) #f)
|
||||
(set! didit #t)))))
|
||||
(lambda () (set-autoloaded! dir-hint name didit)))
|
||||
didit))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue