Commits

remleduff committed fae9de6

Another too-big refactoring

1) Combine expression-type and compute-type to some extent, and
precompute types to the extent possible
2) Remove :children nodes from the AST, add a children multimethod and
walk multimethod to allow the same sort of walking to work. The problem
was that ast-transformations would happen over and over with the
:children scheme, because a change in one part of the tree wouldn't
affect the "same node" in another part of the tree

Comments (0)

Files changed (4)

src/clojure/analyzer.clj

   "Given an environment, a map containing {:locals (mapping of names to bindings), :context
 (one of :statement, :expr, :return), :ns (a symbol naming the
 compilation ns)}, and form, returns an expression object (a map
-containing at least :form, :op and :env keys). If expr has any (immediately)
-nested exprs, must have :children [exprs...] entry. This will
-facilitate code walking without knowing the details of the op set."
+containing at least :form, :op and :env keys)."
   ([form] (analyze {:ns (@namespaces *ns*) :context :statement :locals {}} form nil))
   ([env form] (analyze env form nil))
   ([env form name]
        (set? form) (analyze-set env form name)
        :else {:op :constant :env env :form form}))))
 
+;; TODO: This could be children-keys that just returns the keys of the children, then walk would probably
+;             be simple to implement in terms of that
+(defmulti children :op)
+(defmulti walk (fn [form f] (:op form)))
+
+(defn- walk-coll [f]
+  (fn [coll]
+    (into (empty coll) (map f coll))))
+
 (defn analyze-file
   [f]
   (let [res (or (io/resource f) (io/as-url (io/as-file f)))]
     (let [enve (assoc env :context :expr )
           fexpr (analyze enve f)
           argexprs (vec (map #(analyze enve %) args))]
-      {:env env :op :invoke :f fexpr :args argexprs :children (conj argexprs fexpr)})))
+      {:env env :op :invoke :f fexpr :args argexprs})))
+
+(defmethod children :invoke
+  [{:keys [f args]}]
+  (conj args f))
+
+(defmethod walk :invoke
+  [form f]
+  (-> form
+    (update-in [:f] f)
+    (update-in [:args] (walk-coll f))))
 
 (defn analyze-symbol
   "Finds the var associated with sym"
       (assoc ret :op :var :info lb)
       (assoc ret :op :var :info (resolve-existing-var env sym)))))
 
+(defmethod children :var
+  [form]
+  nil)
+
+(defmethod walk :var [form f] form)
 
 (defn get-expander [sym env]
   (let [mvar
 (defn analyze-map
   [env form name]
   (let [expr-env (assoc env :context :expr )
-        simple-keys? (every? #(or (string? %) (keyword? %))
-      (keys form))
+        simple-keys? (every? #(or (string? %) (keyword? %)) (keys form))
         ks (disallowing-recur (vec (map #(analyze expr-env % name) (keys form))))
         vs (disallowing-recur (vec (map #(analyze expr-env % name) (vals form))))]
-    (analyze-wrap-meta {:op :map :env env :form form :children (vec (concat ks vs))
+    (analyze-wrap-meta {:op :map :env env :form form
                         :keys ks :vals vs :simple-keys? simple-keys?}
       name)))
 
+(defmethod children :map
+  [{:keys [keys vals]}]
+  (concat keys vals))
+
+(defmethod walk :map
+  [form f]
+  (-> form
+    (update-in [:keys] (walk-coll f))
+    (update-in [:vals] (walk-coll f))))
+
 (defn analyze-vector
   [env form name]
   (let [expr-env (assoc env :context :expr )
         items (disallowing-recur (vec (map #(analyze expr-env % name) form)))]
     (analyze-wrap-meta {:op :vector :env env :form form :children items} name)))
 
+(defmethod children :vector
+  [form]
+  (:children form))
+
+(defmethod walk :vector
+  [form f]
+  (update-in form [:children] (walk-coll f)))
+
 (defn analyze-wrap-meta [expr name]
   (let [form (:form expr)]
     (if (meta form)
       (let [env (:env expr) ; take on expr's context ourselves
             expr (assoc-in expr [:env :context ] :expr ) ; change expr to :expr
             meta-expr (analyze-map (:env expr) (meta form) name)]
-        {:op :meta :env env :form form :children [meta-expr expr]
+        {:op :meta :env env :form form
          :meta meta-expr :expr expr})
       expr)))
 
+(defmethod children :meta
+  [{:keys [meta-expr expr]}]
+  [meta-expr expr])
+
+(defmethod walk :meta
+  [form f]
+  (-> form
+    (update-in [:meta-expr] f)
+    (update-in [:meta] f)))
+
 (defmethod parse 'if
   [op env [_ test then else :as form] name]
   (let [test-expr (disallowing-recur (analyze (assoc env :context :expr) test))
         then-expr (analyze env then)
         else-expr (analyze env else)]
-    {:env env :op :if :form form
-     :test test-expr :then then-expr :else else-expr
-     :children [test-expr then-expr else-expr]}))
+    {:env env :op :if :form form :test test-expr :then then-expr :else else-expr}))
+
+(defmethod children :if
+  [{:keys [test then else]}]
+  [test then else])
+
+(defmethod walk :if
+  [form f]
+  (-> form
+    (update-in [:test] f)
+    (update-in [:then] f)
+    (update-in [:else] f)))
 
 (defmethod parse 'def
   [op env form name]
                               m))))
       (merge {:env env :op :def :form form
               :name name :doc doc :init init-expr}
-        (when init-expr {:children [init-expr]})
         (when export-as {:export export-as})))))
 
+(defmethod children :def
+  [{:keys [init]}]
+  (when init [init]))
+
+(defmethod walk :def
+  [form f]
+  (if-let [init (:init form)]
+    (assoc form :init (f init))
+    form))
+
 (defn analyze-block
-  "returns {:statements .. :ret .. :children ..}"
+  "returns {:statements .. :ret ..}"
   [env exprs]
   (let [statements (disallowing-recur
     (seq (map #(analyze (assoc env :context :statement ) %) (butlast exprs))))
         ret (if (<= (count exprs) 1)
       (analyze env (first exprs))
       (analyze (assoc env :context (if (= :statement (:context env)) :statement :return )) (last exprs)))]
-    {:statements statements :ret ret :children (vec (cons ret statements))}))
+    {:statements statements :ret ret}))
 
 (defn- analyze-fn-method [env locals meth]
   (letfn [(uniqify [[p & r]]
           locals (reduce (fn [m name] (assoc m name {:name name})) locals params)
           recur-frame {:names (vec params) :flag (atom nil)}
           block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
-        (analyze-block (assoc env :context :return :locals locals) body))]
+                  (analyze-block (assoc env :context :return :locals locals) body))]
 
       (merge {:env env :op :method :variadic variadic :params params
               :max-fixed-arity fixed-arity :recurs @(:flag recur-frame)} block))))
 
+(defmethod children :method
+  [{:keys [statements ret]}]
+  (cons ret statements))
+
+(defmethod walk :method
+  [form f]
+  (-> form
+    (update-in [:statements] (walk-coll f))
+    (update-in [:ret] f)))
+
 (defmethod parse 'fn*
   [op env [_ & args] name]
   (let [[name meths] (if (symbol? (first args))
     {:env env :op :fn :name name :methods methods :variadic variadic :recur-frames *recur-frames*
      :max-fixed-arity max-fixed-arity}))
 
+(defmethod children :fn
+  [{:keys [methods]}]
+  methods)
+
+(defmethod walk :fn
+  [form f]
+  (update-in form [:methods] (walk-coll f)))
+
 (defmethod parse 'do
   [op env [_ & exprs] _]
   (merge {:env env :op :do} (analyze-block env exprs)))
 
+(defmethod children :do
+  [{:keys [statements ret]}]
+  (cons ret statements))
+
+(defmethod walk :do
+  [form f]
+  (-> form
+    (update-in [:statements] (walk-coll f))
+    (update-in [:ret] f)))
+
 (defn analyze-let
   [encl-env [_ bindings & exprs :as form] is-loop]
   (assert (and (vector? bindings) (even? (count bindings))) "bindings must be vector of even number of elements")
               (do
                 (assert (not (or (namespace name) (.contains (str name) "."))) (str "Invalid local name: " name))
                 (let [init-expr (analyze env init)
-                      be {:name name :init init-expr}]
+                      be {:name name :op :binding :init init-expr}]
                   (recur (conj bes be)
                     (assoc-in env [:locals name] be)
                     (next bindings))))
               [bes env])))
         recur-frame (when is-loop {:names (vec (map :name bes)) :flag (atom nil)})
-        {:keys [statements ret children]}
+        {:keys [statements ret]}
         (binding [*recur-frames* (if recur-frame (cons recur-frame *recur-frames*) *recur-frames*)]
           (analyze-block (assoc env :context (if (= :expr context) :return context)) exprs))]
     {:env encl-env :op :let :loop is-loop
-     :bindings bes :statements statements :ret ret :form form :children (into [children] (map :init bes))}))
+     :bindings bes :statements statements :ret ret :form form}))
+
+(defmethod children :binding
+  [{:keys [init]}]
+  [init])
+
+(defmethod walk :binding
+  [form f]
+  (update-in form [:init] f))
+
+(defmethod children :let
+  [{:keys [bindings statements ret]}]
+  (-> ret (cons statements) (concat bindings)))
+
+(defmethod walk :let
+  [form f]
+  (-> form
+    (update-in [:bindings] (walk-coll f))
+    (update-in [:statements] (walk-coll f))
+    (update-in [:ret] f)))
 
 (defmethod parse 'let*
   [op encl-env form _]
       :frame frame
       :exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs))))))
 
