Mercurial > curry

     1 (ns sunil.curry)

     2 

     3 (defmacro def-curry-fn [name args & body]

     4   {:pre [(not-any? #{'&} args)]}

     5   (if (empty? args)

     6     `(defn ~name ~args ~@body)

     7     (let [rec-funcs (reduce (fn [l v]

     8 			      `(letfn [(helper#

     9 					([] helper#)

    10 					([x#] (let [~v x#] ~l))

    11 					([x# & rest#] (let [~v x#]

    12 							(apply (helper# x#) rest#))))]

    13 				 helper#))

    14 			    `(do ~@body) (reverse args))]

    15       `(defn ~name [& args#]

    16 	 (let [helper# ~rec-funcs]

    17 	   (apply helper# args#))))))

    18 

    19 

    20 (defn partial+

    21   "Takes a function f and fewer than the normal arguments to f, and

    22   returns a fn that takes a variable number of additional args. When

    23   called, the returned function calls f with args + additional args.

    24   differs from the core version in that it works on just one argument."

    25   {:added "1.0"}

    26   ([f] f)

    27   ([f arg1]

    28    (fn [& args] (apply f arg1 args)))

    29   ([f arg1 arg2]

    30    (fn [& args] (apply f arg1 arg2 args)))

    31   ([f arg1 arg2 arg3]

    32    (fn [& args] (apply f arg1 arg2 arg3 args)))

    33   ([f arg1 arg2 arg3 & more]

    34    (fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))

    35 

    36 

    37 (defmacro decorate

    38   "given an unqualified symbol, redefines the associated var to exist in the current

    39    namespace and be decorated with the array of decorators.

    40    Example:

    41    (decorate + memoize)"

    42   [sym & decorations]

    43   (let 	[decorations (vec decorations)

    44 	 str-decorations (apply str (interleave decorations " "))]

    45   `(let [target-var# (resolve (quote ~sym))

    46 	 old-meta# (meta target-var#)

    47 	 value-of-sym# (var-get target-var#)

    48 

    49 	 new-meta# (update-in old-meta# [:doc]

    50 			     #(str "*Decorated with: [ "

    51 				   ~str-decorations "]*"  \newline

    52 				   %))]

    53      (rlm.rlm-commands/undef ~sym)

    54      (intern

    55       *ns*

    56       (with-meta (quote ~sym) new-meta#)

    57       ((reduce comp identity (reverse ~decorations)) value-of-sym#)))))

    58     

    59 

    60 (defmacro defn-decorated

    61   "like defn except it accepts an additional vector of

    62    decorator functions which will be applied to the base definition.

    63    the decorators are applied in left-to-right order."

    64   {:author "Robert McIntyre"

    65    :arglists '[[name [modifers*] doc-string? attr-map? [params*] body]

    66 	       [name [modifers*] doc-string? attr-map? ([params*] body) + attr-map?]]}

    67   [fn-name decorators & defn-stuff]

    68   `(do

    69      (defn ~fn-name ~@defn-stuff)

    70      (alter-var-root (var ~fn-name) (reduce comp identity (reverse ~decorators)))

    71      (var ~fn-name)))

    72 

    73 

    74 (defn curry+

    75   "another way to do it, curry+, thanks to duncant"

    76   ([num-args f eval-list]

    77      (if (= num-args (count eval-list))

    78        (apply f eval-list)

    79        (fn [& args]

    80 	 (curry+ num-args f (concat eval-list args)))))

    81   ([num-args f]

    82      (curry+ num-args f '())))

    83 

    84 (defn curry**

    85   "curry classic. rlm. consumes stack like a mother"

    86   [num-args f]

    87   (fn [& args]

    88     (let [num-inputs (count args)]

    89       (if (= num-inputs num-args)

    90 	(apply f args)

    91 	(curry** (- num-args num-inputs)

    92 		 (fn [& more] (apply f (concat args more))))))))

    93 

    94 (defn curry++

    95   "takes a function with a fixed number of args and modifies

    96    it to that it will be automaticaly curried when called with

    97    less args"

    98   ([num-args f & eval-list]

    99      (if (= num-args (count eval-list))

   100        (apply f eval-list)

   101        (fn [& args]

   102 	 (apply curry++ num-args f (concat eval-list args))))))

   103 

   104   

   105 

   106 

   107 (def curry* (curry++ 2 curry++))

   108 

   109 (defn-decorated

   110   curry

   111   [(curry* 2)]

   112   "higher order function that enables automatic curying as in haskel, scheme"

   113   {:author "Robert McIntyre"}

   114   [number-of-args f]

   115   (curry++ number-of-args f))

   116 

   117 

   118 

   119 ;;; Example of Use

   120 

   121 (defn-decorated

   122   demo

   123   [memoize (curry 3)]

   124   "I like the vector of unitarty higher order transforms ---

   125    sort of like a list of modifiers on a magic(tm) card.

   126    This function has flying, resistance to black, etc :)"

   127   [a b c]

   128   (println "side effect")

   129   (+ a b c))

   130 

   131 

   132 ;; (((((demo1)) 1) 2) 3)

   133 ;; 6

   134
author	Robert McIntyre <rlm@mit.edu>
date	Tue, 18 Oct 2011 00:48:50 -0700
parents
children