Skip to content

Commit

Permalink
Two more tricks to solve "method code too large!" issue
Browse files Browse the repository at this point in the history 
  - save original forms within local map
  - recompile with no &env bindings when "code too large!" method detected
  • Loading branch information
@vspinu
vspinu committed Jun 1, 2017
1 parent 990adc0 commit 2bf0d17
Show file tree
Hide file tree
Showing 2 changed files with 90 additions and 68 deletions.
138 changes: 80 additions & 58 deletions src/cider/nrepl/middleware/debug.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -127,15 +127,20 @@
;; the user won't be offered the :quit option if there's no *msg*.
(skip-breaks! :all)))


(defn- filter-env
"Remove internal vars and macro locals with _ in their names."
[locals]
(remove (fn [[k]] (re-find #"_" (name k))) locals))

;;; Politely borrowed from clj-debugger.
(defn sanitize-env
"Turn a macro's &env into a map usable for binding."
[env]
(into {} (for [[sym bind] env
(into {} (for [[sym bind] (filter-env env)
:when (instance? Compiler$LocalBinding bind)]
[`(quote ~sym) (.sym bind)])))


;;;; ## Getting user input
;;; `wrap-debug` receives an initial message from the client, stores
;;; it in `debugger-message`, and `breakpoint` answers it when asking
Expand Down Expand Up @@ -163,17 +168,10 @@
*print-level* @print-level]
(pr-str x)))

(defn- clean-locals
"Remove internal vars and macro locals with _ in their names."
[locals]
(remove (fn [[k]] (re-find #"_" (name k))) locals))

(defn- locals-for-message
"Prepare a map of local variables for sending through the repl.
This involves removing any keys whose name looks like it was
autogenerated by a macro, and turning keys and values to strings."
"Prepare a map of local variables for sending through the repl."
[locals]
(map (partial map pr-short) (clean-locals locals)))
(map (partial map pr-short) locals))

(defn debugger-send
"Send a response through debugger-message."
Expand Down Expand Up @@ -215,7 +213,6 @@
(binding [*eval-locals* locals]
(eval `(let ~(vec (mapcat #(list % `(get *eval-locals* '~%))
(keys *eval-locals*)))
;; (eval `(let ~(vec (mapcat #(list (key %) (val %)) locals))
~form)))
(catch Exception e
;; Borrowed from `interruptible-eval/evaluate`.
Expand Down Expand Up @@ -304,9 +301,9 @@
a :code entry, its value is used for operations such as :eval, which
would otherwise interactively prompt for an expression."
[value extras]
(let [commands (cond-> debug-commands
(not (map? *msg*)) (dissoc "q")
(cljs/grab-cljs-env *msg*) identity)
(let [commands (cond-> debug-commands
(not (map? *msg*)) (dissoc "q")
(cljs/grab-cljs-env *msg*) identity)
response-raw (read-debug extras commands nil)

{:keys [code coord response page-size force?] :or {page-size 32}}
Expand All @@ -315,26 +312,31 @@
extras (dissoc extras :inspect)]
(reset! step-in-to-next? false)
(case response
:next value
:in (do (reset! step-in-to-next? true)
value)
:continue (do (skip-breaks! :all)
value)
:out (do (skip-breaks! :deeper (butlast (:coor extras)) (:code extras) force?)
value)
:here (do (skip-breaks! :before coord (:code extras) force?)
value)
:locals (->> (clean-locals (:locals extras))
(inspect-then-read-command value extras page-size))
:inspect (->> (read-debug-eval-expression "Inspect value: " extras code)
(inspect-then-read-command value extras page-size))
:inject (read-debug-eval-expression "Expression to inject: " extras code)
:eval (let [return (read-debug-eval-expression "Expression to evaluate: " extras code)]
(read-debug-command value (assoc extras :debug-value (pr-short return))))
:next value
:in (do (reset! step-in-to-next? true)
value)
:continue (do (skip-breaks! :all)
value)
:out (do (skip-breaks! :deeper (butlast (:coor extras)) (:code extras) force?)
value)
:here (do (skip-breaks! :before coord (:code extras) force?)
value)
:stacktrace (stack-then-read-command value extras)
:trace (do (skip-breaks! :trace)
value)
:quit (abort!))))
:trace (do (skip-breaks! :trace)
value)
:quit (abort!)
(if (nil? (:locals extras))
;; nil means that we didn't expand &env; see instrument-and-eval
(do (println "WARNING: Compiled with no locals. Method code was too large!")
value)
(case response
:locals (->> (:locals extras)
(inspect-then-read-command value extras page-size))
:inspect (->> (read-debug-eval-expression "Inspect value: " extras code)
(inspect-then-read-command value extras page-size))
:inject (read-debug-eval-expression "Expression to inject: " extras code)
:eval (let [return (read-debug-eval-expression "Expression to evaluate: " extras code)]
(read-debug-command value (assoc extras :debug-value (pr-short return)))))))))

(defn print-step-indented [depth form value]
(print (apply str (repeat (dec depth) "| ")))
Expand Down Expand Up @@ -404,21 +406,26 @@


;;; ## Breakpoint logic

(def ^:dynamic *tmp-forms* (atom {}))
(def ^:dynamic *do-locals* true)

(defmacro with-initial-debug-bindings
"Let-wrap `body` with META_ map containing code, file, line,
column etc."
{:style/indent 1}
[& body]
;; *msg* is the message that instrumented the function,
;; not the message that led to its evaluation.
`(let [~'META_ ~(let [{:keys [code id file line column]} *msg*]
(-> {:code code, :original-id id, :file file,
:line line, :column column}
;; There's an nrepl bug where the column starts counting
;; at 1 if it's after the first line. Since this is a
;; top-level sexp, a (= col 1) is much more likely to be
;; wrong than right.
(update :column #(if (= % 1) 0 %))))]
`(let [~'META_ {:msg ~(let [{:keys [code id file line column]} *msg*]
(-> {:code code, :original-id id, :file file,
:line line, :column column}
;; There's an nrepl bug where the column starts counting
;; at 1 if it's after the first line. Since this is a
;; top-level sexp, a (= col 1) is much more likely to be
;; wrong than right.
(update :column #(if (= % 1) 0 %))))
:forms @*tmp-forms*}]
(when (not (seq @debugger-message))
(throw (Exception. "Debugger not initialized")))
(skip-breaks! nil)
Expand All @@ -428,25 +435,25 @@
"Breakpoint function.
Send the result of form and its coordinates to the client and wait for
response with `read-debug-command`'."
[coor val original-form meta locals]
[coor val locals META_]
(cond
(skip-breaks? coor (:code meta)) val
(skip-breaks? coor (get-in META_ [:msg :code])) val
;; The length of `coor` is a good indicator of current code
;; depth.
(= (:mode @*skip-breaks*) :trace)
(do (print-step-indented (count coor) original-form val)
(do (print-step-indented (count coor) (get-in META_ [:forms coor]) val)
val)
;; Most common case - ask for input.
:else
(read-debug-command val (assoc meta
(read-debug-command val (assoc (:msg META_)
: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 code]
(let [stepin (step-in? var-fn coor code)]
[var-fn args coor META_]
(let [stepin (step-in? var-fn coor (get-in META_ [:msg :code]))]
(apply (if stepin
(::instrumented (meta var-fn))
var-fn)
Expand All @@ -457,9 +464,14 @@
[form {:keys [coor]} original-form]
(let [val-form (if (looks-step-innable? form)
(let [[fn-sym & args] form]
`(apply-instrumented-maybe (var ~fn-sym) [~@args] ~coor (:code ~'META_)))
form)]
`(break ~coor ~val-form '~original-form ~'META_ ~(sanitize-env &env))))
`(apply-instrumented-maybe (var ~fn-sym) [~@args] ~coor ~'META_))
form)
locals (when *do-locals*
(sanitize-env &env))]
;; Keep original forms in a separate atom to save some code
;; size. Unfortunately same trick wouldn't work for locals.
(swap! *tmp-forms* assoc coor original-form)
`(break ~coor ~val-form ~locals ~'META_)))

(def irrelevant-return-value-forms
"Set of special-forms whose return value we don't care about.
Expand Down Expand Up @@ -488,10 +500,10 @@
;; once. Next time, we need to test the condition again.
`(let [old-breaks# @*skip-breaks*]
(when-not ~condition
(skip-breaks! :deeper ~(vec (butlast coor)) (:code ~'META_) false))
(let [val# (expand-break ~form ~extras ~original-form)]
(reset! *skip-breaks* old-breaks#)
val#))
(skip-breaks! :deeper ~(vec (butlast coor)) (:code (:msg ~'META_)) false))
(try
(expand-break ~form ~extras ~original-form)
(finally (reset! *skip-breaks* old-breaks#))))
`(expand-break ~form ~extras ~original-form)))))


Expand All @@ -510,10 +522,20 @@

(defn instrument-and-eval [form]
(let [form1 `(with-initial-debug-bindings
~(ins/instrument-tagged-code form))]
~(ins/instrument-tagged-code form))]
;; (ins/print-form form1 true false)
(eval form1)))

(try
(binding [*tmp-forms* (atom {})]
(eval form1))
(catch java.lang.RuntimeException e
(if (re-matcher #".*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
(binding [*tmp-forms* (atom {})
*do-locals* false]
(eval form1)))
(throw e))))))

;;; ## Middleware
(defn- maybe-debug
Expand Down
20 changes: 10 additions & 10 deletions test/clj/cider/nrepl/middleware/debug_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,9 +82,9 @@
;; Check functionality
(with-redefs [d/abort! (constantly :aborted)
t/send (send-override :quit)]
(is (= :aborted (#'d/read-debug-command 'value {}))))
(is (= :aborted (#'d/read-debug-command 'value (add-locals {})))))
(with-redefs [t/send (send-override :next)]
(is (= 'value (#'d/read-debug-command 'value {}))))
(is (= 'value (#'d/read-debug-command 'value (add-locals {})))))
(binding [*msg* {:session (atom {})}
d/*skip-breaks* (atom {:mode :all})]
(with-redefs [t/send (send-override :continue)]
Expand All @@ -93,25 +93,25 @@
(binding [*msg* {:session (atom {})}
d/*skip-breaks* (atom {:mode :all})]
(with-redefs [t/send (send-override :out)]
(is (= 'value (#'d/read-debug-command 'value {:coor [1 2 3]})))
(is (= 'value (#'d/read-debug-command 'value (add-locals {:coor [1 2 3]}))))
(is (#'d/skip-breaks? [1 2 3] nil))
(is (#'d/skip-breaks? [1 2 4] nil))
(is (not (#'d/skip-breaks? [1 2] nil)))))
(with-redefs [t/send (send-override :inject)]
(is (= :inject (#'d/read-debug-command 'value {})))))
(is (= :inject (#'d/read-debug-command 'value (add-locals {}))))))

(deftest read-debug-command-eval-test
(let [replies (atom [:eval 100 :next])]
(with-redefs [t/send (fn [trans {:keys [key]}]
(deliver (@d/promises key) (first @replies))
(swap! replies rest))]
(is (= 'value (#'d/read-debug-command 'value {}))))))
(is (= 'value (#'d/read-debug-command 'value (add-locals {})))))))

(deftest read-debug-eval-expression-test
(reset! d/debugger-message {})
(let [x 1]
(with-redefs [t/send (send-override '(inc 10))]
(is (= 11 (#'d/read-debug-eval-expression "" {}))))
(is (= 11 (#'d/read-debug-eval-expression "" (add-locals {})))))
(with-redefs [t/send (send-override '(inc x))]
(is (= 2 (#'d/read-debug-eval-expression "" (add-locals {})))))))

Expand Down Expand Up @@ -221,14 +221,14 @@
;; Locals capturing
(is (= (:value (eval `(d/with-initial-debug-bindings
(let [~'x 10] (d/breakpoint-if-interesting
(#'d/clean-locals (locals))
(locals)
{:coor [1]} nil)))))
'[[x 10]]))
'{x 10}))
;; Top-level sexps are not debugged, just returned.
(is (= (eval `(d/with-initial-debug-bindings
(let [~'x 10] (d/breakpoint-if-interesting
(#'d/clean-locals (locals))
(locals)
{:coor []}
nil))))
'[[x 10]]))
'{x 10}))
)))

0 comments on commit 2bf0d17

Please sign in to comment.