Skip to content
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
92 lines (85 sloc) 3.84 KB
;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (
;; which can be found in the file epl-v10.html at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
(:require [ :refer [arglist-for-arity protocol-node? source-info]]
:refer [specials prim-interface]]
[ :refer [validate]]))
(defn classify-invoke
"If the AST node is an :invoke, check the node in function position,
* if it is a keyword, transform the node in a :keyword-invoke node;
* if it is the clojure.core/instance? var and the first argument is a
literal class, transform the node in a :instance? node to be inlined by
the emitter
* if it is a protocol function var, transform the node in a :protocol-invoke
* if it is a regular function with primitive type hints that match a
clojure.lang.IFn$[primitive interface], transform the node in a :prim-invoke
{:pass-info {:walk :post :depends #{#'validate}}}
[{:keys [op args tag env form] :as ast}]
(if-not (= op :invoke)
(let [argc (count args)
the-fn (:fn ast)
op (:op the-fn)
var? (= :var op)
the-var (:var the-fn)]
(and (= :const op)
(= :keyword (:type the-fn)))
(if (<= 1 argc 2)
(if (and (not (namespace (:val the-fn)))
(= 1 argc))
(merge (dissoc ast :fn :args)
{:op :keyword-invoke
:target (first args)
:keyword the-fn
:children [:keyword :target]})
(throw (ex-info (str "Cannot invoke keyword with " argc " arguments")
(merge {:form form}
(source-info env)))))
(and (= 2 argc)
(= #'clojure.core/instance? the-var)
(= :const (:op (first args)))
(= :class (:type (first args))))
(merge (dissoc ast :fn :args)
{:op :instance?
:class (:val (first args))
:target (second args)
:form form
:env env
:o-tag Boolean/TYPE
:tag (or tag Boolean/TYPE)
:children [:target]})
(and var? (protocol-node? the-var (:meta the-fn)))
(if (>= argc 1)
(merge (dissoc ast :fn)
{:op :protocol-invoke
:protocol-fn the-fn
:target (first args)
:args (vec (rest args))
:children [:protocol-fn :target :args]})
(throw (ex-info "Cannot invoke protocol method with no args"
(merge {:form form}
(source-info env)))))
(let [arglist (arglist-for-arity the-fn argc)
arg-tags (mapv (comp specials str :tag meta) arglist)
ret-tag (-> arglist meta :tag str specials)
tags (conj arg-tags ret-tag)]
(if-let [prim-interface (prim-interface (mapv #(if (nil? %) Object %) tags))]
(merge ast
{:op :prim-invoke
:prim-interface prim-interface
:args (mapv (fn [arg tag] (assoc arg :tag tag)) args arg-tags)
:o-tag ret-tag
:tag (or tag ret-tag)})
You can’t perform that action at this time.