(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