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

On Fri, 2008-04-11 at 07:33 -0600, Matthew Flatt wrote:
> So, if you can create a patch to "parse-ref.ss" (and probably
> "find-version.ss") to search for ".sls", ".mzscheme.sls", and
> ".mzscheme.ss", I'll apply the patch.

Here it is, below.  It chooses the library-file with the best version
match regardless of the extension; in other words, .mzscheme.{ss,sls} is
only chosen over other files for the same library with different
extensions if it's the best version match.

Thanks again.  I'm loving having DrScheme understand my R6RS code now.
Other than gaps in MzScheme's unfinished R6RS support, I've been running
my code seamlessly on both Ikarus and MzScheme.

-- 
: Derick
----------------------------------------------------------------

diff -u -r -b 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-12 18:08:12.000000000 -0700
@@ -13,33 +13,47 @@
                    (filter
                     values
                     (map
-                     (lambda (file)
-                       (let ([s (path-element->bytes file)])
-                         (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))])
+                     (lambda (s)
+                       (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))))))))))
-                     files))]
+                                                     (regexp-split #rx#"-" vers))))
+                                          ext)))))))
+                     (filter (lambda (s)
+                               (and (len . < . (bytes-length s))
+                                    (bytes=? p (subbytes s 0 len))))
+                             (map path-element->bytes 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 -r -b 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-12 10:17:11.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)