Merge pull request #177 from Malabarba/master

bbatsov · bbatsov · commit 6249eb0fd4dc · 2015-04-02T08:59:37.000+03:00
Some improvements to intrument.clj
diff --git a/src/cider/nrepl/middleware/debug.clj b/src/cider/nrepl/middleware/debug.clj
@@ -35,7 +35,7 @@
    (:transport @debugger-message)
    (response-for @debugger-message
                  (assoc extras
-                        :value (pr-str value)
+                        :debug-value (pr-str value)
                         :breakfunction nil)))
   ;; Send the actual break.
   (binding [*out* (new java.io.StringWriter)]
diff --git a/src/cider/nrepl/middleware/util/instrument.clj b/src/cider/nrepl/middleware/util/instrument.clj
@@ -45,18 +45,28 @@
   Used only for the purposed of instrumenting on special symbols which
   don't have arglists (such as `if` or `try`), or for macros whose
   usual arglist we wouldn't understand.
-  
+
   This can also be used to disable instrumenting of a form by setting
   its arglist to ([]).
 
   Finally, if the key's value is a symbol, it is taken as an alias and
   we use this symbol's arglist."
-  
-  '{if ([& expr])
-    try ([])
-    def ([form doc-string? expr?])
-    defn- defn
-    fn ([name? [params*] exprs*] [name? ([params*] exprs*) +])})
+
+  '{;; Possible in theory, but not supported yet.
+    try ([& form]),
+
+    ;; More sophisticated cases with badly written arglists.
+    defn- defn,
+    fn ([name? [params*] exprs*] [name? ([params*] exprs*) +]),
+
+    ;; condp, cond, case, cond->, cond->>, all use different meanings
+    ;; for the "clause" argument. We do the best we can in the
+    ;; `specifier-map` below, but we need to override a few here too.
+    ;; case clauses are of the form-expression type.
+    case ([expr fe-clause* expr?]),
+    ;; cond-> clauses are of the expression-form type.
+    cond-> ([expr & ef-clause]),
+    cond->> cond->})
 
 (defn- macro-arglists
   "Return a list of possible arglist vectors for symbol."
@@ -68,8 +78,15 @@
     (let [metadata (if (var? symbol)
                      (meta symbol)
                      (info-clj (ns-name *ns*) symbol))]
+      ;; :debugspec let's people define their own macros in a way we
+      ;; can instrument it (if they don't want to use the arglist).
       (or (:debugspec metadata)
-          (:arglists metadata)))))
+          ;; Then we look for an arglist.
+          (:arglists metadata)
+          ;; If it doesn't have an arglist, it's probably a special
+          ;; form. Try to construct an arglist from :forms.
+          (map (comp vec rest)
+               (filter seq? (:forms metadata)))))))
 
 ;;; Because of the way we handle arglists, we need the modifiers such
 ;;; as + or & to come before the argument they're affecting. That's
@@ -192,14 +209,17 @@
                forms
                (range (count forms))))))
 
