Skip to content

Commit

Permalink
Merge pull request #522 from bsless/faster-parse-entries
Browse files Browse the repository at this point in the history 
Reimplement -parse-entries
  • Loading branch information
@ikitommi
ikitommi authored Aug 24, 2021
2 parents 27eef27 + 22e5878 commit bb05259
Showing 1 changed file with 144 additions and 21 deletions.
165 changes: 144 additions & 21 deletions src/malli/core.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -215,27 +215,150 @@
:always (->> (filter (fn [e] (-> e last some?)))))]
(-set-children schema children)))

(defn -parse-entries [cs {:keys [naked-keys lazy-refs]} options]
(let [-parse (fn [e]
(let [[[k ?p ?v] f]
(if (not (sequential? e))
(if (and naked-keys (-reference? e))
[[e nil e] e]
(-fail! ::invalid-ref {:ref e}))
(let [size (count e), k (nth e 0)]
(or (if (-reference? k)
(cond (= 1 size) (if naked-keys [[k nil k] e])
(and (= 2 size) (map? (nth e 1))) (if naked-keys [(conj e k) e])))
[e (->> (-update (vec e) (dec (count e)) (-comp -form #(schema % options))) (keep identity) (vec))])))
[p ?s] (if (or (nil? ?p) (map? ?p)) [?p ?v] [nil ?p])
s (cond-> (or ?s (if (-reference? k) f)) lazy-refs (-lazy options))
c [k p (schema s options)]]
[k c (miu/-tagged k (-val-schema (nth c 2) p)) f]))
es (loop [keyset #{}, children [], entries [], forms [], [p & ps] (map -parse cs)]
(if p (recur (conj keyset (nth p 0)) (conj children (nth p 1)) (conj entries (nth p 2)) (conj forms (nth p 3)) ps)
{:keyset keyset, :children children, :entries entries, :forms forms}))]
(when-not (= (count (:keyset es)) (count cs)) (-fail! ::non-distinct-entry-keys es))
es))
#?(: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 -guard [pred tf]
(when tf (fn [x] (if (pred x) (tf x) x))))
Expand Down

0 comments on commit bb05259

Please sign in to comment.