Fix s/fn performance issues in Clojure

.gitignore

@@ -6,4 +6,5 @@ out/
 pom.xml
 *.asc
 /doc/
-.nrepl-port
+.nrepl-port
+.cpcache/

CHANGELOG.md

@@ -1,5 +1,6 @@
 ## NEXT
  * Fix mutually recursive `s/letfn` bindings
+ * Fix `s/fn` perf caveats in Clojure by avoiding wrappers
 
 ## 1.2.0 (`2021-11-03`)
  * **BREAKING** use `cljc` instead of `cljx`, which requires Clojure 1.7 or later. (#425)

project.clj

@@ -13,15 +13,14 @@
                              [lein-cljsbuild "1.1.7"]
                              [lein-release/lein-release "1.0.4"]
                              [lein-doo "0.1.10"]]}
-             :1.7 {:dependencies [[org.clojure/clojure "1.7.0"] [org.clojure/clojurescript "1.10.520"]]}
              :1.9 {:dependencies [[org.clojure/clojure "1.9.0"] [org.clojure/clojurescript "1.10.520"]]}
              :1.10 {:dependencies [[org.clojure/clojure "1.10.3"] [org.clojure/clojurescript "1.10.879"]]}
              :1.11 {:dependencies [[org.clojure/clojure "1.11.0-master-SNAPSHOT"] [org.clojure/clojurescript "1.10.879"]]
                     :repositories [["sonatype-oss-public" {:url "https://oss.sonatype.org/content/groups/public"}]]}}
 
-  :aliases {"all" ["with-profile" "dev:dev,1.7:dev,1.9:dev,1.10:dev,1.11"]
+  :aliases {"all" ["with-profile" "+dev:+1.9:+1.10:+1.11"]
             "deploy" ["do" "clean," "deploy" "clojars"]
-            "test" ["do" "clean," "test," "with-profile" "dev" "doo" "node" "test" "once"]}
+            "test" ["do" "clean," "test," "doo" "node" "test" "once"]}
 
   :jar-exclusions [#"\.swp|\.swo|\.DS_Store"]
 

src/cljc/schema/core.cljc

@@ -1276,20 +1276,27 @@
       don't supply a name, schema will gensym one for you and attach
       the schema.
     - Unlike s/defn, the function schema is stored in metadata on the
-      fn.  Clojure's implementation for metadata on fns currently
-      produces a wrapper fn, which will decrease performance and
-      negate the benefits of primitive type hints compared to
-      clojure.core/fn."
+      fn. The implications of this differ per platform:
+      :clj   The resulting function has the same performance characteristics
+             as clojure.core/fn. Additionally, the following invariant
+             holds for all parameters and schema annotations:
+               (let [f (s/fn this ... [...] this)]
+                 (assert (identical? f (f ...))))
+      :cljs  Returns a wrapper function that forwards arguments positionally
+             up to 20 arguments, and then via `apply` beyond 20 arguments.
+             See `cljs.core/with-meta` and `cljs.core.MetaFn`."
   [& fn-args]
   (let [fn-args (if (symbol? (first fn-args))
                   fn-args
                   (cons (gensym "fn") fn-args))
         [name more-fn-args] (macros/extract-arrow-schematized-element &env fn-args)
         {:keys [outer-bindings schema-form fn-body]} (macros/process-fn- &env name more-fn-args)]
-    `(let ~outer-bindings
-       (schematize-fn
-        ~(vary-meta `(clojure.core/fn ~name ~@fn-body) #(merge (meta &form) %))
-        ~schema-form)))))
+    `(let [~@outer-bindings
+           ;; let bind to work around https://clojure.atlassian.net/browse/CLJS-968
+           f# ~(vary-meta `(clojure.core/fn ~name ~@fn-body)
+                          #(assoc (merge (meta &form) %)
+                                  :schema schema-form))]
+       f#))))
 
 #?(:clj
 (defmacro defn

test/cljc/schema/core_test.cljc

@@ -865,6 +865,11 @@
   (let [f (s/fn ^s/Str foo [^OddLong arg0 arg1])]
     (is (= +test-fn-schema+ (s/fn-schema f)))))
 
