Add a new #:dont-re-require-enter' flag for enter!', to avoid

requiring itself into the entered namespace.

This makes it useful in some cases where this require leads to a
dependency cycle, eg (enter! racket/list).  It's obviously not useful
for use as-is, since you will not have a bound `enter!' to get out of
the namespace (and possibly no `require' to get it) -- but it is useful
for meta-tools like xrepl.  This is why the flag is verbose.  `xrepl'
now uses this flag.

Also, the check for valid keywords for the form is now done at runtime
rather than in the macro.  This doesn't matter in this case, since the
form is intended for interactive use anyway.

Also, separate the two parts of `enter-load/use-compiled' (it was
defined curried, but didn't use it).
(cherry picked from commit db7f2b4542)
This commit is contained in:
Eli Barzilay 2011-07-14 16:57:45 -04:00
parent 0b0de351fd
commit 225f563bda
3 changed files with 76 additions and 59 deletions

View File

@ -5,73 +5,85 @@
(provide enter!)
(define-syntax (enter! stx)
(define (do-enter mod noise)
(unless (or (not (syntax-e mod)) (module-path? (syntax->datum mod)))
(raise-syntax-error #f "not a valid module path, and not #f" stx mod))
(unless (memq (syntax-e noise) '(#:verbose #:quiet #:verbose-reload))
(raise-syntax-error #f "not a valid verbosity keyword" stx noise))
#`(do-enter! '#,mod '#,noise))
(syntax-protect
(syntax-case stx ()
[(enter! mod) (do-enter #'mod #'#:verbose-reload)]
[(enter! mod noise) (do-enter #'mod #'noise)]
[(enter! mod flag ...) (andmap keyword? (syntax->datum #'(flag ...)))
#'(do-enter! 'mod '(flag ...))]
[_ (raise-syntax-error
#f "bad syntax; should be `(enter! <module-path-or-#f> [noise-flag])'"
#f "bad syntax; should be `(enter! <module-path-or-#f> [flag...])'"
stx)])))
(define orig-namespace (current-namespace))
(define (do-enter! mod noise)
(if mod
(begin (enter-require mod noise)
(let ([ns (module->namespace mod)])
(current-namespace ns)
(namespace-require 'racket/enter)))
(current-namespace orig-namespace)))
(define (check-flags flags)
;; check that all flags are known, that at most one of the noise flags is
;; present, and add #:verbose-reload if none are (could be done at the macro
;; level, but this is intended for interactive use anyway)
(let loop ([flags (remove-duplicates flags eq?)] [noise #f])
(cond [(null? flags)
(if noise '() '(#:verbose-reload))]
[(eq? (car flags) '#:dont-re-require-enter)
(cons (car flags) (loop (cdr flags) noise))]
[(not (memq (car flags) '(#:verbose #:quiet #:verbose-reload)))
(error 'enter! "unknown flag: ~e" (car flags))]
[noise (error 'enter! "contradicting noise flags: ~e and ~e"
noise (car flags))]
[else (cons (car flags) (loop (cdr flags) (car flags)))])))
(define (do-enter! mod flags)
(let ([flags (check-flags flags)])
(if mod
(begin (enter-require mod flags)
(let ([ns (module->namespace mod)])
(current-namespace ns)
(unless (memq '#:dont-re-require-enter flags)
(namespace-require 'racket/enter))))
(current-namespace orig-namespace))))
(struct mod (name timestamp depends))
(define loaded (make-hash))
(define (enter-require mod noise)
(define (enter-require mod flags)
;; Collect dependencies while loading:
(parameterize ([current-load/use-compiled
(enter-load/use-compiled (current-load/use-compiled)
#f noise)])
#f flags)])
(dynamic-require mod #f))
;; Reload anything that's not up to date:
(check-latest mod noise))
(check-latest mod flags))
(define ((enter-load/use-compiled orig re? noise) path name)
(define (enter-load/use-compiled orig re? flags)
(define notify
(if (case noise [(#:verbose-reload) re?] [(#:verbose) #t] [(#:quiet) #f])
(if (or (memq '#:verbose flags) (and re? (memq '#:verbose-reload flags)))
(lambda (path)
(fprintf (current-error-port)
" [~aloading ~a]\n" (if re? "re-" "") path))
void))
(if name
;; Module load:
(let* ([code (get-module-code
path "compiled"
(lambda (e)
(parameterize ([compile-enforce-module-constants #f])
(compile e)))
(lambda (ext loader?) (load-extension ext) #f)
#:notify notify)]
[dir (or (current-load-relative-directory) (current-directory))]
[path (path->complete-path path dir)]
[path (normal-case-path (simplify-path path))])
;; Record module timestamp and dependencies:
(let ([a-mod (mod name
(get-timestamp path)
(if code
(append-map cdr (module-compiled-imports code))
null))])
(hash-set! loaded path a-mod))
;; Evaluate the module:
(eval code))
;; Not a module:
(begin (notify path) (orig path name))))
(lambda (path name)
(if name
;; Module load:
(let* ([code (get-module-code
path "compiled"
(lambda (e)
(parameterize ([compile-enforce-module-constants #f])
(compile e)))
(lambda (ext loader?) (load-extension ext) #f)
#:notify notify)]
[dir (or (current-load-relative-directory) (current-directory))]
[path (path->complete-path path dir)]
[path (normal-case-path (simplify-path path))])
;; Record module timestamp and dependencies:
(let ([a-mod (mod name
(get-timestamp path)
(if code
(append-map cdr (module-compiled-imports code))
null))])
(hash-set! loaded path a-mod))
;; Evaluate the module:
(eval code))
;; Not a module:
(begin (notify path) (orig path name)))))
(define (get-timestamp path)
(file-or-directory-modify-seconds path #f
@ -81,7 +93,7 @@
(path-replace-suffix path #".ss") #f (lambda () -inf.0))
-inf.0))))
(define (check-latest mod noise)
(define (check-latest mod flags)
(define mpi (module-path-index-join mod #f))
(define done (make-hash))
(let loop ([mpi mpi])
@ -98,7 +110,7 @@
(when (ts . > . (mod-timestamp mod))
(define orig (current-load/use-compiled))
(parameterize ([current-load/use-compiled
(enter-load/use-compiled orig #f noise)]
(enter-load/use-compiled orig #f flags)]
[current-module-declare-name rpath])
((enter-load/use-compiled orig #t noise)
((enter-load/use-compiled orig #t flags)
npath (mod-name mod)))))))))

View File

@ -7,7 +7,7 @@
@defform*[[(enter! module-path)
(enter! #f)
(enter! module-path noise-flag)]]{
(enter! module-path flag ...+)]]{
Intended for use in a @tech{REPL}, such as when @exec{racket} is
started in interactive mode. When a @racket[module-path] is provided
@ -26,13 +26,17 @@ module is re-loaded. Re-loading support works only for modules that
are first loaded (either directly or indirectly through transitive
@racket[require]s) via @racket[enter!].
After switching namespaces to the designated module, @racket[enter!]
automatically requires @racket[racket/enter] into the namespace, so
that @racket[enter!] can be used to switch namespaces again.
When @racket[enter!] loads or re-loads a module from a file, it can
print a message to @racket[(current-error-port)], as determined by the
optional @racket[noise-flag]. It can be @racket[#:verbose] to print a
message about such loads and re-loads, @racket[#:verbose-reload] to
print a message only for re-loaded modules, and it can be
@racket[#:quiet] for no printouts.}
Additional @racket[flag]s can customize aspects of @racket[enter!]:
@itemize[
@item{When @racket[enter!] loads or re-loads a module from a file, it
can print a message to @racket[(current-error-port)]. Use a
@racket[#:verbose] flag to print a message about such loads and
re-loads, @racket[#:verbose-reload] to print a message only for
re-loaded modules, and @racket[#:quiet] for no printouts. The default
reporting corresponds to @racket[#:verbose-reload].}
@item{After switching namespaces to the designated module,
@racket[enter!] automatically requires @racket[racket/enter] into the
namespace, so that @racket[enter!] can be used to switch namespaces
again. In some cases this might not be desirable (e.g., in a tool
that uses @racket[racket/enter])---use a
@racket[#:dont-re-require-enter] to diable this.}]

View File

@ -647,7 +647,8 @@
"optional, without it you go back to the toplevel. A module name can"
"specify an existing file as with the ,require command. (Note that this"
"can be used even in languages that don't have the `enter!' binding.)"]
(eval-sexpr-for-user `(,(enter!-id) ,(getarg 'modspec))))
(eval-sexpr-for-user `(,(enter!-id) ,(getarg 'modspec)
#:dont-re-require-enter)))
(defcommand (toplevel top) #f
"go back to the toplevel"