From c122e3e32e324cb1aa7be46b8fffb723f2c5ad3c Mon Sep 17 00:00:00 2001 From: Alan Malloy Date: Thu, 4 Aug 2011 18:29:20 -0700 Subject: [PATCH] Make wrapping-related stuff more function and less macro. Allow already-defined vars to be altered for use with wrappers --- src/useful/experimental.clj | 45 +++++++----- test/useful/experimental_test.clj | 115 ++++++++++++++++++------------ 2 files changed, 95 insertions(+), 65 deletions(-) diff --git a/src/useful/experimental.clj b/src/useful/experimental.clj index f1714a8..c9de65d 100644 --- a/src/useful/experimental.clj +++ b/src/useful/experimental.clj @@ -130,6 +130,30 @@ (extend ~name ~@(apply concat proto-fns)))))) +(defn wrap-with [f wrapper-var & [name]] + (with-meta + (fn [& args] + (let [wrappers (not-empty @wrapper-var)] + (if-not wrappers + (apply f args) + (with-bindings {wrapper-var + (vary-meta wrappers assoc + ::call-data {:fn-name name})} + (apply (reduce (fn [f wrapper] + (wrapper f)) + f + wrappers) + args))))) + (meta f))) + +(defn make-wrappable! [fn-var wrappers-var & [name]] + (alter-var-root fn-var wrap-with wrappers-var name)) + +(defmacro wrap-multiple [wrappers-var & fn-syms] + (cons `do + (for [f fn-syms] + `(make-wrappable! #'~f ~wrappers-var '~f)))) + (defmacro defn-wrapping "Define a function as with defn, which checks the contents of wrappers-var whenever it is called. If that var is empty, the underlying defn is called @@ -155,24 +179,9 @@ Note the order of the wrapping: when called with 10 as an argument, the former will return -40, and the latter 0." [name wrappers-var & defn-args] - (let [[name macro-args] (name-with-attributes name defn-args) - fake-defn-name (gensym 'tmp)] - `(let [impl# (fn ~@macro-args) - fake-defn-var# (defn ~fake-defn-name ~@macro-args) - arglists# (-> fake-defn-var# meta :arglists)] - (ns-unmap *ns* '~fake-defn-name) - (defn ~name {:arglists arglists#} [& args#] - (let [wrappers# (not-empty @~wrappers-var)] - (if-not wrappers# - (apply impl# args#) - (with-bindings {~wrappers-var - (vary-meta wrappers# assoc - ::call-data {:fn-name '~name})} - (apply (reduce (fn [f# wrapper#] - (wrapper# f#)) - impl# - wrappers#) - args#)))))))) + (let [[name macro-args] (name-with-attributes name defn-args)] + `(doto (defn ~name ~@macro-args) + (make-wrappable! ~wrappers-var '~name)))) (defmacro with-wrappers "Dynamically bind some additional wrappers to the specified wrapper-var diff --git a/test/useful/experimental_test.clj b/test/useful/experimental_test.clj index 6552010..a17caed 100644 --- a/test/useful/experimental_test.clj +++ b/test/useful/experimental_test.clj @@ -65,51 +65,72 @@ (is (= {:f 'lookup :args [1] :ret :not-found} @call-log))))) (deftest wrapper-test - (testing "Wrapping respects manually-established bindings" - (with-local-vars [wrappers ()] - (defn-wrapping my-inc wrappers "add one" [x] - (+ 1 x)) - (is (= 2 (my-inc 1))) - (let [start-num 1] - (is (= (* 2 (inc (+ 10 start-num))) - (with-bindings {wrappers (list (fn [f] ;; outermost wrapper - (fn [x] - (* 2 (f x)))) - (fn [f] ;; innermost wrapper - (fn [x] - (f (+ 10 x)))))} - (my-inc start-num))))) - (let [call-log (atom nil)] - (is (= 2 (with-bindings {wrappers (list (fn [f] + (with-local-vars [dummy-wrapper ()] + (testing "Wrapping respects manually-established bindings" + (with-local-vars [wrappers ()] + (defn-wrapping my-inc wrappers "add one" [x] + (+ 1 x)) + (is (= 2 (my-inc 1))) + (let [start-num 1] + (is (= (* 2 (inc (+ 10 start-num))) + (with-bindings {wrappers (list (fn [f] ;; outermost wrapper (fn [x] - (let [ret (f x)] - (reset! call-log [(-> wrappers deref meta :useful.experimental/call-data :fn-name) x ret]) - ret))))} - (my-inc 1)))) - (testing "Wrapping-related metadata bound correctly" - (is (= ['my-inc 1 2] @call-log)))))) - - (testing "with-wrapper(s) works" - (let [prepend (fn [item] (fn [f] (fn [& args] (apply f item args)))) - append (fn [item] (fn [f] (fn [& args] (apply f (concat args [item])))))] - (with-local-vars [vec-wrapper [] - cons-wrapper ()] - (defn-wrapping vec-str vec-wrapper "Make stuff a string" [& args] - (apply str args)) - (defn-wrapping cons-str cons-wrapper "Make stuff a string" [& args] - (apply str args)) - (with-wrapper vec-wrapper (prepend 'foo) - (is (= "foo123" (vec-str 1 2 3))) - (with-wrapper vec-wrapper (append 'bar) - (is (= "foo123bar" (vec-str 1 2 3))) - (with-wrapper vec-wrapper (prepend 'baz) - (is (= "foobaz123bar" (vec-str 1 2 3)))))) - (with-wrappers cons-wrapper [(prepend 'foo) (append 'bar) (prepend 'baz)] - (is (= "bazfoo123bar" (cons-str 1 2 3))))))) - - (testing "Metadata is applied properly" - (defn-wrapping myfn nil "re-implement clojure.core/first." [[x]] - x) - (let [meta (meta #'myfn)] - (is (= '([[x]]) (:arglists meta))) - (is (= "re-implement clojure.core/first." (:doc meta)))))) + (* 2 (f x)))) + (fn [f] ;; innermost wrapper + (fn [x] + (f (+ 10 x)))))} + (my-inc start-num))))) + (let [call-log (atom nil)] + (is (= 2 (with-bindings {wrappers (list (fn [f] + (fn [x] + (let [ret (f x)] + (reset! call-log [(-> wrappers deref meta :useful.experimental/call-data :fn-name) x ret]) + ret))))} + (my-inc 1)))) + (testing "Wrapping-related metadata bound correctly" + (is (= ['my-inc 1 2] @call-log)))))) + + (testing "with-wrapper(s) works" + (let [prepend (fn [item] (fn [f] (fn [& args] (apply f item args)))) + append (fn [item] (fn [f] (fn [& args] (apply f (concat args [item])))))] + (with-local-vars [vec-wrapper [] + cons-wrapper ()] + (defn-wrapping vec-str vec-wrapper "Make stuff a string" [& args] + (apply str args)) + (defn-wrapping cons-str cons-wrapper "Make stuff a string" [& args] + (apply str args)) + (with-wrapper vec-wrapper (prepend 'foo) + (is (= "foo123" (vec-str 1 2 3))) + (with-wrapper vec-wrapper (append 'bar) + (is (= "foo123bar" (vec-str 1 2 3))) + (with-wrapper vec-wrapper (prepend 'baz) + (is (= "foobaz123bar" (vec-str 1 2 3)))))) + (with-wrappers cons-wrapper [(prepend 'foo) (append 'bar) (prepend 'baz)] + (is (= "bazfoo123bar" (cons-str 1 2 3))))))) + + (testing "Metadata is applied properly" + (defn-wrapping myfn dummy-wrapper "re-implement clojure.core/first." [[x]] + x) + (let [meta (meta #'myfn)] + (is (= '([[x]]) (:arglists meta))) + (is (= "re-implement clojure.core/first." (:doc meta)))) + + (testing "Docstring is optional" + (defn-wrapping testfn dummy-wrapper [x] + (inc x)) + (is (= 1 (testfn 0))))) + + (let [inc-fn (fn [f] (comp inc f))] + (testing "Wrapper can be added after function is defined" + (defn frizzle [x] (inc x)) + (make-wrappable! #'frizzle dummy-wrapper) + (is (= 3 (with-wrapper dummy-wrapper inc-fn + (frizzle 1))))) + + (testing "wrap-multiple" + (defn frazzle [x] (inc x)) + (defn zazzle [x] (inc x)) + (wrap-multiple dummy-wrapper frazzle zazzle) + (are [f] (= 3 (with-wrapper dummy-wrapper inc-fn + (f 1))) + frazzle zazzle)))))