Skip to content

Commit

Permalink
improve defprotocol detection
Browse files Browse the repository at this point in the history
  • Loading branch information
@Bronsa
Bronsa committed Aug 22, 2014
1 parent 55bd59f commit 2509606
Show file tree
Hide file tree
Showing 3 changed files with 19 additions and 84 deletions.
37 changes: 14 additions & 23 deletions src/eastwood/core.clj
View file
Expand Up @@ -47,8 +47,7 @@ return value followed by the time it took to evaluate in millisec."
[ret# elapsed-msec#]))

(def ^:private available-linters
{
:misplaced-docstrings misc/misplaced-docstrings
{:misplaced-docstrings misc/misplaced-docstrings
:deprecations deprecated/deprecations
:redefd-vars misc/redefd-vars
:def-in-def misc/def-in-def
Expand All @@ -64,12 +63,10 @@ return value followed by the time it took to evaluate in millisec."
:unused-namespaces unused/unused-namespaces
:unlimited-use misc/unlimited-use
:keyword-typos typos/keyword-typos
:non-dynamic-earmuffs misc/non-dynamic-earmuffs
})
:non-dynamic-earmuffs misc/non-dynamic-earmuffs})

(def ^:private default-linters
#{
:misplaced-docstrings
#{:misplaced-docstrings
:deprecations
:redefd-vars
:def-in-def
Expand All @@ -79,13 +76,7 @@ return value followed by the time it took to evaluate in millisec."
:suspicious-expression
:unused-ret-vals
:unused-ret-vals-in-try
;;:unused-private-vars ; not yet updated to t.a(.jvm). Also needs cols
;; :unused-fn-args ; updated, but don't use it by default
;; :unused-namespaces ; updated, but don't use it by default. no line/col
:unlimited-use
;; :keyword-typos ; updated, but don't use it by default. no line/col
;;:non-dynamic-earmuffs ; not yet updated to t.a(.jvm). Also needs cols
})
:unlimited-use})

(defn- lint [exprs kw]
(try
Expand Down Expand Up @@ -125,16 +116,16 @@ entire stack trace if depth is nil). Does not print ex-data."
(str/upper-case (subs x 0 1))))))) ; first char is upper-case

(defn misplaced-primitive-tag? [x]
(cond
(= x clojure.core/byte) {:prim-name "byte", :supported-as-ret-hint false}
(= x clojure.core/short) {:prim-name "short", :supported-as-ret-hint false}
(= x clojure.core/int) {:prim-name "int", :supported-as-ret-hint false}
(= x clojure.core/long) {:prim-name "long", :supported-as-ret-hint true}
(= x clojure.core/boolean) {:prim-name "boolean", :supported-as-ret-hint false}
(= x clojure.core/char) {:prim-name "char", :supported-as-ret-hint false}
(= x clojure.core/float) {:prim-name "float", :supported-as-ret-hint false}
(= x clojure.core/double) {:prim-name "double", :supported-as-ret-hint true}
:else nil))
(condp = x
clojure.core/byte {:prim-name "byte", :supported-as-ret-hint false}
clojure.core/short {:prim-name "short", :supported-as-ret-hint false}
clojure.core/int {:prim-name "int", :supported-as-ret-hint false}
clojure.core/long {:prim-name "long", :supported-as-ret-hint true}
clojure.core/boolean {:prim-name "boolean", :supported-as-ret-hint false}
clojure.core/char {:prim-name "char", :supported-as-ret-hint false}
clojure.core/float {:prim-name "float", :supported-as-ret-hint false}
clojure.core/double {:prim-name "double", :supported-as-ret-hint true}
nil))

