Skip to content

Commit

Permalink
Merge pull request #528 from metosin/fast-entry-parsing2
Browse files Browse the repository at this point in the history
Fast entry parsing2
  • Loading branch information
ikitommi authored Aug 24, 2021
2 parents bb05259 + 1f1929d commit e5b0b14
Show file tree
Hide file tree
Showing 2 changed files with 89 additions and 146 deletions.
4 changes: 3 additions & 1 deletion perf/malli/creation_perf_test.cljc
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,7 @@
(bench (m/schema :int))
(profile (m/schema :int))

;; 44µs -> 31µs -> 18µs
;; 44µs -> 31µs -> 18µs -> 11µs -> 9.4µs
(bench (m/schema ?schema))
(profile (m/schema ?schema)))

Expand All @@ -117,6 +117,8 @@
;; 44µs (-set-children, -set-properties)
;; 29µs (lot's of stuff)
;; 21µs (faster parsing)
;; 7.5µs (ever faster parsing)
;; 7.2µs (compact parsing)
(bench (mu/closed-schema schema))
(profile (mu/closed-schema schema)))

Expand Down
231 changes: 86 additions & 145 deletions src/malli/core.cljc
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
[malli.impl.regex :as re]
[malli.registry :as mr])
#?(:clj (:import (java.util.regex Pattern)
(clojure.lang Associative IPersistentCollection MapEntry IPersistentVector)
(clojure.lang Associative IPersistentCollection MapEntry IPersistentVector LazilyPersistentVector)
(malli.impl.util SchemaError)
(java.util.concurrent.atomic AtomicReference)
(java.util Collection LinkedList))))
Expand Down Expand Up @@ -215,150 +215,91 @@
:always (->> (filter (fn [e] (-> e last some?)))))]
(-set-children schema children)))

#?(:clj
(defn- -add-or-fail!
[^java.util.Set keyset k]
(if (.add keyset k)
nil
(-fail! ::non-distinct-entry-keys {:keys (conj (seq keyset) k)})))
:cljs
(defn- -add-or-fail!
[keyset k]
(if (contains? @keyset k)
(-fail! ::non-distinct-entry-keys {:keys (conj (vec @keyset) k)})
(vswap! keyset conj k))))

(defn- parse-ref-entry
[e lazy-refs options i ^objects -children ^objects -entries ^objects -forms -keyset]
(let [s (cond-> (or e (when (-reference? e) e)) lazy-refs (-lazy options))
s' (schema s options)
c [e nil s']
e' (miu/-tagged e (-val-schema s' nil))
i (int i)]
(-add-or-fail! -keyset e)
(aset -children i c)
(aset -entries i e')
(aset -forms i e)
(unchecked-inc-int i)))

(defn- parse-ref-vector1
[e e0 lazy-refs options i ^objects -children ^objects -entries ^objects -forms -keyset]
(let [s (cond-> (or e0 (when (-reference? e0) e)) lazy-refs (-lazy options))
s' (schema s options)
c [e0 nil s']
e' (miu/-tagged e0 (-val-schema s' nil))
i (int i)]
(-add-or-fail! -keyset e0)
(aset -children i c)
(aset -entries i e')
(aset -forms i e)
(unchecked-inc-int i)))

(defn- parse-ref-vector2
[e e0 e1 lazy-refs options i ^objects -children ^objects -entries ^objects -forms -keyset]
(let [s (cond-> (or e0 (when (-reference? e0) e)) lazy-refs (-lazy options))
s' (schema s options)
c [e0 e1 s']
e' (miu/-tagged e0 (-val-schema s' e1))
i (int i)]
(-add-or-fail! -keyset e0)
(aset -children i c)
(aset -entries i e')
(aset -forms i e)
(unchecked-inc-int i)))

(defn- parse-entry-else2
[e0 e1 lazy-refs options i ^objects -children ^objects -entries ^objects -forms -keyset]
(let [f [e0 (-form (schema e1 options))]
s (cond-> (or e1 (when (-reference? e0) f)) lazy-refs (-lazy options))
s' (schema s options)
c [e0 nil s']
e' (miu/-tagged e0 (-val-schema s' nil))
i (int i)]
(-add-or-fail! -keyset e0)
(aset -children i c)
(aset -entries i e')
(aset -forms i f)
(unchecked-inc-int i)))

(defn- parse-entry-else3
[e0 e1 e2 lazy-refs options i ^objects -children ^objects -entries ^objects -forms -keyset]
(let [f' (-form (schema e2 options))
f (if e1 [e0 e1 f'] [e0 f'])
s (cond-> (or e2 (when (-reference? e0) f)) lazy-refs (-lazy options))
s' (schema s options)
c [e0 e1 s']
e' (miu/-tagged e0 (-val-schema s' e1))
i (int i)]
(-add-or-fail! -keyset e0)
(aset -children i c)
(aset -entries i e')
(aset -forms i f)
(unchecked-inc-int i)))


(defn- -parse-entry*
[e naked-keys lazy-refs options i ^objects -children ^objects -entries ^objects -forms -keyset]
(if (sequential? e)
(let [n (count e)
e0 (nth e 0)]
(if (== n 1)
(if (and (-reference? e0) naked-keys)
(parse-ref-vector1 e e0 lazy-refs options i -children -entries -forms -keyset)
i)
(let [e1 (nth e 1)]
(if (== n 2)
(if (and (-reference? e0) (map? e1))
(if naked-keys
(parse-ref-vector2 e e0 e1 lazy-refs options i -children -entries -forms -keyset)
i)
(parse-entry-else2 e0 e1 lazy-refs options i -children -entries -forms -keyset))
(let [e2 (nth e 2)]
(parse-entry-else3 e0 e1 e2 lazy-refs options i -children -entries -forms -keyset))))))
(if (and naked-keys (-reference? e))
(parse-ref-entry e lazy-refs options i -children -entries -forms -keyset)
(-fail! ::invalid-ref {:ref e}))))

