;; (ql:quickload :trivial-custom-debugger)

(defun read-debug-expression (number-of-restarts)
  (format t ";; Enter a restart number to be invoked~%")
  (format t ";; or an expression to be evaluated.~%")
  (loop (format t "Debug> ")
        (let* ((form (read)))
          (if (and (integerp form) (< -1 form number-of-restarts))
              (return form)
              (print (eval form))))))

(defmacro with-abort-restart (&body body)
  (let ((level (gensym)))
    `(let ((,level *debugger-level*))
       (with-simple-restart (abort "Return to level ~D of the debugger." ,level)
         ,@body))))

(defun print-banner (condition)
  (format t ";;~%;; Debugger level ~D entered on ~S:~%"
          *debugger-level* (type-of condition))
  (format t ";; ~W~%" condition))

(defun print-restarts (restarts)
  (format t ";;~%;; Available restarts:~%")
  (loop for i from 0
        for restart in restarts do
          (format t ";; ~D [~W] ~W~%" i (restart-name restart) restart)))

(defvar *debugger-level* 0)

(defvar *debugger-condition* nil)

(defun debugger (condition hook)
  (let ((*print-escape* nil)
        (*debugger-condition* condition)
        (*debugger-level* (1+ *debugger-level*)))
    (print-banner condition)
    (let ((restarts (compute-restarts condition)))
      (print-restarts restarts)
      (let* ((*debugger-hook* hook)
             (chosen-restart
               (with-abort-restart (read-debug-expression (length restarts)))))
        (when chosen-restart
          (with-abort-restart
              (invoke-restart-interactively (nth chosen-restart restarts)))))
      (let ((*debugger-level* (1- *debugger-level*)))
        (debugger condition hook)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

CL-USER> (trivial-custom-debugger:with-debugger (#'debugger)
           (check-type *x* string))
;;
;; Debugger level 1 entered on SIMPLE-TYPE-ERROR:
;; The value of *X* is 42, which is not of type STRING.
;;
;; Available restarts:
;; 0 [STORE-VALUE] Supply a new value for *X*.
;; 1 [RETRY] Retry SLIME REPL evaluation request.
;; 2 [ABORT] Return to SLIME's top level.
;; 3 [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {100FFB9DE3}>)
;; Enter a restart number to be invoked
;; or an expression to be evaluated.
Debug> (setg *x* "forty-two")
;;
;; Debugger level 2 entered on UNDEFINED-FUNCTION:
;; The function COMMON-LISP-USER::SETG is undefined.
;;
;; Available restarts:
;; 0 [CONTINUE] Retry using SETG.
;; 1 [USE-VALUE] Use specified function
;; 2 [ABORT] Return to level 1 of the debugger.
;; 3 [RETRY] Retry SLIME REPL evaluation request.
;; 4 [ABORT] Return to SLIME's top level.
;; 5 [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {100FFB9DE3}>)
;; Enter a restart number to be invoked
;; or an expression to be evaluated.
Debug> (let ((*print-escape* nil))
         (format t "~&~{;; ~W~%~}"
                   (set-difference
                    (compute-restarts)
                    (compute-restarts *debugger-condition*))))

;; Supply a new value for *X*.
NIL
Debug>