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

add `relative-in'

Browse Source
This commit is contained in:
Matthew Flatt 2012-05-15 10:29:43 -06:00
parent 0c6719319f
commit e35337dcfd
6 changed files with 445 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

325
collects/racket/private/reqprov.rkt
View File

@ -2,7 +2,7 @@
(#%require "define.rkt" (#%require "define.rkt"
(for-syntax '#%kernel (for-syntax '#%kernel
"stx.rkt" "stxcase-scheme.rkt" "small-scheme.rkt" "stx.rkt" "stxcase-scheme.rkt" "small-scheme.rkt"
"stxloc.rkt" "qqstx.rkt" "stxloc.rkt" "qqstx.rkt" "more-scheme.rkt"
"../require-transform.rkt" "../require-transform.rkt"
"../provide-transform.rkt" "../provide-transform.rkt"
"struct-info.rkt")) "struct-info.rkt"))
@ -11,6 +11,7 @@
for-syntax for-template for-label for-meta for-syntax for-template for-label for-meta
require require
only-in rename-in prefix-in except-in combine-in only-meta-in only-in rename-in prefix-in except-in combine-in only-meta-in
relative-in
provide provide
all-defined-out all-from-out all-defined-out all-from-out
rename-out except-out prefix-out struct-out combine-out rename-out except-out prefix-out struct-out combine-out
@ -30,36 +31,41 @@
;; lib, file, planet, submod ;; lib, file, planet, submod
(define-for-syntax (xlate-path stx) (define-for-syntax (xlate-path stx)
(if (pair? (syntax-e stx)) ;; Converts a path based on `require' submform bindings into
(let ([kw ;; one based on `#%require' symbolic combinations. For example,
;; symbolic-identifier=? identifiers are not necessarily free-identifier=? ;; is `quote' is imported as `alt:quote', changes the `alt:quote'
(syntax-case stx (lib planet file submod quote) ;; to plain `quote'.
[(quote . _) 'quote] (convert-relative-module-path
[(lib . _) 'lib] (if (pair? (syntax-e stx))
[(planet . _) 'planet] (let ([kw
[(file . _) 'file] ;; symbolic-identifier=? identifiers are not necessarily free-identifier=?
[(submod . _) 'submod])] (syntax-case stx (lib planet file submod quote)
[d (syntax->datum stx)]) [(quote . _) 'quote]
(cond [(lib . _) 'lib]
[(eq? kw 'submod) [(planet . _) 'planet]
(syntax-case stx () [(file . _) 'file]
[(_ mp . rest) [(submod . _) 'submod])]
(let ([new-mp (xlate-path #'mp)]) [d (syntax->datum stx)])
(if (and (eq? new-mp #'mp) (cond
(eq? (car d) 'submod)) [(eq? kw 'submod)
stx (syntax-case stx ()
(datum->syntax [(_ mp . rest)
(let ([new-mp (xlate-path #'mp)])
(if (and (eq? new-mp #'mp)
(eq? (car d) 'submod))
stx stx
(list* kw new-mp #'rest) (datum->syntax
stx stx
stx)))])] (list* kw new-mp #'rest)
[(eq? (car d) kw) stx] stx
[else (datum->syntax stx)))])]
stx [(eq? (car d) kw) stx]
(cons kw (cdr d)) [else (datum->syntax
stx stx
stx)])) (cons kw (cdr d))
stx)) stx
stx)]))
stx)))
(define-for-syntax (check-lib-form stx) (define-for-syntax (check-lib-form stx)
(unless (module-path? (syntax->datum (xlate-path stx))) (unless (module-path? (syntax->datum (xlate-path stx)))
@ -238,127 +244,128 @@
(raise-syntax-error #f (raise-syntax-error #f
"not at module level or top level" "not at module level or top level"
stx)) stx))
(letrec ([mode-wrap (parameterize ([current-require-module-path #f])
(lambda (mode base) (letrec ([mode-wrap
(cond (lambda (mode base)
[(eq? mode 0) base] (cond
[else #`(for-meta #,mode #,base)]))] [(eq? mode 0) base]
[simple-path? (lambda (p) [else #`(for-meta #,mode #,base)]))]
(syntax-case p (lib quote) [simple-path? (lambda (p)
[(lib . _) (syntax-case p (lib quote)
(check-lib-form p)] [(lib . _)
[(quote . _) (check-lib-form p)]
(check-lib-form p)] [(quote . _)
[_ (check-lib-form p)]
(or (identifier? p) [_
(and (string? (syntax-e p)) (or (identifier? p)
(module-path? (syntax-e p))))]))] (and (string? (syntax-e p))
[transform-simple (module-path? (syntax-e p))))]))]
(lambda (in base-mode) [transform-simple
(syntax-case in (lib file planet submod prefix-in except-in quote) (lambda (in base-mode)
;; Detect simple cases first: (syntax-case in (lib file planet submod prefix-in except-in quote)
[_ ;; Detect simple cases first:
(string? (syntax-e in)) [_
(begin (string? (syntax-e in))
(unless (module-path? (syntax-e in)) (begin
(raise-syntax-error (unless (module-path? (syntax-e in))
#f (raise-syntax-error
"bad module-path string" #f
stx "bad module-path string"
in)) stx
(list (mode-wrap base-mode in)))] in))
[_ (list (mode-wrap base-mode in)))]
(and (identifier? in) [_
(module-path? (syntax-e #'in))) (and (identifier? in)
(list (mode-wrap base-mode in))] (module-path? (syntax-e #'in)))
[(quote . s) (list (mode-wrap base-mode in))]
(check-lib-form in) [(quote . s)
(list (mode-wrap base-mode (xlate-path in)))] (check-lib-form in)
[(lib . s) (list (mode-wrap base-mode (xlate-path in)))]
(check-lib-form in) [(lib . s)
(list (mode-wrap base-mode (xlate-path in)))] (check-lib-form in)
[(file . s) (list (mode-wrap base-mode (xlate-path in)))]
(check-lib-form in) [(file . s)
(list (mode-wrap base-mode (xlate-path in)))] (check-lib-form in)
[(planet . s) (list (mode-wrap base-mode (xlate-path in)))]
(check-lib-form in) [(planet . s)
(list (mode-wrap base-mode (xlate-path in)))] (check-lib-form in)
[(submod . s) (list (mode-wrap base-mode (xlate-path in)))]
(check-lib-form in) [(submod . s)
(list (mode-wrap base-mode (xlate-path in)))] (check-lib-form in)
[(prefix-in pfx path) (list (mode-wrap base-mode (xlate-path in)))]
(simple-path? #'path) [(prefix-in pfx path)
(list (mode-wrap (simple-path? #'path)
base-mode (list (mode-wrap
(datum->syntax base-mode
#'path (datum->syntax
(syntax-e #'path
(quasisyntax (syntax-e
(prefix pfx #,(xlate-path #'path)))) (quasisyntax
in (prefix pfx #,(xlate-path #'path))))
in)))] in
[(except-in path id ...) in)))]
(and (simple-path? #'path) [(except-in path id ...)
;; check that it's well-formed... (and (simple-path? #'path)
(call-with-values (lambda () (expand-import in)) ;; check that it's well-formed...
(lambda (a b) #t))) (call-with-values (lambda () (expand-import in))
(list (mode-wrap (lambda (a b) #t)))
base-mode (list (mode-wrap
(datum->syntax base-mode
#'path (datum->syntax
(syntax-e #'path
(quasisyntax/loc in (syntax-e
(all-except #,(xlate-path #'path) id ...))))))] (quasisyntax/loc in
;; General case: (all-except #,(xlate-path #'path) id ...))))))]
[_ (let-values ([(imports sources) (expand-import in)]) ;; General case:
;; TODO: collapse back to simple cases when possible [_ (let-values ([(imports sources) (expand-import in)])
(append ;; TODO: collapse back to simple cases when possible
(map (lambda (import) (append
#`(just-meta (map (lambda (import)
#,(import-orig-mode import) #`(just-meta
#,(mode-wrap (phase+ base-mode (import-req-mode import)) #,(import-orig-mode import)
#`(rename #,(import-src-mod-path import) #,(mode-wrap (phase+ base-mode (import-req-mode import))
#,(import-local-id import) #`(rename #,(import-src-mod-path import)
#,(import-src-sym import))))) #,(import-local-id import)
imports) #,(import-src-sym import)))))
(map (lambda (src) imports)
(mode-wrap (phase+ base-mode (import-source-mode src)) (map (lambda (src)
#`(only #,(import-source-mod-path-stx src)))) (mode-wrap (phase+ base-mode (import-source-mode src))
sources)))]))] #`(only #,(import-source-mod-path-stx src))))
[transform-one sources)))]))]
(lambda (in) [transform-one
;; Recognize `for-syntax', etc. for simple cases: (lambda (in)
(syntax-case in (for-meta) ;; Recognize `for-syntax', etc. for simple cases:
[(for-meta n elem ...) (syntax-case in (for-meta)
(or (exact-integer? (syntax-e #'n)) [(for-meta n elem ...)
(not (syntax-e #'n))) (or (exact-integer? (syntax-e #'n))
(apply append (not (syntax-e #'n)))
(map (lambda (in) (apply append
(transform-simple in (syntax-e #'n))) (map (lambda (in)
(syntax->list #'(elem ...))))] (transform-simple in (syntax-e #'n)))
[(for-something elem ...) (syntax->list #'(elem ...))))]
(and (identifier? #'for-something) [(for-something elem ...)
(ormap (lambda (i) (free-identifier=? i #'for-something)) (and (identifier? #'for-something)
(list #'for-syntax #'for-template #'for-label))) (ormap (lambda (i) (free-identifier=? i #'for-something))
(apply append (list #'for-syntax #'for-template #'for-label)))
(map (lambda (in) (apply append
(transform-simple in (map (lambda (in)
(cond (transform-simple in
[(free-identifier=? #'for-something #'for-syntax) (cond
1] [(free-identifier=? #'for-something #'for-syntax)
[(free-identifier=? #'for-something #'for-template) 1]
-1] [(free-identifier=? #'for-something #'for-template)
[(free-identifier=? #'for-something #'for-label) -1]
#f]))) [(free-identifier=? #'for-something #'for-label)
(syntax->list #'(elem ...))))] #f])))
[_ (transform-simple in 0 #| run phase |#)]))]) (syntax->list #'(elem ...))))]
(syntax-case stx () [_ (transform-simple in 0 #| run phase |#)]))])
[(_ in) (syntax-case stx ()
(with-syntax ([(new-in ...) (transform-one #'in)]) [(_ in)
(syntax/loc stx (with-syntax ([(new-in ...) (transform-one #'in)])
(#%require new-in ...)))] (syntax/loc stx
[(_ in ...) (#%require new-in ...)))]
(syntax/loc stx (begin (require in) ...))]))) [(_ in ...)
(syntax/loc stx (begin (require in) ...))]))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; require transformers ;; require transformers
@ -615,6 +622,22 @@
imports) imports)
sources))])))) sources))]))))
(define-syntax relative-in
(make-require-transformer
(lambda (stx)
(syntax-case stx ()
[(_ mod-path in ...)
(let ([mp (syntax->datum #'mod-path)])
(unless (module-path? mp)
(raise-syntax-error #f
"bad module path"
stx
#'mod-path))
(parameterize ([current-require-module-path (module-path-index-join
mp
(current-require-module-path))])
(expand-import #`(combine-in in ...))))]))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; provide ;; provide

193
collects/racket/require-transform.rkt
View File

@ -8,7 +8,8 @@
(for-syntax '#%kernel)) (for-syntax '#%kernel))
(#%provide expand-import (#%provide expand-import
syntax-local-require-certifier current-require-module-path convert-relative-module-path
syntax-local-require-certifier
make-require-transformer prop:require-transformer require-transformer? make-require-transformer prop:require-transformer require-transformer?
;; the import struct type: ;; the import struct type:
import struct:import make-import import? import struct:import make-import import?
@ -72,6 +73,193 @@
(define orig-insp (variable-reference->module-declaration-inspector (define orig-insp (variable-reference->module-declaration-inspector
(#%variable-reference))) (#%variable-reference)))
(define current-require-module-path
(make-parameter #f
(lambda (v)
(unless (or (not v)
(module-path-index? v))
(raise-type-error 'current-require-module-path
"#f or module path index"
v))
v)))
;; a simplified version of `collapse-module-path-index', where
;; we don't have to normalize:
(define (collapse-mpi mpi)
(define-values (a b) (module-path-index-split mpi))
(define (recur b)
(cond
[(not b) (collapse-mpi (module-path-index-join #f #f))]
[(resolved-module-path? b)
(let ([n (resolved-module-path-name b)])
(if (pair? n)
(cons 'submod n)
n))]
[else (collapse-mpi b)]))
(define (extract-root bc)
(if (and (pair? bc) (eq? 'submod (car bc)))
(cadr bc)
bc))
(define (replace-last s a)
;; replace last path element, and also eliminate "." and "..":
(regexp-replace* #rx"(?<=^|/)[.]/"
(regexp-replace* #rx"(?<=^|/)[-+_%a-zA-Z0-9]*/[.][.]/"
(regexp-replace #rx"[^/]*$" s a)
"")
""))
(define (string->path* s)
;; for now, module-path strings all works as paths
(string->path s))
(cond
[(and (not a) (not b))
(build-path (or (current-load-relative-directory)
(current-directory))
"here.rkt")]
[(path? a) a]
[(symbol? a) a]
[(string? a)
(define bc (extract-root (recur b)))
(let loop ([bc bc])
(cond
[(path? bc)
(define-values (base name dir?) (split-path bc))
(if (eq? base 'relative)
(string->path* a)
(build-path base (string->path* a)))]
[(symbol? bc)
(loop `(lib ,(symbol->string bc)))]
[(eq? (car bc) 'quote)
(build-path (or (current-load-relative-directory)
(current-directory))
(string->path* a))]
[(eq? (car bc) 'file)
(loop (string->path (cadr bc)))]
[(eq? (car bc) 'lib)
(cond
[(and (null? (cddr bc))
(regexp-match? #rx"[/]" (cadr bc)))
`(lib ,(replace-last (cadr bc) a))]
[(and (null? (cddr bc))
(not (regexp-match? #rx"[/.]" (cadr bc))))
(loop `(lib ,(string-append (cadr bc) "/main.rkt")))]
[(and (null? (cddr bc))
(not (regexp-match? #rx"[/]" (cadr bc))))
(loop `(lib ,(string-append "mzlib/" (cadr bc))))]
[else
(loop `(lib ,(apply
string-append
(let loop ([l (cddr bc)])
(if (null? l)
(list (cadr bc))
(list* (car l) "/" (loop (cdr l))))))))])]
[(eq? (car bc) 'planet)
(cond
[(symbol? (cadr bc))
(loop `(planet ,(symbol->string (cadr bc))))]
[(null? (cddr bc))
(define s (cadr bc))
(cond
[(regexp-match? #rx"/.*/" s)
`(planet ,(replace-last s a))]
[else
`(planet ,(string-append s "/" a))])]
[else
(define s (cadr bc))
`(planet ,(if (regexp-match? #rx"/" s)
(replace-last s a)
a)
,@(cddr bc))])]
[else (error "collapse-mpi failed on recur shape: " bc)]))]
[(eq? (car a) 'submod)
(define (add bc l)
(if (and (pair? bc) (eq? 'submod (car bc)))
(append bc l)
(list* 'submod bc l)))
(cond
[(equal? (cadr a) ".")
(add (recur b) (cddr a))]
[(equal? (cadr a) "..")
(add (recur b) (cdr a))]
[else
(add (collapse-mpi (module-path-index-join (cadr a) b))
(cddr a))])]
[else a]))
(define (convert-relative-module-path mp/stx)
(define rmp (current-require-module-path))
(cond
[(not rmp) mp/stx]
[else
(define mp (if (syntax? mp/stx)
(syntax->datum mp/stx)
mp/stx))
(define (d->s d)
(if (syntax? mp/stx)
(datum->syntax mp/stx d mp/stx mp/stx)
d))
(cond
[(not (module-path? mp)) mp/stx]
[(string? mp)
;; collapse a relative reference to an absolute one:
(d->s (collapse-mpi (module-path-index-join mp rmp)))]
[(symbol? mp) mp/stx]
[(eq? (car mp) 'quote)
;; maybe a submodule...
(define r (module-path-index-resolve rmp))
(if (module-declared? (append '(submod)
(if (list? r)
r
(list r))
(cddr mp))
#t)
;; Yes, a submodule:
(let ([rmp-mod (collapse-mpi rmp)])
(if (and (pair? rmp-mod)
(eq? (car rmp-mod 'submod)))
(d->s (append rmp-mod (cadr mp)))
(d->s `(submod ,rmp-mod . ,(cddr mp)))))
mp/stx)]
[(eq? (car mp) 'file)
(define base-path (resolved-module-path-name
(module-path-index-resolve rmp)))
(define path (if (pair? base-path)
(car base-path)
base-path))
(if (path? path)
(let-values ([(base name dir?) (split-path path)])
(if (eq? base 'relative)
mp/stx
(d->s (build-path base (cadr mp)))))
mp/stx)]
[(eq? (car mp) 'submod)
(define sub/stx (if (syntax? mp/stx)
(syntax-case mp/stx ()
[(_ sub . _) #'sub])
(cadr mp)))
(define sub (if (syntax? sub/stx) (syntax->datum sub/stx) sub/stx))
(define new-sub/stx
(cond
[(equal? sub ".") (d->s (collapse-mpi rmp))]
[(equal? sub "..")
(define old (collapse-mpi rmp))
(if (and (pair? old)
(eq? (car old) 'submod))
(d->s (append old ".."))
sub/stx)]
[else
(convert-relative-module-path sub/stx)]))
(cond
[(eq? sub/stx new-sub/stx) mp/stx]
[else
(define new-sub (if (syntax? new-sub/stx)
(syntax->datum new-sub/stx)
new-sub/stx))
(if (and (pair? new-sub)
(eq? (car new-sub 'submod)))
(d->s (append new-sub (cddr sub)))
(d->s `(submod ,new-sub/stx . ,(cddr sub))))])]
[else mp/stx])]))
;; expand-import : stx bool -> (listof import) ;; expand-import : stx bool -> (listof import)
(define (expand-import stx) (define (expand-import stx)
(let ([disarmed-stx (syntax-disarm stx orig-insp)]) (let ([disarmed-stx (syntax-disarm stx orig-insp)])
@ -91,7 +279,8 @@
#f #f
"invalid module-path form" "invalid module-path form"
stx)) stx))
(let ([namess (syntax-local-module-exports mod-path)]) (let* ([mod-path (convert-relative-module-path mod-path)]
[namess (syntax-local-module-exports mod-path)])
(values (values
(apply (apply
append append

45
collects/scribblings/reference/stx-trans.scrbl
View File

@ -602,13 +602,16 @@ by the expander, the result is the @tech{phase level} of the form
being expanded. Otherwise, the result is @racket[0].} being expanded. Otherwise, the result is @racket[0].}
@defproc[(syntax-local-module-exports [mod-path module-path?]) @defproc[(syntax-local-module-exports [mod-path (or/c module-path?
(and/c syntax?
(lambda (stx)
(module-path? (syntax->datum stx)))))])
(listof (cons/c (or/c exact-integer? #f) (listof symbol?)))]{ (listof (cons/c (or/c exact-integer? #f) (listof symbol?)))]{
Returns an association list from @tech{phase-level} numbers (or Returns an association list from @tech{phase-level} numbers (or
@racket[#f] for the @tech{label phase level}) to lists of symbols, @racket[#f] for the @tech{label phase level}) to lists of symbols,
where the symbols are the names of @racket[provide]d where the symbols are the names of @racket[provide]d
bindings at the corresponding @tech{phase level}. bindings from @racket[mod-path] at the corresponding @tech{phase level}.
@transform-time[]} @transform-time[]}
@ -929,6 +932,44 @@ into a module.
]} ]}
@defparam[current-require-module-path module-path (or/c #f module-path-index?)]{
A parameter that determines how relative @racket[require]-level module
paths are expanded to @racket[#%require]-level module paths by
@racket[convert-relative-module-path] (which is used implicitly by all
built-in @racket[require] sub-forms).
When the value of @racket[current-require-module-path] is @racket[#f],
relative module paths are left as-is, which means that the
@racket[require] context determines the resolution of the module
path.
The @racket[require] form @racket[parameterize]s
@racket[current-require-module-path] as @racket[#f] while invoking
sub-form transformers, while @racket[relative-in] @racket[parameterize]s
to a given module path.}
@defproc[(convert-relative-module-path [module-path
(or/c module-path?
(and/c syntax?
(lambda (stx)
(module-path? (syntax-e stx)))))])
(or/c module-path?
(and/c syntax?
(lambda (stx)
(module-path? (syntax-e stx)))))]{
Converts @racket[module-path] according to @racket[current-require-module-path].
If @racket[module-path] is not relative or if the value of
@racket[current-require-module-path] is @racket[#f], then
@racket[module-path] is returned. Otherwise, @racket[module-path] is
converted to an absolute module path that is equivalent to
@racket[module-path] relative to the value of
@racket[current-require-module-path].}
@defproc[(syntax-local-require-certifier) @defproc[(syntax-local-require-certifier)
((syntax?) (or/c #f (syntax? . -> . syntax?)) ((syntax?) (or/c #f (syntax? . -> . syntax?))
. ->* . syntax?)]{ . ->* . syntax?)]{

17
collects/scribblings/reference/syntax.scrbl
View File

@ -1,7 +1,8 @@
#lang scribble/doc #lang scribble/doc
@(require "mz.rkt" scribble/bnf scribble/core @(require "mz.rkt" scribble/bnf scribble/core
(for-label (only-in racket/require-transform (for-label (only-in racket/require-transform
make-require-transformer) make-require-transformer
current-require-module-path)
racket/require-syntax racket/require-syntax
racket/require racket/require
(only-in racket/provide-transform (only-in racket/provide-transform
@ -348,7 +349,8 @@ Legal only in a @tech{module begin context}, and handled by the
@guideintro["module-require"]{@racket[require]} @guideintro["module-require"]{@racket[require]}
@defform/subs[#:literals (only-in prefix-in except-in rename-in lib file planet submod + - = @defform/subs[#:literals (only-in prefix-in except-in rename-in lib file planet submod + - =
for-syntax for-template for-label for-meta only-meta-in combine-in quote) for-syntax for-template for-label for-meta only-meta-in combine-in
relative-in quote)
(require require-spec ...) (require require-spec ...)
([require-spec module-path ([require-spec module-path
(only-in require-spec id-maybe-renamed ...) (only-in require-spec id-maybe-renamed ...)
@ -356,6 +358,7 @@ Legal only in a @tech{module begin context}, and handled by the
(prefix-in prefix-id require-spec) (prefix-in prefix-id require-spec)
(rename-in require-spec [orig-id bind-id] ...) (rename-in require-spec [orig-id bind-id] ...)
(combine-in require-spec ...) (combine-in require-spec ...)
(relative-in module-path require-spec ...)
(only-meta-in phase-level require-spec ...) (only-meta-in phase-level require-spec ...)
(for-syntax require-spec ...) (for-syntax require-spec ...)
(for-template require-spec ...) (for-template require-spec ...)
@ -491,6 +494,16 @@ bindings of each @racket[require-spec] are visible for expanding later
tcp-listen tcp-listen
]} ]}
@defsubform[(relative-in module-path require-spec ...)]{
Like the union of the @racket[require-spec]s, but each
relative module path in a @racket[require-spec] is treated
as relative to @racket[module-path] instead of the enclosing
context.
The @tech{require transformer} that implements @racket[relative-in]
sets @racket[current-require-module-path] to adjust module paths
in the @racket[require-spec]s.}
@defsubform[(only-meta-in phase-level require-spec ...)]{ @defsubform[(only-meta-in phase-level require-spec ...)]{
Like the combination of @racket[require-spec]s, but removing any Like the combination of @racket[require-spec]s, but removing any
binding that is not for @racket[phase-level], where @racket[#f] for binding that is not for @racket[phase-level], where @racket[#f] for

21
collects/tests/racket/module.rktl
View File

@ -470,6 +470,27 @@
(test #t module-path? '(planet "foo.rkt" ("robby" "redex.plt") "sub" "deeper")) (test #t module-path? '(planet "foo.rkt" ("robby" "redex.plt") "sub" "deeper"))
(test #t module-path? '(planet "foo%2e.rkt" ("robby%2e" "redex%2e.plt") "sub%2e" "%2edeeper")) (test #t module-path? '(planet "foo%2e.rkt" ("robby%2e" "redex%2e.plt") "sub%2e" "%2edeeper"))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; check `relative-in'
(let ([check
(lambda (path)
(parameterize ([current-namespace (make-base-namespace)])
(eval
`(module relative-in-test racket/base
(require ,path)
(provide x)
(define x (string-join '("a" "b" "c") "."))))
(test "a.b.c" dynamic-require ''relative-in-test 'x)))])
(check 'racket/string)
(check '(relative-in racket/delay "string.rkt"))
(check '(relative-in racket "string.rkt"))
(check '(relative-in (lib "racket/main.rkt") "string.rkt"))
(check '(relative-in (lib "racket") "string.rkt"))
(check '(relative-in (lib "main.rkt" "racket") "string.rkt"))
(check `(relative-in ,(collection-file-path "delay.rkt" "racket") "string.rkt"))
(check '(relative-in racket (relative-in "private/reqprov.rkt" "../string.rkt"))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; check collection-path details ;; check collection-path details

1
doc/release-notes/racket/HISTORY.txt
View File

@ -1,6 +1,7 @@
Version 5.3.0.8 Version 5.3.0.8
Added variable-reference->module-path-index Added variable-reference->module-path-index
Added syntax-local-submodules Added syntax-local-submodules
Added relative-in
Version 5.3.0.7 Version 5.3.0.7
compiler/zo-struct: added cancel-id field to phase-shift compiler/zo-struct: added cancel-id field to phase-shift