(defn- arr->vec
#?(:clj
{:inline (fn [x] `(clojure.lang.LazilyPersistentVector/createOwning ~x))})
[^objects arr]
#?(:clj
(clojure.lang.LazilyPersistentVector/createOwning arr)
:cljs
(vec arr)))

(defn- arange
[^objects arr to]
#?(:clj
(let [-arr (object-array to)]
(System/arraycopy arr 0 -arr 0 to)
-arr)
:cljs
(.slice arr 0 to)))

(defn -parse-entries
[children {:keys [naked-keys lazy-refs]} options]
(let [n (count children)
-children (object-array n)
-entries (object-array n)
-forms (object-array n)
-keyset #?(:clj (java.util.HashSet.) :cljs (volatile! #{}))]
(loop [i (int 0)
ci (int 0)]
(if (== ci n)
(if (== ci i)
{:children (arr->vec -children)
:entries (arr->vec -entries)
:forms (arr->vec -forms)
:keyset (#?(:clj set, :cljs clojure.core/deref) -keyset)}
{:children (arr->vec (arange -children i))
:entries (arr->vec (arange -entries i))
:forms (arr->vec (arange -forms i))
:keyset (#?(:clj set, :cljs clojure.core/deref) -keyset)})
(recur
(-parse-entry* (nth children i) naked-keys lazy-refs options i -children -entries -forms -keyset)
(unchecked-inc-int ci))))))
(defn- -parse-entry [e naked-keys lazy-refs options i ^objects -children ^objects -entries ^objects -forms -keyset]
(letfn [(-collect [k c e f i]
(-keyset k)
(aset -children i c)
(aset -entries i e)
(aset -forms i f)
(unchecked-inc-int i))
(-schema [e] (schema (cond-> (or e (when (-reference? e) e)) lazy-refs (-lazy options)) options))
(-parse-ref-entry [e]
(let [s (-schema e)
c [e nil s]
e' (miu/-tagged e (-val-schema s nil))
i (int i)]
(-collect e c e' e i)))
(-parse-ref-vector1 [e e0]
(let [s (-schema e0)
c [e0 nil s]
e' (miu/-tagged e0 (-val-schema s nil))
i (int i)]
(-collect e0 c e' e i)))
(-parse-ref-vector2 [e e0 e1]
(let [s (-schema e0)
c [e0 e1 s]
e' (miu/-tagged e0 (-val-schema s e1))
i (int i)]
(-collect e0 c e' e i)))
(-parse-entry-else2 [e0 e1]
(let [f [e0 (-form (schema e1 options))]
s (-schema e1)
c [e0 nil s]
e' (miu/-tagged e0 (-val-schema s nil))
i (int i)]
(-collect e0 c e' f i)))
(-parse-entry-else3 [e0 e1 e2]
(let [f' (-form (schema e2 options))
f (if e1 [e0 e1 f'] [e0 f'])
s (-schema e2)
c [e0 e1 s]
e' (miu/-tagged e0 (-val-schema s e1))
i (int i)]
(-collect e0 c e' f i)))]
(if (sequential? e)
(let [n (count e), e0 (nth e 0)]
(if (== n 1)
(if (and (-reference? e0) naked-keys) (-parse-ref-vector1 e e0) i)
(let [e1 (nth e 1)]
(if (== n 2)
(if (and (-reference? e0) (map? e1))
(if naked-keys (-parse-ref-vector2 e e0 e1) i)
(-parse-entry-else2 e0 e1))
(let [e2 (nth e 2)]
(-parse-entry-else3 e0 e1 e2))))))
(if (and naked-keys (-reference? e))
(-parse-ref-entry e)
(-fail! ::invalid-ref {:ref e})))))

(defn -parse-entries [children {:keys [naked-keys lazy-refs]} options]
(letfn [(-arr->vec [^objects arr]
#?(:clj (LazilyPersistentVector/createOwning arr)
:cljs (vec arr)))
(-arange [^objects arr to]
#?(:clj (let [-arr (object-array to)] (System/arraycopy arr 0 -arr 0 to) -arr)
:cljs (.slice arr 0 to)))
(-keyset []
(let [data (volatile! #{})]
(fn
([] @data)
([k] (let [old @data]
(vswap! data conj k)
(when (= old @data)
(-fail! ::non-distinct-entry-keys {:keys old, :key k})))))))]
(let [n (count children)
-children (object-array n)
-entries (object-array n)
-forms (object-array n)
-keyset (-keyset)]
(loop [i (int 0), ci (int 0)]
(if (== ci n)
(let [f (if (== ci i) -arr->vec #(-arr->vec (-arange % i)))]
{:children (f -children)
:entries (f -entries)
:forms (f -forms)
:keyset (-keyset)})
(recur (-parse-entry (nth children i) naked-keys lazy-refs options i -children -entries -forms -keyset)
(unchecked-inc-int ci)))))))

(defn -guard [pred tf]
(when tf (fn [x] (if (pred x) (tf x) x))))
Expand Down

0 comments on commit e5b0b14

Please sign in to comment.