suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Derrick's patch to extend the r6rs library search path with .mzscheme.ss, .mzscheme.sls, and .sls

Browse Source 
svn: r9291
This commit is contained in:
Matthew Flatt 2008-04-14 11:59:51 +00:00
parent 8036ddf5a1
commit c811740d48
3 changed files with 54 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/r6rs/private/find-version.ss
View File

@ -15,31 +15,46 @@
(map (map
(lambda (file) (lambda (file)
(let ([s (path-element->bytes file)]) (let ([s (path-element->bytes file)])
(and
(and (len . < . (bytes-length s)) (and (len . < . (bytes-length s))
(regexp-match? #rx#"[.]ss$" s) (bytes=? p (subbytes s 0 len)))
(bytes=? p (subbytes s 0 len)) (let ([ext (let ([m (regexp-match #rx#"([.][a-z]+)?[.](ss|sls)$"
(or (and (= (bytes-length s) (+ len 3)) (subbytes s len))])
null) (and m
(let ([vers (subbytes s len (- (bytes-length s) 3))]) (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) (and (regexp-match #rx#"^(-[0-9]+)+$" vers)
(cons
(map string->number (map string->number
(cdr (cdr
(map bytes->string/latin-1 (map bytes->string/latin-1
(regexp-split #rx#"-" vers)))))))))) (regexp-split #rx#"-" vers))))
ext)))))))))
files))] files))]
[versions [versions
(let* ([eo '(#".mzscheme.ss" #".mzscheme.sls" #".ss" #".sls")]
[ext< (lambda (a b)
(> (length (member a eo)) (length (member b eo))))])
(sort candidate-versions (sort candidate-versions
(lambda (a b) (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 (cond
[(null? a) #t] [(null? a) #t]
[(null? b) #f] [(null? b) #f]
[(> (car a) (car b)) #t] [(> (car a) (car b)) #t]
[(< (car a) (car b)) #f] [(< (car a) (car b)) #f]
[else (loop (cdr a) (cdr b))]))))]) [else (loop (cdr a) (cdr b))]))))))])
(ormap (lambda (candidate-version) (ormap (lambda (candidate-version)
(and (version-match? candidate-version vers) (and (version-match? (car candidate-version) vers)
candidate-version)) (cons (car candidate-version)
(bytes->string/latin-1 (cdr candidate-version)))))
versions)))))) versions))))))
(define (version-match? cand vers) (define (version-match? cand vers)

8
collects/r6rs/private/parse-ref.ss
View File

@ -54,8 +54,8 @@
exn))))]) exn))))])
(apply collection-path coll)) (apply collection-path coll))
file)]) file)])
(let ([vers (find-version (path->bytes base) (syntax->datum #'(vers ...)))]) (let ([vers.ext (find-version (path->bytes base) (syntax->datum #'(vers ...)))])
(if vers (if vers.ext
(apply string-append (apply string-append
(car coll) (car coll)
(append (append
@ -64,8 +64,8 @@
(append (cdr coll) (list file))) (append (cdr coll) (list file)))
(map (lambda (v) (map (lambda (v)
(format "-~a" v)) (format "-~a" v))
vers) (car vers.ext))
(list ".ss"))) (list (cdr vers.ext))))
(err "cannot find suitable installed library")))))] (err "cannot find suitable installed library")))))]
[(id1 id2 ...) [(id1 id2 ...)
(and (identifier? #'id1) (and (identifier? #'id1)

33
collects/r6rs/scribblings/r6rs.scrbl
View File

@ -2,7 +2,8 @@
@(require scribble/manual @(require scribble/manual
scribble/bnf scribble/bnf
(for-label setup/dirs (for-label setup/dirs
rnrs/programs-6)) rnrs/programs-6
(only-in scheme/base lib)))
@(define guide-src '(lib "scribblings/guide/guide.scrbl")) @(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} @section[#:tag "libpaths"]{Libraries and Collections}
An @|r6rs| library name is sequence of symbols, optionally followed by An @|r6rs| library name is sequence of symbols, optionally followed by
a version as a sequence of exact, non-negative integers. Such a name a version as a sequence of exact, non-negative integers. Roughly, such
is converted to a PLT Scheme module pathname (see @secref[#:doc a name is converted to a PLT Scheme module pathname (see @secref[#:doc
guide-src "module-paths"]) by concatenating the symbols with a guide-src "module-paths"]) by concatenating the symbols with a
@litchar{/} separator, and then appending the version integers each @litchar{/} separator, and then appending the version integers each
with a preceeding @litchar{-}. As a special case, when an @|r6rs| path 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: Examples:
@schemeblock[ @schemeblock[
(rnrs io simple (6)) #, @elem{corresponds to} rnrs/io/simple-6 (rnrs io simple (6)) #, @elem{roughly means} rnrs/io/simple-6
(rnrs) #, @elem{corresponds to} rnrs (rnrs) #, @elem{roughly means} rnrs
(rnrs (6)) #, @elem{corresponds to} rnrs/main-6 (rnrs (6)) #, @elem{roughly means} rnrs/main-6
] ]
When an @|r6rs| library or top-level program refers to another When an @|r6rs| library or top-level program refers to another
library, it can supply version constraints rather than naming a library, it can supply version constraints rather than naming a
specific version. The version constraint is resolved at compile time specific version. Version constraints are always resolved at compile
by searching the set of installed files. 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")
]
@; ---------------------------------------- @; ----------------------------------------