accumulators: implement clojure.contrib.generic.arithmethic/+ as a synonym for combine

1 files changed, 46 insertions, 21 deletions

diff --git a/src/clojure/contrib/accumulators.clj b/src/clojure/contrib/accumulators.clj
index d32dbda6..524bf7f7 100644
--- a/src/clojure/contrib/accumulators.clj
+++ b/src/clojure/contrib/accumulators.clj
@@ -1,7 +1,7 @@
 ;; Accumulators
 
 ;; by Konrad Hinsen
-;; last updated March 11, 2009
+;; last updated April 17, 2009
 
 ;; This module defines various accumulators (list, vector, map,
 ;; sum, product, counter, and combinations thereof) with a common
@@ -20,7 +20,8 @@
 
 (ns clojure.contrib.accumulators
   (:use [clojure.contrib.types :only (deftype)])
-  (:use [clojure.contrib.def :only (defvar defvar- defmacro-)]))
+  (:use [clojure.contrib.def :only (defvar defvar- defmacro-)])
+  (:require [clojure.contrib.generic.arithmetic :as ga]))
 
 (defmulti add
   "Add item to the accumulator acc. The exact meaning of adding an
@@ -39,39 +40,61 @@
   {:arglists '([& accs])}
   (fn [& accs] (type (first accs))))
 
+;
+; An ::accumulator type tag is attached to tbe built-in types
+; when used as accumulators, and new types are derived from it.
+; Multimethods add and combine for ::accumulator sub-dispatch on class.
+; We also define generic addition as the combine operation.
+;
+(let [meta-map {:type ::accumulator}]
+  (defn- with-acc-tag
+    [x]
+    (with-meta x meta-map)))
+
+(defmethod add ::accumulator
+  [a e]
+  ((get-method add (class a)) a e))
+
+(defmethod combine ::accumulator
+  [& as]
+  (apply (get-method add (class (first as))) as))
+
+(defmethod ga/+ ::accumulator
+  [x y]
+  (combine x y))
 
 ;
 ; Vector accumulator
 ;
-(defvar empty-vector []
+(defvar empty-vector (with-acc-tag [])
   "An empty vector accumulator. Adding an item appends it at the end.")
 
 (defmethod combine clojure.lang.IPersistentVector
   [& vs]
-  (vec (apply concat vs)))
+  (with-acc-tag (vec (apply concat vs))))
 
 (defmethod add clojure.lang.IPersistentVector
   [v e]
-  (conj v e))
+  (with-acc-tag (conj v e)))
 
 ;
 ; List accumulator
 ;
-(defvar empty-list '()
+(defvar empty-list (with-acc-tag '())
   "An empty list accumulator. Adding an item appends it at the beginning.")
 
 (defmethod combine clojure.lang.IPersistentList
   [& vs]
-  (apply concat vs))
+  (with-acc-tag (apply concat vs)))
 
 (defmethod add clojure.lang.IPersistentList
   [v e]
-  (conj v e))
+  (with-acc-tag (conj v e)))
 
 ;
 ; Queue accumulator
 ;
-(defvar empty-queue clojure.lang.PersistentQueue/EMPTY
+(defvar empty-queue (with-acc-tag clojure.lang.PersistentQueue/EMPTY)
   "An empty queue accumulator. Adding an item appends it at the end.")
 
 (defmethod combine clojure.lang.PersistentQueue
@@ -80,26 +103,21 @@
 
 (defmethod add clojure.lang.PersistentQueue
   [v e]
-  (conj v e))
+  (with-acc-tag (conj v e)))
 
 ;
 ; Set accumulator
 ;
-(defvar empty-set #{}
+(defvar empty-set (with-acc-tag #{})
   "An empty set accumulator.")
 
-; A multi-argument version of set/union
-(defn- union
-  [set & sets]
-  (reduce clojure.set/union set sets))
-
 (defmethod combine (class empty-set)
   [& vs]
-  (apply union vs))
+  (with-acc-tag (apply clojure.set/union vs)))
 
 (defmethod add (class empty-set)
   [v e]
-  (conj v e))
+  (with-acc-tag (conj v e)))
 
 ;
 ; String accumulator
@@ -119,16 +137,16 @@
 ;
 ; Map accumulator
 ;
-(defvar empty-map {}
+(defvar empty-map (with-acc-tag {})
   "An empty map accumulator. Items to be added must be [key value] pairs.")
 
 (defmethod combine clojure.lang.IPersistentMap
   [& vs]
-  (apply merge vs))
+  (with-acc-tag (apply merge vs)))
 
 (defmethod add clojure.lang.IPersistentMap
   [v e]
-  (conj v e))
+  (with-acc-tag (conj v e)))
 
 ;
 ; Numerical accumulators: sum, product, minimum, maximum
@@ -141,6 +159,7 @@
      (deftype ~type-tag ~name
        (fn [~'x] {:value ~'x})
        (fn [~'x] (list (:value ~'x))))
+     (derive ~type-tag ::accumulator)
      (defvar ~empty-symbol (~name ~empty) ~doc-string)
      (defmethod combine ~type-tag [& vs#]
        (~name (apply op# (map :value vs#))))
@@ -178,6 +197,8 @@
   (fn [min max] {:min min :max max})
   (fn [mm] (list (:min mm) (:max mm))))
 
+(derive ::min-max ::accumulator)
+
 (defvar empty-min-max (min-max nil nil)
   "An empty min-max accumulator, combining minimum and maximum.
    Only numbers can be added.")
@@ -201,6 +222,8 @@
 ;
 (deftype ::counter counter)
 
+(derive ::counter ::accumulator)
+
 (defvar empty-counter (counter {})
   "An empty counter accumulator. Its value is a map that stores for
    every item the number of times it was added.")
@@ -238,6 +261,8 @@
 ;
 (deftype ::tuple acc-tuple)
 
+(derive ::tuple ::accumulator)
+
 (defn empty-tuple
   "Returns an accumulator tuple with the supplied empty-accumulators
    as its value. Accumulator tuples consist of several accumulators that