suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Xrepl improvements, mainly around the treatment of module names.

Browse Source 
* 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 "<require-spec>" and "<module>", 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.
This commit is contained in:
Eli Barzilay 2012-03-18 01:32:56 -04:00
parent 5280ef1517
commit 89dee6f6c1
5 changed files with 193 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/tests/xrepl/main.rkt
View File

@ -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))

87
collects/tests/xrepl/wrapping-output.rkt
View File

@ -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)

16
collects/tests/xrepl/xrepl.rkt
View File

@ -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»
#<procedure:string->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»
@||})

204
collects/xrepl/xrepl.rkt
View File

@ -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) "<file> ..."
"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) "<module-spec> ...+"
(defcommand (require req r) "<require-spec> ...+"
"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) "<simple-module-spec> ..."
(defcommand (require-reloadable reqr rr) "<module> ..."
"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) "[<simple-module-spec>] [noisy?]"
(defcommand (enter en) "[<module>] [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) "[<name>] [? | - | ! [<init>]]"
"switch to a different repl namespace"
["Switch to the <name> namespace, creating it if needed. The <name> 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 `! <init>' is used, it"
"indicates that a new namespace will be created even if it exists, using"
"`<init>' 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 `! <init>' is used, the new namespace will be created even if it"
"exists, using `<init>' as the initial module. If `!' is used without an"
"<init> 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 <init> 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 <init>, 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) "[<simple-module-spec>]"
(defcommand (check-requires ckreq) "[<module>]"
"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)))])

18
collects/xrepl/xrepl.scrbl
View File

@ -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