diff --git a/Data/Monoid/Combinators.hs b/Data/Monoid/Combinators.hs
--- a/Data/Monoid/Combinators.hs
+++ b/Data/Monoid/Combinators.hs
@@ -27,7 +27,6 @@
     ) where
 
 import Prelude hiding (replicate, cycle, repeat)
-import Control.Monad (MonadPlus)
 import Data.Monoid.Reducer
 import Test.QuickCheck
 
diff --git a/Data/Monoid/Union.hs b/Data/Monoid/Union.hs
--- a/Data/Monoid/Union.hs
+++ b/Data/Monoid/Union.hs
@@ -29,7 +29,7 @@
 
 import Control.Functor.Pointed
 
-import Data.Monoid.Reducer (Reducer, unit, cons, snoc, Monoid, mappend, mempty)
+import Data.Monoid.Reducer
 
 -- | A Container suitable for the 'Union' 'Monoid'
 class HasUnion f where
@@ -82,7 +82,7 @@
     extract = getUnion
 
 -- | Polymorphic containers that we can supply an operation to handle unions with
-class HasUnionWith f where
+class Functor f => HasUnionWith f where
     {-# SPECIALIZE unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a #-}
     {-# SPECIALIZE unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a #-}
     unionWith :: (a -> a -> a) -> f a -> f a -> f a
@@ -96,7 +96,6 @@
     emptyWith = Map.empty
     unionWith = Map.unionWith
 
-
 -- | The 'Monoid' @('unionWith mappend','empty')@ for containers full of monoids.
 newtype UnionWith f m = UnionWith { getUnionWith :: f m } 
     deriving (Eq,Ord,Show,Read,Functor,Pointed,Monad)
@@ -108,3 +107,4 @@
 instance (HasUnionWith f, Monoid m) => Reducer (f m) (UnionWith f m) where
     unit = UnionWith
 
+-- we want an absorbing 0, for that we need a seminearring and a notion of equality
diff --git a/Data/Ring/Module.hs b/Data/Ring/Module.hs
--- a/Data/Ring/Module.hs
+++ b/Data/Ring/Module.hs
@@ -24,6 +24,8 @@
     ) where
 
 import Data.Ring
+import Data.Monoid.Union
+
 -- import qualified Data.Monoid.Combinators as Monoid
 
 -- | @ (x * y) *. m = x * (y *. m) @
@@ -59,3 +61,13 @@
 instance (Module r m, Module r n, Module r o) => Module r (m,n,o)
 instance (Module r m, Module r n, Module r o, Module r p) => Module r (m,n,o,p)
 instance (Module r m, Module r n, Module r o, Module r p, Module r q) => Module r (m,n,o,p,q)
+
+
+-- we want an absorbing 0, for that we need a seminearring and a notion of equality
+instance (HasUnionWith f, Ord r, Eq r, RightSemiNearRing r) => LeftModule r (UnionWith f r) where
+    r *. m | r == zero = zero
+           | otherwise = fmap (r `times`) m
+instance (HasUnionWith f, Ord r, Eq r, RightSemiNearRing r) => RightModule r (UnionWith f r) where
+    m .* r | r == zero = zero
+           | otherwise = fmap (`times` r) m
+instance (HasUnionWith f, Ord r, Eq r, RightSemiNearRing r) => Module r (UnionWith f r) where
diff --git a/Data/Ring/Semi/BitSet.hs b/Data/Ring/Semi/BitSet.hs
new file mode 100644
--- /dev/null
+++ b/Data/Ring/Semi/BitSet.hs
@@ -0,0 +1,279 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, DeriveDataTypeable, BangPatterns, PatternGuards, TypeFamilies #-}
+module Data.Ring.Semi.BitSet
+    ( module Data.Monoid.Reducer
+    , BitSet
+    , empty
+    , singleton
+    , null
+    , full
+    , complement
+    , insert
+    , delete
+    , fromList
+    , fromDistinctAscList
+    , toInteger
+    , (\\)
+    , member
+    , size
+    ) where
+
+import Prelude hiding ( null, exponent, toInteger )
+import Data.Bits hiding ( complement )
+import qualified Data.Bits as Bits
+import Data.Data
+import Data.Ring.Semi.Natural
+import Data.Monoid.Reducer
+import Data.Generator
+import Data.Ring.Algebra
+
+data BitSet a = BS 
+        { _countAtLeast  :: {-# UNPACK #-} !Int       -- ^ a conservative upper bound on the element count
+        , _countAtMost   :: {-# UNPACK #-} !Int       -- ^ a conservative lower bound on the element count
+        , _count         :: Int                       -- ^ the actual element count (lazy) used when the above two disagree
+        , exponent       :: {-# UNPACK #-} !Int       -- ^ low water mark
+        , _hwm           :: {-# UNPACK #-} !Int       -- ^ high water mark
+        , mantissa       :: {-# UNPACK #-} !Integer   -- ^ the set of bits. TODO: negative mantissa = complement
+        , _universe      :: (Int,Int)                 -- ^ invariant: mantissa < 0 => universe = (fromEnum minBound,fromEnum maxBound)
+        } deriving (Data, Typeable,Show)
+
+debug :: BitSet a -> (Int,Int,Int,Int,Int,Integer)
+debug (BS a b c d e f _) = (a,b,c,d,e,f)
+
+-- | internal smart constructor: makes sure the count is forced when known
+bs :: Int -> Int -> Int -> Int -> Int -> Integer -> (Int,Int) -> BitSet a
+bs !a !b c !l !h !m u | a == b = BS a a a l h m u
+                      | otherwise = BS a b c l h m u
+{-# INLINE bs #-}
+
+-- instance (Enum a, Show a) => Show (BitSet a) where
+--    show s = "fromDistinctAscList " ++ show (toList s) ++ 
+
+-- | /O(d)/ where /d/ is absolute deviation in fromEnum from the least element in the set.
+toList :: Enum a => BitSet a -> [a]
+toList (BS _ _ _ l h m u) 
+    | m < 0 = map toEnum [ul..max (pred l) ul] ++ toList' l (map toEnum [min (succ h) uh..uh])
+    | otherwise = toList' 0 []
+    where
+        ~(ul,uh) = u
+        toList' :: Enum a => Int -> [a] -> [a]
+        toList' !n t | n > h = t
+                     | testBit m (n - l) = toEnum n : toList' (n+1) t
+                     | otherwise         = toList' (n+1) t
+{-# INLINE toList #-}
+
+-- | The empty bit set.
+empty :: BitSet a
+empty = BS 0 0 0 0 0 0 undefined
+{-# INLINE empty #-}
+
+singleton :: Enum a => a -> BitSet a 
+singleton x = BS 1 1 1 e e 1 undefined where e = fromEnum x
+{-# INLINE singleton #-}
+
+-- | Is the bit set empty? Asymptotically faster than checking if size == 0 in some cases.
+null :: BitSet a -> Bool
+null (BS a b c _ _ _ _) 
+    | a > 0     = False
+    | b == 0    = True
+    | otherwise = c == 0 
+{-# INLINE null #-}
+
+full :: (Enum a, Bounded a) => BitSet a
+full = complement empty 
+
+universeOf :: (Bounded a, Enum a) => BitSet a -> (Int,Int)
+universeOf x = (fromEnum (minBound `asArgTypeOf` x), fromEnum (maxBound `asArgTypeOf` x))
+
+-- ensures valid universe, may result in negative bitset, note recalculation of universe
+complement :: (Enum a, Bounded a) => BitSet a -> BitSet a 
+complement r@(BS a b c l h m _) = BS (Bits.complement b) (Bits.complement a) (Bits.complement c) l h (Bits.complement m) (universeOf r)
+
+-- proof obligation: either the value is already complemented or it is a complement-complement, note retention of u
+recomplement :: BitSet a -> BitSet a 
+recomplement (BS a b c l h m u) = BS (Bits.complement b) (Bits.complement a) (Bits.complement c) l h (Bits.complement m) u
+
+-- | /O(d * n)/ Make a @BitSet@ from a list of items.
+fromList :: Enum a => [a] -> BitSet a
+fromList = foldr insert empty 
+{-# INLINE fromList #-}
+
+fromDistinctAscList :: Enum a => [a] -> BitSet a 
+fromDistinctAscList [] = empty
+fromDistinctAscList (c:cs) = fromDistinctAscList' cs 1 0 1 
+    where
+        l = fromEnum c
+        fromDistinctAscList' :: Enum a => [a] -> Int -> Int -> Integer -> BitSet a
+        fromDistinctAscList' [] !n !h !m  = BS n n n l h m undefined
+        fromDistinctAscList' (c':cs') !n _ !m = fromDistinctAscList' cs' (n+1) h' (setBit m (h' - l))
+            where
+                h' = fromEnum c'
+{-# INLINE fromDistinctAscList #-}
+
+-- | /O(d)/ Insert an item into the bit set.
+insert :: Enum a => a -> BitSet a -> BitSet a
+insert x r@(BS a b c l h m u) 
+    | m < 0, e < l = r 
+    | m < 0, e > h = r
+    | e < l = bs (a+1) (b+1) (c+1) e (h - e) (shiftL m (l - e) .|. 1) u
+    | e > h = bs (a+1) (b+1) (c+1) l p (setBit m p) u
+    | testBit m (e - l) = r 
+    | otherwise = bs (a+1) (b+1) (c+1) l h (setBit m p) u
+    where 
+        e = fromEnum x
+        p = e - l 
+{-# INLINE insert #-}
+
+-- | /O(d)/ Delete an item from the bit set.
+delete :: Enum a => a -> BitSet a -> BitSet a
+delete x r@(BS a b c l h m u) 
+    | m < 0, e < l = bs (a+1) (b+1) (c+1) e (h - e) (shiftL m (l - e) .&. Bits.complement 1) u
+    | m < 0, e > h = bs (a+1) (b+1) (c+1) l p (clearBit m p) u
+    | e < l       = r
+    | e > h       = r
+    | testBit m p = bs (a-1) (b-1) (c-1) l h (clearBit m p) u
+    | otherwise   = r
+    where 
+        e = fromEnum x
+        p = e - l
+{-# INLINE delete #-}
+
+-- | /O(testBit on Integer)/ Ask whether the item is in the bit set.
+member :: Enum a => a -> BitSet a -> Bool
+member x (BS _ _ _ l h m _) 
+    | e < l     = m < 0 
+    | e > h     = m > 0
+    | otherwise = testBit m (e - l)
+    where 
+        e = fromEnum x
+{-# INLINE member #-}
+
+-- | /O(1)/ or /O(d)/ The number of elements in the bit set.
+size :: BitSet a -> Int
+size (BS a b c _ _ m (ul,uh)) 
+    | a == b, m >= 0 = a
+    | a == b         = uh - ul - a 
+    | m >= 0         = c
+    | otherwise      = uh - ul - c 
+
+-- | /O(d)/ convert to an Integer representation. Discards negative elements
+toInteger :: BitSet a -> Integer
+toInteger x = mantissa x `shift` exponent x
+
+union :: BitSet a -> BitSet a -> BitSet a 
+union x@(BS a b c l h m u) y@(BS a' b' c' l' h' m' u')
+    | l' < l    = union y x                                                         -- ensure left side has lower exponent
+    | b == 0    = y                                                                 -- fast empty union
+    | b' == 0   = x                                                                 -- fast empty union
+    | a == -1   = BS (-1) (-1) (-1) 0 0 (-1) u                                      -- fast full union, recomplement obligation met by negative size
+    | a' == -1  = BS (-1) (-1) (-1) 0 0 (-1) u'                                     -- fast full union, recomplement obligation met by negative size
+    | m < 0, m' < 0 = recomplement (intersection (recomplement x) (recomplement y)) -- appeal to intersection, recomplement obligation met by 2s complement
+    | m' < 0    = recomplement (pseudoDiff (recomplement y) x u')                      -- union with complement, recomplement obligation met by 2s complement -- THESE ARE WRONG FIX!
+    | m < 0     = recomplement (pseudoDiff (recomplement x) y u)                      -- union with complement, recomplement obligation met by 2s complement -- THESE ARE WRONG FIX!
+    | h < l'    = bs (a + a') (b + b') (c + c') l h' m'' u                          -- disjoint positive ranges
+    | otherwise = bs (a `max` a') (b + b') (recount m'') l (h `max` h') m'' u       -- overlapped positives
+    where 
+        m'' = m .|. shiftL m' (l' - l)
+
+intersection :: BitSet a -> BitSet a -> BitSet a 
+intersection x@(BS a b _ l h m u) y@(BS a' b' _ l' h' m' u')
+    | l' < l = intersection y x                                 
+    | b == 0 = empty
+    | b' == 0 = empty
+    | a == -1 = y
+    | a' == -1 = x
+    | m < 0, m' < 0 = recomplement (union (recomplement x) (recomplement y))
+    | m' < 0 = pseudoDiff x (recomplement y) u'
+    | m < 0 = pseudoDiff y (recomplement x) u
+    | h < l' = empty 
+    | otherwise = bs 0 (b `min` b') (recount m'') l'' (h `min` h') m'' u
+    where
+        l'' = max l l'
+        m'' = shift m (l'' - l) .&. shift m' (l'' - l')
+
+-- we know m >= 0, m' >= 0, a /= -1, a' /= -1, b /= 0, b' /= 0, u' is the universe of discourse
+pseudoDiff :: BitSet a -> BitSet a -> (Int,Int) -> BitSet a 
+pseudoDiff x@(BS a _ _ l h m _) (BS _ b' _ l' h' m' _) u''
+    | h < l' = x
+    | h' < l = x
+    | otherwise = bs (max (a - b') 0) a (recount m'') l h m'' u''
+    where m'' = m .&. shift (Bits.complement m') (l' - l)
+
+(\\) :: (Enum a, Bounded a) => BitSet a -> BitSet a -> BitSet a 
+x \\ y = x `intersection` complement y
+
+-- TODO: fix this so that it handles complements correctly
+instance Eq (BitSet a) where
+    BS _ _ _ l _ m _ == BS _ _ _ l' _ m' _ = shift m (l'' - l) == shift m' (l'' - l) where l'' = min l l'
+    BS _ _ _ l _ m _ /= BS _ _ _ l' _ m' _ = shift m (l'' - l) /= shift m' (l'' - l) where l'' = min l l'
+
+instance Ord (BitSet a) where
+    BS _ _ _ l _ m _ `compare` BS _ _ _ l' _ m' _ = shift m (l'' - l) `compare` shift m' (l'' - l) where l'' = min l l'
+
+instance (Enum a, Bounded a) => Bounded (BitSet a) where
+    minBound = empty
+    maxBound = result where
+        result = BS n n n l h m (l,h)
+        n = h - l + 1
+        l = fromEnum (minBound `asArgTypeOf` result)
+        h = fromEnum (maxBound `asArgTypeOf` result)
+        m = setBit 0 n - 1
+
+asArgTypeOf :: a -> f a -> a
+asArgTypeOf = const
+{-# INLINE asArgTypeOf #-}
+
+recount :: Integer -> Int
+recount = recount' 0 where
+    recount' :: Int -> Integer -> Int
+    recount' !n 0 = n
+    recount' !n !m = recount' (if testBit m 0 then n+1 else n) (shiftR m 1)
+
+-- note that operations on values generated by toEnum are pretty slow because the bounds are suboptimal
+instance (Enum a, Bounded a) => Enum (BitSet a) where
+    fromEnum b@(BS _ _ _ l _ m _) = fromInteger (shiftL m (l - l'))
+        where 
+            l' = fromEnum (minBound `asArgTypeOf` b)
+    toEnum i = result 
+        where
+            result = BS a i (recount m) l h m undefined -- n <= 2^n, so i serves as a valid upper bound
+            l = fromEnum (minBound `asArgTypeOf` result)
+            h = fromEnum (maxBound `asArgTypeOf` result)
+            m = fromIntegral i
+            a | m /= 0 = 1 -- allow a fast null check, but not much else
+              | otherwise = 0
+        
+instance Enum a => Monoid (BitSet a) where
+    mempty = empty
+    mappend = union
+
+instance Enum a => Reducer a (BitSet a) where
+    unit = singleton
+    snoc = flip insert
+    cons = insert
+
+instance (Bounded a, Enum a) => Multiplicative (BitSet a) where
+    one = full
+    times = intersection
+
+instance (Bounded a, Enum a) => LeftSemiNearRing (BitSet a)
+instance (Bounded a, Enum a) => RightSemiNearRing (BitSet a)
+instance (Bounded a, Enum a) => SemiRing (BitSet a)
+
+-- idempotent monoid
+instance Enum a => LeftModule Natural (BitSet a) where
+    0 *. _ = empty
+    _ *. m = m
+instance Enum a => RightModule Natural (BitSet a) where
+    _ .* 0 = empty
+    m .* _ = m
+instance Enum a => Module Natural (BitSet a)
+
+instance (Bounded a, Enum a) => LeftModule (BitSet a) (BitSet a) where (*.) = times
+instance (Bounded a, Enum a) => RightModule (BitSet a) (BitSet a) where (.*) = times
+instance (Bounded a, Enum a) => Module (BitSet a) (BitSet a)
+
+instance (Bounded a, Enum a) => Algebra Natural (BitSet a)
+    
+instance Enum a => Generator (BitSet a) where
+    type Elem (BitSet a) = a
+    mapReduce f = mapReduce f . toList
diff --git a/Data/Ring/Semi/Near/Trie.hs b/Data/Ring/Semi/Near/Trie.hs
new file mode 100644
--- /dev/null
+++ b/Data/Ring/Semi/Near/Trie.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
+module Data.Ring.Semi.Near.Trie 
+    ( module Data.Ring.Semi.Near
+    , Trie(Trie, total, label, children)
+    , singleton
+    , empty
+    , null
+    ) where
+    
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+--import Data.Monoid.Multiplicative
+--import Data.Monoid.Reducer
+import Data.Monoid.Union hiding (empty)
+--import Data.Ring.Module
+import Data.Ring.Semi.Near
+import Prelude hiding (null)
+
+singleton :: (Ord c, c `Reducer` m) => c -> Trie c m 
+singleton = unit
+
+empty :: (Ord c, Monoid m) => Trie c m
+empty = zero
+
+null :: Ord c => Trie c m -> Bool
+null = Map.null . getUnionWith . children
+
+data Trie c m = Trie { total :: m, label :: m, children :: UnionWith (Map c) (Trie c m) }
+    deriving (Eq,Show)
+
+instance Functor (Trie c) where
+    fmap f (Trie t e r) = Trie (f t) (f e) (fmap (fmap f) r)
+
+instance (Ord c, Monoid m) => Monoid (Trie c m) where
+    mempty = Trie mempty mempty mempty
+    Trie x y z `mappend` Trie x' y' z' = Trie (x `mappend` x') (y `mappend` y') (z `mappend` z')
+
+instance (Ord c, c `Reducer` m) => Reducer c (Trie c m) where
+    unit c = Trie r zero . UnionWith $ flip Map.singleton (Trie r r zero) c where r = unit c
+
+{-
+instance (Ord c, Eq r, RightSemiNearRing r) => Multiplicative (Trie c r) where
+    one = Trie one one zero
+    Trie t e r `times` rhs@(Trie t' e' r') = 
+        Trie (t `times` t') (e `times` e') (r .* rhs `plus` lhs *. r') where
+            lhs = Trie e e zero `asTypeOf` rhs
+
+instance (Ord c, Eq r, RightSemiNearRing r) => RightSemiNearRing (Trie c r)
+
+toList :: (Ord c, c `Reducer` [c]) => Trie c m -> [[c]]
+toList = fmap merge . Map.assocs . getUnionWith . children where
+    merge (k,t) = k `times` toList t
+-}
diff --git a/monoids.cabal b/monoids.cabal
--- a/monoids.cabal
+++ b/monoids.cabal
@@ -1,12 +1,12 @@
 name:		    monoids
-version:	    0.1.25
+version:	    0.1.28
 license:	    BSD3
 license-file:   LICENSE
 author:		    Edward A. Kmett
 maintainer:	    Edward A. Kmett <ekmett@gmail.com>
 stability:	    experimental
 homepage:	    http://comonad.com/reader
-category:	    Data
+category:	    Data, Math, Numerical, Natural Language Processing, Parsing
 synopsis:	    Monoids, specialized containers and a general map/reduce framework
 description:    Monoids, specialized containers and a general map/reduce framework
 copyright:      (c) 2009 Edward A. Kmett
@@ -69,7 +69,9 @@
     Data.Ring.Module
     Data.Ring.Module.AutomaticDifferentiation
     Data.Ring.Semi
+    Data.Ring.Semi.BitSet
     Data.Ring.Semi.Near
+    Data.Ring.Semi.Near.Trie
     Data.Ring.Semi.Natural
     Data.Ring.Semi.Ord
     Data.Ring.Semi.Tropical