[plt-scheme] *.mzscheme.{ss,sls} patch
Here's a better patch which traverses the files list only once, like the
original; otherwise it's the same.
--
: Derick
----------------------------------------------------------------
diff -u -b -r plt-3.99.0.23/collects/r6rs/private/find-version.ss plt-3.99.0.23--more-r6rs-exts/collects/r6rs/private/find-version.ss
--- plt-3.99.0.23/collects/r6rs/private/find-version.ss 2008-02-15 14:27:54.000000000 -0800
+++ plt-3.99.0.23--more-r6rs-exts/collects/r6rs/private/find-version.ss 2008-04-13 04:06:21.000000000 -0700
@@ -15,31 +15,46 @@
(map
(lambda (file)
(let ([s (path-element->bytes file)])
+ (and
(and (len . < . (bytes-length s))
- (regexp-match? #rx#"[.]ss$" s)
- (bytes=? p (subbytes s 0 len))
- (or (and (= (bytes-length s) (+ len 3))
- null)
- (let ([vers (subbytes s len (- (bytes-length s) 3))])
+ (bytes=? p (subbytes s 0 len)))
+ (let ([ext (let ([m (regexp-match #rx#"([.][a-z]+)?[.](ss|sls)$"
+ (subbytes s len))])
+ (and m
+ (or (not (cadr m))
+ (bytes=? (cadr m) #".mzscheme"))
+ (car m)))])
+ (and ext
+ (or (and (= (bytes-length s) (+ len (bytes-length ext)))
+ (cons null ext))
+ (let ([vers (subbytes s len (- (bytes-length s) (bytes-length ext)))])
(and (regexp-match #rx#"^(-[0-9]+)+$" vers)
+ (cons
(map string->number
(cdr
(map bytes->string/latin-1
- (regexp-split #rx#"-" vers))))))))))
+ (regexp-split #rx#"-" vers))))
+ ext)))))))))
files))]
[versions
+ (let* ([eo '(#".mzscheme.ss" #".mzscheme.sls" #".ss" #".sls")]
+ [ext< (lambda (a b)
+ (> (length (member a eo)) (length (member b eo))))])
(sort candidate-versions
(lambda (a b)
- (let loop ([a a][b b])
+ (if (equal? (car a) (car b))
+ (ext< (cdr a) (cdr b))
+ (let loop ([a (car a)] [b (car b)])
(cond
[(null? a) #t]
[(null? b) #f]
[(> (car a) (car b)) #t]
[(< (car a) (car b)) #f]
- [else (loop (cdr a) (cdr b))]))))])
+ [else (loop (cdr a) (cdr b))]))))))])
(ormap (lambda (candidate-version)
- (and (version-match? candidate-version vers)
- candidate-version))
+ (and (version-match? (car candidate-version) vers)
+ (cons (car candidate-version)
+ (bytes->string/latin-1 (cdr candidate-version)))))
versions))))))
(define (version-match? cand vers)
diff -u -b -r plt-3.99.0.23/collects/r6rs/private/parse-ref.ss plt-3.99.0.23--more-r6rs-exts/collects/r6rs/private/parse-ref.ss
--- plt-3.99.0.23/collects/r6rs/private/parse-ref.ss 2008-03-06 19:18:06.000000000 -0800
+++ plt-3.99.0.23--more-r6rs-exts/collects/r6rs/private/parse-ref.ss 2008-04-13 01:07:21.000000000 -0700
@@ -54,8 +54,8 @@
exn))))])
(apply collection-path coll))
file)])
- (let ([vers (find-version (path->bytes base) (syntax->datum #'(vers ...)))])
- (if vers
+ (let ([vers.ext (find-version (path->bytes base) (syntax->datum #'(vers ...)))])
+ (if vers.ext
(apply string-append
(car coll)
(append
@@ -64,8 +64,8 @@
(append (cdr coll) (list file)))
(map (lambda (v)
(format "-~a" v))
- vers)
- (list ".ss")))
+ (car vers.ext))
+ (list (cdr vers.ext))))
(err "cannot find suitable installed library")))))]
[(id1 id2 ...)
(and (identifier? #'id1)