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,50 +5,62 @@
|
||||||
(provide enter!)
|
(provide enter!)
|
||||||
|
|
||||||
(define-syntax (enter! stx)
|
(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-protect
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(enter! mod) (do-enter #'mod #'#:verbose-reload)]
|
[(enter! mod flag ...) (andmap keyword? (syntax->datum #'(flag ...)))
|
||||||
[(enter! mod noise) (do-enter #'mod #'noise)]
|
#'(do-enter! 'mod '(flag ...))]
|
||||||
[_ (raise-syntax-error
|
[_ (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)])))
|
stx)])))
|
||||||
|
|
||||||
(define orig-namespace (current-namespace))
|
(define orig-namespace (current-namespace))
|
||||||
|
|
||||||
(define (do-enter! mod noise)
|
(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
|
(if mod
|
||||||
(begin (enter-require mod noise)
|
(begin (enter-require mod flags)
|
||||||
(let ([ns (module->namespace mod)])
|
(let ([ns (module->namespace mod)])
|
||||||
(current-namespace ns)
|
(current-namespace ns)
|
||||||
(namespace-require 'racket/enter)))
|
(unless (memq '#:dont-re-require-enter flags)
|
||||||
(current-namespace orig-namespace)))
|
(namespace-require 'racket/enter))))
|
||||||
|
(current-namespace orig-namespace))))
|
||||||
|
|
||||||
(struct mod (name timestamp depends))
|
(struct mod (name timestamp depends))
|
||||||
|
|
||||||
(define loaded (make-hash))
|
(define loaded (make-hash))
|
||||||
|
|
||||||
(define (enter-require mod noise)
|
(define (enter-require mod flags)
|
||||||
;; Collect dependencies while loading:
|
;; Collect dependencies while loading:
|
||||||
(parameterize ([current-load/use-compiled
|
(parameterize ([current-load/use-compiled
|
||||||
(enter-load/use-compiled (current-load/use-compiled)
|
(enter-load/use-compiled (current-load/use-compiled)
|
||||||
#f noise)])
|
#f flags)])
|
||||||
(dynamic-require mod #f))
|
(dynamic-require mod #f))
|
||||||
;; Reload anything that's not up to date:
|
;; 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
|
(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)
|
(lambda (path)
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
" [~aloading ~a]\n" (if re? "re-" "") path))
|
" [~aloading ~a]\n" (if re? "re-" "") path))
|
||||||
void))
|
void))
|
||||||
|
(lambda (path name)
|
||||||
(if name
|
(if name
|
||||||
;; Module load:
|
;; Module load:
|
||||||
(let* ([code (get-module-code
|
(let* ([code (get-module-code
|
||||||
|
@ -71,7 +83,7 @@
|
||||||
;; Evaluate the module:
|
;; Evaluate the module:
|
||||||
(eval code))
|
(eval code))
|
||||||
;; Not a module:
|
;; Not a module:
|
||||||
(begin (notify path) (orig path name))))
|
(begin (notify path) (orig path name)))))
|
||||||
|
|
||||||
(define (get-timestamp path)
|
(define (get-timestamp path)
|
||||||
(file-or-directory-modify-seconds path #f
|
(file-or-directory-modify-seconds path #f
|
||||||
|
@ -81,7 +93,7 @@
|
||||||
(path-replace-suffix path #".ss") #f (lambda () -inf.0))
|
(path-replace-suffix path #".ss") #f (lambda () -inf.0))
|
||||||
-inf.0))))
|
-inf.0))))
|
||||||
|
|
||||||
(define (check-latest mod noise)
|
(define (check-latest mod flags)
|
||||||
(define mpi (module-path-index-join mod #f))
|
(define mpi (module-path-index-join mod #f))
|
||||||
(define done (make-hash))
|
(define done (make-hash))
|
||||||
(let loop ([mpi mpi])
|
(let loop ([mpi mpi])
|
||||||
|
@ -98,7 +110,7 @@
|
||||||
(when (ts . > . (mod-timestamp mod))
|
(when (ts . > . (mod-timestamp mod))
|
||||||
(define orig (current-load/use-compiled))
|
(define orig (current-load/use-compiled))
|
||||||
(parameterize ([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])
|
[current-module-declare-name rpath])
|
||||||
((enter-load/use-compiled orig #t noise)
|
((enter-load/use-compiled orig #t flags)
|
||||||
npath (mod-name mod)))))))))
|
npath (mod-name mod)))))))))
|
||||||
|
|
|
@ -7,7 +7,7 @@
|
||||||
|
|
||||||
@defform*[[(enter! module-path)
|
@defform*[[(enter! module-path)
|
||||||
(enter! #f)
|
(enter! #f)
|
||||||
(enter! module-path noise-flag)]]{
|
(enter! module-path flag ...+)]]{
|
||||||
|
|
||||||
Intended for use in a @tech{REPL}, such as when @exec{racket} is
|
Intended for use in a @tech{REPL}, such as when @exec{racket} is
|
||||||
started in interactive mode. When a @racket[module-path] is provided
|
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
|
are first loaded (either directly or indirectly through transitive
|
||||||
@racket[require]s) via @racket[enter!].
|
@racket[require]s) via @racket[enter!].
|
||||||
|
|
||||||
After switching namespaces to the designated module, @racket[enter!]
|
Additional @racket[flag]s can customize aspects of @racket[enter!]:
|
||||||
automatically requires @racket[racket/enter] into the namespace, so
|
@itemize[
|
||||||
that @racket[enter!] can be used to switch namespaces again.
|
@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
|
||||||
When @racket[enter!] loads or re-loads a module from a file, it can
|
@racket[#:verbose] flag to print a message about such loads and
|
||||||
print a message to @racket[(current-error-port)], as determined by the
|
re-loads, @racket[#:verbose-reload] to print a message only for
|
||||||
optional @racket[noise-flag]. It can be @racket[#:verbose] to print a
|
re-loaded modules, and @racket[#:quiet] for no printouts. The default
|
||||||
message about such loads and re-loads, @racket[#:verbose-reload] to
|
reporting corresponds to @racket[#:verbose-reload].}
|
||||||
print a message only for re-loaded modules, and it can be
|
@item{After switching namespaces to the designated module,
|
||||||
@racket[#:quiet] for no printouts.}
|
@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"
|
"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"
|
"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.)"]
|
"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
|
(defcommand (toplevel top) #f
|
||||||
"go back to the toplevel"
|
"go back to the toplevel"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user