add `relative-in'
This commit is contained in:
parent
0c6719319f
commit
e35337dcfd
|
@ -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,6 +31,11 @@
|
||||||
;; lib, file, planet, submod
|
;; lib, file, planet, submod
|
||||||
|
|
||||||
(define-for-syntax (xlate-path stx)
|
(define-for-syntax (xlate-path stx)
|
||||||
|
;; Converts a path based on `require' submform bindings into
|
||||||
|
;; one based on `#%require' symbolic combinations. For example,
|
||||||
|
;; is `quote' is imported as `alt:quote', changes the `alt:quote'
|
||||||
|
;; to plain `quote'.
|
||||||
|
(convert-relative-module-path
|
||||||
(if (pair? (syntax-e stx))
|
(if (pair? (syntax-e stx))
|
||||||
(let ([kw
|
(let ([kw
|
||||||
;; symbolic-identifier=? identifiers are not necessarily free-identifier=?
|
;; symbolic-identifier=? identifiers are not necessarily free-identifier=?
|
||||||
|
@ -59,7 +65,7 @@
|
||||||
(cons kw (cdr d))
|
(cons kw (cdr d))
|
||||||
stx
|
stx
|
||||||
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,6 +244,7 @@
|
||||||
(raise-syntax-error #f
|
(raise-syntax-error #f
|
||||||
"not at module level or top level"
|
"not at module level or top level"
|
||||||
stx))
|
stx))
|
||||||
|
(parameterize ([current-require-module-path #f])
|
||||||
(letrec ([mode-wrap
|
(letrec ([mode-wrap
|
||||||
(lambda (mode base)
|
(lambda (mode base)
|
||||||
(cond
|
(cond
|
||||||
|
@ -358,7 +365,7 @@
|
||||||
(syntax/loc stx
|
(syntax/loc stx
|
||||||
(#%require new-in ...)))]
|
(#%require new-in ...)))]
|
||||||
[(_ in ...)
|
[(_ in ...)
|
||||||
(syntax/loc stx (begin (require 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
|
||||||
|
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
(for-syntax '#%kernel))
|
(for-syntax '#%kernel))
|
||||||
|
|
||||||
(#%provide expand-import
|
(#%provide expand-import
|
||||||
|
current-require-module-path convert-relative-module-path
|
||||||
syntax-local-require-certifier
|
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:
|
||||||
|
@ -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
|
||||||
|
|
|
@ -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?)]{
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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,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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user