# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1318924130 25200
# Node ID 7cef0e03f29e5da138e63dca134ac511d216c9ef

initial commit

diff -r 000000000000 -r 7cef0e03f29e src/sunil/curry.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sunil/curry.clj	Tue Oct 18 00:48:50 2011 -0700
@@ -0,0 +1,134 @@
+(ns sunil.curry)
+
+(defmacro def-curry-fn [name args & body]
+  {:pre [(not-any? #{'&} args)]}
+  (if (empty? args)
+    `(defn ~name ~args ~@body)
+    (let [rec-funcs (reduce (fn [l v]
+			      `(letfn [(helper#
+					([] helper#)
+					([x#] (let [~v x#] ~l))
+					([x# & rest#] (let [~v x#]
+							(apply (helper# x#) rest#))))]
+				 helper#))
+			    `(do ~@body) (reverse args))]
+      `(defn ~name [& args#]
+	 (let [helper# ~rec-funcs]
+	   (apply helper# args#))))))
+
+
+(defn partial+
+  "Takes a function f and fewer than the normal arguments to f, and
+  returns a fn that takes a variable number of additional args. When
+  called, the returned function calls f with args + additional args.
+  differs from the core version in that it works on just one argument."
+  {:added "1.0"}
+  ([f] f)
+  ([f arg1]
+   (fn [& args] (apply f arg1 args)))
+  ([f arg1 arg2]
+   (fn [& args] (apply f arg1 arg2 args)))
+  ([f arg1 arg2 arg3]
+   (fn [& args] (apply f arg1 arg2 arg3 args)))
+  ([f arg1 arg2 arg3 & more]
+   (fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))
+
+
+(defmacro decorate
+  "given an unqualified symbol, redefines the associated var to exist in the current
+   namespace and be decorated with the array of decorators.
+   Example:
+   (decorate + memoize)"
+  [sym & decorations]
+  (let 	[decorations (vec decorations)
+	 str-decorations (apply str (interleave decorations " "))]
+  `(let [target-var# (resolve (quote ~sym))
+	 old-meta# (meta target-var#)
+	 value-of-sym# (var-get target-var#)
+
+	 new-meta# (update-in old-meta# [:doc]
+			     #(str "*Decorated with: [ "
+				   ~str-decorations "]*"  \newline
+				   %))]
+     (rlm.rlm-commands/undef ~sym)
+     (intern
+      *ns*
+      (with-meta (quote ~sym) new-meta#)
+      ((reduce comp identity (reverse ~decorations)) value-of-sym#)))))
+    
+
+(defmacro defn-decorated
+  "like defn except it accepts an additional vector of
+   decorator functions which will be applied to the base definition.
+   the decorators are applied in left-to-right order."
+  {:author "Robert McIntyre"
+   :arglists '[[name [modifers*] doc-string? attr-map? [params*] body]
+	       [name [modifers*] doc-string? attr-map? ([params*] body) + attr-map?]]}
+  [fn-name decorators & defn-stuff]
+  `(do
+     (defn ~fn-name ~@defn-stuff)
+     (alter-var-root (var ~fn-name) (reduce comp identity (reverse ~decorators)))
+     (var ~fn-name)))
+
+
+(defn curry+
+  "another way to do it, curry+, thanks to duncant"
+  ([num-args f eval-list]
+     (if (= num-args (count eval-list))
+       (apply f eval-list)
+       (fn [& args]
+	 (curry+ num-args f (concat eval-list args)))))
+  ([num-args f]
+     (curry+ num-args f '())))
+
+(defn curry**
+  "curry classic. rlm. consumes stack like a mother"
+  [num-args f]
+  (fn [& args]
+    (let [num-inputs (count args)]
+      (if (= num-inputs num-args)
+	(apply f args)
+	(curry** (- num-args num-inputs)
+		 (fn [& more] (apply f (concat args more))))))))
+
+(defn curry++
+  "takes a function with a fixed number of args and modifies
+   it to that it will be automaticaly curried when called with
+   less args"
+  ([num-args f & eval-list]
+     (if (= num-args (count eval-list))
+       (apply f eval-list)
+       (fn [& args]
+	 (apply curry++ num-args f (concat eval-list args))))))
+
+  
+
+
+(def curry* (curry++ 2 curry++))
+
+(defn-decorated
+  curry
+  [(curry* 2)]
+  "higher order function that enables automatic curying as in haskel, scheme"
+  {:author "Robert McIntyre"}
+  [number-of-args f]
+  (curry++ number-of-args f))
+
+
+
+;;; Example of Use
+
+(defn-decorated
+  demo
+  [memoize (curry 3)]
+  "I like the vector of unitarty higher order transforms ---
+   sort of like a list of modifiers on a magic(tm) card.
+   This function has flying, resistance to black, etc :)"
+  [a b c]
+  (println "side effect")
+  (+ a b c))
+
+
+;; (((((demo1)) 1) 2) 3)
+;; 6
+