From bfa8353992a2ad7f51cb62b1d8d58d11046bb09f Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sun, 17 Oct 2021 23:26:11 +0300
Subject: [PATCH 01/25] there it is

---
 src/malli/core.cljc | 52 +++++++++++++++++++++++++++++++--------------
 1 file changed, 36 insertions(+), 16 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index afbbe1a8c..b1dc96198 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -190,7 +190,7 @@
 (defn -inner-entries [walker path entries options]
   (mapv (fn [[k s]] [k (-properties s) (-inner walker s (conj path k) options)]) entries))
 
-(defn -parsed [s] (-> s meta ::parsed))
+(defn -parsed [s] (-> s meta ::entry-parser))
 
 (defn -set-children [schema children]
   (if (-equals children (-children schema))
@@ -212,7 +212,20 @@
               (fn [e] (when (= (nth e 0) key) (nth e 2))))
             (-children schema)) default))
 
-(defrecord Parsed [keyset children entries forms])
+(defprotocol EntryParser
+  (-entry-keyset [this])
+  (-entry-children [this])
+  (-entry-entries [this])
+  (-entry-forms [this]))
+
+(defn -entry-parser? [x] (#?(:clj instance?, :cljs implements?) malli.core.EntryParser x))
+
+(defn -simple-entry-parser [keyset children entries forms]
+  (reify EntryParser
+    (-entry-keyset [_] keyset)
+    (-entry-children [_] children)
+    (-entry-entries [_] entries)
+    (-entry-forms [_] forms)))
 
 (defn- -update-parsed [{:keys [keyset children entries forms]} ?key value options]
   (let [[k p override] (if (vector? ?key) [(nth ?key 0) (second ?key) true] [?key])
@@ -221,17 +234,17 @@
     (if (nil? s)
       ;; remove
       (letfn [(cut [v] (into (subvec v 0 i) (subvec v (inc i))))]
-        (->Parsed (dissoc keyset k) (cut children) (cut entries) (cut forms)))
+        (-simple-entry-parser (dissoc keyset k) (cut children) (cut entries) (cut forms)))
       (let [c [k p s]
             e (miu/-tagged k (-val-schema s p))
             p (if i (if override p (nth (children i) 1)) p)
             f (if (seq p) [k p (-form s)] [k (-form s)])]
         (if i
           ;; update
-          (->Parsed keyset (assoc children i c) (assoc entries i e) (assoc forms i f))
+          (-simple-entry-parser keyset (assoc children i c) (assoc entries i e) (assoc forms i f))
           ;; assoc
           (let [size (inc (count keyset))]
-            (->Parsed (assoc keyset k size) (conj children c) (conj entries e) (conj forms f))))))))
+            (-simple-entry-parser (assoc keyset k size) (conj children c) (conj entries e) (conj forms f))))))))
 
 (defn -set-entries
   ([schema ?key value]
@@ -301,8 +314,8 @@
         (-parse-ref-entry e)
         (-fail! ::invalid-ref {:ref e})))))
 
