From 2bf0d17b80f00772e67ad29d5a52db335bd7805d Mon Sep 17 00:00:00 2001 From: Vitalie Spinu Date: Thu, 1 Jun 2017 03:41:28 +0200 Subject: [PATCH] Two more tricks to solve "method code too large!" issue - save original forms within local map - recompile with no &env bindings when "code too large!" method detected --- src/cider/nrepl/middleware/debug.clj | 138 ++++++++++-------- .../clj/cider/nrepl/middleware/debug_test.clj | 20 +-- 2 files changed, 90 insertions(+), 68 deletions(-) diff --git a/src/cider/nrepl/middleware/debug.clj b/src/cider/nrepl/middleware/debug.clj index fb7d10305..74864b4bf 100644 --- a/src/cider/nrepl/middleware/debug.clj +++ b/src/cider/nrepl/middleware/debug.clj @@ -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 @@ -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." @@ -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`. @@ -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}} @@ -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) "| "))) @@ -404,6 +406,10 @@ ;;; ## 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." @@ -411,14 +417,15 @@ [& 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) @@ -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) @@ -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. @@ -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))))) @@ -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 diff --git a/test/clj/cider/nrepl/middleware/debug_test.clj b/test/clj/cider/nrepl/middleware/debug_test.clj index b6acf7e84..04b768c5d 100644 --- a/test/clj/cider/nrepl/middleware/debug_test.clj +++ b/test/clj/cider/nrepl/middleware/debug_test.clj @@ -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)] @@ -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 {}))))))) @@ -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})) )))