22 " Expression-based debugger for clojure code"
33 {:author " Artur Malabarba" }
44 (:require
5+ [clojure.string :as str]
56 [cider.nrepl.middleware.inspect :refer [swap-inspector!]]
67 [cider.nrepl.middleware.util :as util :refer [respond-to]]
78 [cider.nrepl.middleware.util.cljs :as cljs]
9+ [cider.nrepl.middleware.util.eval]
810 [cider.nrepl.middleware.util.instrument :as ins]
911 [cider.nrepl.middleware.util.nrepl :refer [notify-client]]
10- [nrepl.middleware.interruptible-eval :refer [*msg*]]
12+ [nrepl.middleware.interruptible-eval :as ieval : refer [*msg*]]
1113 [nrepl.middleware.print :as print]
1214 [orchard.info :as info]
1315 [orchard.inspect :as inspect]
@@ -175,6 +177,9 @@ this map (identified by a key), and will `dissoc` it afterwards."}
175177(defonce print-options (atom nil ))
176178(defonce step-in-to-next? (atom false ))
177179
180+ (def ^:private nrepl-1-5+?
181+ (cider.nrepl.middleware.util.nrepl/satisfies-version? 1 5 ))
182+
178183(defn pr-short
179184 " Like `pr-str` but limited in length and depth."
180185 [x]
@@ -466,6 +471,10 @@ this map (identified by a key), and will `dissoc` it afterwards."}
466471
467472(def ^:dynamic *tmp-forms* (atom {}))
468473(def ^:dynamic *do-locals* true )
474+ #_:clj-kondo/ignore
475+ (def ^:dynamic ^:private *found-debugger-tag*)
476+ #_:clj-kondo/ignore
477+ (def ^:dynamic ^:private *top-level-form-meta*)
469478
470479(defmacro with-initial-debug-bindings
471480 " Let-wrap `body` with STATE__ map containing code, file, line, column etc.
@@ -476,17 +485,26 @@ this map (identified by a key), and will `dissoc` it afterwards."}
476485 {:style/indent 0 }
477486 [& body]
478487 ; ; NOTE: *msg* is the message that instrumented the function,
479- `(let [~'STATE__ {:msg ~(let [{:keys [code id file line column ns ]} *msg*]
480- {:code code
481- ; ; Passing clojure.lang.Namespace object
482- ; ; as :original-ns breaks nREPL in bewildering
483- ; ; ways.
484- ; ; NOTE: column numbers in the response map
485- ; ; start from 1 according to Clojure.
486- ; ; This is not a bug and should be converted to
487- ; ; 0-based indexing by the client if necessary.
488- :original-id id, :original-ns (str (or ns *ns*))
489- :file file, :line line, :column column})
488+ `(let [~'STATE__ {:msg ~(if (bound? #'*top-level-form-meta*)
489+ (let [{:keys [line column ns ], form-info ::form-info }
490+ *top-level-form-meta*
491+ {:keys [code file original-id]} form-info]
492+ {:code code
493+ ; ; Passing clojure.lang.Namespace object
494+ ; ; as :original-ns breaks nREPL in bewildering
495+ ; ; ways.
496+ ; ; NOTE: column numbers in the response map
497+ ; ; start from 1 according to Clojure.
498+ ; ; This is not a bug and should be converted to
499+ ; ; 0-based indexing by the client if necessary.
500+ :original-ns (str (or ns *ns*))
501+ :original-id original-id
502+ :file file, :line line, :column column})
503+ (let [{:keys [code file line column ns id]} *msg*]
504+ {:code code
505+ :original-ns (str (or ns *ns*))
506+ :original-id id
507+ :file file, :line line, :column column}))
490508 ; ; the coor of first form is used as the debugger session id
491509 :session-id (atom nil )
492510 :skip (atom false )
@@ -626,50 +644,59 @@ this map (identified by a key), and will `dissoc` it afterwards."}
626644; ;; ## Data readers
627645; ;
628646; ; Set in `src/data_readers.clj`.
647+
648+ (defn- found-debugger-tag []
649+ (when (bound? #'*found-debugger-tag*)
650+ (set! *found-debugger-tag* true )))
651+
629652(defn breakpoint-reader
630653 " #break reader. Mark `form` for breakpointing."
631654 [form]
655+ (found-debugger-tag )
632656 (ins/tag-form form #'breakpoint-with-initial-debug-bindings true ))
633657
634658(defn debug-reader
635659 " #dbg reader. Mark all forms in `form` for breakpointing.
636660 `form` itself is also marked."
637661 [form]
662+ (found-debugger-tag )
638663 (ins/tag-form (ins/tag-form-recursively form #'breakpoint-if-interesting)
639664 #'breakpoint-if-interesting-with-initial-debug-bindings))
640665
641666(defn break-on-exception-reader
642667 " #exn reader. Wrap `form` in try-catch and break only on exception"
643668 [form]
669+ (found-debugger-tag )
644670 (ins/tag-form form #'breakpoint-if-exception-with-initial-debug-bindings true ))
645671
646672(defn debug-on-exception-reader
647673 " #dbgexn reader. Mark all forms in `form` for breakpointing on exception.
648674 `form` itself is also marked."
649675 [form]
676+ (found-debugger-tag )
650677 (ins/tag-form (ins/tag-form-recursively form #'breakpoint-if-exception)
651678 #'breakpoint-if-exception-with-initial-debug-bindings))
652679
653680(defn instrument-and-eval [form]
654- (let [form1 ( ins/instrument-tagged-code form)]
655- ; ; (ins/print-form form1 true false)
656- (try
657- (binding [*tmp-forms* (atom {})]
658- (eval form1))
659- (catch java.lang.RuntimeException e
660- (if (some #(when %
661- (re-matches #".*Method code too large!.*"
662- (.getMessage ^Throwable %)))
663- [e (.getCause e)])
664- (do (notify-client *msg*
665- (str " Method code too large!\n "
666- " Locals and evaluation in local context won't be available." )
667- :warning )
668- ; ; re-try without locals
669- (binding [*tmp-forms* (atom {})
670- *do-locals* false ]
671- (eval form1)))
672- (throw e))))))
681+ (with-bindings ( if nrepl-1-5+? {#'*top-level- form-meta* ( meta form)} {})
682+ ( let [form1 (ins/instrument-tagged-code form)]
683+ (try
684+ (binding [*tmp-forms* (atom {})]
685+ (eval form1))
686+ (catch java.lang.RuntimeException e
687+ (if (some #(when %
688+ (re-matches #".*Method code too large!.*"
689+ (.getMessage ^Throwable %)))
690+ [e (.getCause e)])
691+ (do (notify-client *msg*
692+ (str " Method code too large!\n "
693+ " Locals and evaluation in local context won't be available." )
694+ :warning )
695+ ; ; re-try without locals
696+ (binding [*tmp-forms* (atom {})
697+ *do-locals* false ]
698+ (eval form1)))
699+ (throw e) ))))))
673700
674701(def ^:dynamic *debug-data-readers*
675702 " Reader macros like #dbg which cause code to be instrumented when present."
@@ -701,6 +728,30 @@ this map (identified by a key), and will `dissoc` it afterwards."}
701728 ; ; If there was no reader macro, fallback on regular eval.
702729 msg)))
703730
731+ (defn- maybe-debug-nrepl-1-5+
732+ " Alternative implementation of `maybe-debug` that is only supported with nREPL
733+ 1.5+ or higher. This version supports forms compiled by `load-file` and
734+ doesn't perform double read like the older version."
735+ [msg]
736+ (let [read-fn
737+ (fn [options reader]
738+ (binding [*found-debugger-tag* false ]
739+ ; ; Read the form normally and then check if the flag turned on that
740+ ; ; tells us the form contains any debugger reader tags.
741+ (let [[form code] (ins/comment-trimming-read+string options reader)]
742+ (if *found-debugger-tag*
743+ ; ; Attach the original (but cleaned up) source code for the
744+ ; ; instrumenter to set up correct debugger state later.
745+ (vary-meta form assoc
746+ ::form-info {:code code
747+ :file (:file msg)
748+ :original-id (:id msg)})
749+ form))))]
750+ (assoc msg
751+ ::ieval/read-fn read-fn
752+ ::ieval/eval-fn (cider.nrepl.middleware.util.eval/eval-dispatcher
753+ instrument-and-eval ::form-info ))))
754+
704755(defn- initialize
705756 " Initialize the channel used for debug-input requests."
706757 [{:keys [:nrepl.middleware.print/options ] :as msg}]
@@ -723,7 +774,9 @@ this map (identified by a key), and will `dissoc` it afterwards."}
723774 (case op
724775 " eval" (do (when (instance? clojure.lang.Atom session)
725776 (swap! session assoc #'*skip-breaks* (atom nil )))
726- (handler (maybe-debug msg)))
777+ (handler (if nrepl-1-5+?
778+ (maybe-debug-nrepl-1-5+ msg)
779+ (maybe-debug msg))))
727780 " debug-instrumented-defs" (instrumented-defs-reply msg)
728781 " debug-input" (when-let [pro (@promises (:key msg))]
729782 (deliver pro input))
0 commit comments