From c811740d48a67a28b5500a8148452ca4029d73cc Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 14 Apr 2008 11:59:51 +0000 Subject: [PATCH] Derrick's patch to extend the r6rs library search path with .mzscheme.ss, .mzscheme.sls, and .sls svn: r9291 --- collects/r6rs/private/find-version.ss | 35 +++++++++++++++++++-------- collects/r6rs/private/parse-ref.ss | 8 +++--- collects/r6rs/scribblings/r6rs.scrbl | 33 +++++++++++++++++++------ 3 files changed, 54 insertions(+), 22 deletions(-) diff --git a/collects/r6rs/private/find-version.ss b/collects/r6rs/private/find-version.ss index 33801c31ce..3587a622d5 100644 --- a/collects/r6rs/private/find-version.ss +++ b/collects/r6rs/private/find-version.ss @@ -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 --git a/collects/r6rs/private/parse-ref.ss b/collects/r6rs/private/parse-ref.ss index d52b4b4f82..271881e244 100644 --- a/collects/r6rs/private/parse-ref.ss +++ b/collects/r6rs/private/parse-ref.ss @@ -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) diff --git a/collects/r6rs/scribblings/r6rs.scrbl b/collects/r6rs/scribblings/r6rs.scrbl index 53352311a0..3d998b50ac 100644 --- a/collects/r6rs/scribblings/r6rs.scrbl +++ b/collects/r6rs/scribblings/r6rs.scrbl @@ -2,7 +2,8 @@ @(require scribble/manual scribble/bnf (for-label setup/dirs - rnrs/programs-6)) + rnrs/programs-6 + (only-in scheme/base lib))) @(define guide-src '(lib "scribblings/guide/guide.scrbl")) @@ -142,8 +143,8 @@ the files are written. Libraries installed by @exec{plt-r6rs @section[#:tag "libpaths"]{Libraries and Collections} An @|r6rs| library name is sequence of symbols, optionally followed by -a version as a sequence of exact, non-negative integers. Such a name -is converted to a PLT Scheme module pathname (see @secref[#:doc +a version as a sequence of exact, non-negative integers. Roughly, such +a name is converted to a PLT Scheme module pathname (see @secref[#:doc guide-src "module-paths"]) by concatenating the symbols with a @litchar{/} separator, and then appending the version integers each with a preceeding @litchar{-}. As a special case, when an @|r6rs| path @@ -153,15 +154,31 @@ symbol is effectively inserted after the initial symbol. Examples: @schemeblock[ -(rnrs io simple (6)) #, @elem{corresponds to} rnrs/io/simple-6 -(rnrs) #, @elem{corresponds to} rnrs -(rnrs (6)) #, @elem{corresponds to} rnrs/main-6 +(rnrs io simple (6)) #, @elem{roughly means} rnrs/io/simple-6 +(rnrs) #, @elem{roughly means} rnrs +(rnrs (6)) #, @elem{roughly means} rnrs/main-6 ] When an @|r6rs| library or top-level program refers to another library, it can supply version constraints rather than naming a -specific version. The version constraint is resolved at compile time -by searching the set of installed files. +specific version. Version constraints are always resolved at compile +time by searching the set of installed files. + +In addition, when an @|r6rs| library path is converted, a file +extension is selected at compile time based on installed files. The +search order for file extensions is @filepath{.mzscheme.ss}, +@filepath{.mzscheme.sls}, @filepath{.ss}, and @filepath{.sls}. When +resolving version constraints, these extensions are all tried when +looking for matches. + +Examples (assuming a typical PLT Scheme installation): + +@schemeblock[ +(rnrs io simple (6)) #, @elem{really means} (lib "rnrs/io/simple-6.ss") +(rnrs) #, @elem{really means} (lib "rnrs/main-6.ss") +(rnrs (6)) #, @elem{really means} (lib "rnrs/main-6.ss") +] + @; ----------------------------------------