+#?(:clj
+(deftest no-wrapper-fn-test
+  (let [f (s/fn this [] this)]
+    (is (identical? f (f))))))
+
 (deftest no-schema-fn-test
   (let [f (s/fn [arg0 arg1] (+ arg0 arg1))]
     (is (= (s/=> s/Any s/Any s/Any) (s/fn-schema f)))
@@ -873,8 +878,10 @@
     (is (= 4 (f 1 3)))))
 
 (deftest simple-validated-fn-test
-  (let [f (s/fn test-fn :- (s/pred even?)
+  (let [fthiss (atom [])
+        f (s/fn test-fn :- (s/pred even?)
             [^s/Int x y :- {:foo (s/both s/Int (s/pred odd?))}]
+            (swap! fthiss conj test-fn)
             (+ x (:foo y -100)))]
     (s/with-fn-validation
       (is (= 4 (f 1 {:foo 3})))
@@ -886,18 +893,21 @@
     (is (= 5 (f 1 {:foo 4})))     ;; foo not odd?
     (is (= 4.0 (f 1.0 {:foo 3}))) ;; first arg not long
     (is (= 5 (f 2 {:foo 3})))     ;; return not even?
-    (testing
-        "Tests that the anonymous function schema macro can handle a
-         name, a schema without a name and no return schema."
-      (let [named-square (s/fn square :- s/Int [x :- s/Int]
-                           (* x x))
-            anon-square (s/fn :- s/Int [x :- s/Int]
-                          (* x x))
-            arg-only-square (s/fn [x :- s/Int] (* x x))]
-        (is (= 100
-               (named-square 10)
-               (anon-square 10)
-               (arg-only-square 10)))))))
+    (let [fthiss @fthiss]
+      (is (seq fthiss))
+      #?(:clj (is (every? #(identical? % f) fthiss)))))
+  (testing
+    "Tests that the anonymous function schema macro can handle a
+    name, a schema without a name and no return schema."
+    (let [named-square (s/fn square :- s/Int [x :- s/Int]
+                         (* x x))
+          anon-square (s/fn :- s/Int [x :- s/Int]
+                        (* x x))
+          arg-only-square (s/fn [x :- s/Int] (* x x))]
+      (is (= 100
+             (named-square 10)
+             (anon-square 10)
+             (arg-only-square 10))))))
 
 
 
@@ -996,14 +1006,20 @@
 
 (deftest rest-arg-destructuring-test
   (testing "no schema"
-    (let [f (s/fn foo :- s/Int
-              [^s/Int arg0 & [rest0]] (+ arg0 (or rest0 2)))]
+    (let [fthiss (atom [])
+          f (s/fn foo :- s/Int
+              [^s/Int arg0 & [rest0]]
+              (swap! fthiss conj foo)
+              (+ arg0 (or rest0 2)))]
       (is (= (s/=>* s/Int [s/Int & [(s/optional s/Any 'rest0)]])
              (s/fn-schema f)))
       (s/with-fn-validation
         (is (= 6 (f 4)))
         (is (= 9 (f 4 5)))
-        (invalid-call! f 4 9 2))))
+        (invalid-call! f 4 9 2))
+      (let [fthiss @fthiss]
+        (is (seq fthiss))
+        #?(:clj (is (every? #(identical? % f) fthiss))))))
   (testing "arg schema"
     (let [f (s/fn foo :- s/Int
               [^s/Int arg0 & [rest0 :- s/Int]] (+ arg0 (or rest0 2)))]
@@ -1039,11 +1055,10 @@
       (s/with-fn-validation
         (is (= 120 (f 5 1)))))))
 
-#?(:clj ;; in ClojureScript, metadata on ordinary fn form does not propagate to fn either.
 (deftest fn-metadata-test
   (let [->mkeys #(set (keys (meta %)))]
     (is (= (into (->mkeys (s/fn [])) [:blah])
-           (->mkeys ^:blah (s/fn [])))))))
+           (->mkeys ^:blah (s/fn []))))))
 
 ;;; defn