diff --git a/Data/Histogram.hs b/Data/Histogram.hs
--- a/Data/Histogram.hs
+++ b/Data/Histogram.hs
@@ -37,6 +37,7 @@
   , histMap
   , histMapBin
   , histZip
+  , histZipSafe
   ) where
 
 import qualified Data.Vector.Unboxed    as U
@@ -125,12 +126,17 @@
 histMapBin :: (Bin bin, Bin bin') => (bin -> bin') -> Histogram bin a -> Histogram bin' a
 histMapBin = H.histMapBin
 
--- | Zip two histograms together. Bins of histograms must be equal
+-- | 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 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
+
 -- | 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
diff --git a/Data/Histogram/Bin.hs b/Data/Histogram/Bin.hs
--- a/Data/Histogram/Bin.hs
+++ b/Data/Histogram/Bin.hs
@@ -1,174 +1,200 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE GADTs        #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+-- Requred for Bin2D conversions
+{-# LANGUAGE OverlappingInstances #-}
 -- |
 -- Module     : Data.Histogram.Bin
 -- Copyright  : Copyright (c) 2009, Alexey Khudyakov <alexey.skladnoy@gmail.com>
 -- License    : BSD3
 -- Maintainer : Alexey Khudyakov <alexey.skladnoy@gmail.com>
 -- Stability  : experimental
--- 
+--
 -- Binning algorithms. This is mapping from set of interest to integer
--- indices and approximate reverse. 
+-- indices and approximate reverse.
 
 module Data.Histogram.Bin ( -- * Type classes
                             Bin(..)
                           , Bin1D(..)
-                          , Indexable(..)
-                          , Indexable2D(..)
+                          , UniformBin1D(..)
+                          , VariableBin1D(..)
+                          , ConvertBin(..)
                           -- * Bin types
                           -- ** Integer bins
                           , BinI(..)
                           , binI0
                           -- ** Integer bins with non-1 size
-                          , BinInt
+                          , BinInt(..)
                           , binInt
-                          -- ** Indexed bins 
-                          , BinIx(BinIx,unBinIx)
-                          , binIx
+                          -- ** Enum based bin
+                          , BinEnum(..)
+                          , binEnum
+                          , binEnumFull
                           -- ** Floating point bins
                           , BinF
                           , binF
                           , binFn
-                          , binI2binF
+                          , binFstep
                           , scaleBinF
-                          -- *** Specialized for Double 
+                          -- *** Specialized for Double
                           , BinD
                           , binD
                           , binDn
-                          , binI2binD
+                          , binDstep
                           , scaleBinD
                           -- ** Log scale point
-                          , LogBinD 
+                          , LogBinD
                           , logBinD
                           -- ** 2D bins
                           , Bin2D(..)
                           , (><)
                           , nBins2D
                           , toIndex2D
-                          , binX
-                          , binY
                           , fmapBinX
                           , fmapBinY
-                          -- ** 2D indexed bins
-                          , BinIx2D (unBinIx2D)
-                          , binIx2D
                           ) where
 
-import Control.Monad
+import Control.Monad (liftM, liftM2, liftM3)
+import GHC.Float     (double2Int)
+
+import qualified Data.Vector.Generic as G
+import           Data.Vector.Generic    (Vector)
+import Data.Typeable                    (Typeable)
+import Text.Read                        (Read(..))
+
 import Data.Histogram.Parse
-import Text.Read (Read(..))
 
-import GHC.Float (double2Int)
+
+
 ----------------------------------------------------------------
--- | Abstract binning algorithm. It provides way to map some values
--- onto continous range of integer values starting from zero. 
--- 
--- Following invariant is expected to hold: 
--- 
--- > toIndex . fromIndex == id
--- 
--- Reverse is not nessearily true. 
+-- Type classes
+----------------------------------------------------------------
+
+-- | This type represent some abstract data binning algorithms.
+--   It maps some value to integer indices.
+--
+--   Following invariant is expected to hold:
+--
+--   > toIndex . fromIndex == id
 class Bin b where
-    -- | Type of value to bin
-    type BinValue b
-    -- | Convert from value to index. No bound checking performed
-    toIndex :: b -> BinValue b -> Int
-    -- | Convert from index to value. 
-    fromIndex :: b -> Int -> BinValue b 
-    -- | Check whether value in range.
-    inRange :: b -> BinValue b -> Bool
-    -- | Total number of bins
-    nBins :: b -> Int
+  -- | Type of value to bin
+  type BinValue b
+  -- | Convert from value to index. No bound checking
+  --   performed. Function must not fail for any input.
+  toIndex :: b -> BinValue b -> Int
+  -- | Convert from index to value. Returned value should correspond
+  --   to "center" of bin. Definition of center is left for definition
+  --   of instance. Funtion may fail for invalid indices but
+  --   encouraged not to do so.
+  fromIndex :: b -> Int -> BinValue b
+  -- | Check whether value in range. Values which lay in range must
+  --   produce valid indices and conversely value which produce
+  --   valid index must be in range.
+  inRange :: b -> BinValue b -> Bool
+  -- | Total number of bins
+  nBins :: b -> Int
 
-----------------------------------------------------------------
+
 -- | One dimensional binning algorithm. It means that bin values have
--- some inherent ordering. For example all binning algorithms for real
--- numbers could be members or this type class whereas binning
--- algorithms for R^2 could not. 
+--   some inherent ordering. For example all binning algorithms for
+--   real numbers could be members or this type class whereas binning
+--   algorithms for R^2 could not.
 class Bin b => Bin1D b where
-    -- | List of center of bins in ascending order.
-    binsList :: b -> [BinValue b]
-    -- | List of bins in ascending order.
-    binsListRange :: b -> [(BinValue b, BinValue b)]
+  -- | Minimal accepted value of histogram
+  lowerLimit :: b -> BinValue b
+  -- | Maximal accepted value of histogram
+  upperLimit :: b -> BinValue b
+  -- | List of center of bins in ascending order. Default
+  --   implementation is:
+  --
+  --   > binsList b = G.generate (nBins b) (fromIndex b)
+  binsList :: Vector v (BinValue b) => b -> v (BinValue b)
+  binsList b = G.generate (nBins b) (fromIndex b)
+  -- | List of bins in ascending order. First element of tuple is
+  --   lower bound second is upper bound of bin
+  binsListRange :: Vector v (BinValue b, BinValue b) => b -> v (BinValue b, BinValue b)
+  {-# INLINE binsList #-}
 
-----------------------------------------------------------------
--- | Indexable is value which could be converted to and from Int
--- without information loss.
---
--- Always true
---
--- > deindex . index = id
---
--- Only if Int is in range
---
--- > index . deindex = id
-class Indexable a where
-    -- | Convert value to index
-    index :: a -> Int 
-    -- | Convert index to value
-    deindex :: Int -> a
 
-instance Indexable Int where
-    index   = id
-    deindex = id
+-- | 1D binning algorithms with variable bin size
+class Bin1D b => VariableBin1D b where
+  -- | Size of n'th bin.
+  binSizeN :: b -> Int -> BinValue b
 
-----------------------------------------------------------------
--- | This type class is same as Indexable but for 2D values.
-class Indexable2D a where
-    -- | Convert value to index
-    index2D :: a -> (Int,Int)
-    -- | Convert index to value
-    deindex2D :: (Int,Int) -> a
 
-instance (Indexable a, Indexable b) => Indexable2D (a,b) where
-    index2D   (x,y) = (index x,   index y)
-    deindex2D (i,j) = (deindex i, deindex j)
+-- | 1D binning algorithms with constant size bins. Constant sized
+--   bins could be thought as specialization of variable-sized bins
+--   therefore a superclass constraint.
+class VariableBin1D b => UniformBin1D b where
+  -- | Size of bin. Default implementation just uses 0 bin.
+  binSize :: b -> BinValue b
+  binSize b = binSizeN b 0
 
+
+-- | Class for conversion between binning algorithms
+class (Bin b, Bin b') => ConvertBin b b' where
+  -- | Convert bins
+  convertBin :: b -> b'
+
 ----------------------------------------------------------------
 -- Integer bin
 ----------------------------------------------------------------
 -- | Simple binning algorithm which map continous range of bins onto
 -- indices. Each number correcsponds to different bin
-data BinI = BinI {-# UNPACK #-} !Int {-# UNPACK #-} !Int
-            deriving Eq
+data BinI = BinI
+            {-# UNPACK #-} !Int -- ^ Lower bound (inclusive)
+            {-# UNPACK #-} !Int -- ^ Upper bound (inclusive)
+            deriving (Eq,Typeable)
 
 -- | Construct BinI with n bins. Indexing starts from 0
 binI0 :: Int -> BinI
 binI0 n = BinI 0 (n-1)
 
 instance Bin BinI where
-    type BinValue BinI = Int
-    toIndex   !(BinI base _) !x = x - base
-    {-# INLINE toIndex #-}
-    fromIndex !(BinI base _) !x = x + base
-    inRange   !(BinI x y) i     = i>=x && i<=y
-    {-# INLINE inRange #-}
-    nBins     !(BinI x y) = y - x + 1
+  type BinValue BinI = Int
+  toIndex   !(BinI base _) !x = x - base
+  fromIndex !(BinI base _) !x = x + base
+  inRange   !(BinI x y) i     = i>=x && i<=y
+  nBins     !(BinI x y) = y - x + 1
+  {-# INLINE toIndex #-}
+  {-# INLINE inRange #-}
 
 instance Bin1D BinI where
-    binsList (BinI lo hi) = [lo .. hi]
-    binsListRange b = zip (binsList b) (binsList b)
+  lowerLimit (BinI i _) = i
+  upperLimit (BinI _ i) = i
+  binsList      b@(BinI lo _) = G.enumFromN lo (nBins b)
+  binsListRange b@(BinI lo _) = G.generate (nBins b) (\i -> let n = lo+i in (n,n))
+  {-# INLINE binsList      #-}
+  {-# INLINE binsListRange #-}
 
+instance VariableBin1D BinI where
+  binSizeN _ _ = 1
+
+instance UniformBin1D BinI where
+  binSize _ = 1
+
 instance Show BinI where
-    show (BinI lo hi) = unlines [ "# BinI"
-                                , "# Low  = " ++ show lo
-                                , "# High = " ++ show hi
-                                ]
+  show (BinI lo hi) = unlines [ "# BinI"
+                              , "# Low  = " ++ show lo
+                              , "# High = " ++ show hi
+                              ]
 instance Read BinI where
-    readPrec = keyword "BinI" >> liftM2 BinI (value "Low") (value "High")
+  readPrec = keyword "BinI" >> liftM2 BinI (value "Low") (value "High")
 
+
+
 ----------------------------------------------------------------
 -- Another form of Integer bin
 ----------------------------------------------------------------
 
 -- | Integer bins with size which differ from 1.
-data BinInt = BinInt 
-              {-# UNPACK #-} !Int -- Low bound
-              {-# UNPACK #-} !Int -- Bin size
-              {-# UNPACK #-} !Int -- Number of bins
-              deriving Eq
+data BinInt = BinInt
+              {-# UNPACK #-} !Int -- ^ Low bound
+              {-# UNPACK #-} !Int -- ^ Bin size
+              {-# UNPACK #-} !Int -- ^ Number of bins
+              deriving (Eq,Typeable)
 
 -- | Construct BinInt.
 binInt :: Int                   -- ^ Lower bound
@@ -177,71 +203,91 @@
        -> BinInt
 binInt lo n hi = BinInt lo n nb
   where
-    nb = (hi-lo) `div` n 
+    nb = (hi-lo) `div` n
 
 instance Bin BinInt where
-    type BinValue BinInt = Int
-    toIndex   !(BinInt base sz _) !x = (x - base) `div` sz
-    {-# INLINE toIndex #-}
-    fromIndex !(BinInt base sz _) !x = x * sz + base
-    inRange   !(BinInt base sz n) i  = i>=base && i<(base+n*sz)
-    {-# INLINE inRange #-}
-    nBins     !(BinInt _ _ n) = n
+  type BinValue BinInt = Int
+  toIndex   !(BinInt base sz _) !x = (x - base) `div` sz
+  fromIndex !(BinInt base sz _) !x = x * sz + base
+  inRange   !(BinInt base sz n) i  = i>=base && i<(base+n*sz)
+  nBins     !(BinInt _ _ n) = n
+  {-# INLINE toIndex #-}
+  {-# INLINE inRange #-}
 
+instance Bin1D BinInt where
+  lowerLimit      (BinInt base _  _) = base
+  upperLimit      (BinInt base sz n) = base + sz * n - 1
+  binsListRange b@(BinInt _    sz n) = G.generate n (\i -> let x = fromIndex b i in (x,x + sz - 1))
+
+instance VariableBin1D BinInt where
+  binSizeN (BinInt _ sz _) _ = sz
+
+instance UniformBin1D BinInt where
+  binSize (BinInt _ sz _) = sz
+
 instance Show BinInt where
-    show (BinInt base sz n) = 
-      unlines [ "# BinInt"
-              , "# Base = " ++ show base
-              , "# Step = " ++ show sz
-              , "# Bins = " ++ show n
-              ]
+  show (BinInt base sz n) =
+    unlines [ "# BinInt"
+            , "# Base = " ++ show base
+            , "# Step = " ++ show sz
+            , "# Bins = " ++ show n
+            ]
 
 instance Read BinInt where
-    readPrec = keyword "BinInt" >> liftM3 BinInt (value "Base") (value "Step") (value "Bins")
+  readPrec = keyword "BinInt" >> liftM3 BinInt (value "Base") (value "Step") (value "Bins")
 
+
 ----------------------------------------------------------------
--- Bins for indexables
+-- Enumeration bin
 ----------------------------------------------------------------
 
--- | Binning for indexable values
-newtype BinIx i = BinIx { unBinIx :: BinI }
-                  deriving Eq
+-- | Bin for types which are instnaces of Enum type class
+newtype BinEnum a = BinEnum BinI
+                    deriving (Eq,Typeable)
 
--- | Construct indexed bin
-binIx :: Indexable i => i -> i -> BinIx i
-binIx lo hi = BinIx $ BinI (index lo) (index hi)
+-- | Create enum based bin
+binEnum :: Enum a => a -> a -> BinEnum a
+binEnum a b = BinEnum $ BinI (fromEnum a) (fromEnum b)
 
-instance Indexable i => Bin (BinIx i) where
-    type BinValue (BinIx i) = i
-    toIndex   (BinIx b) x = toIndex b (index x)
-    fromIndex (BinIx b) i = deindex (fromIndex b i)
-    inRange   (BinIx b) x = inRange b (index x)
-    nBins (BinIx b) = nBins b
+-- | Use full range of data
+binEnumFull :: (Enum a, Bounded a) => BinEnum a
+binEnumFull = binEnum minBound maxBound
 
-instance Indexable i => Bin1D (BinIx i) where
-    binsList (BinIx b) = map deindex (binsList b)
-    binsListRange b    = let bins = binsList b in zip bins bins
+instance Enum a => Bin (BinEnum a) where
+  type BinValue (BinEnum a) = a
+  toIndex   (BinEnum b) = toIndex b . fromEnum
+  fromIndex (BinEnum b) = toEnum . fromIndex b
+  inRange   (BinEnum b) = inRange b . fromEnum
+  nBins     (BinEnum b) = nBins b
 
-instance (Show i, Indexable i) => Show (BinIx i) where
-    show (BinIx (BinI lo hi)) = unlines [ "# BinIx"
-                                        , "# Low  = " ++ show (deindex lo :: i)
-                                        , "# High = " ++ show (deindex hi :: i)
-                                        ]
-instance (Read i, Indexable i) => Read (BinIx i) where
-    readPrec = keyword "BinIx" >> liftM2 binIx (value "Low") (value "High")
+instance Enum a => Bin1D (BinEnum a) where
+  lowerLimit (BinEnum b) = toEnum $ lowerLimit b
+  upperLimit (BinEnum b) = toEnum $ upperLimit b
+  binsListRange b        = G.generate (nBins b) (\n -> let x = fromIndex b n in (x,x))
+  {-# INLINE binsListRange #-}
 
+instance Show (BinEnum a) where
+  show (BinEnum b) = "# BinEnum\n" ++ show b
+instance Read (BinEnum a) where
+  readPrec = keyword "BinEnum" >> liftM BinEnum readPrec
+
+
+
 ----------------------------------------------------------------
 -- Floating point bin
 ----------------------------------------------------------------
+
 -- | Floaintg point bins with equal sizes.
-data BinF f where
-    BinF :: RealFrac f => !f -> !f -> !Int -> BinF f 
+--
+-- Note that due to GHC bug #2271 this toIndex is really slow (20x
+-- slowdown with respect to BinD) and use of BinD is recommended
+data BinF f = BinF {-# UNPACK #-} !f   -- ^ Lower bound
+                   {-# UNPACK #-} !f   -- ^ Size of bin
+                   {-# UNPACK #-} !Int -- ^ Number of bins
+              deriving (Eq,Typeable)
 
-instance Eq f => Eq (BinF f) where
-    (BinF lo hi n) == (BinF lo' hi' n') = lo == lo'  && hi == hi' && n == n'
-                                          
 -- | Create bins.
-binF :: RealFrac f => 
+binF :: RealFrac f =>
         f   -- ^ Lower bound of range
      -> Int -- ^ Number of bins
      -> f   -- ^ Upper bound of range
@@ -253,58 +299,67 @@
          f -- ^ Begin of range
       -> f -- ^ Size of step
       -> f -- ^ Approximation of end of range
-      -> BinF f 
+      -> BinF f
 binFn from step to = BinF from step (round $ (to - from) / step)
 
--- | Convert BinI to BinF
-binI2binF :: RealFrac f => BinI -> BinF f
-binI2binF b@(BinI i _) = BinF (fromIntegral i) 1 (nBins b)
+-- | Create bins
+binFstep :: RealFrac f =>
+            f      -- ^ Begin of range
+         -> f      -- ^ Size of step
+         -> Int    -- ^ Number of bins
+         -> BinF f
+binFstep = BinF
 
 -- | 'scaleBinF a b' scales BinF using linear transform 'a+b*x'
 scaleBinF :: RealFrac f => f -> f -> BinF f -> BinF f
-scaleBinF a b (BinF base step n) 
+scaleBinF a b (BinF base step n)
     | b > 0     = BinF (a + b*base) (b*step) n
     | otherwise = error $ "scaleBinF: b must be positive (b = "++show b++")"
 
-instance Bin (BinF f) where
-    type BinValue (BinF f) = f 
-    toIndex   !(BinF from step _) !x = floor $ (x-from) / step
-    {-# INLINE toIndex #-}
-    fromIndex !(BinF from step _) !i = (step/2) + (fromIntegral i * step) + from 
-    inRange   !(BinF from step n) x  = x > from && x < from + step*fromIntegral n
-    {-# INLINE inRange #-}
-    nBins     !(BinF _ _ n) = n
+instance RealFrac f => Bin (BinF f) where
+  type BinValue (BinF f) = f
+  toIndex   !(BinF from step _) !x = floor $ (x-from) / step
+  fromIndex !(BinF from step _) !i = (step/2) + (fromIntegral i * step) + from
+  inRange   !(BinF from step n) x  = x > from && x < from + step*fromIntegral n
+  nBins     !(BinF _ _ n) = n
+  {-# INLINE toIndex #-}
+  {-# INLINE inRange #-}
 
-instance Bin1D (BinF f) where
-    binsList b@(BinF _ _ n) = map (fromIndex b) [0..n-1]
-    binsListRange b@(BinF _ step _) = map toPair (binsList b)
-        where
-          toPair x = (x - step/2, x + step/2)
+instance RealFrac f => Bin1D (BinF f) where
+  lowerLimit (BinF from _    _) = from
+  upperLimit (BinF from step n) = from + step * fromIntegral n
+  binsListRange !b@(BinF _ step n) = G.generate n toPair
+    where
+      toPair k = (x - step/2, x + step/2) where x = fromIndex b k
+  {-# INLINE binsListRange #-}
 
+instance RealFrac f => VariableBin1D (BinF f) where
+  binSizeN (BinF _ step _) _ = step
+
+instance RealFrac f => UniformBin1D (BinF f) where
+  binSize (BinF _ step _) = step
+
 instance Show f => Show (BinF f) where
-    show (BinF base step n) = unlines [ "# BinF"
-                                      , "# Base = " ++ show base
-                                      , "# Step = " ++ show step
-                                      , "# N    = " ++ show n
-                                      ]
+  show (BinF base step n) = unlines [ "# BinF"
+                                    , "# Base = " ++ show base
+                                    , "# Step = " ++ show step
+                                    , "# N    = " ++ show n
+                                    ]
 instance (Read f, RealFrac f) => Read (BinF f) where
-    readPrec = do
-      keyword "BinF"
-      base <- value "Base"
-      step <- value "Step"
-      n    <- value "N"
-      return $ BinF base step n
+  readPrec = keyword "BinF" >> liftM3 BinF (value "Base") (value "Step") (value "N")
 
+
+
 ----------------------------------------------------------------
 -- 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.
-data BinD = BinD {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Int
+data BinD = BinD {-# UNPACK #-} !Double -- ^ Lower bound
+                 {-# UNPACK #-} !Double -- ^ Size of bin
+                 {-# UNPACK #-} !Int    -- ^ Number of bins
+            deriving (Eq,Typeable)
 
-instance Eq BinD where
-    (BinD lo hi n) == (BinD lo' hi' n') = lo == lo'  && hi == hi' && n == n'
-                                          
 -- | Create bins.
 binD :: Double -- ^ Lower bound of range
      -> Int    -- ^ Number of bins
@@ -319,13 +374,16 @@
       -> BinD
 binDn from step to = BinD from step (round $ (to - from) / step)
 
--- | Convert BinI to BinF
-binI2binD :: BinI -> BinD
-binI2binD b@(BinI i _) = BinD (fromIntegral i) 1 (nBins b)
+-- | Create bins
+binDstep :: Double -- ^ Begin of range
+         -> Double -- ^ Size of step
+         -> Int    -- ^ Number of bins
+         -> BinD
+binDstep = BinD
 
 -- | 'scaleBinF a b' scales BinF using linear transform 'a+b*x'
 scaleBinD :: Double -> Double -> BinD -> BinD
-scaleBinD a b (BinD base step n) 
+scaleBinD a b (BinD base step n)
     | b > 0     = BinD (a + b*base) (b*step) n
     | otherwise = error $ "scaleBinF: b must be positive (b = "++show b++")"
 
@@ -336,102 +394,119 @@
 {-# INLINE floorD #-}
 
 instance Bin BinD where
-    type BinValue BinD = Double
-    toIndex   !(BinD from step _) !x = floorD $ (x-from) / step
-    {-# INLINE toIndex #-}
-    fromIndex !(BinD from step _) !i = (step/2) + (fromIntegral i * step) + from 
-    inRange   !(BinD from step n) x  = x > from && x < from + step*fromIntegral n
-    {-# INLINE inRange #-}
-    nBins     !(BinD _ _ n) = n
+  type BinValue BinD = Double
+  toIndex   !(BinD from step _) !x = floorD $ (x-from) / step
+  fromIndex !(BinD from step _) !i = (step/2) + (fromIntegral i * step) + from
+  inRange   !(BinD from step n) x  = x > from && x < from + step*fromIntegral n
+  nBins     !(BinD _ _ n) = n
+  {-# INLINE toIndex #-}
+  {-# INLINE inRange #-}
 
 instance Bin1D BinD where
-    binsList b@(BinD _ _ n) = map (fromIndex b) [0..n-1]
-    binsListRange b@(BinD _ step _) = map toPair (binsList b)
-        where
-          toPair x = (x - step/2, x + step/2)
+  lowerLimit (BinD from _    _) = from
+  upperLimit (BinD from step n) = from + step * fromIntegral n
+  binsListRange b@(BinD _ step n) = G.generate n toPair
+    where
+      toPair k = (x - step/2, x + step/2) where x = fromIndex b k
+  {-# INLINE binsListRange #-}
 
+
+instance VariableBin1D BinD where
+  binSizeN (BinD _ step _) _ = step
+
+instance UniformBin1D BinD where
+  binSize (BinD _ step _) = step
+
 instance Show BinD where
-    show (BinD base step n) = unlines [ "# BinD"
-                                      , "# Base = " ++ show base
-                                      , "# Step = " ++ show step
-                                      , "# N    = " ++ show n
-                                      ]
+  show (BinD base step n) = unlines [ "# BinD"
+                                    , "# Base = " ++ show base
+                                    , "# Step = " ++ show step
+                                    , "# N    = " ++ show n
+                                    ]
 instance Read BinD where
-    readPrec = do
-      keyword "BinD"
-      base <- value "Base"
-      step <- value "Step"
-      n    <- value "N"
-      return $ BinD base step n
+  readPrec = keyword "BinD" >> liftM3 BinD (value "Base") (value "Step") (value "N")
 
 
+
 ----------------------------------------------------------------
 -- Log-scale bin
 ----------------------------------------------------------------
 -- | Logarithmic scale bins.
 data LogBinD = LogBinD
-               Double -- Low border
-               Double -- Hi border
-               Double -- Increment ratio
-               Int    -- Number of bins
-               deriving Eq
+               Double -- ^ Low border
+               Double -- ^ Hi border
+               Double -- ^ Increment ratio
+               Int    -- ^ Number of bins
+               deriving (Eq,Typeable)
 
--- | Create log-scale bins. 
+-- | Create log-scale bins.
 logBinD :: Double -> Int -> Double -> LogBinD
 logBinD lo n hi = LogBinD lo hi ((hi/lo) ** (1 / fromIntegral n)) n
 
 instance Bin LogBinD where
-    type BinValue LogBinD = Double
-    toIndex   !(LogBinD base _ step _) !x = floorD $ logBase step (x / base)
-    {-# INLINE toIndex #-}
-    fromIndex !(LogBinD base _ step _) !i = base * step ^ i
-    inRange   !(LogBinD lo hi _ _) x  = x >= lo && x < hi
-    {-# INLINE inRange #-}
-    nBins     !(LogBinD _ _ _ n) = n
+  type BinValue LogBinD = Double
+  toIndex   !(LogBinD base _ step _) !x = floorD $ logBase step (x / base)
+  fromIndex !(LogBinD base _ step _) !i | i >= 0    = base * step ** (fromIntegral i + 0.5)
+                                        | otherwise = -1 / 0
+  inRange   !(LogBinD lo hi _ _) x  = x >= lo && x < hi
+  nBins     !(LogBinD _ _ _ n) = n
+  {-# INLINE toIndex #-}
+  {-# INLINE inRange #-}
 
+instance Bin1D LogBinD where
+  lowerLimit (LogBinD lo _  _ _) = lo
+  upperLimit (LogBinD _  hi _ _) = hi
+  binsListRange (LogBinD base _ step n) = G.unfoldrN n next base
+    where
+      next x = let x' = x * step in Just ((x,x'), x')
+  {-# INLINE binsListRange #-}
+
+instance VariableBin1D LogBinD where
+  binSizeN (LogBinD base _ step _) n = let x = base * step ^ n in x*step - x
+
 instance Show LogBinD where
-    show (LogBinD lo hi step n) = 
-        unlines [ "# LogBinD"
-                , "# Lo   = " ++ show lo
-                , "# Hi   = " ++ show hi
-                , "# Step = " ++ show step
-                , "# N    = " ++ show n
-                ]
+  show (LogBinD lo hi _ n) =
+    unlines [ "# LogBinD"
+            , "# Lo   = " ++ show lo
+            , "# N    = " ++ show n
+            , "# Hi   = " ++ show hi
+            ]
+instance Read LogBinD where
+  readPrec = do
+    keyword "LogBinD"
+    liftM3 logBinD (value "Lo") (value "N") (value "Hi")
 
+
 ----------------------------------------------------------------
 -- 2D bin
 ----------------------------------------------------------------
 
--- | 2D bins. binX is binning along X axis and binY is one along Y axis. 
-data Bin2D binX binY = Bin2D !binX !binY
-                       deriving Eq
+-- | 2D bins. binX is binning along X axis and binY is one along Y axis.
+data Bin2D binX binY = Bin2D { binX :: !binX -- ^ Binning algorithm for X axis
+                             , binY :: !binY -- ^ Binning algorithm for Y axis
+                             }
+                       deriving (Eq,Typeable)
 
 -- | Alias for 'Bin2D'.
 (><) :: binX -> binY -> Bin2D binX binY
 (><) = Bin2D
 
--- | Get binning algorithm along X axis
-binX :: Bin2D bx by -> bx
-binX !(Bin2D bx _) = bx
-
--- | Get binning algorithm along Y axis
-binY :: Bin2D bx by -> by
-binY !(Bin2D _ by) = by
-
 instance (Bin binX, Bin binY) => Bin (Bin2D binX binY) where
-    type BinValue (Bin2D binX binY) = (BinValue binX, BinValue binY)
-    toIndex b@(Bin2D bx by) (x,y) 
-        | inRange b (x,y) = toIndex bx x + (toIndex by y)*(fromIntegral $ nBins bx)
-        | otherwise       = maxBound
-    {-# INLINE toIndex #-}
-    fromIndex b@(Bin2D bx by) i = let (ix,iy) = toIndex2D b i
-                                  in  (fromIndex bx ix, fromIndex by iy)
-    inRange (Bin2D bx by) (x,y) = inRange bx x && inRange by y
-    {-# INLINE inRange #-}
-    nBins (Bin2D bx by) = (nBins bx) * (nBins by)
+  type BinValue (Bin2D binX binY) = (BinValue binX, BinValue binY)
+  toIndex !(Bin2D bx by) !(x,y)
+        | inRange bx x = toIndex bx x + toIndex by y * nBins bx
+        | otherwise    = maxBound
+  fromIndex b@(Bin2D bx by) i = let (ix,iy) = toIndex2D b i
+                                in  (fromIndex bx ix, fromIndex by iy)
+  inRange (Bin2D bx by) !(x,y) = inRange bx x && inRange by y
+  nBins (Bin2D bx by) = nBins bx * nBins by
+  {-# INLINE toIndex #-}
+  {-# INLINE inRange #-}
 
+-- | Convert index into pair of indices for X and Y axes
 toIndex2D :: (Bin binX, Bin binY) => Bin2D binX binY -> Int -> (Int,Int)
-toIndex2D b i = let (iy,ix) = divMod i (nBins $ binX b) in (ix,iy)
+toIndex2D !b !i = let (iy,ix) = divMod i (nBins $ binX b) in (ix,iy)
+{-# INLINE toIndex2D #-}
 
 -- | 2-dimensional size of binning algorithm
 nBins2D :: (Bin bx, Bin by) => Bin2D bx by -> (Int,Int)
@@ -440,10 +515,10 @@
 -- | Apply function to X binning algorithm. If new binning algorithm
 --   have different number of bins will fail.
 fmapBinX :: (Bin bx, Bin bx') => (bx -> bx') -> Bin2D bx by -> Bin2D bx' by
-fmapBinX f (Bin2D bx by) 
+fmapBinX f (Bin2D bx by)
     | nBins bx' /= nBins bx = error "fmapBinX: new binnig algorithm has different number of bins"
     | otherwise             = Bin2D bx' by
-    where 
+    where
       bx' = f bx
 
 -- | Apply function to Y binning algorithm. If new binning algorithm
@@ -452,53 +527,45 @@
 fmapBinY f (Bin2D bx by)
     | nBins by' /= nBins by = error "fmapBinY: new binnig algorithm has different number of bins"
     | otherwise             = Bin2D bx by'
-    where 
+    where
       by' = f by
 
 instance (Show b1, Show b2) => Show (Bin2D b1 b2) where
-    show (Bin2D b1 b2) = concat [ "# Bin2D\n"
-                                , "# X\n"
-                                , show b1
-                                , "# Y\n"
-                                , show b2
-                                ]
+  show (Bin2D b1 b2) = concat [ "# Bin2D\n"
+                              , "# X\n"
+                              , show b1
+                              , "# Y\n"
+                              , show b2
+                              ]
 instance (Read b1, Read b2) => Read (Bin2D b1 b2) where
-    readPrec = do
-      keyword "Bin2D"
-      keyword "X"
-      b1 <- readPrec
-      keyword "Y"
-      b2 <- readPrec
-      return $ Bin2D b1 b2
-
+  readPrec = do
+    keyword "Bin2D"
+    keyword "X"
+    b1 <- readPrec
+    keyword "Y"
+    b2 <- readPrec
+    return $ Bin2D b1 b2
 
 ----------------------------------------------------------------
--- Indexed 2D bins
+-- Bin conversion
 ----------------------------------------------------------------
--- | Binning for 2D indexable value
-newtype BinIx2D i = BinIx2D {unBinIx2D :: (Bin2D BinI BinI) }
 
--- | Construct indexed bin
-binIx2D :: Indexable2D i => i -> i -> BinIx2D i
-binIx2D lo hi = let (ix,iy) = index2D lo
-                    (jx,jy) = index2D hi
-                in BinIx2D $ BinI ix jx >< BinI iy jy
+-- BinI,BinInt -> BinF
+instance RealFrac f => ConvertBin BinI (BinF f) where
+  convertBin b = BinF (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)
 
-instance Indexable2D i => Bin (BinIx2D i) where
-    type BinValue (BinIx2D i) = i
-    toIndex   (BinIx2D b) x = toIndex b (index2D x)
-    fromIndex (BinIx2D b) i = deindex2D $ fromIndex b i
-    inRange   (BinIx2D b) x = inRange b (index2D x)
-    nBins     (BinIx2D b)   = nBins b
+-- BinI,BinInt -> BinD
+instance ConvertBin BinI BinD where
+  convertBin b = BinD (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)
 
-instance (Show i, Indexable2D i) => Show (BinIx2D i) where
-    show (BinIx2D b) = unlines [ "# BinIx2D"
-                               , "# Low  = " ++ show (deindex2D (fromIndex b 0            ) :: i)
-                               , "# High = " ++ show (deindex2D (fromIndex b (nBins b - 1)) :: i)
-                               ]
-instance (Read i, Indexable2D i) => Read (BinIx2D i) where
-    readPrec = do
-      keyword "BinIx2D"
-      l <- value "Low"
-      h <- value "High"
-      return $ binIx2D l h
+-- Bin2D -> Bin2D
+instance (ConvertBin bx bx', Bin by) => ConvertBin (Bin2D bx by) (Bin2D bx' by) where
+  convertBin = fmapBinX convertBin
+instance (ConvertBin by by', Bin bx) => ConvertBin (Bin2D bx by) (Bin2D bx by') where
+  convertBin = fmapBinY convertBin
+instance (ConvertBin bx bx', ConvertBin by by') => ConvertBin (Bin2D bx by) (Bin2D bx' by') where
+  convertBin (Bin2D bx by) = Bin2D (convertBin bx) (convertBin by)
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
@@ -1,6 +1,8 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies      #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -- |
 -- Module     : Data.Histogram.Bin
 -- Copyright  : Copyright (c) 2010, Alexey Khudyakov <alexey.skladnoy@gmail.com>
@@ -10,67 +12,162 @@
 --
 -- Extra binning algorithms
 
-module Data.Histogram.Bin.Extra ( BinPermute(permutedBin, permuteTo, permuteFrom)
+module Data.Histogram.Bin.Extra ( Enum2D(..)
+                                , BinEnum2D
+                                , binEnum2D
+                                , BinPermute(permutedBin, permuteTo, permuteFrom)
+                                , permuteByTable
                                 , permuteBin
                                 ) where
 
 import Control.Applicative
-import Control.Monad (forM_)
+import Control.Monad --  (forM_,liftM2)
+
+import qualified Data.Vector.Generic         as G
 import qualified Data.Vector.Unboxed         as U
 import qualified Data.Vector.Unboxed.Mutable as M
-import Data.Vector.Unboxed ((!))
+import           Data.Vector.Generic            ((!))
 import Text.Read
 
 import Data.Histogram.Bin
 import Data.Histogram.Parse
 
--- | Direct permutation of indices. 
-data BinPermute b = BinPermute { permutedBin :: b
-                               , permuteTo   :: U.Vector Int
-                               , permuteFrom :: U.Vector Int
+----------------------------------------------------------------
+
+-- | Type class very similar to 'Enum' but elements of type are
+--   enumerated on 2-dimensional grid
+class Enum2D a where
+  -- | Convert value to index
+  fromEnum2D :: a -> (Int,Int)
+  -- | Convert index to value
+  toEnum2D :: (Int,Int) -> a
+
+instance (Enum a, Enum b) => Enum2D (a,b) where
+  fromEnum2D (x,y) = (fromEnum x, fromEnum y)
+  toEnum2D   (i,j) = (toEnum   i, toEnum   j)
+
+
+
+----------------------------------------------------------------
+-- 2D enumaration bin
+----------------------------------------------------------------
+
+-- | Binning for 2D enumerations
+newtype BinEnum2D i = BinEnum2D (Bin2D BinI BinI)
+
+-- | Construct indexed bin
+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
+
+instance Enum2D i => Bin (BinEnum2D i) where
+    type BinValue (BinEnum2D i) = i
+    toIndex   !(BinEnum2D b) !x = toIndex b (fromEnum2D x)
+    fromIndex !(BinEnum2D b) !i = toEnum2D  (fromIndex b i)
+    inRange   !(BinEnum2D b) !x = inRange b (fromEnum2D x)
+    nBins     !(BinEnum2D b)    = nBins b
+
+instance (Show i, Enum2D i) => Show (BinEnum2D i) where
+    show (BinEnum2D b) = unlines [ "# BinEnum2D"
+                                 , "# Low  = " ++ show (toEnum2D (fromIndex b 0            ) :: i)
+                                 , "# High = " ++ show (toEnum2D (fromIndex b (nBins b - 1)) :: i)
+                                 ]
+instance (Read i, Enum2D i) => Read (BinEnum2D i) where
+    readPrec = do
+      keyword "BinEnum2D"
+      liftM2 binEnum2D (value "Low") (value "High")
+
+
+----------------------------------------------------------------
+-- Permutation
+----------------------------------------------------------------
+
+-- | Direct permutation of indices.
+data BinPermute b = BinPermute { permutedBin :: b            -- ^ Original bin
+                               , permuteTo   :: U.Vector Int -- ^ Maps original bin's indices to new indices
+                               , permuteFrom :: U.Vector Int -- ^ Inverse of pervious table
                                }
+
 instance Bin b => Bin (BinPermute b) where
-    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
-    nBins     (BinPermute b _ _) = nBins b
+  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
+  nBins = nBins . permutedBin
 
+instance (Bin1D b) => Bin1D (BinPermute b) where
+  lowerLimit = lowerLimit . permutedBin
+  upperLimit = upperLimit . permutedBin
+  binsList (BinPermute b _ a) = res
+    where
+      res = G.generate (nBins b) fun
+      arr = binsList b `asTypeOf` res
+      fun i = arr ! (a ! i)
+  binsListRange (BinPermute b _ a) = res
+    where
+      res = G.generate (nBins b) fun
+      arr = binsListRange b `asTypeOf` res
+      fun i = arr ! (a ! i)
+  {-# INLINE binsList      #-}
+  {-# INLINE binsListRange #-}
+
+instance VariableBin1D b => VariableBin1D (BinPermute b) where
+  binSizeN b i = binSizeN (permutedBin b) (permuteFrom b ! i)
+  
+instance UniformBin1D b => UniformBin1D (BinPermute b) where
+  binSize = binSize . permutedBin
+  
+
 instance Show b => Show (BinPermute b) where
-    show (BinPermute b to _) = unlines [ "# BinPermute"
-                                       , "# Permutation = " ++ show (U.toList to)
-                                       ] ++ show b
+  show (BinPermute b to _) = unlines [ "# BinPermute"
+                                     , "# Permutation = " ++ show (U.toList to)
+                                     ] ++ show b
 
 instance Read BinI => Read (BinPermute BinI) where
-    readPrec = do keyword "BinPermute"
-                  to   <- U.fromList <$> value "Permutation"
-                  from <- case checkPermutation (invertPermutation to) of
-                            Just v  -> return v
-                            Nothing -> fail "Invalid permutation"
-                  b  <- readPrec 
-                  return $ BinPermute b to from
+  readPrec = do keyword "BinPermute"
+                to   <- U.fromList <$> value "Permutation"
+                b    <- readPrec
+                from <- case checkPermutationTable b (invertPermutationTable to) of
+                          Just v  -> return v
+                          Nothing -> fail "Invalid permutation"
+                return $ BinPermute b to from
 
+
 -- Check whether this viable permutation
-checkPermutation :: U.Vector Int -> Maybe (U.Vector Int)
-checkPermutation v | U.any bad v = Nothing
-                   | otherwise   = Just v
-                   where
-                     n     = U.length v
-                     bad i = i < 0 || i >= n
+checkPermutationTable :: Bin b => b -> U.Vector Int -> Maybe (U.Vector Int)
+checkPermutationTable b v = do
+  let n      = U.length v
+      good i = i >= 0 && i < n
+  guard $ nBins b == n
+  guard $ U.all good v
+  return v
 
--- Calculate inverse permutation                     
-invertPermutation :: U.Vector Int -> U.Vector Int
-invertPermutation v = U.create $ do a <- M.newWith n (-1)
-                                    forM_ [0..n-1] (writeInvert a)
-                                    return a
+
+-- Calculate inverse permutation
+invertPermutationTable :: U.Vector Int -> U.Vector Int
+invertPermutationTable v = U.create $ do a <- M.newWith n (-1)
+                                         forM_ [0..n-1] (writeInvert a)
+                                         return a
   where
     n = U.length v
     writeInvert a i | j >= 0 && j < n = M.write a j i
                     | otherwise       = return ()
-                    where j = v ! i
+                      where j = v ! i
 
+
+-- | Constuct bin permutation from table
+permuteByTable :: Bin b => b -> U.Vector Int -> Maybe (BinPermute b)
+permuteByTable b tbl = BinPermute b <$>
+                       checkPermutationTable b tbl <*>
+                       checkPermutationTable b (invertPermutationTable tbl)
+
+
 -- | Constuct bin permutation from function.
-permuteBin :: Bin b => (Int -> Int) -> b -> Maybe (BinPermute b)
-permuteBin f b = BinPermute b <$> checkPermutation to <*> checkPermutation (invertPermutation to)
+permuteBin :: Bin b => b -> (Int -> Int) -> Maybe (BinPermute b)
+permuteBin b f = BinPermute b <$>
+                 checkPermutationTable b to <*>
+                 checkPermutationTable b (invertPermutationTable to)
     where
       to   = U.map f $ U.enumFromN 0 (nBins b)
+
diff --git a/Data/Histogram/Fill.hs b/Data/Histogram/Fill.hs
--- a/Data/Histogram/Fill.hs
+++ b/Data/Histogram/Fill.hs
@@ -1,6 +1,4 @@
-{-# LANGUAGE GADTs        #-}
-{-# LANGUAGE Rank2Types   #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE Rank2Types #-}
 -- |
 -- Module     : Data.Histogram.Fill
 -- Copyright  : Copyright (c) 2009, Alexey Khudyakov <alexey.skladnoy@gmail.com>
@@ -11,59 +9,47 @@
 -- Module with algorithms for histogram filling. This is pure wrapper
 -- around stateful histograms.
 --
-module Data.Histogram.Fill ( -- * Type classes
+module Data.Histogram.Fill ( -- * Histogram builders API
                              HistBuilder(..)
+                           , FillableData(..)
+                           , (<<-)
+                           , (<<-|)
+                           , (<<?)
+                           , (-<<)
                              -- * Histogram builders
                              -- ** Stateful
-                           , HBuilderST
+                           , HBuilderM
                            , feedOne
-                           , freezeHBuilderST
-                           , joinHBuilderST
-                           , joinHBuilderSTList
-                           , treeHBuilderST
-                             -- ** IO based
-                           , HBuilderIO
-                           , feedOneIO
-                           , freezeHBuilderIO
-                           , joinHBuilderIO
-                           , joinHBuilderIOList
-                           , treeHBuilderIO
+                           , freezeHBuilderM
+                           , joinHBuilderM
+                           , joinHBuilderMonoidM
+                           , treeHBuilderM
+                           , treeHBuilderMonoidM
                              -- ** Stateless
                            , HBuilder
                            , joinHBuilder
-                           , joinHBuilderList
+                           , joinHBuilderMonoid
                            , treeHBuilder
-                             -- ** Conversion between builders
-                           , toBuilderST
-                           , toBuilderIO
-                           , builderSTtoIO
-                           -- * Fill histograms
-                           , fillBuilder
-                           -- * Histogram constructors
+                           , treeHBuilderMonoid
+                             -- * Histogram constructors
                            , module Data.Histogram.Bin
-                           -- ** Fixed weigth histograms
-                           , mkHist1
-                           , mkHist
-                           , mkHistMaybe
-                           -- ** Weighted histograms
-                           , mkHistWgh1
-                           , mkHistWgh
-                           , mkHistWghMaybe
-                           -- ** Histograms with monoidal bins
-                           , mkHistMonoid1
-                           , mkHistMonoid
-                           , mkHistMonoidMaybe
-                           -- * Auxillary functions
+                           , mkSimple
+                           , mkWeighted
+                           , mkMonoidal
+                             -- * Fill histograms
+                           , fillBuilder
+                             -- * Auxillary functions
                            , forceInt
                            , forceDouble
                            , forceFloat
                            ) where
 
-import Control.Applicative ((<$>))
-import Control.Monad       (when)
+import Control.Applicative
+import Control.Monad       (when,liftM,liftM2)
 import Control.Monad.ST 
+import Control.Monad.Primitive
 
-import Data.Monoid         (Monoid, mempty)
+import Data.Monoid         (Monoid(..))
 import Data.Vector.Unboxed (Unbox)
 
 import Data.Histogram
@@ -74,266 +60,193 @@
 -- Type class
 ----------------------------------------------------------------
 
+-- | Data type which could be put into histogram.
+class FillableData d where
+    -- | Lift putter function to lift putter function to use data type.
+    fillData :: PrimMonad m => (a -> m ()) -> d a -> m ()
+
+instance FillableData Maybe where
+    fillData f (Just x) = f x
+    fillData _ Nothing  = return ()
+instance FillableData [] where
+    fillData = mapM_
+
 -- | Histogram builder typeclass. Instance of this class contain
 --   instructions how to build histograms.
 class HistBuilder h where
-    -- | Convert input type of histogram from a to a'
-    modifyIn  :: (a' -> a) -> h a b -> h a' b
-    -- | Make input function accept value only if it's Just a.
-    modifyMaybe :: h a b -> h (Maybe a) b
-    -- | Add cut to histogram. Only put value histogram if condition is true.
-    addCut    :: (a -> Bool) -> h a b -> h a b
     -- | Convert output of histogram
-    modifyOut :: (b -> b') -> h a b -> h a  b'
+    modifyOut   :: (b -> b') -> h a b -> h a  b'
+    -- | Convert input type of histogram from a to a'
+    modifyIn    :: (a' -> a) -> h a b -> h a' b
+    -- | Make input function accept value only 
+    modifyWith  :: FillableData d => h a b -> h (d a) b
+    -- | Add cut to histogram. Value would be putted into histogram only if condition is true.
+    addCut      :: (a -> Bool) -> h a b -> h a b
 
-----------------------------------------------------------------
--- ST based builder
-----------------------------------------------------------------
 
--- | Stateful histogram builder.
-data HBuilderST s a b = HBuilderST { hbInput  :: a -> ST s ()
-                                   , hbOutput :: ST s b
-                                   }
+-- | Modify input of builder 
+(<<-) :: HistBuilder h => h a b -> (a' -> a) -> h a' b
+(<<-) = flip modifyIn
+{-# INLINE (<<-) #-}
 
-instance HistBuilder (HBuilderST s) where
-    modifyIn  f h = h { hbInput  = hbInput h . f }
-    addCut    f h = h { hbInput  = \x -> when (f x) (hbInput h x) }
-    modifyMaybe h = h { hbInput  = modified } 
-        where modified (Just x) = hbInput h x
-              modified Nothing  = return ()
-    modifyOut f h = h { hbOutput = f `fmap` hbOutput h }
+-- | Modify input of builder to use composite input
+(<<-|) :: (HistBuilder h, FillableData d) => h a b -> (a' -> d a) -> h a' b
+h <<-| f = modifyWith h <<- f
+{-# INLINE (<<-|) #-}
 
-instance Functor (HBuilderST s a) where
-    fmap = modifyOut
+-- | Add cut for input
+(<<?) :: HistBuilder h => h a b -> (a -> Bool) -> h a b
+(<<?) = flip addCut
+{-# INLINE (<<?) #-}
 
--- | Put one value into histogram
-feedOne :: HBuilderST s a b -> a -> ST s ()
-feedOne = hbInput
+-- | Modify output of histogram. In fact it's same as '<$>' but have opposite fixity
+(-<<) :: HistBuilder h => (b -> b') -> h a b -> h a b'
+(-<<) = modifyOut
+{-# INLINE (-<<) #-}
 
--- | Create stateful histogram from instructions. Histograms could
---   be filled either in the ST monad or with createHistograms
-freezeHBuilderST :: HBuilderST s a b -> ST s b
-freezeHBuilderST = hbOutput
+-- Fixity of operator
+infixl 5 <<-
+infixl 5 <<-|
+infixl 5 <<?
+infixr 4 -<<
 
 
--- | Join list of builders into one builder
-joinHBuilderST :: [HBuilderST s a b] -> HBuilderST s a [b]
-joinHBuilderST hs = HBuilderST { hbInput  = \x -> mapM_ (flip hbInput x) hs
-                               , hbOutput = mapM hbOutput hs
-                               }
-
--- | Join list of builders into one builders
-joinHBuilderSTList :: [HBuilderST s a [b]] -> HBuilderST s a [b]
-joinHBuilderSTList = fmap concat . joinHBuilderST
-
-treeHBuilderST :: [HBuilderST s a b -> HBuilderST s a' b'] -> HBuilderST s a b -> HBuilderST s a' [b']
-treeHBuilderST fs h = joinHBuilderST $ map ($ h) fs
-
 ----------------------------------------------------------------
--- IO based
+-- ST based builder
 ----------------------------------------------------------------
 
 -- | Stateful histogram builder.
-data HBuilderIO a b = HBuilderIO { hbInputIO  :: a -> IO ()
-                                 , hbOutputIO :: IO b
+data HBuilderM m a b = HBuilderM { hbInput  :: a -> m ()
+                                 , hbOutput :: m b
                                  }
 
-instance HistBuilder (HBuilderIO) where
-    modifyIn  f h = h { hbInputIO  = hbInputIO h . f }
-    addCut    f h = h { hbInputIO  = \x -> when (f x) (hbInputIO h x) }
-    modifyMaybe h = h { hbInputIO  = modified } 
-        where modified (Just x) = hbInputIO h x
-              modified Nothing  = return ()
-    modifyOut f h = h { hbOutputIO = f `fmap` hbOutputIO h }
+instance PrimMonad m => HistBuilder (HBuilderM m) where
+    modifyIn  f h = h { hbInput  = hbInput h . f }
+    addCut    f h = h { hbInput  = \x -> when (f x) (hbInput h x) }
+    modifyWith h = h { hbInput  = fillData (hbInput h) } 
+    modifyOut f h = h { hbOutput = f `liftM` hbOutput h }
 
-instance Functor (HBuilderIO a) where
+instance PrimMonad m => Functor (HBuilderM m a) where
     fmap = modifyOut
-
+instance PrimMonad m => Applicative (HBuilderM m a) where
+    pure x = HBuilderM { hbInput  = const $ return ()
+                       , hbOutput = return x
+                       }
+    f <*> g = HBuilderM { hbInput  = \a -> hbInput f a >> hbInput g a
+                        , hbOutput = do a <- hbOutput f
+                                        b <- hbOutput g
+                                        return (a b)
+                        }
+                                        
 -- | Put one value into histogram
-feedOneIO :: HBuilderIO a b -> a -> IO ()
-feedOneIO = hbInputIO
+feedOne :: PrimMonad m => HBuilderM m a b -> a -> m ()
+feedOne = hbInput
+{-# INLINE feedOne #-}
 
 -- | Create stateful histogram from instructions. Histograms could
 --   be filled either in the ST monad or with createHistograms
-freezeHBuilderIO :: HBuilderIO a b -> IO b
-freezeHBuilderIO = hbOutputIO
+freezeHBuilderM :: PrimMonad m => HBuilderM m a b -> m b
+freezeHBuilderM = hbOutput
+{-# INLINE freezeHBuilderM #-}
 
 -- | Join list of builders into one builder
-joinHBuilderIO :: [HBuilderIO a b] -> HBuilderIO a [b]
-joinHBuilderIO hs = HBuilderIO { hbInputIO  = \x -> mapM_ (flip hbInputIO x) hs
-                               , hbOutputIO = mapM hbOutputIO hs
-                               }
+joinHBuilderM :: PrimMonad m => [HBuilderM m a b] -> HBuilderM m a [b]
+joinHBuilderM hs = HBuilderM { hbInput  = \x -> mapM_ (flip hbInput x) hs
+                             , hbOutput = mapM hbOutput hs
+                             }
+{-# INLINE joinHBuilderM #-}
 
 -- | Join list of builders into one builders
-joinHBuilderIOList :: [HBuilderIO a [b]] -> HBuilderIO a [b]
-joinHBuilderIOList = fmap concat . joinHBuilderIO
+joinHBuilderMonoidM :: (PrimMonad m, Monoid b) => [HBuilderM m a b] -> HBuilderM m a b
+joinHBuilderMonoidM = fmap mconcat . joinHBuilderM
+{-# INLINE joinHBuilderMonoidM #-}
 
-treeHBuilderIO :: [HBuilderIO a b -> HBuilderIO a' b'] -> HBuilderIO a b -> HBuilderIO a' [b']
-treeHBuilderIO fs h = joinHBuilderIO $ map ($ h) fs
+treeHBuilderM :: PrimMonad m => [HBuilderM m a b -> HBuilderM m a' b'] -> HBuilderM m a b -> HBuilderM m a' [b']
+treeHBuilderM fs h = joinHBuilderM $ map ($ h) fs
+{-# INLINE treeHBuilderM #-}
 
+treeHBuilderMonoidM :: (PrimMonad m, Monoid b') => 
+                        [HBuilderM m a b -> HBuilderM m a' b'] -> HBuilderM m a b -> HBuilderM m a' b'
+treeHBuilderMonoidM fs h = joinHBuilderMonoidM $ map ($ h) fs
+{-# INLINE treeHBuilderMonoidM #-}
+
+
 ----------------------------------------------------------------
 -- Stateless 
 ----------------------------------------------------------------
 
 -- | Stateless histogram builder
-newtype HBuilder a b = HBuilder { toBuilderST :: (forall s . ST s (HBuilderST s a b)) }
+newtype HBuilder a b = HBuilder { toBuilderM :: (forall s . ST s (HBuilderM (ST s) a b)) }
 
 instance HistBuilder (HBuilder) where
     modifyIn  f (HBuilder h) = HBuilder (modifyIn  f <$> h)
     addCut    f (HBuilder h) = HBuilder (addCut    f <$> h)
-    modifyMaybe (HBuilder h) = HBuilder (modifyMaybe <$> h)
+    modifyWith  (HBuilder h) = HBuilder (modifyWith <$> h)
     modifyOut f (HBuilder h) = HBuilder (modifyOut f <$> h)
 
 instance Functor (HBuilder a) where
     fmap = modifyOut
+instance Applicative (HBuilder a) where
+    pure x  = HBuilder (return $ pure x)
+    (HBuilder f) <*> (HBuilder g) = HBuilder $ liftM2 (<*>) f g 
 
 -- | Join list of builders
 joinHBuilder :: [HBuilder a b] -> HBuilder a [b]
-joinHBuilder hs = HBuilder (joinHBuilderST <$> mapM toBuilderST hs)
+joinHBuilder hs = HBuilder (joinHBuilderM <$> mapM toBuilderM hs)
+{-# INLINE joinHBuilder #-}
 
 -- | Join list of builders
-joinHBuilderList :: [HBuilder a [b]] -> HBuilder a [b]
-joinHBuilderList = modifyOut concat . joinHBuilder
+joinHBuilderMonoid :: Monoid b => [HBuilder a b] -> HBuilder a b
+joinHBuilderMonoid = modifyOut mconcat . joinHBuilder
+{-# INLINE joinHBuilderMonoid #-}
 
 treeHBuilder :: [HBuilder a b -> HBuilder a' b'] -> HBuilder a b -> HBuilder a' [b']
 treeHBuilder fs h = joinHBuilder $ map ($ h) fs
+{-# INLINE treeHBuilder #-}
 
+treeHBuilderMonoid :: Monoid b' => [HBuilder a b -> HBuilder a' b'] -> HBuilder a b -> HBuilder a' b'
+treeHBuilderMonoid fs h = joinHBuilderMonoid $ map ($ h) fs
+{-# INLINE treeHBuilderMonoid #-}
+
+
 ----------------------------------------------------------------
--- Conversions
+-- Constructors
 ----------------------------------------------------------------
 
--- | Convert ST base builder to IO based one
-builderSTtoIO :: HBuilderST RealWorld a b -> HBuilderIO a b
-builderSTtoIO (HBuilderST i o) = HBuilderIO (stToIO . i) (stToIO o)
+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
+                                   }
+{-# INLINE mkSimple #-}
 
--- | Convert stateless builder to IO based one
-toBuilderIO :: HBuilder a b -> IO (HBuilderIO a b)
-toBuilderIO h = builderSTtoIO `fmap` stToIO (toBuilderST h)
+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
+                                                  }
+{-# INLINE mkWeighted #-}
 
+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
+                                                  }
+{-# INLINE mkMonoidal #-}
+
 ----------------------------------------------------------------
 -- Actual filling of histograms
 ----------------------------------------------------------------
 
 fillBuilder :: HBuilder a b -> [a] -> b
 fillBuilder hb xs = 
-    runST $ do h <- toBuilderST hb
+    runST $ do h <- toBuilderM hb
                mapM_ (feedOne h) xs
-               freezeHBuilderST h
-  
-----------------------------------------------------------------
--- Histogram constructors
-----------------------------------------------------------------
-
--- | Create histogram builder which take single item as input. Each
---   item has weight 1.
-mkHist1 :: (Bin bin, Unbox val, Num val) =>
-           bin                      -- ^ Bin information
-        -> (Histogram bin val -> b) -- ^ Output function 
-        -> (a -> BinValue bin)      -- ^ Input function
-        -> HBuilder a b
-mkHist1 bin out inp = HBuilder $ do
-  acc <- newMHistogram 0 bin
-  return $ HBuilderST { hbInput  = fillOne acc . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
-
--- | Create histogram builder which take many items as input. Each
---   item has weight 1.
-mkHist :: (Bin bin, Unbox val, Num val) =>
-          bin                      -- ^ Bin information
-       -> (Histogram bin val -> b) -- ^ Output function
-       -> (a -> [BinValue bin])    -- ^ Input function 
-       -> HBuilder a b
-mkHist bin out inp = HBuilder $ do
-  acc <- newMHistogram 0 bin
-  return $ HBuilderST { hbInput  = mapM_ (fillOne acc) . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
-
--- | Create histogram builder which at most one item as input. Each
---   item has weight 1. 
-mkHistMaybe :: (Bin bin, Unbox val, Num val) =>
-          bin                         -- ^ Bin information
-       -> (Histogram bin val -> b)    -- ^ Output function
-       -> (a -> Maybe (BinValue bin)) -- ^ Input function 
-       -> HBuilder a b
-mkHistMaybe bin out inp = HBuilder $ do
-  acc <- newMHistogram 0 bin
-  return $ HBuilderST { hbInput  = maybe (return ()) (fillOne acc) . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
-
--- | Create histogram with weighted bin. Takes one item at time. 
-mkHistWgh1 :: (Bin bin, Unbox val, Num val) =>
-              bin                        -- ^ Bin information
-          -> (Histogram bin val -> b)    -- ^ Output function
-          -> (a -> (BinValue bin, val))  -- ^ Input function
-          -> HBuilder a b
-mkHistWgh1 bin out inp = HBuilder $ do
-  acc <- newMHistogram 0 bin
-  return $ HBuilderST { hbInput  = fillOneW acc . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
-
--- | Create histogram with weighted bin. Takes many items at time.
-mkHistWgh :: (Bin bin, Unbox val, Num val) => 
-             bin                          -- ^ Bin information
-          -> (Histogram bin val  -> b)    -- ^ Output function
-          -> (a -> [(BinValue bin, val)]) -- ^ Input function
-          -> HBuilder a b
-mkHistWgh bin out inp = HBuilder $ do
-  acc <- newMHistogram 0 bin
-  return $ HBuilderST { hbInput  = mapM_ (fillOneW acc) . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
-
--- | Create histogram with weighted bin. Takes many items at time.
-mkHistWghMaybe :: (Bin bin, Unbox val, Num val) => 
-                  bin                              -- ^ Bin information
-               -> (Histogram bin val  -> b)        -- ^ Output function
-               -> (a -> Maybe (BinValue bin, val)) -- ^ Input function
-               -> HBuilder a b
-mkHistWghMaybe bin out inp = HBuilder $ do
-  acc <- newMHistogram 0 bin
-  return $ HBuilderST { hbInput  = maybe (return ()) (fillOneW acc) . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
-
--- | Create histogram with monoidal bins
-mkHistMonoid1 :: (Bin bin, Unbox val, Monoid val) =>
-              bin                         -- ^ Bin information
-          -> (Histogram bin val -> b)     -- ^ Output function
-          -> (a -> (BinValue bin, val))   -- ^ Input function
-          -> HBuilder a b
-mkHistMonoid1 bin out inp = HBuilder $ do
-  acc <- newMHistogram mempty bin
-  return $ HBuilderST { hbInput  = fillMonoid acc . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
-
--- | Create histogram with monoidal bins. Takes many items at time.
-mkHistMonoid :: (Bin bin, Unbox val, Monoid val) =>
-              bin                         -- ^ Bin information
-          -> (Histogram bin val -> b)     -- ^ Output function
-          -> (a -> [(BinValue bin, val)]) -- ^ Input function
-          -> HBuilder a b
-mkHistMonoid bin out inp = HBuilder $ do
-  acc <- newMHistogram mempty bin
-  return $ HBuilderST { hbInput  = mapM_ (fillMonoid acc) . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
-
--- | Create histogram with monoidal bins
-mkHistMonoidMaybe :: (Bin bin, Unbox val, Monoid val) =>
-                     bin                              -- ^ Bin information
-                  -> (Histogram bin val -> b)         -- ^ Output function
-                  -> (a -> Maybe (BinValue bin, val)) -- ^ Input function
-                  -> HBuilder a b
-mkHistMonoidMaybe bin out inp = HBuilder $ do
-  acc <- newMHistogram mempty bin
-  return $ HBuilderST { hbInput  = maybe (return ()) (fillMonoid acc) . inp
-                      , hbOutput = fmap out (freezeHist acc)
-                      }
+               freezeHBuilderM h
 
 ----------------------------------------------------------------
 
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,4 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts  #-}
 -- |
 -- Module     : Data.Histogram
 -- Copyright  : Copyright (c) 2009, Alexey Khudyakov <alexey.skladnoy@gmail.com>
@@ -32,6 +32,7 @@
   , histMap
   , histMapBin
   , histZip
+  , histZipSafe
   ) where
 
 import Control.Applicative ((<$>),(<*>))
@@ -40,7 +41,8 @@
 import Control.Monad.ST    (runST)
 
 import qualified Data.Vector.Generic.Mutable as M
-import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic         as G
+import Data.Typeable        (Typeable1(..), Typeable2(..), mkTyConApp, mkTyCon)
 import Data.Vector.Generic  (Vector)
 import Text.Read
 
@@ -54,7 +56,7 @@
 -- | Immutable histogram. Histogram consists of binning algorithm,
 --   optional number of under and overflows, and data. 
 data Histogram v bin a = Histogram bin (Maybe (a,a)) (v a)
-                         deriving Eq
+                         deriving (Eq)
 
 -- | Create histogram from binning algorithm and vector with
 -- data. Overflows are set to Nothing. 
@@ -79,7 +81,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 (map showT $ asList h)
         where
           showT (x,y) = show x ++ "\t" ++ show y
           showUO (Just (u,o)) = "# Underflows = " ++ show u ++ "\n" ++
@@ -87,6 +89,9 @@
           showUO Nothing      = "# Underflows = \n" ++
                                 "# Overflows  = \n"
 
+instance Typeable1 v => Typeable2 (Histogram v) where
+  typeOf2 h = mkTyConApp (mkTyCon "Data.Histogram.Generic.Histogram") [typeOf1 (histData h)]
+
 -- Parse histogram header
 histHeader :: (Read bin, Read a, Bin bin, Vector v a) => ReadPrec (v a -> Histogram v bin a)
 histHeader = do
@@ -161,7 +166,7 @@
     where
       bin' = bin
 
--- | Zip two histograms together. Bins of histograms must be equal
+-- | 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
@@ -170,7 +175,17 @@
     | otherwise   = Histogram bin (f2 <$> uo <*> uo') (G.zipWith f v v')
       where
         f2 (x,x') (y,y') = (f x y, f x' y')
-           
+
+-- | 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) =>
+           (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')
+
+
 -- | 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]
diff --git a/Data/Histogram/Parse.hs b/Data/Histogram/Parse.hs
--- a/Data/Histogram/Parse.hs
+++ b/Data/Histogram/Parse.hs
@@ -36,8 +36,8 @@
 
 -- Return optional value
 maybeValue :: Read a => String -> ReadPrec (Maybe a)
-maybeValue str = do lift $ key str >> eq
-                    (lift $ ws >> eol >> return Nothing) <++ (Just `fmap` getVal)
+maybeValue str = do lift (key str >> eq)
+                    lift (ws >> eol >> return Nothing) <++ (Just `fmap` getVal)
 
 -- Keyword
 keyword :: String -> ReadPrec ()
diff --git a/Data/Histogram/ST.hs b/Data/Histogram/ST.hs
--- a/Data/Histogram/ST.hs
+++ b/Data/Histogram/ST.hs
@@ -1,6 +1,4 @@
-{-# LANGUAGE GADTs #-}
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE Rank2Types #-}
 -- |
 -- Module     : Data.Histogram.ST
 -- Copyright  : Copyright (c) 2009, Alexey Khudyakov <alexey.skladnoy@gmail.com>
@@ -16,11 +14,11 @@
                          , fillOne
                          , fillOneW
                          , fillMonoid
+                         , unsafeFreezeHist
                          , freezeHist
                          ) where
 
-
-import Control.Monad.ST
+import Control.Monad.Primitive
 
 import Data.Monoid
 import qualified Data.Vector.Unboxed as U
@@ -34,16 +32,11 @@
 ----------------------------------------------------------------
 
 -- | Mutable histogram.
-data MHistogram s bin a where
-    MHistogram :: (Bin bin, MU.Unbox a) => 
-                  bin            -- Binning
-               -> MU.MVector s a -- Over/underflows
-               -> MU.MVector s a -- Data
-               -> MHistogram s bin a
+data MHistogram s bin a = MHistogram bin (MU.MVector s a) (MU.MVector s a)
 
 -- | Create new mutable histogram. All bins are set to zero element as
 --   passed to function.
-newMHistogram :: (Bin bin, U.Unbox a) => a -> bin -> ST s (MHistogram s bin a)
+newMHistogram :: (PrimMonad m, Bin bin, U.Unbox a) => a -> bin -> m (MHistogram (PrimState m) bin a)
 newMHistogram zero bin = do
   uo <- MU.newWith 2 zero
   a  <- MU.newWith (nBins bin) zero
@@ -51,8 +44,8 @@
 {-# INLINE newMHistogram #-}
 
 -- | Put one value into histogram
-fillOne :: Num a => MHistogram s bin a -> BinValue bin -> ST s ()
-fillOne (MHistogram bin uo arr) x
+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
@@ -61,8 +54,8 @@
 {-# INLINE fillOne #-}
 
 -- | Put one value into histogram with weight
-fillOneW :: Num a => MHistogram s bin a -> (BinValue bin, a) -> ST s ()
-fillOneW (MHistogram bin uo arr) (x,w)
+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
@@ -71,17 +64,28 @@
 {-# INLINE fillOneW #-} 
 
 -- | Put one monoidal element
-fillMonoid :: Monoid a => MHistogram s bin a -> (BinValue bin, a) -> ST s ()
-fillMonoid (MHistogram bin uo arr) (x,m)
-    | i < 0              = MU.unsafeWrite uo  1 . (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
+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  1 . 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 #-}
+{-# INLINE fillMonoid #-}
 
--- | Create immutable histogram from mutable one. This operation involve copying.
-freezeHist :: MHistogram s bin a -> ST s (Histogram bin a)
+
+-- | 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
+  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
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.2.0
+Version:        0.3
 Cabal-Version:  >= 1.6
 License:        BSD3
 License-File:   LICENSE
@@ -12,15 +12,13 @@
 Description:    
   This is library for histograms filling. Its aim to provide
   convenient way to create and fill histograms. 
-  .
-  This is very much work in progress so expect API breakage in future relesases.
 
 source-repository head
   type:     hg
   location: http://bitbucket.org/Shimuuar/histogram-fill
 
 Library
-  Build-Depends:        base >=3 && <5, vector
+  Build-Depends:        base >=3 && <5, primitive, vector
   Exposed-modules:      Data.Histogram
                         Data.Histogram.Generic
                         Data.Histogram.Fill