[plt-scheme] *.mzscheme.{ss,sls} patch

From: Derick Eddington (derick.eddington at gmail.com)
Date: Sun Apr 13 07:27:39 EDT 2008

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)





Posted on the users mailing list.