ond
   ((or (not (integer? count)) (<= count 0))
    (format #t "Invalid argument to `down': expected a positive integer for COUNT.~%"))
   ((< (- index count) 0)
    (cond
     ((zero? index)
      (format #t "Already at innermost frame.\n"))
     (else
      (set! index 0)
      (print-frame cur #:index index))))
   (else
    (set! index (- index count))
    (print-frame cur #:index index))))

(define-stack-command (frame repl #:optional idx)
  "frame [IDX]
Show a frame.

Show the selected frame.
With an argument, select a frame by index, then show it."
  (cond
   (idx
    (cond
     ((or (not (integer? idx)) (< idx 0))
      (format #t "Invalid argument to `frame': expected a non-negative integer for IDX.~%"))
     ((< idx (vector-length frames))
      (set! index idx)
      (print-frame cur #:index index))
     (else
      (format #t "No such frame.~%"))))
   (else (print-frame cur #:index index))))

(define-stack-command (locals repl #:key (width (terminal-width)))
  "locals
Show local variables.

Show locally-bound variables in the selected frame."
  (print-locals cur #:width width))

(define-stack-command (error-message repl)
  "error-message
Show error message.

Display the message associated with the error that started the current
debugging REPL."
  (format #t "~a~%" (if (string? message) message "No error message")))

(define-meta-command (break repl (form))
  "break PROCEDURE
Break on calls to PROCEDURE.

Starts a recursive prompt when PROCEDURE is called."
  (let ((proc (repl-eval repl (repl-parse repl form))))
    (if (not (procedure? proc))
        (error "Not a procedure: ~a" proc)
        (let ((idx (add-trap-at-procedure-call! proc)))
          (format #t "Trap ~a: ~a.~%" idx (trap-name idx))))))

(define-meta-command (break-at-source repl file line)
  "break-at-source FILE LINE
Break when control reaches the given source location.

Starts a recursive prompt when control reaches line LINE of file FILE.
Note that the given source location must be inside a procedure."
  (let ((file (if (symbol? file) (symbol->string file) file)))
    (let ((idx (add-trap-at-source-location! file line)))
      (format #t "Trap ~a: ~a.~%" idx (trap-name idx)))))

(define (repl-pop-continuation-resumer repl msg)
  ;; Capture the dynamic environment with this prompt thing. The result
  ;; is a procedure that takes a frame and number of values returned.
  (% (call-with-values
         (lambda ()
           (abort
            (lambda (k)
              ;; Call frame->stack-vector before reinstating the
              ;; continuation, so that we catch the %stacks fluid at
              ;; the time of capture.
              (lambda (frame . values)
                (k frame
                   (frame->stack-vector
                    (frame-previous frame))
                   values)))))
       (lambda (from stack values)
         (format #t "~a~%" msg)
         (if (null? values)
             (format #t "No return values.~%")
             (begin
               (format #t "Return values:~%")
               (for-each (lambda (x) (repl-print repl x)) values)))
         ((module-ref (resolve-interface '(system repl repl)) 'start-repl)
          #:debug (make-debug stack 0 msg))))))

(define-stack-command (finish repl)
  "finish
Run until the current frame finishes.

Resume execution, breaking when the current frame finishes."
  (let ((handler (repl-pop-continuation-resumer
                  repl (format #f "Return from ~a" cur))))
    (add-ephemeral-trap-at-frame-finish! cur handler)
    (throw 'quit)))

(define (repl-next-resumer msg)
  ;; Capture the dynamic environment with this prompt thing. The
  ;; result is a procedure that takes a frame.
  (% (let ((stack (abort
                   (lambda (k)
                     ;; Call frame->stack-vector before reinstating the
                     ;; continuation, so that we catch the %stacks fluid
                     ;; at the time of capture.
                     (lambda (frame)
                       (k (frame->stack-vector frame)))))))
       (format #t "~a~%" msg)
       ((module-ref (resolve-interface '(system repl repl)) 'start-repl)
        #:debug (make-debug stack 0 msg)))))

(define-stack-command (step repl)
  "step
Step until control reaches a different source location.

Step until control reaches a different source location."
  (let ((msg (format #f "Step into ~a" cur)))
    (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                  #:into? #t #:instruction? #f)
    (throw 'quit)))

(define-stack-command (step-instruction repl)
  "step-instruction
Step until control reaches a different instruction.

Step until control reaches a different VM instruction."
  (let ((msg (format #f "Step into ~a" cur)))
    (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                  #:into? #t #:instruction? #t)
    (throw 'quit)))

(define-stack-command (next repl)
  "next
Step until control reaches a different source location in the current frame.

Step until control reaches a different source location in the current frame."
  (let ((msg (format #f "Step into ~a" cur)))
    (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                  #:into? #f #:instruction? #f)
    (throw 'quit)))

(define-stack-command (next-instruction repl)
  "next-instruction
Step until control reaches a different instruction in the current frame.

Step until control reaches a different VM instruction in the current frame."
  (let ((msg (format #f "Step into ~a" cur)))
    (add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
                                  #:into? #f #:instruction? #t)
    (throw 'quit)))

(define-meta-command (tracepoint repl (form))
  "tracepoint PROCEDURE
Add a tracepoint to PROCEDURE.

A tracepoint will print out the procedure and its arguments, when it is
called, and its return value(s) when it returns."
  (let ((proc (repl-eval repl (repl-parse repl form))))
    (if (not (procedure? proc))
        (error "Not a procedure: ~a" proc)
        (let ((idx (add-trace-at-procedure-call! proc)))
          (format #t "Trap ~a: ~a.~%" idx (trap-name idx))))))

(define-meta-command (traps repl)
  "traps
Show the set of currently attached traps.

Show the set of currently attached traps (breakpoints and tracepoints)."
  (let ((traps (list-traps)))
    (if (null? traps)
        (format #t "No traps set.~%")
        (for-each (lambda (idx)
                    (format #t "  ~a: ~a~a~%"
                            idx (trap-name idx)
                            (if (trap-enabled? idx) "" " (disabled)")))
                  traps))))

(define-meta-command (delete repl idx)
  "delete IDX
Delete a trap.

Delete a trap."
  (if (not (integer? idx))
      (error "expected a trap index (a non-negative integer)" idx)
      (delete-trap! idx)))

(define-meta-command (disable repl idx)
  "disable IDX
Disable a trap.

Disable a trap."
  (if (not (integer? idx))
      (error "expected a trap index (a non-negative integer)" idx)
      (disable-trap! idx)))

(define-meta-command (enable repl idx)
  "enable IDX
Enable a trap.

Enable a trap."
  (if (not (integer? idx))
      (error "expected a trap index (a non-negative integer)" idx)
      (enable-trap! idx)))

(define-stack-command (registers repl)
  "registers
Print registers.

Print the registers of the current frame."
  (print-registers cur))

(define-meta-command (width repl #:optional x)
  "width [X]
Set debug output width.

Set the number of screen columns in the output from `backtrace' and
`locals'."
  (terminal-width x)
  (format #t "Set screen width to ~a columns.~%" (terminal-width)))


