Skip to content

Commit

Permalink
CLJS-853: propagate read-time metadata on fn and reify forms at runtime
Browse files Browse the repository at this point in the history
  • Loading branch information
@Bronsa
Bronsa authored and dnolen committed Dec 2, 2014
1 parent 6b251ba commit d54defd
Show file tree
Hide file tree
Showing 2 changed files with 60 additions and 58 deletions.
112 changes: 57 additions & 55 deletions src/clj/cljs/analyzer.clj
View file
Expand Up @@ -719,67 +719,71 @@
{:env env :variadic variadic :params params :max-fixed-arity fixed-arity
:type type :form form :recurs @(:flag recur-frame) :expr expr}))

(declare analyze-wrap-meta)

(defmethod parse 'fn*
[op env [_ & args :as form] name _]
(let [[name meths] (if (symbol? (first args))
[(first args) (next args)]
[name (seq args)])
;;turn (fn [] ...) into (fn ([]...))
meths (if (vector? (first meths)) (list meths) meths)
locals (:locals env)
name-var (if name
(merge
(analyze-wrap-meta
(let [[name meths] (if (symbol? (first args))
[(first args) (next args)]
[name (seq args)])
;;turn (fn [] ...) into (fn ([]...))
meths (if (vector? (first meths)) (list meths) meths)
locals (:locals env)
name-var (if name
(merge
{:name name
:info {:shadow (or (locals name)
(get-in env [:js-globals name]))}}
(get-in env [:js-globals name]))}}
(when-let [tag (-> name meta :tag)]
{:ret-tag tag})))
locals (if (and locals name) (assoc locals name name-var) locals)
type (-> form meta ::type)
protocol-impl (-> form meta :protocol-impl)
protocol-inline (-> form meta :protocol-inline)
menv (if (> (count meths) 1) (assoc env :context :expr) env)
menv (merge menv
{:protocol-impl protocol-impl
:protocol-inline protocol-inline})
methods (map #(analyze-fn-method menv locals % type) meths)
max-fixed-arity (apply max (map :max-fixed-arity methods))
variadic (boolean (some :variadic methods))
locals (if name
(update-in locals [name] assoc
;; TODO: can we simplify? - David
:fn-var true
:variadic variadic
:max-fixed-arity max-fixed-arity
:method-params (map :params methods)
:methods methods)
locals)
methods (if name
;; a second pass with knowledge of our function-ness/arity
;; lets us optimize self calls
(no-warn (doall (map #(analyze-fn-method menv locals % type) meths)))
methods)]
(let [variadic-methods (filter :variadic methods)
variadic-params (count (:params (first variadic-methods)))
param-counts (map (comp count :params) methods)]
(when (< 1 (count variadic-methods))
(warning :multiple-variadic-overloads env {:name name-var}))
(when (not (or (zero? variadic-params) (= variadic-params (+ 1 max-fixed-arity))))
(warning :variadic-max-arity env {:name name-var}))
(when (not= (distinct param-counts) param-counts)
(warning :overload-arity env {:name name-var})))
{:env env :op :fn :form form :name name-var :methods methods :variadic variadic
:tag 'function
:recur-frames *recur-frames* :loop-lets *loop-lets*
:jsdoc [(when variadic "@param {...*} var_args")]
:max-fixed-arity max-fixed-arity
:protocol-impl protocol-impl
:protocol-inline protocol-inline
:children (mapv :expr methods)}))
{:ret-tag tag})))
locals (if (and locals name) (assoc locals name name-var) locals)
type (-> form meta ::type)
protocol-impl (-> form meta ::protocol-impl)
protocol-inline (-> form meta ::protocol-inline)
menv (if (> (count meths) 1) (assoc env :context :expr) env)
menv (merge menv
{:protocol-impl protocol-impl
:protocol-inline protocol-inline})
methods (map #(analyze-fn-method menv locals % type) meths)
max-fixed-arity (apply max (map :max-fixed-arity methods))
variadic (boolean (some :variadic methods))
locals (if name
(update-in locals [name] assoc
;; TODO: can we simplify? - David
:fn-var true
:variadic variadic
:max-fixed-arity max-fixed-arity
:method-params (map :params methods)
:methods methods)
locals)
methods (if name
;; a second pass with knowledge of our function-ness/arity
;; lets us optimize self calls
(no-warn (doall (map #(analyze-fn-method menv locals % type) meths)))
methods)
form (vary-meta form dissoc ::protocol-impl ::protocol-inline ::type)]
(let [variadic-methods (filter :variadic methods)
variadic-params (count (:params (first variadic-methods)))
param-counts (map (comp count :params) methods)]
(when (< 1 (count variadic-methods))
(warning :multiple-variadic-overloads env {:name name-var}))
(when (not (or (zero? variadic-params) (= variadic-params (+ 1 max-fixed-arity))))
(warning :variadic-max-arity env {:name name-var}))
(when (not= (distinct param-counts) param-counts)
(warning :overload-arity env {:name name-var})))
{:env env :op :fn :form form :name name-var :methods methods :variadic variadic
:tag 'function
:recur-frames *recur-frames* :loop-lets *loop-lets*
:jsdoc [(when variadic "@param {...*} var_args")]
:max-fixed-arity max-fixed-arity
:protocol-impl protocol-impl
:protocol-inline protocol-inline
:children (mapv :expr methods)})))

(defmethod parse 'letfn*
[op env [_ bindings & exprs :as form] name _]
(when-not (and (vector? bindings) (even? (count bindings)))
(when-not (and (vector? bindings) (even? (count bindings)))
(throw (error env "bindings must be vector of even number of elements")))
(let [n->fexpr (into {} (map (juxt first second) (partition 2 bindings)))
names (keys n->fexpr)
Expand Down Expand Up @@ -1485,8 +1489,6 @@
(parse-invoke env form)))
(analyze env mform name opts))))))))

(declare analyze-wrap-meta)

(defn analyze-map
[env form]
(let [expr-env (assoc env :context :expr)
Expand Down
6 changes: 3 additions & 3 deletions src/clj/cljs/core.clj
View file
Expand Up @@ -622,7 +622,7 @@
IMeta
(~'-meta [~this-sym] ~meta-sym)
~@impls))
(new ~t ~@locals nil))))
(new ~t ~@locals ~(meta &form)))))

(defmacro specify! [expr & impls]
(let [x (with-meta (gensym "x") {:extend :instance})]
Expand Down Expand Up @@ -855,8 +855,8 @@
(dt->et type specs fields false))
([type specs fields inline]
(let [annots {:cljs.analyzer/type type
:protocol-impl true
:protocol-inline inline}]
:cljs.analyzer/protocol-impl true
:cljs.analyzer/protocol-inline inline}]
(loop [ret [] specs specs]
(if (seq specs)
(let [p (first specs)
Expand Down

0 comments on commit d54defd

Please sign in to comment.