-(defn- instrument-two-args
+(defn- instrument-second-arg
   [{:keys [coor] :as ex} [form1 form2 & forms]]
-  (cons (instrument ex form1)
+  (cons form1
         (let [n (last coor)
               coor (vec (butlast coor))]
           (cons (instrument (assoc ex :coor (conj coor (inc n))) form2)
                 forms))))
 
+(def instrument-two-args
+  #(instrument-next-arg %1 (instrument-second-arg %1 %2)))
+
 (declare instrument-special-form-try)
 (def specifier-map
   "Map between specifiers and [matcher handler] functions pairs.
@@ -220,31 +240,40 @@
   if the matcher returned nil."
 
   {;; Safe to instrument
-   "else" [always-1 instrument-next-arg]
    "expr" [always-1 instrument-next-arg]
+   "init" [always-1 instrument-next-arg]
    "pred" [always-1 instrument-next-arg]
-   "then" [always-1 instrument-next-arg]
    "test" [always-1 instrument-next-arg]
+   "then" [always-1 instrument-next-arg]
+   "else" [always-1 instrument-next-arg]
    ;; Match everything.
    "body" [count instrument-all-args]
    ;; Not safe or not meant to be instrumented
    "form"    [always-1 instrument-nothing]
    "oldform" [always-1 instrument-nothing]
    "params"  [always-1 instrument-nothing]
    "name"    [(fn [[f]] (if (symbol? f) 1)) instrument-nothing]
+   "symbol"  [(fn [[f]] (if (symbol? f) 1)) instrument-nothing]
    ;; Complicated
    "bindings" [specifier-match-bindings
                (fn [ex [bindings & forms]]
                  (cons (instrument-bindings ex bindings) forms))]
    "docstring" [#(when (string? (first %)) 1) instrument-nothing]
    "string"    [#(when (string? (first %)) 1) instrument-nothing]
    "map"       [#(when (map? (first %)) 1)    instrument-next-arg]
-   "clause"    [#(when (> (count %) 1) 2)     instrument-two-args]
    "fn-tail"   [#(when (vector? (first %)) (count %))
                 instrument-all-but-first-arg]
    "dispatch-fn" [(fn [[[f & r]]]
                     (when (instrument-special-form-try [] f r) 1))
-                  instrument-next-arg]})
+                  instrument-next-arg]
+   ;; Clauses are a mess. cond, condp, case, all take them to mean
+   ;; different things. And don't get me started on cond->.
+   ;; I hereby declare `clause` to mean "instrument anything".
+   "clause"    [always-1 instrument-next-arg]
+   ;; Expression-Form type clauses instrument every odd argument.
+   "ef-clause" [#(if (> (count %) 1) 2) instrument-next-arg]
+   ;; Form-Expression type clauses instrument every even argument.
+   "fe-clause" [#(if (> (count %) 1) 2) instrument-second-arg]})
 
 (defn- specifier-destructure
   "Take a symbol specifier and return a vector description.
@@ -268,6 +297,7 @@
           (if (.endsWith spec-name "s")
             (subs spec-name 0 (dec (count spec-name)))
             (str spec-name "s")))
+         (and (.endsWith spec-name "-symbol") (specifier-map "symbol"))
          (and (.endsWith spec-name "-string") (specifier-map "string"))
          (and (.endsWith spec-name "-map") (specifier-map "map"))
          [always-1 instrument-nothing])
@@ -445,14 +475,32 @@
   ([form ex]
    `(~(:breakfunction ex) ~form ~ex)))
 
+(defn- contains-recur?
+  "Return true if form is not a `loop` and a `recur` is found in it."
+  [form]
+  (if (listy? form)
+    (condp = (first form)
+      'recur true
+      'loop  false
+      (some contains-recur? (rest form)))))
+
+(defn- dont-break?
+  "Return true if it's NOT ok to wrap form in a breakpoint.
+  Expressions we don't want to wrap are those containing a `recur`
+  form, and those whose `name` is contained in
+  `irrelevant-return-value-macros`."
+  [form]
+  (or (irrelevant-return-value-macros name)
+      (contains-recur? form)))
+
 (defn- instrument-function-like-form
   "Instrument form representing a function/macro call or special-form."
   [ex [name & args :as form]]
   (if (symbol? name)
     (let [name (or (ns-resolve *ns* name) name)]
       (if (or (resolve-special name)
               (:macro (meta name)))
-        (if (irrelevant-return-value-macros name)
+        (if (dont-break? form)
           (instrument-special-form ex form)
           (with-break instrument-special-form form ex))
         (with-break instrument-coll form ex)))
diff --git a/test/cider/nrepl/middleware/util/instrument_test.clj b/test/cider/nrepl/middleware/util/instrument_test.clj
@@ -26,12 +26,12 @@
 
 (deftest macro-arglists
   (are [s a] (= (#'t/macro-arglists s) a)
-    'if '([& expr])
+    'if   '([test then else?])
     'when '([test & body])
-    'let '([bindings & body])
+    'let  '([bindings & body])
     'defn '([name doc-string? attr-map? [params*] prepost-map? body]
             [name doc-string? attr-map? ([params*] prepost-map? body) + attr-map?])
-    'def '([form doc-string? expr?])))
+    'def  '([symbol doc-string? init?])))
 
 (deftest reorder-+
   (are [a b] (= (#'t/reorder-+ a) b)
@@ -44,27 +44,111 @@
 
 (deftest always-1
   (are [a] (= (#'t/always-1 a) 1)
-    '[+ 1 2 3 4] '(+ 1 2 3 4)
-    '([& expr]) '([test & body])
+    '[+ 1 2 3 4]
+    '(+ 1 2 3 4)
+    '([& expr])
+    '([test & body])
     'pikachu
     "Charizard"
     :Blastoise))
 
 ;;; Dummy ex
 (def dex {:coor [13] :breakfunction 'b})
+(defn- id [v] (assoc dex :coor v))
+(defmacro bt [form vec]
+  `'(~'b ~(eval form) ~(id vec)))
 
 (deftest instrument-nothing
-  (are [a b] (= (#'t/instrument-nothing '{:coor a} b) b)
+  (are [a b] (= (#'t/instrument-nothing dex b) b)
     '[+ 1 2 3 4] '(+ 1 2 3 4)
-    '([& expr]) '([test & body])
-    'pikachu "Charizard"
-    :Blastoise :Magikarp))
+    '([& expr])  '([test & body])
+    'pikachu     "Charizard"
+    :Blastoise   :Magikarp))
 
 (deftest instrument-map
   (is (= (#'t/instrument-map dex '{:a 1, (name :b) (inc 2)})
-         '{:a 1,
-           (b (name :b) {:breakfunction b, :coor [13 2]})
-           (b (inc 2) {:breakfunction b, :coor [13 3]})})))
+         {:a 1,
+          (bt '(name :b) [13 2])
+          (bt '(inc 2) [13 3])})))
+
+(deftest instrument-basics
+  (are [f o] (= (f dex '(a b c)) o)
+    #'t/instrument-all-args          (list (bt 'a [13]) (bt 'b [14]) (bt 'c [15]))
+    #'t/instrument-next-arg          (list (bt 'a [13]) 'b 'c)
+    #'t/instrument-nothing           (list 'a 'b 'c)
+    #'t/instrument-all-but-first-arg (list 'a (bt 'b [14]) (bt 'c [15]))
+    #'t/instrument-second-arg        (list 'a (bt 'b [14]) 'c)
+    #'t/instrument-two-args          (list (bt 'a [13]) (bt 'b [14]) 'c)))
+
+(deftest instrument-clauses
+  (are [exp res] (= (#'t/instrument dex exp)
+                    res)
+
+    '(cond-> value
+       v2 form
+       v3 form)
+    `(~'b (~'cond-> ~(bt 'value [13 1])
+                    ~(bt 'v2 [13 2]) ~'form
+                    ~(bt 'v3 [13 4]) ~'form)
+          ~(id [13]))
+
+    '(case value
+       const expr
+       default)
+    `(~'b (~'case ~(bt 'value [13 1])
+                  ~'const ~(bt 'expr [13 3])
+                  ~(bt 'default [13 4]))
+          ~(id [13]))
+
+    '(condp pred value
+       v4 :key v5)
+    `(~'b (~'condp ~(bt 'pred [13 1]) ~(bt 'value [13 2])
+                   ~(bt 'v4 [13 3]) :key ~(bt 'v5 [13 5]))
+          ~(id [13]))
+
+    '(condp pred value
+       v2 v3
+       default)
+    `(~'b (~'condp ~(bt 'pred [13 1]) ~(bt 'value [13 2])
+                   ~(bt 'v2 [13 3]) ~(bt 'v3 [13 4])
+                   ~(bt 'default [13 5]))
+          ~(id [13]))
+
+    '(cond
+       (= x 1) true
+       false   never
+       :else   final)
+    `(~'b
+      (~'cond (~'b (~'= ~(bt 'x [13 1 1]) 1) ~(id [13 1]))
+              true
+              false ~(bt 'never [13 4])
+              :else ~(bt 'final [13 6]))
+      ~(id [13]))))
+
+
+(deftest instrument-recur
+  (is (= (#'t/instrument dex '(loop [x '(1 2)]
+                                (if (seq x)
+                                  (recur (rest x))
+                                  x)))
+         `(~'b (~'loop [~'x ~(bt ''(1 2) [13 1 1])]
+                       (~'if (~'b (~'seq ~(bt 'x [13 2 1 1]))
+                                  ~(id [13 2 1]))
+                             (~'recur (~'b (~'rest ~(bt 'x [13 2 2 1 1]))
+                                           ~(id [13 2 2 1])))
+                             ~(bt 'x [13 2 3])))
+               ~(id [13]))))
+
+  (is (= (#'t/instrument dex '(fn [x]
+                                (if (seq x)
+                                  (recur (rest x))
+                                  x)))
+         `(~'fn [~'x]
+                (~'if (~'b (~'seq ~(bt 'x [13 2 1 1]))
+                           ~(id [13 2 1]))
+                      (~'recur (~'b (~'rest ~(bt 'x [13 2 2 1 1]))
+                                    ~(id [13 2 2 1])))
+                      ~(bt 'x [13 2 3]))))))
 
 (deftest specifier-match-bindings
   (are [f] (= 1 (#'t/specifier-match-bindings f))