+(defmethod children :recur
+  [{:keys [exprs]}]
+  exprs)
+
+(defmethod walk :recur
+  [form f]
+  (update-in form [:exprs] (walk-coll f)))
+
 (defmethod parse 'quote
   [_ env [_ x] _]
   {:op :constant :env env :form x})
 
+(defmethod children :constant
+  [form]
+  nil)
+
+(defmethod walk :constant
+  [form f]
+  form)
+
 (defmethod parse 'new
   [_ env [_ ctor & args] _]
   (disallowing-recur
     (let [enve (assoc env :context :expr)
           ctorexpr (analyze enve ctor)
           argexprs (vec (map #(analyze enve %) args))]
-      {:env env :op :new :ctor ctorexpr :args argexprs :children (conj argexprs ctorexpr)})))
+      {:env env :op :new :ctor ctorexpr :args argexprs})))
+
+(defmethod children :new
+  [{:keys [args ctor]}]
+  (conj args ctor))
+
+(defmethod walk :new
+  [form f]
+  (-> form
+    (update-in [:args] (walk-coll f))
+    (update-in [:ctor] f)))
 
 ;; dot accessor code
 
   (disallowing-recur
     (let [{:keys [dot-action target method field args]} (build-dot-form [target field member+])
           enve        (assoc env :context :expr)
-          targetexpr  (analyze enve target)
-          children    [enve]]
+          targetexpr  (analyze enve target)]
       (case dot-action
-        ::access {:env env :op :dot :children children
+        ::access {:env env :op :dot
                   :target targetexpr
                   :field field}
         ::call   (let [argexprs (map #(analyze enve %) args)]
-        {:env env :op :dot :children (into children argexprs)
+        {:env env :op :dot
          :target targetexpr
          :method method
          :args argexprs})))))
 
+(defmethod children :dot
+  [{:keys [target args]}]
+  (cons target args))
+
+(defmethod walk :dot
+  [form f]
+  (-> form
+    (update-in [:target] f)
+    (update-in [:args] (walk-coll f))))
+
 (defn analyze-method-impls
   [env meth]
   (let [name (or (first meth) (throw (Error. "Must specify a method to implement")))
                      (for [meth meths]
                        (assoc meth :class class))))]
     {:env env :op :reify :opts {} :methods methods :ancestors ancestors}))
+
+(defmethod children :reify
+  [{:keys [methods]}]
+  methods)
+
+(defmethod walk :reify
+  [form f]
+  (update-in form [:methods] (walk-coll f)))

src/clojure/java/ast.clj

