#| -*- scheme -*-

This file provides some useful facilities for interactive use of mzscheme.  It
is best used as a ".mzschemerc" file or "mzschemerc.ss" on Windows (evaluate
`(find-system-path 'init-file)' to know where this file is on your system).

The highlights are:

* Defines a `debug' module that provides a few useful utilities for use in code
  while debugging:
  > (eprintf fmt arg ...)
    Like `printf', but uses the current error port.
  > (warn ...)
    Same as `error', but only prints the error message.
  > ***
  > (*** value)
  > (*** fmt args ...)
    This is macro that is useful for debugging: the first form prints (on
    stderr) the source file and line number, the second also prints a value
    (and returns it), and the third uses a format string.  For example, to see
    where a problem happens in a function, you spread `***'s around, and the
    printout.
  > (define*** (name args ...) ...)
    Macro that defines `name' as a traced function.  (The idea is that you
    append a `***' to functions that you want to trace.)  This is a cheap hack:
    it kills tail-recursiveness.
  The `***' is supposed to be a token that stands out textually in *your* code
  while you're debugging it, so it is customizable: set the `MZ_DEBUGGER_TOKEN'
  environment variable to whatever you want -- for example, set it to `@@' and
  you'll get bindings for `@@' and `define@@' instead of the above.

* Provides a `mzscheme*' module that can be used as a `mzscheme' drop-in
  replacement.  Basically lets you be lazy and change `mzscheme' to `mzscheme*'
  instead of adding a `(require debug)'.

* The following REPL functionality is used only when there is some REPL
  interaction, so non-interactive use (scripts) is not affected.

* Uses the readline library if we're running in an xterm (and if it's present).
  (Again, triggered by repl interaction.)

* Makes a convenient syntax for requiring, hooked on using 'foo as a module
  spec:
    (require 'foo1/foo2/bar) will require the first of
      (lib "bar" "foo1" "foo2")
      (lib "bar.ss" "foo1" "foo2")
      (lib "bar.scm" "foo1" "foo2")
      (lib "bar{,.ss,.scm}" "mzlib" "foo1" "foo2")
      (lib "bar{.ss,.scm}" "foo1" "foo2" "bar") when `bar' is suffixless
      "./foo1/foo2/bar{,.ss,.scm}"
  Here are a few examples for `obvious' things that it gets right:
    (require 'list)         -> (lib "list.ss")
    (require 'net/sendmail) -> (lib "sendmail.ss" "net")
    (require 'r5rs)         -> (lib "r5rs.ss" "r5rs")
    (require 'foo)          -> (file "foo.ss") ; if the file exists
  This is intended for convenient interactive use, not for programs.

* Toplevel commands, in the form of ",cmd".  Some of these commands read an
  argument that is at the end of the line (eg, ",cd foo", ",ls"), and some read
  an expression (eg, ",stx (...expr...)").  These commands make it convenient
  to perform many otherwise-tedious operations in MzScheme.  Use ",h" for a
  list of available commands.

* Two of these commads allow you to go into and out of module namespaces.  The
  prompt shows you which module you're currently in.  For example:
    > ,enter 'list
    (quote list)> foldl
    #<procedure:foldl>
    (quote list)> ,toplevel
  To enable more debugging capabilities, uncomment the
    (compile-enforce-module-constants #f)
  line, which will avoid compiler inlining (and enable arbitrary mutation).
  (Better than putting it in your .mzschemerc, because it will have an effect
  only on REPL use.)

* Previous toplevel results are accessible: `^' is the last result, `^^' is the
  second to last (or the second value of the last multiple-value result) etc.
  This is done in a way that is trying to avoid clobbering a binding that you
  already have for these identifiers.

|#


;; ============================================================================
;; convenient debugging utilities

(module debug mzscheme
  ;; either change this line, or set the "MZ_DEBUGGER_TOKEN" environment var
  (define-for-syntax debug-token (or (getenv "MZ_DEBUGGER_TOKEN") "***"))

  (provide eprintf warn)
  (define (eprintf fmt . args)
    (apply fprintf (current-error-port) fmt args))
  (define (warn who . fmt/args)
    (parameterize ([current-output-port (current-error-port)])
      (display who)
      (when (pair? fmt/args)
        (if (symbol? who)
          (begin (display ": ") (apply printf fmt/args))
          (for-each (lambda (x) (printf " ~s" x)) fmt/args)))
      (newline)))

  (define token
    (let-syntax ([token (lambda (stx)
                          (datum->syntax-object stx debug-token stx))])
      token))

  (define-syntax (define-debug-syntax stx)
    (syntax-case stx ()
      [(_ (pfx stx) body ...)
       #'(define-debug-syntax pfx (lambda (stx) body ...))]
      [(_ pfx expr)
       (identifier? #'pfx)
       (with-syntax ([id (datum->syntax-object
                          #'pfx
                          (string->symbol
                           (string-append (symbol->string (syntax-e #'pfx))
                                          debug-token))
                          #'pfx)])
         #'(begin (provide id) (define-syntax id expr)))]))

  (define-debug-syntax (|| stx)
    (syntax-case stx ()
      [(_ fmt arg ...)
       (string? (syntax-e #'fmt))
       #`(dprint '#,(syntax-source stx)
                 '#,(syntax-position stx)
                 '#,(syntax-line stx)
                 fmt (list (lambda () arg) ...) '(arg ...))]
      [(_ arg ...)
       #`(dprint '#,(syntax-source stx)
                 '#,(syntax-position stx)
                 '#,(syntax-line stx)
                 #f (list (lambda () arg) ...) '(arg ...))]
      [else #`(dprint '#,(syntax-source stx)
                      '#,(syntax-position stx)
                      '#,(syntax-line stx)
                      #f '() '())]))

  (define-debug-syntax define
    (syntax-rules ()
      [(_ (name x ...) body ...)
       (define (name x ...)
         (indent)
         (eprintf "~a~a~a\n" 'name token
                  (string-append (format " ~s" x) ...))
         (let ([r (parameterize ([indentation (cons "  " (indentation))])
                    body ...)])
           (indent)
           (eprintf "~a~a -> ~s\n" token 'name r)
           r))]))

  (define indentation (make-parameter '()))
  (define (indent) (for-each eprintf (indentation)))

  (define (dprint source pos line fmt thunks exprs)
    (define error? #f)
    (define retval (void))
    (define args
      (map (lambda (thunk)
             (with-handlers ([void (lambda (e)
                                     (set! error? (or error? e))
                                     (format "ERROR(~a)" (exn-message e)))])
               (let ([r (thunk)]) (set! retval r) r)))
           thunks))
    (indent)
    (let* ([source (cond [(symbol? source) source]
                         [source (regexp-replace
                                  #rx"^.*/"
                                  (if (string? source)
                                    source
                                    (format "~a" source))
                                  "")]
                         [else #f])]
           [marker (cond
                     [(and source line) (format "~a~a:~a" token source line)]
                     [(and source pos)  (format "~a~a:#~a" token source pos)]
                     [source (format "~a~a" token source)]
                     [else token])]
           [line (if fmt (apply format fmt args) args)])
      (parameterize ([current-output-port (current-error-port)])
        (display marker)
        (unless (null? line)
          (display ">")
          (parameterize ([error-print-width 30])
            (if (pair? line)
              (for-each (lambda (x expr)
                          (display " ")
                          (when (or (symbol? expr)
                                    (and (pair? expr)
                                         (not (memq (car expr)
                                                    '(quasiquote quote)))))
                            (printf "~e=" expr))
                          (write x))
                        args exprs)
              (begin (display " ") (display line)))))
        (printf "\n")))
    (if error? (raise error?) retval)))


;; ============================================================================
;; convenient mzscheme extension (to be used instead of `mzscheme' as a base)

(module mzscheme* mzscheme
  (require debug)
  (provide (all-from mzscheme) (all-from debug) (all-defined)))


;; ============================================================================
(module interactive mzscheme

;; ----------------------------------------------------------------------------
;; configuration

(define toplevel-prompt (make-parameter #f #|"-"|#)) ; when not in a module
(define saved-values-number (make-parameter 4))
(define saved-values-char (make-parameter #\^))
;; may want to disable inlining to allow redefinitions
;; (compile-enforce-module-constants #f)

;; ----------------------------------------------------------------------------
(require (lib "string.ss") (lib "list.ss"))
(require debug)
(provide (all-from debug)) ; can't specify the names of debug tokens

(define-syntax defautoload
  (syntax-rules ()
    [(defautoload id libspec)
     (define id
       (let ([id (delay (dynamic-require 'libspec 'id))])
         (lambda args (apply (force id) args))))]))

;; ----------------------------------------------------------------------------
;; convenient require syntax when using '...

(define (get-libspec path)
  (define (try-suffix file sfx)
    (let ([sfx (if sfx (string-append "." sfx) "")])
      (and (file-exists? (string-append file sfx)) sfx)))
  (define (find-suffix file)
    (ormap (lambda (sfx) (try-suffix file sfx)) '(#f "ss" "scm")))
  (define (collection-file dirs file)
    (define dir (with-handlers ([void (lambda (_) #f)])
                  (path->string (apply collection-path dirs))))
    (define sfx (and dir (find-suffix (string-append dir "/" file))))
    (and sfx (list* 'lib (string-append file sfx) dirs)))
  (define str (and (list? path) (= 2 (length path))
                   (eq? 'quote (car path)) (symbol? (cadr path))
                   (symbol->string (cadr path))))
  (cond
    [(not str) path] ; not a '... spec
    [(regexp-match? #rx"^(?:[/~]|[.][.]?/)" str)
     ;; absolute paths or ./ prefix: use (file <path>[sfx])
     (list 'file (string-append str (or (find-suffix str) "")))]
    [else
     (let-values ([(dirs file)
                   (let ([m (regexp-match #rx"^(.*)/([^/]+)/*?$" str)])
                     (if m
                       (values (regexp-split #rx"/+" (cadr m)) (caddr m))
                       (values '() str)))])
       (cond ; (used mostly as an `or')
         ;; <path>[sfx] (when dirs is non-empty)
         [(and (pair? dirs) (collection-file dirs file))]
         ;; mzlib/<path>[sfx]
         [(collection-file (cons "mzlib" dirs) file)]
         ;; <dir>/<file>/<file>[sfx] (when the file is suffix-less)
         [(and (not (regexp-match? #rx"[.]" file))
               (collection-file (append dirs (list file)) file))]
         ;; ./<P>
         [(find-suffix str)
          => (lambda (sfx) (list 'file (string-append str sfx)))]
         [else (error (format "could not guess require spec: '~a" str))]))]))

(current-module-name-resolver
 (let ([resolve (current-module-name-resolver)])
   (case-lambda
     [(mod) (resolve mod)]
     [(path name stx . load?)
      (apply resolve (get-libspec path) name stx load?)])))

;; ----------------------------------------------------------------------------
;; toplevel "," commands

(define prompt (toplevel-prompt))

(define-struct command (names help handler))
(define commands '())
(define current-command (make-parameter #f))
(define-syntax defcommand
  (syntax-rules ()
    [(_ (cmd . aliases) help body ...)
     (set! commands (append! commands
                             (list (make-command `(cmd . aliases)
                                                 `help
                                                 (lambda () body ...)))))]
    [(_ cmd help body ...) (defcommand (cmd) help body ...)]))

(define (maybe-string-arg) ; read an optional string argument
  (let ([arg (read-line)])
    (and (string? arg)
         (not (regexp-match? #rx"^[ \t]*$" arg))
         (regexp-replace #rx"^[ \t]*(.+?)[ \t]*$" arg "\\1"))))

(define (maybe-path-arg) ; read an optional path argument
  (let ([arg (read-bytes-line)])
    (and (bytes? arg)
         (not (regexp-match? #rx#"^[ \t]*$" arg))
         (bytes->path (regexp-replace #rx#"^[ \t]*(.+?)[ \t]*$" arg #"\\1")))))

(define (syntax-arg)
  (let ([stx (read-syntax)])
    (if (eof-object? stx)
      (error 'syntax-arg "missing input expression")
      (namespace-syntax-introduce stx))))

(define (maybe-syntax-arg) ; read an optional syntax expression
  (and (not (memq (peek-char) '(#\newline #\return))) ; for immediate EOLNs
       (not (regexp-match/fail-without-reading
             #rx"^[ \t]*?\r?\n" (current-input-port)))
       (syntax-arg)))

(define (syntax-args) ; read a list of syntax expressions on one line
  (parameterize ([current-input-port (open-input-string (read-line))])
    (let loop ([r '()])
      (let ([stx (read-syntax)])
        (if (eof-object? stx)
          (reverse! r)
          (loop (cons (namespace-syntax-introduce stx) r)))))))

(define (run-command command)
  (let loop ([commands commands])
    (cond [(null? commands) (eprintf "Unknown command: ~s\n" command)]
          [(memq command (command-names (car commands)))
           (parameterize ([current-command command])
             ((command-handler (car commands))))]
          [else (loop (cdr commands))])))

;; like `eval', but accepts any number of expressions
(define (eval* . exprs)
  (let loop ([r (list (void))] [exprs exprs])
    (if (null? exprs)
      (apply values r)
      (loop (call-with-values (lambda () (eval (car exprs))) list)
            (cdr exprs)))))

(defcommand (help h ?) "display available commands"
  (printf "Available commands:\n")
  (for-each (lambda (cmd)
              (let* ([names   (command-names cmd)]
                     [name    (car names)]
                     [aliases (cdr names)]
                     [help    (command-help cmd)]
                     [header  (format "  ~a~a:" name
                                      (if (pair? aliases)
                                        (format " ~a" aliases) ""))]
                     [help (if (and (string? help)
                                    (< 70 (+ (string-length help)
                                             (string-length header))))
                             (list help) help)])
                (if (list? help)
                  (begin (printf "~a\n" header)
                         (for-each (lambda (h) (printf "    ~a\n" h)) help))
                  (printf "~a ~a\n" header help))))
            commands))

(defcommand (exit quit ex) "Exit MzScheme"
  (exit))

(defcommand cd "change the current directory"
  (let ([arg (or (maybe-path-arg) "~")])
    (if (directory-exists? arg)
      (current-directory arg)
      (warn 'cd "no such directory: ~a" arg))
    (printf "Now in ~a\n" (current-directory))))

(defcommand pwd "read the current directory"
  (printf "~a\n" (current-directory)))

(defautoload system (lib "process.ss"))

(defcommand (sh shell ls cp mv rm svn)
  "run a shell command (aliases are short for known cmds)"
  (let ([arg (maybe-string-arg)] [cmd (current-command)])
    (case cmd
      [(ls) (set! arg (or arg "-F"))]
      [(shell) (set! cmd 'sh)])
    (let ([cmd (and (not (eq? 'sh cmd)) (symbol->string cmd))])
      (system (cond [(and (not cmd) (not arg)) (getenv "SHELL")]
                    [(not cmd) arg]
                    [(not arg) cmd]
                    [else (string-append cmd " " arg)])))))

(defcommand (apropos ap) "look for a binding"
  (let* ([arg (maybe-string-arg)]
         [syms (map (lambda (sym) (cons sym (symbol->string sym)))
                    (namespace-mapped-symbols))]
         [syms (if arg
                 (filter (lambda (sym) (regexp-match arg (cdr sym))) syms)
                 syms)]
         [syms (sort syms (lambda (x y) (string<? (cdr x) (cdr y))))]
         [syms (map car syms)])
    (if (null? syms)
      (printf "No matches found")
      (begin (printf "Matches: ~a" (car syms))
             (for-each (lambda (s) (printf ", ~a" s)) (cdr syms))))
    (printf ".\n")))

(define last-require-modspecs #f)

(defcommand (require req r) "require a module and go into its namespace"
  (let ([specs (syntax-args)])
    (set! last-require-modspecs specs)
    (make-new-input `(require ,@specs))))

(require (lib "moddep.ss" "syntax"))
(define (reload-module modspec)
  (let* (;; moddep.ss doesn't handle different resolvers => do this manually
         [modspec (get-libspec modspec)]
         [name ((current-module-name-resolver) modspec #f #f)]
         [name (symbol->string name)]
         [name (if (eq? #\, (string-ref name 0))
                 (substring name 1)
                 (error 'reload-module
                        "unexpected module name for ~e: ~e" modspec name))]
         [prefix (let-values ([(base name dir?) (split-path name)])
                   (string->symbol (format ",~a" base)))])
    (parameterize ([current-module-name-prefix prefix]
                   [compile-enforce-module-constants #f])
      (load/use-compiled (resolve-module-path modspec #f)))))
(defcommand (reload) "reload a module (default is last argument to ,require)"
  (let* ([specs (syntax-args)]
         [specs (if (pair? specs)
                  specs
                  (or last-require-modspecs
                      (error 'reload "no argument and no previous ,require")))]
         [specs (map syntax-object->datum specs)])
    (for-each reload-module specs)))

(defcommand time "time an expression"
  (make-new-input `(time ,(syntax-arg))))

(defcommand (load ld) "load a file"
  (cond [(maybe-path-arg) => (lambda (p) (make-new-input `(load ,p)))]
        [else (printf "error: need a filename argument\n")]))

(define top-level-ns #f)

(defcommand enter "require a module and go into its namespace"
  (let ([arg (read)])
    (dynamic-require arg #f)
    (unless top-level-ns (set! top-level-ns (current-namespace)))
    (current-namespace (module->namespace arg))
    (set! prompt (string->bytes/utf-8
                  (if (and (pair? arg) (pair? (cdr arg)) (null? (cddr arg))
                           (eq? 'quote (car arg)))
                    (format "'~s" (cadr arg))
                    (format "~s" arg))))))

(defcommand (toplevel top) "go back to the toplevel"
  (when top-level-ns
    (current-namespace top-level-ns)
    (set! top-level-ns #f)
    (set! prompt (toplevel-prompt))))

(defcommand (trace tr) "trace a function (using the trace library)"
  (eval* `(require (lib "trace.ss")) `(trace ,(syntax-arg))))

(defcommand (untrace untr) "untrace a function"
  (eval* `(require (lib "trace.ss")) `(untrace ,(syntax-arg))))

(defcommand prof+ "turn the profiler on (for code that is evaluated from now)"
  (eval* `(require (lib "errortrace.ss" "errortrace"))
         `(profiling-enabled #t)
         `(clear-profile-results)))

(defcommand prof! "show profiling results, and clear them"
  (eval* `(require (lib "errortrace.ss" "errortrace"))
         `(output-profile-results #f #t)
         `(clear-profile-results)))

(defcommand prof- "show profiling results, and turn it off"
  (eval* `(require (lib "errortrace.ss" "errortrace"))
         `(output-profile-results #f #t)
         `(clear-profile-results)
         `(profiling-enabled)))

(define current-syntax #f)
(define (current-syntax->datum)
  (and current-syntax (syntax-object->datum current-syntax)))
(defautoload pretty-print (lib "pretty.ss"))
(defcommand (syntax stx st)
  "set syntax object to inspect (`pp': pretty-print, nothing: show current)"
  (let ([stx (maybe-syntax-arg)])
    (cond [(and stx (identifier? stx) (eq? 'pp (syntax-e stx)))
           (pretty-print (current-syntax->datum))]
          [stx (set! current-syntax stx)]
          [current-syntax (printf "cur: ~s\n" (current-syntax->datum))]
          [else (printf "no current syntax\n")])))
(defcommand (syntax+ stx+ st+)
  "one expansion step (possibly set syntax)"
  (let ([stx (maybe-syntax-arg)])
    (when stx (set! current-syntax stx)))
  (if (not current-syntax)
    (printf "no current syntax\n")
    (begin (set! current-syntax (expand-once current-syntax))
           (printf "cur -> ~s\n" (current-syntax->datum)))))
(defcommand (syntax! stx! st!)
  "fully expand step (possibly set syntax)"
  (let ([stx (maybe-syntax-arg)])
    (when stx (set! current-syntax stx)))
  (if (not current-syntax)
    (printf "no current syntax\n")
    (begin (set! current-syntax (expand current-syntax))
           (printf "cur => ~s\n" (current-syntax->datum)))))
(defcommand (syntax* stx* st*)
  "many single-expansion steps until no change (can be inexact)"
  (let ([stx (maybe-syntax-arg)])
    (when stx (set! current-syntax stx)))
  (if (not current-syntax)
    (printf "no current syntax\n")
    (let loop ([last (current-syntax->datum)])
      (set! current-syntax (expand-once current-syntax))
      (let ([new (current-syntax->datum)])
        (if (equal? new last)
          (printf "done.\n")
          (begin (printf "cur -> ~s\n" new)
                 (loop new)))))))

;; ----------------------------------------------------------------------------
;; eval hook that keep track of recent evaluation results

;; saved interaction values
(define saved-values '())
(define (save-value! x)
  ;; do not save void or repeated values
  (unless (or (void? x) (and (pair? saved-values) (eq? x (car saved-values))))
    (set! saved-values (cons x saved-values))
    (let loop ([n (sub1 (saved-values-number))] [l saved-values])
      (when (pair? l)
        (if (zero? n)
          (set-cdr! l '())
          (loop (sub1 n) (cdr l)))))))

;; 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 saved-names
  (let loop ([n (saved-values-number)] [ids '()])
    (if (zero? n)
      ids
      (loop (sub1 n)
            (cons (string->symbol (make-string n (saved-values-char))) ids)))))
(define (with-saved-values thunk)
  (let ([vs (map (lambda (id) (namespace-variable-value id #f void))
                 saved-names)])
    (dynamic-wind
      (lambda ()
        (let loop ([ids saved-names] [saved saved-values] [vs vs])
          (when (and (pair? ids) (pair? saved))
            ;; set only ids that are void, and remember these values
            (if (void? (car vs))
              (begin (namespace-set-variable-value! (car ids) (car saved))
                     (set-car! vs (car saved)))
              (set-car! vs (void)))
            (loop (cdr ids) (cdr saved) (cdr vs)))))
      thunk
      (lambda ()
        (for-each
         (lambda (id v)
           ;; restore the names to void so we can set them next time
           (when (and (not (void? v)) ; restore when we set this id above
                      (eq? v (namespace-variable-value ; and it didn't change
                              id #f void)))
             (namespace-set-variable-value! id (void))))
         saved-names vs)))))

(define orig-eval (current-eval))
(define (new-eval expr)
  (let ([vals (call-with-values
                  (lambda ()
                    (with-saved-values (lambda () (orig-eval expr))))
                  list)])
    ;; `^' is always last value, `^^' is 2nd-to-last or the second value of the
    ;; last interaction (and see `save-value!' above)
    (for-each save-value! (reverse vals))
    (apply values vals)))
(current-eval new-eval)

;; ----------------------------------------------------------------------------
;; capture ",..." and run the commands, use readline/rep when possible

;; plain reader (default)
(define plain-prompt-read (current-prompt-read))
(define (reader prefix)
  (when prefix (display prefix))
  (plain-prompt-read))

;; readline reader
(when (regexp-match? #rx"term" (or (getenv "TERM") "")) ; only on xterms etc
  (parameterize ([current-prompt-read (current-prompt-read)]) ; don't change
    (with-handlers ([exn?
                     (lambda (e)
                       (eprintf "Warning: no readline support (~a)\n"
                                (exn-message e)))])
      (dynamic-require '(lib "rep.ss" "readline") #f)
      (let* ([p (dynamic-require '(lib "pread.ss" "readline")
                                 'current-prompt)]
             [r (current-prompt-read)])
        (if (eq? r plain-prompt-read)
          (eprintf "Warning: problems in readline initialization\n")
          (set! reader (lambda (prefix) ; use new reader
                         (if prefix
                           (parameterize ([p (bytes-append prefix (p))])
                             (r))
                           (r)))))))))

(define (make-new-input stx)
  (cons make-new-input stx))
(define (new-input? x)
  (and (pair? x) (eq? make-new-input (car x)) (cdr x)))

;; setup the read handler
(define (new-prompt-read)
  (let loop ()
    (let ([stx (reader prompt)])
      (syntax-case stx ()
        [(uq cmd) (eq? 'unquote (syntax-e #'uq))
         (let ([r (with-handlers ([void (lambda (e)
                                          (parameterize ([current-output-port
                                                          (current-error-port)])
                                            (if (exn? e)
                                              (display (exn-message e))
                                              (write e))
                                            (newline)))])
                    (run-command (syntax-object->datum #'cmd)))])
           (or (new-input? r) ; returns new input if it is one
               (loop)))]
        [_else stx]))))
(current-prompt-read new-prompt-read)

)


;; ============================================================================
;; make this always available (for scripts)

(require debug)


;; ============================================================================
;; use the interactive module only when there is an interaction

(current-prompt-read
 (let ([old (current-prompt-read)])
   (lambda ()
     (current-prompt-read old) ; restore the old one so interactive uses that
     (eval '(require interactive))
     ((current-prompt-read))))) ; use the new prompt for this interaction