Improve some printouts.

Specifically the one from ,rr.  Also make ,switch syntax error more
friendly.  Also, test for the recent xrepl fix, including its printout.
(cherry picked from commit e311de0522)
This commit is contained in:
Eli Barzilay 2013-04-17 16:38:23 -04:00 committed by Ryan Culpepper
parent e32c855a48
commit 42e442a755
2 changed files with 25 additions and 8 deletions

View File

@ -188,5 +188,18 @@
json/main> «,sh echo $F» json/main> «,sh echo $F»
@|collects|/json/main.rkt @|collects|/json/main.rkt
json/main> «,top» json/main> «,top»
-> «(display-to-file "#lang racket\n(provide x)\n(define x 1)\n"
"xrepl-test.rkt" #:exists 'truncate)»
-> «,rr "xrepl-test.rkt"» first load
; requiring "xrepl-test.rkt"
-> «x»
1
-> «(display-to-file "#lang racket\n(provide x)\n(define x 2)\n"
"xrepl-test.rkt" #:exists 'truncate)»
-> «,rr xrepl-test.rkt»
; reloading "xrepl-test.rkt"
-> «,rm xrepl-test.rkt»
-> «x»
2
-> «,ex» -> «,ex»
@||}) @||})

View File

@ -110,15 +110,18 @@
[best (if (< (string-length best) (string-length x)) best x)]) [best (if (< (string-length best) (string-length x)) best x)])
best))) best)))
(define (get-prefix* path) (define (get-prefix* path)
(define x (path->string path)) (define x (if (string? path) path (path->string path)))
(define y (->relname path)) (define y (->relname path))
(if (equal? x y) (if (equal? x y)
(format "~s" (choose-path x)) (format "~s" (choose-path x))
(regexp-replace #rx"[.]rkt$" y ""))) (regexp-replace #rx"[.]rkt$" y "")))
(match mod (let loop ([mod mod])
[(? symbol?) (symbol->string mod)] (match mod
[(list 'quote (? symbol? s)) (format "'~a" s)] [(? symbol?) (symbol->string mod)]
[_ (get-prefix* mod)])) [(list 'quote (? symbol? s)) (format "'~a" (loop s))]
[(list 'file (? string? s)) (loop (string->path s))]
[(or (? path?) (? string?)) (get-prefix* mod)]
[_ (error 'xrepl "internal error; ~v" mod)])))
(define (here-source) ; returns a path, a symbol, or #f (= not in a module) (define (here-source) ; returns a path, a symbol, or #f (= not in a module)
(variable-reference->module-source (variable-reference->module-source
@ -749,14 +752,15 @@
(for ([mod (in-list last-rr-modules)]) (for ([mod (in-list last-rr-modules)])
(define resolved ((current-module-name-resolver) mod #f #f #f)) (define resolved ((current-module-name-resolver) mod #f #f #f))
(define path (resolved-module-path-name resolved)) (define path (resolved-module-path-name resolved))
(define disp (module-displayable-name mod))
(if (hash-ref rr-modules resolved #f) (if (hash-ref rr-modules resolved #f)
;; reload ;; reload
(begin (printf "; reloading ~a\n" path) (begin (printf "; reloading ~a\n" disp)
(parameterize ([current-module-declare-name resolved]) (parameterize ([current-module-declare-name resolved])
(load/use-compiled path))) (load/use-compiled path)))
;; require ;; require
(begin (hash-set! rr-modules resolved #t) (begin (hash-set! rr-modules resolved #t)
(printf "; requiring ~a\n" path) (printf "; requiring ~a\n" disp)
;; (namespace-require mod) ;; (namespace-require mod)
(eval #`(require #,mod))))))) (eval #`(require #,mod)))))))
@ -1063,7 +1067,7 @@
(current-namespace-name name) (current-namespace-name name)
(current-namespace (car (hash-ref namespaces name))))) (current-namespace (car (hash-ref namespaces name)))))
(define (syntax-error) (define (syntax-error)
(cmderror "syntax error, see ,help switch-namespace")) (cmderror "syntax error, see \",help ~s\"" (current-command)))
(match (getarg 'sexpr 'list) (match (getarg 'sexpr 'list)
[(list) (cmderror "what do you want to do?")] [(list) (cmderror "what do you want to do?")]
[(list '?) (list-namespaces)] [(list '?) (list-namespaces)]