diff --git a/Data/Histogram.hs b/Data/Histogram.hs
--- a/Data/Histogram.hs
+++ b/Data/Histogram.hs
@@ -8,14 +8,17 @@
 -- Maintainer : Alexey Khudyakov <alexey.skladnoy@gmail.com>
 -- Stability  : experimental
 -- 
--- Immutable histograms. 
-
+-- Immutable histograms. This module export same APi as
+-- 'Data.Histogram.Generic' but specialzed to unboxed vectors. Refer
+-- aforementioned module for documentation.
 module Data.Histogram ( -- * Immutable histogram
     -- * Data type
     Histogram
   , module Data.Histogram.Bin
   , histogram
   , histogramUO
+  , HistIndex(..) 
+  , histIndex
     -- * Read histograms from string
   , readHistogram
   , readFileHistogram
@@ -28,40 +31,52 @@
     -- ** Convert to other data types
   , asList
   , asVector
-    -- * Slicing histogram
-  , sliceByIx
-  , sliceByVal
-    -- * Splitting 2D histograms
-  , sliceX
-  , sliceY
-    -- * Modify histogram
-  , histMap
-  , histMapBin
-  , histZip
-  , histZipSafe
+     -- * Modification
+  , map
+  , bmap
+  , zip
+  , zipSafe
+    -- ** Type conversion
+  , convertBinning
+    -- * Folding
+  , foldl
+  , bfoldl
+    -- * Slicing & rebinning
+  , slice
+  , rebin
+  , rebinFold
+    -- * 2D histograms
+    -- ** Slicing
+  , sliceAlongX
+  , sliceAlongY
+  , listSlicesAlongX
+  , listSlicesAlongY
+    -- ** Reducing along axis
+  , reduceX
+  , reduceY
+    -- * Lift histogram transform to 2D
+  , liftX
+  , liftY
   ) where
 
 import qualified Data.Vector.Unboxed    as U
 import Data.Vector.Unboxed (Unbox,Vector)
 
 import qualified Data.Histogram.Generic as H
+import Data.Histogram.Generic (HistIndex(..),histIndex)
 import Data.Histogram.Bin
 
+import Prelude hiding (map,zip,foldl)
 
+
+
 -- | Immutable histogram. Histogram consists of binning algorithm,
 --   optional number of under and overflows, and data. 
 type Histogram bin a = H.Histogram U.Vector bin a
 
--- | Create histogram from binning algorithm and vector with
--- data. Overflows are set to Nothing. 
---
--- Number of bins and vector size must match.
 histogram :: (Unbox a, Bin bin) => bin -> Vector a -> Histogram bin a
 histogram = H.histogram
 
--- | Create histogram from binning algorithm and vector with data. 
---
--- Number of bins and vector size must match.
 histogramUO :: (Unbox a, Bin bin) => bin -> Maybe (a,a) -> Vector a -> Histogram bin a
 histogramUO = H.histogramUO
 
@@ -71,12 +86,9 @@
 ----------------------------------------------------------------
 
 
--- | Convert String to histogram. Histogram do not have Read instance
---   because of slowness of ReadP
 readHistogram :: (Read bin, Read a, Bin bin, Unbox a) => String -> Histogram bin a
 readHistogram = H.readHistogram
 
--- | Read histogram from file.
 readFileHistogram :: (Read bin, Read a, Bin bin, Unbox a) => FilePath -> IO (Histogram bin a)
 readFileHistogram = H.readFileHistogram
 
@@ -84,31 +96,24 @@
 -- Accessors & conversion
 ----------------------------------------------------------------
 
--- | Histogram bins
 bins :: Histogram bin a -> bin
 bins = H.bins
 
--- | Histogram data as vector
 histData :: Histogram bin a -> Vector a
 histData = H.histData
 
--- | Number of underflows
 underflows :: Histogram bin a -> Maybe a
 underflows = H.underflows
 
--- | Number of overflows
 overflows :: Histogram bin a -> Maybe a
 overflows = H.overflows
 
--- | Underflows and overflows
 outOfRange :: Histogram bin a -> Maybe (a,a)
 outOfRange = H.outOfRange
 
--- | Convert histogram to list.
 asList :: (Unbox a, Bin bin) => Histogram bin a -> [(BinValue bin, a)]
 asList = H.asList
 
--- | Convert histogram to vector
 asVector :: (Bin bin, Unbox a, Unbox (BinValue bin), Unbox (BinValue bin,a)) 
          => Histogram bin a -> Vector (BinValue bin, a) 
 asVector = H.asVector
@@ -117,37 +122,118 @@
 -- Modify histograms
 ----------------------------------------------------------------
 
--- | fmap lookalike. It's not possible to create Functor instance
---   because of class restrictions
-histMap :: (Unbox a, Unbox b) => (a -> b) -> Histogram bin a -> Histogram bin b
-histMap = H.histMap
+map :: (Unbox a, Unbox b) => (a -> b) -> Histogram bin a -> Histogram bin b
+map = H.map
 
--- | Apply function to histogram bins. Function must not change number of bins.
---   If it does error is thrown.
-histMapBin :: (Bin bin, Bin bin') => (bin -> bin') -> Histogram bin a -> Histogram bin' a
-histMapBin = H.histMapBin
+bmap :: (Unbox a, Unbox b, Bin bin)
+     => (BinValue bin -> a -> b) -> Histogram bin a -> Histogram bin b
+bmap = H.bmap
 
--- | Zip two histograms elementwise. Bins of histograms must be equal
---   otherwise error will be called.
-histZip :: (Bin bin, Eq bin, Unbox a, Unbox b, Unbox c) =>
-           (a -> b -> c) -> Histogram bin a -> Histogram bin b -> Histogram bin c
-histZip = H.histZip
+zip :: (Bin bin, BinEq bin, Unbox a, Unbox b, Unbox c) 
+    => (a -> b -> c) -> Histogram bin a -> Histogram bin b -> Histogram bin c
+zip = H.zip
            
--- | Zip two histogram elementwise. If bins are not equal return `Nothing`
-histZipSafe :: (Bin bin, Eq bin, Unbox a, Unbox b, Unbox c) =>
-           (a -> b -> c) -> Histogram bin a -> Histogram bin b -> Maybe (Histogram bin c)
-histZipSafe = H.histZipSafe
+zipSafe :: (Bin bin, BinEq bin, Unbox a, Unbox b, Unbox c)
+        => (a -> b -> c) -> Histogram bin a -> Histogram bin b -> Maybe (Histogram bin c)
+zipSafe = H.zipSafe
 
