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:
parent
0b0de351fd
commit
225f563bda
|
@ -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)))))))))
|
||||
|
|
|
@ -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.}]
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Reference in New Issue
Block a user