(defn print-ex-data-details [ns-sym opts ^Throwable exc]
(let [dat (ex-data exc)
Expand Down
62 changes: 3 additions & 59 deletions src/eastwood/linters/unused.clj
View file
Expand Up @@ -152,71 +152,15 @@ selectively disable such warnings if they wish."
(def ^:dynamic *warning-if-invoke-ret-val-unused* {})
(def ^:dynamic *warning-if-static-ret-val-unused* {})

;; Do a semi-precise pattern-based check of the shape of :do ast that
;; is generated by a 'defprotocol' macro invocation. It might match
;; other code that was not generated as part of a defprotocol
;; expansion, but this is highly unlikely, especially given the check
;; for the :invoke on #'clojure.core/-reset-methods and the two other
;; invoke checks, in a particular order.
;;
;; Even if there was such a false match, the only harm that would be
;; done is that Eastwood would not warn about the do's 4th statement
;; of 'nil' being an unused return value.
(defn- mark-things-in-defprotocol-expansion-post [ast]
(if-not (and (= :do (:op ast))
(= [:statements :ret] (:children ast))
(= 6 (count (:statements ast)))
;; First do statement in defprotocol expansion is a
;; defonce in the defprotocol macro, but that further
;; expands in the analyzed ast into a :let
(let [stmt0 (nth (:statements ast) 0)]
(= :let (:op stmt0)))
;; Second statement in defprotocol expansion is a
;; gen-interface call, but in the analyzed ast it
;; becomes a :const node with a form value that is a
;; Java class that is also an interface.
(let [stmt1 (nth (:statements ast) 1)]
(and (= :const (:op stmt1))
(= :class (:type stmt1))
(util/interface? (:form stmt1))))
;; Third statement in defprotocol expansion is a
;; alter-meta! call
(let [stmt2 (nth (:statements ast) 2)]
(and (= :invoke (:op stmt2))
(= #'clojure.core/alter-meta! (-> stmt2 :fn :var))))
;; Fourth statement in defprotocol expansion is for the
;; methods. This can be nil if it is just a marker
;; protocol, or proportional to the number of methods
;; defined. Do not do any checks on it here.

;; Fifth statement in defprotocol expansion is a
;; alter-var-root call
(let [stmt4 (nth (:statements ast) 4)]
(and (= :invoke (:op stmt4))
(= #'clojure.core/alter-var-root (-> stmt4 :fn :var))))
;; Sixth statement in defprotocol expansion is a
;; -reset-methods call
(let [stmt5 (nth (:statements ast) 5)]
(and (= :invoke (:op stmt5))
(= #'clojure.core/-reset-methods (-> stmt5 :fn :var))))
;; Return expression in defprotocol expansion is a
;; quoted constant symbol with the name of the
;; protocol.
(let [do-ret-ast (:ret ast)]
(and (= :quote (:op do-ret-ast))
(= true (:literal? do-ret-ast))
(= :const (-> do-ret-ast :expr :op))
(= :symbol (-> do-ret-ast :expr :type))
(= true (-> do-ret-ast :expr :literal?)))))
(defn- mark-things-in-defprotocol-expansion-post [{:keys [env] :as ast}]
(if (not-any? #(= % 'clojure.core/defprotocol)) (map #(and (seq? %) (first %)) (:eastwood/partly-resolved-forms ast))
ast
(let [defprotocol-var (get-in ast [:ret :expr :val])
;; Mark the second statement, the interface
ast (update-in ast
[:statements 1 :eastwood/defprotocol-expansion-interface]
(constantly defprotocol-var))
sigs (get-in ast [:statements 3])]
; (println (format "dbgz: Found what looks like a defprotocol expansion for protocol %s"
; defprotocol-var))
;; If the 4th statement, the signatures, is nil, mark that ast
;; node, too.
(if (nil? (:form sigs))
Expand Down Expand Up @@ -403,7 +347,7 @@ discarded inside null: null'."
;; caused by a comment or gen-class macro invocation.
(and (nil? (:form stmt))
(some #{'clojure.core/comment 'clojure.core/gen-class}
(map first (:eastwood/partly-resolved-forms stmt))))
(map #(and (seq? %) (first %)) (:eastwood/partly-resolved-forms ast) (:eastwood/partly-resolved-forms stmt))))
nil

:else
Expand Down
4 changes: 2 additions & 2 deletions src/eastwood/util.clj
View file
Expand Up @@ -394,8 +394,8 @@ replaced by one that is resolved, with a namespace."
;; (println "----------------------------------------")
(if (seq? form)
(let [[op & args] form
var (env/with-env env
(utils/resolve-var op (ana.jvm/empty-env)))
var (env/ensure env
(utils/resolve-var op (:env ast)))
;; _ (do
;; (println (format "dby: op=%s (class op)=%s var=%s (class var)=%s"
;; op (class op)
Expand Down

0 comments on commit 2509606

Please sign in to comment.