diff --git a/.gitignore b/.gitignore index 09c00cba..dfcde2b0 100644 --- a/.gitignore +++ b/.gitignore @@ -6,4 +6,5 @@ out/ pom.xml *.asc /doc/ -.nrepl-port \ No newline at end of file +.nrepl-port +.cpcache/ diff --git a/CHANGELOG.md b/CHANGELOG.md index 2d4a675a..a75abdcb 100644 --- a/CHANGELOG.md +++ b/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) diff --git a/project.clj b/project.clj index 6173eea0..630b1fdc 100644 --- a/project.clj +++ b/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"] diff --git a/src/cljc/schema/core.cljc b/src/cljc/schema/core.cljc index ae9f9e47..5f019f33 100644 --- a/src/cljc/schema/core.cljc +++ b/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 diff --git a/test/cljc/schema/core_test.cljc b/test/cljc/schema/core_test.cljc index d795073e..6a59a294 100644 --- a/test/cljc/schema/core_test.cljc +++ b/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