Permalink
Browse files

Merge branch 'master' into optimize-variadic-merge

Conflicts:
	src/cljs/cljs/core.cljs

* devnotes/corelib.org: merged
  • Loading branch information...
2 parents c895d90 + 8159def commit e5c3a41831520784259392479a387ce89f3b77d1 David Nolen committed May 6, 2012
@@ -462,7 +462,7 @@ ticket #8
* DONE reverse
* DONE reversible?
* DONE rseq
-* TODO rsubseq
+* DONE rsubseq
* DONE satisfies?
as macro
* DONE second
@@ -60,7 +60,7 @@
(events/listen
img events/EventType.MOUSEOVER
(fn [event]
- (hide-tooltip)
+ (hide-tooltip event)
(.setPosition avatar-hover
(goog.ui/Tooltip.CursorTooltipPosition.
(Coordinate/sum (goog.math/Coordinate. px py)
@@ -117,5 +117,5 @@
(draw-graph (layout/radial data) nil)))
(events/listen (dom/get-element :network) events/EventType.CLICK
- #(draw-graph (layout/radial @graph-data)))
+ #(draw-graph (layout/radial @graph-data) nil))
(buzz/register :track-clicked #(. g (clear)))
@@ -867,27 +867,28 @@
opts)
ups-deps (get-upstream-deps)
all-opts (assoc opts
- :ups-libs (:libs ups-deps)
- :ups-foreign-libs (:foreign-libs ups-deps)
- :ups-externs (:externs ups-deps))
- compiled (binding [comp/*cljs-static-fns*
- (or (and (= (opts :optimizations) :advanced))
- (:static-fns opts)
- comp/*cljs-static-fns*)]
- (-compile source all-opts))
- compiled (concat
- (if (coll? compiled) compiled [compiled])
- (when (= :nodejs (:target all-opts))
- [(-compile (io/resource "cljs/nodejscli.cljs") all-opts)]))
- js-sources (if (coll? compiled)
- (apply add-dependencies all-opts compiled)
- (add-dependencies all-opts compiled))]
- (if (:optimizations all-opts)
- (->> js-sources
- (apply optimize all-opts)
- (add-header all-opts)
- (output-one-file all-opts))
- (apply output-unoptimized all-opts js-sources))))
+ :ups-libs (:libs ups-deps)
+ :ups-foreign-libs (:foreign-libs ups-deps)
+ :ups-externs (:externs ups-deps))]
+ (binding [comp/*cljs-static-fns*
+ (or (and (= (opts :optimizations) :advanced))
+ (:static-fns opts)
+ comp/*cljs-static-fns*)]
+ (let [compiled (-compile source all-opts)
+ compiled (concat
+ (if (coll? compiled) compiled [compiled])
+ (when (= :nodejs (:target all-opts))
+ [(-compile (io/resource "cljs/nodejscli.cljs") all-opts)]))
+ js-sources (if (coll? compiled)
+ (binding []
+ (apply add-dependencies all-opts compiled))
+ (add-dependencies all-opts compiled))]
+ (if (:optimizations all-opts)
+ (->> js-sources
+ (apply optimize all-opts)
+ (add-header all-opts)
+ (output-one-file all-opts))
+ (apply output-unoptimized all-opts js-sources))))))
(comment
@@ -16,6 +16,7 @@
(declare resolve-var)
(declare confirm-bindings)
+(declare munge)
(require 'cljs.core)
(def js-reserved
@@ -406,6 +407,10 @@
else-tag (infer-tag (:else e))]
(when (= then-tag else-tag)
then-tag))
+ :constant (case (:form e)
+ true 'boolean
+ false 'boolean
+ nil)
nil)))
(defn safe-test? [e]
@@ -716,7 +721,7 @@
(emitln "goog.require('" (munge lib) "');")))
(defmethod emit :deftype*
- [{:keys [t fields]}]
+ [{:keys [t fields pmasks]}]
(let [fields (map munge fields)]
(emitln "")
(emitln "/**")
@@ -725,10 +730,12 @@
(emitln t " = (function (" (comma-sep (map str fields)) "){")
(doseq [fld fields]
(emitln "this." fld " = " fld ";"))
+ (doseq [[pno pmask] pmasks]
+ (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";"))
(emitln "})")))
(defmethod emit :defrecord*
- [{:keys [t fields]}]
+ [{:keys [t fields pmasks]}]
(let [fields (concat (map munge fields) '[__meta __extmap])]
(emitln "")
(emitln "/**")
@@ -741,6 +748,8 @@
(emitln t " = (function (" (comma-sep (map str fields)) "){")
(doseq [fld fields]
(emitln "this." fld " = " fld ";"))
+ (doseq [[pno pmask] pmasks]
+ (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";"))
(emitln "if(arguments.length>" (- (count fields) 2) "){")
(emitln "this.__meta = __meta;")
(emitln "this.__extmap = __extmap;")
@@ -1067,7 +1076,9 @@
(defmethod parse 'ns
[_ env [_ name & args :as form] _]
- (let [excludes
+ (let [docstring (if (string? (first args)) (first args) nil)
+ args (if docstring (next args) args)
+ excludes
(reduce (fn [s [k exclude xs]]
(if (= k :refer-clojure)
(do
@@ -1110,7 +1121,7 @@
:uses-macros uses-macros :requires-macros requires-macros :excludes excludes}))
(defmethod parse 'deftype*
- [_ env [_ tsym fields :as form] _]
+ [_ env [_ tsym fields pmasks :as form] _]
(let [t (munge (:name (resolve-var (dissoc env :locals) tsym)))]
(swap! namespaces update-in [(-> env :ns :name) :defs tsym]
(fn [m]
@@ -1120,10 +1131,10 @@
(assoc :file *cljs-file*)
(assoc :line line))
m))))
- {:env env :op :deftype* :as form :t t :fields fields}))
+ {:env env :op :deftype* :as form :t t :fields fields :pmasks pmasks}))
(defmethod parse 'defrecord*
- [_ env [_ tsym fields :as form] _]
+ [_ env [_ tsym fields pmasks :as form] _]
(let [t (munge (:name (resolve-var (dissoc env :locals) tsym)))]
(swap! namespaces update-in [(-> env :ns :name) :defs tsym]
(fn [m]
@@ -1133,7 +1144,7 @@
(assoc :file *cljs-file*)
(assoc :line line))
m))))
- {:env env :op :defrecord* :form form :t t :fields fields}))
+ {:env env :op :defrecord* :form form :t t :fields fields :pmasks pmasks}))
;; dot accessor code
@@ -1213,13 +1224,15 @@
::access {:env env :op :dot :form form
:target targetexpr
:field field
- :children [targetexpr]}
+ :children [targetexpr]
+ :tag (-> form meta :tag)}
::call (let [argexprs (map #(analyze enve %) args)]
{:env env :op :dot :form form
:target targetexpr
:method method
:args argexprs
- :children (into [targetexpr] argexprs)})))))
+ :children (into [targetexpr] argexprs)
+ :tag (-> form meta :tag)})))))
(defmethod parse 'js*
[op env [_ jsform & args :as form] _]
@@ -1295,7 +1308,8 @@
(if (specials op)
form
(if-let [mac (and (symbol? op) (get-expander op env))]
- (apply mac form env (rest form))
+ (binding [*ns* *cljs-ns*]
+ (apply mac form env (rest form)))
(if (symbol? op)
(let [opname (str op)]
(cond
View
@@ -42,6 +42,30 @@
or
when when-first when-let when-not while])
+(def fast-path-protocols
+ "protocol fqn -> [partition number, bit]"
+ (zipmap (map #(symbol (core/str "cljs.core." %))
+ '[IFn ICounted IEmptyableCollection ICollection IIndexed ASeq ISeq
+ ILookup IAssociative IMap IMapEntry ISet IStack IVector IDeref
+ IDerefWithTimeout IMeta IWithMeta IReduce IKVReduce IEquiv IHash
+ ISeqable ISequential IList IRecord IReversible ISorted IPrintable
+ IPending IWatchable IEditableCollection ITransientCollection
+ ITransientAssociative ITransientMap ITransientVector ITransientSet
+ IMultiFn])
+ (iterate (fn [[p b]]
+ (if (core/== 2147483648 b)
+ [(core/inc p) 1]
+ [p (core/bit-shift-left b 1)]))
+ [0 1])))
+
+(def fast-path-protocol-partitions-count
+ "total number of partitions"
+ (let [c (count fast-path-protocols)
+ m (core/mod c 32)]
+ (if (core/zero? m)
+ (core/quot c 32)
+ (core/inc (core/quot c 32)))))
+
(defmacro str [& xs]
(let [strs (->> (repeat (count xs) "cljs.core.str(~{})")
(interpose ",")
@@ -52,7 +76,11 @@
(vary-meta e assoc :tag 'boolean))
(defmacro nil? [x]
- `(identical? ~x nil))
+ `(coercive-= ~x nil))
+
+;; internal - do not use.
+(defmacro coercive-not [x]
+ (bool-expr (list 'js* "(!~{})" x)))
;; internal - do not use.
(defmacro coercive-not= [x y]
@@ -166,6 +194,11 @@
([x y] (list 'js* "(~{} & ~{})" x y))
([x y & more] `(bit-and (bit-and ~x ~y) ~@more)))
+;; internal do not use
+(defmacro unsafe-bit-and
+ ([x y] (bool-expr (list 'js* "(~{} & ~{})" x y)))
+ ([x y & more] `(unsafe-bit-and (unsafe-bit-and ~x ~y) ~@more)))
+
(defmacro bit-or
([x y] (list 'js* "(~{} | ~{})" x y))
([x y & more] `(bit-or (bit-or ~x ~y) ~@more)))
@@ -230,10 +263,13 @@
'default "_"})
(defmacro reify [& impls]
- (let [t (gensym "t")
- locals (keys (:locals &env))]
+ (let [t (gensym "t")
+ locals (keys (:locals &env))
+ ns (-> &env :ns :name)
+ munge cljs.compiler/munge
+ ns-t (list 'js* (core/str (munge ns) "." (munge t)))]
`(do
- (when (undefined? ~t)
+ (when (undefined? ~ns-t)
(deftype ~t [~@locals __meta#]
cljs.core.IWithMeta
(~'-with-meta [_# __meta#]
@@ -308,6 +344,28 @@
sigs)))))]
`(do ~@(mapcat assign-impls impl-map))))))
+(defn- prepare-protocol-masks [env t impls]
+ (let [resolve #(let [ret (:name (cljs.compiler/resolve-var (dissoc env :locals) %))]
+ (assert ret (core/str "Can't resolve: " %))
+ ret)
+ impl-map (loop [ret {} s impls]
+ (if (seq s)
+ (recur (assoc ret (first s) (take-while seq? (next s)))
+ (drop-while seq? (next s)))
+ ret))]
+ (if-let [fpp-pbs (seq (keep fast-path-protocols
+ (map resolve
+ (keys impl-map))))]
+ (let [fpp-partitions (group-by first fpp-pbs)
+ fpp-partitions (into {} (map (juxt key (comp (partial map peek) val))
+ fpp-partitions))
+ fpp-partitions (into {} (map (juxt key (comp (partial reduce core/bit-or) val))
+ fpp-partitions))]
+ (reduce (fn [ps p]
+ (update-in ps [p] (fnil identity 0)))
+ fpp-partitions
+ (range fast-path-protocol-partitions-count))))))
+
(defmacro deftype [t fields & impls]
(let [adorn-params (fn [sig]
(cons (vary-meta (second sig) assoc :cljs.compiler/fields fields)
@@ -325,25 +383,29 @@
(group-by first (take-while seq? (next s))))))
(drop-while seq? (next s)))
ret)))
- r (:name (cljs.compiler/resolve-var (dissoc &env :locals) t))]
+ r (:name (cljs.compiler/resolve-var (dissoc &env :locals) t))
+ pmasks (prepare-protocol-masks &env t impls)]
(if (seq impls)
`(do
- (deftype* ~t ~fields)
- (set! (.-cljs$core$IPrintable$_pr_seq ~t) (fn [this#] (list ~(core/str r))))
+ (deftype* ~t ~fields ~pmasks)
+ (set! (.-cljs$lang$type ~t) true)
+ (set! (.-cljs$lang$ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
(extend-type ~t ~@(dt->et impls))
~t)
`(do
- (deftype* ~t ~fields)
- (set! (.-cljs$core$IPrintable$_pr_seq ~t) (fn [this#] (list ~(core/str r))))
+ (deftype* ~t ~fields ~pmasks)
+ (set! (.-cljs$lang$type ~t) true)
+ (set! (.-cljs$lang$ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
~t))))
(defn- emit-defrecord
"Do not use this directly - use defrecord"
- [tagname rname fields impls]
+ [env tagname rname fields impls]
(let [hinted-fields fields
fields (vec (map #(with-meta % nil) fields))
base-fields fields
fields (conj fields '__meta '__extmap)
+ pmasks (prepare-protocol-masks env tagname impls)
adorn-params (fn [sig]
(cons (vary-meta (second sig) assoc :cljs.compiler/fields fields)
(nnext sig)))
@@ -418,7 +480,7 @@
~'__extmap))))
])]
`(do
- (~'defrecord* ~tagname ~hinted-fields)
+ (~'defrecord* ~tagname ~hinted-fields ~pmasks)
(extend-type ~tagname ~@(dt->et impls))))))
(defn- build-positional-factory
@@ -441,8 +503,9 @@
(defmacro defrecord [rsym fields & impls]
(let [r (:name (cljs.compiler/resolve-var (dissoc &env :locals) rsym))]
`(let []
- ~(emit-defrecord rsym r fields impls)
- (set! (.-cljs$core$IPrintable$_pr_seq ~r) (fn [this#] (list ~(core/str r))))
+ ~(emit-defrecord &env rsym r fields impls)
+ (set! (.-cljs$lang$type ~r) true)
+ (set! (.-cljs$lang$ctorPrSeq ~r) (fn [this#] (list ~(core/str r))))
~(build-positional-factory rsym r fields)
~(build-map-factory rsym r fields)
~r)))
@@ -481,13 +544,19 @@
"Returns true if x satisfies the protocol"
[psym x]
(let [p (:name (cljs.compiler/resolve-var (dissoc &env :locals) psym))
- prefix (protocol-prefix p)]
- `(let [x# ~x]
- (if (and x#
- (. x# ~(symbol (core/str "-" prefix))) ;; Need prop lookup here
- (not (. x# (~'hasOwnProperty ~prefix))))
- true
- (cljs.core/type_satisfies_ ~psym x#)))))
+ prefix (protocol-prefix p)
+ xsym (gensym)
+ [part bit] (fast-path-protocols p)
+ msym (symbol (core/str "-cljs$lang$protocol_mask$partition" part "$"))]
+ `(let [~xsym ~x]
+ (if (coercive-not= ~xsym nil)
+ (if (or ~(if bit `(unsafe-bit-and (. ~xsym ~msym) ~bit))
+ ~(bool-expr `(. ~xsym ~(symbol (core/str "-" prefix)))))
+ true
+ (if (coercive-not (. ~xsym ~msym))
+ (cljs.core/type_satisfies_ ~psym ~xsym)
+ false))
+ (cljs.core/type_satisfies_ ~psym ~xsym)))))
(defmacro lazy-seq [& body]
`(new cljs.core.LazySeq nil false (fn [] ~@body)))
Oops, something went wrong.

0 comments on commit e5c3a41

Please sign in to comment.