diff --git a/Data/StorableVector.hs b/Data/StorableVector.hs
--- a/Data/StorableVector.hs
+++ b/Data/StorableVector.hs
@@ -66,7 +66,7 @@
         switchL,
         switchR,
 
-        -- * Transformating 'Vector's
+        -- * Transforming 'Vector's
         map,
         reverse,
         intersperse,
@@ -83,6 +83,7 @@
         -- ** Special folds
         concat,
         concatMap,
+        monoidConcatMap,
         any,
         all,
         maximum,
@@ -102,8 +103,10 @@
 
         -- ** Unfolding 'Vector's
         replicate,
+        iterateN,
         unfoldr,
         unfoldrN,
+        unfoldrResultN,
         sample,
 
         -- * Substrings
@@ -158,6 +161,8 @@
         -- * Zipping and unzipping 'Vector's
         zip,
         zipWith,
+        zipWith3,
+        zipWith4,
         unzip,
         copy,
 
@@ -179,7 +184,7 @@
                                 ,scanl,scanl1,scanr,scanr1
                                 ,readFile,writeFile,appendFile,replicate
                                 ,getContents,getLine,putStr,putStrLn
-                                ,zip,zipWith,unzip,notElem)
+                                ,zip,zipWith,zipWith3,unzip,notElem)
 
 import Data.StorableVector.Base
 
@@ -199,7 +204,7 @@
 import Foreign.Storable         (Storable(..))
 
 import Data.Monoid              (Monoid, mempty, mappend, mconcat, )
