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