+(ns clojure.java.ast
+  (:use [clojure
+          [analyzer :only [children walk resolve-var]]
+          [reflect :only [type-reflect]]
+          [set :only [select]]
+          pprint repl]) ; for debugging
+  (:import [clojure.lang RT Util]
+           [org.objectweb.asm Type]
+           [org.objectweb.asm.commons Method]))
+
+(defn- pprints [& args]
+  (binding [*print-level* 6] (apply pprint args)))
+
+(def ^:private prims
+  {"byte" Byte/TYPE "bool" Boolean/TYPE "char" Character/TYPE "int" Integer/TYPE "long" Long/TYPE "float" Float/TYPE "double" Double/TYPE "void" Void/TYPE})
+
+(defn array-for-class [class]
+  (RT/classForName (str "[L" (.getName class) ";")))
+
+(def ^:private array-classes
+  (let [types [java.lang.Object java.lang.Byte java.lang.Character java.lang.Integer]]
+    (zipmap types (map array-for-class types))))
+
+(defmulti maybe-class class)
+(defmethod maybe-class nil [_] nil)
+(defmethod maybe-class java.lang.Class [c] c)
+(defmethod maybe-class java.lang.String [s]
+  (if-let [ret (prims s)]
+    ret
+    (if-let [ret (maybe-class (symbol s))]
+      ret
+      (try
+        (RT/classForName s)
+        (catch Exception e nil)))))
+(defmethod maybe-class clojure.lang.Symbol [sym]
+  ; TODO: I have no idea what this used to do
+  ;    (if(Util.equals(sym,COMPILE_STUB_SYM.get()))
+  ;    return (Class) COMPILE_STUB_CLASS.get();
+  (when-not (namespace sym)
+    (if (.endsWith (name sym) "<>")
+      (let [str (name sym)
+            base-type (maybe-class (subs str 0 (- (count str) 2)))]
+        (array-classes base-type))
+      (if-let [ret (prims (name sym))]
+        ret
+        (let [ret (resolve sym)]
+          (when (class? ret)
+            ret))))))
+
+(defn dynamic? [v]
+  (or (:dynamic (meta v))
+      (when-let [var (cond
+                       (symbol? v) (resolve v)
+                       (var? v) v)]
+        (.isDynamic var))))
+
+(defn protocol-node? [ast]
+  (when-let [name (-> ast :f :info :name)]
+    (when-let [var (resolve name)]
+      (-> var meta :protocol))))
+
+(defn tagged-type [o]
+  (if-let [tag (-> o meta :tag)]
+    tag
+    java.lang.Object))
+
+(declare compute-type)
+
+(defn expression-type [form]
+  (if-let [type (:type form)]
+    type
+    (-> form compute-type :type)))
+
+(defmulti convertible? (fn [t1 t2] [(maybe-class t1) (maybe-class t2)]))
+
+(defmethod convertible? [java.lang.Object java.lang.Number] [t1 ts] true)
+(defmethod convertible? [java.lang.Object Integer/TYPE] [t1 ts] true)
+(defmethod convertible? [java.lang.Object Long/TYPE] [t1 ts] true)
+(defmethod convertible? [Long/TYPE java.lang.Object] [t1 ts] true)
+(defmethod convertible? [Long/TYPE Integer/TYPE] [t1 ts] true)
+
+(defmethod convertible? :default [t1 t2]
+  (if (= t1 t2) true (.isAssignableFrom t2 t1)))
+
+
+(defn match [name args pred]
+  (fn match-method [method]
+    (let [meth-parms (map maybe-class (:parameter-types method))]
+      (and (= name (:name method))
+           (= (count args) (count meth-parms))
+           (every? true? (map pred args meth-parms))))))
+
+;; ---
+
+(defn- rprintln [args]
+  (println "---" args "---")
+  args)
+
+(defn- node? [form] (:op form))
+
+;(defn- walk-node [f form]
+;  (letfn [(walk-child [child]
+;            (if (node? child) (f child) child))
+;          (walk-children [child]
+;            (cond
+;              (node? child) (f child)
+;
+;              (instance? clojure.lang.MapEntry child)
+;              (vec (map walk-children (seq child)))
+;
+;              (instance? clojure.lang.Seqable child)
+;              (into (empty child) (map walk-children (seq child)))
+;
+;              :else child))]
+;    (into {} (walk-children (seq form)))))
+
+(defn- walk-node [f form]
+  (walk form f))
+
+(defn- map-children [f form]
+  (map f (children form)))
+
+(defn ast-processor
+  [pres posts]
+  (let [pre  (apply comp pres)
+        post (apply comp posts)]
+    (fn this [form]
+      (when form
+        (let [form (pre form)
+              form (walk form this)]
+          (post form))))))
+
+(defmulti set-box :op)
+
+(defn boxed? [form]
+  (:box (set-box form)))
+
+(defmethod set-box :map
+  [form]
+  (walk-node #(assoc % :box true) (assoc form :box true)))
+
+(defmethod set-box :vector
+  [form]
+  (walk-node #(assoc % :box true) (assoc form :box true)))
+
+(defmethod set-box :def
+  [form]
+  (assoc-in form [:init :box] true))
+
+(defmethod set-box :invoke
+  [form]
+  (if-not (protocol-node? form)
+    (walk-node #(assoc % :box true) (assoc form :box true))
+    form))
+
+(defmethod set-box :do
+  [form]
+  (if (:box form)
+    (assoc-in form [:ret :box] true)
+    form))
+
+(defmethod set-box :binding
+  [form]
+  (if (:box form)
+    (assoc-in form [:init :box] true)
+    form))
+
+(defmethod set-box :let
+  [form]
+  ;; TODO: Smarter boxing for loops
+  (let [form (if (:loop form) (assoc form :box true) form)]
+    (if (:box form)
+      (assoc-in form [:ret :box] true)
+      form)))
+
+(defmethod set-box :if
+  [form]
+  ;; Always box the test, otherwise (if nil) can't work
+  (let [form (assoc-in form [:test :box] true)]
+    (if (or (:box form) (boxed? (:then form)) (boxed? (:else form)))
+      (-> form
+        (assoc-in [:then :box] true)
+        (assoc-in [:else :box] true))
+      form)))
+
+(defmethod set-box :fn
+  [form]
+  ;; TODO: this needs to check type hints, etc
+  (walk-node #(assoc % :box true) form))
+
+(defmethod set-box :reify
+  [form]
+  ;; TODO: this needs to check type hints, etc
+  (walk-node #(assoc % :box true) form))
+
+(defmethod set-box :method
+  [form]
+  (if (:box form)
+    (assoc-in form [:ret :box] true)
+    form))
+
+(defmethod set-box :dot
+  [form]
+  (assoc-in form [:target :box] true))
+
+(defmethod set-box :default
+  [form]
+  form)
+
+(defmulti exported (fn [attribute form] (:op form)))
+
+(defmethod exported :default
+  [attribute form]
+  (attribute form))
+
+(defmethod exported :fn [_ _] #{})
+(defmethod exported :reify [_ _] #{})
+
+(declare collect-vars)
+
+(defmethod exported :let
+  [attribute form]
+  (condp = attribute
+    ; lets shouldn't export their own locals as referenced, they still need to export any locals used in inits though
+    :referenced-locals
+    (let [bindings (:bindings form)
+;          inits (map :init bindings)
+          init-vars (map collect-vars bindings)
+          init-locals (mapcat :referenced-locals init-vars)
+          init-local-names (into #{} (map :name init-locals))
+          locals (into #{} (map :name bindings))
+          referenced-locals (:referenced-locals form)]
+        (remove #(and (contains? locals (:name %)) (not (contains? init-local-names (:name %)))) referenced-locals))
+
+    ;default
+    (attribute form)))
+
+(defn- collect-attribute
+  [form attribute]
+  (->> form
+    (map-children (partial exported attribute))
+    (reduce into #{})
+    (assoc form attribute)))
+
+(defn- collect
+  [form & attributes]
+  (reduce collect-attribute form attributes))
+
+(defmulti collect-constants :op)
+(defmethod collect-constants :default
+  [form]
+  (collect form :constants))
+
+(defmethod collect-constants :constant
+  [form]
+  (assoc form :constants #{{:value (:form form) :type (:type form)}}))
+
+
+(defmulti collect-callsites :op)
+(defmethod collect-callsites :default
+  [form]
+  (collect form :callsites))
+
+(defmethod collect-callsites :invoke
+  [form]
+  (let [s (-> form :f :info :name)]
+    (if (protocol-node? form)
+      (assoc form :callsites #{s})
+      form)))
+
+
+(defmulti collect-vars :op)
+(defmethod collect-vars :default
+  [form]
+  (collect form :vars :referenced-locals))
+
+(defmethod collect-vars :var
+  [{:as form :keys [info env]}]
+  (let [v (:name info)]
+    (if-not (-> env :locals v)
+      (assoc form :vars #{v})
+      (assoc form :referenced-locals #{{:name (-> form :info :name) :type (:type form)}}))))
+
+(defmethod collect-vars :def
+  [form]
+  (assoc form :vars #{(:name form)}))
+
+(defmulti transform :op)
+(defmethod transform :default [form] form)
+(defmethod transform :var
+  [{:as form :keys [info env]}]
+  (let [sym (:name info)
+        v (resolve-var env sym)
+        o (resolve sym)]
+    (when-not (:name v)
+      (throw (Util/runtimeException (str "No such var: " sym))))
+    (cond
+      ;; Transform vars that represent classes into constants
+      (instance? java.lang.Class o)
+      (assoc form :op :constant :form o :type java.lang.Class)
+      :else
+      form)))
+
+(defmulti compute-type :op)
+(defmethod compute-type nil [form] form)
+;(defmethod compute-type :default [form] form)
+
+(defmethod compute-type :def
+  [form]
+  (assoc form :type clojure.lang.Var))
+
+(defmethod compute-type :vector [form] (assoc form :type clojure.lang.IPersistentVector))
+(defmethod compute-type :map [form] (assoc form :type clojure.lang.IPersistentMap))
+
+(defmethod compute-type :constant
+  [{:as form :keys [box]}]
+  (let [class (class (:form form))
+        type (condp #(isa? %2 %1) class
+               java.lang.Integer (if box java.lang.Long Long/TYPE)
+               java.lang.Long (if box java.lang.Long Long/TYPE)
+               java.lang.Float (if box java.lang.Double Double/TYPE)
+               java.lang.Double (if box java.lang.Double Double/TYPE)
+               java.lang.String java.lang.String
+               java.lang.Class java.lang.Class
+               clojure.lang.Keyword clojure.lang.Keyword
+               clojure.lang.Symbol clojure.lang.Symbol
+               clojure.lang.IPersistentMap clojure.lang.IPersistentMap
+               clojure.lang.IPersistentVector clojure.lang.IPersistentVector
+               java.lang.Object)]
+  (assoc form :type type)))
+
+(defn- compute-local-type
+  [info]
+  (if-let [init (:init info)]
+    (expression-type init)
+    java.lang.Object))
+
+(defmethod compute-type :var
+  [{:as form :keys [info env]}]
+  ;; TODO: Check :tag
+  (let [sym (:name info)
+        lb (-> env :locals sym)
+        var (resolve sym)
+        type (if var (class @var))]
+    (if lb
+      (assoc form :type (compute-local-type info))
+      (assoc form :type type)))) ;; TODO: Fail here if var doesn't resolve?
+
+(defmethod compute-type :fn
+  [form]
+  (assoc form :type clojure.lang.IFn))
+
+(defmethod compute-type :invoke
+  [form]
+  ; Symbol meta have a :tag?
+  ; Var have a :tag?
+  ; Find the correct overload in arglists, does it have a tag? )
+  (let [tag (-> form :f :info :name resolve meta :tag)]
+    (assoc form :type tag)
+    (assoc form :type java.lang.Object)))
+
+(defn compute-host-method
+  [env class name args]
+  (let [members (-> class type-reflect :members)
+        matches (select (match name args convertible?) members)]
+    (if (= (count matches) 1)
+      (first matches)
+      (let [matches (select (match name args =) matches)]
+        (if (= (count matches) 1)
+              (first matches))))))
+
+(defn compute-host-field
+  [env class field]
+  (let [members (-> class (type-reflect :ancestors true) :members)
+        matches (select #(= (:name %) field) members)]
+    (if (= (count matches) 1)
+      (first matches)
+      (when *warn-on-reflection*
+        (.format (RT/errPrintWriter)
+          "Reflection warning, %s:%d - reference to field %s can't be resolved.\n"
+          (into-array Object [*file* (:line env) (name field)]))
+        nil))))
+
+(defmethod compute-type :method
+  [{:as form :keys [env class name params]}]
+  (if-let [class (maybe-class class)]
+    (let [host-method (compute-host-method env class name (map tagged-type params))]
+      (assoc form :host-method host-method :type (maybe-class (:return-type host-method))))
+    form))
+
+;(defn- )
+;meth (find-best-method class name args
+;                             (apply str "No single method: " name " of class: " class " found with args: " (map :type args)))
+;{:keys [name return-type parameter-types]} meth
+;m (apply asm-method name return-type parameter-types)
+;return-type (maybe-class return-type)
+;parameter-types (map maybe-class parameter-types)
+
+(defmethod compute-type :dot
+  [{:as form :keys [target field method args env box]}]
+  (if-let [class (expression-type target)]
+    (if field
+      (let [host-field (compute-host-field env class field)
+            type (-> host-field :type maybe-class)]
+        (assoc form :host-field host-field :type type))
+      (let [host-method (compute-host-method env class method (map expression-type args))
+            type (-> host-method :return-type maybe-class)]
+        (assoc form :host-method host-method :type type)))
+    form))
+
+(defmethod compute-type :reify
+  [{:as form :keys [name]}]
+  (let [name (if name name (gensym "reify__"))]
+    (assoc form :name name :class (resolve name))))
+
+(defmethod compute-type :new
+  [{:as form :keys [ctor]}]
+  (assoc form :type (-> ctor :info :name resolve)))
+
+(defmethod compute-type :do
+  [{:as form :keys [ret]}]
+  (assoc form :type (expression-type ret)))
+
+(defmethod compute-type :binding
+  [{:as form :keys [init]}]
+  (assoc form :type (expression-type init)))
+
+(defmethod compute-type :let
+  [{:as form :keys [ret]}]
+  (assoc form :type (expression-type ret)))
+
+(defmethod compute-type :recur
+  [form]
+  form)
+
+(defmethod compute-type :if
+  [{:as form :keys [then else]}]
+  (let [then-type (expression-type then)
+        else-type (expression-type else)
+        type (if (= then-type else-type)
+               then-type
+               (cond
+                 (nil? then-type) else-type
+                 (nil? else-type) then-type
+                 (convertible? else-type then-type) then-type
+                 (convertible? then-type else-type) else-type
+                 :else nil))]
+    (assoc form :type type)))
+
+(def process-frames (ast-processor [set-box]
+                      [collect-constants collect-vars collect-callsites compute-type transform]))

src/clojure/java/compiler.clj

 (ns clojure.java.compiler
   (:refer-clojure :exclude [eval load munge *ns* type])
   (:require [clojure.java.io :as io]
-            [clojure.string :as string])
+            [clojure.string :as string]
+            [clojure.java.ast :as ast])
+  (:refer clojure.java.ast :only [convertible? dynamic? expression-type maybe-class tagged-type])
   (:use [clojure
           [analyzer :only [analyze namespaces *ns*]]
           [walk :only [walk]]
           [reflect :only [type-reflect]]
           [set :only [select]]
-          pprint repl]) ; pprint is for debugging
+          pprint repl]) ; for debugging
   (:import [org.objectweb.asm Type Opcodes ClassReader ClassWriter]
            [org.objectweb.asm.commons Method GeneratorAdapter]
            [org.objectweb.asm.util CheckClassAdapter TraceClassVisitor]
            [clojure.lang DynamicClassLoader RT Util]))
 
-;; TODO: It feels like expression-type shouldn't be called in this file, is it a performance problem?
-;;  if it is being called too much, it would be easy
-;; to make compute-type in analysis.clj add a :type key to everything. expression-type would then be able to short-circuit
-;; if there is already a :type
-
-(clojure.core/load "compiler/analysis")
-
 (def max-positional-arity 20)
 
 (def ^:private char-map
 (defmacro notsup [& args]
   `(throw (RuntimeException. (str "Unsupported: " ~@args))))
 
+(defn- primitive? [o]
+  (let [c (maybe-class o)]
+    (and
+      (not (or (nil? c) (= c Void/TYPE)))
+      (.isPrimitive c))))
+
+(defn- asm-type [s]
+  (when s
+    (let [class (maybe-class s)]
+      (if class
+        (Type/getType class)
+        (Type/getType s)))))
+
+(defn- asm-method
+  ([{:keys [name return-types parameter-types]}]
+   (apply asm-method name return-types parameter-types))
+  ([name return-type & args]
+   (Method. (str name) (asm-type return-type) (into-array Type (map asm-type args)))))
 
 ; Frame members (maybe these should be separate variables?):
 ; :class - ASM type of current class being written
          (eval ret))
        (let [env {:ns (@namespaces *ns*) :context :statement :locals {}}
              ast (analyze env form)
-             ast (process-frames (assoc ast :box true))
+             ast (ast/process-frames (assoc ast :box true))
              internal-name (str "repl/Temp" (RT/nextID))
              cw (emit-class internal-name (assoc ast :super "clojure/lang/AFn") emit-wrapper-fn)]
          (let [bytecode (.toByteArray cw)
         (.visitLineNumber *gen* line (.mark *gen*)))
       (doseq [{:keys [name type value]} (vals statics)]
         (emit-value type value)
-;        (.checkCast *gen* (:type static))
         (.putStatic *gen* class name (asm-type type)))
       (.returnValue *gen*)
       (.endMethod *gen*))))
     (.checkCast *gen* (asm-type t))))
 
 (defmulti emit-convert (fn [actual-type desired-type] [actual-type desired-type]))
+(defmethod emit-convert [java.lang.Object Integer/TYPE]
+  [actual-type desired-type]
+  (emit-cast desired-type))
 (defmethod emit-convert [java.lang.Object Long/TYPE]
   [actual-type desired-type]
   (emit-cast desired-type))
   [actual-type desired-type]
   (when-not (= actual-type desired-type) (println "Conversion not implemented" [actual-type desired-type])))
 
-(defn- emit-typed-arg [param-type arg]
+(defn- emit-typed-arg [param-type {:as arg arg-type :type}]
+  (assert arg-type (str "Missing type for arg " arg))
   (emit arg)
   (cond
-    (= param-type (expression-type arg))
+    (= param-type arg-type)
     nil
 
-    (convertible? (expression-type arg) param-type)
-    (emit-convert (expression-type arg) param-type)
+    (convertible? arg-type param-type)
+    (emit-convert arg-type param-type)
 
     :else
     (emit-cast param-type)))
   (.box *gen* (asm-type type)))
 
 (defn- find-method [class filter error-msg]
-  (let [members (-> class type-reflect :members)
+  (let [members (-> class (type-reflect :ancestors true) :members)
         methods (select filter members)
         _ (when-not (= (count methods) 1)
             (throw (IllegalArgumentException. error-msg)))]
     (first methods)))
 
+#_(defn- find-best-method [class name args error-msg]
+  (let [members (-> class (type-reflect :ancestors true) :members)
+        methods (select (match name args convertible?) members)
+        arg-classes (map :type args)]
+    (if (= (count methods) 1)
+      (first methods)
+      (let [exacts (into []
+                     (for [meth methods]
+                       [(count (filter true? (map = (map maybe-class (:parameter-types meth)) arg-classes))) meth]))
+            exacts (reverse (sort-by first exacts))
+            [arank a] (first exacts)
+            [brank b] (fnext exacts)]
+        (if-not (= arank brank)
+          a
+          (throw (Exception. error-msg)))))))
+
+
 (defn- emit-invoke-proto [{:keys [f args box]}]
   (let [{:keys [class statics protos]} @*frame*
         on-label (.newLabel *gen*)
                         " found for function: " fsym " of protocol: " (-> fvar meta :protocol)
                         " (The protocol method may have been defined before and removed.)"))))
             meth-name (-> key name munge)
-            meth (find-method protocol-on (match meth-name (rest args))
-                                          (str "No single method: " meth-name " of class: " protocol-on " found with args: " args))]
+            arg-types (map expression-type (rest args))
+            meth (find-method protocol-on (ast/match meth-name arg-types convertible?)
+                                          (apply str "No single method: " meth-name " of class: " protocol-on
+                                                                    " found with args: " arg-types))]
         (emit-typed-args (:parameter-types meth) (rest args))
         (when (= (-> f :info :env :context ) :return )
           ; emit-clear-locals
 
 (defmethod emit :invoke [ast]
   (.visitLineNumber *gen* (-> ast :env :line ) (.mark *gen*))
-  (if (protocol-node? ast)
+  (if (ast/protocol-node? ast)
     (emit-invoke-proto ast)
     (emit-invoke-fn ast)))
 
   (.dup *gen*)
   (doseq [arg args]
     (emit arg))
-  (.invokeConstructor *gen* type (apply asm-method "<init>" "void" (map expression-type args))))
+  (.invokeConstructor *gen* type (apply asm-method "<init>" "void" (map :type args))))
 
 (defmethod emit :new
   [{:keys [ctor args env]}]
         index (:index lb)]
     (.visitVarInsn *gen* opcode index)))
 
-(defmethod emit :local [{:as form :keys [info box]}]
-  (let [v (:name info)]
-    (emit-local v))
-  (when box (emit-box (expression-type form))))
+(defn- emit-var [v]
+  (let [{:keys [class statics]} @*frame*]
+    (.getStatic *gen* class (:name (statics v)) var-type)
+    (.invokeVirtual *gen* var-type (if (dynamic? v) var-get-method var-get-raw-method))))
 
-(defmethod emit :var [{:keys [info type box]}]
+(defmethod emit :var [{:as form :keys [env info box]}]
   (let [v (:name info)
-        {:keys [class statics]} @*frame*]
-    (.getStatic *gen* class (:name (statics v)) var-type)
-    (.invokeVirtual *gen* var-type (if (dynamic? v) var-get-method var-get-raw-method)))
-  (when box (emit-box type)))
+        lb (-> env :locals v)]
+    (if lb
+      (emit-local v)
+      (emit-var v)))
+  (when box (emit-box (expression-type form))))
 
 (defmulti emit-test (fn [ast null-label false-label] (:op ast)))
 
   (.goTo *gen* (:loop-label @*frame*)))
 
 (defn- emit-field
-  [env target field box]
-  (let [class (expression-type target)
-        members (-> class type-reflect :members)
-        field-info (select #(= (:name %) field) members)
-        type (:type field-info)]
-    (if type
-      (do
-        (.getField *gen* (asm-type class) field (asm-type type))
-        (when box (emit-box type)))
-      (do
-        (when *warn-on-reflection*
-          (.format (RT/errPrintWriter)
-            "Reflection warning, %s:%d - reference to field %s can't be resolved.\n"
-          *file* (make-array (-> target :env :line) field)))
-        (.push *gen* (name field))
-        (.invokeStatic *gen* (asm-type clojure.lang.Reflector)
-                             (Method/getMethod "Object invokeNoArgInstanceMember(Object,String)"))))))
-
-(defn- emit-method-call [target name args box]
-  (let [class (:type target)
-        meth (find-method class (match name args)
-                                (apply str "No single method: " name " of class: " class " found with args: " (map expression-type args)))
-        {:keys [name return-type parameter-types]} meth
-        m (apply asm-method name return-type parameter-types)
-        return-type (maybe-class return-type)
-        parameter-types (map maybe-class parameter-types)]
-    (.checkCast *gen* (asm-type class))
-    (emit-typed-args parameter-types args)
-    (.invokeVirtual *gen* (asm-type class) m)
-    (when box (emit-box return-type))))
+  [env target field host-field box]
+  (if-let [host-field (or host-field (ast/compute-host-field env (expression-type target) field))]
+    (let [class (-> target expression-type asm-type)
+          {:keys [name type]} host-field]
+      (.checkCast *gen* class)
+      (.getField *gen* class (clojure.core/name name) (asm-type type))
+      (when box (emit-box type)))
+    (do
+      (.push *gen* (name field))
+      (.invokeStatic *gen* (asm-type clojure.lang.Reflector)
+                           (Method/getMethod "Object invokeNoArgInstanceMember(Object,String)")))))
+
+(defn- emit-method-call [env target method args host-method box]
+  (if-let [host-method (or host-method (ast/compute-host-method env (expression-type target) method (map expression-type args)))]
+    (let [class (asm-type (expression-type target))
+          {:keys [name parameter-types return-type declaring-class]} host-method
+          meth (apply asm-method name return-type (map maybe-class parameter-types))
+          declaring-class (maybe-class declaring-class)]
+      (.checkCast *gen* class)
+      (emit-typed-args (map maybe-class parameter-types) args)
+      (if (.isInterface declaring-class)
+        (.invokeInterface *gen* class meth)
+        (.invokeVirtual *gen* class meth))
+      (when box (emit-box (maybe-class return-type))))
+    (do
+      (when *warn-on-reflection*
+        (.format (RT/errPrintWriter)
+          "Reflection warning, %s:%d - call to %s can't be resolved.\n"
+          (into-array Object [*file* (:line env) (str method)])))
+      (.push *gen* (name method))
+      (emit-as-array (map #(assoc % :box true) args))
+      (.invokeStatic *gen* (asm-type clojure.lang.Reflector)
+                           (Method/getMethod "Object invokeInstanceMethod(Object,String,Object[])")))))
 
 (defmethod emit :dot
-  [{:keys [target field method args env box]}]
+  [{:as form :keys [target field method host-field host-method args env box]}]
   (emit target)
   (if field
-    (emit-field env target field box)
-    (emit-method-call target method args box)))
+    (emit-field env target field host-field box)
+    (emit-method-call env target method args host-method box)))
 
 (defn- emit-fns
   [cv {:as ast :keys [name type fns]}]
     (emit-fn-methods cv fn)))
 
 (defmethod emit :reify
-  [{:as ast :keys [methods ancestors]}]
-  (let [name (str (gensym "reify__"))
-        c (-> ancestors first maybe-class)
+  [{:as ast :keys [name ancestors]}]
+  (let [c (-> ancestors first maybe-class)
         [super interfaces] (if (and c (.isInterface c))
-                             [java.lang.Object ancestors]
-                             [(first ancestors) (rest ancestors)])
+          [java.lang.Object ancestors]
+          [(first ancestors) (rest ancestors)])
         ast (assoc ast :super super :interfaces interfaces)
-        cw (emit-class name ast emit-fn-methods)
+        cw (emit-class (str name) ast emit-fn-methods)
         bytecode (.toByteArray cw)
-        class (load-class name bytecode ast)
-        type (asm-type class)]
-    (emit-closure type (closed-overs ast))))
+        class (load-class (str name) bytecode ast)]
+    (emit-closure (asm-type class) (closed-overs ast))))
 
 (defmethod emit :vector [args]
   (emit-as-array (:children args))

src/clojure/java/compiler/analysis.clj

-(in-ns 'clojure.java.compiler)
-
-(defn- pprints [& args]
-  (binding [*print-level* 6] (apply pprint args)))
-
-(def ^:private prims
-  {"byte" Byte/TYPE "bool" Boolean/TYPE "char" Character/TYPE "int" Integer/TYPE "long" Long/TYPE "float" Float/TYPE "double" Double/TYPE "void" Void/TYPE})
-
-(defmulti maybe-class class)
-(defmethod maybe-class java.lang.Class [c] c)
-(defmethod maybe-class java.lang.String [s]
-  (if-let [ret (prims s)]
-    ret
-    (if-let [ret (maybe-class (symbol s))]
-      ret
-      (try
-        (RT/classForName s)
-        (catch Exception e nil)))))
-(defmethod maybe-class clojure.lang.Symbol [sym]
-  ; TODO: I have no idea what this used to do
-  ;    (if(Util.equals(sym,COMPILE_STUB_SYM.get()))
-  ;    return (Class) COMPILE_STUB_CLASS.get();
-  (when-not (namespace sym)
-    (if-let [ret (prims (name sym))]
-      ret
-      (let [ret (resolve sym)]
-        (when (class? ret)
-          ret)))))
-
-(defn- primitive? [o]
-  (let [c (maybe-class o)]
-    (and
-      (not (or (nil? c) (= c Void/TYPE)))
-      (.isPrimitive c))))
-
-(defn- asm-type [s]
-  (when s
-    (let [class (maybe-class s)]
-      (if class
-        (Type/getType class)
-        (Type/getType s)))))
-
-(defn- asm-method
-  ([{:keys [name return-types parameter-types]}]
-    (apply asm-method name return-types parameter-types))
-  ([name return-type & args]
-    (Method. (str name) (asm-type return-type) (into-array Type (map asm-type args)))))
-
-(defn dynamic? [v]
-  (or (:dynamic (meta v))
-      (when-let [var (cond
-                       (symbol? v) (resolve v)
-                       (var? v) v)]
-        (.isDynamic var))))
-
-(defn protocol-node? [ast]
-  (when-let [name (-> ast :f :info :name)]
-    (when-let [var (resolve name)]
-      (-> var meta :protocol))))
-
-(defmulti expression-type
-  "Returns the type of the ast node provided, or Object if unknown. Respects :tag metadata"
-  :op)
-
-(defn tagged-type [o]
-  (if-let [tag (-> o meta :tag)]
-    tag
-    java.lang.Object))
-
-(defmethod expression-type :default [{type :type}]
-  (if type type java.lang.Object))
-
-(defmethod expression-type :constant [ast]
-  [ast]
-  (let [class (-> ast :form class)
-        boxed (:box ast)]
-    (condp #(isa? %2 %1) class
-             java.lang.Integer (if boxed Long Long/TYPE)
-             java.lang.Long (if boxed Long Long/TYPE)
-             java.lang.Float (if boxed Double Double/TYPE)
-             java.lang.Double (if boxed Double Double/TYPE)
-             java.lang.String java.lang.String
-             java.lang.Class java.lang.Class
-             clojure.lang.Keyword clojure.lang.Keyword
-             clojure.lang.Symbol clojure.lang.Symbol
-             clojure.lang.IPersistentMap clojure.lang.IPersistentMap
-             clojure.lang.IPersistentVector clojure.lang.IPersistentVector
-             nil nil
-             java.lang.Object)))
-
-(defmethod expression-type :local [{:keys [info]}]
-  (expression-type (:init info)))
-
-(defmethod expression-type :def [form]
-  clojure.lang.Var)
-
-(defmethod expression-type :var
-  [{:as form :keys [info]}]
-  (let [sym (:name info)
-        var (resolve sym)]
-    (if var
-      (class @var)
-      java.lang.Object)))
-
-(defmethod expression-type :do
-  [{:keys [ret]}]
-  (expression-type ret))
-
-(defmethod expression-type :let
-  [{:keys [ret]}]
-  (expression-type ret))
-
-(defmethod expression-type :if
-  [{:keys [then else]}]
-  (let [then-type (expression-type then)
-        else-type (expression-type else)]
-    (if (= then-type else-type)
-      then-type
-      (cond
-        (nil? then-type) else-type
-        (nil? else-type) then-type
-        :else java.lang.Object))))
-
-(defmethod expression-type :recur
-  [form]
-  nil)
-
-(defmulti convertible? (fn [t1 t2] [(maybe-class t1) (maybe-class t2)]))
-
-(defmethod convertible? [java.lang.Object java.lang.Number] [t1 ts] true)
-(defmethod convertible? [java.lang.Object Long/TYPE] [t1 ts] true)
-(defmethod convertible? :default [t1 t2]
-  (if (= t1 t2) true (println "Conversion not implemented: " [t1 t2])))
-
-
-(defn- match [name args]
-  (fn match-method [method]
-    (let [arg-classes (map expression-type args)
-          meth-parms (map maybe-class (:parameter-types method))]
-      (and (= name (:name method))
-           (= (count args) (-> method :parameter-types count))
-           (every? true? (map convertible? arg-classes meth-parms))))))
-
-;; ---
-
-(defn- rprintln [args]
-  (println "---" args "---")
-  args)
-
-(defn- node? [form] (:op form))
-
-(defn- walk-node [f form]
-  (letfn [(walk-child [child]
-            (if (node? child) (f child) child))
-          (walk-children [child]
-            (cond
-              (node? child) (f child)
-
-              (instance? clojure.lang.MapEntry child)
-              (vec (map walk-children (seq child)))
-
-              (instance? clojure.lang.Seqable child)
-              (into (empty child) (map walk-children (seq child)))
-
-              :else child))]
-    (into {} (walk-children (seq form)))))
-
-
-(defn- map-children [f form]
-  (let [walk-children
-          (fn [child]
-            (if-let [s (and (sequential? child) (seq child))]
-              (into [] (map f s))
-              [(f child)]))]
-    (reduce into [] (map walk-children (vals form)))))
-
-(defn ast-processor
-  [pres posts]
-  (let [pre  (apply comp pres)
-        post (apply comp posts)]
-    (fn this [form]
-             (let [form (pre form)
-                   form (walk-node this form)]
-               (post form)))))
-
-(defmulti set-box :op)
-
-(defn boxed? [form]
-  (:box (set-box form)))
-
-(defmethod set-box :map
-  [form]
-  (walk-node #(assoc % :box true) (assoc form :box true)))
-
-(defmethod set-box :vector
-  [form]
-  (walk-node #(assoc % :box true) (assoc form :box true)))
-
-(defmethod set-box :def
-  [form]
-  (assoc-in form [:init :box] true))
-
-(defmethod set-box :invoke
-  [form]
-  (if-not (protocol-node? form)
-    (walk-node #(assoc % :box true) (assoc form :box true))
-    form))
-
-(defmethod set-box :do
-  [form]
-  (if (:box form)
-    (assoc-in form [:ret :box] true)
-    form))
-
-(defmethod set-box :let
-  [form]
-  ;; TODO: Smarter boxing for loops
-  (let [form (if (:loop form) (assoc form :box true) form)]
-    (if (:box form)
-      (assoc-in form [:ret :box] true)
-      form)))
-
-(defmethod set-box :if
-  [form]
-  ;; Always box the test, otherwise (if nil) can't work
-  (let [form (assoc-in form [:test :box] true)]
-    (if (or (:box form) (boxed? (:then form)) (boxed? (:else form)))
-      (-> form
-        (assoc-in [:then :box] true)
-        (assoc-in [:else :box] true))
-      form)))
-
-(defmethod set-box :fn
-  [form]
-  ;; TODO: this needs to check type hints, etc
-  (walk-node #(assoc % :box true) form))
-
-(defmethod set-box :reify
-  [form]
-  ;; TODO: this needs to check type hints, etc
-  (walk-node #(assoc % :box true) form))
-
-(defmethod set-box :method
-  [form]
-  (if (:box form)
-    (assoc-in form [:ret :box] true)
-    form))
-
-(defmethod set-box :dot
-  [form]
-  (assoc-in form [:target :box] true))
-
-(defmethod set-box :default
-  [form]
-  form)
-
-(defmulti exported (fn [attribute form] (:op form)))
-
-(defmethod exported :default
-  [attribute form]
-  (attribute form))
-
-(defmethod exported :fn [_ _] #{})
-(defmethod exported :reify [_ _] #{})
-
-(declare collect-vars)
-
-(defmethod exported :let
-  [attribute form]
-  (condp = attribute
-    ; lets shouldn't export their own locals as referenced, they still need to export any locals used in inits though
-    :referenced-locals
-    (let [bindings (:bindings form)
-          inits (map :init bindings)
-          init-vars (map collect-vars inits)
-          init-locals (mapcat :referenced-locals init-vars)
-          init-local-names (into #{} (map :name init-locals))
-          locals (into #{} (map :name bindings))
-          referenced-locals (:referenced-locals form)]
-        (remove #(and (contains? locals (:name %)) (not (contains? init-local-names (:name %)))) referenced-locals))
-
-    ;default
-    (attribute form)))
-
-(defn- collect-attribute
-  [form attribute]
-  (->> form
-    (map-children (partial exported attribute))
-    (reduce into #{})
-    (assoc form attribute)))
-
-(defn- collect
-  [form & attributes]
-  (reduce collect-attribute form attributes))
-
-(defmulti collect-constants :op)
-(defmethod collect-constants :default
-  [form]
-  (collect form :constants))
-
-(defmethod collect-constants :constant
-  [form]
-  (assoc form :constants #{{:value (:form form) :type (expression-type form)}}))
-
-
-(defmulti collect-callsites :op)
-(defmethod collect-callsites :default
-  [form]
-  (collect form :callsites))
-
-(defmethod collect-callsites :invoke
-  [form]
-  (let [s (-> form :f :info :name)]
-    (if (protocol-node? form)
-      (assoc form :callsites #{s})
-      form)))
-
-
-(defmulti collect-vars :op)
-(defmethod collect-vars :default
-  [form]
-  (collect form :vars :referenced-locals))
-
-(defmethod collect-vars :var
-  [{:as form :keys [info env]}]
-  (let [sym (:name info)
-        lb (-> env :locals sym)
-        v (clojure.analyzer/resolve-var env sym)
-        o (resolve sym)]
-    (when-not (:name v)
-      (throw (Util/runtimeException (str "No such var: " sym))))
-    (cond
-      ;; Transform vars that represent classes into constants
-      (instance? java.lang.Class o)
-      (assoc form :op :constant :form o)
-      ;; Transform vars into a new :local op, and track references to them so we know what to capture when we create closures
-      lb
-      (let [form (assoc form :op :local)]
-        (assoc form :referenced-locals #{{:name sym :type (expression-type form)}}))
-      :else
-      (assoc form :vars #{sym}))))
-
-(defmethod collect-vars :local
-  [form]
-  (assoc form :referenced-locals #{{:name (-> form :info :name) :type (expression-type form)}}))
-
-(defmethod collect-vars :def
-  [form]
-  (assoc form :vars #{(:name form)}))
-
-(defmulti compute-type :op)
-(defmethod compute-type :default [form] form)
-
-(defn- compute-host-method
-  [class meth]
-  (let [t (-> class type-reflect :members)
-        matches (select (match (:name meth) (:params meth)) t)
-        _ (when-not (= (count matches) 1)
-            (throw (IllegalArgumentException.
-              (str "No single method: " (:name meth) " of " class " found with arguments: " (:params meth)))))]
-    (first matches)))
-
-(defmethod compute-type :constant
-  [form]
-  (assoc form :type (expression-type form)))
-
-(defmethod compute-type :var
-  [form]
-  (assoc form :type (expression-type form)))
-
-(defmethod compute-type :local
-  [form]
-  (assoc form :type (expression-type form)))
-
-(defmethod compute-type :method
-  [form]
-  (if (:class form)
-    (let [class (maybe-class (:class form))
-          host-method (compute-host-method class form)]
-      (assoc form :host-method host-method :type (maybe-class (:return-type host-method))))
-    form))
-
-(defmethod compute-type :new
-  [{:as form :keys [ctor]}]
-  (assoc form :type (-> ctor :info :name resolve)))
-
-;(defmethod compute-type :fn
-  ; Symbol meta have a :tag?
-  ; Var have a :tag?
-  ; Find the correct overload in arglists, does it have a tag? )
-
-(def process-frames (ast-processor [set-box]
-                      [compute-type collect-constants collect-vars collect-callsites]))