-import Control.Monad            (mplus, guard, when, )
+import Control.Monad            (mplus, guard, when, liftM2, liftM3, liftM4, )
 
 import System.IO                (openBinaryFile, hClose, hFileSize,
                                  hGetBuf, hPutBuf,
@@ -587,6 +592,13 @@
 concatMap f = concat . unpackWith f
 {-# INLINE concatMap #-}
 
+-- | This is like @mconcat . map f@,
+-- but in many cases the result of @f@ will not be storable.
+monoidConcatMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m
+monoidConcatMap f =
+   foldr (mappend . f) mempty
+{-# INLINE monoidConcatMap #-}
+
 -- | /O(n)/ Applied to a predicate and a 'Vector', 'any' determines if
 -- any element of the 'Vector' satisfies the predicate.
 any :: (Storable a) => (a -> Bool) -> Vector a -> Bool
@@ -744,10 +756,18 @@
 -- the value of every element.
 --
 replicate :: (Storable a) => Int -> a -> Vector a
-replicate w c
-    | w <= 0    = empty
-    | otherwise = fst $ unfoldrN w (const $ return (c, ())) ()
+replicate n c =
+   fst $ unfoldrN n (const $ Just (c, ())) ()
+{-# INLINE replicate #-}
 
+-- | /O(n)/ 'iterateN' @n f x@ is a 'Vector' of length @n@
+-- where the elements of @x@ are generated by repeated application of @f@.
+--
+iterateN :: (Storable a) => Int -> (a -> a) -> a -> Vector a
+iterateN n f =
+   fst . unfoldrN n (\a -> Just (a, f a))
+{-# INLINE iterateN #-}
+
 -- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr'
 -- function is analogous to the List \'unfoldr\'.  'unfoldr' builds a
 -- 'Vector' from a seed value.  The function takes the element and
@@ -778,7 +798,7 @@
 --
 unfoldrN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
 unfoldrN i f x0 =
-   if i < 0
+   if i <= 0
      then (empty, Just x0)
      else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0
        {-
@@ -796,6 +816,53 @@
                                      go (incPtr p) (n+1) x'
 {-# INLINE unfoldrN #-}
 
+{-
+Examples:
+
+f i = Just (i::Char, succ i)
+
+f i = toMaybe (i<='p') (i::Char, succ i)
+
+-}
+-- | /O(n)/ Like 'unfoldrN' this function builds a 'Vector'
+-- from a seed value with limited size.
+-- Additionally it returns a value, that depends on the state,
+-- but is not necessarily the state itself.
+-- If end of vector and end of the generator coincide,
+-- then the result is as if only the end of vector is reached.
+--
+-- Example:
+--
+-- > unfoldrResultN 30 Char.ord (\c -> if c>'z' then Left 1000 else Right (c, succ c)) 'a'
+--
+-- The following equation relates 'unfoldrN' and 'unfoldrResultN':
+--
+-- > unfoldrN n f s ==
+-- >    unfoldrResultN n Just
+-- >       (maybe (Left Nothing) Right . f) s
+--
+-- It is not possible to express 'unfoldrResultN' in terms of 'unfoldrN'.
+--
+unfoldrResultN :: (Storable b) => Int -> (a -> c) -> (a -> Either c (b, a)) -> a -> (Vector b, c)
+unfoldrResultN i g f x0 =
+   if i <= 0
+     then (empty, g x0)
+     else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0
+       {-
+       go must not be strict in the accumulator
+       since otherwise packN would be too strict.
+       -}
+       where
+          go = Strict.arguments2 $ \p n -> \a0 ->
+             if n == i
+               then return (0, n, g a0)
+               else
+                 case f a0 of
+                   Left c -> return (0, n, c)
+                   Right (b,a1) -> do poke p b
+                                      go (incPtr p) (n+1) a1
+{-# INLINE unfoldrResultN #-}
+
 unfoldlN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
 unfoldlN i f x0
     | i < 0     = (empty, Just x0)
@@ -1044,8 +1111,9 @@
 -- satisfying the predicate.
 findIndex :: (Storable a) => (a -> Bool) -> Vector a -> Maybe Int
 findIndex p xs =
-   {- the implementation is in principle the same as for findIndices,
-      but we use the First monoid, instead of the List/append monoid -}
+   {- The implementation is in principle the same as for findIndices,
+      but we use the First monoid, instead of the List/append monoid.
+      We could also implement findIndex in terms of monoidConcatMap. -}
    foldr
       (\x k n ->
          toMaybe (p x) n `mplus` k (succ n))
@@ -1155,18 +1223,58 @@
 -- corresponding sums.
 zipWith :: (Storable a, Storable b, Storable c) =>
    (a -> b -> c) -> Vector a -> Vector b -> Vector c
-zipWith f ps0 qs0 =
-   fst $ unfoldrN
-      (min (length ps0) (length qs0))
-      (\(ps,qs) ->
-         do (ph,pt) <- viewL ps
-            (qh,qt) <- viewL qs
-            return (f ph qh, (pt,qt)))
-      (ps0,qs0)
+zipWith f as bs =
+   unsafeWithStartPtr as $ \pa0 la ->
+   withStartPtr       bs $ \pb0 lb ->
+   let len = min la lb
+   in  create len $ \p0 ->
+       let go = Strict.arguments4 $ \n p pa pb ->
+              when (n>0) $
+                 liftM2 f (peek pa) (peek pb) >>= poke p >>
+                 go (pred n) (incPtr p) (incPtr pa) (incPtr pb)
+       in  go len p0 pa0 pb0
 
+
 -- zipWith f ps qs = pack $ List.zipWith f (unpack ps) (unpack qs)
 {-# INLINE zipWith #-}
 
+-- | Like 'zipWith' but for three input vectors
+zipWith3 :: (Storable a, Storable b, Storable c, Storable d) =>
+   (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
+zipWith3 f as bs cs =
+   unsafeWithStartPtr as $ \pa0 la ->
+   withStartPtr       bs $ \pb0 lb ->
+   withStartPtr       cs $ \pc0 lc ->
+   let len = la `min` lb `min` lc
+   in  create len $ \p0 ->
+       let go = Strict.arguments5 $ \n p pa pb pc ->
+              when (n>0) $
+                 liftM3 f (peek pa) (peek pb) (peek pc) >>= poke p >>
+                 go (pred n) (incPtr p) (incPtr pa) (incPtr pb) (incPtr pc)
+       in  go len p0 pa0 pb0 pc0
+{-# INLINE zipWith3 #-}
+
+-- | Like 'zipWith' but for four input vectors
+-- If you need even more input vectors,
+-- you might write a function yourselve using unfoldrN and viewL.
+zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) =>
+   (a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e
+zipWith4 f as bs cs ds =
+   unsafeWithStartPtr as $ \pa0 la ->
+   withStartPtr       bs $ \pb0 lb ->
+   withStartPtr       cs $ \pc0 lc ->
+   withStartPtr       ds $ \pd0 ld ->
+   let len = la `min` lb `min` lc `min` ld
+   in  create len $ \p0 ->
+       let go =
+              Strict.arguments2 $ \n p ->
+              Strict.arguments4 $ \pa pb pc pd ->
+              when (n>0) $
+                 liftM4 f (peek pa) (peek pb) (peek pc) (peek pd) >>= poke p >>
+                 go (pred n) (incPtr p) (incPtr pa) (incPtr pb) (incPtr pc) (incPtr pd)
+       in  go len p0 pa0 pb0 pc0 pd0
+{-# INLINE zipWith4 #-}
+
 -- | /O(n)/ 'unzip' transforms a list of pairs of elements into a pair of
 -- 'Vector's. Note that this performs two 'pack' operations.
 unzip :: (Storable a, Storable b) => [(a, b)] -> (Vector a, Vector b)
@@ -1222,13 +1330,22 @@
 --
 hGet :: (Storable a) => Handle -> Int -> IO (Vector a)
 hGet _ 0 = return empty
-hGet h i =
-   createAndTrim i $ \p ->
+hGet h l =
+   createAndTrim l $ \p ->
       let elemType :: Ptr a -> a
           elemType _ = undefined
-          sizeOfElem = sizeOf (elemType p)
+          roundUp m n = n + mod (-n) m
+          sizeOfElem =
+             roundUp
+                (alignment (elemType p))
+                (sizeOf (elemType p))
       in  fmap (flip div sizeOfElem) $
-          hGetBuf h p (i * sizeOfElem)
+          hGetBuf h p (l * sizeOfElem)
+{-
+   createAndTrim l $ \p ->
+      fmap (flip div (incPtr p `minusPtr` p)) $
+      hGetBuf h p (advancePtr p l `minusPtr` p)
+-}
 
 -- | Read an entire file strictly into a 'Vector'.  This is far more
 -- efficient than reading the characters into a 'String' and then using
@@ -1265,10 +1382,6 @@
 foreignPeek fp k =
    inlinePerformIO $ withForeignPtr fp $ flip peekElemOff k
 {-# INLINE foreignPeek #-}
-
-incPtr :: (Storable a) => Ptr a -> Ptr a
-incPtr v = advancePtr v 1
-{-# INLINE incPtr #-}
 
 withNonEmptyVector ::
    String -> (ForeignPtr a -> Int -> Int -> b) -> Vector a -> b
diff --git a/Data/StorableVector/Base.hs b/Data/StorableVector/Base.hs
--- a/Data/StorableVector/Base.hs
+++ b/Data/StorableVector/Base.hs
@@ -38,6 +38,7 @@
         fromForeignPtr,         -- :: ForeignPtr a -> Int -> Vector a
         toForeignPtr,           -- :: Vector a -> (ForeignPtr a, Int, Int)
         withStartPtr,           -- :: Vector a -> (Ptr a -> Int -> IO b) -> IO b
+        incPtr,                 -- :: Ptr a -> Ptr a
 
         inlinePerformIO
 
@@ -133,6 +134,14 @@
 unsafeDrop n (SV x s l) = assert (0 <= n && n <= l) $ SV x (s+n) (l-n)
 {-# INLINE unsafeDrop #-}
 
+
+instance (Storable a, Show a) => Show (Vector a) where
+   showsPrec p xs@(SV _ _ l) =
+      showParen (p>=10)
+         (showString "Vector.pack " .
+          showsPrec 10 (map (unsafeIndex xs) [0..(l-1)]))
+
+
 -- ---------------------------------------------------------------------
 -- Low level constructors
 
@@ -150,6 +159,10 @@
 withStartPtr (SV x s l) f =
    withForeignPtr x $ \p -> f (p `advancePtr` s) l
 {-# INLINE withStartPtr #-}
+
+incPtr :: (Storable a) => Ptr a -> Ptr a
+incPtr v = advancePtr v 1
+{-# INLINE incPtr #-}
 
 -- | A way of creating Vectors outside the IO monad. The @Int@
 -- argument gives the final size of the Vector. Unlike
diff --git a/Data/StorableVector/Lazy.hs b/Data/StorableVector/Lazy.hs
--- a/Data/StorableVector/Lazy.hs
+++ b/Data/StorableVector/Lazy.hs
@@ -56,8 +56,6 @@
 
 
 
-{-# ONLINE chunks #-}
-
 newtype Vector a = SV {chunks :: [V.Vector a]}
 
 
@@ -69,7 +67,13 @@
 instance (Storable a, Eq a) => Eq (Vector a) where
    (==) = equal
 
+instance (Storable a, Show a) => Show (Vector a) where
+   showsPrec p xs =
+      showParen (p>=10)
+         (showString "VectorLazy.fromChunks " .
+          showsPrec 10 (chunks xs))
 
+
 -- for a list of chunk sizes see "Data.StorableVector.LazySize".
 newtype ChunkSize = ChunkSize Int
    deriving (Eq, Ord, Show)
@@ -123,7 +127,7 @@
 {-# INLINE packWith #-}
 packWith :: (Storable b) => ChunkSize -> (a -> b) -> [a] -> Vector b
 packWith size f =
-   unfoldr size (fmap (\(a,b) -> (f a, b)) . ListHT.viewL)
+   unfoldr size (fmap (mapFst f) . ListHT.viewL)
 
 {-# INLINE unpackWith #-}
 unpackWith :: (Storable a) => (a -> b) -> Vector a -> [b]
@@ -132,15 +136,37 @@
 
 {-# INLINE unfoldr #-}
 unfoldr :: (Storable b) =>
-      ChunkSize
-   -> (a -> Maybe (b,a))
-   -> a
-   -> Vector b
+   ChunkSize ->
+   (a -> Maybe (b,a)) ->
+   a ->
+   Vector b
 unfoldr (ChunkSize size) f =
    SV .
    List.unfoldr (cancelNullVector . V.unfoldrN size f =<<) .
    Just
 
+{- |
+Example:
+
+> *Data.StorableVector.Lazy> unfoldrResult (ChunkSize 5) (\c -> if c>'z' then Left (Char.ord c) else Right (c, succ c)) 'a'
+> (VectorLazy.fromChunks [Vector.pack "abcde",Vector.pack "fghij",Vector.pack "klmno",Vector.pack "pqrst",Vector.pack "uvwxy",Vector.pack "z"],123)
+-}
+{-# INLINE unfoldrResult #-}
+unfoldrResult :: (Storable b) =>
+   ChunkSize ->
+   (a -> Either c (b, a)) ->
+   a ->
+   (Vector b, c)
+unfoldrResult (ChunkSize size) f =
+   let recourse a0 =
+          let (chunk, a1) =
+                 V.unfoldrResultN size Right (either (Left . Left) Right . f) a0
+          in  either
+                 ((,) (if V.null chunk then [] else [chunk]))
+                 (mapFst (chunk :) . recourse) a1
+   in  mapFst SV . recourse
+
+
 {-# INLINE sample #-}
 sample :: (Storable a) => ChunkSize -> (Int -> a) -> Vector a
 sample size f =
@@ -281,6 +307,11 @@
 foldr f x0 = List.foldr (flip (V.foldr f)) x0 . chunks
 
 
+{-# INLINE monoidConcatMap #-}
+monoidConcatMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m
+monoidConcatMap f =
+   List.foldr (mappend . V.monoidConcatMap f) mempty . chunks
+
 {-# INLINE any #-}
 any :: (Storable a) => (a -> Bool) -> Vector a -> Bool
 any p = List.any (V.any p) . chunks
@@ -314,8 +345,7 @@
 
 {-# INLINE pointer #-}
 pointer :: Storable a => Vector a -> Ptr.Pointer a
-pointer x =
-   Ptr.Pointer (chunks x) 0
+pointer = Ptr.cons . chunks
 
 {-# INLINE viewL #-}
 viewL :: Storable a => Vector a -> Maybe (a, Vector a)
@@ -327,7 +357,11 @@
 {-# INLINE viewR #-}
 viewR :: Storable a => Vector a -> Maybe (Vector a, a)
 viewR (SV xs0) =
+   do xsp <- ListHT.viewR xs0
+      let (xs,x) = xsp
+{-
    do ~(xs,x) <- ListHT.viewR xs0
+-}
       let (ys,y) = fromMaybe (moduleError "viewR" "last chunk empty") (V.viewR x)
       return (append (SV xs) (fromChunk ys), y)
 
@@ -418,8 +452,12 @@
 
 {-# INLINE take #-}
 take :: (Storable a) => Int -> Vector a -> Vector a
-take _ (SV []) = empty
+{- this order of pattern matches is certainly the most lazy one
+> take 4 (pack (chunkSize 2) $ "abcd" List.++ undefined)
+VectorLazy.fromChunks [Vector.pack "ab",Vector.pack "cd"]
+-}
 take 0 _ = empty
+take _ (SV []) = empty
 take n (SV (x:xs)) =
    let m = V.length x
    in  if m<=n
@@ -438,8 +476,12 @@
 {-# INLINE splitAt #-}
 splitAt :: (Storable a) => Int -> Vector a -> (Vector a, Vector a)
 splitAt n0 =
-   let recourse _ [] = ([], [])
-       recourse 0 xs = ([], xs)
+   {- this order of pattern matches is certainly the most lazy one
+   > splitAt 4 (pack (chunkSize 2) $ "abcd" List.++ undefined)
+   (VectorLazy.fromChunks [Vector.pack "ab",Vector.pack "cd"],VectorLazy.fromChunks *** Exception: Prelude.undefined
+   -}
+   let recourse 0 xs = ([], xs)
+       recourse _ [] = ([], [])
        recourse n (x:xs) =
           let m = V.length x
           in  if m<=n
@@ -527,22 +569,88 @@
    SV . List.filter (not . V.null) . List.map (V.filter p) . chunks
 
 
+{- |
+Generates laziness breaks
+wherever one of the input signals has a chunk boundary.
+-}
 {-# INLINE zipWith #-}
 zipWith :: (Storable a, Storable b, Storable c) =>
       (a -> b -> c)
    -> Vector a
    -> Vector b
    -> Vector c
-zipWith f =
+zipWith f as0 bs0 =
+   let recourse at@(a:_) bt@(b:_) =
+          let z = V.zipWith f a b
+              n = V.length z
+          in  z : recourse
+                     (chunks $ drop n $ fromChunks at)
+                     (chunks $ drop n $ fromChunks bt)
+       recourse _ _ = []
+   in  fromChunks $ recourse (chunks as0) (chunks bs0)
+
+{-# INLINE zipWith3 #-}
+zipWith3 :: (Storable a, Storable b, Storable c, Storable d) =>
+      (a -> b -> c -> d)
+   -> Vector a
+   -> Vector b
+   -> Vector c
+   -> Vector d
+zipWith3 f as0 bs0 cs0 =
+   let recourse at@(a:_) bt@(b:_) ct@(c:_) =
+          let z = V.zipWith3 f a b c
+              n = V.length z
+          in  z : recourse
+                     (chunks $ drop n $ fromChunks at)
+                     (chunks $ drop n $ fromChunks bt)
+                     (chunks $ drop n $ fromChunks ct)
+       recourse _ _ _ = []
+   in  fromChunks $ recourse (chunks as0) (chunks bs0) (chunks cs0)
+
+{-# INLINE zipWith4 #-}
+zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) =>
+      (a -> b -> c -> d -> e)
+   -> Vector a
+   -> Vector b
+   -> Vector c
+   -> Vector d
+   -> Vector e
+zipWith4 f as0 bs0 cs0 ds0 =
+   let recourse at@(a:_) bt@(b:_) ct@(c:_) dt@(d:_) =
+          let z = V.zipWith4 f a b c d
+              n = V.length z
+          in  z : recourse
+                     (chunks $ drop n $ fromChunks at)
+                     (chunks $ drop n $ fromChunks bt)
+                     (chunks $ drop n $ fromChunks ct)
+                     (chunks $ drop n $ fromChunks dt)
+       recourse _ _ _ _ = []
+   in  fromChunks $
+       recourse (chunks as0) (chunks bs0) (chunks cs0) (chunks ds0)
+
+
+{- |
+Preserves chunk pattern of the last argument.
+-}
+{-# INLINE zipWithLastPattern #-}
+zipWithLastPattern :: (Storable a, Storable b, Storable c) =>
+      (a -> b -> c)
+   -> Vector a
+   -> Vector b
+   -> Vector c
+zipWithLastPattern f =
    crochetL (\y -> liftM (mapFst (flip f y)) . Ptr.viewL)
     . pointer
 
-{-# INLINE zipWith3 #-}
-zipWith3 ::
+{- |
+Preserves chunk pattern of the last argument.
+-}
+{-# INLINE zipWithLastPattern3 #-}
+zipWithLastPattern3 ::
    (Storable a, Storable b, Storable c, Storable d) =>
    (a -> b -> c -> d) ->
    (Vector a -> Vector b -> Vector c -> Vector d)
-zipWith3 f s0 s1 =
+zipWithLastPattern3 f s0 s1 =
    crochetL (\z (xt,yt) ->
       liftM2
          (\(x,xs) (y,ys) -> (f x y z, (xs,ys)))
@@ -550,12 +658,15 @@
          (Ptr.viewL yt))
       (pointer s0, pointer s1)
 
-{-# INLINE zipWith4 #-}
-zipWith4 ::
+{- |
+Preserves chunk pattern of the last argument.
+-}
+{-# INLINE zipWithLastPattern4 #-}
+zipWithLastPattern4 ::
    (Storable a, Storable b, Storable c, Storable d, Storable e) =>
    (a -> b -> c -> d -> e) ->
    (Vector a -> Vector b -> Vector c -> Vector d -> Vector e)
-zipWith4 f s0 s1 s2 =
+zipWithLastPattern4 f s0 s1 s2 =
    crochetL (\w (xt,yt,zt) ->
       liftM3
          (\(x,xs) (y,ys) (z,zs) -> (f x y z w, (xs,ys,zs)))
@@ -615,7 +726,7 @@
 {- |
 Ensure a minimal length of the list by appending pad values.
 -}
-{-# ONLINE pad #-}
+{- disabled INLINE pad -}
 pad :: (Storable a) => ChunkSize -> a -> Int -> Vector a -> Vector a
 pad size y n0 =
    let recourse n xt =
@@ -1127,7 +1238,7 @@
                then hClose h >>
                     return (Exc.mkIOError Exc.eofErrorType
                       "StorableVector.Lazy.hGetContentsAsync" (Just h) Nothing, [])
-               else liftM (\ ~(err,rest) -> (err, v:rest)) go
+               else fmap (mapSnd (v:)) go
 {-
           unsafeInterleaveIO $
           flip catch (\err -> return (err,[])) $
@@ -1136,19 +1247,15 @@
 -}
    in  fmap (mapSnd SV) go
 
-{-
 hGetContentsSync :: Storable a =>
-   ChunkSize -> Handle -> IO (IOError, Vector a)
+   ChunkSize -> Handle -> IO (Vector a)
 hGetContentsSync (ChunkSize size) h =
    let go =
-          flip catch (\err -> return (err,[])) $
           do v <- V.hGet h size
              if V.null v
-               then return (Exc.mkIOError Exc.eofErrorType
-                      "StorableVector.Lazy.hGetContentsAsync" (Just h) Nothing, [])
-               else liftM (\ ~(err,rest) -> (err, v:rest)) go
-   in  fmap (mapSnd SV) go
--}
+               then return []
+               else fmap (v:) go
+   in  fmap SV go
 
 hPut :: Storable a => Handle -> Vector a -> IO ()
 hPut h = mapM_ (V.hPut h) . chunks
diff --git a/Data/StorableVector/Lazy/Builder.hs b/Data/StorableVector/Lazy/Builder.hs
--- a/Data/StorableVector/Lazy/Builder.hs
+++ b/Data/StorableVector/Lazy/Builder.hs
@@ -2,6 +2,11 @@
 {- |
 Build a lazy storable vector by incrementally adding an element.
 This is analogous to Data.Binary.Builder for Data.ByteString.Lazy.
+
+Attention:
+This implementation is still almost 3 times slower
+than constructing a lazy storable vector using unfoldr
+in our Chorus speed test.
 -}
 module Data.StorableVector.Lazy.Builder (
    Builder,
@@ -12,76 +17,141 @@
 
 import qualified Data.StorableVector as SV
 import qualified Data.StorableVector.Lazy as SVL
-import qualified Data.StorableVector.ST.Lazy as STV
-import qualified Data.StorableVector.ST.Private as STVP
-import qualified Control.Monad.Trans.RWS as RWS
+import qualified Data.StorableVector.ST.Strict as STV
+import qualified Data.StorableVector.ST.Lazy as STVL
 
-import Foreign.Storable (Storable, )
 import Data.StorableVector.Lazy (ChunkSize(ChunkSize), )
-import Control.Monad.ST.Lazy (ST, runST, strictToLazyST, )
-import Control.Monad.Trans.RWS (RWST, runRWST, )
-import Control.Monad.Trans (lift, )
-import Data.Monoid (Monoid(mempty, mappend), Endo(Endo), appEndo, )
+import Control.Monad (liftM2, )
+import Control.Monad.ST.Strict (ST, runST, unsafeInterleaveST, )
+import Data.Monoid (Monoid(mempty, mappend), )
 
+import Foreign.Storable (Storable, )
 
+
+{-
+Given an initial buffer and a function that generates the rest of the vector,
+a 'Builder' generates the whole vector.
+The idea is inspired by Data.Binary.Builder.
+
+We use the strict ST monad by default
+and only rare 'unsafeInterleaveST',
+since this is more efficient than using lazy ST everywhere.
+
+Before that approach I tried to achieve this with a lazy State monad.
+I found this more comprehensible but it was very slow
+and had a space leak, when the last chunk shall be handled correctly.
+-}
 newtype Builder a =
    Builder {run :: forall s.
-      RWST ChunkSize (Endo [SV.Vector a]) (STV.Vector s a, Int) (ST s) ()}
+      ChunkSize ->
+      (Buffer s a -> ST s [SV.Vector a]) ->
+      (Buffer s a -> ST s [SV.Vector a])
+   }
 
+type Buffer s a = (STV.Vector s a, Int)
 
+
 -- instance Monoid (Builder a) where
 {-
-Storable constraint not need in the current implementation,
+Storable constraint not needed in the current implementation,
 but who knows what will be in future ...
 -}
 instance Storable a => Monoid (Builder a) where
-   mempty = Builder (return ())
-   mappend x y = Builder (run x >> run y)
+   {-# INLINE mempty #-}
+   {-# INLINE mappend #-}
+   mempty = Builder (\_ -> id)
+   mappend x y = Builder (\cs -> run x cs . run y cs)
 
 
-{-
-SVL.unpack $ toLazyStorableVector (ChunkSize 7) $ Data.Monoid.mconcat $ map put ['a'..'z']
+{- |
+> toLazyStorableVector (ChunkSize 7) $ Data.Monoid.mconcat $ map put ['a'..'z']
 -}
+{-# INLINE toLazyStorableVector #-}
 toLazyStorableVector :: Storable a =>
    ChunkSize -> Builder a -> SVL.Vector a
-toLazyStorableVector cs@(SVL.ChunkSize size) bld =
-   runST (do
-      v0 <- STV.new_ size
-      (_,vi1,chunks) <- runRWST (run bld) cs (v0,0)
-      lastChunk <- fixVector vi1
-      return $ SVL.fromChunks $ appEndo chunks [lastChunk])
+toLazyStorableVector cs bld =
+   SVL.fromChunks $
+   runST (run bld cs (fmap (:[]) . fixVector) =<< newChunk cs)
 
+
+{-# INLINE put #-}
 put :: Storable a => a -> Builder a
 put a =
-   Builder (
-      do (SVL.ChunkSize size) <- RWS.ask
-         (v0,i0) <- RWS.get
-         (v1,i1) <-
-            if i0<size
-              then return (v0,i0)
-              else
+   Builder (\cs cont (v0,i0) ->
+      do STV.unsafeWrite v0 i0 a
+         let i1 = succ i0
+         if i1 < STV.length v0
+           then
+             cont (v0, i1)
+           else
+             liftM2 (:)
                 -- we could call 'flush' here, but this requires an extra 'SV.take'
-                do RWS.tell . Endo . (:) =<<
-                      (lift $ strictToLazyST $ STVP.unsafeToVector v0)
-                   lift $ fmap (flip (,) 0) $ STV.new_ size
-         lift $ STV.write v1 i1 a
-         RWS.put (v1, succ i1)
+                (STV.unsafeFreeze v0)
+                (unsafeInterleaveST $
+                 cont =<< newChunk cs)
    )
 
+{-
+put :: Storable a => a -> Builder a
+put a =
+   Builder (\cs cont (v0,i0) ->
+      if i0 < STV.length v0
+        then
+          do STV.write v0 i0 a
+             cont (v0, succ i0)
+        else
+          liftM2 (:)
+             -- we could call 'flush' here, but this requires an extra 'SV.take'
+             (STV.unsafeFreeze v0)
+             (unsafeInterleaveST $
+              do (v1,i1) <- newChunk cs
+                 STV.write v1 i1 a
+                 cont (v1, succ i1))
+   )
+-}
+
+{-
+          lazyToStrictST $
+          liftM2 (:)
+             -- we could call 'flush' here, but this requires an extra 'SV.take'
+             (STVL.unsafeFreeze v0)
+             (strictToLazyST $
+              do (v1,i1) <- newChunk cs
+                 STV.write v1 i1 a
+                 cont (v1, succ i1))
+-}
+
+{-
+Prelude Control.Monad.ST.Lazy> Control.Monad.ST.runST (lazyToStrictST $ Monad.liftM2 (,) (strictToLazyST $ return 'a') (strictToLazyST (undefined::Monad m => m Char)))
+*** Exception: Prelude.undefined
+-}
+
 {- |
 Set a laziness break.
 -}
+{-# INLINE flush #-}
 flush :: Storable a => Builder a
 flush =
-   Builder (
-      do RWS.tell . Endo . (:) =<< lift . fixVector =<< RWS.get
-         (SVL.ChunkSize size) <- RWS.ask
-         v1 <- lift $ STV.new_ size
-         RWS.put (v1, 0)
+   Builder (\cs cont vi0 ->
+      liftM2 (:)
+         (fixVector vi0)
+         (unsafeInterleaveST $ cont =<< newChunk cs)
+{-
+      lazyToStrictST $
+      liftM2 (:)
+         (strictToLazyST $ fixVector vi0)
+         (strictToLazyST $ cont =<< newChunk cs)
+-}
    )
 
+{-# INLINE newChunk #-}
+newChunk :: (Storable a) =>
+   ChunkSize -> ST s (Buffer s a)
+newChunk (SVL.ChunkSize size) =
+   fmap (flip (,) 0) $ STV.new_ size
+
+{-# INLINE fixVector #-}
 fixVector :: (Storable a) =>
-   (STVP.Vector s a, Int) -> ST s (SV.Vector a)
+   Buffer s a -> ST s (SV.Vector a)
 fixVector ~(v1,i1) =
-   fmap (SV.take i1) $
-   strictToLazyST $ STVP.unsafeToVector v1
+   fmap (SV.take i1) $ STV.unsafeFreeze v1
diff --git a/Data/StorableVector/Lazy/Pattern.hs b/Data/StorableVector/Lazy/Pattern.hs
--- a/Data/StorableVector/Lazy/Pattern.hs
+++ b/Data/StorableVector/Lazy/Pattern.hs
@@ -102,7 +102,6 @@
 
 import qualified Data.List as List
 
-import Data.Maybe (Maybe(Just, Nothing), )
 import qualified Data.List.HT as ListHT
 import Data.Tuple.HT (mapPair, mapFst, forcePair, )
 
@@ -110,12 +109,14 @@
 
 import Foreign.Storable (Storable)
 
-{-
 import Prelude hiding
    (length, (++), iterate, foldl, map, repeat, replicate, null,
-    zip, zipWith, zipWith3, drop, take, splitAt, takeWhile, dropWhile, reverse)
--}
+    zip, zipWith, zipWith3, drop, take, splitAt, takeWhile, dropWhile, reverse,
+    any, all, concat, cycle, filter, maximum, minimum, scanl, span, )
+{-
+import Data.Maybe (Maybe(Just, Nothing), )
 import Prelude (Int, (.), ($), fst, snd, (<=), flip, curry, return, fmap, not, uncurry, )
+-}
 
 
 type LazySize = LS.T ChunkSize
diff --git a/Data/StorableVector/Lazy/PointerPrivate.hs b/Data/StorableVector/Lazy/PointerPrivate.hs
--- a/Data/StorableVector/Lazy/PointerPrivate.hs
+++ b/Data/StorableVector/Lazy/PointerPrivate.hs
@@ -1,5 +1,6 @@
 module Data.StorableVector.Lazy.PointerPrivate where
 
+import qualified Data.StorableVector.Pointer as VP
 import qualified Data.StorableVector as V
 import qualified Data.StorableVector.Base as VB
 
@@ -7,9 +8,21 @@
 
 
 data Pointer a =
-   Pointer {chunks :: ![VB.Vector a], index :: !Int}
+   Pointer {
+      chunks :: [VB.Vector a],
+      ptr    :: {-# UNPACK #-} !(VP.Pointer a)
+   }
 
 
+empty :: Storable a => Pointer a
+empty =
+   Pointer [] (VP.cons V.empty)
+
+{-# INLINE cons #-}
+cons :: Storable a => [VB.Vector a] -> Pointer a
+cons [] = empty
+cons (c:cs) = Pointer cs (VP.cons c)
+
 {-# INLINE viewL #-}
 viewL :: Storable a => Pointer a -> Maybe (a, Pointer a)
 viewL = switchL Nothing (curry Just)
@@ -19,13 +32,11 @@
    b -> (a -> Pointer a -> b) -> Pointer a -> b
 switchL n j =
    let recourse p =
-          let s = chunks p
-          in  case s of
-                 [] -> n
-                 (c:cs) ->
-                    let i = index p
-                        d = i - V.length c
-                    in  if d < 0
-                          then j (VB.unsafeIndex c i) (Pointer s (i+1))
-                          else recourse (Pointer cs d)
+          let ct = chunks p
+          in  VP.switchL
+                 (case ct of
+                    [] -> n
+                    (c:cs) -> recourse (Pointer cs (VP.cons c)))
+                 (\a cp -> j a (Pointer ct cp))
+                 (ptr p)
    in  recourse
diff --git a/Data/StorableVector/Lazy/PointerPrivateIndex.hs b/Data/StorableVector/Lazy/PointerPrivateIndex.hs
new file mode 100644
--- /dev/null
+++ b/Data/StorableVector/Lazy/PointerPrivateIndex.hs
@@ -0,0 +1,38 @@
+{-
+Alternative to PointerPrivate implemented at a higher level.
+-}
+module Data.StorableVector.Lazy.PointerPrivateIndex where
+
+import qualified Data.StorableVector as V
+import qualified Data.StorableVector.Base as VB
+
+import Foreign.Storable (Storable)
+
+
+data Pointer a =
+   Pointer {chunks :: ![VB.Vector a], index :: !Int}
+
+
+{-# INLINE cons #-}
+cons :: Storable a => [VB.Vector a] -> Pointer a
+cons = flip Pointer 0
+
+{-# INLINE viewL #-}
+viewL :: Storable a => Pointer a -> Maybe (a, Pointer a)
+viewL = switchL Nothing (curry Just)
+
+{-# INLINE switchL #-}
+switchL :: Storable a =>
+   b -> (a -> Pointer a -> b) -> Pointer a -> b
+switchL n j =
+   let recourse p =
+          let s = chunks p
+          in  case s of
+                 [] -> n
+                 (c:cs) ->
+                    let i = index p
+                        d = i - V.length c
+                    in  if d < 0
+                          then j (VB.unsafeIndex c i) (Pointer s (i+1))
+                          else recourse (Pointer cs d)
+   in  recourse
diff --git a/Data/StorableVector/Pointer.hs b/Data/StorableVector/Pointer.hs
new file mode 100644
--- /dev/null
+++ b/Data/StorableVector/Pointer.hs
@@ -0,0 +1,52 @@
+{- |
+In principle you can traverse through a storable vector
+using repeated calls to @viewL@ or using @index@.
+However this needs a bit of pointer arrangement and allocation.
+This data structure should make loops optimally fast.
+-}
+module Data.StorableVector.Pointer where
+
+-- import qualified Data.StorableVector as V
+import qualified Data.StorableVector.Base as VB
+
+import qualified Foreign.ForeignPtr as FPtr
+import Foreign.Marshal.Array (advancePtr, )
+import Foreign.Storable (Storable, peek, )
+import Foreign (Ptr, ForeignPtr, )
+-- import System.IO.Unsafe (unsafePerformIO, )
+
+
+{-
+The reference to the ForeignPtr asserts,
+that the array is maintained and thus is not garbage collected.
+The Ptr we use for traversing would not achieve this.
+-}
+{- |
+We might have name the data type iterator.
+-}
+data Pointer a =
+   Pointer {
+      fptr :: {-# UNPACK #-} !(FPtr.ForeignPtr a),
+      ptr  :: {-# UNPACK #-} !(Ptr a),
+      left :: {-# UNPACK #-} !Int
+   }
+
+
+{-# INLINE cons #-}
+cons :: Storable a => VB.Vector a -> Pointer a
+cons (VB.SV fp s l) =
+   Pointer fp (advancePtr (FPtr.unsafeForeignPtrToPtr fp) s) l
+
+
+{-# INLINE viewL #-}
+viewL :: Storable a => Pointer a -> Maybe (a, Pointer a)
+viewL = switchL Nothing (curry Just)
+
+{-# INLINE switchL #-}
+switchL :: Storable a =>
+   b -> (a -> Pointer a -> b) -> Pointer a -> b
+switchL n j (Pointer fp p l) =
+   if l<=0
+     then n
+     else j (VB.inlinePerformIO (peek p)) (Pointer fp (advancePtr p 1) (l-1))
+-- unsafePerformIO at this place would make SpeedPointer test 0.5 s slower
diff --git a/Data/StorableVector/Private.hs b/Data/StorableVector/Private.hs
new file mode 100644
--- /dev/null
+++ b/Data/StorableVector/Private.hs
@@ -0,0 +1,151 @@
+{- |
+Functions that may be useful, but I'm uncertain.
+-}
+module Data.StorableVector.Private where
+
+
+import Data.StorableVector (empty, unfoldrN, viewL, length, )
+import Data.StorableVector.Base
+
+import qualified Data.Strictness.HT as Strict
+
+import Foreign.Storable         (Storable(..))
+
+import System.IO.Unsafe         (unsafePerformIO, )
+
+import Control.DeepSeq (NFData, rnf, deepseq, )
+
+import Prelude hiding (length, )
+
+
+
+{- |
+This implementation is based on viewL
+and thus not as fast as possible.
+-}
+zipWithViewL :: (Storable a, Storable b, Storable c) =>
+   (a -> b -> c) -> Vector a -> Vector b -> Vector c
+zipWithViewL f ps0 qs0 =
+   fst $ unfoldrN
+      (min (length ps0) (length qs0))
+      (\(ps,qs) ->
+         do (ph,pt) <- viewL ps
+            (qh,qt) <- viewL qs
+            return (f ph qh, (pt,qt)))
+      (ps0,qs0)
+
+
+zipWithIndex :: (Storable a, Storable b, Storable c) =>
+   (a -> b -> c) -> Vector a -> Vector b -> Vector c
+zipWithIndex f ps qs =
+   fst $ unfoldrN
+      (min (length ps) (length qs))
+      (\i -> Just (f (unsafeIndex ps i) (unsafeIndex qs i), succ i))
+      0
+
+
+unfoldrStrictN :: (Storable b, NFData a) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
+-- unfoldrStrictN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)
+unfoldrStrictN i f x0 =
+   if i <= 0
+     then (empty, Just x0)
+     else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0
+       {-
+       go must not be strict in the accumulator
+       since otherwise packN would be too strict.
+       -}
+       where
+          go = Strict.arguments3 $ \p n -> \x ->
+             if n == i
+               then return (0, n, Just x)
+               else
+                 case f x of
+                   Nothing     -> return (0, n, Nothing)
+                   Just (w,x') -> do poke p w
+--                                     go (incPtr p) (n+1) $! x'
+                                     go (incPtr p) (n+1) (x' `deepseq` x')
+--                                     seq (rnf x') (((go $! incPtr p) $! n+1) $! x')
+{-# INLINE unfoldrStrictN #-}
+
+unfoldrTransitionN :: (Storable b) => Int -> (a -> a) -> (a -> Maybe b) -> a -> (Vector b, a)
+unfoldrTransitionN n trans emit x =
+   if n <= 0
+     then (empty, x)
+     else unsafePerformIO $ createAndTrim' n $ \p ->
+       case emit x of
+         Nothing -> return (0, n, x)
+         Just y0 -> poke p y0 >>
+           {-
+           go must not be strict in the accumulator
+           since otherwise packN would be too strict.
+           -}
+           let go = Strict.arguments2 $ \p0 i0 -> \x0 ->
+                  {-
+                  We run 'emit' in order to evaluate the new state.
+                  We need to return this new state
+                  also in case the array is full.
+                  The drawback is, that the whole vector becomes undefined
+                  if only the state after the last element is undefined.
+                  This is the same situation as in an unfoldr with strict state.
+                  -}
+                  let i1 = i0-1
+                      x1 = trans x0
+                  in  case emit x1 of
+                         Nothing -> return (0, n-i1, x1)
+                         Just y1 ->
+                            if i1 == 0
+                              then return (0, n, x1)
+                              else
+                                let p1 = incPtr p0
+                                in  do poke p1 y1
+                                       go p1 i1 x1
+{-
+                  let i1 = i0-1
+                  in  if i1 == 0
+                        then return (0, n, x0)
+                        else
+                          let x1 = trans x0
+                              p1 = incPtr p0
+                          in  case emit x1 of
+                                Nothing -> return (0, n-i1, x1)
+                                Just y1 -> do poke p1 y1
+                                              go p1 i1 x1
+-}
+           in  go p n x
+{-# INLINE unfoldrTransitionN #-}
+
+-- | /O(n)/ Like 'unfoldrN' this function builds a 'Vector' from a seed
+-- value.  However, it does always return a state value.
+-- The vector construction can be aborted either by reaching
+-- the given maximum size or by returning 'Nothing' as element.
+--
+-- The following equation relates 'unfoldrN' and 'unfoldrStateN':
+--
+-- > unfoldrN n f s ==
+-- >    unfoldrStateN n
+-- >       (maybe (error "state will be always Just")
+-- >           ((\a -> (fmap fst a, fmap snd a)) . f))
+-- >       (Just s)
+--
+-- It is not possible to express 'unfoldrNState' in terms of 'unfoldrN'.
+--
+unfoldrStateN :: (Storable b) => Int -> (a -> (Maybe b, a)) -> a -> (Vector b, a)
+unfoldrStateN i f x0 =
+   if i <= 0
+     then (empty, x0)
+     else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0
+       {-
+       go must not be strict in the accumulator
+       since otherwise packN would be too strict.
+       -}
+       where
+          go = Strict.arguments2 $ \p n -> \x ->
+             if n == i
+               then return (0, n, x)
+               else
+                 let (my,x') = f x
+                 in  case my of
+                       Nothing -> return (0, n, x)
+                       Just w  -> do poke p w
+                                     go (incPtr p) (n+1) x'
+{-# INLINE unfoldrStateN #-}
diff --git a/Data/StorableVector/ST/Lazy.hs b/Data/StorableVector/ST/Lazy.hs
--- a/Data/StorableVector/ST/Lazy.hs
+++ b/Data/StorableVector/ST/Lazy.hs
@@ -16,7 +16,11 @@
         read,
         write,
         modify,
+        unsafeRead,
+        unsafeWrite,
+        unsafeModify,
         freeze,
+        unsafeFreeze,
         thaw,
         VST.length,
         runSTVector,
@@ -43,25 +47,14 @@
 
 
 
-{-# INLINE new #-}
-{-# INLINE new_ #-}
-{-# INLINE read #-}
-{-# INLINE write #-}
-{-# INLINE modify #-}
-{-# INLINE freeze #-}
-{-# INLINE thaw #-}
-{-# ONLINE length #-}
-{-# INLINE runSTVector #-}
-{-# INLINE mapST #-}
-{-# INLINE mapSTLazy #-}
-
-
 -- * access to mutable storable vector
 
+{-# INLINE new #-}
 new :: (Storable e) =>
    Int -> e -> ST s (Vector s e)
 new n x = ST.strictToLazyST (VST.new n x)
 
+{-# INLINE new_ #-}
 new_ :: (Storable e) =>
    Int -> ST s (Vector s e)
 new_ n  =  ST.strictToLazyST (VST.new_ n)
@@ -69,6 +62,7 @@
 {- |
 > Control.Monad.ST.runST (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; read arr 3)
 -}
+{-# INLINE read #-}
 read :: (Storable e) =>
    Vector s e -> Int -> ST s e
 read xs n = ST.strictToLazyST (VST.read xs n)
@@ -76,24 +70,51 @@
 {- |
 > VS.unpack $ runSTVector (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; return arr)
 -}
+{-# INLINE write #-}
 write :: (Storable e) =>
    Vector s e -> Int -> e -> ST s ()
 write xs n x = ST.strictToLazyST (VST.write xs n x)
 
+{-# INLINE modify #-}
 modify :: (Storable e) =>
    Vector s e -> Int -> (e -> e) -> ST s ()
 modify xs n f = ST.strictToLazyST (VST.modify xs n f)
 
+
+{-# INLINE unsafeRead #-}
+unsafeRead :: (Storable e) =>
+   Vector s e -> Int -> ST s e
+unsafeRead xs n = ST.strictToLazyST (VST.unsafeRead xs n)
+
+{-# INLINE unsafeWrite #-}
+unsafeWrite :: (Storable e) =>
+   Vector s e -> Int -> e -> ST s ()
+unsafeWrite xs n x = ST.strictToLazyST (VST.unsafeWrite xs n x)
+
+{-# INLINE unsafeModify #-}
+unsafeModify :: (Storable e) =>
+   Vector s e -> Int -> (e -> e) -> ST s ()
+unsafeModify xs n f = ST.strictToLazyST (VST.unsafeModify xs n f)
+
+
+{-# INLINE freeze #-}
 freeze :: (Storable e) =>
    Vector s e -> ST s (VS.Vector e)
 freeze xs = ST.strictToLazyST (VST.freeze xs)
 
+{-# INLINE unsafeFreeze #-}
+unsafeFreeze :: (Storable e) =>
+   Vector s e -> ST s (VS.Vector e)
+unsafeFreeze xs = ST.strictToLazyST (VST.unsafeFreeze xs)
+
+{-# INLINE thaw #-}
 thaw :: (Storable e) =>
    VS.Vector e -> ST s (Vector s e)
 thaw xs = ST.strictToLazyST (VST.thaw xs)
 
 
 
+{-# INLINE runSTVector #-}
 runSTVector :: (Storable e) =>
    (forall s. ST s (Vector s e)) -> VS.Vector e
 runSTVector m = VST.runSTVector (ST.lazyToStrictST m)
@@ -106,6 +127,7 @@
 > :module + Data.STRef
 > VS.unpack $ Control.Monad.ST.runST (do ref <- newSTRef 'a'; mapST (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VS.pack [1,2,3,4::Data.Int.Int16]))
 -}
+{-# INLINE mapST #-}
 mapST :: (Storable a, Storable b) =>
    (a -> ST s b) -> VS.Vector a -> ST s (VS.Vector b)
 mapST f xs =
@@ -123,6 +145,7 @@
 > *Data.StorableVector.ST.Strict Data.STRef.Lazy> VL.unpack $ Control.Monad.ST.Lazy.runST (do ref <- newSTRef 'a'; mapSTLazy (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VL.pack VL.defaultChunkSize [0::Data.Int.Int16 ..]))
 > "Interrupted.
 -}
+{-# INLINE mapSTLazy #-}
 mapSTLazy :: (Storable a, Storable b) =>
    (a -> ST s b) -> VL.Vector a -> ST s (VL.Vector b)
 mapSTLazy f (VL.SV xs) =
diff --git a/Data/StorableVector/ST/Private.hs b/Data/StorableVector/ST/Private.hs
--- a/Data/StorableVector/ST/Private.hs
+++ b/Data/StorableVector/ST/Private.hs
@@ -12,11 +12,13 @@
 import qualified Data.StorableVector.Base as V
 import qualified Data.StorableVector as VS
 
+import Data.StorableVector.Memory (mallocForeignPtrArray, )
+
 import qualified Control.Monad.ST.Strict as ST
 import Control.Monad.ST.Strict (ST, unsafeIOToST, )  -- stToIO,
 
 import Foreign.Ptr        (Ptr, )
-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, mallocForeignPtrArray, )
+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, )
 import Foreign.Storable   (Storable, )
 
 -- import Prelude (Int, ($), (+), return, const, )
diff --git a/Data/StorableVector/ST/Strict.hs b/Data/StorableVector/ST/Strict.hs
--- a/Data/StorableVector/ST/Strict.hs
+++ b/Data/StorableVector/ST/Strict.hs
@@ -16,7 +16,11 @@
         read,
         write,
         modify,
+        unsafeRead,
+        unsafeWrite,
+        unsafeModify,
         freeze,
+        unsafeFreeze,
         thaw,
         length,
         runSTVector,
@@ -25,7 +29,7 @@
         ) where
 
 import Data.StorableVector.ST.Private
-          (Vector(SV), unsafeCreate, unsafeToVector, )
+          (Vector(SV), create, unsafeCreate, unsafeToVector, )
 import qualified Data.StorableVector.Base as V
 import qualified Data.StorableVector as VS
 import qualified Data.StorableVector.Lazy as VL
@@ -43,21 +47,9 @@
 import Prelude hiding (read, length, )
 
 
-{-# INLINE new #-}
-{-# INLINE new_ #-}
-{-# INLINE read #-}
-{-# INLINE write #-}
-{-# INLINE modify #-}
-{-# INLINE freeze #-}
-{-# INLINE thaw #-}
-{-# INLINE length #-}
-{-# INLINE runSTVector #-}
-{-# INLINE mapST #-}
-{-# INLINE mapSTLazy #-}
-
-
 -- * access to mutable storable vector
 
+{-# INLINE new #-}
 new :: (Storable e) =>
    Int -> e -> ST s (Vector s e)
 new n x =
@@ -65,10 +57,11 @@
    let {-# INLINE go #-}
        go m p =
          if m>0
-           then poke p x >> go (pred m) (p `advancePtr` 1)
+           then poke p x >> go (pred m) (V.incPtr p)
            else return ()
    in  go n
 
+{-# INLINE new_ #-}
 new_ :: (Storable e) =>
    Int -> ST s (Vector s e)
 new_ n =
@@ -78,35 +71,65 @@
 {- |
 > Control.Monad.ST.runST (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; read arr 3)
 -}
+{-# INLINE read #-}
 read :: (Storable e) =>
    Vector s e -> Int -> ST s e
 read v n =
-   access "read" v n $ peek
+   access "read" v n $ unsafeRead v n
 
 {- |
 > VS.unpack $ runSTVector (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; return arr)
 -}
+{-# INLINE write #-}
 write :: (Storable e) =>
    Vector s e -> Int -> e -> ST s ()
 write v n x =
-   access "write" v n $ \p -> poke p x
+   access "write" v n $ unsafeWrite v n x
 
 {- |
 > VS.unpack $ runSTVector (do arr <- new 10 'a'; Monad.mapM_ (\n -> modify arr (mod n 8) succ) [0..10]; return arr)
 -}
+{-# INLINE modify #-}
 modify :: (Storable e) =>
    Vector s e -> Int -> (e -> e) -> ST s ()
 modify v n f =
-   access "modify" v n $ \p -> poke p . f =<< peek p
+   access "modify" v n $ unsafeModify v n f
 
 {-# INLINE access #-}
 access :: (Storable e) =>
-   String -> Vector s e -> Int -> (Ptr e -> IO a) -> ST s a
-access name (SV v l) n act =
+   String -> Vector s e -> Int -> ST s a -> ST s a
+access name (SV _v l) n act =
    if 0<=n && n<l
-     then unsafeIOToST (withForeignPtr v $ \p -> act (advancePtr p n))
+     then act
      else error ("StorableVector.ST." ++ name ++ ": index out of range")
 
+
+{-# INLINE unsafeRead #-}
+unsafeRead :: (Storable e) =>
+   Vector s e -> Int -> ST s e
+unsafeRead v n =
+   unsafeAccess v n $ peek
+
+{-# INLINE unsafeWrite #-}
+unsafeWrite :: (Storable e) =>
+   Vector s e -> Int -> e -> ST s ()
+unsafeWrite v n x =
+   unsafeAccess v n $ \p -> poke p x
+
+{-# INLINE unsafeModify #-}
+unsafeModify :: (Storable e) =>
+   Vector s e -> Int -> (e -> e) -> ST s ()
+unsafeModify v n f =
+   unsafeAccess v n $ \p -> poke p . f =<< peek p
+
+{-# INLINE unsafeAccess #-}
+unsafeAccess :: (Storable e) =>
+   Vector s e -> Int -> (Ptr e -> IO a) -> ST s a
+unsafeAccess (SV v _l) n act =
+   unsafeIOToST (withForeignPtr v $ \p -> act (advancePtr p n))
+
+
+{-# INLINE freeze #-}
 freeze :: (Storable e) =>
    Vector s e -> ST s (VS.Vector e)
 freeze (SV x l) =
@@ -115,20 +138,35 @@
    withForeignPtr x $ \f ->
    copyArray p f (fromIntegral l)
 
+{- |
+This is like 'freeze' but it does not copy the vector.
+You must make sure that you never write again to the array.
+It is best to use 'unsafeFreeze' only at the end of a block,
+that is run by 'runST'.
+-}
+{-# INLINE unsafeFreeze #-}
+unsafeFreeze :: (Storable e) =>
+   Vector s e -> ST s (VS.Vector e)
+unsafeFreeze = unsafeToVector
 
+
+{-# INLINE thaw #-}
 thaw :: (Storable e) =>
    VS.Vector e -> ST s (Vector s e)
-thaw (V.SV x s l) =
-   unsafeCreate l $ \p ->
-   withForeignPtr x $ \f ->
-   copyArray p (f `advancePtr` s) (fromIntegral l)
+thaw v =
+   unsafeIOToST $
+   V.withStartPtr v $ \f l ->
+   create l $ \p ->
+   copyArray p f (fromIntegral l)
 
 
+{-# INLINE length #-}
 length ::
    Vector s e -> Int
 length (SV _v l) = l
 
 
+{-# INLINE runSTVector #-}
 runSTVector :: (Storable e) =>
    (forall s. ST s (Vector s e)) -> VS.Vector e
 runSTVector m =
@@ -142,6 +180,7 @@
 > :module + Data.STRef
 > VS.unpack $ Control.Monad.ST.runST (do ref <- newSTRef 'a'; mapST (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VS.pack [1,2,3,4::Data.Int.Int16]))
 -}
+{-# INLINE mapST #-}
 mapST :: (Storable a, Storable b) =>
    (a -> ST s b) -> VS.Vector a -> ST s (VS.Vector b)
 mapST f (V.SV px sx n) =
@@ -183,6 +222,7 @@
 > *Data.StorableVector.ST.Strict Data.STRef> VL.unpack $ Control.Monad.ST.runST (do ref <- newSTRef 'a'; mapSTLazy (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VL.pack VL.defaultChunkSize [0::Data.Int.Int16 ..]))
 > "Interrupted.
 -}
+{-# INLINE mapSTLazy #-}
 mapSTLazy :: (Storable a, Storable b) =>
    (a -> ST s b) -> VL.Vector a -> ST s (VL.Vector b)
 mapSTLazy f (VL.SV xs) =
diff --git a/foreign-ptr/fast/Data/StorableVector/Memory.hs b/foreign-ptr/fast/Data/StorableVector/Memory.hs
new file mode 100644
--- /dev/null
+++ b/foreign-ptr/fast/Data/StorableVector/Memory.hs
@@ -0,0 +1,9 @@
+module Data.StorableVector.Memory where
+
+import Foreign.Storable (Storable)
+import Foreign.ForeignPtr (ForeignPtr)
+import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
+
+{-# INLINE mallocForeignPtrArray #-}
+mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a)
+mallocForeignPtrArray = mallocPlainForeignPtrArray
diff --git a/foreign-ptr/jhc/Data/StorableVector/Memory.hs b/foreign-ptr/jhc/Data/StorableVector/Memory.hs
new file mode 100644
--- /dev/null
+++ b/foreign-ptr/jhc/Data/StorableVector/Memory.hs
@@ -0,0 +1,12 @@
+module Data.StorableVector.Memory where
+
+import Foreign.Storable (Storable, sizeOf, )
+import qualified Foreign.ForeignPtr as F
+
+
+{-# INLINE mallocForeignPtrArray #-}
+mallocForeignPtrArray :: Storable a => Int -> IO (F.ForeignPtr a)
+mallocForeignPtrArray =
+   let withSize :: Storable a => a -> (Int -> IO (F.ForeignPtr a)) -> (Int -> IO (F.ForeignPtr a))
+       withSize dummy f n = f (n*sizeOf dummy)
+   in  withSize undefined F.mallocForeignPtrBytes
diff --git a/foreign-ptr/slow/Data/StorableVector/Memory.hs b/foreign-ptr/slow/Data/StorableVector/Memory.hs
new file mode 100644
--- /dev/null
+++ b/foreign-ptr/slow/Data/StorableVector/Memory.hs
@@ -0,0 +1,9 @@
+module Data.StorableVector.Memory where
+
+import Foreign.Storable (Storable)
+import qualified Foreign.ForeignPtr as F
+
+
+{-# INLINE mallocForeignPtrArray #-}
+mallocForeignPtrArray :: Storable a => Int -> IO (F.ForeignPtr a)
+mallocForeignPtrArray = F.mallocForeignPtrArray
diff --git a/slow-foreign-ptr/Data/StorableVector/Memory.hs b/slow-foreign-ptr/Data/StorableVector/Memory.hs
deleted file mode 100644
--- a/slow-foreign-ptr/Data/StorableVector/Memory.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Data.StorableVector.Memory where
-
-import Foreign.Storable (Storable)
-import qualified Foreign.ForeignPtr as F
-
-
-{-# INLINE mallocForeignPtrArray #-}
-mallocForeignPtrArray :: Storable a => Int -> IO (F.ForeignPtr a)
-mallocForeignPtrArray = F.mallocForeignPtrArray
diff --git a/speedtest/Pointer.hs b/speedtest/Pointer.hs
--- a/speedtest/Pointer.hs
+++ b/speedtest/Pointer.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -O -ddump-simpl-stats #-}
+{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl-stats -O2 #-}
 {-  -dverbose-core2core -}
 module Main (main) where
 
@@ -70,10 +70,11 @@
    print $
    SV.foldl' (+) 0 $
    SV.take 10000000 $
-   (case 1 of
+   (case (1::Int) of
       0 -> zipWith (+)
       1 -> zipWithPointer (+)
       2 -> zipWithSize SV.defaultChunkSize (+)
-      3 -> zipWithPointerSize SV.defaultChunkSize (+))
+      3 -> zipWithPointerSize SV.defaultChunkSize (+)
+      _ -> error "invalid choice")
          (SV.iterate SV.defaultChunkSize (subtract 1) 0)
-         (SV.iterate SV.defaultChunkSize (1+) (0::Int16))
+         (SV.iterate SV.defaultChunkSize (1+) (1::Int16))
diff --git a/speedtest/SpeedTestChorus.hs b/speedtest/SpeedTestChorus.hs
new file mode 100644
--- /dev/null
+++ b/speedtest/SpeedTestChorus.hs
@@ -0,0 +1,553 @@
+{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl -O #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-  -dverbose-core2core -ddump-simpl-stats -}
+{-
+This module demonstrates the following:
+mainMonolithic1Generator performs the same computation as mainMonolithic1Compose
+but the former is more than two times slower than latter.
+This is serious since in more complex signal processing programs
+this factor seems to multiply.
+I assume that the problem is that 'mixGen' is not inlined.
+Instead GHC seems to have decided to specialise mixGen.
+In contrast to mainMonolithic1Compose,
+mainMonolithic1Generator uses a data type with existential quantification.
+But this alone is not the problem,
+since mainMonolithic0 and mainMonolithic0Generator run with the same speed.
+
+The program can be compiled using
+> ghc -package storablevector-0.2.5 -O speedtest/SpeedTestChorus.hs
+
+
+Exporting only main causes warnings about unused functions,
+but it also reduces the core output to a third.
+-}
+module Main (main) where
+
+import qualified Data.StorableVector.Lazy.Builder as Builder
+import qualified Data.StorableVector.ST.Strict as SVSTS
+import qualified Data.StorableVector.ST.Lazy   as SVSTL
+import qualified Data.StorableVector as SV
+import qualified Data.StorableVector.Lazy as SVL
+import qualified Data.StorableVector.Private as SVP
+
+import qualified Control.Monad.ST.Strict as StrictST
+import Control.Monad.ST.Lazy (ST, runST, strictToLazyST, )
+
+import Foreign.Storable (Storable, )
+import GHC.Float (float2Int, int2Float, double2Int, int2Double, )
+
+import qualified Sound.Frame.Stereo as Stereo
+
+-- import qualified Data.Strictness.HT as Strict
+
+import Control.Monad (guard, zipWithM, )
+import Data.Monoid (mempty, mappend, )
+
+
+{-
+I started with Storable instance for pairs from storable-tuple,
+that was implemented using the storable-record framework at this time.
+I got run-time around 5 seconds.
+When I used inlining then the computation time increased to 8s!
+Then I switch to sample-frame:Sound.Frame.Stereo
+computation time dropped to 1.4 seconds.
+At this time I already switched back
+from the storable-record based implementation to a custom one
+of the Storable Stereo instance.
+With this implementation inlining doesn't change the run-time.
+But then I noted that the generated file
+contained only one saw wave tone.
+This problem disappeared by not using -O2 option, but only -O.
+Monolithic and chunky require about 2.6 seconds,
+whereas monolithicStrict needs 3.8 seconds.
+After inlining monolithicStrict needs 1.8 seconds.
+-}
+
+type Phase = (Float, Float, Float)
+
+{-# INLINE saw #-}
+saw :: Num a => a -> a
+saw t = 1-2*t
+
+{-# INLINE sawChorus #-}
+sawChorus :: Phase -> Float
+sawChorus (pl0,pl1,pl2) =
+   0.3 * (saw pl0 + saw pl1 + saw pl2)
+
+{-
+Much faster than @snd . properFraction@ but fails for large numbers.
+-}
+class (Num a, Ord a) => Fraction a where
+   fraction :: a -> a
+
+instance Fraction Float where
+   {-# INLINE fraction #-}
+   fraction x = x - int2Float (float2Int x)
+
+instance Fraction Double where
+   {-# INLINE fraction #-}
+   fraction x = x - int2Double (double2Int x)
+
+{-
+fraction = Strict.arguments1 $ \x ->
+   let y = x - int2Float (float2Int x)
+   in  y
+-}
+{-
+   in  if y<0
+         then y+1
+         else y
+-}
+{-
+   if x==0
+     then 0
+     else x - int2Float (float2Int x)
+-}
+--   rnf x `seq` x - int2Float (float2Int x)
+
+
+{-# INLINE generator0Freq #-}
+generator0Freq ::
+   Fraction a => a -> a -> Maybe (a, a)
+generator0Freq freq =
+   \p -> Just (saw p, fraction (p+freq))
+
+{-# INLINE generator0 #-}
+generator0 ::
+   Float -> Maybe (Float, Float)
+generator0 = generator0Freq 0.01
+
+
+{-# INLINE tone0 #-}
+tone0 :: Float -> Float -> SVL.Vector Float
+tone0 freq phase =
+   SVL.unfoldr SVL.defaultChunkSize (generator0Freq freq) phase
+
+
+{-# INLINE runLoopSTStrict #-}
+runLoopSTStrict ::
+   (Storable a) =>
+   Int -> (s -> Maybe (a, s)) -> s -> SV.Vector a
+runLoopSTStrict n f s =
+   SVSTS.runSTVector
+      (do v <- SVSTS.new_ n
+          let go i s0 =
+                if i<n
+                  then
+                    case f s0 of
+                       Nothing -> return v
+                       Just (a,s1) ->
+--                          SVSTS.write v i a >> go (succ i) s1
+                          SVSTS.unsafeWrite v i a >> go (succ i) s1
+                  else return v
+          go 0 s)
+
+{-# INLINE runLoopSTLazy #-}
+runLoopSTLazy ::
+   (Storable a) =>
+   Int -> (s -> Maybe (a, s)) -> s -> SV.Vector a
+runLoopSTLazy n f s =
+   SVSTL.runSTVector
+      (do v <- SVSTL.new_ n
+          let go s0 i =
+                if i<n
+                  then
+                    case f s0 of
+                       Nothing -> return v
+                       Just (a,s1) ->
+                          {-
+                          Strict pattern matching on () is necessary
+                          in order to avoid a memory leak.
+                          Working in ST.Lazy is still
+                          three times slower than ST.Strict
+                          -}
+                          strictToLazyST (SVSTS.unsafeWrite v i a >> return (succ i))
+                           >>= go s1
+--                          SVSTL.unsafeWrite v i a >>= \() -> go s1 (succ i)
+--                          SVSTL.unsafeWrite v i a >> go s1 (succ i)
+                  else return v
+          go s 0)
+
+
+{-# INLINE mixST #-}
+mixST :: (Storable a, Num a) =>
+   SVSTS.Vector s a -> (st -> Maybe (a, st)) -> st -> StrictST.ST s Int
+mixST v f s =
+   let go i s0 =
+         if i < SVSTS.length v
+           then
+             case f s0 of
+                Nothing -> return i
+                Just (a,s1) ->
+                   SVSTS.unsafeWrite v i a >> go (succ i) s1
+           else return i
+   in  go 0 s
+
+{-# INLINE mixSTGuard #-}
+mixSTGuard :: (Storable a, Num a) =>
+   SVSTS.Vector s a -> (st -> Maybe (a, st)) -> st -> StrictST.ST s Int
+mixSTGuard v f s =
+   let go i s0 =
+          case guard (i < SVSTS.length v) >> f s0 of
+             Nothing -> return i
+             Just (a,s1) ->
+                SVSTS.unsafeWrite v i a >> go (succ i) s1
+   in  go 0 s
+
+
+
+{-# INLINE runBuilder #-}
+runBuilder ::
+   (Storable a) =>
+   SVL.ChunkSize -> (s -> Maybe (a, s)) -> s -> SVL.Vector a
+runBuilder chunkSize f s =
+   Builder.toLazyStorableVector chunkSize
+      (let go s0 =
+              case f s0 of
+                 Nothing -> mempty
+                 Just (a,s1) ->
+                    mappend (Builder.put a) (go s1)
+       in  go s)
+
+
+infixl 6 `mix`, `mixGen`, `mixVec`
+
+{- |
+Build a generator from two other generators
+by handling their state in parallel and mix their results.
+-}
+{-# INLINE mix #-}
+mix ::
+   (Num y) =>
+   (s -> Maybe (y, s)) ->
+   (t -> Maybe (y, t)) ->
+   ((s,t) -> Maybe (y, (s,t)))
+mix f g (s0,t0) =
+   do (a,s1) <- f s0
+      (b,t1) <- g t0
+      return ((a+b), (s1,t1))
+
+
+{- |
+This is like a list without storage.
+It is like stream-fusion:Data.Stream
+but without Skip constructor.
+-}
+data Generator a =
+   forall s.
+      Generator (s -> Maybe (a, s)) s
+
+{-# INLINE runGeneratorMonolithic #-}
+runGeneratorMonolithic :: Storable a => Int -> Generator a -> SV.Vector a
+runGeneratorMonolithic size (Generator f s) =
+   fst $ SV.unfoldrN size f s
+
+{- SPECIALISE INLINE generator0Gen :: Float -> Float -> Generator Float -}
+{-# INLINE generator0Gen #-}
+generator0Gen ::
+   Fraction a => a -> a -> Generator a
+generator0Gen freq phase =
+   Generator (\p -> Just (saw p, fraction (p+freq))) phase
+
+{- SPECIALISE INLINE mixGen :: Generator Float -> Generator Float -> Generator Float -}
+{-# INLINE mixGen #-}
+mixGen ::
+   (Num y) =>
+   Generator y ->
+   Generator y ->
+   Generator y
+mixGen (Generator f s) (Generator g t) =
+   Generator (\(s0,t0) ->
+      do (a,s1) <- f s0
+         (b,t1) <- g t0
+         return ((a+b), (s1,t1))) (s,t)
+
+
+
+{-# INLINE incPhase #-}
+incPhase :: Phase -> Phase -> Phase
+incPhase (d0,d1,d2) (p0,p1,p2) =
+   (fraction (p0+d0), fraction (p1+d1), fraction (p2+d2))
+
+{-# INLINE generator1 #-}
+generator1 ::
+   Phase -> Maybe (Float, Phase)
+generator1 =
+   \p -> Just (sawChorus p, incPhase dl p)
+
+
+{-# SPECIALISE mixVec :: SVL.Vector Float -> SVL.Vector Float -> SVL.Vector Float #-}
+{- disabled INLINE mixVec -}
+mixVec ::
+   (Num y, Storable y) =>
+   SVL.Vector y ->
+   SVL.Vector y ->
+   SVL.Vector y
+mixVec xs0 ys0 =
+   let recourse xt@(x:_) yt@(y:_) =
+          let z = SV.zipWith (+) x y
+              n = SV.length z
+          in  z : recourse
+                     (SVL.chunks $ SVL.drop n $ SVL.fromChunks xt)
+                     (SVL.chunks $ SVL.drop n $ SVL.fromChunks yt)
+       recourse xs [] = xs
+       recourse [] ys = ys
+   in  SVL.fromChunks $
+       recourse (SVL.chunks xs0) (SVL.chunks ys0)
+
+
+{-# INLINE generator2 #-}
+generator2 ::
+   (Phase, Phase) -> Maybe (Stereo.T Float, (Phase, Phase))
+generator2 =
+   \(pl, pr) ->
+      Just (Stereo.cons (sawChorus pl) (sawChorus pr),
+         (incPhase dl pl, incPhase dr pr))
+
+{-# INLINE dl #-}
+{-# INLINE dr #-}
+dl, dr :: Phase
+(dl,dr) =
+   ((0.01008, 0.01003, 0.00990),
+    (0.00992, 0.00997, 0.01010))
+
+{-# INLINE initPhase2 #-}
+initPhase2 :: (Phase, Phase)
+initPhase2 =
+   ((0,0.7,0.1), (0.3,0.4,0.6))
+
+
+size :: Int
+size = 10000000
+
+mainMonolithic0 :: IO ()
+mainMonolithic0 =
+   SV.writeFile "speed.f32"
+      (fst $ SV.unfoldrN size generator0 0)
+{-
+real    0m0.423s
+user    0m0.256s
+sys     0m0.152s
+-}
+
+mainMonolithic0Generator :: IO ()
+mainMonolithic0Generator =
+   SV.writeFile "speed.f32"
+      (runGeneratorMonolithic size
+          (generator0Gen (0.01::Float) 0))
+
+mainMonolithic0STStrict :: IO ()
+mainMonolithic0STStrict =
+   SV.writeFile "speed.f32"
+      (runLoopSTStrict size (generator0Freq (0.01::Float)) 0)
+{-
+real    0m0.430s
+user    0m0.288s
+sys     0m0.132s
+-}
+
+mainMonolithic0STLazy :: IO ()
+mainMonolithic0STLazy =
+   SV.writeFile "speed.f32"
+      (runLoopSTLazy size (generator0Freq (0.01::Float)) 0)
+{-
+real    0m0.886s
+user    0m0.752s
+sys     0m0.128s
+-}
+
+mainMonolithic0STMix :: IO ()
+mainMonolithic0STMix =
+   SV.writeFile "speed.f32" $
+   StrictST.runST
+      (do v <- SVSTS.new size 0
+          l <- mixSTGuard v (generator0Freq (0.01::Float)) 0
+          fmap (SV.take l) (SVSTS.unsafeFreeze v))
+{-
+real    0m0.505s
+user    0m0.344s
+sys     0m0.156s
+-}
+
+mainMonolithic1 :: IO ()
+mainMonolithic1 =
+   SV.writeFile "speed.f32"
+      (fst $ SV.unfoldrN size generator1 (fst initPhase2))
+
+mainMonolithic1Composed :: IO ()
+mainMonolithic1Composed =
+   SV.writeFile "speed.f32"
+      (fst $ SV.unfoldrN size
+          (let (f0,f1,f2) = dl
+           in  generator0Freq f0 `mix`
+               generator0Freq f1 `mix`
+               generator0Freq f2)
+          (let (p0,p1,p2) = fst initPhase2
+           in  ((p0,p1),p2)))
+{-
+real    0m0.974s
+user    0m0.812s
+sys     0m0.160s
+-}
+
+mainMonolithic1Generator :: IO ()
+mainMonolithic1Generator =
+   SV.writeFile "speed.f32"
+      (runGeneratorMonolithic size
+          (let (f0,f1,f2) = dl
+               (p0,p1,p2) = fst initPhase2
+           in  generator0Gen f0 p0 `mixGen`
+               generator0Gen f1 p1 `mixGen`
+               generator0Gen f2 p2))
+{-
+real    0m2.244s
+user    0m2.084s
+sys     0m0.152s
+-}
+
+mainMonolithic1GeneratorFold :: IO ()
+mainMonolithic1GeneratorFold =
+   SV.writeFile "speed.f32"
+      (runGeneratorMonolithic size
+          (let (f0,f1,f2) = dl
+               (p0,p1,p2) = fst initPhase2
+           in  foldl1 mixGen $
+               map (uncurry generator0Gen) $
+               [(f0,p0), (f1,p1), (f2,p2)]))
+{-
+real    0m3.006s
+user    0m2.816s
+sys     0m0.180s
+-}
+
+mainMonolithic1STMix :: IO ()
+mainMonolithic1STMix =
+   SV.writeFile "speed.f32" $
+   StrictST.runST
+      (do v <- SVSTS.new size 0
+          let (f0,f1,f2) = dl
+              (p0,p1,p2) = fst initPhase2
+          l0 <- mixSTGuard v (generator0Freq f0) p0
+          l1 <- mixSTGuard v (generator0Freq f1) p1
+          l2 <- mixSTGuard v (generator0Freq f2) p2
+          fmap (SV.take (l0 `min` l1 `min` l2)) (SVSTS.unsafeFreeze v))
+{-
+real    0m1.895s
+user    0m1.684s
+sys     0m0.180s
+-}
+
+mainMonolithic1STMixZip :: IO ()
+mainMonolithic1STMixZip =
+   SV.writeFile "speed.f32" $
+   StrictST.runST
+      (do v <- SVSTS.new size 0
+          let (f0,f1,f2) = dl
+              (p0,p1,p2) = fst initPhase2
+          ls <- zipWithM (mixSTGuard v . generator0Freq)
+                   [f0,f1,f2] [p0,p1,p2]
+          fmap (SV.take (minimum ls)) (SVSTS.unsafeFreeze v))
+{-
+real    0m1.391s
+user    0m1.232s
+sys     0m0.160s
+-}
+
+mainMonolithic2 :: IO ()
+mainMonolithic2 =
+   SV.writeFile "speed.f32"
+      (fst $ SV.unfoldrN size generator2 initPhase2)
+
+mainMonolithicStrict2 :: IO ()
+mainMonolithicStrict2 =
+   SV.writeFile "speed.f32"
+      (fst $ SVP.unfoldrStrictN size generator2 initPhase2)
+
+mainMonolithicTransition2 :: IO ()
+mainMonolithicTransition2 =
+   SV.writeFile "speed.f32"
+      (fst $ SVP.unfoldrTransitionN size
+          (\(pl,pr) -> (incPhase dl pl, incPhase dr pr))
+          (\(pl,pr) ->
+              Just (Stereo.cons (sawChorus pl) (sawChorus pr)))
+          initPhase2)
+
+
+mainChunky0 :: IO ()
+mainChunky0 =
+   SVL.writeFile "speed.f32"
+      (SVL.take size $
+       SVL.unfoldr SVL.defaultChunkSize generator0 0)
+{-
+real    0m0.428s
+user    0m0.292s
+sys     0m0.132s
+-}
+
+mainChunky0Builder :: IO ()
+mainChunky0Builder =
+   SVL.writeFile "speed.f32"
+      (SVL.take size $
+       runBuilder SVL.defaultChunkSize generator0 0)
+{-
+real    0m1.107s
+user    0m0.968s
+sys     0m0.140s
+-}
+
+mainChunky1 :: IO ()
+mainChunky1 =
+   SVL.writeFile "speed.f32"
+      (SVL.take size $
+       SVL.unfoldr SVL.defaultChunkSize generator1 (fst initPhase2))
+{-
+real    0m0.938s
+user    0m0.812s
+sys     0m0.116s
+-}
+
+mainChunky1MixFlat :: IO ()
+mainChunky1MixFlat =
+   SVL.writeFile "speed.f32"
+      (let (f0,f1,f2) = dl
+           (p0,p1,p2) = fst initPhase2
+       in  SVL.take size $
+           tone0 f0 p0 `mixVec`
+           tone0 f1 p1 `mixVec`
+           tone0 f2 p2)
+{-
+real    0m3.932s
+user    0m2.112s
+sys     0m0.156s
+-}
+
+mainChunky1MixFold :: IO ()
+mainChunky1MixFold =
+   SVL.writeFile "speed.f32"
+      (let (f0,f1,f2) = dl
+           (p0,p1,p2) = fst initPhase2
+       in  SVL.take size $
+           foldl1 mixVec $
+           map (uncurry tone0) $
+           [(f0,p0), (f1,p1), (f2,p2)])
+{-
+real    0m1.611s
+user    0m1.476s
+sys     0m0.108s
+-}
+
+mainChunky2 :: IO ()
+mainChunky2 =
+   SVL.writeFile "speed.f32"
+      (SVL.take size $
+       SVL.unfoldr SVL.defaultChunkSize generator2 initPhase2)
+{-
+real    0m2.220s
+user    0m1.400s
+sys     0m0.192s
+-}
+
+main :: IO ()
+main =
+   mainMonolithic1STMixZip
+--   mainMonolithic1GeneratorFold
diff --git a/speedtest/SpeedTestLazy.hs b/speedtest/SpeedTestLazy.hs
deleted file mode 100644
--- a/speedtest/SpeedTestLazy.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# OPTIONS_GHC -O -ddump-simpl-stats #-}
-{-  -dverbose-core2core -}
-module Main (main) where
-
-import qualified Data.StorableVector.Lazy as SV
-
-import Data.Int (Int16)
-
-
-
-main :: IO ()
-main =
-   SV.writeFile "speed-lazy.sw"
-      (SV.take 10000000 $
-       SV.unfoldr (SV.ChunkSize 10000)
-          (\x -> let y = mod (succ x) 10000
-                 in  Just (x,y)) (0::Int16))
diff --git a/storablevector.cabal b/storablevector.cabal
--- a/storablevector.cabal
+++ b/storablevector.cabal
@@ -1,5 +1,5 @@
 Name:                storablevector
-Version:             0.2.4
+Version:             0.2.5
 Category:            Data
 Synopsis:            Fast, packed, strict storable arrays with a list interface like ByteString
 Description:
@@ -16,7 +16,7 @@
     We do not provide advanced fusion optimization,
     since especially for lazy vectors
     this would either be incorrect or not applicable.
-    For fusion see @storablevector-streamfusion@ package.
+    For fusion see <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/storablevector-streamfusion>.
 License:             BSD3
 License-file:        LICENSE
 Author:              Spencer Janssen <sjanssen@cse.unl.edu>, Henning Thielemann <storablevector@henning-thielemann.de>
@@ -24,8 +24,12 @@
 Homepage:            http://www.haskell.org/haskellwiki/Storable_Vector
 Stability:           Experimental
 Build-Type:          Simple
-Tested-With:         GHC==6.8.2
+Tested-With:         GHC==6.8.2, JHC==0.7.3
 Cabal-Version:       >=1.6
+Extra-Source-Files:
+  foreign-ptr/fast/Data/StorableVector/Memory.hs
+  foreign-ptr/slow/Data/StorableVector/Memory.hs
+  foreign-ptr/jhc/Data/StorableVector/Memory.hs
 
 Flag splitBase
   description: Choose the new smaller, split-up base package.
@@ -33,6 +37,9 @@
 Flag separateSYB
   description: Data.Generics available in separate package.
 
+Flag functorInstance
+  description: Use a custom Functor instance for pairs and functions
+
 Flag buildTests
   description: Build test executables
   default:     False
@@ -44,31 +51,40 @@
 Source-Repository this
   type:     darcs
   location: http://code.haskell.org/storablevector/
-  tag:      0.2.4
+  tag:      0.2.5
 
 Library
   Build-Depends:
     non-negative >= 0.0.4 && <0.1,
     utility-ht >= 0.0.5 && <0.1,
     transformers >=0.0 && <0.2
-  If flag(splitBase)
-    If flag(separateSYB)
-      Build-Depends:
-        base >=4 && <5,
-        syb >=0.1 && <0.2
-    Else
-      Build-Depends:
-        base >=3 && <4
+
+  If impl(jhc)
+    Hs-Source-Dirs: foreign-ptr/jhc
+    Build-Depends:
+      statethread >=0.1 && <0.2,
+      base >=1 && <2
   Else
-    Build-Depends: base >=1 && <2
+    Hs-Source-Dirs: foreign-ptr/slow
+    If flag(splitBase)
+      If flag(separateSYB)
+        Build-Depends:
+          base >=4 && <5,
+          syb >=0.1 && <0.2
+      Else
+        Build-Depends:
+          base >=3 && <4
+    Else
+      Build-Depends: base >=1 && <2
 
   Extensions:          CPP, ForeignFunctionInterface
   GHC-Options:         -Wall -funbox-strict-fields
-  Hs-Source-Dirs:      ., slow-foreign-ptr
+  Hs-Source-Dirs:      .
 
   Exposed-Modules:
     Data.StorableVector
     Data.StorableVector.Base
+    Data.StorableVector.Pointer
     Data.StorableVector.Lazy
     Data.StorableVector.Lazy.Builder
     Data.StorableVector.Lazy.Pattern
@@ -76,51 +92,71 @@
     Data.StorableVector.ST.Strict
     Data.StorableVector.ST.Lazy
 
+  If !impl(jhc)
+    Other-Modules:
+      -- Cursor has no mature interface so far
+      Data.StorableVector.Cursor
+
   Other-Modules:
-    -- Cursor has no mature interface so far
-    Data.StorableVector.Cursor
     Data.StorableVector.Memory
     Data.StorableVector.ST.Private
     Data.StorableVector.Lazy.PointerPrivate
+    Data.StorableVector.Lazy.PointerPrivateIndex
 
 
 
 Executable test
   GHC-Options:         -Wall -funbox-strict-fields
-  Hs-Source-Dirs:      ., slow-foreign-ptr, tests
+  Hs-Source-Dirs:      ., foreign-ptr/slow, tests
   Main-Is:             tests.hs
   Other-Modules:       QuickCheckUtils, Instances
-  Build-Depends:       bytestring >= 0.9 && < 0.10, QuickCheck >= 1 && < 2
   Extensions:          CPP, ForeignFunctionInterface
-  If flag(splitBase)
-    Hs-Source-Dirs:    tests-2
-    Build-Depends:     base >= 3 && <5, random >= 1.0 && < 1.1
+  If flag(buildTests)
+    Build-Depends:
+      bytestring >= 0.9 && < 0.10,
+      QuickCheck >= 1 && < 2
+    If flag(splitBase)
+      Build-Depends:     random >= 1.0 && < 1.1
+      If flag(functorInstance)
+        Hs-Source-Dirs:    tests-2
+        Build-Depends:     base >= 3 && <4
+      Else
+        Hs-Source-Dirs:    tests-1
+        Build-Depends:     base >= 4 && <5
+    Else
+      Hs-Source-Dirs:    tests-1
+      Build-Depends:     base >= 1.0 && < 2
   Else
-    Hs-Source-Dirs:    tests-1
-    Build-Depends:     base >= 1.0 && < 2
-  if !flag(buildTests)
-    buildable:         False
+    Buildable:         False
 
 Executable speedtest
-  GHC-Options:         -Wall -funbox-strict-fields
-  Main-Is:             SpeedTestLazy.hs
+  GHC-Options:         -Wall
+  -- -fvia-C -optc-ffast-math -optc-O3 -optc-ftree-vectorize
+  Main-Is:             SpeedTestChorus.hs
+  Other-Modules:
+    Data.StorableVector.Private
   Extensions:          CPP, ForeignFunctionInterface
-  Hs-Source-Dirs:      ., slow-foreign-ptr, speedtest
-  If flag(splitBase)
-    Build-Depends:     base >= 3 && <5
+  Hs-Source-Dirs:      ., foreign-ptr/slow, speedtest
+  If flag(buildTests)
+    Build-Depends:
+      sample-frame >=0.0.1 && <0.1,
+      deepseq >=1.1 && <1.2
+    If flag(splitBase)
+      Build-Depends:   base >= 3 && <5
+    Else
+      Build-Depends:   base >= 1.0 && < 2
   Else
-    Build-Depends:     base >= 1.0 && < 2
-  If !flag(buildTests)
     Buildable:         False
 
 Executable speedpointer
-  GHC-Options:         -Wall -funbox-strict-fields
+  GHC-Options:         -Wall
   Main-Is:             Pointer.hs
   Extensions:          CPP, ForeignFunctionInterface
-  Hs-Source-Dirs:      ., slow-foreign-ptr, speedtest
-  If flag(splitBase)
-    Build-Depends:     base >= 3 && <5
+  Hs-Source-Dirs:      ., foreign-ptr/slow, speedtest
+  If flag(buildTests)
+    If flag(splitBase)
+      Build-Depends:   base >= 3 && <5
+    Else
+      Build-Depends:   base >= 1.0 && < 2
   Else
-    Build-Depends:     base >= 1.0 && < 2
-  If !flag(buildTests)
     Buildable:         False
diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs
--- a/tests/QuickCheckUtils.hs
+++ b/tests/QuickCheckUtils.hs
@@ -223,6 +223,3 @@
 class    IsNull t            where isNull :: t -> Bool
 instance IsNull P.ByteString where isNull = P.null
 instance IsNull V            where isNull = V.null
-
-instance Show V where
-    show = show . V.unpack
diff --git a/tests/tests.hs b/tests/tests.hs
--- a/tests/tests.hs
+++ b/tests/tests.hs
@@ -34,6 +34,7 @@
 prop_isPrefixOfVP   = (V.isPrefixOf :: V -> V -> Bool) `eq2`  P.isPrefixOf
 prop_mapVP          = (V.map :: (W -> W) -> V -> V)        `eq2`  P.map
 prop_replicateVP    = (V.replicate :: X -> W -> V)  `eq2`  P.replicate
+prop_iterateVP      = (V.iterateN :: X -> (W -> W) -> W -> V)  `eq3`  (\n f -> P.pack . take n . iterate f)
 prop_snocVP         = (V.snoc :: V -> W -> V)       `eq2`  P.snoc
 prop_spanVP         = (V.span :: (W -> Bool) -> V -> (V, V))       `eq2`  P.span
 prop_splitVP        = (V.split :: W -> V -> [V])      `eq2`  P.split
@@ -127,6 +128,7 @@
     ,("scanr",       mytest prop_scanrVP)
     ,("transpose",   mytest prop_transposeVP)
     ,("replicate",   mytest prop_replicateVP)
+    ,("iterateN",    mytest prop_iterateVP)
     ,("take",        mytest prop_takeVP)
     ,("drop",        mytest prop_dropVP)
     ,("splitAt",     mytest prop_splitAtVP)