|
rlm@0
|
1 (ns sunil.curry)
|
|
rlm@0
|
2
|
|
rlm@0
|
3 (defmacro def-curry-fn [name args & body]
|
|
rlm@0
|
4 {:pre [(not-any? #{'&} args)]}
|
|
rlm@0
|
5 (if (empty? args)
|
|
rlm@0
|
6 `(defn ~name ~args ~@body)
|
|
rlm@0
|
7 (let [rec-funcs (reduce (fn [l v]
|
|
rlm@0
|
8 `(letfn [(helper#
|
|
rlm@0
|
9 ([] helper#)
|
|
rlm@0
|
10 ([x#] (let [~v x#] ~l))
|
|
rlm@0
|
11 ([x# & rest#] (let [~v x#]
|
|
rlm@0
|
12 (apply (helper# x#) rest#))))]
|
|
rlm@0
|
13 helper#))
|
|
rlm@0
|
14 `(do ~@body) (reverse args))]
|
|
rlm@0
|
15 `(defn ~name [& args#]
|
|
rlm@0
|
16 (let [helper# ~rec-funcs]
|
|
rlm@0
|
17 (apply helper# args#))))))
|
|
rlm@0
|
18
|
|
rlm@0
|
19
|
|
rlm@0
|
20 (defn partial+
|
|
rlm@0
|
21 "Takes a function f and fewer than the normal arguments to f, and
|
|
rlm@0
|
22 returns a fn that takes a variable number of additional args. When
|
|
rlm@0
|
23 called, the returned function calls f with args + additional args.
|
|
rlm@0
|
24 differs from the core version in that it works on just one argument."
|
|
rlm@0
|
25 {:added "1.0"}
|
|
rlm@0
|
26 ([f] f)
|
|
rlm@0
|
27 ([f arg1]
|
|
rlm@0
|
28 (fn [& args] (apply f arg1 args)))
|
|
rlm@0
|
29 ([f arg1 arg2]
|
|
rlm@0
|
30 (fn [& args] (apply f arg1 arg2 args)))
|
|
rlm@0
|
31 ([f arg1 arg2 arg3]
|
|
rlm@0
|
32 (fn [& args] (apply f arg1 arg2 arg3 args)))
|
|
rlm@0
|
33 ([f arg1 arg2 arg3 & more]
|
|
rlm@0
|
34 (fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))
|
|
rlm@0
|
35
|
|
rlm@0
|
36
|
|
rlm@0
|
37 (defmacro decorate
|
|
rlm@0
|
38 "given an unqualified symbol, redefines the associated var to exist in the current
|
|
rlm@0
|
39 namespace and be decorated with the array of decorators.
|
|
rlm@0
|
40 Example:
|
|
rlm@0
|
41 (decorate + memoize)"
|
|
rlm@0
|
42 [sym & decorations]
|
|
rlm@0
|
43 (let [decorations (vec decorations)
|
|
rlm@0
|
44 str-decorations (apply str (interleave decorations " "))]
|
|
rlm@0
|
45 `(let [target-var# (resolve (quote ~sym))
|
|
rlm@0
|
46 old-meta# (meta target-var#)
|
|
rlm@0
|
47 value-of-sym# (var-get target-var#)
|
|
rlm@0
|
48
|
|
rlm@0
|
49 new-meta# (update-in old-meta# [:doc]
|
|
rlm@0
|
50 #(str "*Decorated with: [ "
|
|
rlm@0
|
51 ~str-decorations "]*" \newline
|
|
rlm@0
|
52 %))]
|
|
rlm@0
|
53 (rlm.rlm-commands/undef ~sym)
|
|
rlm@0
|
54 (intern
|
|
rlm@0
|
55 *ns*
|
|
rlm@0
|
56 (with-meta (quote ~sym) new-meta#)
|
|
rlm@0
|
57 ((reduce comp identity (reverse ~decorations)) value-of-sym#)))))
|
|
rlm@0
|
58
|
|
rlm@0
|
59
|
|
rlm@0
|
60 (defmacro defn-decorated
|
|
rlm@0
|
61 "like defn except it accepts an additional vector of
|
|
rlm@0
|
62 decorator functions which will be applied to the base definition.
|
|
rlm@0
|
63 the decorators are applied in left-to-right order."
|
|
rlm@0
|
64 {:author "Robert McIntyre"
|
|
rlm@0
|
65 :arglists '[[name [modifers*] doc-string? attr-map? [params*] body]
|
|
rlm@0
|
66 [name [modifers*] doc-string? attr-map? ([params*] body) + attr-map?]]}
|
|
rlm@0
|
67 [fn-name decorators & defn-stuff]
|
|
rlm@0
|
68 `(do
|
|
rlm@0
|
69 (defn ~fn-name ~@defn-stuff)
|
|
rlm@0
|
70 (alter-var-root (var ~fn-name) (reduce comp identity (reverse ~decorators)))
|
|
rlm@0
|
71 (var ~fn-name)))
|
|
rlm@0
|
72
|
|
rlm@0
|
73
|
|
rlm@0
|
74 (defn curry+
|
|
rlm@0
|
75 "another way to do it, curry+, thanks to duncant"
|
|
rlm@0
|
76 ([num-args f eval-list]
|
|
rlm@0
|
77 (if (= num-args (count eval-list))
|
|
rlm@0
|
78 (apply f eval-list)
|
|
rlm@0
|
79 (fn [& args]
|
|
rlm@0
|
80 (curry+ num-args f (concat eval-list args)))))
|
|
rlm@0
|
81 ([num-args f]
|
|
rlm@0
|
82 (curry+ num-args f '())))
|
|
rlm@0
|
83
|
|
rlm@0
|
84 (defn curry**
|
|
rlm@0
|
85 "curry classic. rlm. consumes stack like a mother"
|
|
rlm@0
|
86 [num-args f]
|
|
rlm@0
|
87 (fn [& args]
|
|
rlm@0
|
88 (let [num-inputs (count args)]
|
|
rlm@0
|
89 (if (= num-inputs num-args)
|
|
rlm@0
|
90 (apply f args)
|
|
rlm@0
|
91 (curry** (- num-args num-inputs)
|
|
rlm@0
|
92 (fn [& more] (apply f (concat args more))))))))
|
|
rlm@0
|
93
|
|
rlm@0
|
94 (defn curry++
|
|
rlm@0
|
95 "takes a function with a fixed number of args and modifies
|
|
rlm@0
|
96 it to that it will be automaticaly curried when called with
|
|
rlm@0
|
97 less args"
|
|
rlm@0
|
98 ([num-args f & eval-list]
|
|
rlm@0
|
99 (if (= num-args (count eval-list))
|
|
rlm@0
|
100 (apply f eval-list)
|
|
rlm@0
|
101 (fn [& args]
|
|
rlm@0
|
102 (apply curry++ num-args f (concat eval-list args))))))
|
|
rlm@0
|
103
|
|
rlm@0
|
104
|
|
rlm@0
|
105
|
|
rlm@0
|
106
|
|
rlm@0
|
107 (def curry* (curry++ 2 curry++))
|
|
rlm@0
|
108
|
|
rlm@0
|
109 (defn-decorated
|
|
rlm@0
|
110 curry
|
|
rlm@0
|
111 [(curry* 2)]
|
|
rlm@0
|
112 "higher order function that enables automatic curying as in haskel, scheme"
|
|
rlm@0
|
113 {:author "Robert McIntyre"}
|
|
rlm@0
|
114 [number-of-args f]
|
|
rlm@0
|
115 (curry++ number-of-args f))
|
|
rlm@0
|
116
|
|
rlm@0
|
117
|
|
rlm@0
|
118
|
|
rlm@0
|
119 ;;; Example of Use
|
|
rlm@0
|
120
|
|
rlm@0
|
121 (defn-decorated
|
|
rlm@0
|
122 demo
|
|
rlm@0
|
123 [memoize (curry 3)]
|
|
rlm@0
|
124 "I like the vector of unitarty higher order transforms ---
|
|
rlm@0
|
125 sort of like a list of modifiers on a magic(tm) card.
|
|
rlm@0
|
126 This function has flying, resistance to black, etc :)"
|
|
rlm@0
|
127 [a b c]
|
|
rlm@0
|
128 (println "side effect")
|
|
rlm@0
|
129 (+ a b c))
|
|
rlm@0
|
130
|
|
rlm@0
|
131
|
|
rlm@0
|
132 ;; (((((demo1)) 1) 2) 3)
|
|
rlm@0
|
133 ;; 6
|
|
rlm@0
|
134
|