-(defn -parse-entries [?children props options]
-  (if (instance? Parsed ?children)
+(defn -entry-parser [?children props options]
+  (if (-entry-parser? ?children)
     ?children
     (letfn [(-vec [^objects arr] #?(:clj (LazilyPersistentVector/createOwning arr), :cljs (vec arr)))
             (-map [^objects arr] #?(:clj (PersistentArrayMap/createWithCheck arr)
@@ -321,10 +334,17 @@
         (loop [i (int 0), ci (int 0)]
           (if (== ci n)
             (let [f (if (== ci i) -vec #(-vec (-arange % i)))]
-              (->Parsed (-map -keyset) (f -children) (f -entries) (f -forms)))
+              (-simple-entry-parser (-map -keyset) (f -children) (f -entries) (f -forms)))
             (recur (int (-parse-entry (nth ?children i) naked-keys lazy-refs options i -children -entries -forms -keyset))
                    (unchecked-inc-int ci))))))))
 
+(defn -parse-entries [?children props options]
+  (let [entry-parser (-entry-parser ?children props options)]
+    {:keyset (-entry-keyset entry-parser)
+     :children (-entry-children entry-parser)
+     :entries (-entry-entries entry-parser)
+     :forms (-entry-forms entry-parser)}))
+
 (defn -guard [pred tf]
   (when tf (fn [x] (if (pred x) (tf x) x))))
 
@@ -602,10 +622,10 @@
     (-children-schema [_ _])
     (-into-schema [parent properties children options]
       (-check-children! :orn properties children 1 nil)
-      (let [{:keys [children entries forms] :as parsed} (-parse-entries children {:naked-keys true} options)
+      (let [{:keys [children entries forms entry-parser]} (-parse-entries children {:naked-keys true} options)
             form (-create-form :orn properties forms)]
         ^{:type ::schema
-          ::parsed parsed}
+          ::entry-parser entry-parser}
         (reify
           Schema
           (-validator [_]
@@ -753,7 +773,7 @@
      (-properties-schema [_ _])
      (-children-schema [_ _])
      (-into-schema [parent {:keys [closed] :as properties} children options]
-       (let [{:keys [keyset children entries forms] :as parsed} (-parse-entries children opts options)
+       (let [{:keys [keyset children entries forms entry-parser]} (-parse-entries children opts options)
              form (delay (-create-form :map properties forms))
              ->parser (fn [f] (let [parsers (cond-> (mapv
                                                       (fn [[key {:keys [optional]} schema]]
@@ -773,7 +793,7 @@
                                                                       m (keys m)))]))]
                                 (fn [x] (if (map? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid))))]
          ^{:type ::schema
-           ::parsed parsed}
+           ::entry-parser entry-parser}
          (reify
            Schema
            (-validator [_]
@@ -1237,7 +1257,7 @@
      (-into-schema [parent properties children options]
        (let [type (or (:type opts) :multi)
              opts' (merge opts (select-keys properties [:lazy-refs]))
-             {:keys [children entries forms] :as parsed} (-parse-entries children opts' options)
+             {:keys [children entries forms entry-parser]} (-parse-entries children opts' options)
              form (-create-form type properties forms)
              dispatch (eval (:dispatch properties) options)
              dispatch-map (->> (for [[k s] entries] [k s]) (into {}))
@@ -1245,7 +1265,7 @@
          (when-not dispatch
            (-fail! ::missing-property {:key :dispatch}))
          ^{:type ::schema
-           ::parsed parsed}
+           ::entry-parser entry-parser}
          (reify
            Schema
            (-validator [_]
@@ -1590,10 +1610,10 @@
     (-children-schema [_ _])
     (-into-schema [parent properties children options]
       (-check-children! type properties children min max)
-      (let [{:keys [children entries forms] :as parsed} (-parse-entries children opts options)
+      (let [{:keys [children entries forms entry-parser]} (-parse-entries children opts options)
             form (-create-form type properties forms)]
         ^{:type ::schema
-          ::parsed parsed}
+          ::entry-parser entry-parser}
         (reify
           Schema
           (-validator [this] (regex-validator this))

From c4d2bfd24b53fd863385f3349b44c37620f6b3c7 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Tue, 19 Oct 2021 18:35:18 +0300
Subject: [PATCH 02/25] use entry-parser directly

---
 src/malli/core.cljc       | 140 +++++++++++++++++++++-----------------
 test/malli/core_test.cljc |  31 +++++----
 2 files changed, 94 insertions(+), 77 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index b1dc96198..90dc1fae0 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -42,7 +42,8 @@
   (-form [this] "returns original form of the schema"))
 
 (defprotocol MapSchema
-  (-entries [this] "returns sequence of `key -val-schema` MapEntries"))
+  (-entries [this] "returns sequence of `key -val-schema` MapEntries")
+  (-keyset [this]))
 
 (defprotocol LensSchema
   (-keep [this] "returns truthy if schema contributes to value path")
@@ -212,6 +213,10 @@
               (fn [e] (when (= (nth e 0) key) (nth e 2))))
             (-children schema)) default))
 
+;;
+;; entries
+;;
+
 (defprotocol EntryParser
   (-entry-keyset [this])
   (-entry-children [this])
@@ -227,8 +232,12 @@
     (-entry-entries [_] entries)
     (-entry-forms [_] forms)))
 
-(defn- -update-parsed [{:keys [keyset children entries forms]} ?key value options]
+(defn- -update-parsed [entry-parser ?key value options]
   (let [[k p override] (if (vector? ?key) [(nth ?key 0) (second ?key) true] [?key])
+        keyset (-entry-keyset entry-parser)
+        children (-entry-children entry-parser)
+        entries (-entry-entries entry-parser)
+        forms (-entry-forms entry-parser)
         s (when value (schema value options))
         i (keyset k)]
     (if (nil? s)
@@ -248,8 +257,8 @@
 
 (defn -set-entries
   ([schema ?key value]
-   (if-let [parsed (-parsed schema)]
-     (-set-children schema (-update-parsed parsed ?key value (-options schema)))
+   (if-let [entry-parser (-parsed schema)]
+     (-set-children schema (-update-parsed entry-parser ?key value (-options schema)))
      (let [found (atom nil)
            [key props override] (if (vector? ?key) [(nth ?key 0) (second ?key) true] [?key])
            children (cond-> (mapv (fn [[k p :as entry]]
@@ -338,12 +347,9 @@
             (recur (int (-parse-entry (nth ?children i) naked-keys lazy-refs options i -children -entries -forms -keyset))
                    (unchecked-inc-int ci))))))))
 
-(defn -parse-entries [?children props options]
-  (let [entry-parser (-entry-parser ?children props options)]
-    {:keyset (-entry-keyset entry-parser)
-     :children (-entry-children entry-parser)
-     :entries (-entry-entries entry-parser)
-     :forms (-entry-forms entry-parser)}))
+;;
+;; helpers
+;;
 
 (defn -guard [pred tf]
   (when tf (fn [x] (if (pred x) (tf x) x))))
@@ -622,32 +628,32 @@
     (-children-schema [_ _])
     (-into-schema [parent properties children options]
       (-check-children! :orn properties children 1 nil)
-      (let [{:keys [children entries forms entry-parser]} (-parse-entries children {:naked-keys true} options)
-            form (-create-form :orn properties forms)]
+      (let [entry-parser (-entry-parser children {:naked-keys true} options)
+            form (delay (-create-form :orn properties (-entry-forms entry-parser)))]
         ^{:type ::schema
           ::entry-parser entry-parser}
         (reify
           Schema
-          (-validator [_]
-            (let [validators (distinct (map (fn [[_ _ c]] (-validator c)) children))]
+          (-validator [this]
+            (let [validators (distinct (map (fn [[_ _ c]] (-validator c)) (-children this)))]
               #?(:clj  (miu/-some-pred validators)
                  :cljs (if (second validators) (fn [x] (boolean (some #(% x) validators))) (first validators)))))
-          (-explainer [_ path]
-            (let [explainers (mapv (fn [[k _ c]] (-explainer c (conj path k))) children)]
+          (-explainer [this path]
+            (let [explainers (mapv (fn [[k _ c]] (-explainer c (conj path k))) (-children this))]
               (fn explain [x in acc]
                 (reduce
                   (fn [acc' explainer]
                     (let [acc'' (explainer x in acc')]
                       (if (identical? acc' acc'') (reduced acc) acc'')))
                   acc explainers))))
-          (-parser [_]
+          (-parser [this]
             (let [parsers (mapv (fn [[k _ c]]
                                   (let [c (-parser c)]
                                     (fn [x] (miu/-map-valid #(reduced (miu/-tagged k %)) (c x)))))
-                                children)]
+                                (-children this))]
               (fn [x] (reduce (fn [_ parser] (parser x)) x parsers))))
-          (-unparser [_]
-            (let [unparsers (into {} (map (fn [[k _ c]] [k (-unparser c)])) children)]
+          (-unparser [this]
+            (let [unparsers (into {} (map (fn [[k _ c]] [k (-unparser c)])) (-children this))]
               (fn [x]
                 (if (miu/-tagged? x)
                   (if-some [unparse (get unparsers (key x))]
@@ -656,10 +662,11 @@
                   ::invalid))))
           (-transformer [this transformer method options]
             (let [this-transformer (-value-transformer transformer this method options)]
-              (if (seq children)
+              (if (seq (-children this))
                 (let [transformers (mapv (fn [[_ _ c]] (or (-transformer c transformer method options) identity))
-                                         children)
-                      validators (mapv (fn [[_ _ c]] (-validator c)) children)]
+
+                                         (-children this))
+                      validators (mapv (fn [[_ _ c]] (-validator c)) (-children this))]
                   (-intercepting this-transformer
                                  (if (= :decode method)
                                    (fn [x]
@@ -675,12 +682,15 @@
                 (-intercepting this-transformer))))
           (-walk [this walker path options]
             (if (-accept walker this path options)
-              (-outer walker this path (-inner-entries walker path entries options) options)))
+              (-outer walker this path (-inner-entries walker path (-entries this) options) options)))
           (-properties [_] properties)
           (-options [_] options)
-          (-children [_] children)
+          (-children [_] (-entry-children entry-parser))
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
+          MapSchema
+          (-entries [_] (-entry-entries entry-parser))
+          (-keyset [_] (-entry-keyset entry-parser))
           LensSchema
           (-keep [_] true)
           (-get [this key default] (-get-entries this key default))
@@ -773,9 +783,10 @@
      (-properties-schema [_ _])
      (-children-schema [_ _])
      (-into-schema [parent {:keys [closed] :as properties} children options]
-       (let [{:keys [keyset children entries forms entry-parser]} (-parse-entries children opts options)
-             form (delay (-create-form :map properties forms))
-             ->parser (fn [f] (let [parsers (cond-> (mapv
+       (let [entry-parser (-entry-parser children opts options)
+             form (delay (-create-form :map properties (-entry-forms entry-parser)))
+             ->parser (fn [this f] (let [keyset (-keyset this)
+                                         parsers (cond-> (mapv
                                                       (fn [[key {:keys [optional]} schema]]
                                                         (let [parser (f schema)]
                                                           (fn [m]
@@ -786,7 +797,7 @@
                                                                       (identical? v* v) m
                                                                       :else (assoc m key v*)))
                                                               (if optional m (reduced ::invalid))))))
-                                                      children)
+                                                      (-children this))
                                                     closed (into [(fn [m]
                                                                     (reduce
                                                                       (fn [m k] (if (contains? keyset k) m (reduced (reduced ::invalid))))
@@ -796,17 +807,17 @@
            ::entry-parser entry-parser}
          (reify
            Schema
-           (-validator [_]
+           (-validator [this]
              (let [validators (cond-> (mapv
                                         (fn [[key {:keys [optional]} value]]
                                           (let [valid? (-validator value)
                                                 default (boolean optional)]
                                             #?(:clj  (fn [^Associative m] (if-let [map-entry (.entryAt m key)] (valid? (.val map-entry)) default))
                                                :cljs (fn [m] (if-let [map-entry (find m key)] (valid? (val map-entry)) default)))))
-                                        children)
+                                        (-children this))
                                       closed (into [(fn [m]
                                                       (reduce
-                                                        (fn [acc k] (if (contains? keyset k) acc (reduced false)))
+                                                        (fn [acc k] (if (contains? (-keyset this) k) acc (reduced false)))
                                                         true (keys m)))]))
                    validate #?(:clj (miu/-every-pred validators)
                                :cljs (fn [m] (boolean (reduce #(or (%2 m) (reduced false)) true validators))))]
@@ -821,11 +832,11 @@
                                                 (if-not optional
                                                   (conj acc (miu/-error (conj path key) (conj in key) this nil ::missing-key))
                                                   acc)))))
-                                        children)
+                                        (-children this))
                                       closed (into [(fn [x in acc]
                                                       (reduce
                                                         (fn [acc k]
-                                                          (if (contains? keyset k)
+                                                          (if (contains? (-keyset this) k)
                                                             acc
                                                             (conj acc (miu/-error (conj path k) (conj in k) this nil ::extra-key))))
                                                         acc (keys x)))]))]
@@ -836,26 +847,27 @@
                      (fn [acc explainer]
                        (explainer x in acc))
                      acc explainers)))))
-           (-parser [_] (->parser -parser))
-           (-unparser [_] (->parser -unparser))
+           (-parser [this] (->parser this -parser))
+           (-unparser [this] (->parser this -unparser))
            (-transformer [this transformer method options]
              (let [this-transformer (-value-transformer transformer this method options)
                    ->children (reduce (fn [acc [k s]]
                                         (let [t (-transformer s transformer method options)]
-                                          (cond-> acc t (conj [k t])))) [] entries)
+                                          (cond-> acc t (conj [k t])))) [] (-entries this))
                    apply->children (when (seq ->children) (-map-transformer ->children))
                    apply->children (-guard map? apply->children)]
                (-intercepting this-transformer apply->children)))
            (-walk [this walker path options]
              (if (-accept walker this path options)
-               (-outer walker this path (-inner-entries walker path entries options) options)))
+               (-outer walker this path (-inner-entries walker path (-entries this) options) options)))
            (-properties [_] properties)
            (-options [_] options)
-           (-children [_] children)
+           (-children [_] (-entry-children entry-parser))
            (-parent [_] parent)
            (-form [_] @form)
            MapSchema
-           (-entries [_] entries)
+           (-entries [_] (-entry-entries entry-parser))
+           (-keyset [_] (-entry-keyset entry-parser))
            LensSchema
            (-keep [_] true)
            (-get [this key default] (-get-entries this key default))
@@ -1257,10 +1269,10 @@
      (-into-schema [parent properties children options]
        (let [type (or (:type opts) :multi)
              opts' (merge opts (select-keys properties [:lazy-refs]))
-             {:keys [children entries forms entry-parser]} (-parse-entries children opts' options)
-             form (-create-form type properties forms)
+             entry-parser (-entry-parser children opts' options)
+             form (delay (-create-form type properties (-entry-forms entry-parser)))
              dispatch (eval (:dispatch properties) options)
-             dispatch-map (->> (for [[k s] entries] [k s]) (into {}))
+             dispatch-map (->> (for [[k s] (-entry-entries entry-parser)] [k s]) (into {}))
              finder (fn [{:keys [::default] :as m}] (fn [x] (m x default)))]
          (when-not dispatch
            (-fail! ::missing-property {:key :dispatch}))
@@ -1272,7 +1284,7 @@
              (let [find (finder (reduce-kv (fn [acc k s] (assoc acc k (-validator s))) {} dispatch-map))]
                (fn [x] (if-let [validator (find (dispatch x))] (validator x) false))))
            (-explainer [this path]
-             (let [find (finder (reduce (fn [acc [k s]] (assoc acc k (-explainer s (conj path k)))) {} entries))
+             (let [find (finder (reduce (fn [acc [k s]] (assoc acc k (-explainer s (conj path k)))) {} (-entries this)))
                    ->path (if (keyword? dispatch) #(conj % dispatch) identity)]
                (fn [x in acc]
                  (if-let [explainer (find (dispatch x))]
@@ -1296,14 +1308,15 @@
                (-intercepting this-transformer child-transformer)))
            (-walk [this walker path options]
              (if (-accept walker this path options)
-               (-outer walker this path (-inner-entries walker path entries options) options)))
+               (-outer walker this path (-inner-entries walker path (-entries this) options) options)))
            (-properties [_] properties)
            (-options [_] options)
-           (-children [_] children)
+           (-children [_] (-entry-children entry-parser))
            (-parent [_] parent)
-           (-form [_] form)
+           (-form [_] @form)
            MapSchema
-           (-entries [_] entries)
+           (-entries [_] (-entry-entries entry-parser))
+           (-keyset [_] (-entry-keyset entry-parser))
            LensSchema
            (-keep [_])
            (-get [this key default] (-get-entries this key default))
@@ -1610,8 +1623,8 @@
     (-children-schema [_ _])
     (-into-schema [parent properties children options]
       (-check-children! type properties children min max)
-      (let [{:keys [children entries forms entry-parser]} (-parse-entries children opts options)
-            form (-create-form type properties forms)]
+      (let [entry-parser (-entry-parser children opts options)
+            form (delay (-create-form type properties (-entry-forms entry-parser)))]
         ^{:type ::schema
           ::entry-parser entry-parser}
         (reify
@@ -1623,26 +1636,29 @@
           (-transformer [this transformer method options] (regex-transformer this transformer method options))
           (-walk [this walker path options]
             (if (-accept walker this path options)
-              (-outer walker this path (-inner-entries walker path entries options) options)))
+              (-outer walker this path (-inner-entries walker path (-entries this) options) options)))
           (-properties [_] properties)
           (-options [_] options)
-          (-children [_] children)
+          (-children [_] (-entry-children entry-parser))
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_] true)
           (-get [this key default] (-get-entries this key default))
           (-set [this key value] (-set-entries this key value))
+          MapSchema
+          (-entries [_] (-entry-entries entry-parser))
+          (-keyset [_] (-entry-keyset entry-parser))
           RegexSchema
           (-regex-op? [_] true)
-          (-regex-validator [_] (re-validator properties (map (fn [[k _ s]] [k (-regex-validator s)]) children)))
-          (-regex-explainer [_ path]
-            (re-explainer properties (map (fn [[k _ s]] [k (-regex-explainer s (conj path k))]) children)))
-          (-regex-parser [_] (re-parser properties (map (fn [[k _ s]] [k (-regex-parser s)]) children)))
-          (-regex-unparser [_] (re-unparser properties (map (fn [[k _ s]] [k (-regex-unparser s)]) children)))
-          (-regex-transformer [_ transformer method options]
-            (re-transformer properties (map (fn [[k _ s]] [k (-regex-transformer s transformer method options)]) children)))
-          (-regex-min-max [_] (re-min-max properties children)))))))
+          (-regex-validator [this] (re-validator properties (map (fn [[k _ s]] [k (-regex-validator s)]) (-children this))))
+          (-regex-explainer [this path]
+            (re-explainer properties (map (fn [[k _ s]] [k (-regex-explainer s (conj path k))]) (-children this))))
+          (-regex-parser [this] (re-parser properties (map (fn [[k _ s]] [k (-regex-parser s)]) (-children this))))
+          (-regex-unparser [this] (re-unparser properties (map (fn [[k _ s]] [k (-regex-unparser s)]) (-children this))))
+          (-regex-transformer [this transformer method options]
+            (re-transformer properties (map (fn [[k _ s]] [k (-regex-transformer s transformer method options)]) (-children this))))
+          (-regex-min-max [this] (re-min-max properties (-children this))))))))
 
 ;;
 ;; public api
diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc
index 75ae6f315..e79f69ca3 100644
--- a/test/malli/core_test.cljc
+++ b/test/malli/core_test.cljc
@@ -40,43 +40,43 @@
   (is (= "abba" (m/-keyword->string "abba"))))
 
 (deftest parse-entries-test
-  (let [{:keys [children entries forms]} (m/-parse-entries
-                                           [[:x int?]
-                                            ::x
-                                            "x"
-                                            [::y {:optional true}]
-                                            [:y {:optional true, :title "boolean"} boolean?]]
-                                           {:naked-keys true}
-                                           {:registry (merge (m/default-schemas) {::x int?, "x" int?, ::y int?})})]
+  (let [entry-parser (m/-entry-parser
+                      [[:x int?]
+                       ::x
+                       "x"
+                       [::y {:optional true}]
+                       [:y {:optional true, :title "boolean"} boolean?]]
+                      {:naked-keys true}
+                      {:registry (merge (m/default-schemas) {::x int?, "x" int?, ::y int?})})]
     (testing "forms"
       (is (= [[:x 'int?]
               ::x
               "x"
               [::y {:optional true}]
               [:y {:optional true, :title "boolean"} 'boolean?]]
-             forms)))
+             (m/-entry-forms entry-parser))))
     (testing "entries"
       (is (schema= [[:x [::m/val 'int?]]
                     [::x [::m/val ::x]]
                     ["x" [::m/val "x"]]
                     [::y [::m/val {:optional true} ::y]]
                     [:y [::m/val {:optional true :title "boolean"} 'boolean?]]]
-                   entries)))
+                   (m/-entry-entries entry-parser))))
     (testing "children"
       (is (= [[:x nil 'int?]
               [::x nil ::x]
               ["x" nil "x"]
               [::y {:optional true} ::y]
               [:y {:optional true, :title "boolean"} 'boolean?]]
-             (map #(update % 2 m/form) children)))))
+             (map #(update % 2 m/form) (m/-entry-children entry-parser))))))
   (testing "duplicate keys"
     (is (thrown? #?(:clj Exception, :cljs js/Error)
-                 (m/-parse-entries
+                 (m/-entry-parser
                    [[:x int?]
                     [:x boolean?]] {:naked-keys true} nil))))
   (testing "naked keys fails when not supported"
     (is (thrown? #?(:clj Exception, :cljs js/Error)
-                 (m/-parse-entries
+                 (m/-entry-parser
                    [::x] nil nil)))))
 
 (deftest eval-test
@@ -217,8 +217,9 @@
       (is (= ::m/invalid (m/unparse schema* (miu/-tagged :pos 0))))
 
       (doseq [schema [schema schema*]]
-        (is (= 1 (m/decode schema "1" mt/string-transformer)))
-        (is (= "1" (m/decode schema "1" mt/json-transformer))))
+        (testing (m/form schema)
+          (is (= 1 (m/decode schema "1" mt/string-transformer)))
+          (is (= "1" (m/decode schema "1" mt/json-transformer)))))
 
       (is (= "olipa_kerran_avaruus"
              (m/decode

From e2bdf12047af9b491b3093a922bcbbcb6ddcdc1c Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Tue, 19 Oct 2021 22:55:08 +0300
Subject: [PATCH 03/25] delayed forms

---
 src/malli/core.cljc | 46 ++++++++++++++++++++++-----------------------
 1 file changed, 22 insertions(+), 24 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 90dc1fae0..f09c3fc50 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -707,7 +707,7 @@
       (-check-children! :not properties children 1 1)
       (let [[schema :as children] (map #(schema % options) children)
             validator (complement (-validator schema))
-            form (-create-form :not properties (map -form children))]
+            form (delay (-create-form :not properties (map -form children)))]
         ^{:type ::schema}
         (reify
           Schema
@@ -726,7 +726,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -883,7 +883,7 @@
     (-into-schema [parent {:keys [min max] :as properties} children options]
       (-check-children! :map-of properties children 2 2)
       (let [[key-schema value-schema :as children] (mapv #(schema % options) children)
-            form (-create-form :map-of properties (mapv -form children))
+            form (delay (-create-form :map-of properties (mapv -form children)))
             validate-limits (-validate-limits min max)
             ->parser (fn [f] (let [key-parser (f key-schema)
                                    value-parser (f value-schema)]
@@ -946,7 +946,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -967,7 +967,7 @@
             (reset! props* ?props)
             (-check-children! type properties children 1 1)
             (let [[schema :as children] (mapv #(schema % options) children)
-                  form (-create-form type properties (map -form children))
+                  form (delay (-create-form type properties (map -form children)))
                   validate-limits (-validate-limits min max)
                   ->parser (fn [f] (let [child-parser (f schema)]
                                      (fn [x]
@@ -1021,7 +1021,7 @@
                 (-options [_] options)
                 (-children [_] children)
                 (-parent [_] parent)
-                (-form [_] form)
+                (-form [_] @form)
                 LensSchema
                 (-keep [_] true)
                 (-get [_ _ _] schema)
@@ -1037,7 +1037,7 @@
     (-into-schema [parent properties children options]
       (let [children (into [] (map #(schema % options)) children)
             size (count children)
-            form (-create-form :tuple properties (map -form children))
+            form (delay (-create-form :tuple properties (map -form children)))
             ->parser (fn [f] (let [parsers (into {} (comp (map f) (map-indexed vector)) children)]
                                (fn [x]
                                  (cond
@@ -1087,7 +1087,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_] true)
           (-get [_ key default] (get children key default))
@@ -1102,7 +1102,7 @@
       (-check-children! :enum properties children 1 nil)
       (let [children (vec children)
             schema (set children)
-            form (-create-form :enum properties children)]
+            form (delay (-create-form :enum properties children))]
         ^{:type ::schema}
         (reify
           Schema
@@ -1123,7 +1123,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -1140,7 +1140,7 @@
       (-check-children! :re properties children 1 1)
       (let [children (vec children)
             re (re-pattern child)
-            form (if class? re (-create-form :re properties children))]
+            form (delay (if class? re (-create-form :re properties children)))]
         ^{:type ::schema}
         (reify
           Schema
@@ -1167,7 +1167,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -1182,7 +1182,7 @@
       (-check-children! :fn properties children 1 1)
       (let [children (vec children)
             f (eval (first children) options)
-            form (-create-form :fn properties children)]
+            form (delay (-create-form :fn properties children))]
         ^{:type ::schema}
         (reify
           Schema
@@ -1208,7 +1208,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -1224,7 +1224,7 @@
     (-into-schema [parent properties children options]
       (-check-children! :maybe properties children 1 1)
       (let [[schema :as children] (map #(schema % options) children)
-            form (-create-form :maybe properties (map -form children))
+            form (delay (-create-form :maybe properties (map -form children)))
             ->parser (fn [f] (let [parser (f schema)]
                                (fn [x] (if (nil? x) x (parser x)))))]
         ^{:type ::schema}
@@ -1248,7 +1248,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_])
           (-get [_ key default] (if (= 0 key) schema default))
@@ -1339,7 +1339,7 @@
                       (when-not allow-invalid-refs
                         (-fail! ::invalid-ref {:type :ref, :ref ref})))
              children (vec children)
-             form (-create-form :ref properties children)
+             form (delay (-create-form :ref properties children))
              ->parser (fn [f] (let [parser (-memoize (fn [] (f (-ref))))]
                                 (fn [x] ((parser) x))))]
          ^{:type ::schema}
@@ -1369,7 +1369,7 @@
            (-options [_] options)
            (-children [_] children)
            (-parent [_] parent)
-           (-form [_] form)
+           (-form [_] @form)
            LensSchema
            (-get [_ key default] (if (= key 0) (-pointer ref (-ref) options) default))
            (-keep [_])
@@ -1462,7 +1462,7 @@
     (-into-schema [parent properties children {::keys [function-checker] :as options}]
       (-check-children! :=> properties children 2 2)
       (let [[input :as children] (map #(schema % options) children)
-            form (-create-form :=> properties (map -form children))
+            form (delay (-create-form :=> properties (map -form children)))
             ->checker (if function-checker #(function-checker % options) (constantly nil))]
         (when-not (#{:cat :catn} (type input))
           (-fail! ::invalid-input-schema {:input input}))
@@ -1496,7 +1496,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
+          (-form [_] @form)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -1579,7 +1579,7 @@
     (-into-schema [parent properties children options]
       (-check-children! type properties children min max)
       (let [children (mapv #(schema % options) children)
-            form (-create-form type properties (mapv -form children))]
+            form (delay (-create-form type properties (mapv -form children)))]
         ^{:type ::schema}
         (reify
           Schema
@@ -1595,13 +1595,11 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] form)
-
+          (-form [_] @form)
           LensSchema
           (-keep [_] true)
           (-get [_ key default] (get children key default))
           (-set [this key value] (-set-assoc-children this key value))
-
           RegexSchema
           (-regex-op? [_] true)
           (-regex-validator [_] (re-validator properties (map -regex-validator children)))

From ede3644f1b17ce344bbfc0d31887695a607bb0ab Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Wed, 20 Oct 2021 13:10:07 +0300
Subject: [PATCH 04/25] wip cache

---
 src/malli/core.cljc | 30 ++++++++++++++++++++++++------
 1 file changed, 24 insertions(+), 6 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index f09c3fc50..7b78d7a1a 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -4,7 +4,8 @@
   (:require [malli.sci :as ms]
             [malli.impl.util :as miu]
             [malli.impl.regex :as re]
-            [malli.registry :as mr])
+            [malli.registry :as mr]
+            [clojure.core :as c])
   #?(:clj (:import (java.util.regex Pattern)
                    (clojure.lang Associative IPersistentCollection MapEntry IPersistentVector LazilyPersistentVector PersistentArrayMap)
                    (malli.impl.util SchemaError)
@@ -45,6 +46,12 @@
   (-entries [this] "returns sequence of `key -val-schema` MapEntries")
   (-keyset [this]))
 
+(defprotocol Cached
+  (-get-cache [this k])
+  (-set-cache [this k v]))
+
+(defn -cached? [x] (#?(:clj instance?, :cljs implements?) malli.core.Cached x))
+
 (defprotocol LensSchema
   (-keep [this] "returns truthy if schema contributes to value path")
   (-get [this key default] "returns schema at key")
@@ -364,6 +371,8 @@
         child-transformer (if (seq child-transformers) (apply -comp (rseq child-transformers)))]
     (-intercepting parent-transformer child-transformer)))
 
+(defn -cached [s k f] (if (-cached? s) (or (-get-cache s k) (-set-cache s k (f s))) (f s)))
+
 (defn- -register-var [registry v]
   (let [name (-> v meta :name)
         schema (-simple-schema {:type name, :pred @v})]
@@ -379,7 +388,7 @@
 (defn- -lookup [?schema options]
   (let [registry (-registry options)]
     (or (mr/-schema registry ?schema)
-        (some-> registry (mr/-schema (clojure.core/type ?schema)) (-into-schema nil [?schema] options)))))
+        (some-> registry (mr/-schema (c/type ?schema)) (-into-schema nil [?schema] options)))))
 
 (defn- -lookup! [?schema f options]
   (or (and f (f ?schema) ?schema)
@@ -784,7 +793,7 @@
      (-children-schema [_ _])
      (-into-schema [parent {:keys [closed] :as properties} children options]
        (let [entry-parser (-entry-parser children opts options)
-             form (delay (-create-form :map properties (-entry-forms entry-parser)))
+             cache (atom {})
              ->parser (fn [this f] (let [keyset (-keyset this)
                                          parsers (cond-> (mapv
                                                       (fn [[key {:keys [optional]} schema]]
@@ -864,15 +873,24 @@
            (-options [_] options)
            (-children [_] (-entry-children entry-parser))
            (-parent [_] parent)
-           (-form [_] @form)
+           (-form [_] (-create-form :map properties (-entry-forms entry-parser)))
            MapSchema
            (-entries [_] (-entry-entries entry-parser))
            (-keyset [_] (-entry-keyset entry-parser))
+           Cached
+           (-get-cache [_ k] (@cache k))
+           (-set-cache [_ k v] ((swap! cache assoc k v) k))
            LensSchema
            (-keep [_] true)
            (-get [this key default] (-get-entries this key default))
            (-set [this key value] (-set-entries this key value))))))))
 
+(defn -memory [] (let [state (atom {})] (fn [k d] @(or (get @state k) ((swap! state assoc k d) k)))))
+
+(let [memory (-memory)]
+  (memory :form (delay "kikka"))
+  (memory :form (delay "kikka")))
+
 (defn -map-of-schema []
   ^{:type ::into-schema}
   (reify IntoSchema
@@ -1750,7 +1768,7 @@
   ([?schema]
    (form ?schema nil))
   ([?schema options]
-   (-form (schema ?schema options))))
+   (-cached (schema ?schema options) :form -form)))
 
 (defn properties
   "Returns the Schema properties"
@@ -1802,7 +1820,7 @@
   ([?schema]
    (validator ?schema nil))
   ([?schema options]
-   (-validator (schema ?schema options))))
+   (-cached (schema ?schema options) :validator -validator)))
 
 (defn validate
   "Validates a value againsta a given schema. Creates the `validator` for every call.

From 2facca97547b71fe71da6eb94ab6956fe1fd609f Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Wed, 20 Oct 2021 13:30:49 +0300
Subject: [PATCH 05/25] cached explainer

---
 src/malli/core.cljc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 7b78d7a1a..aeb9ea120 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -1836,7 +1836,7 @@
    (explainer ?schema nil))
   ([?schema options]
    (let [schema' (schema ?schema options)
-         explainer' (-explainer schema' [])]
+         explainer' (-cached schema' :explainer #(-explainer % []))]
      (fn explainer
        ([value]
         (explainer value [] []))

From 2b6b03261fb9948051760c30725e12f79d187a73 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Wed, 20 Oct 2021 13:35:10 +0300
Subject: [PATCH 06/25] simplify caching

---
 perf/malli/perf/creation_perf_test.cljc |  5 +----
 src/malli/core.cljc                     | 14 +++-----------
 2 files changed, 4 insertions(+), 15 deletions(-)

diff --git a/perf/malli/perf/creation_perf_test.cljc b/perf/malli/perf/creation_perf_test.cljc
index 7281681b4..c97b6e25d 100644
--- a/perf/malli/perf/creation_perf_test.cljc
+++ b/perf/malli/perf/creation_perf_test.cljc
@@ -70,16 +70,13 @@
 
   ;; 480ns -> 400ns -> 340ns -> 280ns -> 240ns -> 170ns (registry) -> 160ns (recur)
   (p/bench (m/schema :int))
-  (p/profile (m/schema :int))
 
   ;; 44µs -> 31µs -> 18µs -> 11µs -> 9.4µs -> 9.0µs -> 8.5µs -> 7.0µs -> 6.4µs (registry) -> 5.7µs -> 3.4µs
   (p/bench (m/schema ?schema))
-  (p/profile (m/schema ?schema))
 
   ;; does not work with direct linking
   (with-redefs [m/-check-children? (constantly false)]
-    (p/bench (m/schema ?schema))
-    (p/profile (m/schema ?schema))))
+    (p/bench (m/schema ?schema))))
 
 (def ref-schema (m/schema [:schema :int]))
 
diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index aeb9ea120..4c494a976 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -47,8 +47,7 @@
   (-keyset [this]))
 
 (defprotocol Cached
-  (-get-cache [this k])
-  (-set-cache [this k v]))
+  (-cache [this]))
 
 (defn -cached? [x] (#?(:clj instance?, :cljs implements?) malli.core.Cached x))
 
@@ -371,7 +370,7 @@
         child-transformer (if (seq child-transformers) (apply -comp (rseq child-transformers)))]
     (-intercepting parent-transformer child-transformer)))
 
-(defn -cached [s k f] (if (-cached? s) (or (-get-cache s k) (-set-cache s k (f s))) (f s)))
+(defn -cached [s k f] (if (-cached? s) (let [c (-cache s)] (or (@c k) ((swap! c assoc k (f s)) k))) (f s)))
 
 (defn- -register-var [registry v]
   (let [name (-> v meta :name)
@@ -878,19 +877,12 @@
            (-entries [_] (-entry-entries entry-parser))
            (-keyset [_] (-entry-keyset entry-parser))
            Cached
-           (-get-cache [_ k] (@cache k))
-           (-set-cache [_ k v] ((swap! cache assoc k v) k))
+           (-cache [_] cache)
            LensSchema
            (-keep [_] true)
            (-get [this key default] (-get-entries this key default))
            (-set [this key value] (-set-entries this key value))))))))
 
-(defn -memory [] (let [state (atom {})] (fn [k d] @(or (get @state k) ((swap! state assoc k d) k)))))
-
-(let [memory (-memory)]
-  (memory :form (delay "kikka"))
-  (memory :form (delay "kikka")))
-
 (defn -map-of-schema []
   ^{:type ::into-schema}
   (reify IntoSchema

From 683dc1758815c25c4b29d6b0fa953baaab7688df Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Wed, 20 Oct 2021 13:51:41 +0300
Subject: [PATCH 07/25] conditional lazy

---
 src/malli/core.cljc | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 4c494a976..19b5651c0 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -329,7 +329,7 @@
         (-parse-ref-entry e)
         (-fail! ::invalid-ref {:ref e})))))
 
-(defn -entry-parser [?children props options]
+(defn -eager-entry-parser [?children props options]
   (if (-entry-parser? ?children)
     ?children
     (letfn [(-vec [^objects arr] #?(:clj (LazilyPersistentVector/createOwning arr), :cljs (vec arr)))
@@ -353,6 +353,19 @@
             (recur (int (-parse-entry (nth ?children i) naked-keys lazy-refs options i -children -entries -forms -keyset))
                    (unchecked-inc-int ci))))))))
 
+(defn -lazy-entry-parser [?children props options]
+  (let [parser (delay (-eager-entry-parser ?children props options))]
+    (reify EntryParser
+      (-entry-keyset [_] (-entry-keyset @parser))
+      (-entry-children [_] (-entry-children @parser))
+      (-entry-entries [_] (-entry-entries @parser))
+      (-entry-forms [_] (-entry-forms @parser)))))
+
+(defn -entry-parser [?children props options]
+  (cond (-entry-parser? ?children) ?children
+        (or (:lazy props) (::lazy-entries options)) (-lazy-entry-parser ?children props options)
+        :else (-eager-entry-parser ?children props options)))
+
 ;;
 ;; helpers
 ;;

From 8683f2cf48947d442363fa20db2946cbc32b4ff0 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Thu, 21 Oct 2021 14:32:53 +0300
Subject: [PATCH 08/25] wip

---
 src/malli/core.cljc       | 126 +++++++++++++++++++-------------------
 src/malli/util.cljc       |  10 +--
 test/malli/core_test.cljc |   6 +-
 3 files changed, 70 insertions(+), 72 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 19b5651c0..9c39ec6ea 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -42,15 +42,19 @@
   (-parent [this] "returns the IntoSchema instance")
   (-form [this] "returns original form of the schema"))
 
-(defprotocol MapSchema
-  (-entries [this] "returns sequence of `key -val-schema` MapEntries")
-  (-keyset [this]))
+(defprotocol EntryParser
+  (-entry-keyset [this])
+  (-entry-children [this])
+  (-entry-entries [this])
+  (-entry-forms [this]))
+
+(defprotocol EntrySchema
+  (-entries [this] "returns sequence of `key -val-schema` entries")
+  (-entry-parser [this]))
 
 (defprotocol Cached
   (-cache [this]))
 
-(defn -cached? [x] (#?(:clj instance?, :cljs implements?) malli.core.Cached x))
-
 (defprotocol LensSchema
   (-keep [this] "returns truthy if schema contributes to value path")
   (-get [this key default] "returns schema at key")
@@ -60,6 +64,15 @@
   (-ref [this] "returns the reference name")
   (-deref [this] "returns the referenced schema"))
 
+(defprotocol Walker
+  (-accept [this schema path options])
+  (-inner [this schema path options])
+  (-outer [this schema path children options]))
+
+(defprotocol Transformer
+  (-transformer-chain [this] "returns transformer chain as a vector of maps with :name, :encoders, :decoders and :options")
+  (-value-transformer [this schema method options] "returns an value transforming interceptor for the given schema and method"))
+
 (defprotocol RegexSchema
   (-regex-op? [this] "is this a regex operator (e.g. :cat, :*...)")
   (-regex-validator [this] "returns the raw internal regex validator implementation")
@@ -70,6 +83,8 @@
   (-regex-min-max [this] "returns size of the sequence as [min max] vector. nil max means unbuond."))
 
 (defn -ref-schema? [x] (#?(:clj instance?, :cljs implements?) malli.core.RefSchema x))
+(defn -entry-parser? [x] (#?(:clj instance?, :cljs implements?) malli.core.EntryParser x))
+(defn -cached? [x] (#?(:clj instance?, :cljs implements?) malli.core.Cached x))
 
 (extend-type #?(:clj Object, :cljs default)
   RegexSchema
@@ -102,15 +117,6 @@
 
   (-regex-min-max [_] {:min 1, :max 1}))
 
-(defprotocol Walker
-  (-accept [this schema path options])
-  (-inner [this schema path options])
-  (-outer [this schema path children options]))
-
-(defprotocol Transformer
-  (-transformer-chain [this] "returns transformer chain as a vector of maps with :name, :encoders, :decoders and :options")
-  (-value-transformer [this schema method options] "returns an value transforming interceptor for the given schema and method"))
-
 #?(:clj (defmethod print-method SchemaError [v ^java.io.Writer w] (.write w (str "#Error" (->> v (filter val) (into {}))))))
 #?(:clj (defmethod print-method ::into-schema [v ^java.io.Writer w] (.write w (str "#IntoSchema{:type " (pr-str (-type ^IntoSchema v)) "}"))))
 #?(:clj (defmethod print-method ::schema [v ^java.io.Writer w] (.write w (pr-str (-form ^Schema v)))))
@@ -223,14 +229,6 @@
 ;; entries
 ;;
 
-(defprotocol EntryParser
-  (-entry-keyset [this])
-  (-entry-children [this])
-  (-entry-entries [this])
-  (-entry-forms [this]))
-
-(defn -entry-parser? [x] (#?(:clj instance?, :cljs implements?) malli.core.EntryParser x))
-
 (defn -simple-entry-parser [keyset children entries forms]
   (reify EntryParser
     (-entry-keyset [_] keyset)
@@ -330,28 +328,26 @@
         (-fail! ::invalid-ref {:ref e})))))
 
 (defn -eager-entry-parser [?children props options]
-  (if (-entry-parser? ?children)
-    ?children
-    (letfn [(-vec [^objects arr] #?(:clj (LazilyPersistentVector/createOwning arr), :cljs (vec arr)))
-            (-map [^objects arr] #?(:clj (PersistentArrayMap/createWithCheck arr)
-                                    :cljs (let [m (apply array-map arr)]
-                                            (when-not (= (* 2 (count m)) (count arr))
-                                              (-fail! ::duplicate-keys)) m)))
-            (-arange [^objects arr to]
-             #?(:clj (let [-arr (object-array to)] (System/arraycopy arr 0 -arr 0 to) -arr)
-                :cljs (.slice arr 0 to)))]
-      (let [{:keys [naked-keys lazy-refs]} props
-            n (count ?children)
-            -children (object-array n)
-            -entries (object-array n)
-            -forms (object-array n)
-            -keyset (object-array (* 2 n))]
-        (loop [i (int 0), ci (int 0)]
-          (if (== ci n)
-            (let [f (if (== ci i) -vec #(-vec (-arange % i)))]
-              (-simple-entry-parser (-map -keyset) (f -children) (f -entries) (f -forms)))
-            (recur (int (-parse-entry (nth ?children i) naked-keys lazy-refs options i -children -entries -forms -keyset))
-                   (unchecked-inc-int ci))))))))
+  (letfn [(-vec [^objects arr] #?(:clj (LazilyPersistentVector/createOwning arr), :cljs (vec arr)))
+          (-map [^objects arr] #?(:clj (PersistentArrayMap/createWithCheck arr)
+                                  :cljs (let [m (apply array-map arr)]
+                                          (when-not (= (* 2 (count m)) (count arr))
+                                            (-fail! ::duplicate-keys)) m)))
+          (-arange [^objects arr to]
+           #?(:clj (let [-arr (object-array to)] (System/arraycopy arr 0 -arr 0 to) -arr)
+              :cljs (.slice arr 0 to)))]
+    (let [{:keys [naked-keys lazy-refs]} props
+          n (count ?children)
+          -children (object-array n)
+          -entries (object-array n)
+          -forms (object-array n)
+          -keyset (object-array (* 2 n))]
+      (loop [i (int 0), ci (int 0)]
+        (if (== ci n)
+          (let [f (if (== ci i) -vec #(-vec (-arange % i)))]
+            (-simple-entry-parser (-map -keyset) (f -children) (f -entries) (f -forms)))
+          (recur (int (-parse-entry (nth ?children i) naked-keys lazy-refs options i -children -entries -forms -keyset))
+                 (unchecked-inc-int ci)))))))
 
 (defn -lazy-entry-parser [?children props options]
   (let [parser (delay (-eager-entry-parser ?children props options))]
@@ -361,7 +357,7 @@
       (-entry-entries [_] (-entry-entries @parser))
       (-entry-forms [_] (-entry-forms @parser)))))
 
-(defn -entry-parser [?children props options]
+(defn -create-entry-parser [?children props options]
   (cond (-entry-parser? ?children) ?children
         (or (:lazy props) (::lazy-entries options)) (-lazy-entry-parser ?children props options)
         :else (-eager-entry-parser ?children props options)))
@@ -649,7 +645,7 @@
     (-children-schema [_ _])
     (-into-schema [parent properties children options]
       (-check-children! :orn properties children 1 nil)
-      (let [entry-parser (-entry-parser children {:naked-keys true} options)
+      (let [entry-parser (-create-entry-parser children {:naked-keys true} options)
             form (delay (-create-form :orn properties (-entry-forms entry-parser)))]
         ^{:type ::schema
           ::entry-parser entry-parser}
@@ -709,9 +705,9 @@
           (-children [_] (-entry-children entry-parser))
           (-parent [_] parent)
           (-form [_] @form)
-          MapSchema
+          EntrySchema
           (-entries [_] (-entry-entries entry-parser))
-          (-keyset [_] (-entry-keyset entry-parser))
+          (-entry-parser [_] entry-parser)
           LensSchema
           (-keep [_] true)
           (-get [this key default] (-get-entries this key default))
@@ -804,9 +800,9 @@
      (-properties-schema [_ _])
      (-children-schema [_ _])
      (-into-schema [parent {:keys [closed] :as properties} children options]
-       (let [entry-parser (-entry-parser children opts options)
+       (let [entry-parser (-create-entry-parser children opts options)
              cache (atom {})
-             ->parser (fn [this f] (let [keyset (-keyset this)
+             ->parser (fn [this f] (let [keyset (-entry-keyset (-entry-parser this))
                                          parsers (cond-> (mapv
                                                       (fn [[key {:keys [optional]} schema]]
                                                         (let [parser (f schema)]
@@ -829,7 +825,8 @@
          (reify
            Schema
            (-validator [this]
-             (let [validators (cond-> (mapv
+             (let [keyset (-entry-keyset (-entry-parser this))
+                   validators (cond-> (mapv
                                         (fn [[key {:keys [optional]} value]]
                                           (let [valid? (-validator value)
                                                 default (boolean optional)]
@@ -838,13 +835,14 @@
                                         (-children this))
                                       closed (into [(fn [m]
                                                       (reduce
-                                                        (fn [acc k] (if (contains? (-keyset this) k) acc (reduced false)))
+                                                        (fn [acc k] (if (contains? keyset k) acc (reduced false)))
                                                         true (keys m)))]))
                    validate #?(:clj (miu/-every-pred validators)
                                :cljs (fn [m] (boolean (reduce #(or (%2 m) (reduced false)) true validators))))]
                (fn [m] (and (map? m) (validate m)))))
            (-explainer [this path]
-             (let [explainers (cond-> (mapv
+             (let [keyset (-entry-keyset (-entry-parser this))
+                   explainers (cond-> (mapv
                                         (fn [[key {:keys [optional]} schema]]
                                           (let [explainer (-explainer schema (conj path key))]
                                             (fn [x in acc]
@@ -857,7 +855,7 @@
                                       closed (into [(fn [x in acc]
                                                       (reduce
                                                         (fn [acc k]
-                                                          (if (contains? (-keyset this) k)
+                                                          (if (contains? keyset k)
                                                             acc
                                                             (conj acc (miu/-error (conj path k) (conj in k) this nil ::extra-key))))
                                                         acc (keys x)))]))]
@@ -886,9 +884,9 @@
            (-children [_] (-entry-children entry-parser))
            (-parent [_] parent)
            (-form [_] (-create-form :map properties (-entry-forms entry-parser)))
-           MapSchema
+           EntrySchema
            (-entries [_] (-entry-entries entry-parser))
-           (-keyset [_] (-entry-keyset entry-parser))
+           (-entry-parser [_] entry-parser)
            Cached
            (-cache [_] cache)
            LensSchema
@@ -1292,7 +1290,7 @@
      (-into-schema [parent properties children options]
        (let [type (or (:type opts) :multi)
              opts' (merge opts (select-keys properties [:lazy-refs]))
-             entry-parser (-entry-parser children opts' options)
+             entry-parser (-create-entry-parser children opts' options)
              form (delay (-create-form type properties (-entry-forms entry-parser)))
              dispatch (eval (:dispatch properties) options)
              dispatch-map (->> (for [[k s] (-entry-entries entry-parser)] [k s]) (into {}))
@@ -1337,9 +1335,9 @@
            (-children [_] (-entry-children entry-parser))
            (-parent [_] parent)
            (-form [_] @form)
-           MapSchema
+           EntrySchema
            (-entries [_] (-entry-entries entry-parser))
-           (-keyset [_] (-entry-keyset entry-parser))
+           (-entry-parser [_] entry-parser)
            LensSchema
            (-keep [_])
            (-get [this key default] (-get-entries this key default))
@@ -1644,7 +1642,7 @@
     (-children-schema [_ _])
     (-into-schema [parent properties children options]
       (-check-children! type properties children min max)
-      (let [entry-parser (-entry-parser children opts options)
+      (let [entry-parser (-create-entry-parser children opts options)
             form (delay (-create-form type properties (-entry-forms entry-parser)))]
         ^{:type ::schema
           ::entry-parser entry-parser}
@@ -1667,9 +1665,9 @@
           (-keep [_] true)
           (-get [this key default] (-get-entries this key default))
           (-set [this key value] (-set-entries this key value))
-          MapSchema
+          EntrySchema
           (-entries [_] (-entry-entries entry-parser))
-          (-keyset [_] (-entry-keyset entry-parser))
+          (-entry-parser [_] entry-parser)
           RegexSchema
           (-regex-op? [_] true)
           (-regex-validator [this] (re-validator properties (map (fn [[k _ s]] [k (-regex-validator s)]) (-children this))))
@@ -1924,7 +1922,7 @@
      value)))
 
 (defn entries
-  "Returns `MapSchema` children as a sequence of `clojure.lang/MapEntry`s
+  "Returns `EntrySchema` children as a sequence of `clojure.lang/MapEntry`s
    where the values child schemas wrapped in `:malli.core/val` Schemas,
    with the entry properties as properties.
 
@@ -1950,7 +1948,7 @@
    (entries ?schema nil))
   ([?schema options]
    (if-let [schema (schema ?schema options)]
-     (if (#?(:clj instance?, :cljs implements?) malli.core.MapSchema schema)
+     (if (#?(:clj instance?, :cljs implements?) malli.core.EntrySchema schema)
        (-entries schema)))))
 
 (defn deref
diff --git a/src/malli/util.cljc b/src/malli/util.cljc
index da7bb6b70..0ccd3750f 100644
--- a/src/malli/util.cljc
+++ b/src/malli/util.cljc
@@ -183,7 +183,7 @@
     @state))
 
 ;;
-;; MapSchemas
+;; EntrySchemas
 ;;
 
 (defn transform-entries
@@ -220,7 +220,7 @@
      (transform-entries ?schema #(map mapper %) options))))
 
 (defn select-keys
-  "Like [[clojure.core/select-keys]], but for MapSchemas."
+  "Like [[clojure.core/select-keys]], but for EntrySchemas."
   ([?schema keys]
    (select-keys ?schema keys nil))
   ([?schema keys options]
@@ -228,7 +228,7 @@
      (transform-entries ?schema #(filter (fn [[k]] (key-set k)) %) options))))
 
 (defn rename-keys
-  "Like [[clojure.set/rename-keys]], but for MapSchemas. Collisions are resolved in favor of the renamed key, like `assoc`-ing."
+  "Like [[clojure.set/rename-keys]], but for EntrySchemas. Collisions are resolved in favor of the renamed key, like `assoc`-ing."
   ([?schema kmap]
    (rename-keys ?schema kmap nil))
   ([?schema kmap options]
@@ -243,14 +243,14 @@
      options)))
 
 (defn dissoc
-  "Like [[clojure.core/dissoc]], but for MapSchemas."
+  "Like [[clojure.core/dissoc]], but for EntrySchemas."
   ([?schema key]
    (dissoc ?schema key nil))
   ([?schema key options]
    (transform-entries ?schema #(remove (fn [[k]] (= key k)) %) options)))
 
 (defn find
-  "Like [[clojure.core/find]], but for MapSchemas."
+  "Like [[clojure.core/find]], but for EntrySchemas."
   ([?schema k]
    (find ?schema k nil))
   ([?schema k options]
diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc
index e79f69ca3..2aecc5f3b 100644
--- a/test/malli/core_test.cljc
+++ b/test/malli/core_test.cljc
@@ -40,7 +40,7 @@
   (is (= "abba" (m/-keyword->string "abba"))))
 
 (deftest parse-entries-test
-  (let [entry-parser (m/-entry-parser
+  (let [entry-parser (m/-create-entry-parser
                       [[:x int?]
                        ::x
                        "x"
@@ -71,12 +71,12 @@
              (map #(update % 2 m/form) (m/-entry-children entry-parser))))))
   (testing "duplicate keys"
     (is (thrown? #?(:clj Exception, :cljs js/Error)
-                 (m/-entry-parser
+                 (m/-create-entry-parser
                    [[:x int?]
                     [:x boolean?]] {:naked-keys true} nil))))
   (testing "naked keys fails when not supported"
     (is (thrown? #?(:clj Exception, :cljs js/Error)
-                 (m/-entry-parser
+                 (m/-create-entry-parser
                    [::x] nil nil)))))
 
 (deftest eval-test

From f867f5e19b242d6291c98c21d06fc88aaadb88b1 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Fri, 22 Oct 2021 13:38:37 +0300
Subject: [PATCH 09/25] cleanup

---
 src/malli/core.cljc | 24 +++++++++---------------
 1 file changed, 9 insertions(+), 15 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 9c39ec6ea..453922581 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -84,6 +84,7 @@
 
 (defn -ref-schema? [x] (#?(:clj instance?, :cljs implements?) malli.core.RefSchema x))
 (defn -entry-parser? [x] (#?(:clj instance?, :cljs implements?) malli.core.EntryParser x))
+(defn -entry-schema? [x] (#?(:clj instance?, :cljs implements?) malli.core.EntrySchema x))
 (defn -cached? [x] (#?(:clj instance?, :cljs implements?) malli.core.Cached x))
 
 (extend-type #?(:clj Object, :cljs default)
@@ -203,15 +204,13 @@
 (defn -inner-entries [walker path entries options]
   (mapv (fn [[k s]] [k (-properties s) (-inner walker s (conj path k) options)]) entries))
 
-(defn -parsed [s] (-> s meta ::entry-parser))
-
 (defn -set-children [schema children]
   (if (-equals children (-children schema))
     schema (-into-schema (-parent schema) (-properties schema) children (-options schema))))
 
 (defn -set-properties [schema properties]
   (if (-equals properties (-properties schema))
-    schema (-into-schema (-parent schema) properties (or (-parsed schema) (-children schema)) (-options schema))))
+    schema (-into-schema (-parent schema) properties (or (and (-entry-schema? schema) (-entry-parser schema)) (-children schema)) (-options schema))))
 
 (defn -update-options [schema f]
   (-into-schema (-parent schema) (-properties schema) (-children schema) (f (-options schema))))
@@ -261,7 +260,7 @@
 
 (defn -set-entries
   ([schema ?key value]
-   (if-let [entry-parser (-parsed schema)]
+   (if-let [entry-parser (-entry-parser schema)]
      (-set-children schema (-update-parsed entry-parser ?key value (-options schema)))
      (let [found (atom nil)
            [key props override] (if (vector? ?key) [(nth ?key 0) (second ?key) true] [?key])
@@ -647,8 +646,7 @@
       (-check-children! :orn properties children 1 nil)
       (let [entry-parser (-create-entry-parser children {:naked-keys true} options)
             form (delay (-create-form :orn properties (-entry-forms entry-parser)))]
-        ^{:type ::schema
-          ::entry-parser entry-parser}
+        ^{:type ::schema}
         (reify
           Schema
           (-validator [this]
@@ -820,8 +818,7 @@
                                                                       (fn [m k] (if (contains? keyset k) m (reduced (reduced ::invalid))))
                                                                       m (keys m)))]))]
                                 (fn [x] (if (map? x) (reduce (fn [m parser] (parser m)) x parsers) ::invalid))))]
-         ^{:type ::schema
-           ::entry-parser entry-parser}
+         ^{:type ::schema}
          (reify
            Schema
            (-validator [this]
@@ -1297,8 +1294,7 @@
              finder (fn [{:keys [::default] :as m}] (fn [x] (m x default)))]
          (when-not dispatch
            (-fail! ::missing-property {:key :dispatch}))
-         ^{:type ::schema
-           ::entry-parser entry-parser}
+         ^{:type ::schema}
          (reify
            Schema
            (-validator [_]
@@ -1346,7 +1342,7 @@
 (defn -ref-schema
   ([]
    (-ref-schema nil))
-  ([{:keys [lazy type-properties] :as opts}]
+  ([{:keys [lazy type-properties]}]
    ^{:type ::into-schema}
    (reify IntoSchema
      (-type [_] :ref)
@@ -1644,8 +1640,7 @@
       (-check-children! type properties children min max)
       (let [entry-parser (-create-entry-parser children opts options)
             form (delay (-create-form type properties (-entry-forms entry-parser)))]
-        ^{:type ::schema
-          ::entry-parser entry-parser}
+        ^{:type ::schema}
         (reify
           Schema
           (-validator [this] (regex-validator this))
@@ -1948,8 +1943,7 @@
    (entries ?schema nil))
   ([?schema options]
    (if-let [schema (schema ?schema options)]
-     (if (#?(:clj instance?, :cljs implements?) malli.core.EntrySchema schema)
-       (-entries schema)))))
+     (if (-entry-schema? schema) (-entries schema)))))
 
 (defn deref
   "Derefs top-level `RefSchema`s or returns original Schema."

From d001f7851495e507ac608a58fac3c30d4dd2c83b Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Fri, 22 Oct 2021 13:46:49 +0300
Subject: [PATCH 10/25] re-run perf-tests

---
 perf/malli/perf/creation_perf_test.cljc | 33 +++++++++++--------------
 1 file changed, 14 insertions(+), 19 deletions(-)

diff --git a/perf/malli/perf/creation_perf_test.cljc b/perf/malli/perf/creation_perf_test.cljc
index c97b6e25d..e0e9b2588 100644
--- a/perf/malli/perf/creation_perf_test.cljc
+++ b/perf/malli/perf/creation_perf_test.cljc
@@ -15,7 +15,6 @@
   ;; 3.2µs (mapv childs)
   ;; 2.5µs (...)
   (p/bench (m/validate [:or :int :string] 42))
-  (p/profile (m/validate [:or :int :string] 42))
 
   ;; 3.0µs
   ;; 500ns (delayed mapv childs)
@@ -27,7 +26,6 @@
   ;; 1.1µs (mapv childs)
   ;; 750ns (...)
   (p/bench (m/schema [:or :int :string]))
-  (p/profile (m/schema [:or :int :string]))
 
   ;; 1.7µs
   ;; 470ns (map childs)
@@ -37,18 +35,15 @@
   ;; 1.1µs (mapv childs)
   ;; 750ns (...)
   (p/bench (m/schema [:and :int :string]))
-  (p/profile (m/schema [:and :int :string]))
 
   ;; 1.7µs
   ;; 1.5µs (fast parse)
   (let [schema (m/schema [:or :int :string])]
-    (p/bench (m/validator schema))
-    #_(p/profile (m/validator schema)))
+    (p/bench (m/validator schema)))
 
   ;; 4ns
   (let [validate (m/validator [:or :int :string])]
-    (p/bench (validate 42))
-    #_(p/profile (validate 42))))
+    (p/bench (validate 42))))
 
 (def ?schema
   [:map
@@ -71,9 +66,14 @@
   ;; 480ns -> 400ns -> 340ns -> 280ns -> 240ns -> 170ns (registry) -> 160ns (recur)
   (p/bench (m/schema :int))
 
-  ;; 44µs -> 31µs -> 18µs -> 11µs -> 9.4µs -> 9.0µs -> 8.5µs -> 7.0µs -> 6.4µs (registry) -> 5.7µs -> 3.4µs
+  ;; 44µs -> 31µs -> 18µs -> 11µs -> 9.4µs -> 9.0µs -> 8.5µs -> 7.0µs -> 6.4µs (registry) -> 5.7µs
+  ;; 3.4µs
+  ;; 2.9µs (-entry-parser)
   (p/bench (m/schema ?schema))
 
+  ;; 240ns
+  (p/bench (m/schema ?schema {::m/lazy-entries true}))
+
   ;; does not work with direct linking
   (with-redefs [m/-check-children? (constantly false)]
     (p/bench (m/schema ?schema))))
@@ -84,11 +84,9 @@
 
   ;; 14ns -> 5ns
   (p/bench (m/deref ref-schema))
-  (p/profile (m/deref ref-schema))
 
   ;; 5µs -> 28ns
-  (p/bench (m/deref-all ref-schema))
-  (p/profile (m/deref-all ref-schema)))
+  (p/bench (m/deref-all ref-schema)))
 
 (comment
 
@@ -98,14 +96,13 @@
 
   ;; 271ns
   ;; 14ns (-set-children, -set-properties)
+  ;; 12ns (-entry-parser)
   (p/bench (m/walk leaf-schema (m/schema-walker identity)))
-  (p/profile (m/walk leaf-schema (m/schema-walker identity)))
 
   ;; 26µs
   ;; 1.3µs (-set-children, -set-properties)
   ;; 1.2µs (protocols, registry, recur)
   (p/bench (m/walk schema (m/schema-walker identity)))
-  (p/profile (m/walk schema (m/schema-walker identity)))
 
   ;; 51µs
   ;; 44µs (-set-children, -set-properties)
@@ -116,26 +113,25 @@
   ;; 6.5µs (schema)
   ;; 5.8µs (protocols, registry, recur, parsed)
   ;; 3.9µs (-parsed)
+  ;; 3.6µs (-entry-parser)
   (p/bench (mu/closed-schema schema))
-  (p/profile (mu/closed-schema schema))
 
   ;; 3.8µs
   ;; 3.4µs (satisfies?)
   ;; 2.2µs (-set-entries)
   ;; 830ns (-update-parsed)
+  ;; 560ns (-entry-parser)
   (p/bench (mu/assoc schema :y :string))
-  (p/profile (mu/assoc schema :y :string))
 
   ;; 4.2µs
   ;; 3.8µs (satisfies?)
   ;; 820ns (-update-parsed)
+  ;; 580ns (-entry-parser)
   (p/bench (mu/assoc schema :w :string))
-  (p/profile (mu/assoc schema :w :string))
 
   ;; 205ns
   ;; 195ns
   (p/bench (mu/get schema :y))
-  (p/profile (mu/get schema :y))
 
   ;; 13µs
   ;; 2.4µs (satisfies?)
@@ -159,8 +155,7 @@
     ;; 341ns (-create-form)
     ;; 150ns (delayed form)
     ;;  30ns (don't -check-children)
-    (p/bench (m/-val-schema s nil))
-    (p/profile (m/-val-schema s nil))))
+    (p/bench (m/-val-schema s nil))))
 
 (comment
   "clojurescript perf tests"

From 6606a669909d8fc37d1ef3cbff6cf5e65677978a Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Fri, 22 Oct 2021 14:25:04 +0300
Subject: [PATCH 11/25] cache all the things

---
 src/malli/core.cljc | 181 +++++++++++++++++++++++++++-----------------
 1 file changed, 113 insertions(+), 68 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 453922581..06412dc2b 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -365,6 +365,8 @@
 ;; helpers
 ;;
 
+(defn -create-cache [_options] (atom {}))
+
 (defn -guard [pred tf]
   (when tf (fn [x] (if (pred x) (tf x) x))))
 
@@ -471,9 +473,7 @@
       (and max f) (fn [x] (<= (f x) max))
       max (fn [x] (<= x max)))))
 
-(defn -validate-limits
-  [min max]
-  (or ((-min-max-pred count) {:min min :max max}) (constantly true)))
+(defn -validate-limits [min max] (or ((-min-max-pred count) {:min min :max max}) (constantly true)))
 
 (defn -qualified-keyword-pred [properties]
   (when-let [ns-name (some-> properties :namespace name)]
@@ -494,18 +494,21 @@
       (-into-schema [parent properties children options]
         (if (fn? ?props)
           (-into-schema (-simple-schema (?props properties children)) properties children options)
-          (let [_ (-check-children! type properties children min max)
-                pvalidator (if property-pred (property-pred properties))
-                validator (if pvalidator (fn [x] (and (pred x) (pvalidator x))) pred)
-                form (delay (-create-form type properties children))]
+          (let [cache (-create-cache options)]
+            (-check-children! type properties children min max)
             ^{:type ::schema}
             (reify
               Schema
-              (-validator [_] validator)
+              (-validator [_]
+                (let [pvalidator (if property-pred (property-pred properties))]
+                  (if pvalidator (fn [x] (and (pred x) (pvalidator x))) pred)))
               (-explainer [this path]
-                (fn explain [x in acc]
-                  (if-not (validator x) (conj acc (miu/-error path in this x)) acc)))
-              (-parser [_] (fn [x] (if (validator x) x ::invalid)))
+                (let [validator (-validator this)]
+                  (fn explain [x in acc]
+                    (if-not (validator x) (conj acc (miu/-error path in this x)) acc))))
+              (-parser [this]
+                (let [validator (-validator this)]
+                  (fn [x] (if (validator x) x ::invalid))))
               (-unparser [this] (-parser this))
               (-transformer [this transformer method options]
                 (-intercepting (-value-transformer transformer this method options)))
@@ -516,7 +519,9 @@
               (-options [_] options)
               (-children [_] children)
               (-parent [_] parent)
-              (-form [_] @form)
+              (-form [_] (-create-form type properties children))
+              Cached
+              (-cache [_] cache)
               LensSchema
               (-keep [_])
               (-get [_ _ default] default)
@@ -544,7 +549,7 @@
     (-into-schema [parent properties children options]
       (-check-children! :and properties children 1 nil)
       (let [children (into [] (map #(schema % options)) children)
-            form (delay (-create-form :and properties (map -form children)))
+            cache (-create-cache options)
             ->parser (fn [f m] (let [parsers (m (mapv f children))]
                                  #(reduce (fn [x parser] (miu/-map-invalid reduced (parser x))) % parsers)))]
         ^{:type ::schema}
@@ -568,7 +573,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :and properties (map -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -584,7 +591,7 @@
     (-into-schema [parent properties children options]
       (-check-children! :or properties children 1 nil)
       (let [children (into [] (map #(schema % options)) children)
-            form (delay (-create-form :or properties (map -form children)))
+            cache (-create-cache options)
             ->parser (fn [f] (let [parsers (mapv f children)]
                                #(reduce (fn [_ parser] (miu/-map-valid reduced (parser %))) ::invalid parsers)))]
         ^{:type ::schema}
@@ -629,7 +636,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :or properties (map -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -645,7 +654,7 @@
     (-into-schema [parent properties children options]
       (-check-children! :orn properties children 1 nil)
       (let [entry-parser (-create-entry-parser children {:naked-keys true} options)
-            form (delay (-create-form :orn properties (-entry-forms entry-parser)))]
+            cache (-create-cache options)]
         ^{:type ::schema}
         (reify
           Schema
@@ -702,10 +711,12 @@
           (-options [_] options)
           (-children [_] (-entry-children entry-parser))
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :orn properties (-entry-forms entry-parser)))
           EntrySchema
           (-entries [_] (-entry-entries entry-parser))
           (-entry-parser [_] entry-parser)
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_] true)
           (-get [this key default] (-get-entries this key default))
@@ -721,16 +732,18 @@
     (-into-schema [parent properties children options]
       (-check-children! :not properties children 1 1)
       (let [[schema :as children] (map #(schema % options) children)
-            validator (complement (-validator schema))
-            form (delay (-create-form :not properties (map -form children)))]
+            cache (-create-cache options)]
         ^{:type ::schema}
         (reify
           Schema
-          (-validator [_] validator)
+          (-validator [_] (complement (-validator schema)))
           (-explainer [this path]
-            (fn explain [x in acc]
-              (if-not (validator x) (conj acc (miu/-error (conj path 0) in this x)) acc)))
-          (-parser [_] (fn [x] (if (validator x) x ::invalid)))
+            (let [validator (-validator this)]
+              (fn explain [x in acc]
+                (if-not (validator x) (conj acc (miu/-error (conj path 0) in this x)) acc))))
+          (-parser [this]
+            (let [validator (-validator this)]
+              (fn [x] (if (validator x) x ::invalid))))
           (-unparser [this] (-parser this))
           (-transformer [this transformer method options]
             (-parent-children-transformer this children transformer method options))
@@ -741,7 +754,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :not properties (map -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -760,7 +775,7 @@
      (-into-schema [parent properties children options]
        #_(-check-children! ::val properties children 1 1)
        (let [schema (schema (first children) options)
-             form (delay (-create-form ::val properties [(-form schema)]))]
+             cache (-create-cache options)]
          ^{:type ::schema}
          (reify Schema
            (-validator [_] (-validator schema))
@@ -778,7 +793,9 @@
            (-options [_] (-options schema))
            (-children [_] [schema])
            (-parent [_] parent)
-           (-form [_] @form)
+           (-form [_] (-create-form ::val properties [(-form schema)]))
+           Cached
+           (-cache [_] cache)
            LensSchema
            (-keep [_])
            (-get [_ key default] (if (= 0 key) schema default))
@@ -790,7 +807,7 @@
 (defn -map-schema
   ([]
    (-map-schema {:naked-keys true}))
-  ([opts] ;; :naked-keys
+  ([opts] ;; :naked-keys, :lazy
    ^{:type ::into-schema}
    (reify IntoSchema
      (-type [_] :map)
@@ -799,7 +816,7 @@
      (-children-schema [_ _])
      (-into-schema [parent {:keys [closed] :as properties} children options]
        (let [entry-parser (-create-entry-parser children opts options)
-             cache (atom {})
+             cache (-create-cache options)
              ->parser (fn [this f] (let [keyset (-entry-keyset (-entry-parser this))
                                          parsers (cond-> (mapv
                                                       (fn [[key {:keys [optional]} schema]]
@@ -901,7 +918,7 @@
     (-into-schema [parent {:keys [min max] :as properties} children options]
       (-check-children! :map-of properties children 2 2)
       (let [[key-schema value-schema :as children] (mapv #(schema % options) children)
-            form (delay (-create-form :map-of properties (mapv -form children)))
+            cache (-create-cache options)
             validate-limits (-validate-limits min max)
             ->parser (fn [f] (let [key-parser (f key-schema)
                                    value-parser (f value-schema)]
@@ -964,7 +981,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :map-of properties (mapv -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -985,7 +1004,7 @@
             (reset! props* ?props)
             (-check-children! type properties children 1 1)
             (let [[schema :as children] (mapv #(schema % options) children)
-                  form (delay (-create-form type properties (map -form children)))
+                  cache (-create-cache options)
                   validate-limits (-validate-limits min max)
                   ->parser (fn [f] (let [child-parser (f schema)]
                                      (fn [x]
@@ -1039,7 +1058,9 @@
                 (-options [_] options)
                 (-children [_] children)
                 (-parent [_] parent)
-                (-form [_] @form)
+                (-form [_] (-create-form type properties (map -form children)))
+                Cached
+                (-cache [_] cache)
                 LensSchema
                 (-keep [_] true)
                 (-get [_ _ _] schema)
@@ -1055,7 +1076,7 @@
     (-into-schema [parent properties children options]
       (let [children (into [] (map #(schema % options)) children)
             size (count children)
-            form (delay (-create-form :tuple properties (map -form children)))
+            cache (-create-cache options)
             ->parser (fn [f] (let [parsers (into {} (comp (map f) (map-indexed vector)) children)]
                                (fn [x]
                                  (cond
@@ -1105,7 +1126,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :tuple properties (map -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_] true)
           (-get [_ key default] (get children key default))
@@ -1120,7 +1143,7 @@
       (-check-children! :enum properties children 1 nil)
       (let [children (vec children)
             schema (set children)
-            form (delay (-create-form :enum properties children))]
+            cache (-create-cache options)]
         ^{:type ::schema}
         (reify
           Schema
@@ -1141,7 +1164,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :enum properties children))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -1158,7 +1183,7 @@
       (-check-children! :re properties children 1 1)
       (let [children (vec children)
             re (re-pattern child)
-            form (delay (if class? re (-create-form :re properties children)))]
+            cache (-create-cache options)]
         ^{:type ::schema}
         (reify
           Schema
@@ -1185,7 +1210,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (if class? re (-create-form :re properties children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -1200,7 +1227,7 @@
       (-check-children! :fn properties children 1 1)
       (let [children (vec children)
             f (eval (first children) options)
-            form (delay (-create-form :fn properties children))]
+            cache (-create-cache options)]
         ^{:type ::schema}
         (reify
           Schema
@@ -1226,7 +1253,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :fn properties children))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -1242,19 +1271,19 @@
     (-into-schema [parent properties children options]
       (-check-children! :maybe properties children 1 1)
       (let [[schema :as children] (map #(schema % options) children)
-            form (delay (-create-form :maybe properties (map -form children)))
+            cache (-create-cache options)
             ->parser (fn [f] (let [parser (f schema)]
                                (fn [x] (if (nil? x) x (parser x)))))]
         ^{:type ::schema}
         (reify
           Schema
           (-validator [_]
-            (let [validator' (-validator schema)]
-              (fn [x] (or (nil? x) (validator' x)))))
+            (let [validator (-validator schema)]
+              (fn [x] (or (nil? x) (validator x)))))
           (-explainer [_ path]
-            (let [explainer' (-explainer schema (conj path 0))]
+            (let [explainer (-explainer schema (conj path 0))]
               (fn explain [x in acc]
-                (if (nil? x) acc (explainer' x in acc)))))
+                (if (nil? x) acc (explainer x in acc)))))
           (-parser [_] (->parser -parser))
           (-unparser [_] (->parser -unparser))
           (-transformer [this transformer method options]
@@ -1266,7 +1295,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :maybe properties (map -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (if (= 0 key) schema default))
@@ -1288,9 +1319,9 @@
        (let [type (or (:type opts) :multi)
              opts' (merge opts (select-keys properties [:lazy-refs]))
              entry-parser (-create-entry-parser children opts' options)
-             form (delay (-create-form type properties (-entry-forms entry-parser)))
+             cache (-create-cache options)
              dispatch (eval (:dispatch properties) options)
-             dispatch-map (->> (for [[k s] (-entry-entries entry-parser)] [k s]) (into {}))
+             dispatch-map (delay (->> (for [[k s] (-entry-entries entry-parser)] [k s]) (into {})))
              finder (fn [{:keys [::default] :as m}] (fn [x] (m x default)))]
          (when-not dispatch
            (-fail! ::missing-property {:key :dispatch}))
@@ -1298,7 +1329,7 @@
          (reify
            Schema
            (-validator [_]
-             (let [find (finder (reduce-kv (fn [acc k s] (assoc acc k (-validator s))) {} dispatch-map))]
+             (let [find (finder (reduce-kv (fn [acc k s] (assoc acc k (-validator s))) {} @dispatch-map))]
                (fn [x] (if-let [validator (find (dispatch x))] (validator x) false))))
            (-explainer [this path]
              (let [find (finder (reduce (fn [acc [k s]] (assoc acc k (-explainer s (conj path k)))) {} (-entries this)))
@@ -1309,17 +1340,17 @@
                    (conj acc (miu/-error (->path path) (->path in) this x ::invalid-dispatch-value))))))
            (-parser [_]
              (let [parse (fn [k s] (let [p (-parser s)] (fn [x] (miu/-map-valid #(miu/-tagged k %) (p x)))))
-                   find (finder (reduce-kv (fn [acc k s] (assoc acc k (parse k s))) {} dispatch-map))]
+                   find (finder (reduce-kv (fn [acc k s] (assoc acc k (parse k s))) {} @dispatch-map))]
                (fn [x] (if-some [parser (find (dispatch x))] (parser x) ::invalid))))
            (-unparser [_]
-             (let [unparsers (reduce-kv (fn [acc k s] (assoc acc k (-unparser s))) {} dispatch-map)]
+             (let [unparsers (reduce-kv (fn [acc k s] (assoc acc k (-unparser s))) {} @dispatch-map)]
                (fn [x] (if (miu/-tagged? x) (if-some [f (unparsers (key x))] (f (val x)) ::invalid) ::invalid))))
            (-transformer [this transformer method options]
              ;; FIXME: Probably should not use `dispatch`
              ;; Can't use `dispatch` as `x` might not be valid before it has been unparsed:
              (let [this-transformer (-value-transformer transformer this method options)
                    ->children (reduce-kv (fn [acc k s] (let [t (-transformer s transformer method options)]
-                                                         (cond-> acc t (assoc k t)))) {} dispatch-map)
+                                                         (cond-> acc t (assoc k t)))) {} @dispatch-map)
                    find (finder ->children)
                    child-transformer (if (seq ->children) (fn [x] (if-some [t (find (dispatch x))] (t x) x)))]
                (-intercepting this-transformer child-transformer)))
@@ -1330,10 +1361,12 @@
            (-options [_] options)
            (-children [_] (-entry-children entry-parser))
            (-parent [_] parent)
-           (-form [_] @form)
+           (-form [_] (-create-form type properties (-entry-forms entry-parser)))
            EntrySchema
            (-entries [_] (-entry-entries entry-parser))
            (-entry-parser [_] entry-parser)
+           Cached
+           (-cache [_] cache)
            LensSchema
            (-keep [_])
            (-get [this key default] (-get-entries this key default))
@@ -1356,7 +1389,7 @@
                       (when-not allow-invalid-refs
                         (-fail! ::invalid-ref {:type :ref, :ref ref})))
              children (vec children)
-             form (delay (-create-form :ref properties children))
+             cache (-create-cache options)
              ->parser (fn [f] (let [parser (-memoize (fn [] (f (-ref))))]
                                 (fn [x] ((parser) x))))]
          ^{:type ::schema}
@@ -1386,7 +1419,9 @@
            (-options [_] options)
            (-children [_] children)
            (-parent [_] parent)
-           (-form [_] @form)
+           (-form [_] (-create-form :ref properties children))
+           Cached
+           (-cache [_] cache)
            LensSchema
            (-get [_ key default] (if (= key 0) (-pointer ref (-ref) options) default))
            (-keep [_])
@@ -1417,8 +1452,7 @@
         (-check-children! type properties children 1 1)
         (let [children (into [] (map #(schema % options)) children)
               child (nth children 0)
-              form (delay (or (and (empty? properties) (or id (and raw (-form child))))
-                              (-create-form type properties [(-form child)])))]
+              cache (-create-cache options)]
           ^{:type ::schema}
           (reify
             Schema
@@ -1437,7 +1471,10 @@
             (-options [_] options)
             (-children [_] children)
             (-parent [_] parent)
-            (-form [_] @form)
+            (-form [_] (or (and (empty? properties) (or id (and raw (-form child))))
+                           (-create-form type properties [(-form child)])))
+            Cached
+            (-cache [_] cache)
             LensSchema
             (-keep [_])
             (-get [_ key default] (if (= key 0) child default))
@@ -1479,7 +1516,7 @@
     (-into-schema [parent properties children {::keys [function-checker] :as options}]
       (-check-children! :=> properties children 2 2)
       (let [[input :as children] (map #(schema % options) children)
-            form (delay (-create-form :=> properties (map -form children)))
+            cache (-create-cache options)
             ->checker (if function-checker #(function-checker % options) (constantly nil))]
         (when-not (#{:cat :catn} (type input))
           (-fail! ::invalid-input-schema {:input input}))
@@ -1513,7 +1550,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :=> properties (map -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [_ key default] (get children key default))
@@ -1529,7 +1568,7 @@
     (-into-schema [parent properties children {::keys [function-checker] :as options}]
       (-check-children! :function properties children 1 nil)
       (let [children (into [] (map #(schema % options)) children)
-            form (delay (-create-form :function properties (map -form children)))
+            cache (-create-cache options)
             ->checker (if function-checker #(function-checker % options) (constantly nil))]
         (when-not (every? #(= :=> (type %)) children)
           (-fail! ::non-function-childs {:children children}))
@@ -1568,7 +1607,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form :function properties (map -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_])
           (-get [this key default] (get children key default))
@@ -1595,8 +1636,8 @@
     (-children-schema [_ _])
     (-into-schema [parent properties children options]
       (-check-children! type properties children min max)
-      (let [children (mapv #(schema % options) children)
-            form (delay (-create-form type properties (mapv -form children)))]
+      (let [children (into [] (map #(schema % options)) children)
+            cache (-create-cache options)]
         ^{:type ::schema}
         (reify
           Schema
@@ -1612,7 +1653,9 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form type properties (mapv -form children)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_] true)
           (-get [_ key default] (get children key default))
@@ -1639,7 +1682,7 @@
     (-into-schema [parent properties children options]
       (-check-children! type properties children min max)
       (let [entry-parser (-create-entry-parser children opts options)
-            form (delay (-create-form type properties (-entry-forms entry-parser)))]
+            cache (-create-cache options)]
         ^{:type ::schema}
         (reify
           Schema
@@ -1655,7 +1698,9 @@
           (-options [_] options)
           (-children [_] (-entry-children entry-parser))
           (-parent [_] parent)
-          (-form [_] @form)
+          (-form [_] (-create-form type properties (-entry-forms entry-parser)))
+          Cached
+          (-cache [_] cache)
           LensSchema
           (-keep [_] true)
           (-get [this key default] (-get-entries this key default))

From 454c936cdbe5a91d48cb6c86167b4ba70b7b8d2f Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Fri, 22 Oct 2021 17:01:44 +0300
Subject: [PATCH 12/25] -vmap, more bench

---
 perf/malli/perf/creation_perf_test.cljc | 13 ++++++++++++-
 src/malli/core.cljc                     | 20 +++++++++++++++++---
 test/malli/core_test.cljc               | 11 +++++++----
 3 files changed, 36 insertions(+), 8 deletions(-)

diff --git a/perf/malli/perf/creation_perf_test.cljc b/perf/malli/perf/creation_perf_test.cljc
index e0e9b2588..7ec4021f6 100644
--- a/perf/malli/perf/creation_perf_test.cljc
+++ b/perf/malli/perf/creation_perf_test.cljc
@@ -14,8 +14,14 @@
   ;; 3.0µs (map childs)
   ;; 3.2µs (mapv childs)
   ;; 2.5µs (...)
+  ;; 2.1µs (non-distinct)
+  ;; 1.4µs (-vmap)
   (p/bench (m/validate [:or :int :string] 42))
 
+  ;; 15ns
+  (let [schema (m/schema [:or :int :string])]
+    (p/bench (m/validate schema 42)))
+
   ;; 3.0µs
   ;; 500ns (delayed mapv childs)
   ;; 1.7µs
@@ -38,10 +44,15 @@
 
   ;; 1.7µs
   ;; 1.5µs (fast parse)
+  ;; 13ns (-cache)
   (let [schema (m/schema [:or :int :string])]
     (p/bench (m/validator schema)))
 
-  ;; 4ns
+  ;; 16ns
+  (let [schema (m/schema [:or :int :string])]
+    (p/bench (m/validate schema 42)))
+
+  ;; 3ns
   (let [validate (m/validator [:or :int :string])]
     (p/bench (validate 42))))
 
diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 06412dc2b..431cfab58 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -194,6 +194,16 @@
 
 (defn -equals [x y] (or (identical? x y) (= x y)))
 
+(defn -vmap [f os]
+  (let [c (count os)]
+    (when (pos? c)
+      (let [oa (object-array c)
+            iter #?(:clj (.iterator ^Iterable os), :cljs (iter os))
+            n (volatile! -1)]
+        (while (.hasNext iter)
+          (aset oa (vreset! n (inc ^int @n)) (f (.next iter))))
+        #?(:clj (LazilyPersistentVector/createOwning oa), (vec os))))))
+
 (defn -memoize [f]
   (let [value #?(:clj (AtomicReference. nil), :cljs (atom nil))]
     (fn [] #?(:clj (or (.get value) (do (.set value (f)) (.get value))), :cljs (or @value (reset! value (f)))))))
@@ -380,7 +390,11 @@
         child-transformer (if (seq child-transformers) (apply -comp (rseq child-transformers)))]
     (-intercepting parent-transformer child-transformer)))
 
-(defn -cached [s k f] (if (-cached? s) (let [c (-cache s)] (or (@c k) ((swap! c assoc k (f s)) k))) (f s)))
+(defn -cached [s k f]
+  (if (-cached? s)
+    (let [c (-cache s)]
+      (or (@c k) ((swap! c assoc k (f s)) k)))
+    (f s)))
 
 (defn- -register-var [registry v]
   (let [name (-> v meta :name)
@@ -556,7 +570,7 @@
         (reify
           Schema
           (-validator [_]
-            (let [validators (distinct (map -validator children))]
+            (let [validators (-vmap -validator children)]
               #?(:clj  (miu/-every-pred validators)
                  :cljs (if (second validators) (apply every-pred validators) (first validators)))))
           (-explainer [_ path]
@@ -598,7 +612,7 @@
         (reify
           Schema
           (-validator [_]
-            (let [validators (distinct (map -validator children))]
+            (let [validators (-vmap -validator children)]
               #?(:clj  (miu/-some-pred validators)
                  :cljs (if (second validators) (fn [x] (boolean (some #(% x) validators))) (first validators)))))
           (-explainer [_ path]
diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc
index 2aecc5f3b..ef0532afc 100644
--- a/test/malli/core_test.cljc
+++ b/test/malli/core_test.cljc
@@ -188,10 +188,6 @@
         (is (false? (m/validate schema "1")))
         (is (false? (m/validate schema [1]))))
 
-      (is (= pos-int? (m/validator [:and pos-int? pos-int? pos-int?])))
-      (is (= pos-int? (m/validator [:or pos-int? pos-int? pos-int?])))
-      (is (= pos-int? (m/validator [:orn [:a pos-int?] [:b pos-int?] [:c pos-int?]])))
-
       (is (nil? (m/explain schema 1)))
       (is (results= {:schema schema,
                      :value 0,
@@ -2391,3 +2387,10 @@
       (is (true?  (f (range 4))))
       (is (true?  (f (range 7))))
       (is (true?  (f (range 8)))))))
+
+(deftest -vmap-test
+  (is (nil? (m/-vmap str nil)))
+  (is (nil? (m/-vmap str [])))
+  (is (= ["1"] (m/-vmap str [1])))
+  (is (= ["1" "2"] (m/-vmap str [1 2]))))
+

From d94734068d2bae66277322f33bb0d1c36955d19d Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Fri, 22 Oct 2021 17:28:19 +0300
Subject: [PATCH 13/25] fix cljs

---
 src/malli/core.cljc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 431cfab58..056472b4d 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -202,7 +202,7 @@
             n (volatile! -1)]
         (while (.hasNext iter)
           (aset oa (vreset! n (inc ^int @n)) (f (.next iter))))
-        #?(:clj (LazilyPersistentVector/createOwning oa), (vec os))))))
+        #?(:clj (LazilyPersistentVector/createOwning oa), :cljs (vec os))))))
 
 (defn -memoize [f]
   (let [value #?(:clj (AtomicReference. nil), :cljs (atom nil))]

From 34505f012dbb6a23e4f6e20cb7ba4d89fc6dcc5c Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Fri, 22 Oct 2021 17:37:07 +0300
Subject: [PATCH 14/25] cache -parser and -unparser too

---
 src/malli/core.cljc | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 056472b4d..8334b3f58 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -1916,7 +1916,7 @@
   ([?schema]
    (parser ?schema nil))
   ([?schema options]
-   (-parser (schema ?schema options))))
+   (-cached (schema ?schema options) :parser -parser)))
 
 (defn parse
   "parses a value against a given schema. Creates the `parser` for every call.
@@ -1931,7 +1931,7 @@
   ([?schema]
    (unparser ?schema nil))
   ([?schema options]
-   (-unparser (schema ?schema options))))
+   (-cached (schema ?schema options) :unparser -unparser)))
 
 (defn unparse
   "Unparses a value against a given schema. Creates the `unparser` for every call.

From 7a9f68bd4432a110883a464e3b78167ba1fef04c Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Fri, 22 Oct 2021 17:48:35 +0300
Subject: [PATCH 15/25] simple -vamp for cljs

---
 src/malli/core.cljc | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 8334b3f58..ab6f27483 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -195,14 +195,15 @@
 (defn -equals [x y] (or (identical? x y) (= x y)))
 
 (defn -vmap [f os]
-  (let [c (count os)]
-    (when (pos? c)
-      (let [oa (object-array c)
-            iter #?(:clj (.iterator ^Iterable os), :cljs (iter os))
-            n (volatile! -1)]
-        (while (.hasNext iter)
-          (aset oa (vreset! n (inc ^int @n)) (f (.next iter))))
-        #?(:clj (LazilyPersistentVector/createOwning oa), :cljs (vec os))))))
+  #?(:clj (let [c (count os)]
+            (when (pos? c)
+              (let [oa (object-array c)
+                    iter (.iterator ^Iterable os)
+                    n (volatile! -1)]
+                (while (.hasNext iter)
+                  (aset oa (vreset! n (inc ^int @n)) (f (.next iter))))
+                (LazilyPersistentVector/createOwning oa))))
+     :cljs (into [] (map f) os)))
 
 (defn -memoize [f]
   (let [value #?(:clj (AtomicReference. nil), :cljs (atom nil))]

From 6b5c3265cf72e0fcb477ce8d4222b7d6631677a9 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Fri, 22 Oct 2021 18:57:27 +0300
Subject: [PATCH 16/25] fix tests

---
 src/malli/core.cljc       | 4 ++--
 test/malli/core_test.cljc | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index ab6f27483..f1c2c2d59 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -196,13 +196,13 @@
 
 (defn -vmap [f os]
   #?(:clj (let [c (count os)]
-            (when (pos? c)
+            (if (pos? c)
               (let [oa (object-array c)
                     iter (.iterator ^Iterable os)
                     n (volatile! -1)]
                 (while (.hasNext iter)
                   (aset oa (vreset! n (inc ^int @n)) (f (.next iter))))
-                (LazilyPersistentVector/createOwning oa))))
+                (LazilyPersistentVector/createOwning oa)) []))
      :cljs (into [] (map f) os)))
 
 (defn -memoize [f]
diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc
index ef0532afc..2f1723828 100644
--- a/test/malli/core_test.cljc
+++ b/test/malli/core_test.cljc
@@ -2389,8 +2389,8 @@
       (is (true?  (f (range 8)))))))
 
 (deftest -vmap-test
-  (is (nil? (m/-vmap str nil)))
-  (is (nil? (m/-vmap str [])))
+  (is (= [] (m/-vmap str nil)))
+  (is (= [] (m/-vmap str [])))
   (is (= ["1"] (m/-vmap str [1])))
   (is (= ["1" "2"] (m/-vmap str [1 2]))))
 

From 60ecdd34e3fdb6c2346493dc9d664ea1f2fdc0a1 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 12:12:38 +0300
Subject: [PATCH 17/25] entries don't have to eagerly calculated

---
 perf/malli/perf/creation_perf_test.cljc |  2 +
 src/malli/core.cljc                     | 71 ++++++++++++-------------
 2 files changed, 35 insertions(+), 38 deletions(-)

diff --git a/perf/malli/perf/creation_perf_test.cljc b/perf/malli/perf/creation_perf_test.cljc
index 7ec4021f6..19e32ab2d 100644
--- a/perf/malli/perf/creation_perf_test.cljc
+++ b/perf/malli/perf/creation_perf_test.cljc
@@ -80,6 +80,7 @@
   ;; 44µs -> 31µs -> 18µs -> 11µs -> 9.4µs -> 9.0µs -> 8.5µs -> 7.0µs -> 6.4µs (registry) -> 5.7µs
   ;; 3.4µs
   ;; 2.9µs (-entry-parser)
+  ;; 2.5µs (no entries, object-arraus)
   (p/bench (m/schema ?schema))
 
   ;; 240ns
@@ -125,6 +126,7 @@
   ;; 5.8µs (protocols, registry, recur, parsed)
   ;; 3.9µs (-parsed)
   ;; 3.6µs (-entry-parser)
+  ;; 3.5µs (object-array)
   (p/bench (mu/closed-schema schema))
 
   ;; 3.8µs
diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index f1c2c2d59..bef4a9886 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -239,35 +239,34 @@
 ;; entries
 ;;
 
-(defn -simple-entry-parser [keyset children entries forms]
-  (reify EntryParser
-    (-entry-keyset [_] keyset)
-    (-entry-children [_] children)
-    (-entry-entries [_] entries)
-    (-entry-forms [_] forms)))
+(defn -simple-entry-parser [keyset children forms]
+  (let [entries (map (fn [[k p s]] (miu/-tagged k (-val-schema s p))) children)]
+    (reify EntryParser
+      (-entry-keyset [_] keyset)
+      (-entry-children [_] children)
+      (-entry-entries [_] entries)
+      (-entry-forms [_] forms))))
 
 (defn- -update-parsed [entry-parser ?key value options]
   (let [[k p override] (if (vector? ?key) [(nth ?key 0) (second ?key) true] [?key])
         keyset (-entry-keyset entry-parser)
         children (-entry-children entry-parser)
-        entries (-entry-entries entry-parser)
         forms (-entry-forms entry-parser)
         s (when value (schema value options))
         i (keyset k)]
     (if (nil? s)
       ;; remove
       (letfn [(cut [v] (into (subvec v 0 i) (subvec v (inc i))))]
-        (-simple-entry-parser (dissoc keyset k) (cut children) (cut entries) (cut forms)))
+        (-simple-entry-parser (dissoc keyset k) (cut children) (cut forms)))
       (let [c [k p s]
-            e (miu/-tagged k (-val-schema s p))
             p (if i (if override p (nth (children i) 1)) p)
             f (if (seq p) [k p (-form s)] [k (-form s)])]
         (if i
           ;; update
-          (-simple-entry-parser keyset (assoc children i c) (assoc entries i e) (assoc forms i f))
+          (-simple-entry-parser keyset (assoc children i c) (assoc forms i f))
           ;; assoc
           (let [size (inc (count keyset))]
-            (-simple-entry-parser (assoc keyset k size) (conj children c) (conj entries e) (conj forms f))))))))
+            (-simple-entry-parser (assoc keyset k size) (conj children c) (conj forms f))))))))
 
 (defn -set-entries
   ([schema ?key value]
@@ -284,60 +283,56 @@
                       :always (->> (filter (fn [e] (-> e last some?)))))]
        (-set-children schema children)))))
 
-(defn- -parse-entry [e naked-keys lazy-refs options i ^objects -children ^objects -entries ^objects -forms ^objects -keyset]
-  (letfn [(-collect [k c e f i]
+(defn- -parse-entry [e naked-keys lazy-refs options i ^objects -children ^objects -forms ^objects -keyset]
+  (letfn [(-collect [k c f i]
             (let [i (int i)]
               (aset -keyset (* 2 i) k)
               (aset -keyset (inc (* 2 i)) #?(:clj (Long. i), :cljs i))
               (aset -children i c)
-              (aset -entries i e)
               (aset -forms i f)
               (unchecked-inc-int i)))
           (-schema [e] (schema (cond-> e (and (-reference? 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))]
-              (-collect e c e' e i)))
+                  c [e nil s]]
+              (-collect e c e i)))
           (-parse-ref-vector1 [e e0]
             (let [s (-schema e0)
-                  c [e0 nil s]
-                  e' (miu/-tagged e0 (-val-schema s nil))]
-              (-collect e0 c e' e i)))
+                  c [e0 nil s]]
+              (-collect e0 c e i)))
           (-parse-ref-vector2 [e e0 e1]
             (let [s (-schema e0)
-                  c [e0 e1 s]
-                  e' (miu/-tagged e0 (-val-schema s e1))]
-              (-collect e0 c e' e i)))
+                  c [e0 e1 s]]
+              (-collect e0 c e i)))
           (-parse-entry-else2 [e0 e1]
             (let [s (-schema e1)
                   f [e0 (-form s)]
-                  c [e0 nil s]
-                  e' (miu/-tagged e0 (-val-schema s nil))]
-              (-collect e0 c e' f i)))
+                  c [e0 nil s]]
+              (-collect e0 c f i)))
           (-parse-entry-else3 [e0 e1 e2]
             (let [s (-schema e2)
                   f' (-form s)
                   f (if e1 [e0 e1 f'] [e0 f'])
-                  c [e0 e1 s]
-                  e' (miu/-tagged e0 (-val-schema s e1))]
-              (-collect e0 c e' f i)))]
-    (if (sequential? e)
-      (let [n (count e), e0 (nth e 0)]
+                  c [e0 e1 s]]
+              (-collect e0 c f i)))]
+    (if (vector? e)
+      (let [ea (object-array e)
+            n (alength ea)
+            e0 (aget ea 0)]
         (if (== n 1)
           (if (and (-reference? e0) naked-keys) (-parse-ref-vector1 e e0) i)
-          (let [e1 (nth e 1)]
+          (let [e1 (aget ea 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)]
+              (let [e2 (aget ea 2)]
                 (-parse-entry-else3 e0 e1 e2))))))
       (if (and naked-keys (-reference? e))
         (-parse-ref-entry e)
         (-fail! ::invalid-ref {:ref e})))))
 
-(defn -eager-entry-parser [?children props options]
+(defn -eager-entry-parser [children props options]
   (letfn [(-vec [^objects arr] #?(:clj (LazilyPersistentVector/createOwning arr), :cljs (vec arr)))
           (-map [^objects arr] #?(:clj (PersistentArrayMap/createWithCheck arr)
                                   :cljs (let [m (apply array-map arr)]
@@ -347,16 +342,16 @@
            #?(:clj (let [-arr (object-array to)] (System/arraycopy arr 0 -arr 0 to) -arr)
               :cljs (.slice arr 0 to)))]
     (let [{:keys [naked-keys lazy-refs]} props
-          n (count ?children)
+          ca (object-array children)
+          n (alength ca)
           -children (object-array n)
-          -entries (object-array n)
           -forms (object-array n)
           -keyset (object-array (* 2 n))]
       (loop [i (int 0), ci (int 0)]
         (if (== ci n)
           (let [f (if (== ci i) -vec #(-vec (-arange % i)))]
-            (-simple-entry-parser (-map -keyset) (f -children) (f -entries) (f -forms)))
-          (recur (int (-parse-entry (nth ?children i) naked-keys lazy-refs options i -children -entries -forms -keyset))
+            (-simple-entry-parser (-map -keyset) (f -children) (f -forms)))
+          (recur (int (-parse-entry (aget ca i) naked-keys lazy-refs options i -children -forms -keyset))
                  (unchecked-inc-int ci)))))))
 
 (defn -lazy-entry-parser [?children props options]

From 65912e8cea5b190861f80d40b205ca96bd4cef09 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 12:51:42 +0300
Subject: [PATCH 18/25] use loop variable, faster than volatile

---
 perf/malli/perf/creation_perf_test.cljc |  2 +-
 src/malli/core.cljc                     | 11 ++++-------
 test/malli/core_test.cljc               |  1 -
 3 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/perf/malli/perf/creation_perf_test.cljc b/perf/malli/perf/creation_perf_test.cljc
index 19e32ab2d..27486c3e8 100644
--- a/perf/malli/perf/creation_perf_test.cljc
+++ b/perf/malli/perf/creation_perf_test.cljc
@@ -15,7 +15,7 @@
   ;; 3.2µs (mapv childs)
   ;; 2.5µs (...)
   ;; 2.1µs (non-distinct)
-  ;; 1.4µs (-vmap)
+  ;; 1.3µs (-vmap)
   (p/bench (m/validate [:or :int :string] 42))
 
   ;; 15ns
diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index bef4a9886..7d4607377 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -196,13 +196,10 @@
 
 (defn -vmap [f os]
   #?(:clj (let [c (count os)]
-            (if (pos? c)
-              (let [oa (object-array c)
-                    iter (.iterator ^Iterable os)
-                    n (volatile! -1)]
-                (while (.hasNext iter)
-                  (aset oa (vreset! n (inc ^int @n)) (f (.next iter))))
-                (LazilyPersistentVector/createOwning oa)) []))
+            (if-not (zero? c)
+              (let [oa (object-array c), iter (.iterator ^Iterable os)]
+                (loop [n 0] (when (.hasNext iter) (aset oa n (f (.next iter))) (recur (unchecked-inc n))))
+                (clojure.lang.LazilyPersistentVector/createOwning oa)) []))
      :cljs (into [] (map f) os)))
 
 (defn -memoize [f]
diff --git a/test/malli/core_test.cljc b/test/malli/core_test.cljc
index 2f1723828..3ec137046 100644
--- a/test/malli/core_test.cljc
+++ b/test/malli/core_test.cljc
@@ -2393,4 +2393,3 @@
   (is (= [] (m/-vmap str [])))
   (is (= ["1"] (m/-vmap str [1])))
   (is (= ["1" "2"] (m/-vmap str [1 2]))))
-

From 72f6ce0659c20cd6bddaeca82d22325a08aabc1b Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 13:16:07 +0300
Subject: [PATCH 19/25] m/-walk-entries, m/-walk-indexed

---
 CHANGELOG.md        |  4 +++
 src/malli/core.cljc | 60 ++++++++++++++++-----------------------------
 2 files changed, 25 insertions(+), 39 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 49d57e56e..003744d7c 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -47,6 +47,10 @@ Malli is in [alpha](README.md#alpha).
 * fixed arity error in `m/function-schema`
 * add localized error messages for all type-schemas
 
+### Extender API
+
+* `m/-walk-entries` & `m/-walk-indexed` helpers
+
 ## 0.6.1 (2021-08-08)
 
 * add missing optional dependency to `mvxcvi/arrangement` to make pretty printing work
diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 7d4607377..dbf4ec325 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -212,6 +212,14 @@
 (defn -inner-entries [walker path entries options]
   (mapv (fn [[k s]] [k (-properties s) (-inner walker s (conj path k) options)]) entries))
 
+(defn -walk-entries [schema walker path options]
+  (when (-accept walker schema path options)
+    (-outer walker schema path (-inner-entries walker path (-entries schema) options) options)))
+
+(defn -walk-indexed [schema walker path options]
+  (when (-accept walker schema path options)
+    (-outer walker schema path (-inner-indexed walker path (-children schema) options) options)))
+
 (defn -set-children [schema children]
   (if (-equals children (-children schema))
     schema (-into-schema (-parent schema) (-properties schema) children (-options schema))))
@@ -573,9 +581,7 @@
           (-unparser [_] (->parser -unparser rseq))
           (-transformer [this transformer method options]
             (-parent-children-transformer this children transformer method options))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -636,9 +642,7 @@
                                        (fn [x i validator] (if (validator x) (reduced ((nth transformers i) x)) x))
                                        x validators)))))
                 (-intercepting this-transformer))))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -711,9 +715,7 @@
                                        (fn [x i validator] (if (validator x) (reduced ((nth transformers i) x)) x))
                                        x validators)))))
                 (-intercepting this-transformer))))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-entries walker path (-entries this) options) options)))
+          (-walk [this walker path options] (-walk-entries this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] (-entry-children entry-parser))
@@ -754,9 +756,7 @@
           (-unparser [this] (-parser this))
           (-transformer [this transformer method options]
             (-parent-children-transformer this children transformer method options))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -897,9 +897,7 @@
                    apply->children (when (seq ->children) (-map-transformer ->children))
                    apply->children (-guard map? apply->children)]
                (-intercepting this-transformer apply->children)))
-           (-walk [this walker path options]
-             (if (-accept walker this path options)
-               (-outer walker this path (-inner-entries walker path (-entries this) options) options)))
+           (-walk [this walker path options] (-walk-entries this walker path options))
            (-properties [_] properties)
            (-options [_] options)
            (-children [_] (-entry-children entry-parser))
@@ -981,9 +979,7 @@
                   apply->key-child (when ->key-child #(reduce-kv ->key-child (empty %) %))
                   apply->key-child (-guard map? apply->key-child)]
               (-intercepting this-transformer apply->key-child)))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1126,9 +1122,7 @@
                   apply->children (when (seq ->children) (-tuple-transformer ->children))
                   apply->children (-guard vector? apply->children)]
               (-intercepting this-transformer apply->children)))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1295,9 +1289,7 @@
           (-unparser [_] (->parser -unparser))
           (-transformer [this transformer method options]
             (-parent-children-transformer this children transformer method options))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1361,9 +1353,7 @@
                    find (finder ->children)
                    child-transformer (if (seq ->children) (fn [x] (if-some [t (find (dispatch x))] (t x) x)))]
                (-intercepting this-transformer child-transformer)))
-           (-walk [this walker path options]
-             (if (-accept walker this path options)
-               (-outer walker this path (-inner-entries walker path (-entries this) options) options)))
+           (-walk [this walker path options] (-walk-entries this walker path options))
            (-properties [_] properties)
            (-options [_] options)
            (-children [_] (-entry-children entry-parser))
@@ -1550,9 +1540,7 @@
               (fn [x] (if (validator x) x ::invalid))))
           (-unparser [this] (-parser this))
           (-transformer [_ _ _ _])
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1607,9 +1595,7 @@
               (fn [x] (if (validator x) x ::invalid))))
           (-unparser [this] (-parser this))
           (-transformer [_ _ _ _])
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1653,9 +1639,7 @@
           (-parser [this] (regex-parser this))
           (-unparser [this] (-regex-unparser this))
           (-transformer [this transformer method options] (regex-transformer this transformer method options))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-indexed walker path children options) options)))
+          (-walk [this walker path options] (-walk-indexed this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1698,9 +1682,7 @@
           (-parser [this] (regex-parser this))
           (-unparser [this] (-regex-unparser this))
           (-transformer [this transformer method options] (regex-transformer this transformer method options))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path (-inner-entries walker path (-entries this) options) options)))
+          (-walk [this walker path options] (-walk-entries this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] (-entry-children entry-parser))

From 7b849fd3dc9caa5df6b4ac79fe0bd834d9ae4c00 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 13:34:13 +0300
Subject: [PATCH 20/25] m/-walk-leaf

---
 CHANGELOG.md        |  2 +-
 src/malli/core.cljc | 42 +++++++++++++++++++++++-------------------
 2 files changed, 24 insertions(+), 20 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 003744d7c..9799f163f 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -49,7 +49,7 @@ Malli is in [alpha](README.md#alpha).
 
 ### Extender API
 
-* `m/-walk-entries` & `m/-walk-indexed` helpers
+* `m/walk-leaf`, `m/-walk-entries` & `m/-walk-indexed` helpers
 
 ## 0.6.1 (2021-08-08)
 
diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index dbf4ec325..9d8351699 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -206,6 +206,10 @@
   (let [value #?(:clj (AtomicReference. nil), :cljs (atom nil))]
     (fn [] #?(:clj (or (.get value) (do (.set value (f)) (.get value))), :cljs (or @value (reset! value (f)))))))
 
+;;
+;; walkers
+;;
+
 (defn -inner-indexed [walker path children options]
   (mapv (fn [[i c]] (-inner walker c (conj path i) options)) (map-indexed vector children)))
 
@@ -220,6 +224,14 @@
   (when (-accept walker schema path options)
     (-outer walker schema path (-inner-indexed walker path (-children schema) options) options)))
 
+(defn -walk-leaf [schema walker path options]
+  (when (-accept walker schema path options)
+    (-outer walker schema path (-children schema) options)))
+
+;;
+;; lenses
+;;
+
 (defn -set-children [schema children]
   (if (-equals children (-children schema))
     schema (-into-schema (-parent schema) (-properties schema) children (-options schema))))
@@ -527,9 +539,7 @@
               (-unparser [this] (-parser this))
               (-transformer [this transformer method options]
                 (-intercepting (-value-transformer transformer this method options)))
-              (-walk [this walker path options]
-                (if (-accept walker this path options)
-                  (-outer walker this path children options)))
+              (-walk [this walker path options] (-walk-leaf this walker path options))
               (-properties [_] properties)
               (-options [_] options)
               (-children [_] children)
@@ -1151,16 +1161,15 @@
           (-validator [_]
             (fn [x] (contains? schema x)))
           (-explainer [this path]
-            (fn explain [x in acc]
-              (if-not (contains? schema x) (conj acc (miu/-error (conj path 0) in this x)) acc)))
+            (let [validator (-validator this)]
+              (fn explain [x in acc]
+                (if-not (validator x) (conj acc (miu/-error (conj path 0) in this x)) acc))))
           (-parser [_] (fn [x] (if (contains? schema x) x ::invalid)))
           (-unparser [this] (-parser this))
           ;; TODO: should we try to derive the type from values? e.g. [:enum 1 2] ~> int?
           (-transformer [this transformer method options]
             (-intercepting (-value-transformer transformer this method options)))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path children options)))
+          (-walk [this walker path options] (-walk-leaf this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1200,13 +1209,11 @@
                   (conj acc (miu/-error path in this x (:type (ex-data e))))))))
           (-transformer [this transformer method options]
             (-intercepting (-value-transformer transformer this method options)))
-          (-parser [_]
-            (let [find (-safe-pred #(re-find re %))]
-              (fn [x] (if (find x) x ::invalid))))
+          (-parser [this]
+            (let [valid? (-validator this)]
+              (fn [x] (if (valid? x) x ::invalid))))
           (-unparser [this] (-parser this))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path children options)))
+          (-walk [this walker path options] (-walk-leaf this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1247,9 +1254,7 @@
           (-unparser [this] (-parser this))
           (-transformer [this transformer method options]
             (-intercepting (-value-transformer transformer this method options)))
-          (-walk [this walker path options]
-            (if (-accept walker this path options)
-              (-outer walker this path children options)))
+          (-walk [this walker path options] (-walk-leaf this walker path options))
           (-properties [_] properties)
           (-options [_] options)
           (-children [_] children)
@@ -1273,8 +1278,7 @@
       (-check-children! :maybe properties children 1 1)
       (let [[schema :as children] (map #(schema % options) children)
             cache (-create-cache options)
-            ->parser (fn [f] (let [parser (f schema)]
-                               (fn [x] (if (nil? x) x (parser x)))))]
+            ->parser (fn [f] (let [parser (f schema)] (fn [x] (if (nil? x) x (parser x)))))]
         ^{:type ::schema}
         (reify
           Schema

From 9176920cec350607c850d4803651c5791bd6a007 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 14:00:04 +0300
Subject: [PATCH 21/25] Update CHANGELOG

---
 CHANGELOG.md                            | 46 ++++++++++++++++++++++---
 perf/malli/perf/creation_perf_test.cljc | 12 +++++--
 2 files changed, 50 insertions(+), 8 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 9799f163f..4ce3e2609 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -16,7 +16,11 @@ Malli is in [alpha](README.md#alpha).
 
 ## 0.7.0-SNAPSHOT
 
-* big improvements to schema creation and transformation perfromance, see [#531](https://github.com/metosin/malli/issues/513).
+### Performance
+
+* big improvements to schema creation and transformation perfromance, see [#531](https://github.com/metosin/malli/issues/513) and [#550](https://github.com/metosin/malli/pull/550).
+
+#### Schema Creation
 
 ```clj
 (def ?schema
@@ -29,27 +33,59 @@ Malli is in [alpha](README.md#alpha).
 
 (def schema (m/schema ?schema))
 
-;; 44µs -> 3.6µs (12x)
+;; 44µs -> 2.5µs (18x)
 (bench (m/schema ?schema))
 
-;; 26µs -> 1.3µs (20x)
+;; 44µs -> 240ns (180x, not realized)
+(p/bench (m/schema ?schema {::m/lazy-entries true}))
+```
+
+#### Schema Transformation
+
+```clj
+;; 26µs -> 1.2µs (21x)
 (bench (m/walk schema (m/schema-walker identity)))
 
-;; 4.2µs -> 0.8µs (5x)
+;; 4.2µs -> 0.54µs (7x)
 (bench (mu/assoc schema :w :string))
 
-;; 51µs -> 3.7µs (14x)
+;; 51µs -> 3.4µs (15x)
 (bench (mu/closed-schema schema))
+
+;; 5µs -> 28ns (180x)
+(p/bench (m/deref-all ref-schema))
+
+;; 134µs -> 9µs (15x)
+(p/bench (mu/merge schema schema))
 ```
 
+#### Schema Workers
+
+```clj
+(def schema (m/schema ?schema))
+
+;; 1.6µs -> 64ns (25x)
+(p/bench (m/validate schema {:x true, :z {:x true}}))
+
+;; 1.6µs -> 450ns (3x)
+(p/bench (m/explain schema {:x true, :z {:x true}}))
+```
+
+### Public API
+
 * fixed pretty printing of function values, [#509](https://github.com/metosin/malli/pull/509)
 * fixed `:function` lenses
 * fixed arity error in `m/function-schema`
 * add localized error messages for all type-schemas
+* support for Lazy EntrySchema parsing
 
 ### Extender API
 
 * `m/walk-leaf`, `m/-walk-entries` & `m/-walk-indexed` helpers
+* new `m/Cached` protocol Schema can support for memoization of `-form`, `-validator`, `-explainer` and `-parser`
+* **BREAKING**: `m/EntrySchema` replaces `m/MapSchema` with new `-entry-parser` method
+* **BREAKING**: (eager) `m/-parse-entries` is removed, use (pluggable) `m/-entry-parser` instead
+* new `m/EntryParser` protocol
 
 ## 0.6.1 (2021-08-08)
 
diff --git a/perf/malli/perf/creation_perf_test.cljc b/perf/malli/perf/creation_perf_test.cljc
index 27486c3e8..3be62de08 100644
--- a/perf/malli/perf/creation_perf_test.cljc
+++ b/perf/malli/perf/creation_perf_test.cljc
@@ -83,9 +83,15 @@
   ;; 2.5µs (no entries, object-arraus)
   (p/bench (m/schema ?schema))
 
-  ;; 240ns
+  ;; 44µs -> 240ns
   (p/bench (m/schema ?schema {::m/lazy-entries true}))
 
+  ;; 1.6µs -> 64ns
+  (p/bench (m/validate schema {:x true, :z {:x true}}))
+
+  ;; 1.6µs -> 450ns
+  (p/bench (m/explain schema {:x true, :z {:x true}}))
+
   ;; does not work with direct linking
   (with-redefs [m/-check-children? (constantly false)]
     (p/bench (m/schema ?schema))))
@@ -126,7 +132,7 @@
   ;; 5.8µs (protocols, registry, recur, parsed)
   ;; 3.9µs (-parsed)
   ;; 3.6µs (-entry-parser)
-  ;; 3.5µs (object-array)
+  ;; 3.4µs (object-array)
   (p/bench (mu/closed-schema schema))
 
   ;; 3.8µs
@@ -139,7 +145,7 @@
   ;; 4.2µs
   ;; 3.8µs (satisfies?)
   ;; 820ns (-update-parsed)
-  ;; 580ns (-entry-parser)
+  ;; 540ns (-entry-parser)
   (p/bench (mu/assoc schema :w :string))
 
   ;; 205ns

From a4f6ad8882a4b64a9aa3b02e0d7c1dbfb3fb3062 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 15:22:11 +0300
Subject: [PATCH 22/25] form-creation helpers

---
 CHANGELOG.md        |  8 +++---
 src/malli/core.cljc | 64 +++++++++++++++++++++++++--------------------
 2 files changed, 40 insertions(+), 32 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 4ce3e2609..cd8af4740 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -81,11 +81,13 @@ Malli is in [alpha](README.md#alpha).
 
 ### Extender API
 
-* `m/walk-leaf`, `m/-walk-entries` & `m/-walk-indexed` helpers
-* new `m/Cached` protocol Schema can support for memoization of `-form`, `-validator`, `-explainer` and `-parser`
 * **BREAKING**: `m/EntrySchema` replaces `m/MapSchema` with new `-entry-parser` method
 * **BREAKING**: (eager) `m/-parse-entries` is removed, use (pluggable) `m/-entry-parser` instead
-* new `m/EntryParser` protocol
+* `m/EntryParser` protocol
+* `m/-create-form` has 2-arity for easier form creation
+* `m/-entry-forms` helper
+* `m/walk-leaf`, `m/-walk-entries` & `m/-walk-indexed` helpers
+* `m/Cached` protocol and `m/-create-cache` for memoization of `-form`, `-validator`, `-explainer` and `-parser` when using `m/form`, `m/validator`, `m/explain` and `m/parser`
 
 ## 0.6.1 (2021-08-08)
 
diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 9d8351699..65a8af4d4 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -156,12 +156,18 @@
        (when (or (and min (< size ^long min)) (and max (> size ^long max)))
          (-fail! ::child-error {:type type, :properties properties, :children children, :min min, :max max}))))))
 
-(defn -create-form [type properties children]
-  (let [has-children (seq children), has-properties (seq properties)]
-    (cond (and has-properties has-children) (reduce conj [type properties] children)
-          has-properties [type properties]
-          has-children (reduce conj [type] children)
-          :else type)))
+(defn -create-form
+  ([schema f]
+   (-create-form (type schema) (-properties schema) (map f (-children schema))))
+  ([type properties children]
+   (let [has-children (seq children), has-properties (seq properties)]
+     (cond (and has-properties has-children) (reduce conj [type properties] children)
+           has-properties [type properties]
+           has-children (reduce conj [type] children)
+           :else type))))
+
+(defn -create-entry-form [schema]
+  (-create-form (type schema) (-properties schema) (-entry-forms (-entry-parser schema))))
 
 (defn -pointer [id schema options] (-into-schema (-schema-schema {:id id}) nil [schema] options))
 
@@ -544,7 +550,7 @@
               (-options [_] options)
               (-children [_] children)
               (-parent [_] parent)
-              (-form [_] (-create-form type properties children))
+              (-form [this] (-create-form this identity))
               Cached
               (-cache [_] cache)
               LensSchema
@@ -596,7 +602,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :and properties (map -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -657,7 +663,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :or properties (map -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -730,7 +736,7 @@
           (-options [_] options)
           (-children [_] (-entry-children entry-parser))
           (-parent [_] parent)
-          (-form [_] (-create-form :orn properties (-entry-forms entry-parser)))
+          (-form [this] (-create-entry-form this))
           EntrySchema
           (-entries [_] (-entry-entries entry-parser))
           (-entry-parser [_] entry-parser)
@@ -771,7 +777,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :not properties (map -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -791,7 +797,8 @@
      (-children-schema [_ _])
      (-into-schema [parent properties children options]
        #_(-check-children! ::val properties children 1 1)
-       (let [schema (schema (first children) options)
+       (let [children (map #(schema % options) children)
+             schema (first children)
              cache (-create-cache options)]
          ^{:type ::schema}
          (reify Schema
@@ -810,7 +817,7 @@
            (-options [_] (-options schema))
            (-children [_] [schema])
            (-parent [_] parent)
-           (-form [_] (-create-form ::val properties [(-form schema)]))
+           (-form [this] (-create-form this -form))
            Cached
            (-cache [_] cache)
            LensSchema
@@ -912,7 +919,7 @@
            (-options [_] options)
            (-children [_] (-entry-children entry-parser))
            (-parent [_] parent)
-           (-form [_] (-create-form :map properties (-entry-forms entry-parser)))
+           (-form [this] (-create-entry-form this))
            EntrySchema
            (-entries [_] (-entry-entries entry-parser))
            (-entry-parser [_] entry-parser)
@@ -994,7 +1001,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :map-of properties (mapv -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1071,7 +1078,7 @@
                 (-options [_] options)
                 (-children [_] children)
                 (-parent [_] parent)
-                (-form [_] (-create-form type properties (map -form children)))
+                (-form [this] (-create-form this -form))
                 Cached
                 (-cache [_] cache)
                 LensSchema
@@ -1137,7 +1144,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :tuple properties (map -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1174,7 +1181,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :enum properties children))
+          (-form [this] (-create-form this identity))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1218,7 +1225,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (if class? re (-create-form :re properties children)))
+          (-form [this] (if class? re (-create-form this identity)))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1259,7 +1266,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :fn properties children))
+          (-form [this] (-create-form this identity))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1298,7 +1305,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :maybe properties (map -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1362,7 +1369,7 @@
            (-options [_] options)
            (-children [_] (-entry-children entry-parser))
            (-parent [_] parent)
-           (-form [_] (-create-form type properties (-entry-forms entry-parser)))
+           (-form [this] (-create-entry-form this))
            EntrySchema
            (-entries [_] (-entry-entries entry-parser))
            (-entry-parser [_] entry-parser)
@@ -1420,7 +1427,7 @@
            (-options [_] options)
            (-children [_] children)
            (-parent [_] parent)
-           (-form [_] (-create-form :ref properties children))
+           (-form [this] (-create-form this identity))
            Cached
            (-cache [_] cache)
            LensSchema
@@ -1472,8 +1479,7 @@
             (-options [_] options)
             (-children [_] children)
             (-parent [_] parent)
-            (-form [_] (or (and (empty? properties) (or id (and raw (-form child))))
-                           (-create-form type properties [(-form child)])))
+            (-form [this] (or (and (empty? properties) (or id (and raw (-form child)))) (-create-form this -form)))
             Cached
             (-cache [_] cache)
             LensSchema
@@ -1549,7 +1555,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :=> properties (map -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1604,7 +1610,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form :function properties (map -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1648,7 +1654,7 @@
           (-options [_] options)
           (-children [_] children)
           (-parent [_] parent)
-          (-form [_] (-create-form type properties (mapv -form children)))
+          (-form [this] (-create-form this -form))
           Cached
           (-cache [_] cache)
           LensSchema
@@ -1691,7 +1697,7 @@
           (-options [_] options)
           (-children [_] (-entry-children entry-parser))
           (-parent [_] parent)
-          (-form [_] (-create-form type properties (-entry-forms entry-parser)))
+          (-form [this] (-create-entry-form this))
           Cached
           (-cache [_] cache)
           LensSchema

From 542bcf47c2297a76b7f3aff040e6877c1a06e1e7 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 15:29:55 +0300
Subject: [PATCH 23/25] fix :multi type oddity

---
 src/malli/core.cljc | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index 65a8af4d4..cf5bdeef6 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -1321,13 +1321,12 @@
   ([opts]
    ^{:type ::into-schema}
    (reify IntoSchema
-     (-type [_] :multi)
+     (-type [_] (or (:type opts) :multi))
      (-type-properties [_] (:type-properties opts))
      (-properties-schema [_ _])
      (-children-schema [_ _])
      (-into-schema [parent properties children options]
-       (let [type (or (:type opts) :multi)
-             opts' (merge opts (select-keys properties [:lazy-refs]))
+       (let [opts' (merge opts (select-keys properties [:lazy-refs]))
              entry-parser (-create-entry-parser children opts' options)
              cache (-create-cache options)
              dispatch (eval (:dispatch properties) options)

From 18789bf30b6e9ee6b82105690e0397b5e584a614 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 20:36:14 +0300
Subject: [PATCH 24/25] fast inferring

---
 CHANGELOG.md                   | 14 +++++++-
 README.md                      | 13 ++++++++
 perf/malli/perf/core.cljc      |  4 +--
 perf/malli/perf/perf_test.cljc | 32 +++++++++++++------
 src/malli/provider.cljc        | 58 +++++++++++++++++-----------------
 test/malli/provider_test.cljc  |  7 ++--
 6 files changed, 83 insertions(+), 45 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index cd8af4740..199033653 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -18,7 +18,7 @@ Malli is in [alpha](README.md#alpha).
 
 ### Performance
 
-* big improvements to schema creation and transformation perfromance, see [#531](https://github.com/metosin/malli/issues/513) and [#550](https://github.com/metosin/malli/pull/550).
+* big improvements to schema creation, transformation and inferring perfromance, see [#531](https://github.com/metosin/malli/issues/513) and [#550](https://github.com/metosin/malli/pull/550).
 
 #### Schema Creation
 
@@ -71,6 +71,17 @@ Malli is in [alpha](README.md#alpha).
 (p/bench (m/explain schema {:x true, :z {:x true}}))
 ```
 
+#### Schema Inferring
+
+```clj
+;; 3.6ms -> 2.2ms (1.7x)
+(p/bench (mp/provide [1 2 3]))
+
+;; 2.5ms -> 82µs (30x)
+(let [provider (mp/provider)]
+  (p/bench (provider [1 2 3])))
+```
+
 ### Public API
 
 * fixed pretty printing of function values, [#509](https://github.com/metosin/malli/pull/509)
@@ -78,6 +89,7 @@ Malli is in [alpha](README.md#alpha).
 * fixed arity error in `m/function-schema`
 * add localized error messages for all type-schemas
 * support for Lazy EntrySchema parsing
+* **BREAKING**: `malli.provider/schema` is moved into extender API: `malli.provider/-schema`
 
 ### Extender API
 
diff --git a/README.md b/README.md
index 86fec533f..0acf022df 100644
--- a/README.md
+++ b/README.md
@@ -1363,6 +1363,19 @@ All samples are valid against the inferred schema:
 ; => true
 ```
 
+For order of magnitude better performance, use `mp/provider` instead:
+
+```clj
+;; 3.6ms -> 2.1ms (1.7x)
+(p/bench (mp/provide [1 2 3]))
+
+;; 2.5ms -> 82µs (30x)
+(let [provider (mp/provider)]
+  (p/bench (provider [1 2 3])))
+```
+
+Infferring is [still kinda slow](https://github.com/metosin/malli/issues/191).
+
 ## Parsing values
 
 Schemas can be used to parse values using `m/parse` and `m/parser`:
diff --git a/perf/malli/perf/core.cljc b/perf/malli/perf/core.cljc
index 0f69ba45f..d9939844d 100644
--- a/perf/malli/perf/core.cljc
+++ b/perf/malli/perf/core.cljc
@@ -14,9 +14,9 @@
 
 (defmacro profile [& body]
   `(let [start# (System/currentTimeMillis)]
-     (dotimes [_# 100000] ~@body)
+     (dotimes [_# 1000] ~@body)
      (let [ms# (- (System/currentTimeMillis) start#)
-           times# (int (/ 1000000000 ms#))]
+           times# (int (/ 10000000 ms#))]
        (println "invoking" times# "times")
        (time (prof/profile (dotimes [_# times#] ~@body))))))
 
diff --git a/perf/malli/perf/perf_test.cljc b/perf/malli/perf/perf_test.cljc
index fb67ca574..c593c6aa0 100644
--- a/perf/malli/perf/perf_test.cljc
+++ b/perf/malli/perf/perf_test.cljc
@@ -10,7 +10,8 @@
             [schema.core :as sc]
             [schema.coerce :as scc]
             [clojure.pprint]
-            [malli.transform :as transform]))
+            [malli.transform :as mt]
+            [malli.provider :as mp]))
 
 (s/def ::x boolean?)
 (s/def ::y int?)
@@ -44,7 +45,7 @@
     ;; 650ns
     (let [valid? (sc/checker {:x sc/Bool
                               (sc/optional-key :y) sc/Int
-                              :z sc/Str })]
+                              :z sc/Str})]
       (assert (not (valid? valid)))
       (p/bench (valid? valid)))))
 
@@ -168,7 +169,7 @@
       ;; 74µs (wrong result!)
       (p/bench (json->place json)))
 
-    (let [json->place (m/decoder Place transform/json-transformer)]
+    (let [json->place (m/decoder Place mt/json-transformer)]
       (clojure.pprint/pprint (json->place json))
 
       ;; 1µs -> 800ns
@@ -188,7 +189,7 @@
     (p/bench (string->edn "1")))
 
   ;; 4ns
-  (let [string->edn (m/decoder int? transform/string-transformer)]
+  (let [string->edn (m/decoder int? mt/string-transformer)]
     (assert (= 1
                (string->edn "1")
                (string->edn 1)))
@@ -211,7 +212,7 @@
 
   ;; 44ns
   (let [schema [:map [:id int?] [:name string?]]
-        string->edn (m/decoder schema transform/string-transformer)]
+        string->edn (m/decoder schema mt/string-transformer)]
     (assert (= {:id 1, :name "kikka"}
                (string->edn {:id 1, :name "kikka"})
                (string->edn {:id "1", :name "kikka"})))
@@ -245,7 +246,7 @@
 
   ;; 3.0ns
   (let [schema [:map [:id int?] [:name string?]]
-        string->edn (m/decoder schema transform/json-transformer)]
+        string->edn (m/decoder schema mt/json-transformer)]
     (assert (= {:id 1, :name "kikka"}
                (string->edn {:id 1, :name "kikka"})))
     (p/bench (string->edn {:id 1, :name "kikka"}))))
@@ -284,10 +285,10 @@
     (p/bench (f3 12))))
 
 (defn map-transform-test []
-  (doseq [transformer [transform/json-transformer
-                       (transform/transformer
-                         transform/strip-extra-keys-transformer
-                         transform/json-transformer)]]
+  (doseq [transformer [mt/json-transformer
+                       (mt/transformer
+                         mt/strip-extra-keys-transformer
+                         mt/json-transformer)]]
 
     ;; 3ns -> 3ns
     ;; 520ns -> 130ns
@@ -450,6 +451,16 @@
                                     [:country "Country"]]]]]]}}
            "Order"])))))
 
+(defn provider-test []
+
+  ;; 3.6ms
+  ;; 2.1ms (1.7x)
+  (p/bench (mp/provide [1 2 3]))
+
+  ;; 2.5ms
+  ;;  82µs (30x)
+  (let [provider (mp/provider)]
+    (p/bench (provider [1 2 3]))))
 
 (comment
   (map-perf)
@@ -466,6 +477,7 @@
   (simple-regex)
   (parsing)
   (and-map-perf-test)
+  (provider-test)
 
   (prof/serve-files 8080)
   (prof/clear-results)
diff --git a/src/malli/provider.cljc b/src/malli/provider.cljc
index f12de92c5..03083d87e 100644
--- a/src/malli/provider.cljc
+++ b/src/malli/provider.cljc
@@ -2,14 +2,15 @@
   (:require [malli.core :as m]
             [malli.registry :as mr]))
 
-(def preferences (-> ['int? 'integer? 'double? 'number? 'qualified-keyword? 'keyword? 'symbol? 'string? 'boolean?]
-                     (reverse) (zipmap (range)) (assoc 'any? -10 'some? -9)))
+(def -preferences (-> ['int? 'integer? 'double? 'number? 'qualified-keyword? 'keyword? 'symbol? 'string? 'boolean? 'uuid?]
+                      (reverse) (zipmap (drop 1 (range))) (assoc :any -13, :or -12, :and -11, 'any? -10, 'some? -9)))
 
-(defn- -safe? [f & args] (try (apply f args) (catch #?(:clj Exception, :cljs js/Error) _ false)))
+(defn -safe? [f & args] (try (apply f args) (catch #?(:clj Exception, :cljs js/Error) _ false)))
 
-(defn- ->inferrer [options]
-  (let [schemas (->> options (m/-registry) (mr/-schemas) (vals) (keep #(-safe? m/schema %)) (vec))
-        infer-value (fn [x] (-> schemas (->> (filter #(-safe? m/validate % x)) (map m/type)) (zipmap (repeat 1))))
+(defn -inferrer [options]
+  (let [schemas (->> options (m/-registry) (mr/-schemas) (vals) (filter #(-safe? m/schema %)))
+        form->validator (into {} (mapv (juxt m/form m/validator) schemas))
+        infer-value (fn [x] (-> (reduce-kv (fn [acc f v] (cond-> acc (-safe? v x) (assoc f 1))) {} form->validator)))
         infer-map (fn [infer] (fn [acc x] (reduce-kv (fn [acc k v] (update-in acc [:keys k] infer v)) acc x)))
         infer-seq (fn [infer] (fn [acc x] (reduce infer acc x)))
         merge+ (fnil #(merge-with + %1 %2) {})]
@@ -25,51 +26,50 @@
             (update-in [:types type :count] (fnil inc 0))
             (cond-> (= :value type) (-> (update-in [:types type :values] merge+ {x 1})
                                         (update-in [:types type :schemas] merge+ (infer-value x)))
-                    (= :map type) (update-in [:types type] (fnil (infer-map infer) {}) x)
-                    (#{:set :vector :sequential} type) (update-in [:types type :values] (fnil (infer-seq infer) {}) x)))))))
+              (= :map type) (update-in [:types type] (fnil (infer-map infer) {}) x)
+              (#{:set :vector :sequential} type) (update-in [:types type :values] (fnil (infer-seq infer) {}) x)))))))
 
-(defn- -map-schema [{:keys [count] :as stats} schema options]
+(defn -map-schema [{:keys [count] :as stats} schema options]
   (->> (:keys stats)
        (map (fn [[k kstats]]
               (let [kschema (schema kstats options)]
                 (if (not= count (:count kstats)) [k {:optional true} kschema] [k kschema]))))
        (into [:map])))
 
-(defn- -value-schema [{:keys [schemas]}]
+(defn -value-schema [{:keys [schemas]}]
   (let [max (->> schemas vals (apply max))]
     (->> schemas
          (filter #(= max (val %)))
-         (map (fn [[k]] [k (preferences k -1)]))
+         (map (fn [[k]] [k (-preferences k -1)]))
          (sort-by second >)
          (ffirst))))
 
-;;
-;; public api
-;;
-
-(defn schema
+(defn -schema
   ([stats]
-   (schema stats nil))
+   (-schema stats nil))
   ([{:keys [types] :as stats} options]
    (cond
      (= 1 (count (keys types)))
      (let [type (-> types keys first)]
        (case type
          :value (-value-schema (type types))
-         (:set :vector :sequential) [type (-> types type :values (schema options))]
-         :map (-map-schema (type types) schema options)))
+         (:set :vector :sequential) [type (-> types type :values (-schema options))]
+         :map (-map-schema (type types) -schema options)))
      (nil? types) (m/schema any?)
-     :else (into [:or] (map (fn [[type]] (schema (update stats :types select-keys [type]) options)) types)))))
+     :else (into [:or] (map (fn [[type]] (-schema (update stats :types select-keys [type]) options)) types)))))
+
+;;
+;; public api
+;;
 
 (defn provider
-  ([]
-   (provider nil))
-  ([options]
-   (let [inferrer (->inferrer options)]
-     (fn [xs] (-> (reduce inferrer {} xs) (schema options))))))
+  "Returns a inferring function of `values -> schema`."
+  ([] (provider nil))
+  ([options] (let [inferrer (-inferrer options)]
+               (fn [xs] (-> (reduce inferrer {} xs) (-schema options))))))
 
 (defn provide
-  ([xs]
-   (provide xs nil))
-  ([xs options]
-   ((provider options) xs)))
+  "Given an sequence of example values, returms a Schema that can all values are valid against.
+   For better performance, user [[provider]] instead."
+  ([xs] (provide xs nil))
+  ([xs options] ((provider options) xs)))
diff --git a/test/malli/provider_test.cljc b/test/malli/provider_test.cljc
index 68a60a254..ed010f2a6 100644
--- a/test/malli/provider_test.cljc
+++ b/test/malli/provider_test.cljc
@@ -1,14 +1,15 @@
 (ns malli.provider-test
   (:require [clojure.test :refer [deftest testing is]]
             [malli.provider :as mp]
-            [malli.core :as m]))
+            [malli.core :as m])
+  #?(:clj (:import (java.util UUID Date))))
 
 (def expectations
   [[int? [1 2 3]]
    [keyword? [:kikka :kukka]]
    [qualified-keyword? [::kikka ::kukka]]
-   [uuid? [#?(:clj (java.util.UUID/randomUUID) :cljs (random-uuid))]]
-   [inst? [#?(:clj (java.util.Date.) :cljs (js/Date.))]]
+   [uuid? [#?(:clj (UUID/randomUUID) :cljs (random-uuid))]]
+   [inst? [#?(:clj (Date.) :cljs (js/Date.))]]
    [any? []]
 
    [[:vector keyword?] [[:kikka] [:kukka :kakka]]]

From 08fc36d5adc95c3ef05a6652508d9b8b7afba3bb Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sat, 23 Oct 2021 20:48:09 +0300
Subject: [PATCH 25/25] reorg code

---
 src/malli/core.cljc | 141 ++++++++++++++++++++++++--------------------
 1 file changed, 76 insertions(+), 65 deletions(-)

diff --git a/src/malli/core.cljc b/src/malli/core.cljc
index cf5bdeef6..3bf32a4be 100644
--- a/src/malli/core.cljc
+++ b/src/malli/core.cljc
@@ -141,6 +141,8 @@
       (name x))
     x))
 
+(defn -guard [pred tf] (when tf (fn [x] (if (pred x) (tf x) x))))
+
 (defn -unlift-keys [m prefix]
   (reduce-kv #(if (= (name prefix) (namespace %2)) (assoc %1 (keyword (name %2)) %3) %1) {} m))
 
@@ -156,19 +158,6 @@
        (when (or (and min (< size ^long min)) (and max (> size ^long max)))
          (-fail! ::child-error {:type type, :properties properties, :children children, :min min, :max max}))))))
 
-(defn -create-form
-  ([schema f]
-   (-create-form (type schema) (-properties schema) (map f (-children schema))))
-  ([type properties children]
-   (let [has-children (seq children), has-properties (seq properties)]
-     (cond (and has-properties has-children) (reduce conj [type properties] children)
-           has-properties [type properties]
-           has-children (reduce conj [type] children)
-           :else type))))
-
-(defn -create-entry-form [schema]
-  (-create-form (type schema) (-properties schema) (-entry-forms (-entry-parser schema))))
-
 (defn -pointer [id schema options] (-into-schema (-schema-schema {:id id}) nil [schema] options))
 
 (defn -reference? [?schema] (or (string? ?schema) (qualified-keyword? ?schema)))
@@ -212,6 +201,33 @@
   (let [value #?(:clj (AtomicReference. nil), :cljs (atom nil))]
     (fn [] #?(:clj (or (.get value) (do (.set value (f)) (.get value))), :cljs (or @value (reset! value (f)))))))
 
+(defn -function-info [schema]
+  (if (= (type schema) :=>)
+    (let [[input output] (-children schema)
+          {:keys [min max]} (-regex-min-max input)]
+      (cond-> {:min min
+               :arity (if (= min max) min :varargs)
+               :input input
+               :output output}
+        max (assoc :max max)))))
+
+;;
+;; forms
+;;
+
+(defn -create-form
+  ([schema f]
+   (-create-form (type schema) (-properties schema) (map f (-children schema))))
+  ([type properties children]
+   (let [has-children (seq children), has-properties (seq properties)]
+     (cond (and has-properties has-children) (reduce conj [type properties] children)
+           has-properties [type properties]
+           has-children (reduce conj [type] children)
+           :else type))))
+
+(defn -create-entry-form [schema]
+  (-create-form (type schema) (-properties schema) (-entry-forms (-entry-parser schema))))
+
 ;;
 ;; walkers
 ;;
@@ -391,29 +407,68 @@
         :else (-eager-entry-parser ?children props options)))
 
 ;;
-;; helpers
+;; cache
 ;;
 
 (defn -create-cache [_options] (atom {}))
 
-(defn -guard [pred tf]
-  (when tf (fn [x] (if (pred x) (tf x) x))))
+(defn -cached [s k f]
+  (if (-cached? s)
+    (let [c (-cache s)]
+      (or (@c k) ((swap! c assoc k (f s)) k)))
+    (f s)))
+
+;;
+;; transformers
+;;
 
 (defn -intercepting
   ([interceptor] (-intercepting interceptor nil))
   ([{:keys [enter leave]} f] (some->> [leave f enter] (keep identity) (seq) (apply -comp))))
 
+(defn -into-transformer [x]
+  (cond
+    (#?(:clj instance?, :cljs implements?) malli.core.Transformer x) x
+    (fn? x) (-into-transformer (x))
+    :else (-fail! ::invalid-transformer {:value x})))
+
 (defn -parent-children-transformer [parent children transformer method options]
   (let [parent-transformer (-value-transformer transformer parent method options)
         child-transformers (into [] (keep #(-transformer % transformer method options)) children)
         child-transformer (if (seq child-transformers) (apply -comp (rseq child-transformers)))]
     (-intercepting parent-transformer child-transformer)))
 
-(defn -cached [s k f]
-  (if (-cached? s)
-    (let [c (-cache s)]
-      (or (@c k) ((swap! c assoc k (f s)) k)))
-    (f s)))
+(defn -map-transformer [ts]
+  #?(:clj  (apply -comp (map (fn child-transformer [[k t]]
+                               (fn [^Associative x]
+                                 (if-let [e ^MapEntry (.entryAt x k)]
+                                   (.assoc x k (t (.val e))) x))) (rseq ts)))
+     :cljs (fn [x] (reduce (fn child-transformer [m [k t]]
+                             (if-let [entry (find m k)]
+                               (assoc m k (t (val entry)))
+                               m)) x ts))))
+
+(defn -tuple-transformer [ts]
+  #?(:clj  (let [tl (LinkedList. ^Collection (mapv (fn [[k v]] (MapEntry/create k v)) ts))]
+             (fn [x] (let [i (.iterator ^Iterable tl)]
+                       (loop [x ^IPersistentVector x]
+                         (if (.hasNext i)
+                           (let [e ^MapEntry (.next i), k (.key e)]
+                             (recur (.assoc x k ((.val e) (.nth x k)))))
+                           x)))))
+     :cljs (fn [x] (reduce-kv -update x ts))))
+
+(defn -collection-transformer [t empty]
+  #?(:clj  (fn [x] (let [i (.iterator ^Iterable x)]
+                     (loop [x ^IPersistentCollection empty]
+                       (if (.hasNext i)
+                         (recur (.cons x (t (.next i))))
+                         x))))
+     :cljs (fn [x] (into (if x empty) (map t) x))))
+
+;;
+;; registry
+;;
 
 (defn- -register-var [registry v]
   (let [name (-> v meta :name)
@@ -437,12 +492,6 @@
       (-lookup ?schema options)
       (-fail! ::invalid-schema {:schema ?schema})))
 
-(defn -into-transformer [x]
-  (cond
-    (#?(:clj instance?, :cljs implements?) malli.core.Transformer x) x
-    (fn? x) (-into-transformer (x))
-    :else (-fail! ::invalid-transformer {:value x})))
-
 (defn- -property-registry [m options f]
   (let [options (assoc options ::allow-invalid-refs true)]
     (reduce-kv (fn [acc k v] (assoc acc k (f (schema v options)))) {} m)))
@@ -453,44 +502,6 @@
       [(assoc properties :registry (-property-registry r options f)) options])
     [properties options]))
 
-(defn -function-info [schema]
-  (if (= (type schema) :=>)
-    (let [[input output] (-children schema)
-          {:keys [min max]} (-regex-min-max input)]
-      (cond-> {:min min
-               :arity (if (= min max) min :varargs)
-               :input input
-               :output output}
-              max (assoc :max max)))))
-
-(defn -map-transformer [ts]
-  #?(:clj  (apply -comp (map (fn child-transformer [[k t]]
-                               (fn [^Associative x]
-                                 (if-let [e ^MapEntry (.entryAt x k)]
-                                   (.assoc x k (t (.val e))) x))) (rseq ts)))
-     :cljs (fn [x] (reduce (fn child-transformer [m [k t]]
-                             (if-let [entry (find m k)]
-                               (assoc m k (t (val entry)))
-                               m)) x ts))))
-
-(defn -tuple-transformer [ts]
-  #?(:clj  (let [tl (LinkedList. ^Collection (mapv (fn [[k v]] (MapEntry/create k v)) ts))]
-             (fn [x] (let [i (.iterator ^Iterable tl)]
-                       (loop [x ^IPersistentVector x]
-                         (if (.hasNext i)
-                           (let [e ^MapEntry (.next i), k (.key e)]
-                             (recur (.assoc x k ((.val e) (.nth x k)))))
-                           x)))))
-     :cljs (fn [x] (reduce-kv -update x ts))))
-
-(defn -collection-transformer [t empty]
-  #?(:clj  (fn [x] (let [i (.iterator ^Iterable x)]
-                     (loop [x ^IPersistentCollection empty]
-                       (if (.hasNext i)
-                         (recur (.cons x (t (.next i))))
-                         x))))
-     :cljs (fn [x] (into (if x empty) (map t) x))))
-
 ;;
 ;; simple schema helpers
 ;;