Skip to content
Browse files

CLJS-235: implementing David Nolen's protocol mask idea

The core protocols are now partitioned into groups of 32. For each
such group a property cljs$lang$protocol_mask$partitionX$ (with X
being the partition number) is attached to *instances* (not
prototypes) of implementing types / records at construction time (in
the ctor). This is then used by satisfies? to produce quick answers in
the "success" case (that is, when the given object does satisfy a core
protocol).
  • Loading branch information...
1 parent 2d2f11f commit e227b100bfa9bbf3a80201ec99b97c79634563ad @michalmarczyk michalmarczyk committed May 5, 2012
Showing with 52 additions and 24 deletions.
  1. +10 −8 src/clj/cljs/compiler.clj
  2. +42 −16 src/clj/cljs/core.clj
View
18 src/clj/cljs/compiler.clj
@@ -715,7 +715,7 @@
(emitln "goog.require('" (munge lib) "');")))
(defmethod emit :deftype*
- [{:keys [t fields pmask]}]
+ [{:keys [t fields pmasks]}]
(let [fields (map munge fields)]
(emitln "")
(emitln "/**")
@@ -724,11 +724,12 @@
(emitln t " = (function (" (comma-sep (map str fields)) "){")
(doseq [fld fields]
(emitln "this." fld " = " fld ";"))
- (when pmask (emitln "this.__protocol_mask = " pmask ";"))
+ (doseq [[pno pmask] pmasks]
+ (emitln "this.cljs$lang$protocol_mask$partition" pno "$ = " pmask ";"))
(emitln "})")))
(defmethod emit :defrecord*
- [{:keys [t fields pmask]}]
+ [{:keys [t fields pmasks]}]
(let [fields (concat (map munge fields) '[__meta __extmap])]
(emitln "")
(emitln "/**")
@@ -741,7 +742,8 @@
(emitln t " = (function (" (comma-sep (map str fields)) "){")
(doseq [fld fields]
(emitln "this." fld " = " fld ";"))
- (when pmask (emitln "this.__protocol_mask = " pmask ";"))
+ (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;")
@@ -1113,7 +1115,7 @@
:uses-macros uses-macros :requires-macros requires-macros :excludes excludes}))
(defmethod parse 'deftype*
- [_ env [_ tsym fields pmask :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]
@@ -1123,10 +1125,10 @@
(assoc :file *cljs-file*)
(assoc :line line))
m))))
- {:env env :op :deftype* :as form :t t :fields fields :pmask pmask}))
+ {:env env :op :deftype* :as form :t t :fields fields :pmasks pmasks}))
(defmethod parse 'defrecord*
- [_ env [_ tsym fields pmask :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]
@@ -1136,7 +1138,7 @@
(assoc :file *cljs-file*)
(assoc :line line))
m))))
- {:env env :op :defrecord* :form form :t t :fields fields :pmask pmask}))
+ {:env env :op :defrecord* :form form :t t :fields fields :pmasks pmasks}))
;; dot accessor code
View
58 src/clj/cljs/core.clj
@@ -43,10 +43,28 @@
when when-first when-let when-not while])
(def fast-path-protocols
+ "protocol fqn -> [partition number, bit]"
(zipmap (map #(symbol (core/str "cljs.core." %))
- '[ISeq IFn IHash IEquiv ISeqable ILookup ICounted IIndexed
- ICollection IAssociative])
- (iterate (partial core/* 2) 1)))
+ '[IFn ICounted IEmptyableCollection ICollection IIndexed 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/== 32 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(~{})")
@@ -326,7 +344,7 @@
sigs)))))]
`(do ~@(mapcat assign-impls impl-map))))))
-(defn- prepare-protocol-mask [env t impls]
+(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)
@@ -335,10 +353,18 @@
(recur (assoc ret (first s) (take-while seq? (next s)))
(drop-while seq? (next s)))
ret))]
- (if-let [fpp-bits (seq (keep fast-path-protocols
- (map resolve
- (keys impl-map))))]
- (reduce core/bit-or fpp-bits))))
+ (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]
@@ -358,16 +384,16 @@
(drop-while seq? (next s)))
ret)))
r (:name (cljs.compiler/resolve-var (dissoc &env :locals) t))
- pmask (prepare-protocol-mask &env t impls)]
+ pmasks (prepare-protocol-masks &env t impls)]
(if (seq impls)
`(do
- (deftype* ~t ~fields ~pmask)
+ (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 ~pmask)
+ (deftype* ~t ~fields ~pmasks)
(set! (.-cljs$lang$type ~t) true)
(set! (.-cljs$lang$ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
~t))))
@@ -379,7 +405,7 @@
fields (vec (map #(with-meta % nil) fields))
base-fields fields
fields (conj fields '__meta '__extmap)
- pmask (prepare-protocol-mask env tagname impls)
+ pmasks (prepare-protocol-masks env tagname impls)
adorn-params (fn [sig]
(cons (vary-meta (second sig) assoc :cljs.compiler/fields fields)
(nnext sig)))
@@ -454,7 +480,7 @@
~'__extmap))))
])]
`(do
- (~'defrecord* ~tagname ~hinted-fields ~pmask)
+ (~'defrecord* ~tagname ~hinted-fields ~pmasks)
(extend-type ~tagname ~@(dt->et impls))))))
(defn- build-positional-factory
@@ -520,12 +546,12 @@
(let [p (:name (cljs.compiler/resolve-var (dissoc &env :locals) psym))
prefix (protocol-prefix p)
xsym (gensym)
- msym (symbol "-__protocol_mask")]
+ [part bit] (fast-path-protocols p)
+ msym (symbol (core/str "-cljs$lang$protocol_mask$partition" part "$"))]
`(let [~xsym ~x]
(if (and (coercive-not= ~xsym nil)
(or
- ~(if-let [bit (fast-path-protocols p)]
- `(unsafe-bit-and (. ~xsym ~msym) ~bit))
+ ~(if bit `(unsafe-bit-and (. ~xsym ~msym) ~bit))
~(bool-expr `(. ~xsym ~(symbol (core/str "-" prefix))))))
true
(cljs.core/type_satisfies_ ~psym ~xsym)))))

0 comments on commit e227b10

Please sign in to comment.
Something went wrong with that request. Please try again.