From e35337dcfd511007974ba7c08ee51b4cc24b4912 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 15 May 2012 10:29:43 -0600
Subject: [PATCH] add `relative-in'

---
 collects/racket/private/reqprov.rkt           | 325 ++++++++++--------
 collects/racket/require-transform.rkt         | 193 ++++++++++-
 .../scribblings/reference/stx-trans.scrbl     |  45 ++-
 collects/scribblings/reference/syntax.scrbl   |  17 +-
 collects/tests/racket/module.rktl             |  21 ++
 doc/release-notes/racket/HISTORY.txt          |   1 +
 6 files changed, 445 insertions(+), 157 deletions(-)

diff --git a/collects/racket/private/reqprov.rkt b/collects/racket/private/reqprov.rkt
index bff57cf5c7..c8e3307791 100644
--- a/collects/racket/private/reqprov.rkt
+++ b/collects/racket/private/reqprov.rkt
@@ -2,7 +2,7 @@
   (#%require "define.rkt"
              (for-syntax '#%kernel
                          "stx.rkt" "stxcase-scheme.rkt" "small-scheme.rkt" 
-                         "stxloc.rkt" "qqstx.rkt"
+                         "stxloc.rkt" "qqstx.rkt" "more-scheme.rkt"
                          "../require-transform.rkt"
                          "../provide-transform.rkt"
                          "struct-info.rkt"))
@@ -11,6 +11,7 @@
              for-syntax for-template for-label for-meta
              require
              only-in rename-in prefix-in except-in combine-in only-meta-in
+             relative-in
              provide
              all-defined-out all-from-out
              rename-out except-out prefix-out struct-out combine-out
@@ -30,36 +31,41 @@
   ;; lib, file, planet, submod
   
   (define-for-syntax (xlate-path stx)
-    (if (pair? (syntax-e stx))
-        (let ([kw
-               ;; symbolic-identifier=? identifiers are not necessarily free-identifier=?
-               (syntax-case stx (lib planet file submod quote)
-                 [(quote . _) 'quote]
-                 [(lib . _) 'lib]
-                 [(planet . _) 'planet]
-                 [(file . _) 'file]
-                 [(submod . _) 'submod])]
-              [d (syntax->datum stx)])
-          (cond
-           [(eq? kw 'submod)
-            (syntax-case stx ()
-              [(_ mp . rest)
-               (let ([new-mp (xlate-path #'mp)])
-                 (if (and (eq? new-mp #'mp)
-                          (eq? (car d) 'submod))
-                     stx
-                     (datum->syntax
+    ;; 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))
+         (let ([kw
+                ;; symbolic-identifier=? identifiers are not necessarily free-identifier=?
+                (syntax-case stx (lib planet file submod quote)
+                  [(quote . _) 'quote]
+                  [(lib . _) 'lib]
+                  [(planet . _) 'planet]
+                  [(file . _) 'file]
+                  [(submod . _) 'submod])]
+               [d (syntax->datum stx)])
+           (cond
+            [(eq? kw 'submod)
+             (syntax-case stx ()
+               [(_ mp . rest)
+                (let ([new-mp (xlate-path #'mp)])
+                  (if (and (eq? new-mp #'mp)
+                           (eq? (car d) 'submod))
                       stx
-                      (list* kw new-mp #'rest)
-                      stx
-                      stx)))])]
-           [(eq? (car d) kw) stx]
-           [else (datum->syntax
-                  stx
-                  (cons kw (cdr d))
-                  stx
-                  stx)]))
-        stx))
+                      (datum->syntax
+                       stx
+                       (list* kw new-mp #'rest)
+                       stx
+                       stx)))])]
+            [(eq? (car d) kw) stx]
+            [else (datum->syntax
+                   stx
+                   (cons kw (cdr d))
+                   stx
+                   stx)]))
+         stx)))
   
   (define-for-syntax (check-lib-form stx)
     (unless (module-path? (syntax->datum (xlate-path stx)))
@@ -238,127 +244,128 @@
       (raise-syntax-error #f
                           "not at module level or top level"
                           stx))
-    (letrec ([mode-wrap
-              (lambda (mode base)
-                (cond
-                  [(eq? mode 0) base]
-                  [else #`(for-meta #,mode #,base)]))]
-             [simple-path? (lambda (p)
-                             (syntax-case p (lib quote)
-                               [(lib . _)
-                                (check-lib-form p)]
-                               [(quote . _)
-                                (check-lib-form p)]
-                               [_
-                                (or (identifier? p)
-                                    (and (string? (syntax-e p))
-                                         (module-path? (syntax-e p))))]))]
-             [transform-simple
-              (lambda (in base-mode)
-                (syntax-case in (lib file planet submod prefix-in except-in quote)
-                  ;; Detect simple cases first:
-                  [_ 
-                   (string? (syntax-e in))
-                   (begin
-                     (unless (module-path? (syntax-e in))
-                       (raise-syntax-error
-                        #f
-                        "bad module-path string"
-                        stx
-                        in))
-                     (list (mode-wrap base-mode in)))]
-                  [_
-                   (and (identifier? in)
-                        (module-path? (syntax-e #'in)))
-                   (list (mode-wrap base-mode in))]
-                  [(quote . s)
-                   (check-lib-form in)
-                   (list (mode-wrap base-mode (xlate-path in)))]
-                  [(lib . s)
-                   (check-lib-form in)
-                   (list (mode-wrap base-mode (xlate-path in)))]
-                  [(file . s)
-                   (check-lib-form in)
-                   (list (mode-wrap base-mode (xlate-path in)))]
-                  [(planet . s)
-                   (check-lib-form in)
-                   (list (mode-wrap base-mode (xlate-path in)))]
-                  [(submod . s)
-                   (check-lib-form in)
-                   (list (mode-wrap base-mode (xlate-path in)))]
-                  [(prefix-in pfx path)
-                   (simple-path? #'path)
-                   (list (mode-wrap
-                          base-mode
-                          (datum->syntax
-                           #'path
-                           (syntax-e
-                            (quasisyntax
-                             (prefix pfx #,(xlate-path #'path))))
-                           in
-                           in)))]
-                  [(except-in path id ...)
-                   (and (simple-path? #'path)
-                        ;; check that it's well-formed...
-                        (call-with-values (lambda () (expand-import in))
-                          (lambda (a b) #t)))
-                   (list (mode-wrap
-                          base-mode
-                          (datum->syntax
-                           #'path
-                           (syntax-e
-                            (quasisyntax/loc in
-                              (all-except #,(xlate-path #'path) id ...))))))]
-                  ;; General case:
-                  [_ (let-values ([(imports sources) (expand-import in)])
-                       ;; TODO: collapse back to simple cases when possible
-                       (append
-                        (map (lambda (import)
-                               #`(just-meta
-                                  #,(import-orig-mode import)
-                                  #,(mode-wrap (phase+ base-mode (import-req-mode import))
-                                               #`(rename #,(import-src-mod-path import)
-                                                         #,(import-local-id import)
-                                                         #,(import-src-sym import)))))
-                             imports)
-                        (map (lambda (src)
-                               (mode-wrap (phase+ base-mode (import-source-mode src))
-                                          #`(only #,(import-source-mod-path-stx src))))
-                             sources)))]))]
-             [transform-one
-              (lambda (in)
-                ;; Recognize `for-syntax', etc. for simple cases:
-                (syntax-case in (for-meta)
-                  [(for-meta n elem ...)
-                   (or (exact-integer? (syntax-e #'n))
-                       (not (syntax-e #'n)))
-                   (apply append
-                          (map (lambda (in)
-                                 (transform-simple in (syntax-e #'n)))
-                               (syntax->list #'(elem ...))))]
-                  [(for-something elem ...)
-                   (and (identifier? #'for-something)
-                        (ormap (lambda (i) (free-identifier=? i #'for-something))
-                               (list #'for-syntax #'for-template #'for-label)))
-                   (apply append
-                          (map (lambda (in)
-                                 (transform-simple in
-                                                   (cond
-                                                    [(free-identifier=? #'for-something #'for-syntax)
-                                                     1]
-                                                    [(free-identifier=? #'for-something #'for-template)
-                                                     -1]
-                                                    [(free-identifier=? #'for-something #'for-label)
-                                                     #f])))
-                               (syntax->list #'(elem ...))))]
-                  [_ (transform-simple in 0 #| run phase |#)]))])
-      (syntax-case stx ()
-        [(_ in)
-         (with-syntax ([(new-in ...) (transform-one #'in)])
-           (syntax/loc stx
-             (#%require new-in ...)))]
-        [(_ in ...)
-         (syntax/loc stx (begin (require in) ...))])))
+    (parameterize ([current-require-module-path #f])
+      (letrec ([mode-wrap
+                (lambda (mode base)
+                  (cond
+                   [(eq? mode 0) base]
+                   [else #`(for-meta #,mode #,base)]))]
+               [simple-path? (lambda (p)
+                               (syntax-case p (lib quote)
+                                 [(lib . _)
+                                  (check-lib-form p)]
+                                 [(quote . _)
+                                  (check-lib-form p)]
+                                 [_
+                                  (or (identifier? p)
+                                      (and (string? (syntax-e p))
+                                           (module-path? (syntax-e p))))]))]
+               [transform-simple
+                (lambda (in base-mode)
+                  (syntax-case in (lib file planet submod prefix-in except-in quote)
+                    ;; Detect simple cases first:
+                    [_ 
+                     (string? (syntax-e in))
+                     (begin
+                       (unless (module-path? (syntax-e in))
+                         (raise-syntax-error
+                          #f
+                          "bad module-path string"
+                          stx
+                          in))
+                       (list (mode-wrap base-mode in)))]
+                    [_
+                     (and (identifier? in)
+                          (module-path? (syntax-e #'in)))
+                     (list (mode-wrap base-mode in))]
+                    [(quote . s)
+                     (check-lib-form in)
+                     (list (mode-wrap base-mode (xlate-path in)))]
+                    [(lib . s)
+                     (check-lib-form in)
+                     (list (mode-wrap base-mode (xlate-path in)))]
+                    [(file . s)
+                     (check-lib-form in)
+                     (list (mode-wrap base-mode (xlate-path in)))]
+                    [(planet . s)
+                     (check-lib-form in)
+                     (list (mode-wrap base-mode (xlate-path in)))]
+                    [(submod . s)
+                     (check-lib-form in)
+                     (list (mode-wrap base-mode (xlate-path in)))]
+                    [(prefix-in pfx path)
+                     (simple-path? #'path)
+                     (list (mode-wrap
+                            base-mode
+                            (datum->syntax
+                             #'path
+                             (syntax-e
+                              (quasisyntax
+                               (prefix pfx #,(xlate-path #'path))))
+                             in
+                             in)))]
+                    [(except-in path id ...)
+                     (and (simple-path? #'path)
+                          ;; check that it's well-formed...
+                          (call-with-values (lambda () (expand-import in))
+                            (lambda (a b) #t)))
+                     (list (mode-wrap
+                            base-mode
+                            (datum->syntax
+                             #'path
+                             (syntax-e
+                              (quasisyntax/loc in
+                                (all-except #,(xlate-path #'path) id ...))))))]
+                    ;; General case:
+                    [_ (let-values ([(imports sources) (expand-import in)])
+                         ;; TODO: collapse back to simple cases when possible
+                         (append
+                          (map (lambda (import)
+                                 #`(just-meta
+                                    #,(import-orig-mode import)
+                                    #,(mode-wrap (phase+ base-mode (import-req-mode import))
+                                                 #`(rename #,(import-src-mod-path import)
+                                                           #,(import-local-id import)
+                                                           #,(import-src-sym import)))))
+                               imports)
+                          (map (lambda (src)
+                                 (mode-wrap (phase+ base-mode (import-source-mode src))
+                                            #`(only #,(import-source-mod-path-stx src))))
+                               sources)))]))]
+               [transform-one
+                (lambda (in)
+                  ;; Recognize `for-syntax', etc. for simple cases:
+                  (syntax-case in (for-meta)
+                    [(for-meta n elem ...)
+                     (or (exact-integer? (syntax-e #'n))
+                         (not (syntax-e #'n)))
+                     (apply append
+                            (map (lambda (in)
+                                   (transform-simple in (syntax-e #'n)))
+                                 (syntax->list #'(elem ...))))]
+                    [(for-something elem ...)
+                     (and (identifier? #'for-something)
+                          (ormap (lambda (i) (free-identifier=? i #'for-something))
+                                 (list #'for-syntax #'for-template #'for-label)))
+                     (apply append
+                            (map (lambda (in)
+                                   (transform-simple in
+                                                     (cond
+                                                      [(free-identifier=? #'for-something #'for-syntax)
+                                                       1]
+                                                      [(free-identifier=? #'for-something #'for-template)
+                                                       -1]
+                                                      [(free-identifier=? #'for-something #'for-label)
+                                                       #f])))
+                                 (syntax->list #'(elem ...))))]
+                    [_ (transform-simple in 0 #| run phase |#)]))])
+        (syntax-case stx ()
+          [(_ in)
+           (with-syntax ([(new-in ...) (transform-one #'in)])
+             (syntax/loc stx
+               (#%require new-in ...)))]
+          [(_ in ...)
+           (syntax/loc stx (begin (require in) ...))]))))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; require transformers
@@ -615,6 +622,22 @@
                   imports)
              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
   
diff --git a/collects/racket/require-transform.rkt b/collects/racket/require-transform.rkt
index ca06e57ada..5c68ce0b00 100644
--- a/collects/racket/require-transform.rkt
+++ b/collects/racket/require-transform.rkt
@@ -8,7 +8,8 @@
              (for-syntax '#%kernel))
   
   (#%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?
              ;; the import struct type:
              import struct:import make-import import?
@@ -72,6 +73,193 @@
   (define orig-insp (variable-reference->module-declaration-inspector
                      (#%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)
   (define (expand-import stx)
     (let ([disarmed-stx (syntax-disarm stx orig-insp)])
@@ -91,7 +279,8 @@
               #f
               "invalid module-path form"
               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
               (apply
                append
diff --git a/collects/scribblings/reference/stx-trans.scrbl b/collects/scribblings/reference/stx-trans.scrbl
index d592f81f24..5dc1d3d6c7 100644
--- a/collects/scribblings/reference/stx-trans.scrbl
+++ b/collects/scribblings/reference/stx-trans.scrbl
@@ -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].}
 
 
-@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?)))]{
 
 Returns an association list from @tech{phase-level} numbers (or
 @racket[#f] for the @tech{label phase level}) to lists of symbols,
 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[]}
 
@@ -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)
          ((syntax?) (or/c #f (syntax? . -> . syntax?)) 
           . ->* . syntax?)]{
diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl
index ccf1b220f6..0658d29b20 100644
--- a/collects/scribblings/reference/syntax.scrbl
+++ b/collects/scribblings/reference/syntax.scrbl
@@ -1,7 +1,8 @@
 #lang scribble/doc
 @(require "mz.rkt" scribble/bnf scribble/core
           (for-label (only-in racket/require-transform
-                              make-require-transformer)
+                              make-require-transformer
+                              current-require-module-path)
                      racket/require-syntax
                      racket/require
                      (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]}
 
 @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-spec module-path
                              (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)
                              (rename-in require-spec [orig-id bind-id] ...)
                              (combine-in require-spec ...)
+                             (relative-in module-path require-spec ...)
                              (only-meta-in phase-level require-spec ...)
                              (for-syntax require-spec ...)
                              (for-template require-spec ...)
@@ -491,6 +494,16 @@ bindings of each @racket[require-spec] are visible for expanding later
     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 ...)]{
   Like the combination of @racket[require-spec]s, but removing any
   binding that is not for @racket[phase-level], where @racket[#f] for
diff --git a/collects/tests/racket/module.rktl b/collects/tests/racket/module.rktl
index 90d3be1210..464e713889 100644
--- a/collects/tests/racket/module.rktl
+++ b/collects/tests/racket/module.rktl
@@ -470,6 +470,27 @@
 (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"))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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
 
diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt
index edd717faeb..32b859455d 100644
--- a/doc/release-notes/racket/HISTORY.txt
+++ b/doc/release-notes/racket/HISTORY.txt
@@ -1,6 +1,7 @@
 Version 5.3.0.8
 Added variable-reference->module-path-index
 Added syntax-local-submodules
+Added relative-in
 
 Version 5.3.0.7
 compiler/zo-struct: added cancel-id field to phase-shift