From 32b53e65496675b4dfa64abef1962b2a47e41781 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 19 Jul 2011 17:03:17 -0400 Subject: [PATCH] Remove xrepl from the release branch. --- collects/meta/dist-specs.rkt | 3 - collects/meta/props | 2 - collects/tests/xrepl/main.rkt | 94 --- collects/xrepl/doc-utils.rkt | 80 -- collects/xrepl/info.rkt | 5 - collects/xrepl/main.rkt | 13 - collects/xrepl/xrepl.rkt | 1345 --------------------------------- collects/xrepl/xrepl.scrbl | 496 ------------ 8 files changed, 2038 deletions(-) delete mode 100644 collects/tests/xrepl/main.rkt delete mode 100644 collects/xrepl/doc-utils.rkt delete mode 100644 collects/xrepl/info.rkt delete mode 100644 collects/xrepl/main.rkt delete mode 100644 collects/xrepl/xrepl.rkt delete mode 100644 collects/xrepl/xrepl.scrbl diff --git a/collects/meta/dist-specs.rkt b/collects/meta/dist-specs.rkt index 99187995f3..13fa0f72f9 100644 --- a/collects/meta/dist-specs.rkt +++ b/collects/meta/dist-specs.rkt @@ -511,9 +511,6 @@ mz-extras :+= (collects: "rnrs/") ;; -------------------- readline mz-extras :+= (package: "readline/") -;; -------------------- readline -mz-extras :+= (package: "xrepl/") - ;; -------------------- wxme mz-extras :+= (collects: "wxme/") diff --git a/collects/meta/props b/collects/meta/props index 4f3df0511a..e428687d58 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1979,7 +1979,6 @@ path/s is either such a string or a list of them. "collects/tests/xml" responsible (jay) "collects/tests/xml/test-clark.rkt" drdr:command-line #f drdr:timeout 300 "collects/tests/xml/xml-snip-bug.rkt" drdr:command-line (gracket "-t" *) -"collects/tests/xrepl" responsible (eli) "collects/tests/zo-size.rkt" responsible (jay) "collects/tex2page" responsible (jay) "collects/texpict" responsible (mflatt robby) @@ -2070,7 +2069,6 @@ path/s is either such a string or a list of them. "collects/xml/text-box-tool.rkt" drdr:command-line (gracket-text "-t" *) "collects/xml/text-snipclass.rkt" drdr:command-line (gracket-text "-t" *) "collects/xml/xml-snipclass.rkt" drdr:command-line (gracket-text "-t" *) -"collects/xrepl" responsible (eli) "doc/release-notes/COPYING-libscheme.txt" responsible (mflatt) "doc/release-notes/COPYING.txt" responsible (mflatt) "doc/release-notes/drracket" responsible (robby) diff --git a/collects/tests/xrepl/main.rkt b/collects/tests/xrepl/main.rkt deleted file mode 100644 index e73c7b3408..0000000000 --- a/collects/tests/xrepl/main.rkt +++ /dev/null @@ -1,94 +0,0 @@ -#lang at-exp racket/base - -(define verbose? (make-parameter #t)) - -(define global-ns (current-namespace)) - -(define stderr (current-error-port)) - -(define (test-xrepl . args) - (define show-all? (verbose?)) - (define-values [Ii Io] (make-pipe)) - (define-values [Oi Oo] (make-pipe)) - (define repl-thread - (parameterize ([current-input-port Ii] - [current-output-port Oo] - [current-error-port Oo] - [current-namespace (make-empty-namespace)] - [error-print-context-length 0] ; easier output - [exit-handler (λ (_) (kill-thread repl-thread))]) - (thread (λ () - (namespace-attach-module global-ns 'racket/base) - (namespace-require 'racket) - (dynamic-require 'xrepl #f) - (read-eval-print-loop))))) - (define (repl-> expected) - (define output (read-string (string-length expected) Oi)) - (if (equal? output expected) - (when show-all? (display output)) - (error 'xrepl "test failure, expected ~s, got ~s" expected output))) - (let loop ([strs args] [input? #f]) - (cond - [(and (pair? strs) (equal? "" (car strs))) - (loop (cdr strs) input?)] - [(and (thread-dead? repl-thread) (null? strs)) - (printf "All tests passed.\n")] - [(thread-dead? repl-thread) - (error 'xrepl "test failure, repl thread died unexpectedly")] - [(null? strs) - (if (sync/timeout 1 repl-thread) - (loop strs input?) - (error 'xrepl "test failure, repl thread is alive at end of tests"))] - [(eq? '« (car strs)) - (when input? (error 'xrepl "bad test: unterminated `«'")) - (loop (cdr strs) #t)] - [(eq? '» (car strs)) - (unless input? (error 'xrepl "bad test: redundant `»'")) - (loop (cdr strs) 'newline)] - [(regexp-match #rx"^(.*?)(?: *⇒[^\n]*)(.*)" (car strs)) - => (λ (m) (loop (list* (cadr m) (caddr m) (cdr strs)) input?))] - [(regexp-match #rx"^(.*?)([«»])(.*)" (car strs)) - => (λ (m) (loop (list* (cadr m) (string->symbol (caddr m)) (cadddr m) - (cdr strs)) - input?))] - [(eq? 'newline input?) - (unless (regexp-match? #rx"^\n" (car strs)) - (error 'xrepl "bad test: `»' followed by a non-newline")) - (newline Io) (flush-output Io) - (when show-all? (newline) (flush-output)) - (loop (cons (substring (car strs) 1) (cdr strs)) #f)] - [input? - (display (car strs) Io) - (when show-all? (display (car strs)) (flush-output)) - (loop (cdr strs) #t)] - [else - (repl-> (car strs)) - (loop (cdr strs) #f)]))) - -@test-xrepl|={ - -> «(- 2 1)» - 1 - -> «(values 2 3)» - 2 - 3 - -> «(values 4)» - 4 - -> «(list ^ ^^ ^^^ ^^^^)» - '(4 3 2 1) - -> «(module foo racket (define x 123))» - -> «,en foo» - 'foo> «x» - 123 - 'foo> «,top» - -> «(define enter! 123)» - -> «(enter! 'foo)» - procedure application: expected procedure, given: 123; arguments were: 'foo - -> «,en foo» ⇒ but this still works - 'foo> «,top» - -> «,switch foo» - ; *** Initializing a new `foo' namespace with "racket/main.rkt" *** - ; *** Switching to the `foo' namespace *** - foo::-> «,switch *» - ; *** Switching to the `*' namespace *** - -> «,ex» - |=@||}=| diff --git a/collects/xrepl/doc-utils.rkt b/collects/xrepl/doc-utils.rkt deleted file mode 100644 index fe15ecd335..0000000000 --- a/collects/xrepl/doc-utils.rkt +++ /dev/null @@ -1,80 +0,0 @@ -#lang racket/base - -(require scribble/manual scribble/core scribble/decode - racket/list racket/sandbox) - -(provide (all-from-out scribble/manual) - RL GUIDE cmd defcmd check-all-documented) - -(define RL '(lib "readline/readline.scrbl")) -(define GUIDE '(lib "scribblings/guide/guide.scrbl")) - -(define commands - (let ([c #f]) - (λ () - (unless c - (define e (call-with-trusted-sandbox-configuration - (λ () (make-evaluator 'racket/base)))) - (e '(require xrepl/xrepl)) - (e '(current-namespace (module->namespace 'xrepl/xrepl))) - (set! c (e '(for/list ([c (in-list commands-list)]) - (list (car (command-names c)) - (cdr (command-names c)) - (command-argline c) - (command-blurb c))))) - (kill-evaluator e)) - c))) -(define documented '()) - -(define (cmd* name0 . more) - (define name (if (symbol? name0) name0 (string->symbol name0))) - (define full-name - (or (and (assq name (commands)) name) - (for/or ([c (in-list (commands))]) (and (memq name (cadr c)) (car c))) - (error 'cmd "unknown command: ~s" name))) - (define content - (litchar (let ([s (format ",~a" name)]) - (if (pair? more) (apply string-append s " " more) s)))) - (link-element "plainlink" content `(xrepl ,(format "~a" full-name)))) - -(define-syntax-rule (cmd name more ...) (cmd* 'name more ...)) - -(define (cmd-index name) - (define namestr (format ",~a" name)) - (define tag `(xrepl ,(format "~a" name))) - (define content (cmd* name)) - (define ielem - (index-element #f content tag (list namestr) (list content) - 'xrepl-command)) - (toc-target-element #f (list ielem) tag)) - -(define (defcmd* name . text) - (set! documented (cons name documented)) - (define-values [other-names argline blurb] - (apply values (cond [(assq name (commands)) => cdr] - [else (error 'defcmd "unknown command: ~s" name)]))) - (define header - (list (cmd-index name) (litchar (string-append " " (or argline ""))))) - (define desc - (list (hspace 2) (make-element 'italic blurb))) - (define synonyms - (and (pair? other-names) - (list (hspace 2) - "[Synonyms: " - (add-between (map (λ (n) (litchar (format ",~a" n))) - other-names) - " ") - "]"))) - (splice - (list* (tabular #:style 'boxed `((,header) (,desc) - ,@(if synonyms `((,synonyms)) `()))) - "\n" "\n" text))) - -(define-syntax-rule (defcmd name text ...) (defcmd* 'name text ...)) - -(define (check-all-documented) - (unless (= (length documented) (length (remove-duplicates documented))) - (error 'xrepl-docs "some commands were documented multiple times")) - (let ([missing (remove* documented (map car (commands)))]) - (when (pair? missing) - (error 'xrepl-docs "missing command documentation: ~s" missing)))) diff --git a/collects/xrepl/info.rkt b/collects/xrepl/info.rkt deleted file mode 100644 index 96e8ea9a85..0000000000 --- a/collects/xrepl/info.rkt +++ /dev/null @@ -1,5 +0,0 @@ -#lang setup/infotab - -(define name "eXtended REPL") - -(define scribblings '(("xrepl.scrbl" () (tool-library)))) diff --git a/collects/xrepl/main.rkt b/collects/xrepl/main.rkt deleted file mode 100644 index 3a70c4f70f..0000000000 --- a/collects/xrepl/main.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket/base - -;; This file is intended to be loaded from your init file (evaluatue -;; (find-system-path 'init-file) to see where that is on your OS.) - -(require "xrepl.rkt") - -;; may want to disable inlining to allow redefinitions -;; (compile-enforce-module-constants #f) - -;; create the command repl reader, and value-saving evaluator -(current-prompt-read (make-xrepl-reader)) -(current-eval (make-xrepl-evaluator (current-eval))) diff --git a/collects/xrepl/xrepl.rkt b/collects/xrepl/xrepl.rkt deleted file mode 100644 index d4b1a4cd33..0000000000 --- a/collects/xrepl/xrepl.rkt +++ /dev/null @@ -1,1345 +0,0 @@ -#lang racket/base - -;; ---------------------------------------------------------------------------- -;; customization - -(define toplevel-prefix (make-parameter "-")) ; when not in a module -(define saved-values-number (make-parameter 5)) -(define saved-values-char (make-parameter #\^)) -(define wrap-column (make-parameter 79)) -;; TODO: when there's a few more of these, make them come from the prefs - -;; ---------------------------------------------------------------------------- - -(require racket/list racket/match) - -;; ---------------------------------------------------------------------------- -;; utilities - -(define home-dir (find-system-path 'home-dir)) - -;; autoloads: avoid loading a ton of stuff to minimize startup penalty -(define autoloaded-specs (make-hasheq)) -(define (autoloaded? sym) (hash-ref autoloaded-specs sym #f)) -(define-syntax-rule (defautoload libspec id ...) - (begin (define (id . args) - (set! id (parameterize ([current-namespace hidden-namespace]) - (dynamic-require 'libspec 'id))) - (hash-set! autoloaded-specs 'libspec #t) - (hash-set! autoloaded-specs 'id #t) - (apply id args)) - ...)) - -(defautoload racket/system system system*) -(defautoload racket/file file->string) -(defautoload setup/path-to-relative path->relative-string/setup) -(defautoload syntax/modcode get-module-code) -(defautoload racket/path find-relative-path) - -;; similar, but just for identifiers -(define-namespace-anchor anchor) -(define (here-namespace) (namespace-anchor->namespace anchor)) -(define hidden-namespace (make-base-namespace)) -(define initial-namespace (current-namespace)) -;; when `racket/enter' initializes, it grabs the `current-namespace' to get -;; back to -- which means it should be instantiated in a top level namespace -;; rather than in (here-namespace); but if we use `initial-namespace' we -;; essentially rely on the user to not kill `enter!' (eg, (define enter! 4)). -;; the solution is to make a `hidden-namespace' where we store these bindings, -;; then instantiate needed modules in the initial namespace and immediately -;; attach the modules to the hidden one then use it, so changes to the binding -;; in `initial-namespace' doesn't affect us. -(define (make-lazy-identifier sym from) - (define id #f) - (λ () (or id (begin (parameterize ([current-namespace initial-namespace]) - (namespace-require from)) - (parameterize ([current-namespace hidden-namespace]) - (namespace-attach-module initial-namespace from) - (namespace-require from) - (set! id (namespace-symbol->identifier sym)) - id))))) - -;; makes it easy to use meta-tools without user-namespace contamination -(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))) -(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)) - -(define (here-source) ; returns a path, a symbol, or #f (= not in a module) - (variable-reference->module-source - (eval (namespace-syntax-introduce - (datum->syntax #f `(,#'#%variable-reference)))))) - -(define (phase->name phase [fmt #f]) - (define s - (case phase - [(0) #f] [(#f) "for-label"] [(1) "for-syntax"] [(-1) "for-template"] - [else (format "for-meta:~a" phase)])) - (cond [(not fmt) s] [s (format fmt s)] [else ""])) - -;; true if (quote sym) is a known module name -(define (module-name? sym) - (and (symbol? sym) - (with-handlers ([exn? (λ (_) #f)]) (module->imports `',sym) #t))) - -;; support visual column-aware output -;; right after an input expression is entered the terminal won't show the -;; newline, so as far as column counting goes it's still after the prompt which -;; leads to bad output in practice. (at least in the common case where IO -;; share the same terminal.) This will be redundant with the already-added -;; `port-set-next-location!'. -(define last-output-port #f) -(define last-output-line #f) -(define last-output-visual-col #f) -(define (maybe-new-output-port) - (unless (eq? last-output-port (current-output-port)) - (set! last-output-port (current-output-port)) - (flush-output last-output-port) - (port-count-lines! last-output-port) - (let-values ([(line col pos) (port-next-location last-output-port)]) - (set! last-output-line line) - (set! last-output-visual-col col)))) -(define (fresh-line) - (maybe-new-output-port) - (flush-output last-output-port) - (let-values ([(line col pos) (port-next-location last-output-port)]) - (unless (eq? col (if (eq? line last-output-line) last-output-visual-col 0)) - (newline)))) -(define (zero-column!) - ;; there's a problem whenever there's some printout followed by a read: the - ;; cursor will at column zero, but the port counting will think that it's - ;; still right after the printout; call this function in such cases to adjust - ;; the column to 0. - (maybe-new-output-port) - ;; if there was a way to change the location of stdout we'd set the column to - ;; 0 here... - (let-values ([(line col pos) (port-next-location last-output-port)]) - (set! last-output-line line) - (set! last-output-visual-col col))) - -;; wrapped `printf' (cheap but effective), aware of the visual col -(define wrap-prefix (make-parameter "")) -(define (wprintf fmt . args) - (let ([o (current-output-port)] - [wcol (wrap-column)] - [pfx (wrap-prefix)] - [strs (regexp-split #rx" +" (apply format fmt args))]) - (write-string (car strs) o) - (for ([str (in-list (cdr strs))]) - (define-values [line col pos] (port-next-location o)) - (define vcol - (if (eq? line last-output-line) (- col last-output-visual-col) col)) - (if ((+ vcol (string-length str)) . >= . wcol) - (begin (newline o) (write-string pfx o)) - (write-string " " o)) - (write-string str o)))) - -;; ---------------------------------------------------------------------------- -;; toplevel "," commands management - -(struct command (names argline blurb desc handler)) -(define commands (make-hasheq)) -(define commands-list '()) ; for help displays, in definition order -(define current-command (make-parameter #f)) -(define (register-command! names blurb argline desc handler) - (let* ([names (if (list? names) names (list names))] - [cmd (command names blurb argline desc handler)]) - (for ([n (in-list names)]) - (if (hash-ref commands n #f) - (error 'defcommand "duplicate command name: ~s" n) - (hash-set! commands n cmd))) - (set! commands-list (cons cmd commands-list)))) -(define-syntax-rule (defcommand cmd+aliases argline blurb [desc ...] - body0 body ...) - (register-command! `cmd+aliases `argline `blurb `(desc ...) - (λ () body0 body ...))) - -(define (cmderror fmt #:default-who [dwho #f] . args) - (let ([cmd (current-command)]) - (raise-user-error (or (and cmd (string->symbol (format ",~a" cmd))) - dwho '???) - (apply format fmt args)))) - -;; returns first peeked non-space/tab char (#\return is considered space too) -(define string->list* - (let ([t (make-weak-hasheq)]) ; good for string literals - (λ (s) (hash-ref! t s (λ () (string->list s)))))) -(define (skip-spaces/peek [skip " \t\r"]) - (let ([skip (string->list* skip)]) - (let loop () - (let ([ch (peek-char)]) - (if (memq ch skip) (begin (read-char) (loop)) ch))))) - -(define (here-path [no-path eof]) - (let ([x (here-source)]) (if (path? x) x no-path))) -(define (here-mod-or-eof) - (let ([x (here-source)]) - (if (not x) - eof - (datum->syntax #f - (cond [(symbol? x) (and (module-name? 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)]))))) - -(define (getarg kind [flag 'req] #:default [dflt #f]) - (define (argerror fmt . args) - (apply cmderror #:default-who 'getarg fmt args)) - (define (missing) (argerror "missing ~a argument" kind)) - (define (get read) - (define (get-one) - (cond [(eq? read read-line-arg) (read)] - [(eq? #\newline (skip-spaces/peek)) eof] - [else (read)])) - (define (get-list) - (let ([x (get-one)]) (if (eof-object? x) '() (cons x (get-list))))) - (define 1st (get-one)) - (define 1st? (not (eof-object? 1st))) - (define (dflt*) (let ([r (dflt)]) (if (eof-object? r) (missing) r))) - (case flag - [(req opt) (cond [1st? 1st] [dflt (dflt*)] - [(eq? 'opt flag) #f] [else (missing)])] - [(list list+) - (cond [1st? (cons 1st (get-list))] [dflt (list (dflt*))] - [(eq? 'list flag) '()] [else (missing)])] - [else (error 'getarg "unknown flag: ~e" flag)])) - (define (read-string-arg) - (define ch (skip-spaces/peek " \t\r\n")) - (let* ([i (current-input-port)] - [m (if (eq? ch #\") - (let ([m (regexp-match #px#"((?:\\\\.|[^\"\\\\]+)+)\"" i)]) - (and m (regexp-replace* #rx#"\\\\(.)" (cadr m) #"\\1"))) - (cond [(regexp-match #px#"\\S+" i) => car] [else #f]))]) - (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)) - (if (not (symbol? dtm)) - spec - (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)))) - (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)] - [else (error 'getarg "unknown arg kind: ~e" kind)]))) - -(define (run-command cmd) - (parameterize ([current-command cmd]) - (with-handlers ([void (λ (e) - (if (exn? e) - (eprintf "~a\n" (exn-message e)) - (eprintf "~s\n" e)))]) - ((command-handler (or (hash-ref commands cmd #f) - (error "Unknown command:" cmd))))))) - -(defcommand (help h ?) "[]" - "display available commands" - ["Lists known commands and their help; use with a command name to get" - "additional information for that command."] - (define arg (match (getarg 'sexpr 'opt) [(list 'unquote x) x] [x x])) - (define cmd - (and arg (hash-ref commands arg - (λ () (printf "*** Unknown command: `~s'\n" arg) #f)))) - (define (show-cmd cmd indent) - (define names (command-names cmd)) - (printf "~a~s" indent (car names)) - (when (pair? (cdr names)) (printf " ~s" (cdr names))) - (printf ": ~a\n" (command-blurb cmd))) - (if cmd - (begin (show-cmd cmd "; ") - (printf "; usage: ,~a" arg) - (let ([a (command-argline cmd)]) (when a (printf " ~a" a))) - (printf "\n") - (for ([d (in-list (command-desc cmd))]) - (printf "; ~a\n" d))) - (begin (printf "; Available commands:\n") - (for-each (λ (c) (show-cmd c "; ")) (reverse commands-list))))) - -;; ---------------------------------------------------------------------------- -;; generic commands - -(defcommand (exit quit ex) "[]" - "exit racket" - ["Optional argument specifies exit code."] - (cond [(getarg 'sexpr 'opt) => exit] [else (exit)])) - -(define last-2dirs - (make-parameter (let ([d (current-directory)]) (cons d d)))) -(define (report-directory-change [mode #f]) - (define curdir (current-directory)) - (define (report) ; remove last "/" and say where we are - (define-values [base name dir?] (split-path curdir)) - (printf "; now in ~a\n" (if base (build-path base name) curdir))) - (cond [(not (equal? (car (last-2dirs)) curdir)) - (last-2dirs (cons curdir (car (last-2dirs)))) - (report)] - [else (case mode - [(pwd) (report)] - [(cd) (printf "; still in the same directory\n")])])) - -(defcommand cd "[]" - "change the current directory" - ["Sets `current-directory'; expands user paths. With no arguments, goes" - "to your home directory. An argument of `-' indicates the previous" - "directory."] - (let* ([arg (or (getarg 'path 'opt) home-dir)] - [arg (if (equal? arg (string->path "-")) (cdr (last-2dirs)) arg)]) - (if (directory-exists? arg) - (begin (current-directory arg) (report-directory-change 'cd)) - (eprintf "cd: no such directory: ~a\n" arg)))) - -(defcommand pwd #f - "display the current directory" - ["Displays the value of `current-directory'."] - (report-directory-change 'pwd)) - -(defcommand (shell sh ls cp mv rm md rd git svn) "" - "run a shell command" - ["`sh' runs a shell command (via `system'), the aliases run a few useful" - "unix commands. (Note: `ls' has some default arguments set.)" - "If the REPL is inside some module's namespace, the command can use $F" - "which is set to the full path to this module's source file."] - (let* ([arg (getarg 'line)] - [arg (if (equal? "" arg) #f arg)] - [cmd (current-command)]) - (case cmd - [(ls) (set! cmd "ls -F")] - [(shell) (set! cmd 'sh)]) - (let ([cmd (cond [(eq? 'sh cmd) #f] - [(symbol? cmd) (symbol->string cmd)] - [else cmd])] - [here (here-path #f)]) - (putenv "F" (if here (path->string here) "")) - (unless (system (cond [(and (not cmd) (not arg)) (getenv "SHELL")] - [(not cmd) arg] - [(not arg) cmd] - [else (string-append cmd " " arg)])) - (eprintf "(exit with an error status)\n")) - (when here (putenv "F" ""))))) - -(defcommand (edit e) " ..." - "edit files in your $EDITOR" - ["Runs your $EDITOR with the specified file/s. If no files are given, and" - "the REPL is currently inside a module, the file for that module is used." - "If $EDITOR is not set, the ,drracket will be used instead."] - (define env (let ([e (getenv "EDITOR")]) (and (not (equal? "" e)) e))) - (define exe (and env (find-executable-path env))) - (cond [(not env) - (printf "~a, using the ,drracket command.\n" - (if env - (string-append "$EDITOR ("env") not found in your path") - "no $EDITOR variable")) - (run-command 'drracket)] - [(not (apply system* exe (getarg 'path 'list #:default here-path))) - (eprintf "(exit with an error status)\n")] - [else (void)])) - -(define ->running-dr #f) -(define (->dr . xs) (unless ->running-dr (start-dr)) (->running-dr xs)) -(define (start-dr) - (printf "; starting DrRacket...\n") - (define c (make-custodian)) - (define ns ((dynamic-require 'racket/gui 'make-gui-namespace))) - (parameterize ([current-custodian c] - [current-namespace ns] - [exit-handler (λ (x) - (eprintf "DrRacket shutdown.\n") - (set! ->running-dr #f) - (custodian-shutdown-all c))]) - ;; construct a kind of a fake sandbox to run drracket in - (define es - (eval '(begin (require racket/class racket/gui framework racket/file) - (define es (make-eventspace)) - es))) - (define (E expr) - (parameterize ([current-custodian c] - [current-namespace ns] - [(eval 'current-eventspace ns) es]) - (eval expr ns))) - (E '(begin - (define c (current-custodian)) - (define-syntax-rule (Q expr ...) - (parameterize ([current-eventspace es]) - (queue-callback - (λ () (parameterize ([current-custodian c]) expr ...))))) - ;; problem: right after we read commands, readline will save a new - ;; history in the prefs file which frequently collides with drr; so - ;; make it use a writeback thing, with silent failures. (actually, - ;; this is more likely a result of previously starting drr wrongly, - ;; but keep this anyway.) - (let ([t (make-hasheq)] [dirty '()]) - (preferences:low-level-get-preference - (λ (sym [dflt (λ () #f)]) - (hash-ref t sym - (λ () (let ([r (get-preference sym dflt)]) - (hash-set! t sym r) - r))))) - (preferences:low-level-put-preferences - (λ (prefs vals) - (Q (set! dirty (append prefs dirty)) - (for ([pref (in-list prefs)] [val (in-list vals)]) - (hash-set! t pref val))))) - (define (flush-prefs) - (set! dirty (remove-duplicates dirty)) - (with-handlers ([void void]) - (put-preferences dirty (map (λ (p) (hash-ref t p)) dirty)) - (set! dirty '()))) - (exit:insert-on-callback flush-prefs) - (define (write-loop) - (sleep (random 4)) - (when (pair? dirty) (Q (flush-prefs))) - (write-loop)) - (define th (thread write-loop)) - (exit:insert-on-callback (λ () (Q (kill-thread th))))) - ;; start it - (Q (dynamic-require 'drracket #f)) - ;; hide the first untitled window, so drr runs in "server mode" - (Q (dynamic-require 'drracket/tool-lib #f)) - (define top-window - (let ([ch (make-channel)]) - (Q (let ([r (get-top-level-windows)]) - (channel-put ch (and (pair? r) (car r))))) - (channel-get ch))) - (Q (when top-window (send top-window show #f)) - ;; and avoid trying to open new windows in there - (send (group:get-the-frame-group) clear)) - ;; avoid being able to quit so the server stays running, - ;; also hack: divert quitting into closing all group frames - (define should-exit? #f) - (exit:insert-can?-callback - (λ () (or should-exit? - (let ([g (group:get-the-frame-group)]) - (when (send g can-close-all?) (send g on-close-all)) - #f)))) - (require drracket/tool-lib))) ; used as usual below - (define (new) - (E '(Q (drracket:unit:open-drscheme-window #f)))) - (define open - (case-lambda - [() (E '(Q (handler:open-file)))] - [paths - (let ([paths (map path->string paths)]) - (E `(Q (let ([f (drracket:unit:open-drscheme-window ,(car paths))]) - (send f show #t) - ,@(for/list ([p (in-list (cdr paths))]) - `(begin (send f open-in-new-tab ,p) - (send f show #t)))))))])) - (define (quit) - (E `(Q (set! should-exit? #t) (exit:exit)))) - (define (loop) - (define m (thread-receive)) - (if (pair? m) - (let ([proc (case (car m) [(new) new] [(open) open] [(quit) quit] - [else (cmderror "unknown flag: -~a" (car m))])]) - (if (procedure-arity-includes? proc (length (cdr m))) - (apply proc (cdr m)) - (cmderror "bad number of arguments for the -~a flag" (car m)))) - (error '->dr "internal error")) - (loop)) - (define th (thread loop)) - (set! ->running-dr (λ (xs) (thread-send th xs))))) -(defcommand (drracket dr drr) "[-flag] ..." - "edit files in DrRacket" - ["Runs DrRacket with the specified file/s. If no files are given, and" - "the REPL is currently inside a module, the file for that module is used." - "DrRacket is launched directly, without starting a new subprocess, and it" - "is kept running in a hidden window so further invocations are immediate." - "In addition to file arguments, the arguments can have a flag that" - "specifies one of a few operations for the running DrRacket:" - "* -new: opens a new editing window. This is the default when no files are" - " given and the REPL is not inside a module," - "* -open: opens the specified file/s (or the current module's file). This" - " is the default when files are given or when inside a module." - "* -quit: exits the running instance. Quitting the application as usual" - " will only close the visible window, but it will still run in a hidden" - " window. This command should not be needed under normal circumstances."] - (let ([args (getarg 'path 'list #:default here-path)]) - (if (null? args) - (->dr 'new) - (let* ([cmd (let ([s (path->string (car args))]) - (and (regexp-match? #rx"^-" s) - (string->symbol (substring s 1))))] - [args (if cmd (cdr args) args)]) - (apply ->dr (or cmd 'open) args))))) - -;; ---------------------------------------------------------------------------- -;; binding related commands - -(defcommand (apropos ap) " ..." - "look for a binding" - ["Additional arguments restrict the shown matches. The search specs can" - "have symbols (which specify what to look for in bound names), and regexps" - "(for more complicated matches)."] - (let* ([look (map (λ (s) (cond [(symbol? s) - (regexp (regexp-quote (symbol->string s)))] - [(regexp? s) s] - [else (cmderror "bad search spec: ~e" s)])) - (getarg 'sexpr 'list))] - [look (and (pair? look) - (λ (str) (andmap (λ (rx) (regexp-match? rx str)) look)))] - [syms (map (λ (sym) (cons sym (symbol->string sym))) - (namespace-mapped-symbols))] - [syms (if look (filter (λ (s) (look (cdr s))) syms) syms)] - [syms (sort syms string] ..." - "describe a (bound) identifier" - ["For a bound identifier, describe where is it coming from; for a known" - "module, describe its imports and exports. You can use this command with" - "several identifiers. An optional numeric argument specifies phase for" - "identifier lookup."] - (define-values [try-mods? level ids/mods] - (let ([xs (getarg 'syntax 'list)]) - (if (and (pair? xs) (number? (syntax-e (car xs)))) - (values #f (syntax-e (car xs)) (cdr xs)) - (values #t 0 xs)))) - (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 bind - (cond [(identifier? id/mod) (identifier-binding id/mod level)] - [mod #f] - [else (cmderror "not an identifier or a known module: ~s" dtm)])) - (define bind? (or bind (not mod))) - (when bind? (describe-binding dtm bind level)) - (when mod (describe-module dtm mod bind?)))) -(define (describe-binding sym b level) - (define at-phase (phase->name level " (~a)")) - (cond - [(not b) - (printf "; `~s' is a toplevel (or unbound) identifier~a\n" sym at-phase)] - [(eq? b 'lexical) - (printf "; `~s' is a lexical identifier~a\n" sym at-phase)] - [(or (not (list? b)) (not (= 7 (length b)))) - (cmderror "*** internal error, racket changed ***")] - [else - (define-values [src-mod src-id nominal-src-mod nominal-src-id - src-phase import-phase nominal-export-phase] - (apply values b)) - (set! src-mod (->relname (mpi->name src-mod))) - (set! nominal-src-mod (->relname (mpi->name nominal-src-mod))) - (printf "; `~s' is a bound identifier~a,\n" sym at-phase) - (printf "; defined~a in ~a~a\n" (phase->name src-phase "-~a") src-mod - (if (not (eq? sym src-id)) (format " as `~s'" src-id) "")) - (printf "; required~a ~a\n" (phase->name import-phase "-~a") - (if (equal? src-mod nominal-src-mod) - "directly" - (format "through \"~a\"~a" - nominal-src-mod - (if (not (eq? sym nominal-src-id)) - (format " where it is defined as `~s'" nominal-src-id) - "")))) - (printf "~a" (phase->name nominal-export-phase "; (exported-~a)\n"))])) -(define (describe-module sexpr mod-path/sym also?) - (define get - (if (symbol? mod-path/sym) - (let ([spec `',mod-path/sym]) - (λ (imp?) ((if imp? module->imports module->exports) spec))) - (let ([code (get-module-code mod-path/sym)]) - (λ (imp?) - ((if imp? module-compiled-imports module-compiled-exports) code))))) - (define (phase p1 0) (> p2 0)) (< p1 p2)] - [(and (< p1 0) (< p2 0)) (> p1 p2)] - [else (> p1 0)])) - (define (modnamestring x) (symbol->string y))] - [(and (symbol? x) (string? y)) #t] - [(and (string? x) (symbol? y)) #f] - [else (error 'describe-module "internal error: ~s, ~s" x y)])) - (define imports - (filter-map - (λ (x) - (and (pair? (cdr x)) - (cons (car x) (sort (map (λ (m) (->relname (mpi->name m))) (cdr x)) - modnamerelname mod-path/sym)]) - (printf "; ~a~a\n" - (if (symbol? relname) "defined directly as '" "located at ") - relname)) - (if (null? imports) - (printf "; no imports.\n") - (parameterize ([wrap-prefix "; "]) - (for ([imps (in-list imports)]) - (let ([phase (car imps)] [imps (cdr imps)]) - (wprintf "; imports~a: ~a" (phase->name phase "-~a") (car imps)) - (for ([imp (in-list (cdr imps))]) (wprintf ", ~a" imp)) - (wprintf ".\n"))))) - (define (show-exports exports kind) - (parameterize ([wrap-prefix "; "]) - (for ([exps (in-list exports)]) - (let ([phase (car exps)] [exps (cdr exps)]) - (wprintf "; direct ~a exports~a: ~a" - kind (phase->name phase "-~a") (car exps)) - (for ([exp (in-list (cdr exps))]) (wprintf ", ~a" exp)) - (wprintf ".\n"))))) - (if (and (null? val-exports) (null? stx-exports)) - (printf "; no direct exports.\n") - (begin (show-exports val-exports "value") - (show-exports stx-exports "syntax")))) - -(define help-id (make-lazy-identifier 'help 'racket/help)) -(defcommand doc " ..." - "browse the racket documentation" - ["Uses Racket's `help' to browse the documentation. (Note that this can be" - "used even in languages that don't have the `help' binding.)"] - (eval-sexpr-for-user `(,(help-id) ,@(getarg 'syntax 'list)))) - -;; ---------------------------------------------------------------------------- -;; require/load commands - -(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' - -(define rr-modules (make-hash)) ; hash to remember reloadable modules - -(define last-rr-specs '()) - -(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")) - (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)) - (define path (resolved-module-path-name resolved)) - (if (hash-ref rr-modules resolved #f) - ;; reload - (begin (printf "; reloading ~a\n" path) - (parameterize ([current-module-declare-name resolved]) - (load/use-compiled path))) - ;; require - (begin (hash-set! rr-modules resolved #t) - (printf "; requiring ~a\n" path) - ;; (namespace-require spec) - (eval #`(require #,spec))))))) - -(define enter!-id (make-lazy-identifier 'enter! 'racket/enter)) - -(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" - "given, and the REPL is already in some module's namespace, then `enter!'" - "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 'syntax 'list) - #:dont-re-require-enter))) - -(defcommand (toplevel top) #f - "go back to the toplevel" - ["Go back to the toplevel, same as ,enter with no arguments."] - (eval-sexpr-for-user `(,(enter!-id) #f))) - -(defcommand (load ld) " ..." - "load a file" - ["Uses `load' to load the specified file(s)."] - (more-inputs* (map (λ (name) #`(load #,name)) (getarg 'path 'list)))) - -;; ---------------------------------------------------------------------------- -;; debugging commands - -;; not useful: catches only escape continuations -;; (define last-break-exn (make-parameter #f)) -;; (defcommand (continue cont) #f -;; "continue from a break" -;; ["Continue running from the last break."] -;; (if (last-break-exn) -;; ((exn:break-continuation (last-break-exn))) -;; (cmderror 'continue "no break exception to continue from"))) - -(define time-id - (make-lazy-identifier 'time* '(only-in unstable/time [time time*]))) -(defcommand time "[] ..." - "time an expression" - ["Times execution of an expression, similar to `time' but prints a" - "little easier to read information. You can provide an initial number" - "that specifies how many times to run the expression -- in this case," - "the expression will be executed that many times, extreme results are" - "removed (top and bottom 2/7ths), and the remaining results will be" - "averaged. Two garbage collections are triggered before each run; the" - "resulting value(s) are from the last run."] - (more-inputs #`(#,(time-id) #,@(getarg 'syntax 'list)))) - -(define trace-id (make-lazy-identifier 'trace 'racket/trace)) -(defcommand (trace tr) " ..." - "trace a function" - ["Traces a function (or functions), using the `racket/trace' library."] - (eval-sexpr-for-user `(,(trace-id) ,@(getarg 'syntax 'list)))) - -(define untrace-id (make-lazy-identifier 'untrace 'racket/trace)) -(defcommand (untrace untr) " ..." - "untrace a function" - ["Untraces functions that were traced with ,trace."] - (eval-sexpr-for-user `(,(untrace-id) ,@(getarg 'syntax 'list)))) - -(defautoload errortrace - profiling-enabled instrumenting-enabled clear-profile-results - output-profile-results execute-counts-enabled annotate-executed-file) - -(defcommand (errortrace errt inst) "[]" - "errortrace instrumentation control" - ["An argument is used to perform a specific operation:" - " + : turn errortrace instrumentation on (effective only for code that is" - " evaluated from now on)" - " - : turn it off (also only for future evaluations)" - " ? : show status without changing it" - "With no arguments, toggles instrumentation."] - (case (getarg 'sexpr 'opt) - [(#f) (if (autoloaded? 'errortrace) - (instrumenting-enabled (not (instrumenting-enabled))) - (instrumenting-enabled #t))] - [(-) (when (autoloaded? 'errortrace) (instrumenting-enabled #f))] - [(+) (instrumenting-enabled #t)] - [(?) (void)] - [else (cmderror "unknown subcommand")]) - (if (autoloaded? 'errortrace) - (printf "; errortrace instrumentation is ~a\n" - (if (instrumenting-enabled) "on" "off")) - (printf "; errortrace not loaded\n"))) - -(define profile-id - (make-lazy-identifier 'profile 'profile)) -(define (statistical-profiler) - (more-inputs #`(#,(profile-id) #,(getarg 'syntax)))) -(define (errortrace-profiler) - (instrumenting-enabled #t) - (define flags (regexp-replace* #rx"[ \t]+" (getarg 'line) "")) - (for ([cmd (in-string (if (equal? "" flags) - (if (profiling-enabled) "*!" "+") - flags))]) - (case cmd - [(#\+) (profiling-enabled #t) (printf "; profiling is on\n")] - [(#\-) (profiling-enabled #f) (printf "; profiling is off\n")] - [(#\*) (output-profile-results #f #t)] - [(#\#) (output-profile-results #f #f)] - [(#\!) (clear-profile-results) (printf "; profiling data cleared\n")] - [else (cmderror "unknown subcommand")]))) -(defcommand (profile prof) "[ | ...]" - "profiler control" - ["Runs either the exact errortrace-based profiler, or the statistical one." - "* If a parenthesized expression is given, run the statistical profiler" - " while running it. This profiler requires no special setup and adds" - " almost no overhead, it samples stack traces as execution goes on." - "* Otherwise the errortrace profiler is used. This profiler produces" - " precise results, but like other errortrace uses, it must be enabled" - " before loading the code and it adds noticeable overhead. In this case," - " an argument is used to determine a specific operation:" - " + : turn the profiler on (effective only for code that is evaluated" - " from now on)" - " - : turn the profiler off (also only for future evaluations)" - " * : show profiling results by time" - " # : show profiling results by counts" - " ! : clear profiling results" - " Multiple flags can be combined, for example \",prof *!-\" will show" - " profiler results, clear them, and turn it off." - "* With no arguments, turns the errortrace profiler on if it's off, and if" - " it's on it shows the collected results and clears them." - "Note: using no arguments or *any* of the flags turns errortrace" - " instrumentation on, even a \",prof -\". Use the ,errortrace command if" - " you want to turn instrumentation off."] - (if (memq (skip-spaces/peek) '(#\( #\[ #\{)) - (statistical-profiler) - (errortrace-profiler))) - -(defcommand execution-counts " ..." - "execution counts" - ["Enable errortrace instrumentation for coverage, require the file(s)," - "display the results, disables coverage, and disables instrumentation if" - "it wasn't previously turned on."] - (let ([files (getarg 'path 'list)] - [inst? (and (autoloaded? 'errortrace) (instrumenting-enabled))]) - (more-inputs - (λ () - (instrumenting-enabled #t) - (execute-counts-enabled #t)) - #`(require #,@(map (λ (file) `(file ,(path->string file))) files)) - (λ () - (for ([file (in-list files)]) - (annotate-executed-file file " 123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) - (λ () - (execute-counts-enabled #f) - (unless inst? (instrumenting-enabled #f)))))) - -(defautoload racket/sandbox - make-module-evaluator kill-evaluator call-with-trusted-sandbox-configuration - sandbox-coverage-enabled get-uncovered-expressions) - -(defcommand (coverage cover) "" - "coverage information via a sandbox" - ["Runs the given file in a (trusted) sandbox, and annotates it with" - "uncovered expression information."] - (let ([file (getarg 'path)]) - (sandbox-coverage-enabled) ; autoload it - (parameterize ([sandbox-coverage-enabled #t]) - (define e - (call-with-trusted-sandbox-configuration - (λ () (make-module-evaluator file)))) - (define uncovered - (map (λ (x) (let ([p (sub1 (syntax-position x))]) - (cons p (+ p (syntax-span x))))) - (get-uncovered-expressions e #t))) - (kill-evaluator e) - (call-with-input-file file - (λ (inp) - ;; this is a naive and inefficient solution, could be made efficient - ;; using `mzlib/integer-set' - (let loop () - (let* ([start (file-position inp)] - [line (read-line inp)] - [len (and (string? line) (string-length line))] - [end (and len (+ len start))] - [indent (and len (regexp-match-positions #px"\\S" line))] - [indent (and indent (caar indent))]) - (when len - (displayln line) - (when indent - (string-fill! line #\space) - (for ([u (in-list uncovered)]) - (when (and ((car u) . < . end) - ((cdr u) . > . indent)) - (for ([i (in-range (max (- (car u) start) indent) - (min (- (cdr u) start) len))]) - (string-set! line i #\^)))) - (displayln (regexp-replace #rx" +$" line ""))) - (loop))))))))) - -;; ---------------------------------------------------------------------------- -;; namespace switching - -(define default-namespace-name '*) -(define current-namespace-name (make-parameter default-namespace-name)) -(define namespaces - (let* ([r (namespace-symbol->identifier '#%top-interaction)] - [r (identifier-binding r)] - [r (and r (mpi->name (caddr r)))] - [t (make-hasheq)]) - (hash-set! t (current-namespace-name) (cons (current-namespace) r)) - t)) -(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." - "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 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" - " ,switch - r5rs drop the `r5rs' namespace" - "(Note that you can use `^' etc to communicate values between namespaces.)"] - (define (list-namespaces) - (printf "; namespaces and their languages:\n") - (define nss (sort (map (λ (x) (cons (format "~s" (car x)) (cddr x))) - (hash-map namespaces cons)) - 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 - (cond [init] - [(or force-reset? (not (hash-ref namespaces name #f))) - (when (eq? name default-namespace-name) - ;; no deep reason for this, but might be usful to keep it - ;; 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)) - (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" - (if (hash-ref namespaces name #f) - "Resetting the" "Initializing a new") - name - (->relname init)) - (current-namespace (make-base-empty-namespace)) - (namespace-require init) - (hash-set! namespaces name (cons (current-namespace) init)))) - (when (and name (not (eq? name (current-namespace-name)))) - (printf "; *** Switching to the `~s' namespace ***\n" name) - (let ([x (hash-ref namespaces (current-namespace-name))]) - (unless (eq? (car x) old-namespace) - (printf "; (note: saving current namespace for `~s')\n" - (current-namespace-name)) - (hash-set! namespaces (current-namespace-name) - (cons old-namespace (cdr x))))) - (current-namespace-name name) - (current-namespace (car (hash-ref namespaces name))))) - (define (syntax-error) - (cmderror "syntax error, see ,help switch-namespace")) - (match (getarg 'sexpr 'list) - [(list) (cmderror "what do you want to do?")] - [(list '?) (list-namespaces)] - [(list '? _ ...) (syntax-error)] - [(list '- name) (delete name)] - [(list '- _ ...) (syntax-error)] - [(list '!) (switch #f #t #f )] - [(list '! init) (switch #f #t init)] - [(list name) (switch name #f #f )] - [(list name '!) (switch name #t #f )] - [(list name '! init) (switch name #t init)] - [_ (syntax-error)])) - -;; ---------------------------------------------------------------------------- -;; syntax commands - -(define current-syntax (make-parameter #f)) -(defautoload racket/pretty pretty-write) -(defautoload macro-debugger/stepper-text expand/step-text) -(define not-in-base - (λ () (let ([base-stxs #f]) - (unless base-stxs - (set! base-stxs ; all ids that are bound to a syntax in racket/base - (parameterize ([current-namespace hidden-namespace]) - (let-values ([(vals stxs) (module->exports 'racket/base)]) - (map (λ (s) (namespace-symbol->identifier (car s))) - (cdr (assq 0 stxs))))))) - (λ (id) (not (ormap (λ (s) (free-identifier=? id s)) base-stxs)))))) -(define (macro-stepper . args) - (define-values [i o] (make-pipe)) - (parameterize ([current-output-port o]) - (thread (λ () (apply expand/step-text args) (close-output-port o)))) - (let loop () - (define l (read-line i)) - (unless (eof-object? l) - ;; hack: beautify the stepper's output -- remove empty line, indent code - (unless (equal? "" l) - (printf (if (regexp-match? #px"^[A-Z][a-z]+\\b" l) - "; ---- ~a ----\n" "; ~a\n") - l)) - (loop)))) -(defcommand (syntax stx st) "[] [ ...]" - "set syntax object to inspect, and control it" - ["With no arguments, will show the previously set (or expanded) syntax" - "additional arguments serve as an operation to perform:" - "- `^' sets the syntax from the last entered expression" - "- other sexprs set the current syntax explicitly" - "- `+' will `expand-once' the syntax and show the result (can be used again" - " for additional `expand-once' steps)" - "- `!' will `expand' the syntax and show the result" - "- `*' will use the syntax stepper to show expansion steps, leaving macros" - " from racket/base intact (does not change the currently set syntax)" - "- `**' similar to `*', but expanding everything" - "Note that you can specify several syntaxes and operations in a single" - "invocation."] - (define args (getarg 'syntax 'list)) - (for ([stx (in-list (if (null? args) '(#f) args))]) - (define (show/set label stx) - (printf "; ~a\n" label) - (current-syntax stx) - (display "; ") (pretty-write (syntax->datum stx))) - (define (cur) (or (current-syntax) (cmderror "no syntax set yet"))) - (case (and stx (if (identifier? stx) (syntax-e stx) '--none--)) - [(#f) (show/set "Current syntax:" (cur))] - [(^) (if (last-input-syntax) - (show/set "Using last expression:" (last-input-syntax)) - (cmderror "no expression entered yet"))] - [(+) (show/set "expand-once ->" (expand-once (cur)))] - [(!) (show/set "expand ->" (expand (cur)))] - [(*) (printf "; Stepper:\n") (macro-stepper (cur) (not-in-base))] - [(**) (printf "; Stepper:\n") (macro-stepper (cur))] - [else - (if (syntax? stx) - (begin (printf "; Syntax set\n") (current-syntax stx)) - (cmderror "internal error: ~s ~s" stx (syntax? stx)))]))) - -;; ---------------------------------------------------------------------------- -;; dynamic log output control - -(define current-log-receiver-thread (make-parameter #f)) -(define global-logger (current-logger)) - -(defcommand log "" - "control log output" - ["Starts (or stops) logging events at the given level. The level should be" - "one of the valid racket logging levels, or #f for no logging. For" - "convenience, the level can also be #t (maximum logging) or an integer" - "(with 0 for no logging, and larger numbers for more logging output)."] - (define levels '(#f fatal error warning info debug)) - (define level - (let ([l (getarg 'sexpr)]) - (cond [(memq l levels) l] - [(memq l '(#f none -)) #f] - [(memq l '(#t all +)) (last levels)] - [(not (integer? l)) - (cmderror "bad level, expecting one of: ~s" levels)] - [(<= l 0) #f] - [(< l (length levels)) (list-ref levels l)] - [else (last levels)]))) - (cond [(current-log-receiver-thread) => kill-thread]) - (when level - (let ([r (make-log-receiver global-logger level)]) - (current-log-receiver-thread - (thread - (λ () - (let loop () - (match (sync r) - [(vector l m v) - (display (format "; [~a] ~a~a\n" - l m (if v (format " ~.s" v) ""))) - (flush-output)]) - (loop)))))))) - -;; ---------------------------------------------------------------------------- -;; meta evaluation hook - -;; questionable value, (and need to display the resulting values etc) -#; -(defcommand meta "" - "meta evaluation" - ["Evaluate the given expression where bindings are taken from the xrepl" - "module. This is convenient when you're in a namespace that does not have" - "a specific binding -- for example, you might be using a language that" - "doesn't have `current-namespace', so to get it, you can use" - "`,eval (current-namespace)'. The evaluation happens in the repl namespace" - "as usual, only the bindings are taken from the xrepl module -- so you can" - "use `^' to refer to the result of such an evaluation."] - (eval (datum->syntax #'here `(#%top-interaction . ,(getarg 'sexpr)))) - (void)) - -;; ---------------------------------------------------------------------------- -;; setup xrepl in the user's racketrc file - -(define init-file (find-system-path 'init-file)) -(defcommand install! #f - "install xrepl in your Racket init file" - ["Installs xrepl in your Racket REPL initialization file. This is done" - "carefully: I will tell you about the change, and ask for permission." - "You can then edit the file if you want to; in your system, you can find it" - ,(format "at \"~a\"." init-file)] - (define comment "The following line loads `xrepl' support") - (define expr "(require xrepl)") - (define dexpr "(dynamic-require 'xrepl #f)") - (define contents (file->string init-file)) - (read-line) ; discard the newline for further input - (define (look-for comment-rx expr) - (let ([m (regexp-match-positions - (format "(?<=\r?\n|^) *;+ *~a *\r?\n *~a *(?=\r?\n|$)" - comment-rx (regexp-quote expr)) - contents)]) - (and m (car m)))) - (define existing? (look-for (regexp-quote comment) expr)) - (define existing-readline? - (look-for "load readline support[^\r\n]*" "(require readline/rep)")) - (define (yes?) (flush-output) (regexp-match? #rx"^[yY]" (getarg 'line))) - (cond - [existing? - (printf "; already installed, nothing to do\n") - (when existing-readline? - (printf "; (better to remove the readline loading, xrepl does that)"))] - [(let ([m (regexp-match - (string-append (regexp-quote expr) "|" (regexp-quote dexpr)) - contents)]) - (and m (begin (printf "; found \"~a\", ~a\n" - (car m) "looks like xrepl is already installed") - (printf "; should I continue anyway? ") - (not (yes?)))))] - [else - (when existing-readline? - (printf "; found a `readline' loading line\n") - (printf "; xrepl will already do that, ok to remove? ") - (if (yes?) - (set! contents (string-append - (substring contents 0 (car existing-readline?)) - (substring contents (cdr existing-readline?)))) - (printf "; it will be kept ~a\n" - "(you can edit the file and removing it later)"))) - (printf "; writing new contents, with an added \"~a\"\n" expr) - (printf "; (if you want to load it conditionally, edit the file and\n") - (printf "; use \"~a\" instead, which is a plain expression)\n" dexpr) - (printf "; OK to continue? ") - (if (yes?) - (begin - (call-with-output-file* init-file #:exists 'truncate - (λ (o) (write-string - (string-append (regexp-replace #rx"(?:\r?\n)+$" contents "") - (format "\n\n;; ~a\n~a\n" comment expr)) - o))) - (printf "; new contents written to ~a\n" init-file)) - (printf "; ~a was not updated\n" init-file))]) - (void)) - -;; ---------------------------------------------------------------------------- -;; eval hook that keep track of recent evaluation results - -;; saved interaction values -(define saved-values (make-parameter '())) -(define (save-values! xs) - (let ([xs (filter (λ (x) (not (void? x))) xs)]) ; don't save void values - (unless (null? xs) - ;; the order is last, 2nd-to-last, ..., same from prev interactions - ;; the idea is that `^', `^^', etc refer to the values as displayed - (saved-values (append (reverse xs) (saved-values))) - (let ([n (saved-values-number)] [l (saved-values)]) - (when (< n (length l)) (saved-values (take l n))))))) - -(define last-saved-names+state (make-parameter '(#f #f #f))) -(define (get-saved-names) - (define last (last-saved-names+state)) - (define last-num (cadr last)) - (define last-char (caddr last)) - (define cur-num (saved-values-number)) - (define cur-char (saved-values-char)) - (if (and (equal? last-num cur-num) (equal? last-char cur-char)) - (car last) - (let ([new (for/list ([i (in-range (saved-values-number))]) - (string->symbol (make-string (add1 i) (saved-values-char))))]) - (last-saved-names+state (list new cur-num cur-char)) - new))) - -;; make saved values available through bindings, but do this in a way that -;; doesn't interfere with users using these binders in some way -- set only ids -;; that were void, and restore them to void afterwards -(define (with-saved-values thunk) - (define saved-names (get-saved-names)) - (define vals (for/list ([id (in-list saved-names)]) - (box (namespace-variable-value id #f void)))) - (define res #f) - (dynamic-wind - (λ () - (for ([id (in-list saved-names)] - [saved (in-list (saved-values))] - [v (in-list vals)]) - ;; set only ids that are void, and remember these values - (if (void? (unbox v)) - (begin (namespace-set-variable-value! id saved) - (set-box! v saved)) - (set-box! v (void))))) - (λ () (call-with-values thunk (λ vs (set! res vs) (apply values vs)))) - (λ () - (for ([id (in-list saved-names)] [v (in-list vals)]) - ;; restore the names to void so we can set them next time - (when (and (not (void? (unbox v))) ; restore if we set this id above - (eq? (unbox v) ; and if it didn't change - (namespace-variable-value id #f void))) - (namespace-set-variable-value! id (void)))) - (when res (save-values! res))))) - -(provide make-xrepl-evaluator) -(define (make-xrepl-evaluator builtin-evaluator) - (λ (expr) - ;; not useful: catches only escape continuations - ;; (with-handlers ([exn:break? (λ (e) (last-break-exn e) (raise e))]) ...) - (if (saved-values) - (with-saved-values (λ () (builtin-evaluator expr))) - (builtin-evaluator expr)))) - -;; ---------------------------------------------------------------------------- -;; capture ",..." and run the commands, use readline/rep when possible - -(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 (or x (toplevel-prefix))]) - (if (eq? (current-namespace-name) default-namespace-name) - x (format "~a::~a" (current-namespace-name) x)))) - (define last-directory #f) - (define last-namespace #f) - (define prefix #f) - (λ () - (define curdir (current-directory)) - (unless (and (equal? (current-namespace) last-namespace) - (equal? curdir last-directory)) - (report-directory-change) - (set! prefix - (with-handlers - ([exn? (λ (e) - (eprintf "error during prompt calculation: ~a\n" - (exn-message e)) - "[internal-error]")]) - (get-prefix))) - (set! last-namespace (current-namespace)) - (set! last-directory curdir)) - prefix))) - -;; the last non-command expression read -(define last-input-syntax (make-parameter #f)) - -(struct more-inputs (list) - #:constructor-name more-inputs* #:omit-define-syntaxes) -(define (more-inputs . inputs) (more-inputs* inputs)) - -(provide make-xrepl-reader) -(define (make-xrepl-reader) - (define (plain-reader prefix) ; a plain reader, without readline - (display prefix) (display "> ") (flush-output) (zero-column!) - (let ([in ((current-get-interaction-input-port))]) - ((current-read-interaction) (object-name in) in))) - (define RL ; no direct dependency on readline - (with-handlers ([exn? (λ (_) #f)]) - (collection-file-path "pread.rkt" "readline"))) - (define (make-readline-reader) - (let ([p (dynamic-require RL 'current-prompt)] - [r (dynamic-require RL 'read-cmdline-syntax)]) - (λ (prefix) ; uses the readline prompt - (parameterize ([p (bytes-append (string->bytes/locale prefix) (p))]) - (r))))) - (define reader - (case (object-name (current-input-port)) - [(stdin) - (if (or (not (terminal-port? (current-input-port))) - (regexp-match? #rx"^dumb" (or (getenv "TERM") "")) - (not RL)) - plain-reader - (with-handlers ([exn? - (λ (e) - (eprintf "Warning: no readline support (~a)\n" - (exn-message e)) - plain-reader)]) - (dynamic-require 'readline/rep-start #f) - ;; requiring readline should have changed the reader - (if (eq? (current-prompt-read) - (dynamic-require RL 'read-cmdline-syntax)) - (make-readline-reader) - (begin (eprintf "Warning: could not initialize readline\n") - plain-reader))))] - [(readline-input) - (eprintf "Note: readline already loaded\n~a\n" - " (better to let xrepl load it for you)") - (make-readline-reader)] - [else plain-reader])) - ;; IO management - (port-count-lines! (current-input-port)) - ;; wrap the reader to get the command functionality - (define more-inputs '()) - (define (reader-loop) - (parameterize ([saved-values #f]) - (define from-queue? (pair? more-inputs)) - (define input - (if from-queue? - (begin0 (car more-inputs) (set! more-inputs (cdr more-inputs))) - (begin (fresh-line) (reader (get-prefix))))) - (syntax-case input () - [(uq cmd) (eq? 'unquote (syntax-e #'uq)) - (let ([r (run-command (syntax->datum #'cmd))]) - (cond [(void? r) (reader-loop)] - [(more-inputs? r) - (set! more-inputs (append (more-inputs-list r) more-inputs)) - (reader-loop)] - [else (eprintf "Warning: internal weirdness: ~s\n" r) r]))] - [_ (begin (unless from-queue? (last-input-syntax input)) input)]))) - reader-loop) diff --git a/collects/xrepl/xrepl.scrbl b/collects/xrepl/xrepl.scrbl deleted file mode 100644 index b6654962a7..0000000000 --- a/collects/xrepl/xrepl.scrbl +++ /dev/null @@ -1,496 +0,0 @@ -#lang scribble/doc -@(require scribble/manual "doc-utils.rkt" - scribble/decode (only-in scribble/core) - (for-label racket readline racket/help racket/enter - racket/trace profile)) - -@title{XREPL: eXtended REPL} -@author+email["Eli Barzilay" "eli@barzilay.org"] - -@defmodule[xrepl]{ - The @filepath{xrepl} collection extends the @exec{racket} @tech[#:doc - GUIDE]{REPL} significantly, turning it into a more useful tool for - interactive exploration and development. This includes ``meta - commands'', using readline, keeping past evaluation results, and - more.} - -@; --------------------------------------------------------------------- -@section{Installing XREPL} - -To use XREPL, start @exec{racket} and enter @racket[(require xrepl)]. -You will know that it works when the prompt changes to a @litchar{->}, -and, if you're working on a capable terminal, you will now have readline -editing. You can also start @exec{racket} and ask for XREPL to be -loaded using command-line arguments: -@commandline{racket -il xrepl} - -If you want to enable XREPL automatically, add this expression to your -Racket initialization file. -@margin-note*{To load XREPL conditionally (e.g., not in older Racket - versions), you can use @racket[(dynamic-require 'xrepl #f)]. This - is a plain expression that can be placed inside @racket[when] and - elsewhere.} -An easy way to do the necessary editing is to enter @cmd[install!], -which will inspect and edit your initialization file (it will describe -the change and ask for your permission). Alternatively, you can edit -the file directly: on Unix, it is @filepath{~/.racketrc}, and for -other platforms evaluate @racket[(find-system-path 'init-file)] to see -where it is. - -XREPL will set up a readline-based reader, so you do not need to load -that yourself. If your initialization file was previously set to load -readline via @racket[install-readline!], the @cmd[install!] command -will (notify you and) remove it. If you added it yourself, consider -removing it. (This is not strictly needed, but XREPL is slightly -better at detecting when to use readline.) - -@; --------------------------------------------------------------------- -@section{Meta REPL Commands} - -Most of the XREPL extensions are implemented as meta commands. These -commands are entered at the REPL, prefixed by a @litchar{,} and followed -by the command name. Note that several commands correspond directly to -Racket functions (e.g., @cmd[exit]) --- but since they work outside of -your REPL, they can be used even if the matching bindings are not -available. - -@; --------------------------------- -@subsection{Generic Commands} - -@defcmd[help]{ - Without an argument, displays a list of all known commands. Specify a - command to get help specific to that command. -} - -@defcmd[exit]{ - Exits Racket, optionally with an error code (see @racket[exit]). -} - -@defcmd[cd]{ - Sets the @racket[current-directory] to the given path. If no path is - specified, use your home directory. Path arguments are passed through - @racket[expand-user-path] so you can use @litchar{~}. An argument of - @litchar{-} means ``the previous path''. -} - -@defcmd[pwd]{ - Reports the value of @racket[current-directory]. -} - -@defcmd[shell]{ - Use @cmd[shell] (or @cmd[sh]) to run a generic shell command (via - @racket[system]). For convenience, a few synonyms are provided --- - they run the specified executables (still using @racket[system]). - - When the REPL is in the context of a module with a known source file, - the shell command can use the @envvar{F} environment variable as the - path to the file. Otherwise, @envvar{F} is set to an empty string. -} - -@defcmd[edit]{ - Runs an editor, as specified by your @envvar{EDITOR} environment - variable, with the given file/s arguments. If no files are specified - and the REPL is currently inside a module's namespace, then the file - for that module is used. If the @envvar{EDITOR} environment variable - is not set, use the @cmd[drracket] command instead. -} - -@defcmd[drracket]{ - Runs DrRacket with the specified file/s. If no files are given, and - the REPL is currently inside a module, the file for that module is - used. - - DrRacket is launched directly, without starting a new subprocess, and - it is then kept running in a hidden window so further invocations are - immediate. (When this command is used for the first time, you will - see DrRacket start as usual, and then its window will disappear --- - that window is keeping DrRacket ready for quick editing.) - - In addition to file arguments, arguments can specify one of a few - flags for additional operations: - @itemize[ - @item{@litchar{-new}: opens a new editing window. This is the default - when no files are given and the REPL is not inside a module,} - @item{@litchar{-open}: opens the specified file/s (or the current - module's file). This is the default when files are given or when - inside a module.} - @item{@litchar{-quit}: exits the running DrRacket instance. Quitting - DrRacket is usually not necessary. Therefore, if you try to quit it - from the DrRacket window, it will instead just close the window but - DrRacket will still be running in the background. Use this command - in case there is some exceptional problem that requires actually - quitting the IDE. (Once you do so, future uses of this command will - start a fresh instance.)}] -} - -@; --------------------------------- -@subsection{Binding Information} - -@defcmd[apropos]{ - Searches for known bindings in the current namespace. The arguments - specify which binding to look for: use a symbol (without a - @litchar{'}) to look for bindings that contain that name, and use a - regexp (e.g., @racket[#rx"..."]) to use a regexp for the search. - Multiple arguments are and-ed together. - - If no arguments are given, @emph{all} bindings are listed. -} - -@defcmd[describe]{ - For each of the specified names, describe where where it is coming - from and how it was defined if it names a known binding. In addition, - desribe the module (list its imports and exports) that is named by - arguments that are known module names. - - By default, bindings are searched for at the runtime level (phase 0). - You can add a different phase level for identifier lookups as a first - argument. In this case, only a binding can be described, even if the - same name is a known module. -} - -@defcmd[doc]{ - Uses Racket's @racket[help] to browse the documentation, look for a - binding, etc. Note that this can be used even in languages that don't - have the @racket[help] binding. -} - -@; --------------------------------- -@subsection{Requiring and Loading Files} - -@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].) -} - -@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 - arguments are given, use arguments from the last use of this command - (if any). - - Module reloading is enabled by turnning off the - @racket[compile-enforce-module-constants] parameter --- note that this - prohibits some opimizations, since the compiler assumes that all - bindings may change. -} - -@defcmd[enter]{ - 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 - module, causing it to reload if needed. Using @racket[#f] makes it go - back to the toplevel namespace. - - Note that this can be used even in languages that don't have the - @racket[enter!] binding. In addition, @racket[enter!] is used in a - way that does not make it require itself into the target namespace. -} - -@defcmd[toplevel]{ - Makes the REPL go back to the toplevel namespace. Same as using the - @cmd[enter] command with a @racket[#f] argument. -} - -@defcmd[load]{ - Uses @racket[load] to load the specified file(s). -} - -@; --------------------------------- -@subsection{Debugging} - -@defcmd[time]{ - Times execution of an expression (or expressions). This is similar to - @racket{time} but the information that is displayed is a bit easier to - read. - - In addition, you can provide an initial number to specify repeating - the evaluation a number of times. In this case, each iteration is - preceded by two garbage collections, and when the iteration is done - its timing information and evaluation result(s) are displayed. When - the requested number of repetitions is done, some extreme results are - removed (top and bottom 2/7ths), and the remaining results are be - averaged. Finally, the resulting value(s) are from the last run are - returned (and can be accessed via the bindings for the last few - results, see @secref["past-vals"]). -} - -@defcmd[trace]{ - Traces the named function (or functions), using @racket[trace]. -} - -@defcmd[untrace]{ - Untraces the named function (or functions), using @racket[untrace]. -} - -@defcmd[errortrace]{ - @racketmodname[errortrace] is a useful Racket library which can - provide a number of useful services like precise profiling, test - coverage, and accurate error information. However, using it can be a - little tricky. @cmd[errortrace] and a few related commands fill this - gap, making @racketmodname[errortrace] easier to use. - - @cmd[errortrace] controls global use of @racketmodname[errortrace]. - With a flag argument of @litchar{+} errortrace instrumentation is - turned on, with @litchar{-} it is turned off, and with no arguments it - is toggled. In addition, a @litchar{?} flag displays instrumentation - state. - - Remember that @racketmodname[errortrace] instrumentation hooks into - the Racket compiler, and applies only to source code that gets loaded - from source and therefore compiled. Therefore, you should use it - @emph{before} loading the code that you want to instrument. -} - -@defcmd[profile]{ - This command can perform profiling of code in one of two very - different ways: either statistical profiling via the - @racketmodname[profile] library, or using the exact profiler feature - of @racketmodname[errortrace]. - - When given a parenthesized expression, @cmd[profile] will run it via - the statistical profiler, as with the @racket[profile] form, reporting - results as usual. This profiler adds almost no overhead, and it - requires no special setup. In particular, it does not require - pre-compiling code in a special way. However, there are some - imprecise elements to this profiling: the profiler samples stack - snapshots periodically which can miss certain calls, and it is also - sensitive to some compiler optimizations like inlining procedures and - thereby not showing them in the displayed analysis. See - @other-doc['(lib "profile/scribblings/profile.scrbl")] for more - information. - - In the second mode of operation, @cmd[profile] uses the precise - @racketmodname[errortrace] profiler. This profiler produces precise - results, but like other uses of the @racketmodname[errortrace], it - must be enabled before loading the code that is to be profiled. It - can add noticeable overhead (potentially affecting the reported - runtimes), but the results are accurate in the sense that no procedure - is skipped. (For additional details, see - @other-doc['(lib "errortrace/scribblings/errortrace.scrbl")].) - - In this mode, the arguments are flags that control the profiler. A - @litchar{+} flag turns the profiler on --- and as usual with - @racketmodname[errortrace] functionality, this applies to code that is - compiled from now on. A @litchar{-} flag turns this instrumentation - off, and without any flags it is toggled. Once the profiler is - enabled, you can run some code and then use this command to report - profiling results: use @litchar{*} to show profiling results by time, - and @litchar{#} for the results by counts. Once you've seen the - results, you can evaluate additional code to collect more profiling - information, or you can reset the results with a @litchar{!} flag. - You can also combine several flags to perform the associated - operations, for example, @cmd[prof]{*!-} will show the accumulated - results, clear them, and turn profiler instrumentation off. - - Note that using @emph{any} of these flags turns errortrace - instrumentation on, even @cmd[prof]{-} (or no flags). Use the - @cmd[errortrace] command to turn off instrumentation completely. -} - -@defcmd[execution-counts]{ - This command makes it easy to use the execution counts functionality - of @racketmodname[errortrace]. Given a file name (or names), - @cmd[execution-counts] will enable errortrace instrumentation for - coverage, require the file(s), display the results, disables coverage, - and disables instrumentation (if it wasn't previously turned on). - This is useful as an indication of how well the test coverage is for - some file. -} - -@defcmd[coverage]{ - Runs a given file and displays coverage information for the run. This - is somewhat similar to the @cmd[execution-counts] command, but instead - of using @racketmodname[errortrace] directly, it runs the file in a - (trusted) sandbox, using the @racketmodname[racket/sandbox] library - and its ability to provide coverage information. -} - -@; --------------------------------- -@subsection{Miscellaneous Commands} - -@defcmd[switch-namespace]{ - This powerful command controls the REPL's namespace. While - @cmd[enter] can be used to make the REPL go into the namespace of a - specific module, the @cmd[switch-namespace] command can switch between - @emph{toplevel namespaces}, allowing you to get multiple separate - ``workspaces''. - - Namespaces are given names that are symbols or integers, where - @litchar{*} is the name for the first initial namespace, serving as - the default one. These names are not bindings --- they are only used - to label the known namespaces. - - The most basic usage for this command is to simply specify a new name. - A namespace that corresponds to that name will be created and the REPL - will switch to that namespace. The prompt will now indicate this - namespace's name. The name is usually insignificant, except when it - is a @racket[require]-able module: in this case, the new namespace is - initialized to use that module's bindings. For example, - @cmd[switch]{racket/base} creates a new namespace that is called - @litchar{racket/base} and initializes it with - @racketmodname[racket/base]. For all other names, the new namespace - is initialized the same as the current one. - - Additional @cmd[switch] uses: - @itemize[ - @item{@cmd[switch]{!} --- reset the current namespace, recreating it - using the same initial library. Note that it is forbidden to reset - the default initial namespace, the one named @litchar{*} --- this - namespace corresponds to the one that Racket was started with, and - where XREPL was initialized. There is no technical reason for - forbidding this, but doing so is not useful as no resources will - actually be freed.} - @item{@cmd[switch]{! } --- resets the current namespace with - the explicitly given simple module spec.} - @item{@cmd[switch]{ !} --- switch to a newly made namespace. If - a namespace by that name already existed, it is rest.} - @item{@cmd[switch]{ ! } --- same, but reset to the given - module instead of what it previously used.} - @item{@cmd[switch]{- } --- drop the specified namespace, making - it possible to garbage-collect away any associated resources. You - cannot drop the current namespace or the default one (@litchar{*}).} - @item{@cmd[switch]{?} --- list all known namespaces.}] - - Do not confuse namespaces with sandboxes or custodians. The - @cmd{switch} command changes @emph{only} the - @racket[current-namespace] --- it does not install a new custodian or - restricts evaluation in any way. Note that it is possible to pass - around values from one namespace to another via past result reference; - see @secref["past-vals"]. -} - -@defcmd[syntax]{ - Manipulate syntaxes and inspect their expansion. - - Useful operations revolve around a ``currently set syntax''. With no - arguments, the currently set syntax is displayed; an argument of - @litchar{^} sets the current syntax from the last input to the REPL; - and an argument that holds any other s-expression will set it as the - current syntax. - - Syntax operations are specified via flags: - @itemize[ - @item{@litchar{+} uses @racket[expand-once] on the current syntax and - prints the resulting syntax. In addition, the result becomes the - new ``current'' syntax, so you can use this as a poor-man's syntax - stepper. (Note that in some rare cases expansion via a sequence of - @racket[expand-once] might differ from the actual expansion.)} - @item{@litchar{!} uses @racket[expand] to completely expand the - current syntax.} - @item{@litchar{*} uses the macro debugger's textual output to show - expansion steps for the current syntax, leaving macros from - @racketmodname[racket/base] intact. Does not change the current - syntax. - See @other-doc['(lib "macro-debugger/macro-debugger.scrbl")] for - details.} - @item{@litchar{**} uses the macro debugger similarly to @litchar{*}, - but expands @racketmodname[racket/base] macros too, showing the - resulting full expansion process.}] - Several input flags and/or syntaxes can be spacified in succession as - arguments to @cmd{syntax}. For example, @cmd[stx]{(when 1 2) ** !}. -} - -@defcmd[log]{ - Starts (or stops) logging events at a specific level. The level can - be: - @itemize[ - @item{a known level name (currently one of @litchar{fatal}, - @litchar{error}, @litchar{warning}, @litchar{info}, - @litchar{debug}),} - @item{@racket[#f] for no logging,} - @item{@racket[#t] for maximum logging,} - @item{an integer level specification, with @racket[0] for no logging - and bigger ones for additional verbosity.}] -} - -@defcmd[install!]{ - Convenient utility command to install XREPL in your Racket - initialization file. This is done carefully, you will be notified of - potential issues, and asked to authorize changes. -} - -@; --------------------------------------------------------------------- -@section[#:tag "past-vals"]{Past Evaluation Results} - -XREPL makes the last few interaction results available for evaluation -via special toplevel variables: @racketidfont{^}, @racketidfont{^^}, -..., @racketidfont{^^^^^}. The first, @racketidfont{^}, refers to the -last result, @racketidfont{^^} to the previous one and so on. - -As with the usual REPL printouts, @void-const results are not kept. In -case of multiple results, they are spliced in reverse, so -@racketidfont{^} refers to the last result of the last evaluation. For -example: -@verbatim[#:indent 4]{ - -> 1 - 1 - -> (values 2 3) - 2 - 3 - -> (values 4) - 4 - -> (list ^ ^^ ^^^ ^^^^) - '(4 3 2 1)} -The rationale for this is that @racketidfont{^} always refers to the -last @emph{printed} result, @racketidfont{^^} to the one before that, -etc. - -These bindings are made available only if they are not already defined, -and if they are not modified. This means that if you have code that -uses these names, it will continue to work as usual. - -@; --------------------------------------------------------------------- -@section{Hacking XREPL} - -XREPL is mainly a convenience tool, and as such you might want to hack -it to better suite your needs. Currently, there is no convenient way to -customize and extend it, but this will be added in the future. - -Meanwhile, if you're interested in tweaking XREPL, the @cmd[enter] -command can be used as usual to go into its implementation. For -example --- change an XREPL parameter: -@verbatim[#:indent 4]{ - -> ,en xrepl/xrepl - xrepl/xrepl> ,e - xrepl/xrepl> (saved-values-char #\~) - xrepl/xrepl> ,top - -> 123 - 123 - -> ~ - 123} -or add a command: -@verbatim[#:indent 4]{ - -> ,en xrepl/xrepl - xrepl/xrepl> (defcommand eli "stuff" "eli says" ["Make eli say stuff"] - (printf "Eli says: ~a\n" (getarg 'line))) - xrepl/xrepl> ,top - -> ,eli moo - Eli says: moo} -While this is not intended as @emph{the} way to extend and customize -XREPL, it is a useful debugging tool should you want to do so. - -If you have any useful tweaks and extensions, please mail the author or -the Racket developer's -@hyperlink["http://racket-lang.org/community.html"]{mailing list}. - -@; --------------------------------------------------------------------- -@section{License Issues} - -Under most circumstances XREPL uses the @racketmodname[readline] -library, and therefore a similar license caveat applies: XREPL cannot be -enabled by default because of the @seclink["readline-license" #:doc -RL]{readline licensing}, you have to explicitly do so yourself to use -it. (Note that XREPL is intended to be used only for enhanced -interaction, not as a library; so there are no additional issues.) - -@; --------------------------------------------------------------------- -@(check-all-documented)