From 89dee6f6c143f5db9e9f637f7ae32a5ef7654b16 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 18 Mar 2012 01:32:56 -0400 Subject: [PATCH] Xrepl improvements, mainly around the treatment of module names. * Get rid of the concept of `modspec': `getarg' now has `require' for require specs and `module' for a module name (the latter is what all previous uses of 'modspec except for ,require really needed); command descriptions use "" and "", documentation adjusted as well. * `module-name?' etc turn to `known-module' and `known-module-name', with a saner behavior, and tests to keep it sane. * This cleans up a lot of things. Two specific points: ,switch works better with toplevel-defined modules (see the corresponding change in the test suite), and also fixes PR 12148. * Ensure that ,sh commands return void. * Add tests for ,r with non-atomic require spec, and for use of $F in ,sh commands. * Improved the test suite, including uses of `module+' so each file can be run by itself to perform a subset of the tests. --- collects/tests/xrepl/main.rkt | 6 +- collects/tests/xrepl/wrapping-output.rkt | 87 +++++----- collects/tests/xrepl/xrepl.rkt | 16 +- collects/xrepl/xrepl.rkt | 204 +++++++++++++---------- collects/xrepl/xrepl.scrbl | 18 +- 5 files changed, 193 insertions(+), 138 deletions(-) diff --git a/collects/tests/xrepl/main.rkt b/collects/tests/xrepl/main.rkt index 10daa27615..40b373297f 100644 --- a/collects/tests/xrepl/main.rkt +++ b/collects/tests/xrepl/main.rkt @@ -1,4 +1,6 @@ #lang at-exp racket/base -(require "xrepl.rkt" "wrapping-output.rkt") -(test-xrepl) +(require "xrepl.rkt" "wrapping-output.rkt" "known-module.rkt" tests/eli-tester) +(test do (test-wrapping-output) + do (test-known-module) + do (test-xrepl)) diff --git a/collects/tests/xrepl/wrapping-output.rkt b/collects/tests/xrepl/wrapping-output.rkt index eaaec34ca5..7798a8f840 100644 --- a/collects/tests/xrepl/wrapping-output.rkt +++ b/collects/tests/xrepl/wrapping-output.rkt @@ -23,45 +23,48 @@ (define s string-append) (define n "\n") -(wrap-column 12) - -(test @s{blah} @s{blah}) -(test @s{blah@n} @s{blah@n}) -(test @s{#blah} @s{#blah}) -(test @s{#blah@n} @s{#blah@n}) -(test @s{#blah @n} @s{#blah@n}) -(test @s{# blah@n} @s{# blah@n}) -(test @s{# blah @n} @s{# blah@n}) -(test @s{#blah - #blah@n} - @s{#blah - #blah@n}) -(test @s{#ab cd ef gh ij kl mn op qr st} - @s{#ab cd ef gh - # ij kl mn - # op qr st}) -(test @s{#ab cd ef gh ij kl mn op qr st@n} - @s{#ab cd ef gh - # ij kl mn - # op qr st@n}) -(test @s{#ab - #cd ef gh ij kl mn op qr st@n} - @s{#ab - #cd ef gh ij - # kl mn op - # qr st@n}) -(test @s{# ab - # cd ef gh ij kl mn op qr st@n} - @s{# ab - # cd ef gh - # ij kl - # mn op - # qr st@n}) -(test @s{# ab - # cd ef gh ij kl mn op qr st@n} - @s{# ab - # cd ef gh - # ij kl mn - # op qr - # st@n}) -(printf "~a wrapped output tests passed\n" test-num) +(provide test-wrapping-output) +(module+ main (test-wrapping-output)) +(define (test-wrapping-output) + (wrap-column 12) + (test @s{blah} @s{blah}) + (test @s{blah@n} @s{blah@n}) + (test @s{#blah} @s{#blah}) + (test @s{#blah@n} @s{#blah@n}) + (test @s{#blah @n} @s{#blah@n}) + (test @s{# blah@n} @s{# blah@n}) + (test @s{# blah @n} @s{# blah@n}) + (test @s{#blah + #blah@n} + @s{#blah + #blah@n}) + (test @s{#ab cd ef gh ij kl mn op qr st} + @s{#ab cd ef gh + # ij kl mn + # op qr st}) + (test @s{#ab cd ef gh ij kl mn op qr st@n} + @s{#ab cd ef gh + # ij kl mn + # op qr st@n}) + (test @s{#ab + #cd ef gh ij kl mn op qr st@n} + @s{#ab + #cd ef gh ij + # kl mn op + # qr st@n}) + (test @s{# ab + # cd ef gh ij kl mn op qr st@n} + @s{# ab + # cd ef gh + # ij kl + # mn op + # qr st@n}) + (test @s{# ab + # cd ef gh ij kl mn op qr st@n} + @s{# ab + # cd ef gh + # ij kl mn + # op qr + # st@n}) + (printf "~a wrapped output tests passed\n" test-num) + #t) diff --git a/collects/tests/xrepl/xrepl.rkt b/collects/tests/xrepl/xrepl.rkt index f599eae6b4..08e85258e2 100644 --- a/collects/tests/xrepl/xrepl.rkt +++ b/collects/tests/xrepl/xrepl.rkt @@ -70,9 +70,12 @@ (repl-> (car strs)) (loop (cdr strs) #f)]))) +(require setup/dirs) (define tmp (path->string (find-system-path 'temp-dir))) +(define collects (path->string (find-collects-dir))) (provide test-xrepl) +(module+ main (test-xrepl)) (define test-xrepl @make-xrepl-test{ -> «^» ; ^: no saved values, yet [,bt for context] @@ -107,7 +110,7 @@ -> «,en foo» ⇒ but this still works 'foo> «,top» -> «,switch foo» - ; *** Initializing a new `foo' namespace with "racket/init.rkt" *** + ; *** Initializing a new `foo' namespace with 'foo *** ; *** Switching to the `foo' namespace *** foo::-> «,switch typed/racket» ; *** Initializing a new `typed/racket' namespace with typed/racket *** @@ -153,5 +156,16 @@ 'broken> «foo» 123 ⇒ ...but we still got in 'broken> «,top» + -> «string->jsexpr» + ; reference to undefined identifier: string->jsexpr [,bt for context] + -> «,r (only-in json string->jsexpr)» ⇒ works with an expression + -> «string->jsexpr» + #jsexpr> + -> «jsexpr->string» ⇒ didn't get this + ; reference to undefined identifier: jsexpr->string [,bt for context] + -> «,en json» + json/main> «,sh echo $F» + @|collects|/json/main.rkt + json/main> «,top» -> «,ex» @||}) diff --git a/collects/xrepl/xrepl.rkt b/collects/xrepl/xrepl.rkt index c33ba9cd38..ece0e52e66 100644 --- a/collects/xrepl/xrepl.rkt +++ b/collects/xrepl/xrepl.rkt @@ -18,6 +18,7 @@ (define home-dir (find-system-path 'home-dir)) +(define-namespace-anchor anchor) (define (here-namespace) (namespace-anchor->namespace anchor)) ;; autoloads: avoid loading a ton of stuff to minimize startup penalty @@ -39,7 +40,6 @@ (defautoload racket/path find-relative-path) ;; similar, but just for identifiers -(define-namespace-anchor anchor) (define hidden-namespace (make-base-namespace)) (define initial-namespace (current-namespace)) ;; when `racket/enter' initializes, it grabs the `current-namespace' to get @@ -64,12 +64,62 @@ (define (eval-sexpr-for-user form) (eval (namespace-syntax-introduce (datum->syntax #f form)))) -(define (modspec->path modspec) ; returns a symbol for 'foo specs - (resolved-module-path-name ((current-module-name-resolver) modspec #f #f))) +;; If `mod' is a known module, return it; if it's a symbol and 'mod is +;; known, return 'mod; otherwise return #f. If `mode' is 'path, return +;; a path for modules that come from files and #f otherwise, and if it's +;; 'path/sym return a path for the same and a symbolic name for known +;; modules with that name. +(define (known-module mod [mode #f]) + (define (known-top mod) + (and (not (eq? mode 'path)) + (with-handlers ([exn:fail? (λ (_) #f)]) + (module->imports mod) + (if (eq? mode 'path/sym) (cadr mod) mod)))) + (match mod + [(list 'quote (? symbol?)) (known-top mod)] + [_ (or (with-handlers ([exn:fail? (λ (_) #f)]) + (define r + (resolved-module-path-name + ((current-module-name-resolver) mod #f #f))) + (if (not mode) + (and r mod) + ;; sanity check that path results exists + (and (or (and (path? r) (file-exists? r)) + (and (eq? mode 'path/sym) (symbol? r))) + r))) + ;; for symbols, try also 'mod + (and (symbol? mod) (known-top `',mod)))])) +(define (module->path module) + (resolved-module-path-name ((current-module-name-resolver) module #f #f))) + (define (mpi->name mpi) (resolved-module-path-name (module-path-index-resolve mpi))) (define (->relname x) - (if (path-string? x) (path->relative-string/setup x) x)) + (cond [(path-string? x) (path->relative-string/setup x)] + [x])) + +(define (module-displayable-name mod) + (define (choose-path x) + ;; choose the shortest from an absolute path, a relative path, and a + ;; "~/..." path. + (if (not (complete-path? x)) ; shouldn't happen + x + (let* ([r (path->string (find-relative-path (current-directory) x))] + [h (path->string (build-path (string->path-element "~") + (find-relative-path home-dir x)))] + [best (if (< (string-length r) (string-length h)) r h)] + [best (if (< (string-length best) (string-length x)) best x)]) + best))) + (define (get-prefix* path) + (define x (path->string path)) + (define y (->relname path)) + (if (equal? x y) + (format "~s" (choose-path x)) + (regexp-replace #rx"[.]rkt$" y ""))) + (match mod + [(? symbol?) (symbol->string mod)] + [(list 'quote (? symbol? s)) (format "'~a" s)] + [_ (get-prefix* mod)])) (define (here-source) ; returns a path, a symbol, or #f (= not in a module) (variable-reference->module-source @@ -84,7 +134,7 @@ (cond [(not fmt) s] [s (format fmt s)] [else ""])) ;; true if (quote sym) is a known module name -(define (module-name? sym) +(define (known-module-name? sym) (and (symbol? sym) (with-handlers ([exn? (λ (_) #f)]) (module->imports `',sym) #t))) @@ -194,7 +244,7 @@ (if (not x) eof (datum->syntax #f - (cond [(symbol? x) (and (module-name? x) `',x)] + (cond [(symbol? x) `',x] [(path? x) (let ([s (path->string x)]) (if (absolute-path? x) `(file ,s) s))] [else (error 'here-mod-or-eof "internal error: ~s" x)]))))) @@ -232,30 +282,37 @@ (if m (bytes->string/locale m) eof))) (define (read-line-arg) (regexp-replace* #px"^\\s+|\\s+$" (read-line) "")) - (define (process-modspec spec) - ;; convenience: symbolic modspecs that name a file turn to a `file' spec, - ;; and those that name a known module turn to a (quote sym) spec - (define dtm (if (syntax? spec) (syntax->datum spec) spec)) + (define (symbolic-shorthand x) + ;; convenience: symbolic requires that name a file turn to a `file' + ;; require, and those that name a known module turn to a (quote sym) + (define dtm (if (syntax? x) (syntax->datum x) x)) (if (not (symbol? dtm)) - spec + x (let* (;; try a file [f (expand-user-path (symbol->string dtm))] [f (and (file-exists? f) (path->string f))] [f (and f (if (absolute-path? f) `(file ,f) f))] ;; try a quoted one if the above failed - [m (or f (and (module-name? dtm) `',dtm))] - [m (and m (if (syntax? spec) (datum->syntax spec m spec) m))]) - (or m spec)))) + [m (or f (and (known-module-name? dtm) `',dtm))] + [m (and m (if (syntax? x) (datum->syntax x m x) m))]) + (or m x)))) + (define (process-require req) + ;; no verification of requires -- let the usual error happen if needed + (symbolic-shorthand req)) + (define (process-module mod) + (or (known-module (symbolic-shorthand mod)) + (cmderror "unknown module: ~s" mod))) (define (translate arg convert) (and arg (if (memq flag '(list list+)) (map convert arg) (convert arg)))) (let loop ([kind kind]) (case kind - [(line) (get read-line-arg)] - [(string) (get read-string-arg)] - [(path) (translate (loop 'string) expand-user-path)] - [(sexpr) (get read)] - [(syntax) (translate (get read-syntax) namespace-syntax-introduce)] - [(modspec) (translate (loop 'syntax) process-modspec)] + [(line) (get read-line-arg)] + [(string) (get read-string-arg)] + [(path) (translate (loop 'string) expand-user-path)] + [(sexpr) (get read)] + [(syntax) (translate (get read-syntax) namespace-syntax-introduce)] + [(require) (translate (loop 'syntax) process-require)] + [(module) (translate (loop 'sexpr) process-module)] [else (error 'getarg "unknown arg kind: ~e" kind)]))) (define (run-command cmd) @@ -351,7 +408,8 @@ [(not arg) cmd] [else (string-append cmd " " arg)])) (eprintf "; (exit with an error status)\n")) - (when here (putenv "F" ""))))) + (when here (putenv "F" "")) + (void)))) (defcommand (edit e) " ..." "edit files in your $EDITOR" @@ -539,16 +597,7 @@ (wrapped-output (for ([id/mod (in-list ids/mods)]) (define dtm (syntax->datum id/mod)) - (define mod - (and try-mods? - (match dtm - [(list 'quote (and sym (? module-name?))) sym] - [(? module-name?) dtm] - [_ (let ([x (with-handlers ([exn:fail? (λ (_) #f)]) - (modspec->path dtm))]) - (cond [(or (not x) (path? x)) x] - [(symbol? x) (and (module-name? x) `',x)] - [else (error 'describe "internal error: ~s" x)]))]))) + (define mod (and try-mods? (known-module dtm 'path/sym))) (define bind (cond [(identifier? id/mod) (identifier-binding id/mod level)] [mod #f] @@ -662,32 +711,32 @@ ;; ---------------------------------------------------------------------------- ;; require/load commands -(defcommand (require req r) " ...+" +(defcommand (require req r) " ...+" "require a module" ["The arguments are usually passed to `require', unless an argument" "specifies an existing filename -- in that case, it's like using a" "\"string\" or a (file \"...\") in `require'. (Note: this does not" "work in subforms.)"] - (more-inputs #`(require #,@(getarg 'modspec 'list+)))) ; use *our* `require' + (more-inputs #`(require #,@(getarg 'require 'list+)))) ; use *our* `require' (define rr-modules (make-hash)) ; hash to remember reloadable modules -(define last-rr-specs '()) +(define last-rr-modules '()) -(defcommand (require-reloadable reqr rr) " ..." +(defcommand (require-reloadable reqr rr) " ..." "require a module, make it reloadable" ["Same as ,require but the module is required in a way that makes it" "possible to reload later. If it was already loaded then it is reloaded." "Note that this is done by setting `compile-enforce-module-constants' to" "#f, which prohibits some optimizations."] - (let ([s (getarg 'modspec 'list)]) (when (pair? s) (set! last-rr-specs s))) - (when (null? last-rr-specs) (cmderror "missing modspec arguments")) + (let ([ms (getarg 'module 'list)]) + (when (pair? ms) (set! last-rr-modules ms))) + (when (null? last-rr-modules) (cmderror "missing module argument(s)")) (parameterize ([compile-enforce-module-constants (compile-enforce-module-constants)]) (compile-enforce-module-constants #f) - (for ([spec (in-list last-rr-specs)]) - (define datum (syntax->datum spec)) - (define resolved ((current-module-name-resolver) datum #f #f #f)) + (for ([mod (in-list last-rr-modules)]) + (define resolved ((current-module-name-resolver) mod #f #f #f)) (define path (resolved-module-path-name resolved)) (if (hash-ref rr-modules resolved #f) ;; reload @@ -697,12 +746,12 @@ ;; require (begin (hash-set! rr-modules resolved #t) (printf "; requiring ~a\n" path) - ;; (namespace-require spec) - (eval #`(require #,spec))))))) + ;; (namespace-require mod) + (eval #`(require #,mod))))))) (define enter!-id (make-lazy-identifier 'enter! 'racket/enter)) -(defcommand (enter en) "[] [noisy?]" +(defcommand (enter en) "[] [noisy?]" "require a module and go into its namespace" ["Uses `enter!' to go into the module's namespace. A module name can" "specify an existing file as with the ,require command. If no module is" @@ -710,7 +759,7 @@ "is used with that module, causing it to reload if needed. (Note that this" "can be used even in languages that don't have the `enter!' binding.)"] (eval-sexpr-for-user `(,(enter!-id) - ,(getarg 'modspec #:default here-mod-or-eof) + ,(getarg 'module #:default here-mod-or-eof) ,@(getarg 'syntax 'list) #:dont-re-require-enter))) @@ -915,25 +964,29 @@ (defcommand (switch-namespace switch) "[] [? | - | ! []]" "switch to a different repl namespace" ["Switch to the namespace, creating it if needed. The of a" - "namespace is a symbol or an integer where a `*' indicates the initial one;" - "it is only used to identify namespaces for this command (so don't confuse" - "it with racket bindings). A new namespace is initialized using the name" - "of the namespace (if it's require-able), or using the same initial module" - "that was used for the current namespace. If `! ' is used, it" - "indicates that a new namespace will be created even if it exists, using" - "`' as the initial module, and if just `!' is used, then this happens" - "with the existing namespace's init or with the current one's. You can" - "also use `-' and a name to drop the corresponding namespace (allowing it" - "to be garbage-collected), and `?' to list all known namespaces." + "namespace is a symbol or an integer; `*' indicates the initial namespace." + "These names are used only by this command, they're not bindings. A new" + "namespace is initialized using the name of the namespace if it names a" + "module, or using the same initial module that was used for the current" + "namespace." + "If `! ' is used, the new namespace will be created even if it" + "exists, using `' as the initial module. If `!' is used without an" + " to reset an existing namespace its initial module is used again," + "and if it is used to create a new namespace, the initial module in current" + "namespace used." + "You can also use `-' and a name to drop the corresponding namespace" + "(allowing it to be garbage-collected), and `?' to list all known" + "namespaces." "A few examples:" " ,switch ! reset the current namespace" " ,switch ! racket reset it using the `racket' language" - " ,switch r5rs switch to a new `r5rs' namespace" + " ,switch r5rs switch to a new `r5rs' namespace, initializing it" + " with `r5rs'" " ,switch foo switch to `foo', creating it if it doesn't exist" " ,switch foo ! racket switch to newly made `foo', even if it exists" " ,switch foo ! same, but using the same as it was created" - " with, or same as the current if it's new" - " ,switch ? list known namespaces, showing the above two" + " with, or as the current namespace if `foo' is new" + " ,switch ? list known namespaces and their initial modules" " ,switch - r5rs drop the `r5rs' namespace" "(Note that you can use `^' etc to communicate values between namespaces.)"] (define (list-namespaces) @@ -960,10 +1013,6 @@ (unless (or (not name) (symbol? name) (fixnum? name)) (cmderror "bad namespace name, must be symbol or fixnum")) (define old-namespace (current-namespace)) - (define (is-require-able? name) - (with-handlers ([void (λ (_) #f)]) - ;; name is not a string => no need to set the current directory - (file-exists? (modspec->path name)))) ;; if there's an , then it must be forced (let* ([name (or name (current-namespace-name))] [init @@ -974,18 +1023,22 @@ ;; possible to ,en xrepl/xrepl to change options etc (cmderror "cannot reset the default namespace")) (cdr (or (hash-ref namespaces name #f) - (and (is-require-able? name) (cons #f name)) + (let ([k (known-module name)]) (and k (cons #f k))) (hash-ref namespaces (current-namespace-name) #f) ;; just in case (hash-ref namespaces default-namespace-name #f)))] [else #f])]) (when init - (printf "; *** ~a `~s' namespace with ~s ***\n" + (printf "; *** ~a `~s' namespace with ~a ***\n" (if (hash-ref namespaces name #f) "Resetting the" "Initializing a new") name - (->relname init)) + (module-displayable-name init)) (current-namespace (make-base-empty-namespace)) + (unless (known-module init) + (parameterize ([current-namespace old-namespace]) + (dynamic-require init #f)) ; instantiate it if needed + (namespace-attach-module old-namespace init)) (namespace-require init) (hash-set! namespaces name (cons (current-namespace) init)))) (when (and name (not (eq? name (current-namespace-name)))) @@ -1077,11 +1130,11 @@ (cmderror "internal error: ~s ~s" stx (syntax? stx)))]))) (defautoload macro-debugger/analysis/check-requires show-requires) -(defcommand (check-requires ckreq) "[]" +(defcommand (check-requires ckreq) "[]" "check the `require's of a module" ["Uses `macro-debugger/analysis/check-requires', see the docs for more" "information."] - (define mod (syntax->datum (getarg 'modspec #:default here-mod-or-eof))) + (define mod (getarg 'module #:default here-mod-or-eof)) (define rs (show-requires mod)) (wrapped-output (for ([decision (in-list '(keep bypass drop))]) @@ -1288,26 +1341,9 @@ (define get-prefix ; to show before the "> " prompt (let () - (define (choose-path x) - ;; choose the shortest from an absolute path, a relative path, and a - ;; "~/..." path. - (if (not (complete-path? x)) ; shouldn't happen - x - (let* ([r (path->string (find-relative-path (current-directory) x))] - [h (path->string (build-path (string->path-element "~") - (find-relative-path home-dir x)))] - [best (if (< (string-length r) (string-length h)) r h)] - [best (if (< (string-length best) (string-length x)) best x)]) - best))) - (define (get-prefix* path) - (define x (path->string path)) - (define y (->relname path)) - (if (equal? x y) - (format "~s" (choose-path x)) - (regexp-replace #rx"[.]rkt$" y ""))) (define (get-prefix) (let* ([x (here-source)] - [x (and x (if (symbol? x) (format "'~s" x) (get-prefix* x)))] + [x (and x (module-displayable-name (if (symbol? x) `',x x)))] [x (or x (toplevel-prefix))] [x (let ([ph (namespace-base-phase)]) (if (eq? 0 ph) x (format "~a[~a]" x ph)))]) diff --git a/collects/xrepl/xrepl.scrbl b/collects/xrepl/xrepl.scrbl index ef06a61239..1abed01e1c 100644 --- a/collects/xrepl/xrepl.scrbl +++ b/collects/xrepl/xrepl.scrbl @@ -161,20 +161,20 @@ available. @defcmd[require]{ Most arguments are passed to @racket[require] as is. As a - convenience, if an argument specifies an existing file name, then use - its string form to specify the require, or use a @racket[file] in case - of an absolute path. In addition, an argument that names a known - symbolic module name (e.g., one that was defined on the REPL, or a - builtin module like @racket[#%network]), then its quoted form is used. - (Note that these shorthands do not work inside require subforms like - @racket[only-in].) + convenience, if a symbolic argument specifies an existing file name, + then use its string form to specify the require, or use a + @racket[file] in case of an absolute path. In addition, an argument + that names a known symbolic module name (e.g., one that was defined on + the REPL, or a builtin module like @racket[#%network]), then its + quoted form is used. (Note that these shorthands do not work inside + require subforms like @racket[only-in].) } @defcmd[require-reloadable]{ Same as @cmd[require], but arranges to load the code in a way that makes it possible to reload it later, or if a module was already loaded (using this command) then reload it. Note that the arguments - should be simple specifications, without any require macros. If no + should be simple module names, without any require macros. If no arguments are given, use arguments from the last use of this command (if any). @@ -185,7 +185,7 @@ available. } @defcmd[enter]{ - Uses @racket[enter!] to have the REPL go `inside' a given module's + Uses @racket[enter!] to have the REPL go ``inside'' a given module's namespace. A module name can specify an existing file as with the @cmd[require-reloadable] command. If no module is given, and the REPL is already in some module's namespace, then `enter!' is used with that