Skip to content

Commit

Permalink
Implement debugger session and fix continuation
Browse files Browse the repository at this point in the history 
  Fix #460, fix clojure-emacs/cider#1869, fix clojure-emacs/cider#2253
  fix clojure-emacs/cider#1054
  • Loading branch information
@vspinu
vspinu committed Oct 15, 2018
1 parent ada427d commit eba4840
Showing 1 changed file with 111 additions and 100 deletions.
211 changes: 111 additions & 100 deletions src/cider/nrepl/middleware/debug.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,23 +10,24 @@
[cider.nrepl.middleware.util.instrument :as ins]
[orchard.misc :as misc]
[orchard.meta :as m]
[clojure.java.io :as io])
[clojure.java.io :as io]
[cider.nrepl.middleware.util.nrepl :refer [notify-client]])
(:import [clojure.lang Compiler$LocalBinding]))

;; Compatibility with the legacy tools.nrepl and the new nREPL 0.4.x.
;; The assumption is that if someone is using old lein repl or boot repl
;; they'll end up using the tools.nrepl, otherwise the modern one.
(if (find-ns 'clojure.tools.nrepl)
(require
'[clojure.tools.nrepl.middleware.interruptible-eval :refer [*msg*]]
'[clojure.tools.nrepl.middleware.session :as session]
'[clojure.tools.nrepl.misc :refer [response-for]]
'[clojure.tools.nrepl.transport :as transport])
'[clojure.tools.nrepl.middleware.interruptible-eval :refer [*msg*]]
'[clojure.tools.nrepl.middleware.session :as session]
'[clojure.tools.nrepl.misc :refer [response-for]]
'[clojure.tools.nrepl.transport :as transport])
(require
'[nrepl.middleware.interruptible-eval :refer [*msg*]]
'[nrepl.middleware.session :as session]
'[nrepl.misc :refer [response-for]]
'[nrepl.transport :as transport]))
'[nrepl.middleware.interruptible-eval :refer [*msg*]]
'[nrepl.middleware.session :as session]
'[nrepl.misc :refer [response-for]]
'[nrepl.transport :as transport]))

;;;; # The Debugger
;;;
Expand Down Expand Up @@ -64,12 +65,10 @@
;;;; ## Internal breakpoint logic
;;;
;;; Variables and functions used for navigating between breakpoints.
(def ^:dynamic *skip-breaks*
"Map used to determine whether to skip a breakpoint.
Don't set or examine this directly, it is bound in the session
binding map, use `skip-breaks!` and `skip-breaks?` instead.
Its value is discarded at the end each eval session."
(atom nil))
(def ^:dynamic *skip-all-breaks*
"Boolean which is true when the global `continue` action takes place.
Discarded at the end each eval session."
(atom false))

(defn- random-uuid-str
"Clojure(Script) UUID generator."
Expand All @@ -85,55 +84,57 @@
[a b]
(= (seq a) (seq b)))

(defn skip-breaks?
(defn skip-break?
"True if the breakpoint at coordinates should be skipped.
The `:skip` element of STATE__ is a map which stores a `mode`, `coordinates`,
the `code` that it applies to, and a `force?` flag.
The `*skip-breaks*` map stores a `mode`, `coordinates`, the `code` that it
applies to, and a `force?` flag. Behaviour depends on the `mode`:
Behaviour depends on the `mode`:
- :all - return true, skipping all breaks
- :trace - return false, skip nothing
- :deeper - return true if the given coordinates are deeper than the
coordinates stored in `*skip-breaks*`, in the same code
coordinates stored in `:skip`, in the same code
- :before - return true if the given coordinates represent a place before
the coordinates in `*skip-breaks*`, in the same code
the coordinates in `:skip`, in the same code
For :deeper and :before, if we are not in the same code (i.e. we have stepped
into another instrumented function and code argument doesn't match old code in
*skip-breaks*), then return the value of `force?`."
[coordinates code]
(if (seq coordinates)
(when-let [{mode :mode skip-coords :coor
code-to-skip :code force? :force?} @*skip-breaks*]
(let [same-defn? (identical? code-to-skip code)]
(case mode
;; From :continue, skip everything.
:all true
;; From :trace, never skip.
:trace false
;; From :out, skip some breaks.
:deeper (if same-defn?
(let [parent (take (count skip-coords) coordinates)]
(and (seq= skip-coords parent)
(> (count coordinates) (count parent))))
force?)
;; From :here, skip some breaks.
:before (if same-defn?
(ins/coord< coordinates skip-coords)
force?))))
;; We don't breakpoint top-level sexps, because their return value
;; is already displayed anyway.
true))
:skip), then return the value of `force?`."
[coordinates STATE__]
(or @*skip-all-breaks*
(if (seq coordinates)
(when-let [{mode :mode skip-coords :coor
code-to-skip :code force? :force?} @(:skip STATE__)]
(let [same-defn? (identical? code-to-skip (get-in STATE__ [:msg :code]))]
(case mode
;; From :continue, skip everything.
:all true
;; From :trace, never skip.
:trace false
;; From :out, skip some breaks.
:deeper (if same-defn?
(let [parent (take (count skip-coords) coordinates)]
(and (seq= skip-coords parent)
(> (count coordinates) (count parent))))
force?)
;; From :here, skip some breaks.
:before (if same-defn?
(ins/coord< coordinates skip-coords)
force?))))
;; We don't breakpoint top-level sexps, because their return value
;; is already displayed anyway.
true)))

(defn skip-breaks!
"Set the value of *skip-breaks* for the top-level breakpoint.
"Set the value of local or global skip-breaks `atom` .
Additional arguments depend on mode, and should be:
- empty for :all or :trace
- coordinates, code, and force for :deeper or :before
See `skip-breaks?`."
([mode]
(skip-breaks! mode nil nil nil))
([mode coor code force?]
(reset! *skip-breaks*
See `skip-break?`."
([atom mode]
(skip-breaks! atom mode nil nil nil))
([atom mode coor code force?]
(reset! atom
(case mode
(nil false) nil
(:all :trace) {:mode mode}
Expand All @@ -150,7 +151,7 @@
;; We can't really abort if there's no *msg*, so we do our best
;; impression of that. This is only used in some panic situations,
;; the user won't be offered the :quit option if there's no *msg*.
(skip-breaks! :all)))
(reset! *skip-all-breaks* true)))

(defn- filter-env
"Remove internal vars and macro locals with __ in their names."
Expand Down Expand Up @@ -222,9 +223,9 @@ this map (identified by a key), and will `dissoc` it afterwards."}
(let [root-ex# (#'clojure.main/root-cause e#)]
(when-not (instance? ThreadDeath root-ex#)
(debugger-send
{:status :eval-error
:causes [(let [causes# (stacktrace/analyze-causes e# (:pprint-fn *msg*))]
(when (coll? causes#) (last causes#)))]})))
{:status :eval-error
:causes [(let [causes# (stacktrace/analyze-causes e# (:pprint-fn *msg*))]
(when (coll? causes#) (last causes#)))]})))
error#))]
(if (= error# ~sym)
~error-expr
Expand Down Expand Up @@ -280,8 +281,6 @@ this map (identified by a key), and will `dissoc` it afterwards."}
(eval-with-locals (or code (read-debug-input dbg-state :expression prompt))
dbg-state)))

(declare read-debug-command)

(defn- debug-inspect
"Inspect `inspect-value`."
[page-size inspect-value]
Expand All @@ -295,15 +294,16 @@ this map (identified by a key), and will `dissoc` it afterwards."}
"Create a dummy exception, send its stack."
[]
(debugger-send
{:status :stack
:causes [{:class "StackTrace"
:message "Harmless user-requested stacktrace"
:stacktrace (-> (Exception. "Dummy")
(stacktrace/analyze-causes (:pprint-fn *msg*))
last :stacktrace)}]}))
{:status :stack
:causes [{:class "StackTrace"
:message "Harmless user-requested stacktrace"
:stacktrace (-> (Exception. "Dummy")
(stacktrace/analyze-causes (:pprint-fn *msg*))
last :stacktrace)}]}))

(def debug-commands
{"c" :continue
"C" :Continue
"e" :eval
"h" :here
"i" :in
Expand Down Expand Up @@ -335,47 +335,51 @@ this map (identified by a key), and will `dissoc` it afterwards."}
provide additional parameters. For instance, if this map has a :code entry,
its value is used for operations such as :eval, which would otherwise
interactively prompt for an expression."
[value dbg-state]
[STATE__ value dbg-state]
(let [commands (cond-> debug-commands
(not (map? *msg*)) (dissoc "q")
(nil? (:locals dbg-state)) (dissoc "e" "j" "l" "p")
(nil? (:locals dbg-state)) (dissoc "e" "j" "l" "p")
(cljs/grab-cljs-env *msg*) identity)
response-raw (read-debug-input dbg-state commands nil)
dbg-state (dissoc dbg-state :inspect)
dbg-state (dissoc dbg-state :inspect)
skip (:skip STATE__)

{:keys [code coord response page-size force?]
:or {page-size 32}} (if (map? response-raw)
response-raw
{:response response-raw})]
:or {page-size 32}} (if (map? response-raw)
response-raw
{:response response-raw})]
(reset! step-in-to-next? false)
(case response
:next value
:in (do (reset! step-in-to-next? true)
value)
:continue (do (skip-breaks! :all)
:continue (do (skip-breaks! skip :all)
value)
:Continue (do (reset! *skip-all-breaks* true)
value)
:out (do (skip-breaks! :deeper (butlast (:coor dbg-state)) (:code dbg-state) force?)
:out (do (skip-breaks! skip :deeper (butlast (:coor dbg-state))
(:code dbg-state) force?)
value)
:here (do (skip-breaks! :before coord (:code dbg-state) force?)
:here (do (skip-breaks! skip :before coord (:code dbg-state) force?)
value)
:stacktrace (do (debug-stacktrace)
(recur value dbg-state))
(recur STATE__ value dbg-state))
:trace (do (skip-breaks! :trace)
value)
:locals (->> (debug-inspect page-size (:locals dbg-state))
(assoc dbg-state :inspect)
(recur value))
(recur STATE__ value))
:inspect (try-if-let [val (read-eval-expression "Inspect value: " dbg-state code)]
(->> (debug-inspect page-size val)
(assoc dbg-state :inspect)
(recur value))
(recur value dbg-state))
(->> (debug-inspect page-size val)
(assoc dbg-state :inspect)
(recur STATE__ value))
(recur STATE__ value dbg-state))
:inject (try-if-let [val (read-eval-expression "Expression to inject: " dbg-state code)]
val
(recur value dbg-state))
val
(recur STATE__ value dbg-state))
:eval (try-if-let [val (read-eval-expression "Expression to evaluate: " dbg-state code)]
(recur value (assoc dbg-state :debug-value (pr-short val)))
(recur value dbg-state))
(recur STATE__ value (assoc dbg-state :debug-value (pr-short val)))
(recur STATE__ value dbg-state))
:quit (abort!)
(do (abort!)
(throw (ex-info "Invalid input from `read-debug-input`."
Expand Down Expand Up @@ -420,17 +424,16 @@ this map (identified by a key), and will `dissoc` it afterwards."}
"Return true if we can and should step in to the function in the var `v`.
The \"should\" part is determined by the value in `step-in-to-next?`, which
gets set to true by the user sending the \"step in\" command."
[v coor code]
[v coor STATE__]
(when (and @step-in-to-next?
(not (skip-breaks? coor code))
(not= :trace (:mode @*skip-breaks*))
(not (skip-break? coor STATE__))
(not= :trace (:mode @(:skip STATE__)))
(not (:instrumented (meta v))))
(try
(instrument-var-for-step-in v)
true
(catch Exception e
;; TODO - how do we inform the user that we failed?
(println (.getMessage e))
(notify-client (:msg STATE__) (.getMessage e) :error)
false))))

(defn looks-step-innable?
Expand Down Expand Up @@ -473,6 +476,9 @@ this map (identified by a key), and will `dissoc` it afterwards."}
;; top-level sexp, a (= col 1) is much more likely to be
;; wrong than right.
(update :column #(if (= % 1) 0 %))))
;; the coor of first form is used as the debugger session id
:session-id (atom nil)
:skip (atom nil)
:forms @*tmp-forms*}]
~@body))

Expand All @@ -488,24 +494,28 @@ this map (identified by a key), and will `dissoc` it afterwards."}
Send the result of form and its coordinates to the client and wait for
response with `read-debug-command`'."
[coor val locals STATE__]
(if-let [first-coor @(:session-id STATE__)]
(when (= first-coor coor)
(reset! (:skip STATE__) nil))
(reset! (:session-id STATE__) coor))
(cond
(skip-breaks? coor (get-in STATE__ [:msg :code])) val
(skip-break? coor STATE__) val
;; The length of `coor` is a good indicator of current code
;; depth.
(= (:mode @*skip-breaks*) :trace)
(= (:mode @(:skip STATE__)) :trace)
(do (print-step-indented (count coor) (get-in STATE__ [:forms coor]) val)
val)
;; Most common case - ask for input.
:else
(read-debug-command val (assoc (:msg STATE__)
:debug-value (pr-short val)
:coor coor
:locals locals))))
(read-debug-command STATE__ val (assoc (:msg STATE__)
:debug-value (pr-short val)
:coor coor
:locals locals))))

(defn apply-instrumented-maybe
"Apply var-fn or its instrumented version to args."
[var-fn args coor STATE__]
(let [stepin (step-in? var-fn coor (get-in STATE__ [:msg :code]))]
(let [stepin (step-in? var-fn coor STATE__)]
(apply (if stepin
(::instrumented (meta var-fn))
var-fn)
Expand Down Expand Up @@ -550,12 +560,12 @@ this map (identified by a key), and will `dissoc` it afterwards."}
;; If there is a condition and it is falsy, we need to skip
;; the current level (:deeper than parent coor), but only
;; once. Next time, we need to test the condition again.
`(let [old-breaks# @*skip-breaks*]
`(let [old-breaks# @(:skip ~'STATE__)]
(when-not ~condition
(skip-breaks! :deeper ~(vec (butlast coor)) (:code (:msg ~'STATE__)) false))
(try
(expand-break ~form ~dbg-state ~original-form)
(finally (reset! *skip-breaks* old-breaks#))))
(finally (reset! (:skip ~'STATE__) old-breaks#))))
`(expand-break ~form ~dbg-state ~original-form)))))

;;; ## Data readers
Expand All @@ -575,15 +585,16 @@ this map (identified by a key), and will `dissoc` it afterwards."}

(defn instrument-and-eval [form]
(let [form1 (ins/instrument-tagged-code form)]
;; (ins/print-form form1 true false)
(ins/print-form form1 true false)
(try
(binding [*tmp-forms* (atom {})]
(eval form1))
(catch java.lang.RuntimeException e
(if (re-matches #".*Method code too large!.*" (.getMessage e))
(do (println "WARNING: Method code too large!"
"Locals and evaluation in local context won't be available.")
;; Re-try without locals
(do (notify-client (str "Method code too large!\n"
"Locals and evaluation in local context won't be available.")
:warning)
;; re-try without locals
(binding [*tmp-forms* (atom {})
*do-locals* false]
(eval form1)))
Expand Down Expand Up @@ -639,7 +650,7 @@ this map (identified by a key), and will `dissoc` it afterwards."}
[handler {:keys [op input session] :as msg}]
(case op
"eval" (do (when (instance? clojure.lang.Atom session)
(swap! session assoc #'*skip-breaks* (atom nil)))
(swap! session assoc #'*skip-all-breaks* (atom false)))
(handler (maybe-debug msg)))
"debug-instrumented-defs" (instrumented-defs-reply msg)
"debug-input" (when-let [pro (@promises (:key msg))]
Expand Down

0 comments on commit eba4840

Please sign in to comment.