-sliceByIx :: (Bin1D bin, Unbox a) => Int -> Int -> Histogram bin a -> Histogram bin a
-sliceByIx = H.sliceByIx
+convertBinning :: (ConvertBin bin bin', Unbox a)
+               => Histogram bin a -> Histogram bin' a
+convertBinning = H.convertBinning
 
-sliceByVal :: (Bin1D bin, Unbox a) => BinValue bin -> BinValue bin -> Histogram bin a -> Histogram bin a
-sliceByVal = H.sliceByVal
 
--- | Slice 2D histogram along Y axis. This function is fast because it does not require reallocations.
-sliceY :: (Unbox a, Bin bX, Bin bY) => Histogram (Bin2D bX bY) a -> [(BinValue bY, Histogram bX a)]
-sliceY = H.sliceY
 
--- | Slice 2D histogram along X axis.
-sliceX :: (Unbox a, Bin bX, Bin bY) => Histogram (Bin2D bX bY) a -> [(BinValue bX, Histogram bY a)]
-sliceX = H.sliceX
+----------------------------------------------------------------
+-- Folding
+----------------------------------------------------------------
+
+foldl :: (Bin bin, Unbox a) => (b -> a -> b) -> b -> Histogram bin a -> b
+foldl = H.foldl
+
+bfoldl :: (Bin bin, Unbox a) => (b -> BinValue bin -> a -> b) -> b -> Histogram bin a -> b
+bfoldl = H.bfoldl
+
+
+
+----------------------------------------------------------------
+-- Slicing and reducing histograms
+----------------------------------------------------------------
+
+slice :: (SliceableBin bin, Unbox a)
+      => HistIndex bin          -- ^ Lower inclusive bound
+      -> HistIndex bin          -- ^ Upper inclusive bound
+      -> Histogram bin a      -- ^ Histogram to slice
+      -> Histogram bin a
+slice = H.slice
+
+rebin :: (MergeableBin bin, Unbox a)
+      => CutDirection
+      -> Int      
+      -> (a -> a -> a)          -- ^ Accumulation function
+      -> Histogram bin a
+      -> Histogram bin a
+rebin = H.rebin
+-- {-# INLINE rebin #-}
+
+-- | Rebin histogram
+rebinFold :: (MergeableBin bin, Unbox a, Unbox b)
+          => CutDirection
+          -> Int      
+          -> (b -> a -> b)          -- ^ Accumulation function
+          -> b                      -- ^ Initial value
+          -> Histogram bin a
+          -> Histogram bin b
+rebinFold = H.rebinFold
+-- {-# INLINE rebinFold #-}
+
+
+
+----------------------------------------------------------------
+-- 2D histograms
+----------------------------------------------------------------
+
+sliceAlongX :: (Unbox a, Bin bX, Bin bY)
+            => Histogram (Bin2D bX bY) a -- ^ 2D histogram
+            -> HistIndex bY                -- ^ Position along Y axis
+            -> Histogram bX a
+sliceAlongX = H.sliceAlongX
+
+sliceAlongY :: (Unbox a, Bin bX, Bin bY)
+            => Histogram (Bin2D bX bY) a -- ^ 2D histogram
+            -> HistIndex bX                -- ^ Position along X axis
+            -> Histogram bY a
+sliceAlongY = H.sliceAlongY
+
+listSlicesAlongX :: (Unbox a, Bin bX, Bin bY)
+                 => Histogram (Bin2D bX bY) a
+                 -> [(BinValue bY, Histogram bX a)]
+listSlicesAlongX = H.listSlicesAlongX
+
+listSlicesAlongY :: (Unbox a, Bin bX, Bin bY)
+                 => Histogram (Bin2D bX bY) a
+                 -> [(BinValue bX, Histogram bY a)]
+listSlicesAlongY = H.listSlicesAlongY
+
+reduceX :: (Unbox a, Unbox b, Bin bX, Bin bY)
+        => (Histogram bX a -> b)      -- ^ Function to reduce single slice along X axis
+        ->  Histogram (Bin2D bX bY) a -- ^ 2D histogram
+        ->  Histogram bY b
+reduceX = H.reduceX
+
+reduceY :: (Unbox a, Unbox b, Bin bX, Bin bY)
+        => (Histogram bY a -> b)     -- ^ Function to reduce histogram along Y axis
+        -> Histogram (Bin2D bX bY) a -- ^ 2D histogram
+        -> Histogram bX b
+reduceY = H.reduceY
+
+liftX :: (Bin bX, Bin bY, Bin bX', BinEq bX', Unbox a, Unbox b)
+      => (Histogram bX a -> Histogram bX' b)
+      -> Histogram (Bin2D bX  bY) a
+      -> Histogram (Bin2D bX' bY) b
+liftX = H.liftX
+
+liftY :: (Bin bX, Bin bY, Bin bY', BinEq bY', Unbox a, Unbox b)
+      => (Histogram bY a -> Histogram bY' b)
+      -> Histogram (Bin2D bX bY ) a
+      -> Histogram (Bin2D bX bY') b
+liftY = H.liftY
diff --git a/Data/Histogram/Bin.hs b/Data/Histogram/Bin.hs
--- a/Data/Histogram/Bin.hs
+++ b/Data/Histogram/Bin.hs
@@ -13,7 +13,8 @@
 -- Binning algorithms. This is mapping from set of interest to integer
 -- indices and approximate reverse.
 
-module Data.Histogram.Bin ( -- * Type classes
+module Data.Histogram.Bin ( 
+    -- * Type classes
     module Data.Histogram.Bin.Classes
   , module Data.Histogram.Bin.BinI
   , module Data.Histogram.Bin.BinInt
@@ -35,17 +36,21 @@
 -- Bin conversion
 ----------------------------------------------------------------
 
+-- BinI -> BinInt
+instance ConvertBin BinI BinInt where
+  convertBin b = binIntN (lowerLimit b) 1 (upperLimit b)
+
 -- BinI,BinInt -> BinF
 instance RealFrac f => ConvertBin BinI (BinF f) where
-  convertBin b = BinF (fromIntegral (lowerLimit b) - 0.5) 1 (nBins b)
+  convertBin b = binFstep (fromIntegral (lowerLimit b) - 0.5) 1 (nBins b)
 instance RealFrac f => ConvertBin BinInt (BinF f) where
-  convertBin b = BinF (fromIntegral (lowerLimit b) - 0.5) (fromIntegral $ binSize b) (nBins b)
+  convertBin b = binFstep (fromIntegral (lowerLimit b) - 0.5) (fromIntegral $ binSize b) (nBins b)
 
 -- BinI,BinInt -> BinD
 instance ConvertBin BinI BinD where
-  convertBin b = BinD (fromIntegral (lowerLimit b) - 0.5) 1 (nBins b)
+  convertBin b = binDstep (fromIntegral (lowerLimit b) - 0.5) 1 (nBins b)
 instance ConvertBin BinInt BinD where
-  convertBin b = BinD (fromIntegral (lowerLimit b) - 0.5) (fromIntegral $ binSize b) (nBins b)
+  convertBin b = binDstep (fromIntegral (lowerLimit b) - 0.5) (fromIntegral $ binSize b) (nBins b)
 
 -- Bin2D -> Bin2D
 instance (ConvertBin bx bx', Bin by) => ConvertBin (Bin2D bx by) (Bin2D bx' by) where
diff --git a/Data/Histogram/Bin/Bin2D.hs b/Data/Histogram/Bin/Bin2D.hs
--- a/Data/Histogram/Bin/Bin2D.hs
+++ b/Data/Histogram/Bin/Bin2D.hs
@@ -9,9 +9,9 @@
   , fmapBinY
   ) where
 
-import Data.Typeable (Typeable)
-import Data.Data     (Data)
-import Text.Read     (Read(..))
+import Control.DeepSeq (NFData(..))
+import Data.Data       (Data,Typeable)
+import Text.Read       (Read(..))
 
 import Data.Histogram.Bin.Classes
 import Data.Histogram.Parse
@@ -65,18 +65,24 @@
     where
       by' = f by
 
-instance (Show b1, Show b2) => Show (Bin2D b1 b2) where
-  show (Bin2D b1 b2) = concat [ "# Bin2D\n"
+instance (BinEq bx, BinEq by) => BinEq (Bin2D bx by) where
+  binEq (Bin2D bx by) (Bin2D bx' by') =
+    binEq bx bx' && binEq by by'
+
+instance (Show bx, Show by) => Show (Bin2D bx by) where
+  show (Bin2D bx by) = concat [ "# Bin2D\n"
                               , "# X\n"
-                              , show b1
+                              , show bx
                               , "# Y\n"
-                              , show b2
+                              , show by
                               ]
-instance (Read b1, Read b2) => Read (Bin2D b1 b2) where
+instance (Read bx, Read by) => Read (Bin2D bx by) where
   readPrec = do
     keyword "Bin2D"
     keyword "X"
-    b1 <- readPrec
+    bx <- readPrec
     keyword "Y"
-    b2 <- readPrec
-    return $ Bin2D b1 b2
+    by <- readPrec
+    return $ Bin2D bx by
+
+instance NFData (Bin2D bx by)
diff --git a/Data/Histogram/Bin/BinEnum.hs b/Data/Histogram/Bin/BinEnum.hs
--- a/Data/Histogram/Bin/BinEnum.hs
+++ b/Data/Histogram/Bin/BinEnum.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -8,18 +7,19 @@
   , binEnumFull
   ) where
 
-import Control.Monad (liftM)
-import Data.Typeable (Typeable)
-import Data.Data     (Data)
-import Text.Read     (Read(..))
+import Control.DeepSeq (NFData(..))
+import Control.Monad   (liftM)
+import Data.Data       (Data,Typeable)
+import Text.Read       (Read(..))
 
 import Data.Histogram.Bin.Classes
 import Data.Histogram.Bin.BinI
 import Data.Histogram.Parse
 
--- | Bin for types which are instnaces of Enum type class
+-- | Bin for types which are instnaces of Enum type class. Value are
+--   converted to 'Int' using 'fromEnum' first and then binned.
 newtype BinEnum a = BinEnum BinI
-                    deriving (Eq,Data,Typeable,GrowBin)
+                    deriving (Eq,Data,Typeable,BinEq)
 
 -- | Create enum based bin
 binEnum :: Enum a => a -> a -> BinEnum a
@@ -36,15 +36,19 @@
   inRange   (BinEnum b) = inRange b . fromEnum
   nBins     (BinEnum b) = nBins b
 
-instance Enum a => IntervalBin (BinEnum a) where
+instance (Enum a, Ord a) => IntervalBin (BinEnum a) where
   binInterval b x = (n,n) where n = fromIndex b x
 
-instance Enum a => Bin1D (BinEnum a) where
+instance (Enum a, Ord a) => Bin1D (BinEnum a) where
   lowerLimit (BinEnum b) = toEnum $ lowerLimit b
   upperLimit (BinEnum b) = toEnum $ upperLimit b
+
+instance (Enum a, Ord a) => SliceableBin (BinEnum a) where
   unsafeSliceBin i j (BinEnum b) = BinEnum $ unsafeSliceBin i j b
 
 instance Show (BinEnum a) where
   show (BinEnum b) = "# BinEnum\n" ++ show b
 instance Read (BinEnum a) where
   readPrec = keyword "BinEnum" >> liftM BinEnum readPrec
+
+instance NFData (BinEnum a)
diff --git a/Data/Histogram/Bin/BinF.hs b/Data/Histogram/Bin/BinF.hs
--- a/Data/Histogram/Bin/BinF.hs
+++ b/Data/Histogram/Bin/BinF.hs
@@ -3,24 +3,24 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 module Data.Histogram.Bin.BinF (
     -- * Generic and slow
-    BinF(..)
+    BinF
   , binF
   , binFn
   , binFstep
   , scaleBinF
     -- * Specialized for Double and fast
-  , BinD(..)
+  , BinD
   , binD
   , binDn
   , binDstep
   , scaleBinD
   ) where
 
-import Control.Monad (liftM3)
-import GHC.Float     (double2Int)
-import Data.Typeable (Typeable)
-import Data.Data     (Data)
-import Text.Read     (Read(..))
+import Control.DeepSeq (NFData(..))
+import Control.Monad   (liftM3)
+import GHC.Float       (double2Int)
+import Data.Data       (Data,Typeable)
+import Text.Read       (Read(..))
 
 import Data.Histogram.Bin.Classes
 import Data.Histogram.Parse
@@ -28,18 +28,14 @@
 
 -- | Floaintg point bins with equal sizes.
 --
--- Note that due to GHC bug #2271 this toIndex is really slow (20x
--- slowdown with respect to BinD) and use of BinD is recommended
---
--- 1. Lower bound
---
--- 2. Size of bin
+--   Since 'BinF' is paramentric it couldn't be unpacked. So @BinF
+--   Double@ will be always slower than 'BinD'. For roundtripping use:
 --
--- 3. Number of bins
+-- > b = binFstep (lowerLimit b) (binSize b) (nBins b)
 data BinF f = BinF !f                  -- Lower bound
                    !f                  -- Size of bin
                    {-# UNPACK #-} !Int -- Number of bins
-              deriving (Eq,Data,Typeable)
+              deriving (Data,Typeable)
 
 -- | Create bins.
 binF :: RealFrac f =>
@@ -84,12 +80,18 @@
 instance RealFrac f => Bin1D (BinF f) where
   lowerLimit (BinF from _    _) = from
   upperLimit (BinF from step n) = from + step * fromIntegral n
+
+instance RealFrac f => SliceableBin (BinF f) where
   unsafeSliceBin i j (BinF from step _) = BinF (from + step * fromIntegral i) step (j-i+1)
 
-instance RealFrac f => GrowBin (BinF f) where
-  zeroBin    (BinF from step _) = BinF from step 0
-  appendBin  (BinF from step n) = BinF from step (n+1)
-  prependBin (BinF from step n) = BinF (from-step) step (n+1)
+instance RealFrac f => MergeableBin (BinF f) where
+  unsafeMergeBins dir k b@(BinF base step _) =
+    case dir of
+      CutLower  -> BinF (base + r) (step * fromIntegral k) n
+      CutHigher -> BinF  base      (step * fromIntegral k) n
+    where
+      n = nBins b `div` k
+      r = fromIntegral (nBins b - n * k) * step
 
 instance RealFrac f => VariableBin (BinF f) where
   binSizeN (BinF _ step _) _ = step
@@ -97,6 +99,16 @@
 instance RealFrac f => UniformBin (BinF f) where
   binSize (BinF _ step _) = step
 
+-- | Equality is up to 2/3th of digits
+instance RealFloat f => BinEq (BinF f) where
+  binEq (BinF lo d n) (BinF lo' d' n')
+    =  n == n'
+    && abs (d  - d' ) < eps * abs d
+    && abs (lo - lo') < dlo
+    where
+      dlo = eps * fromIntegral n * d
+      eps = 2 ** (-0.66 * fromIntegral (floatDigits lo))
+
 instance Show f => Show (BinF f) where
   show (BinF base step n) = unlines [ "# BinF"
                                     , "# Base = " ++ show base
@@ -106,23 +118,20 @@
 instance (Read f, RealFrac f) => Read (BinF f) where
   readPrec = keyword "BinF" >> liftM3 BinF (value "Base") (value "Step") (value "N")
 
+instance NFData (BinF f)
 
 
+
 ----------------------------------------------------------------
 -- Floating point bin /Specialized for Double
 ----------------------------------------------------------------
+
 -- | Floaintg point bins with equal sizes. If you work with Doubles
--- this data type should be used instead of BinF.
---
--- 1. Lower bound
---
--- 2. Size of bin
---
--- 3. Number of bins
+-- this data type should be used instead of 'BinF'. Roundtripping is same as with 'BinF'
 data BinD = BinD {-# UNPACK #-} !Double -- Lower bound
                  {-# UNPACK #-} !Double -- Size of bin
                  {-# UNPACK #-} !Int    -- Number of bins
-            deriving (Eq,Data,Typeable)
+            deriving (Data,Typeable)
 
 -- | Create bins.
 binD :: Double -- ^ Lower bound of range
@@ -170,12 +179,18 @@
 instance Bin1D BinD where
   lowerLimit (BinD from _    _) = from
   upperLimit (BinD from step n) = from + step * fromIntegral n
+
+instance SliceableBin BinD where
   unsafeSliceBin i j (BinD from step _) = BinD (from + step * fromIntegral i) step (j-i+1)
 
-instance GrowBin BinD where
-  zeroBin    (BinD from step _) = BinD from step 0
-  appendBin  (BinD from step n) = BinD from step (n+1)
-  prependBin (BinD from step n) = BinD (from-step) step (n+1)
+instance MergeableBin BinD where
+  unsafeMergeBins dir k b@(BinD base step _) =
+    case dir of
+      CutLower  -> BinD (base + r) (step * fromIntegral k) n
+      CutHigher -> BinD  base      (step * fromIntegral k) n
+    where
+      n = nBins b `div` k
+      r = fromIntegral (nBins b - n * k) * step
 
 instance VariableBin BinD where
   binSizeN (BinD _ step _) _ = step
@@ -183,6 +198,16 @@
 instance UniformBin BinD where
   binSize (BinD _ step _) = step
 
+-- | Equality is up to 3e-11 (2/3th of digits)
+instance BinEq BinD where
+  binEq (BinD lo d n) (BinD lo' d' n')
+    =  n == n'
+    && abs (d  - d' ) < eps * abs d
+    && abs (lo - lo') < dlo
+    where
+      dlo = eps * fromIntegral n * d
+      eps = 3e-11
+
 instance Show BinD where
   show (BinD base step n) = unlines [ "# BinD"
                                     , "# Base = " ++ show base
@@ -191,3 +216,5 @@
                                     ]
 instance Read BinD where
   readPrec = keyword "BinD" >> liftM3 BinD (value "Base") (value "Step") (value "N")
+
+instance NFData BinD
diff --git a/Data/Histogram/Bin/BinI.hs b/Data/Histogram/Bin/BinI.hs
--- a/Data/Histogram/Bin/BinI.hs
+++ b/Data/Histogram/Bin/BinI.hs
@@ -2,40 +2,43 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 module Data.Histogram.Bin.BinI (
-    BinI(..)
+    BinI
   , binI
   , binI0
   ) where
 
-import Control.Monad (liftM2)
-import Data.Typeable (Typeable)
-import Data.Data     (Data)
-import Text.Read     (Read(..))
+import Control.DeepSeq (NFData(..))
+import Control.Monad   (liftM2)
+import Data.Data       (Data,Typeable)
+import Text.Read       (Read(..))
 
 import Data.Histogram.Bin.Classes
 import Data.Histogram.Parse
 
 
 
--- | Simple binning algorithm which map continous range of bins onto
--- indices. Each number correcsponds to different bin
+-- | Very simple binning algorithm. Each indices. Each number
+--   correcsponds to different bin.
 --
--- 1. Lower bound (inclusive)
+--   For rountripping use 'lowerLimit' and 'upperLimit'
 --
--- 2. Upper bound (inclusive)
+-- > b = binI (lowerLimit b) (upperLimit b)
 data BinI = BinI
             {-# UNPACK #-} !Int -- Lower bound (inclusive)
             {-# UNPACK #-} !Int -- Upper bound (inclusive)
             deriving (Eq,Data,Typeable)
 
--- | Safe constructor for BinI. It does checks that upper bound is
+-- | Safe constructor for BinI. It checks that upper bound is
 --   greater or equal than lower bound
-binI :: Int -> Int -> BinI
+binI :: Int                     -- ^ Lower bound (inclusive)
+     -> Int                     -- ^ Upper bound (inclusive)
+     -> BinI
 binI lo hi | lo <= hi  = BinI lo hi
            | otherwise = error "Data.Histogram.Bin.BinI.binI: invalid paramters"
 
 -- | Construct BinI with n bins. Indexing starts from 0. n must be positive
-binI0 :: Int -> BinI
+binI0 :: Int                    -- ^ Number of bins.
+      -> BinI
 binI0 n = binI 0 (n - 1)
 
 instance Bin BinI where
@@ -52,6 +55,8 @@
 instance Bin1D BinI where
   lowerLimit (BinI i _) = i
   upperLimit (BinI _ i) = i
+
+instance SliceableBin BinI where
   unsafeSliceBin i j (BinI l _) = BinI (l+i) (l+j)
 
 instance VariableBin BinI where
@@ -60,10 +65,8 @@
 instance UniformBin BinI where
   binSize _ = 1
 
-instance GrowBin BinI where
-  zeroBin    (BinI l _) = BinI l l
-  appendBin  (BinI l u) = BinI l (u+1)
-  prependBin (BinI l u) = BinI (l-1) u
+instance BinEq BinI where
+  binEq = (==)
 
 instance Show BinI where
   show (BinI lo hi) = unlines [ "# BinI"
@@ -72,3 +75,5 @@
                               ]
 instance Read BinI where
   readPrec = keyword "BinI" >> liftM2 BinI (value "Low") (value "High")
+
+instance NFData BinI
diff --git a/Data/Histogram/Bin/BinInt.hs b/Data/Histogram/Bin/BinInt.hs
--- a/Data/Histogram/Bin/BinInt.hs
+++ b/Data/Histogram/Bin/BinInt.hs
@@ -5,51 +5,61 @@
     BinInt(..)
   , binInt
   , binIntN
+  , binIntStep
   ) where
 
-import Control.Monad (liftM3)
-import Data.Typeable (Typeable)
-import Data.Data     (Data)
-import Text.Read     (Read(..))
+import Control.DeepSeq (NFData(..))
+import Control.Monad   (liftM3)
+import Data.Data       (Data,Typeable)
+import Text.Read       (Read(..))
 
 import Data.Histogram.Bin.Classes
 import Data.Histogram.Parse
 
 
 
--- | Integer bins with size which differ from 1.
---
--- 1. Low bound
---
--- 2. Bin size
+-- | Integer bins of equal size. For roundtripping use:
 --
--- 3. Number of bins
+-- > b = binIntStep (lowerLimit b) (binSize b) (nBins b)
 data BinInt = BinInt
               {-# UNPACK #-} !Int -- Low bound
               {-# UNPACK #-} !Int -- Bin size
               {-# UNPACK #-} !Int -- Number of bins
               deriving (Eq,Data,Typeable)
 
--- FIXME: no sanity checks
+
 -- | Construct BinInt.
 binInt :: Int                   -- ^ Lower bound
        -> Int                   -- ^ Bin size
        -> Int                   -- ^ Upper bound
        -> BinInt
-binInt lo n hi = BinInt lo n nb
+binInt lo n hi 
+  | n  < 0    = error "Data.Histogram.Bin.BinInt.binInt: negative bin size"
+  | hi < lo   = binInt hi n lo
+  | otherwise = BinInt lo n nb
   where
     nb = (hi-lo) `div` n
 
+-- | Construct 'BinInt'.
 binIntN :: Int                  -- ^ Lower bound
         -> Int                  -- ^ Bin size
         -> Int                  -- ^ Upper bound
         -> BinInt
 binIntN lo n hi 
+  | n < 0     = error "Data.Histogram.Bin.BinInt.binIntN: negative bin size"
   | n > rng   = BinInt lo 1 rng
   | otherwise = BinInt lo undefined n
   where
     rng = hi - lo + 1
 
+binIntStep :: Int               -- ^ Lower bound
+           -> Int               -- ^ Bin size
+           -> Int               -- ^ Number of bins
+           -> BinInt
+binIntStep lo step n
+  | step < 0  = error "Data.Histogram.Bin.BinInt.binIntStep: negative number of bins"
+  | n    < 0  = error "Data.Histogram.Bin.BinInt.binIntStep: negative bin size"
+  | otherwise = BinInt lo step n
 
 instance Bin BinInt where
   type BinValue BinInt = Int
@@ -64,12 +74,18 @@
 instance Bin1D BinInt where
   lowerLimit (BinInt base _  _) = base
   upperLimit (BinInt base sz n) = base + sz * n - 1
+
+instance SliceableBin BinInt where
   unsafeSliceBin i j (BinInt base sz _) = BinInt (base + i*sz) sz (j-i+1)
 
-instance GrowBin BinInt where
-  zeroBin    (BinInt l sz _) = BinInt l sz 0
-  appendBin  (BinInt l sz n) = BinInt l sz (n+1)
-  prependBin (BinInt l sz n) = BinInt (l-sz) sz (n+1)
+instance MergeableBin BinInt where
+  unsafeMergeBins dir k b@(BinInt base step _) =
+    case dir of
+      CutLower  -> BinInt (base + r) (step*k) n
+      CutHigher -> BinInt  base      (step*k) n
+    where
+      n = nBins b `div` k
+      r = (nBins b - n * k) * step
 
 instance VariableBin BinInt where
   binSizeN (BinInt _ sz _) _ = sz
@@ -77,6 +93,9 @@
 instance UniformBin BinInt where
   binSize (BinInt _ sz _) = sz
 
+instance BinEq BinInt where
+  binEq = (==)
+
 instance Show BinInt where
   show (BinInt base sz n) =
     unlines [ "# BinInt"
@@ -87,3 +106,5 @@
 
 instance Read BinInt where
   readPrec = keyword "BinInt" >> liftM3 BinInt (value "Base") (value "Step") (value "Bins")
+
+instance NFData BinInt
diff --git a/Data/Histogram/Bin/Classes.hs b/Data/Histogram/Bin/Classes.hs
--- a/Data/Histogram/Bin/Classes.hs
+++ b/Data/Histogram/Bin/Classes.hs
@@ -14,13 +14,19 @@
     -- * Bin type class
     Bin(..)
   , binsCenters
+    -- * Approximate equality
+  , BinEq(..)
     -- * 1D bins
   , IntervalBin(..)
   , Bin1D(..)
+  , SliceableBin(..)
   , sliceBin
+  , MergeableBin(..)
+  , CutDirection(..)
+  , mergeBins
+    -- ** Sizes of bin
   , VariableBin(..)
   , UniformBin(..)
-  , GrowBin(..)
     -- * Conversion
   , ConvertBin(..)
   ) where
@@ -60,13 +66,25 @@
 binsCenters b = G.generate (nBins b) (fromIndex b)
 {-# INLINE binsCenters #-}
 
-----------------------------------------------------------------
--- 1D bins
-----------------------------------------------------------------
 
+
+---- Equality --------------------------------------------------
+
+-- | Approximate equality for bins. It's nessesary to define
+--   approximate equality since exact equality is ill defined for bins
+--   which work with floating point data. It's not safe to compare
+--   floating point numbers for exact equality
+class Bin b => BinEq b where
+  -- | Approximate equality
+  binEq :: b -> b -> Bool
+
+
+
+--- 1D bins ----------------------------------------------------
+
 -- | For binning algorithms which work with bin values which have some
 --   natural ordering and every bin is continous interval.
-class Bin b => IntervalBin b where
+class (Bin b, Ord (BinValue b)) => IntervalBin b where
   -- | Interval for n'th bin
   binInterval :: b -> Int -> (BinValue b, BinValue b)
   -- | List of all bins. Could be overridden for efficiency.
@@ -81,28 +99,48 @@
   lowerLimit :: b -> BinValue b
   -- | Maximal accepted value of histogram
   upperLimit :: b -> BinValue b
+
+
+-- | Binning algorithm which support slicing.
+class Bin b => SliceableBin b where
   -- | Slice bin by indices. This function doesn't perform any checks
-  --   and may produce invalid bin
+  --   and may produce invalid bin. Use 'sliceBin' instead.
   unsafeSliceBin :: Int -> Int -> b -> b
 
 -- | Slice bin using indices
-sliceBin :: Bin1D b => Int -> Int -> b -> b
+sliceBin :: SliceableBin b => Int -> Int -> b -> b
 sliceBin i j b 
   | i < 0  ||  j < 0  ||  i > j  ||  i >= n  ||  j >= n = error "sliceBin: bad slice"
   | otherwise                                           = unsafeSliceBin i j b
     where
       n = nBins b       
 
--- | Binning algorithm which allows to append and prepend bins.
-class Bin1D b => GrowBin b where
-  -- | Set number of bins to zero. By convention bins are shrinked to
-  --   lower bound.
-  zeroBin    :: b -> b
-  -- | Append one bin at upper bound
-  appendBin  :: b -> b
-  -- | Prepend one bin at lower bin
-  prependBin :: b -> b
+-- | How index should be dropped
+data CutDirection = CutLower    -- ^ Drop bins with highest index
+                  | CutHigher   -- ^ Drop bins with lowest index
 
+
+-- | Bin which support rebinning. 
+class Bin b => MergeableBin b where
+  -- | @N@ consecutive bins are joined into single bin. If number of
+  --   bins isn't multiple of @N@ remaining bins with highest or
+  --   lowest index are dropped. This function doesn't do any
+  --   checks. Use 'mergeBins' instead.
+  unsafeMergeBins :: CutDirection -> Int -> b -> b
+
+-- | @N@ consecutive bins are joined into single bin. If number of
+--   bins isn't multiple of @N@ remaining bins with highest or lowest
+--   index are dropped. If @N@ is larger than number of bins all bins
+--   are merged into single one.
+mergeBins :: MergeableBin b => CutDirection -> Int -> b -> b
+mergeBins dir n b
+  | nBins b == 0 = b
+  | n <= 0       = error "Data.Histogram.Bin.Classes.mergeNBin: non-positive N"
+  | n >  nBins b = unsafeMergeBins dir (nBins b) b
+  | otherwise    = unsafeMergeBins dir  n        b
+
+
+
 ---- Bin sizes ------------------------------------------------
 
 -- | 1D binning algorithms with variable bin size
@@ -118,6 +156,7 @@
   -- | Size of bin. Default implementation just uses 0th bin.
   binSize :: b -> BinValue b
   binSize b = binSizeN b 0
+
 
 
 ---- Conversion ------------------------------------------------
diff --git a/Data/Histogram/Bin/Extra.hs b/Data/Histogram/Bin/Extra.hs
--- a/Data/Histogram/Bin/Extra.hs
+++ b/Data/Histogram/Bin/Extra.hs
@@ -28,8 +28,7 @@
 import qualified Data.Vector.Unboxed         as U
 import qualified Data.Vector.Unboxed.Mutable as M
 import           Data.Vector.Generic            ((!))
-import Data.Typeable      (Typeable)
-import Data.Data          (Data)
+import Data.Data          (Data,Typeable)
 import Text.Read          (Read(..))         
 
 import Data.Histogram.Bin
@@ -63,7 +62,7 @@
 binEnum2D :: Enum2D i => i -> i -> BinEnum2D i
 binEnum2D lo hi = let (ix,iy) = fromEnum2D lo
                       (jx,jy) = fromEnum2D hi
-                  in BinEnum2D $ BinI ix jx >< BinI iy jy
+                  in BinEnum2D $ binI ix jx >< binI iy jy
 
 instance Enum2D i => Bin (BinEnum2D i) where
     type BinValue (BinEnum2D i) = i
@@ -98,7 +97,7 @@
   type BinValue (BinPermute b) = BinValue b
   toIndex   (BinPermute b to _)   !x = to ! toIndex b x
   fromIndex (BinPermute b _ from) !i = fromIndex b (from ! i)
-  inRange   (BinPermute b _ _)     x = inRange b x
+  inRange   (BinPermute b _ _)       = inRange b
   nBins = nBins . permutedBin
 
 instance IntervalBin b => IntervalBin (BinPermute b) where
diff --git a/Data/Histogram/Bin/LogBinD.hs b/Data/Histogram/Bin/LogBinD.hs
--- a/Data/Histogram/Bin/LogBinD.hs
+++ b/Data/Histogram/Bin/LogBinD.hs
@@ -2,42 +2,64 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 module Data.Histogram.Bin.LogBinD (
-    -- * Generic and slow
-    LogBinD(..)
+    LogBinD
+  , logBinDIncrement
   , logBinD
+  , logBinDN
   ) where
 
-import Control.Monad (liftM3)
-import GHC.Float     (double2Int)
-import Data.Typeable (Typeable)
-import Data.Data     (Data)
-import Text.Read     (Read(..))
+import Control.DeepSeq (NFData(..))
+import Control.Monad   (liftM3)
+import GHC.Float       (double2Int)
+import Data.Data       (Data,Typeable)
+import Text.Read       (Read(..))
 
 import Data.Histogram.Bin.Classes
 import Data.Histogram.Parse
--- | Logarithmic scale bins.
---
--- 1. Lower bound
---
--- 2. Increment ratio
+
+
+
+-- | Uniform binning in logarithmic scale. For roundtripping use:
 --
--- 3. Number of bins
+-- > b = logBinDN (lowerBound b) (logBinDIncrement b) (nBins b)
 data LogBinD = LogBinD
                Double -- Low border
                Double -- Increment ratio
                Int    -- Number of bins
                deriving (Eq,Data,Typeable)
 
--- | Create log-scale bins.
-logBinD :: Double -> Int -> Double -> LogBinD
-logBinD lo n hi = LogBinD lo ((hi/lo) ** (1 / fromIntegral n)) n
+-- | Increment ratio for 'LogBinD'
+logBinDIncrement :: LogBinD -> Double
+logBinDIncrement (LogBinD _ x _) = x
+  
+-- | Create log-scale binning algorithm.
+logBinD :: Double               -- ^ Lower limit
+        -> Int                  -- ^ Number of bins
+        -> Double               -- ^ Upper limit
+        -> LogBinD
+logBinD lo n hi 
+  | lo * hi <= 0  = error "Data.Histogram.Bin.LogBinD.logBinD: interval must not inlude zero"
+  | n < 0         = error "Data.Histogram.Bin.LogBinD.logBinD: negative number of bins"
+  | otherwise     = LogBinD lo ((hi/lo) ** (1 / fromIntegral n)) n
 
+logBinDN :: Double              -- ^ Lower limit
+         -> Double              -- ^ Increment ratio. Must be greater than 1
+         -> Int                 -- ^ Number of bins
+         -> LogBinD
+logBinDN lo rat n
+  | lo  == 0  = error "Data.Histogram.Bin.LogBinD.logBinDN: zero lower bound"
+  | rat <= 1  = error "Data.Histogram.Bin.LogBinD.logBinDN: increment is lesser than 1"
+  | n   < 0   = error "Data.Histogram.Bin.LogBinD.logBinDN: negative number of bins"
+  | otherwise = LogBinD lo rat n
+  
+  
 -- Fast variant of flooor
 floorD :: Double -> Int
 floorD x | x < 0     = double2Int x - 1
          | otherwise = double2Int x
 {-# INLINE floorD #-}
 
+
 instance Bin LogBinD where
   type BinValue LogBinD = Double
   toIndex   !(LogBinD base step _) !x = floorD $ logBase step (x / base)
@@ -47,16 +69,35 @@
   {-# INLINE toIndex #-}
 
 instance IntervalBin LogBinD where
-  binInterval (LogBinD base step _) i = (x, x*step) where x = base * step ** (fromIntegral i)
+  binInterval (LogBinD base step _) i = (x, x*step) where x = base * step ** fromIntegral i
 
 instance Bin1D LogBinD where
   lowerLimit (LogBinD lo  _ _) = lo
   upperLimit (LogBinD lo  r n) = lo * r ^ n
+
+instance SliceableBin LogBinD where
   unsafeSliceBin i j (LogBinD from step _) = LogBinD (from * step ^ i) step (j-i+1)
 
+instance MergeableBin LogBinD where
+  unsafeMergeBins dir k b@(LogBinD from step _) =
+    case dir of
+      CutLower  -> LogBinD (from * step^^r) (step^^k) n
+      CutHigher -> LogBinD  from            (step^^k) n
+    where
+      n = nBins b `div` k
+      r = nBins b - n * k
+
 instance VariableBin LogBinD where
   binSizeN (LogBinD base step _) n = let x = base * step ^ n in x*step - x
 
+instance BinEq LogBinD where
+  binEq (LogBinD lo d n) (LogBinD lo' d' n')
+    =  n == n'
+    && abs (lo - lo') < eps * abs lo
+    && abs (d  - d' ) < eps * abs d
+    where
+      eps = 3e-11
+
 instance Show LogBinD where
   show b =
     unlines [ "# LogBinD"
@@ -68,3 +109,5 @@
   readPrec = do
     keyword "LogBinD"
     liftM3 logBinD (value "Lo") (value "N") (value "Hi")
+
+instance NFData LogBinD
diff --git a/Data/Histogram/Fill.hs b/Data/Histogram/Fill.hs
--- a/Data/Histogram/Fill.hs
+++ b/Data/Histogram/Fill.hs
@@ -9,43 +9,49 @@
 --
 -- Stateful and pure (still stateful under the hood) accumulators. 
 --
-module Data.Histogram.Fill ( -- * Builder type class
-                             HistBuilder(..)
-                             -- ** Operators
-                           , (<<-)
-                           , (<<-|)
-                           , (<<?)
-                           , (<<-$)
-                           , (-<<)
-                             -- * Histogram builders
-                             -- ** Stateful
-                           , HBuilderM
-                           , feedOne
-                           , freezeHBuilderM
-                           , joinHBuilderM
-                           , treeHBuilderM
-                             -- ** Stateless
-                           , HBuilder
-                           , toHBuilderST
-                           , toHBuilderIO
-                           , joinHBuilder
-                           , treeHBuilder
-                             -- * Histogram constructors
-                           , module Data.Histogram.Bin
-                           , mkSimple
-                           , mkWeighted
-                           , mkMonoidal
-                           , mkFolder
-                             -- * Fill histograms
-                           , fillBuilder
-                             -- * Auxillary functions
-                             -- $auxillary
-                           , forceInt
-                           , forceDouble
-                           , forceFloat
-                             -- * Examples
-                             -- $examples
-                           ) where
+module Data.Histogram.Fill ( 
+    -- * Builder type class
+    HistBuilder(..)
+    -- ** Operators
+  , (<<-)
+  , (<<-|)
+  , (<<?)
+  , (<<-$)
+  , (-<<)
+    -- * Histogram builders
+    -- ** Stateful
+  , HBuilderM
+  , feedOne
+  , freezeHBuilderM
+  , joinHBuilderM
+  , treeHBuilderM
+    -- ** Stateless
+  , HBuilder
+  , toHBuilderST
+  , toHBuilderIO
+  , joinHBuilder
+  , treeHBuilder
+    -- * Histogram constructors
+  , module Data.Histogram.Bin
+  , mkSimple
+  , mkWeighted
+  , mkMonoidal
+  , mkFolder
+    -- ** Generic versions
+  , mkSimpleG
+  , mkWeightedG
+  , mkMonoidalG
+    -- * Fill histograms
+  , fillBuilder
+  , fillBuilderVec
+    -- * Auxillary functions
+    -- $auxillary
+  , forceInt
+  , forceDouble
+  , forceFloat
+    -- * Examples
+    -- $examples
+  ) where
 
 import Control.Applicative
 import Control.Monad       (when,liftM,liftM2)
@@ -54,12 +60,13 @@
 
 import Data.STRef
 import Data.Monoid            (Monoid(..))
--- import Data.Monoid.Statistics (StatMonoid)
 import Data.Vector.Unboxed    (Unbox)
-import qualified Data.Foldable    as F (Foldable,mapM_)
-import qualified Data.Traversable as F (Traversable,mapM)
+import qualified Data.Vector.Generic as G
+import qualified Data.Foldable       as F (Foldable,mapM_)
+import qualified Data.Traversable    as F (Traversable,mapM)
 
 import Data.Histogram
+import qualified Data.Histogram.Generic as H
 import Data.Histogram.Bin
 import Data.Histogram.ST
 
@@ -248,7 +255,7 @@
 ----------------------------------------------------------------
 
 -- | Stateless histogram builder
-newtype HBuilder a b = HBuilder { toHBuilderST :: (forall s . ST s (HBuilderM (ST s) a b))
+newtype HBuilder a b = HBuilder { toHBuilderST :: forall s . ST s (HBuilderM (ST s) a b)
                                   -- ^ Convert builder to stateful builder in ST monad
                                 }
 
@@ -299,46 +306,70 @@
 --   item put into histogram
 mkSimple :: (Bin bin, Unbox val, Num val
             ) => bin -> HBuilder (BinValue bin) (Histogram bin val)
-mkSimple bin =
-  HBuilder $ do acc <- newMHistogram 0 bin
-                return HBuilderM { hbInput  = fillOne acc
-                                 , hbOutput = freezeHist acc
-                                 }
+mkSimple = mkSimpleG
 {-# INLINE mkSimple #-}
 
 -- | Create builder. Bin content will incremented by weight supplied
 --   for each item put into histogram
 mkWeighted :: (Bin bin, Unbox val, Num val
               ) => bin -> HBuilder (BinValue bin,val) (Histogram bin val)
-mkWeighted bin = HBuilder $ do acc <- newMHistogram 0 bin
-                               return HBuilderM { hbInput  = fillOneW acc
-                                                , hbOutput = freezeHist acc
-                                                }
+mkWeighted = mkWeightedG
 {-# INLINE mkWeighted #-}
 
 -- | Create builder. New value wil be mappended to current content of
 --   a bin for each item put into histogram
 mkMonoidal :: (Bin bin, Unbox val, Monoid val
               ) => bin -> HBuilder (BinValue bin,val) (Histogram bin val)
-mkMonoidal bin = HBuilder $ do acc <- newMHistogram mempty bin
-                               return HBuilderM { hbInput  = fillMonoid acc
-                                                , hbOutput = freezeHist acc
-                                                }
+mkMonoidal = mkMonoidalG
 {-# INLINE mkMonoidal #-}
 
+-- | Create builder. Bin content will be incremented by 1 for each
+--   item put into histogram
+mkSimpleG :: (Bin bin, G.Vector v val, Num val
+            ) => bin -> HBuilder (BinValue bin) (H.Histogram v bin val)
+mkSimpleG bin = HBuilder $ do
+  acc <- newMHistogram 0 bin
+  return HBuilderM { hbInput  = fillOne    acc
+                   , hbOutput = freezeHist acc
+                   }
+{-# INLINE mkSimpleG #-}
 
+-- | Create builder. Bin content will incremented by weight supplied
+--   for each item put into histogram
+mkWeightedG :: (Bin bin, G.Vector v val, Num val
+              ) => bin -> HBuilder (BinValue bin,val) (H.Histogram v bin val)
+mkWeightedG bin = HBuilder $ do
+  acc <- newMHistogram 0 bin
+  return HBuilderM { hbInput  = fillOneW acc
+                   , hbOutput = freezeHist acc
+                   }
+{-# INLINE mkWeightedG #-}
+
+-- | Create builder. New value wil be mappended to current content of
+--   a bin for each item put into histogram
+mkMonoidalG :: (Bin bin, G.Vector v val, Monoid val
+              ) => bin -> HBuilder (BinValue bin,val) (H.Histogram v bin val)
+mkMonoidalG bin = HBuilder $ do
+  acc <- newMHistogram mempty bin
+  return HBuilderM { hbInput  = fillMonoid acc
+                   , hbOutput = freezeHist acc
+                   }
+{-# INLINE mkMonoidalG #-}
+
 -- | Create histogram builder which just does ordinary pure fold. It
 -- is intended for use when some fold should be performed together
 -- with histogram filling
 mkFolder :: b -> (a -> b -> b) -> HBuilder a b
-mkFolder a f = HBuilder $ do ref <- newSTRef a
-                             return HBuilderM { hbInput  = \x -> do acc <- readSTRef ref
-                                                                    let !acc' = f x acc
-                                                                    writeSTRef ref acc'
-                                              , hbOutput = readSTRef ref
-                                              }
+mkFolder a f = HBuilder $ do
+  ref <- newSTRef a
+  return HBuilderM { hbInput  = \x -> do acc <- readSTRef ref
+                                         let !acc' = f x acc
+                                         writeSTRef ref acc'
+                   , hbOutput = readSTRef ref
+                   }
 {-# INLINE mkFolder #-}
 
+
 -- mkMonoidalAcc :: (Bin bin, Unbox val, StatMonoid val a
 --                  ) => bin -> HBuilder (BinValue bin,a) (Histogram bin val)
 -- mkMonoidalAcc bin = HBuilder $ do acc <- newMHistogram mempty bin
@@ -358,6 +389,13 @@
                F.mapM_ (feedOne h) xs
                freezeHBuilderM h
 
+-- | Fill histogram builder.
+fillBuilderVec :: G.Vector v a => HBuilder a b -> v a -> b
+fillBuilderVec hb vec =
+    runST $ do h <- toHBuilderST hb
+               G.mapM_ (feedOne h) vec
+               freezeHBuilderM h
+
 ----------------------------------------------------------------
 
 -- $auxillary
@@ -373,11 +411,11 @@
 --
 -- > show . forceInt -<< mkSimple (BinI 1 10)
 
-forceInt :: Histogram bin Int -> Histogram bin Int
+forceInt :: H.Histogram v bin Int -> H.Histogram v bin Int
 forceInt = id
 
-forceDouble :: Histogram bin Double -> Histogram bin Double
+forceDouble :: H.Histogram v bin Double -> H.Histogram v bin Double
 forceDouble = id
 
-forceFloat :: Histogram bin Float -> Histogram bin Float
+forceFloat :: H.Histogram v bin Float -> H.Histogram v bin Float
 forceFloat = id
diff --git a/Data/Histogram/Generic.hs b/Data/Histogram/Generic.hs
--- a/Data/Histogram/Generic.hs
+++ b/Data/Histogram/Generic.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 -- |
 -- Module     : Data.Histogram
 -- Copyright  : Copyright (c) 2009, Alexey Khudyakov <alexey.skladnoy@gmail.com>
@@ -13,7 +14,9 @@
   , module Data.Histogram.Bin
   , histogram
   , histogramUO
-    -- * Read histograms from string
+  , HistIndex(..) 
+  , histIndex
+   -- * Read histograms from string
   , readHistogram
   , readFileHistogram
     -- * Accessors
@@ -25,27 +28,47 @@
     -- ** Convert to other data types
   , asList
   , asVector
-    -- * Slicing histogram
-  , sliceByIx
-  , sliceByVal
-    -- * Splitting 2D histograms
-  , sliceX
-  , sliceY
-    -- * Modify histogram
-  , histMap
-  , histMapBin
-  , histZip
-  , histZipSafe
+    -- * Modification
+  , map
+  , bmap
+  , zip
+  , zipSafe
+    -- ** Type conversion
+  , convert
+  , convertBinning
+    -- * Folding
+  , foldl
+  , bfoldl
+    -- * Slicing & rebinning
+  , slice
+  , rebin
+  , rebinFold
+    -- * 2D histograms
+    -- ** Slicing
+  , sliceAlongX
+  , sliceAlongY
+  , listSlicesAlongX
+  , listSlicesAlongY
+    -- ** Reducing along axis
+  , reduceX
+  , reduceY
+    -- * Lift histogram transform to 2D
+  , liftX
+  , liftY
   ) where
 
 import Control.Applicative ((<$>),(<*>))
-import Control.Arrow       ((***))
+import Control.Arrow       ((***), (&&&))
 import Control.Monad       (ap)
+import Control.DeepSeq     (NFData(..))
 
 import qualified Data.Vector.Generic         as G
-import Data.Typeable        (Typeable1(..), Typeable2(..), mkTyConApp, mkTyCon)
+import Data.Maybe           (fromMaybe)
+import Data.Typeable        (Typeable(..),Typeable1(..),Typeable2(..),mkTyConApp,mkTyCon)
 import Data.Vector.Generic  (Vector,(!))
 import Text.Read
+import Prelude       hiding (map,zip,foldl)
+import qualified Prelude    (zip)
 
 import Data.Histogram.Bin
 import Data.Histogram.Parse
@@ -59,21 +82,32 @@
 data Histogram v bin a = Histogram bin (Maybe (a,a)) (v a)
                          deriving (Eq)
 
+-- | Point inside histogram's domain. It could be either bin index or
+--   bin value.
+data HistIndex b
+  = Index Int          -- ^ Index for a bin
+  | Value (BinValue b) -- ^ Value
+  deriving (Typeable)
+
+-- | Convert 'HistIndex' to actual index
+histIndex :: Bin b => b -> HistIndex b -> Int
+histIndex _ (Index i) = i
+histIndex b (Value x) = toIndex b x
+
 -- | Create histogram from binning algorithm and vector with
 -- data. Overflows are set to Nothing. 
 --
 -- Number of bins and vector size must match.
 histogram :: (Vector v a, Bin bin) => bin -> v a -> Histogram v bin a
-histogram b v | nBins b == G.length v = Histogram b Nothing v
-              | otherwise             = error "histogram: number of bins and vector size doesn't match"
-
+histogram b = histogramUO b Nothing
 
 -- | Create histogram from binning algorithm and vector with data. 
 --
 -- Number of bins and vector size must match.
 histogramUO :: (Vector v a, Bin bin) => bin -> Maybe (a,a) -> v a -> Histogram v bin a
-histogramUO b uo v | nBins b == G.length v = Histogram b uo v
-                   | otherwise             = error "histogram: number of bins and vector size doesn't match"
+histogramUO b uo v 
+  | nBins b == G.length v = Histogram b uo v
+  | otherwise             = error "Data.Histogram.Generic.histogramUO: number of bins and vector size doesn't match"
 
 
 ----------------------------------------------------------------
@@ -82,7 +116,7 @@
 
 instance (Show a, Show (BinValue bin), Show bin, Bin bin, Vector v a) => Show (Histogram v bin a) where
     show h@(Histogram bin uo _) = "# Histogram\n" ++ showUO uo ++ show bin ++
-                                  unlines (map showT $ asList h)
+                                  unlines (fmap showT $ asList h)
         where
           showT (x,y) = show x ++ "\t" ++ show y
           showUO (Just (u,o)) = "# Underflows = " ++ show u ++ "\n" ++
@@ -93,6 +127,17 @@
 instance Typeable1 v => Typeable2 (Histogram v) where
   typeOf2 h = mkTyConApp (mkTyCon "Data.Histogram.Generic.Histogram") [typeOf1 (histData h)]
 
+-- | Vector do not supply 'NFData' instance so let just 'seq' it and
+--   hope it's enough. Should be enough for unboxed vectors.
+instance (NFData a, NFData bin) => NFData (Histogram v bin a) where
+   rnf (Histogram bin uo vec) = 
+     rnf bin `seq` rnf uo `seq` seq vec ()
+
+-- | If vector is a functor then histogram is functor as well
+instance (Functor v) => Functor (Histogram v bin) where
+  fmap f (Histogram bin uo vec) = Histogram bin (fmap (f *** f) uo) (fmap f vec)
+
+
 -- Parse histogram header
 histHeader :: (Read bin, Read a, Bin bin, Vector v a) => ReadPrec (v a -> Histogram v bin a)
 histHeader = do
@@ -109,13 +154,15 @@
     let (h,rest) = case readPrec_to_S histHeader 0 str of
                      [x] -> x
                      _   -> error "Cannot parse histogram header"
-        xs = map (unwords . tail) . filter (not . null) . map words . lines $ rest
-    in h (G.fromList $ map read xs)
+        xs = fmap (unwords . tail) . filter (not . null) . fmap words . lines $ rest
+    in h (G.fromList $ fmap read xs)
 
 -- | Read histogram from file.
 readFileHistogram :: (Read bin, Read a, Bin bin, Vector v a) => FilePath -> IO (Histogram v bin a)
 readFileHistogram fname = readHistogram `fmap` readFile fname
 
+
+
 ----------------------------------------------------------------
 -- Accessors & conversion
 ----------------------------------------------------------------
@@ -142,77 +189,227 @@
 
 -- | Convert histogram data to list.
 asList :: (Vector v a, Bin bin) => Histogram v bin a -> [(BinValue bin, a)]
-asList (Histogram bin _ arr) = map (fromIndex bin) [0..] `zip` G.toList arr
+asList (Histogram bin _ arr) = 
+  Prelude.zip (fromIndex bin <$> [0..]) (G.toList arr)
 
 -- | Convert histogram data to vector
-asVector :: (Bin bin, Vector v a, Vector v (BinValue bin), Vector v (BinValue bin,a)) 
-         => Histogram v bin a -> v (BinValue bin, a) 
-asVector (Histogram bin _ arr) = G.zip (G.generate (nBins bin) (fromIndex bin) ) arr
+asVector :: (Bin bin, Vector v a, Vector v (BinValue bin,a))
+         => Histogram v bin a -> v (BinValue bin, a)
+asVector (Histogram bin _ arr) =
+  G.generate (nBins bin) $ \i -> (fromIndex bin i, arr G.! i)
 
+
+
 ----------------------------------------------------------------
 -- Modify histograms
 ----------------------------------------------------------------
 
 -- | fmap lookalike. It's not possible to create Functor instance
---   because of class restrictions
-histMap :: (Vector v a, Vector v b) => (a -> b) -> Histogram v bin a -> Histogram v bin b
-histMap f (Histogram bin uo a) = Histogram bin (fmap (f *** f) uo) (G.map f a)
+--   because of type class context.
+map :: (Vector v a, Vector v b) => (a -> b) -> Histogram v bin a -> Histogram v bin b
+map f (Histogram bin uo a) = 
+  Histogram bin (fmap (f *** f) uo) (G.map f a)
 
--- | Apply function to histogram bins. Function must not change number of bins.
---   If it does error is thrown.
-histMapBin :: (Bin bin, Bin bin') => (bin -> bin') -> Histogram v bin a -> Histogram v bin' a
-histMapBin f (Histogram bin uo a)
-    | nBins bin == nBins bin' = Histogram (f bin) uo a
-    | otherwise               = error "Number of bins doesn't match"
-    where
-      bin' = bin
+-- | Map histogram using bin value and content. Overflows and underflows are set to Nothing.
+bmap :: (Vector v a, Vector v b, Bin bin)
+     => (BinValue bin -> a -> b) -> Histogram v bin a -> Histogram v bin b
+bmap f (Histogram bin _ vec) =
+  Histogram bin Nothing $ G.imap (f . fromIndex bin) vec
 
 -- | Zip two histograms elementwise. Bins of histograms must be equal
 --   otherwise error will be called.
-histZip :: (Bin bin, Eq bin, Vector v a, Vector v b, Vector v c) =>
-           (a -> b -> c) -> Histogram v bin a -> Histogram v bin b -> Histogram v bin c
-histZip f (Histogram bin uo v) (Histogram bin' uo' v')
-    | bin /= bin' = error "histZip: bins are different"
-    | otherwise   = Histogram bin (f2 <$> uo <*> uo') (G.zipWith f v v')
-      where
-        f2 (x,x') (y,y') = (f x y, f x' y')
+zip :: (Bin bin, BinEq bin, Vector v a, Vector v b, Vector v c) =>
+       (a -> b -> c) -> Histogram v bin a -> Histogram v bin b -> Histogram v bin c
+zip f ha hb = fromMaybe (error msg) $ zipSafe f ha hb
+  where msg = "Data.Histogram.Generic.Histogram.histZip: bins are different"
 
 -- | Zip two histogram elementwise. If bins are not equal return `Nothing`
-histZipSafe :: (Bin bin, Eq bin, Vector v a, Vector v b, Vector v c) =>
+zipSafe :: (Bin bin, BinEq bin, Vector v a, Vector v b, Vector v c) =>
            (a -> b -> c) -> Histogram v bin a -> Histogram v bin b -> Maybe (Histogram v bin c)
-histZipSafe f (Histogram bin uo v) (Histogram bin' uo' v')
-    | bin /= bin' = Nothing
-    | otherwise   = Just $ Histogram bin (f2 <$> uo <*> uo') (G.zipWith f v v')
-      where
-        f2 (x,x') (y,y') = (f x y, f x' y')
+zipSafe f (Histogram bin uo v) (Histogram bin' uo' v')
+  | binEq bin bin' = Just $ Histogram bin (f2 <$> uo <*> uo') (G.zipWith f v v')
+  | otherwise      = Nothing
+  where
+    f2 (x,x') (y,y') = (f x y, f x' y')
 
+-- | Convert between different vector types
+convert :: (Vector v a, Vector w a)
+        => Histogram v bin a -> Histogram w bin a
+convert (Histogram bin uo vec) = Histogram bin uo (G.convert vec)
 
--- | Slice histogram using indices.
-sliceByIx :: (Bin1D bin, Vector v a) => Int -> Int -> Histogram v bin a -> Histogram v bin a
-sliceByIx i j (Histogram b _ v) = 
-  Histogram (sliceBin i j b) Nothing (G.slice i (j - i + 1) v)
+-- | Convert between binning types using 'ConvertBin' type class.
+convertBinning :: (ConvertBin bin bin', Vector v a)
+               => Histogram v bin a -> Histogram v bin' a
+convertBinning (Histogram bin uo vec)
+  | nBins bin == nBins bin' = Histogram bin' uo vec
+  | otherwise               = error "Data.Histogram.Generic.convertBinning: invalid ConvertBin instance"
+  where
+    bin' = convertBin bin
 
--- | Slice histogram using bin values. Value will be included in range.
-sliceByVal :: (Bin1D bin, Vector v a) => BinValue bin -> BinValue bin -> Histogram v bin a -> Histogram v bin a
-sliceByVal x y h 
-  | inRange b x && inRange b y = sliceByIx (toIndex b x) (toIndex b y) h
-  | otherwise                  = error "sliceByVal: Values are out of range"
-    where
-      b = bins h
 
--- | Slice 2D histogram along Y axis. This function is fast because it does not require reallocations.
-sliceY :: (Vector v a, Bin bX, Bin bY) => Histogram v (Bin2D bX bY) a -> [(BinValue bY, Histogram v bX a)]
-sliceY (Histogram b _ a) = map mkSlice [0 .. ny-1]
-    where
-      (nx, ny) = nBins2D b
-      mkSlice i = ( fromIndex (binY b) i
-                  , Histogram (binX b) Nothing (G.slice (nx*i) nx a) )
 
+----------------------------------------------------------------
+-- Folding
+----------------------------------------------------------------
+
+-- | Strict fold over bin content in index order. Underflows and overflows are ignored.
+foldl :: (Bin bin, Vector v a) => (b -> a -> b) -> b -> Histogram v bin a -> b
+foldl f x0 (Histogram _ _ vec) =
+  G.foldl' f x0 vec
+
+-- | Strict fold over bin content in index order. Function is applied
+--   to bin content and bin value. Underflows and overflows are ignored.
+bfoldl :: (Bin bin, Vector v a) => (b -> BinValue bin -> a -> b) -> b -> Histogram v bin a -> b
+bfoldl f x0 (Histogram bin _ vec) =
+  G.ifoldl' (\acc -> f acc . fromIndex bin) x0 vec
+
+
+
+----------------------------------------------------------------
+-- Slicing and reducing histograms
+----------------------------------------------------------------
+
+-- | Slice histogram. Values/indices specify inclusive
+--   variant. Under/overflows are discarded.
+slice :: (SliceableBin bin, Vector v a)
+      => HistIndex bin          -- ^ Lower inclusive bound
+      -> HistIndex bin          -- ^ Upper inclusive bound
+      -> Histogram v bin a      -- ^ Histogram to slice
+      -> Histogram v bin a
+slice a b (Histogram bin _ v) =
+  Histogram (sliceBin i j bin) Nothing (G.slice i (j - i + 1) v)
+  where
+    i = histIndex bin a
+    j = histIndex bin b
+
+-- | Rebin histogram
+rebin :: (MergeableBin bin, Vector v a)
+      => CutDirection
+      -> Int      
+      -> (a -> a -> a)          -- ^ Accumulation function
+      -> Histogram v bin a
+      -> Histogram v bin a
+rebin dir k f =  rebinWorker dir k (G.foldl1' f)
+{-# INLINE rebin #-}
+
+-- | Rebin histogram
+rebinFold :: (MergeableBin bin, Vector v a, Vector v b)
+          => CutDirection
+          -> Int      
+          -> (b -> a -> b)          -- ^ Accumulation function
+          -> b                      -- ^ Initial value
+          -> Histogram v bin a
+          -> Histogram v bin b
+rebinFold dir k f x0 =  rebinWorker dir k (G.foldl' f x0)
+{-# INLINE rebinFold #-}
+
+rebinWorker :: (MergeableBin bin, Vector v a, Vector v b)
+            => CutDirection
+            -> Int
+            -> (v a -> b)
+            -> Histogram v bin a
+            -> Histogram v bin b
+{-# INLINE rebinWorker #-}
+rebinWorker dir k f (Histogram bin _ vec)
+  | G.length vec' /= nBins bin' = error "Data.Histogram.Generic.rebin: wrong MergeableBin instance"
+  | otherwise                   = Histogram bin' Nothing vec'
+  where
+    bin' = mergeBins dir k bin
+    vec' = G.generate n $ \i -> f (G.slice (off + i*k) k vec)
+    n    = G.length vec `div` k
+    off  = case dir of CutLower  -> G.length vec - n * k
+                       CutHigher -> 0
+
+----------------------------------------------------------------
+-- 2D histograms
+----------------------------------------------------------------
+
+-- | Get slice of 2D histogram along X axis. This function is faster
+--   than 'sliceAlongY' since no array reallocations is required
+sliceAlongX :: (Vector v a, Bin bX, Bin bY)
+            => Histogram v (Bin2D bX bY) a -- ^ 2D histogram
+            -> HistIndex bY                -- ^ Position along Y axis
+            -> Histogram v bX a
+sliceAlongX (Histogram (Bin2D bX bY) _ arr) y
+  | iy >= 0 && iy < ny = Histogram bX Nothing $ G.slice (nx * iy) nx arr
+  | otherwise          = error "Data.Histogram.Generic.Histogram.sliceXatIx: bad index"
+  where
+    nx = nBins bX
+    ny = nBins bY
+    iy = histIndex bY y
+
+-- | Get slice of 2D histogram along X axis
+sliceAlongY :: (Vector v a, Bin bX, Bin bY)
+            => Histogram v (Bin2D bX bY) a -- ^ 2D histogram
+            -> HistIndex bX                -- ^ Position along X axis
+            -> Histogram v bY a
+sliceAlongY (Histogram (Bin2D bX bY) _ arr) x
+  | ix >= 0 && ix < nx = Histogram bY Nothing $ G.generate ny (\iy -> arr ! (iy*nx + ix))
+  | otherwise          = error "Data.Histogram.Generic.Histogram.sliceXatIx: bad index"
+  where
+    nx = nBins bX
+    ny = nBins bY
+    ix = histIndex bX x
+
+-- | Slice 2D histogram along Y axis. This function is fast because it
+--   does not require reallocations.
+listSlicesAlongX :: (Vector v a, Bin bX, Bin bY)
+                 => Histogram v (Bin2D bX bY) a
+                 -> [(BinValue bY, Histogram v bX a)]
+listSlicesAlongX h@(Histogram (Bin2D _ bY) _ _) =
+  fmap (fromIndex bY &&& sliceAlongX h . Index) [0 .. nBins bY - 1]
+
 -- | Slice 2D histogram along X axis.
-sliceX :: (Vector v a, Bin bX, Bin bY) => Histogram v (Bin2D bX bY) a -> [(BinValue bX, Histogram v bY a)]
-sliceX (Histogram b _ a) = map mkSlice [0 .. nx-1]
-    where
-      (nx, ny)  = nBins2D b
-      mkSlice i = ( fromIndex (binX b) i
-                  , Histogram (binY b) Nothing (mkArray i))
-      mkArray x = G.generate ny (\y -> a ! (y*nx + x))
+listSlicesAlongY :: (Vector v a, Bin bX, Bin bY)
+                 => Histogram v (Bin2D bX bY) a
+                 -> [(BinValue bX, Histogram v bY a)]
+listSlicesAlongY h@(Histogram (Bin2D bX _) _ _) =
+  fmap (fromIndex bX &&& sliceAlongY h . Index) [0 .. nBins bX - 1]
+
+
+-- | Reduce along X axis. Information about under/overlows is lost.
+reduceX :: (Vector v a, Vector v b, Bin bX, Bin bY)
+        => (Histogram v bX a -> b)      -- ^ Function to reduce single slice along X axis
+        ->  Histogram v (Bin2D bX bY) a -- ^ 2D histogram
+        ->  Histogram v bY b
+reduceX f h@(Histogram (Bin2D _ bY) _ _) =
+  Histogram bY Nothing $ G.generate (nBins bY) (f . sliceAlongX h . Index)
+
+
+-- | Reduce along Y axis. Information about under/overflows is lost.
+reduceY :: (Vector v a, Vector v b, Bin bX, Bin bY)
+        => (Histogram v bY a -> b)     -- ^ Function to reduce histogram along Y axis
+        -> Histogram v (Bin2D bX bY) a -- ^ 2D histogram
+        -> Histogram v bX b
+reduceY f h@(Histogram (Bin2D bX _) _ _) =
+  Histogram bX Nothing $ G.generate (nBins bX) (f . sliceAlongY h . Index)
+
+liftX :: (Bin bX, Bin bY, Bin bX', BinEq bX', Vector v a, Vector v b)
+      => (Histogram v bX a -> Histogram v bX' b)
+      -> Histogram v (Bin2D bX  bY) a
+      -> Histogram v (Bin2D bX' bY) b
+liftX f hist@(Histogram (Bin2D _ by) _ _) =
+  case f . snd <$> listSlicesAlongX hist of
+    [] -> error "Data.Histogram.Generic.Histogram.liftX: zero size along Y"
+    hs -> Histogram
+          (Bin2D (bins (head hs)) by)
+           Nothing
+          (G.concat (histData <$> hs))
+
+liftY :: (Bin bX, Bin bY, Bin bY', BinEq bY', Vector v a, Vector v b, Vector v Int)
+      => (Histogram v bY a -> Histogram v bY' b)
+      -> Histogram v (Bin2D bX bY ) a
+      -> Histogram v (Bin2D bX bY') b
+liftY f hist@(Histogram (Bin2D bx _) _ _) =
+  case f . snd <$> listSlicesAlongY hist of
+    [] -> error "Data.Histogram.Generic.Histogram.liftY: zero size along X"
+    hs -> make hs
+ where
+   make hs = Histogram (Bin2D bx by') Nothing
+           $ G.backpermute (G.concat (histData <$> hs)) (G.generate (nx*ny) join)
+     where
+       by'    = bins (head hs)
+       nx     = nBins bx
+       ny     = nBins by'
+       join i = let (a,b) = i `quotRem` nx
+                in  a + b * ny
diff --git a/Data/Histogram/ST.hs b/Data/Histogram/ST.hs
--- a/Data/Histogram/ST.hs
+++ b/Data/Histogram/ST.hs
@@ -22,89 +22,79 @@
 import Control.Monad.Primitive
 
 import Data.Monoid
--- import Data.Monoid.Statistics
-import qualified Data.Vector.Unboxed as U
-import qualified Data.Vector.Unboxed.Mutable as MU
-import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic         as G
+import qualified Data.Vector.Generic.Mutable as M
 
-import Data.Histogram
+import Data.Histogram.Generic
 
 ----------------------------------------------------------------
 -- Mutable histograms
 ----------------------------------------------------------------
 
 -- | Mutable histogram.
-data MHistogram s bin a = MHistogram bin (MU.MVector s a) (MU.MVector s a)
+data MHistogram s v bin a =
+  MHistogram
+    {-# UNPACK #-} !Int -- Number of bins
+    !bin                -- Binning
+    !(v s a)            -- Bin contents. Underflows are stored at the
+                        -- n'th index and overflow are in the n+1
 
+
 -- | Create new mutable histogram. All bins are set to zero element as
 --   passed to function.
-newMHistogram :: (PrimMonad m, Bin bin, U.Unbox a) => a -> bin -> m (MHistogram (PrimState m) bin a)
+newMHistogram :: (PrimMonad m, Bin bin, M.MVector v a) => a -> bin -> m (MHistogram (PrimState m) v bin a)
 newMHistogram zero bin = do
-  uo <- MU.replicate 2 zero
-  a  <- MU.replicate (nBins bin) zero
-  return $ MHistogram bin uo a
+  let n = nBins bin
+  a  <- M.replicate (n + 2) zero
+  return $ MHistogram n bin a
 {-# INLINE newMHistogram #-}
 
+-- Generic fill
+fill :: (PrimMonad m, M.MVector v a, Bin bin) => MHistogram (PrimState m) v bin a -> BinValue bin -> (a -> a) -> m ()
+fill (MHistogram n bin arr) !x f
+  | i <  0    = M.unsafeWrite arr  n    . f =<< M.unsafeRead arr n
+  | i >= n    = M.unsafeWrite arr (n+1) . f =<< M.unsafeRead arr (n+1)
+  | otherwise = M.unsafeWrite arr  i    . f =<< M.unsafeRead arr i
+  where
+    i = toIndex bin x
+{-# INLINE fill #-}
+
 -- | Put one value into histogram
-fillOne :: (PrimMonad m, Num a, U.Unbox a, Bin bin) => MHistogram (PrimState m) bin a -> BinValue bin -> m ()
-fillOne (MHistogram bin uo arr) !x
-    | i < 0              = MU.unsafeWrite uo  0 . (+1)  =<< MU.unsafeRead uo 0
-    | i >= MU.length arr = MU.unsafeWrite uo  1 . (+1)  =<< MU.unsafeRead uo 1
-    | otherwise          = MU.unsafeWrite arr i . (+1)  =<< MU.unsafeRead arr i
-    where
-      i = toIndex bin x
+fillOne :: (PrimMonad m, Num a, M.MVector v a, Bin bin) => MHistogram (PrimState m) v bin a -> BinValue bin -> m ()
+fillOne h !x = fill h x (+1)
 {-# INLINE fillOne #-}
 
 -- | Put one value into histogram with weight
-fillOneW :: (PrimMonad m, Num a, U.Unbox a, Bin bin) => MHistogram (PrimState m) bin a -> (BinValue bin, a) -> m ()
-fillOneW (MHistogram bin uo arr) !(x,w)
-    | i < 0              = MU.unsafeWrite uo  0 . (+w)  =<< MU.unsafeRead uo 0
-    | i >= MU.length arr = MU.unsafeWrite uo  1 . (+w)  =<< MU.unsafeRead uo 1
-    | otherwise          = MU.unsafeWrite arr i . (+w)  =<< MU.unsafeRead arr i
-    where
-      i = toIndex bin x
+fillOneW :: (PrimMonad m, Num a, M.MVector v a, Bin bin) => MHistogram (PrimState m) v bin a -> (BinValue bin, a) -> m ()
+fillOneW h (!x,!w) = fill h x (+w)
 {-# INLINE fillOneW #-} 
 
 -- | Put one monoidal element
-fillMonoid :: (PrimMonad m, Monoid a, U.Unbox a, Bin bin) => MHistogram (PrimState m) bin a -> (BinValue bin, a) -> m ()
-fillMonoid (MHistogram bin uo arr) !(x,m)
-    | i < 0              = MU.unsafeWrite uo  0 . flip mappend m =<< MU.unsafeRead uo  0
-    | i >= MU.length arr = MU.unsafeWrite uo  1 . flip mappend m =<< MU.unsafeRead uo  1
-    | otherwise          = MU.unsafeWrite arr i . flip mappend m =<< MU.unsafeRead arr i
-    where 
-      i = toIndex bin x
+fillMonoid :: (PrimMonad m, Monoid a, M.MVector v a, Bin bin) => MHistogram (PrimState m) v bin a -> (BinValue bin, a) -> m ()
+fillMonoid h (!x,!m) = fill h x (`mappend` m)
 {-# INLINE fillMonoid #-}
 
--- -- | Add one element to monoidal accumulator
--- fillMonoidAccum :: (PrimMonad m, StatMonoid val a, U.Unbox val, Bin bin) 
---                 => MHistogram (PrimState m) bin val -> (BinValue bin, a) -> m ()
--- fillMonoidAccum (MHistogram bin uo arr) !(x,a)
---     | i < 0              = MU.unsafeWrite uo  0 . pappend a =<< MU.unsafeRead uo  0
---     | i >= MU.length arr = MU.unsafeWrite uo  1 . pappend a =<< MU.unsafeRead uo  1
---     | otherwise          = MU.unsafeWrite arr i . pappend a =<< MU.unsafeRead arr i
---     where 
---       i = toIndex bin x
--- {-# INLINE fillMonoidAccum #-}
-    
+
 -- | Create immutable histogram from mutable one. This operation is
 -- unsafe! Accumulator mustn't be used after that
-unsafeFreezeHist :: (PrimMonad m, U.Unbox a, Bin bin) => MHistogram (PrimState m) bin a -> m (Histogram bin a)
-unsafeFreezeHist (MHistogram bin uo arr) = do
-  u <- MU.unsafeRead uo 0
-  o <- MU.unsafeRead uo 1
-  a <- G.unsafeFreeze arr
+unsafeFreezeHist :: (PrimMonad m, G.Vector v a, Bin bin) 
+                 => MHistogram (PrimState m) (G.Mutable v) bin a 
+                 -> m (Histogram v bin a)
+unsafeFreezeHist (MHistogram n bin arr) = do
+  u <- M.unsafeRead arr  n
+  o <- M.unsafeRead arr (n+1)
+  a <- G.unsafeFreeze $ M.slice 0 n arr
   return $ histogramUO bin (Just (u,o)) a
 {-# INLINE unsafeFreezeHist #-}  
 
 -- | Create immutable histogram from mutable one.
-freezeHist :: (PrimMonad m, U.Unbox a, Bin bin) => MHistogram (PrimState m) bin a -> m (Histogram bin a)
-freezeHist (MHistogram bin uo arr) = do
-  u <- MU.unsafeRead uo 0
-  o <- MU.unsafeRead uo 1
-  -- Copy array
-  tmp  <- MU.new (MU.length arr)
-  MU.copy tmp arr
-  a    <- G.unsafeFreeze tmp
+freezeHist :: (PrimMonad m, G.Vector v a, Bin bin) 
+           => MHistogram (PrimState m) (G.Mutable v) bin a 
+           -> m (Histogram v bin a)
+freezeHist (MHistogram n bin arr) = do
+  u <- M.unsafeRead arr  n
+  o <- M.unsafeRead arr (n+1)
+  a <- G.freeze $ M.slice 0 n arr
   return $ histogramUO bin (Just (u,o)) a
 {-# INLINE freezeHist #-}
 
diff --git a/histogram-fill.cabal b/histogram-fill.cabal
--- a/histogram-fill.cabal
+++ b/histogram-fill.cabal
@@ -1,5 +1,5 @@
 Name:           histogram-fill
-Version:        0.5.1.1
+Version:        0.6.0.0
 Cabal-Version:  >= 1.6
 License:        BSD3
 License-File:   LICENSE
@@ -19,6 +19,7 @@
 
 Library
   Build-Depends:        base >=3 && <5,
+                        deepseq,
                         primitive,
                         vector >= 0.7
 --                        monoid-statistics == 0.1.*
