Hey Andy,
> I don't know, all that code is tricky. How about having
> find-versioned-module return a tail instead of a full path, then pass
> that tail to primitive-load-path? It will cause some slight duplication
> of effort but it will find the .go correctly.
Sure! Find attached an implementation of `find-versioned-module' that
does precisely that -- although it looks like we've gone in a slightly
different direction since this email was written... ;-)
Regards,
Julian
(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-pair)
(let* ((file (in-vicinity (car file-pair)
(cdr file-pair)))
(s (false-if-exception (stat file))))
(and s (eq? (stat:type s) 'regular))))
(map (lambda (ext)
(cons (cadr pair)
(in-vicinity (cddr pair)
(string-append 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 (in-vicinity (cddr root-pair) entry))
(dir (in-vicinity (cadr root-pair) subdir))
(num (string->number entry))
(num (and num (exact? num)
(append (car root-pair) (list num)))))
(if (and num (eq? (stat:type (stat dir)) 'directory))
(filter-subdir root-pair dstrm
(cons (cons num (cons (cadr root-pair)
subdir))
subdir-pairs))
(filter-subdir root-pair dstrm subdir-pairs))))))
(or (and (null? root-pairs) ret)
(let* ((rp (car root-pairs))
(dir (in-vicinity (cadr rp) (cddr rp)))
(dstrm (false-if-exception (opendir dir))))
(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 '() (cons 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."))
(cddar (sort matches subdir-pair-less))))
