From a5d14b70e70a93b2dec29fc0dfa7940488dc264a Mon Sep 17 00:00:00 2001
From: Alberto Ruiz <aruiz@um.es>
Date: Fri, 5 Jun 2015 16:53:45 +0200
Subject: move internal vector

---
 packages/base/src/Data/Packed/Internal/Vector.hs | 496 -----------------------
 packages/base/src/Data/Packed/Vector.hs          | 125 ------
 packages/base/src/Internal/Vector.hs             | 447 ++++++++++++++++++++
 3 files changed, 447 insertions(+), 621 deletions(-)
 delete mode 100644 packages/base/src/Data/Packed/Internal/Vector.hs
 delete mode 100644 packages/base/src/Data/Packed/Vector.hs
 create mode 100644 packages/base/src/Internal/Vector.hs

(limited to 'packages/base')

diff --git a/packages/base/src/Data/Packed/Internal/Vector.hs b/packages/base/src/Data/Packed/Internal/Vector.hs
deleted file mode 100644
index 8cb77b0..0000000
--- a/packages/base/src/Data/Packed/Internal/Vector.hs
+++ /dev/null
@@ -1,496 +0,0 @@
-{-# LANGUAGE MagicHash, CPP, UnboxedTuples, BangPatterns, FlexibleContexts #-}
--- |
--- Module      :  Data.Packed.Internal.Vector
--- Copyright   :  (c) Alberto Ruiz 2007
--- License     :  BSD3
--- Maintainer  :  Alberto Ruiz
--- Stability   :  provisional
---
--- Vector implementation
---
---------------------------------------------------------------------------------
-
-module Data.Packed.Internal.Vector (
-    Vector, dim,
-    fromList, toList, (|>),
-    vjoin, (@>), safe, at, at', subVector, takesV,
-    mapVector, mapVectorWithIndex, zipVectorWith, unzipVectorWith,
-    mapVectorM, mapVectorM_, mapVectorWithIndexM, mapVectorWithIndexM_,
-    foldVector, foldVectorG, foldLoop, foldVectorWithIndex,
-    createVector, vec,
-    asComplex, asReal, float2DoubleV, double2FloatV, double2IntV, int2DoubleV, float2IntV, int2floatV,
-    stepF, stepD, stepI, condF, condD, condI,
-    conjugateQ, conjugateC,
-    cloneVector,
-    unsafeToForeignPtr,
-    unsafeFromForeignPtr,
-    unsafeWith,
-    CInt, I
-) where
-
-import Data.Packed.Internal.Common
-import Data.Packed.Internal.Signatures
-import Foreign.Marshal.Array(peekArray, copyArray, advancePtr)
-import Foreign.ForeignPtr(ForeignPtr, castForeignPtr)
-import Foreign.Ptr(Ptr)
-import Foreign.Storable(Storable, peekElemOff, pokeElemOff, sizeOf)
-import Foreign.C.Types
-import Data.Complex
-import System.IO.Unsafe(unsafePerformIO)
-
-#if __GLASGOW_HASKELL__ >= 605
-import GHC.ForeignPtr           (mallocPlainForeignPtrBytes)
-#else
-import Foreign.ForeignPtr       (mallocForeignPtrBytes)
-#endif
-
-import GHC.Base
-#if __GLASGOW_HASKELL__ < 612
-import GHC.IOBase hiding (liftIO)
-#endif
-
-import qualified Data.Vector.Storable as Vector
-import Data.Vector.Storable(Vector,
-                            fromList,
-                            unsafeToForeignPtr,
-                            unsafeFromForeignPtr,
-                            unsafeWith)
-
-type I = CInt
-
--- | Number of elements
-dim :: (Storable t) => Vector t -> Int
-dim = Vector.length
-
-
--- C-Haskell vector adapter
--- vec :: Adapt (CInt -> Ptr t -> r) (Vector t) r
-vec :: (Storable t) => Vector t -> (((CInt -> Ptr t -> t1) -> t1) -> IO b) -> IO b
-vec x f = unsafeWith x $ \p -> do
-    let v g = do
-        g (fi $ dim x) p
-    f v
-{-# INLINE vec #-}
-
-
--- allocates memory for a new vector
-createVector :: Storable a => Int -> IO (Vector a)
-createVector n = do
-    when (n < 0) $ error ("trying to createVector of negative dim: "++show n)
-    fp <- doMalloc undefined
-    return $ unsafeFromForeignPtr fp 0 n
-  where
-    --
-    -- Use the much cheaper Haskell heap allocated storage
-    -- for foreign pointer space we control
-    --
-    doMalloc :: Storable b => b -> IO (ForeignPtr b)
-    doMalloc dummy = do
-#if __GLASGOW_HASKELL__ >= 605
-        mallocPlainForeignPtrBytes (n * sizeOf dummy)
-#else
-        mallocForeignPtrBytes      (n * sizeOf dummy)
-#endif
-
-{- | creates a Vector from a list:
-
-@> fromList [2,3,5,7]
-4 |> [2.0,3.0,5.0,7.0]@
-
--}
-
-safeRead v = inlinePerformIO . unsafeWith v
-{-# INLINE safeRead #-}
-
-inlinePerformIO :: IO a -> a
-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
-{-# INLINE inlinePerformIO #-}
-
-{- extracts the Vector elements to a list
-
->>> toList (linspace 5 (1,10))
-[1.0,3.25,5.5,7.75,10.0]
-
--}
-toList :: Storable a => Vector a -> [a]
-toList v = safeRead v $ peekArray (dim v)
-
-{- | Create a vector from a list of elements and explicit dimension. The input
-     list is explicitly truncated if it is too long, so it may safely
-     be used, for instance, with infinite lists.
-
->>> 5 |> [1..]
-fromList [1.0,2.0,3.0,4.0,5.0]
-
--}
-(|>) :: (Storable a) => Int -> [a] -> Vector a
-infixl 9 |>
-n |> l = if length l' == n
-            then fromList l'
-            else error "list too short for |>"
-  where l' = take n l
-
-
--- | access to Vector elements without range checking
-at' :: Storable a => Vector a -> Int -> a
-at' v n = safeRead v $ flip peekElemOff n
-{-# INLINE at' #-}
-
---
--- turn off bounds checking with -funsafe at configure time.
--- ghc will optimise away the salways true case at compile time.
---
-#if defined(UNSAFE)
-safe :: Bool
-safe = False
-#else
-safe = True
-#endif
-
--- | access to Vector elements with range checking.
-at :: Storable a => Vector a -> Int -> a
-at v n
-    | safe      = if n >= 0 && n < dim v
-                    then at' v n
-                    else error "vector index out of range"
-    | otherwise = at' v n
-{-# INLINE at #-}
-
-{- | takes a number of consecutive elements from a Vector
-
->>> subVector 2 3 (fromList [1..10])
-fromList [3.0,4.0,5.0]
-
--}
-subVector :: Storable t => Int       -- ^ index of the starting element
-                        -> Int       -- ^ number of elements to extract
-                        -> Vector t  -- ^ source
-                        -> Vector t  -- ^ result
-subVector = Vector.slice
-
-
-{- | Reads a vector position:
-
->>> fromList [0..9] @> 7
-7.0
-
--}
-(@>) :: Storable t => Vector t -> Int -> t
-infixl 9 @>
-(@>) = at
-
-
-{- | concatenate a list of vectors
-
->>> vjoin [fromList [1..5::Double], konst 1 3]
-fromList [1.0,2.0,3.0,4.0,5.0,1.0,1.0,1.0]
-
--}
-vjoin :: Storable t => [Vector t] -> Vector t
-vjoin [] = fromList []
-vjoin [v] = v
-vjoin as = unsafePerformIO $ do
-    let tot = sum (map dim as)
-    r <- createVector tot
-    unsafeWith r $ \ptr ->
-        joiner as tot ptr
-    return r
-  where joiner [] _ _ = return ()
-        joiner (v:cs) _ p = do
-            let n = dim v
-            unsafeWith v $ \pb -> copyArray p pb n
-            joiner cs 0 (advancePtr p n)
-
-
-{- | Extract consecutive subvectors of the given sizes.
-
->>> takesV [3,4] (linspace 10 (1,10::Double))
-[fromList [1.0,2.0,3.0],fromList [4.0,5.0,6.0,7.0]]
-
--}
-takesV :: Storable t => [Int] -> Vector t -> [Vector t]
-takesV ms w | sum ms > dim w = error $ "takesV " ++ show ms ++ " on dim = " ++ (show $ dim w)
-            | otherwise = go ms w
-    where go [] _ = []
-          go (n:ns) v = subVector 0 n v
-                      : go ns (subVector n (dim v - n) v)
-
----------------------------------------------------------------
-
--- | transforms a complex vector into a real vector with alternating real and imaginary parts 
-asReal :: (RealFloat a, Storable a) => Vector (Complex a) -> Vector a
-asReal v = unsafeFromForeignPtr (castForeignPtr fp) (2*i) (2*n)
-    where (fp,i,n) = unsafeToForeignPtr v
-
--- | transforms a real vector into a complex vector with alternating real and imaginary parts
-asComplex :: (RealFloat a, Storable a) => Vector a -> Vector (Complex a)
-asComplex v = unsafeFromForeignPtr (castForeignPtr fp) (i `div` 2) (n `div` 2)
-    where (fp,i,n) = unsafeToForeignPtr v
-
----------------------------------------------------------------
-
-float2DoubleV :: Vector Float -> Vector Double
-float2DoubleV = tog c_float2double
-
-double2FloatV :: Vector Double -> Vector Float
-double2FloatV = tog c_double2float
-
-double2IntV :: Vector Double -> Vector CInt
-double2IntV = tog c_double2int
-
-int2DoubleV :: Vector CInt -> Vector Double
-int2DoubleV = tog c_int2double
-
-float2IntV :: Vector Float -> Vector CInt
-float2IntV = tog c_float2int
-
-int2floatV :: Vector CInt -> Vector Float
-int2floatV = tog c_int2float
-
-
-tog f v = unsafePerformIO $ do
-    r <- createVector (dim v)
-    app2 f vec v vec r "tog"
-    return r
-
-foreign import ccall unsafe "float2double" c_float2double :: TFV
-foreign import ccall unsafe "double2float" c_double2float :: TVF
-foreign import ccall unsafe "int2double"   c_int2double   :: CV CInt (CV Double (IO CInt))
-foreign import ccall unsafe "double2int"   c_double2int   :: CV Double (CV CInt (IO CInt))
-foreign import ccall unsafe "int2float"    c_int2float    :: CV CInt (CV Float (IO CInt))
-foreign import ccall unsafe "float2int"    c_float2int    :: CV Float (CV CInt (IO CInt))
-
-
----------------------------------------------------------------
-
-step f v = unsafePerformIO $ do
-    r <- createVector (dim v)
-    app2 f vec v vec r "step"
-    return r
-
-stepD :: Vector Double -> Vector Double
-stepD = step c_stepD
-
-stepF :: Vector Float -> Vector Float
-stepF = step c_stepF
-
-stepI :: Vector CInt -> Vector CInt
-stepI = step c_stepI
-
-foreign import ccall unsafe "stepF" c_stepF :: TFF
-foreign import ccall unsafe "stepD" c_stepD :: TVV
-foreign import ccall unsafe "stepI" c_stepI :: CV CInt (CV CInt (IO CInt))
-
----------------------------------------------------------------
-
-condF :: Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float -> Vector Float
-condF = condg c_condF
-
-condD :: Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double -> Vector Double
-condD = condg c_condD
-
-condI :: Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt
-condI = condg c_condI
-
-
-condg f x y l e g = unsafePerformIO $ do
-    r <- createVector (dim x)
-    app6 f vec x vec y vec l vec e vec g vec r "cond"
-    return r
-
-
-foreign import ccall unsafe "condF" c_condF :: CInt -> PF -> CInt -> PF -> CInt -> PF -> TFFF
-foreign import ccall unsafe "condD" c_condD :: CInt -> PD -> CInt -> PD -> CInt -> PD -> TVVV
-foreign import ccall unsafe "condI" c_condI :: CV CInt (CV CInt (CV CInt (CV CInt (CV CInt (CV CInt (IO CInt))))))
-
---------------------------------------------------------------------------------
-
-conjugateAux fun x = unsafePerformIO $ do
-    v <- createVector (dim x)
-    app2 fun vec x vec v "conjugateAux"
-    return v
-
-conjugateQ :: Vector (Complex Float) -> Vector (Complex Float)
-conjugateQ = conjugateAux c_conjugateQ
-foreign import ccall unsafe "conjugateQ" c_conjugateQ :: TQVQV
-
-conjugateC :: Vector (Complex Double) -> Vector (Complex Double)
-conjugateC = conjugateAux c_conjugateC
-foreign import ccall unsafe "conjugateC" c_conjugateC :: TCVCV
-
---------------------------------------------------------------------------------
-
-cloneVector :: Storable t => Vector t -> IO (Vector t)
-cloneVector v = do
-        let n = dim v
-        r <- createVector n
-        let f _ s _ d =  copyArray d s n >> return 0
-        app2 f vec v vec r "cloneVector"
-        return r
-
-------------------------------------------------------------------
-
--- | map on Vectors
-mapVector :: (Storable a, Storable b) => (a-> b) -> Vector a -> Vector b
-mapVector f v = unsafePerformIO $ do
-    w <- createVector (dim v)
-    unsafeWith v $ \p ->
-        unsafeWith w $ \q -> do
-            let go (-1) = return ()
-                go !k = do x <- peekElemOff p k
-                           pokeElemOff      q k (f x)
-                           go (k-1)
-            go (dim v -1)
-    return w
-{-# INLINE mapVector #-}
-
--- | zipWith for Vectors
-zipVectorWith :: (Storable a, Storable b, Storable c) => (a-> b -> c) -> Vector a -> Vector b -> Vector c
-zipVectorWith f u v = unsafePerformIO $ do
-    let n = min (dim u) (dim v)
-    w <- createVector n
-    unsafeWith u $ \pu ->
-        unsafeWith v $ \pv ->
-            unsafeWith w $ \pw -> do
-                let go (-1) = return ()
-                    go !k = do x <- peekElemOff pu k
-                               y <- peekElemOff pv k
-                               pokeElemOff      pw k (f x y)
-                               go (k-1)
-                go (n -1)
-    return w
-{-# INLINE zipVectorWith #-}
-
--- | unzipWith for Vectors
-unzipVectorWith :: (Storable (a,b), Storable c, Storable d) 
-                   => ((a,b) -> (c,d)) -> Vector (a,b) -> (Vector c,Vector d)
-unzipVectorWith f u = unsafePerformIO $ do
-      let n = dim u
-      v <- createVector n
-      w <- createVector n
-      unsafeWith u $ \pu ->
-          unsafeWith v $ \pv ->
-              unsafeWith w $ \pw -> do
-                  let go (-1) = return ()
-                      go !k   = do z <- peekElemOff pu k
-                                   let (x,y) = f z 
-                                   pokeElemOff      pv k x
-                                   pokeElemOff      pw k y
-                                   go (k-1)
-                  go (n-1)
-      return (v,w)
-{-# INLINE unzipVectorWith #-}
-
-foldVector :: Storable a => (a -> b -> b) -> b -> Vector a -> b
-foldVector f x v = unsafePerformIO $
-    unsafeWith v $ \p -> do
-        let go (-1) s = return s
-            go !k !s = do y <- peekElemOff p k
-                          go (k-1::Int) (f y s)
-        go (dim v -1) x
-{-# INLINE foldVector #-}
-
--- the zero-indexed index is passed to the folding function
-foldVectorWithIndex :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b
-foldVectorWithIndex f x v = unsafePerformIO $
-    unsafeWith v $ \p -> do
-        let go (-1) s = return s
-            go !k !s = do y <- peekElemOff p k
-                          go (k-1::Int) (f k y s)
-        go (dim v -1) x
-{-# INLINE foldVectorWithIndex #-}
-
-foldLoop f s0 d = go (d - 1) s0
-     where
-       go 0 s = f (0::Int) s
-       go !j !s = go (j - 1) (f j s)
-
-foldVectorG f s0 v = foldLoop g s0 (dim v)
-    where g !k !s = f k (at' v) s
-          {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479)
-{-# INLINE foldVectorG #-}
-
--------------------------------------------------------------------
-
--- | monadic map over Vectors
---    the monad @m@ must be strict
-mapVectorM :: (Storable a, Storable b, Monad m) => (a -> m b) -> Vector a -> m (Vector b)
-mapVectorM f v = do
-    w <- return $! unsafePerformIO $! createVector (dim v)
-    mapVectorM' w 0 (dim v -1)
-    return w
-    where mapVectorM' w' !k !t
-              | k == t               = do
-                                       x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
-                                       y <- f x
-                                       return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
-              | otherwise            = do
-                                       x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
-                                       y <- f x
-                                       _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
-                                       mapVectorM' w' (k+1) t
-{-# INLINE mapVectorM #-}
-
--- | monadic map over Vectors
-mapVectorM_ :: (Storable a, Monad m) => (a -> m ()) -> Vector a -> m ()
-mapVectorM_ f v = do
-    mapVectorM' 0 (dim v -1)
-    where mapVectorM' !k !t
-              | k == t            = do
-                                    x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
-                                    f x
-              | otherwise         = do
-                                    x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
-                                    _ <- f x
-                                    mapVectorM' (k+1) t
-{-# INLINE mapVectorM_ #-}
-
--- | monadic map over Vectors with the zero-indexed index passed to the mapping function
---    the monad @m@ must be strict
-mapVectorWithIndexM :: (Storable a, Storable b, Monad m) => (Int -> a -> m b) -> Vector a -> m (Vector b)
-mapVectorWithIndexM f v = do
-    w <- return $! unsafePerformIO $! createVector (dim v)
-    mapVectorM' w 0 (dim v -1)
-    return w
-    where mapVectorM' w' !k !t
-              | k == t               = do
-                                       x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
-                                       y <- f k x
-                                       return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
-              | otherwise            = do
-                                       x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
-                                       y <- f k x
-                                       _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
-                                       mapVectorM' w' (k+1) t
-{-# INLINE mapVectorWithIndexM #-}
-
--- | monadic map over Vectors with the zero-indexed index passed to the mapping function
-mapVectorWithIndexM_ :: (Storable a, Monad m) => (Int -> a -> m ()) -> Vector a -> m ()
-mapVectorWithIndexM_ f v = do
-    mapVectorM' 0 (dim v -1)
-    where mapVectorM' !k !t
-              | k == t            = do
-                                    x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
-                                    f k x
-              | otherwise         = do
-                                    x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
-                                    _ <- f k x
-                                    mapVectorM' (k+1) t
-{-# INLINE mapVectorWithIndexM_ #-}
-
-
-mapVectorWithIndex :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b
---mapVectorWithIndex g = head . mapVectorWithIndexM (\a b -> [g a b])
-mapVectorWithIndex f v = unsafePerformIO $ do
-    w <- createVector (dim v)
-    unsafeWith v $ \p ->
-        unsafeWith w $ \q -> do
-            let go (-1) = return ()
-                go !k = do x <- peekElemOff p k
-                           pokeElemOff      q k (f k x)
-                           go (k-1)
-            go (dim v -1)
-    return w
-{-# INLINE mapVectorWithIndex #-}
-
-
diff --git a/packages/base/src/Data/Packed/Vector.hs b/packages/base/src/Data/Packed/Vector.hs
deleted file mode 100644
index 2104f52..0000000
--- a/packages/base/src/Data/Packed/Vector.hs
+++ /dev/null
@@ -1,125 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE CPP #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Packed.Vector
--- Copyright   :  (c) Alberto Ruiz 2007-10
--- License     :  BSD3
--- Maintainer  :  Alberto Ruiz
--- Stability   :  provisional
---
--- 1D arrays suitable for numeric computations using external libraries.
---
--- This module provides basic functions for manipulation of structure.
---
------------------------------------------------------------------------------
-{-# OPTIONS_HADDOCK hide #-}
-
-module Data.Packed.Vector (
-    Vector,
-    fromList, (|>), toList, buildVector,
-    dim, (@>),
-    subVector, takesV, vjoin, join,
-    mapVector, mapVectorWithIndex, zipVector, zipVectorWith, unzipVector, unzipVectorWith,
-    mapVectorM, mapVectorM_, mapVectorWithIndexM, mapVectorWithIndexM_,
-    foldLoop, foldVector, foldVectorG, foldVectorWithIndex,
-    toByteString, fromByteString
-) where
-
-import Data.Packed.Internal.Vector
-import Foreign.Storable
-
--------------------------------------------------------------------
-
-#ifdef BINARY
-
-import Data.Binary
-import Control.Monad(replicateM)
-
-import Data.ByteString.Internal as BS
-import Foreign.ForeignPtr(castForeignPtr)
-import Data.Vector.Storable.Internal(updPtr)
-import Foreign.Ptr(plusPtr)
-
-
--- a 64K cache, with a Double taking 13 bytes in Bytestring,
--- implies a chunk size of 5041
-chunk :: Int
-chunk = 5000
-
-chunks :: Int -> [Int]
-chunks d = let c = d `div` chunk
-               m = d `mod` chunk
-           in if m /= 0 then reverse (m:(replicate c chunk)) else (replicate c chunk)
-
-putVector v = mapM_ put $! toList v
-
-getVector d = do
-              xs <- replicateM d get
-              return $! fromList xs
-
---------------------------------------------------------------------------------
-
-toByteString :: Storable t => Vector t -> ByteString
-toByteString v = BS.PS (castForeignPtr fp) (sz*o) (sz * dim v)
-  where
-    (fp,o,_n) = unsafeToForeignPtr v
-    sz = sizeOf (v@>0)
-
-
-fromByteString :: Storable t => ByteString -> Vector t
-fromByteString (BS.PS fp o n) = r
-  where
-    r = unsafeFromForeignPtr (castForeignPtr (updPtr (`plusPtr` o) fp)) 0 n'
-    n' = n `div` sz
-    sz = sizeOf (r@>0)
-
---------------------------------------------------------------------------------
-
-instance (Binary a, Storable a) => Binary (Vector a) where
-
-    put v = do
-            let d = dim v
-            put d
-            mapM_ putVector $! takesV (chunks d) v
-
-    -- put = put . v2bs
-
-    get = do
-          d <- get
-          vs <- mapM getVector $ chunks d
-          return $! vjoin vs
-
-    -- get = fmap bs2v get
-
-#endif
-
-
--------------------------------------------------------------------
-
-{- | creates a Vector of the specified length using the supplied function to
-     to map the index to the value at that index.
-
-@> buildVector 4 fromIntegral
-4 |> [0.0,1.0,2.0,3.0]@
-
--}
-buildVector :: Storable a => Int -> (Int -> a) -> Vector a
-buildVector len f =
-    fromList $ map f [0 .. (len - 1)]
-
-
--- | zip for Vectors
-zipVector :: (Storable a, Storable b, Storable (a,b)) => Vector a -> Vector b -> Vector (a,b)
-zipVector = zipVectorWith (,)
-
--- | unzip for Vectors
-unzipVector :: (Storable a, Storable b, Storable (a,b)) => Vector (a,b) -> (Vector a,Vector b)
-unzipVector = unzipVectorWith id
-
--------------------------------------------------------------------
-
-{-# DEPRECATED join "use vjoin or Data.Vector.concat" #-}
-join ::  Storable t => [Vector t] -> Vector t
-join = vjoin
-
diff --git a/packages/base/src/Internal/Vector.hs b/packages/base/src/Internal/Vector.hs
new file mode 100644
index 0000000..27ee13c
--- /dev/null
+++ b/packages/base/src/Internal/Vector.hs
@@ -0,0 +1,447 @@
+{-# LANGUAGE MagicHash, CPP, UnboxedTuples, BangPatterns, FlexibleContexts #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+
+-- |
+-- Module      :  Internal.Vector
+-- Copyright   :  (c) Alberto Ruiz 2007-15
+-- License     :  BSD3
+-- Maintainer  :  Alberto Ruiz
+-- Stability   :  provisional
+--
+
+module Internal.Vector where
+
+import Internal.Tools
+import Foreign.Marshal.Array ( peekArray, copyArray, advancePtr )
+import Foreign.ForeignPtr ( ForeignPtr, castForeignPtr )
+import Foreign.Ptr ( Ptr )
+import Foreign.Storable
+    ( Storable, peekElemOff, pokeElemOff, sizeOf )
+import Foreign.C.Types ( CInt )
+import Data.Complex ( Complex )
+import System.IO.Unsafe ( unsafePerformIO )
+import GHC.ForeignPtr ( mallocPlainForeignPtrBytes )
+import GHC.Base ( realWorld#, IO(IO), when )
+import qualified Data.Vector.Storable as Vector
+    ( Vector, slice, length )
+import Data.Vector.Storable
+    ( fromList, unsafeToForeignPtr, unsafeFromForeignPtr, unsafeWith )
+
+
+#ifdef BINARY
+
+import Data.Binary
+import Control.Monad(replicateM)
+import qualified Data.ByteString.Internal as BS
+import Data.Vector.Storable.Internal(updPtr)
+import Foreign.Ptr(plusPtr)
+
+#endif
+
+
+
+type Vector = Vector.Vector
+
+-- | Number of elements
+dim :: (Storable t) => Vector t -> Int
+dim = Vector.length
+
+
+-- C-Haskell vector adapter
+-- vec :: Adapt (CInt -> Ptr t -> r) (Vector t) r
+vec :: (Storable t) => Vector t -> (((CInt -> Ptr t -> t1) -> t1) -> IO b) -> IO b
+vec x f = unsafeWith x $ \p -> do
+    let v g = do
+        g (fi $ dim x) p
+    f v
+{-# INLINE vec #-}
+
+
+-- allocates memory for a new vector
+createVector :: Storable a => Int -> IO (Vector a)
+createVector n = do
+    when (n < 0) $ error ("trying to createVector of negative dim: "++show n)
+    fp <- doMalloc undefined
+    return $ unsafeFromForeignPtr fp 0 n
+  where
+    --
+    -- Use the much cheaper Haskell heap allocated storage
+    -- for foreign pointer space we control
+    --
+    doMalloc :: Storable b => b -> IO (ForeignPtr b)
+    doMalloc dummy = do
+        mallocPlainForeignPtrBytes (n * sizeOf dummy)
+
+{- | creates a Vector from a list:
+
+@> fromList [2,3,5,7]
+4 |> [2.0,3.0,5.0,7.0]@
+
+-}
+
+safeRead v = inlinePerformIO . unsafeWith v
+{-# INLINE safeRead #-}
+
+inlinePerformIO :: IO a -> a
+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+{-# INLINE inlinePerformIO #-}
+
+{- extracts the Vector elements to a list
+
+>>> toList (linspace 5 (1,10))
+[1.0,3.25,5.5,7.75,10.0]
+
+-}
+toList :: Storable a => Vector a -> [a]
+toList v = safeRead v $ peekArray (dim v)
+
+{- | Create a vector from a list of elements and explicit dimension. The input
+     list is truncated if it is too long, so it may safely
+     be used, for instance, with infinite lists.
+
+>>> 5 |> [1..]
+fromList [1.0,2.0,3.0,4.0,5.0]
+
+-}
+(|>) :: (Storable a) => Int -> [a] -> Vector a
+infixl 9 |>
+n |> l
+    | length l' == n = fromList l'
+    | otherwise      = error "list too short for |>"
+  where
+    l' = take n l
+
+
+-- | Create a vector of indexes, useful for matrix extraction using '??'
+idxs :: [Int] -> Vector I
+idxs js = fromList (map fromIntegral js) :: Vector I
+
+{- | takes a number of consecutive elements from a Vector
+
+>>> subVector 2 3 (fromList [1..10])
+fromList [3.0,4.0,5.0]
+
+-}
+subVector :: Storable t => Int       -- ^ index of the starting element
+                        -> Int       -- ^ number of elements to extract
+                        -> Vector t  -- ^ source
+                        -> Vector t  -- ^ result
+subVector = Vector.slice
+
+
+
+
+{- | Reads a vector position:
+
+>>> fromList [0..9] @> 7
+7.0
+
+-}
+(@>) :: Storable t => Vector t -> Int -> t
+infixl 9 @>
+v @> n
+    | n >= 0 && n < dim v = at' v n
+    | otherwise = error "vector index out of range"
+{-# INLINE (@>) #-}
+
+-- | access to Vector elements without range checking
+at' :: Storable a => Vector a -> Int -> a
+at' v n = safeRead v $ flip peekElemOff n
+{-# INLINE at' #-}
+
+{- | concatenate a list of vectors
+
+>>> vjoin [fromList [1..5::Double], konst 1 3]
+fromList [1.0,2.0,3.0,4.0,5.0,1.0,1.0,1.0]
+
+-}
+vjoin :: Storable t => [Vector t] -> Vector t
+vjoin [] = fromList []
+vjoin [v] = v
+vjoin as = unsafePerformIO $ do
+    let tot = sum (map dim as)
+    r <- createVector tot
+    unsafeWith r $ \ptr ->
+        joiner as tot ptr
+    return r
+  where joiner [] _ _ = return ()
+        joiner (v:cs) _ p = do
+            let n = dim v
+            unsafeWith v $ \pb -> copyArray p pb n
+            joiner cs 0 (advancePtr p n)
+
+
+{- | Extract consecutive subvectors of the given sizes.
+
+>>> takesV [3,4] (linspace 10 (1,10::Double))
+[fromList [1.0,2.0,3.0],fromList [4.0,5.0,6.0,7.0]]
+
+-}
+takesV :: Storable t => [Int] -> Vector t -> [Vector t]
+takesV ms w | sum ms > dim w = error $ "takesV " ++ show ms ++ " on dim = " ++ (show $ dim w)
+            | otherwise = go ms w
+    where go [] _ = []
+          go (n:ns) v = subVector 0 n v
+                      : go ns (subVector n (dim v - n) v)
+
+---------------------------------------------------------------
+
+-- | transforms a complex vector into a real vector with alternating real and imaginary parts 
+asReal :: (RealFloat a, Storable a) => Vector (Complex a) -> Vector a
+asReal v = unsafeFromForeignPtr (castForeignPtr fp) (2*i) (2*n)
+    where (fp,i,n) = unsafeToForeignPtr v
+
+-- | transforms a real vector into a complex vector with alternating real and imaginary parts
+asComplex :: (RealFloat a, Storable a) => Vector a -> Vector (Complex a)
+asComplex v = unsafeFromForeignPtr (castForeignPtr fp) (i `div` 2) (n `div` 2)
+    where (fp,i,n) = unsafeToForeignPtr v
+
+--------------------------------------------------------------------------------
+
+
+-- | map on Vectors
+mapVector :: (Storable a, Storable b) => (a-> b) -> Vector a -> Vector b
+mapVector f v = unsafePerformIO $ do
+    w <- createVector (dim v)
+    unsafeWith v $ \p ->
+        unsafeWith w $ \q -> do
+            let go (-1) = return ()
+                go !k = do x <- peekElemOff p k
+                           pokeElemOff      q k (f x)
+                           go (k-1)
+            go (dim v -1)
+    return w
+{-# INLINE mapVector #-}
+
+-- | zipWith for Vectors
+zipVectorWith :: (Storable a, Storable b, Storable c) => (a-> b -> c) -> Vector a -> Vector b -> Vector c
+zipVectorWith f u v = unsafePerformIO $ do
+    let n = min (dim u) (dim v)
+    w <- createVector n
+    unsafeWith u $ \pu ->
+        unsafeWith v $ \pv ->
+            unsafeWith w $ \pw -> do
+                let go (-1) = return ()
+                    go !k = do x <- peekElemOff pu k
+                               y <- peekElemOff pv k
+                               pokeElemOff      pw k (f x y)
+                               go (k-1)
+                go (n -1)
+    return w
+{-# INLINE zipVectorWith #-}
+
+-- | unzipWith for Vectors
+unzipVectorWith :: (Storable (a,b), Storable c, Storable d) 
+                   => ((a,b) -> (c,d)) -> Vector (a,b) -> (Vector c,Vector d)
+unzipVectorWith f u = unsafePerformIO $ do
+      let n = dim u
+      v <- createVector n
+      w <- createVector n
+      unsafeWith u $ \pu ->
+          unsafeWith v $ \pv ->
+              unsafeWith w $ \pw -> do
+                  let go (-1) = return ()
+                      go !k   = do z <- peekElemOff pu k
+                                   let (x,y) = f z 
+                                   pokeElemOff      pv k x
+                                   pokeElemOff      pw k y
+                                   go (k-1)
+                  go (n-1)
+      return (v,w)
+{-# INLINE unzipVectorWith #-}
+
+foldVector :: Storable a => (a -> b -> b) -> b -> Vector a -> b
+foldVector f x v = unsafePerformIO $
+    unsafeWith v $ \p -> do
+        let go (-1) s = return s
+            go !k !s = do y <- peekElemOff p k
+                          go (k-1::Int) (f y s)
+        go (dim v -1) x
+{-# INLINE foldVector #-}
+
+-- the zero-indexed index is passed to the folding function
+foldVectorWithIndex :: Storable a => (Int -> a -> b -> b) -> b -> Vector a -> b
+foldVectorWithIndex f x v = unsafePerformIO $
+    unsafeWith v $ \p -> do
+        let go (-1) s = return s
+            go !k !s = do y <- peekElemOff p k
+                          go (k-1::Int) (f k y s)
+        go (dim v -1) x
+{-# INLINE foldVectorWithIndex #-}
+
+foldLoop f s0 d = go (d - 1) s0
+     where
+       go 0 s = f (0::Int) s
+       go !j !s = go (j - 1) (f j s)
+
+foldVectorG f s0 v = foldLoop g s0 (dim v)
+    where g !k !s = f k (safeRead v . flip peekElemOff) s
+          {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479)
+{-# INLINE foldVectorG #-}
+
+-------------------------------------------------------------------
+
+-- | monadic map over Vectors
+--    the monad @m@ must be strict
+mapVectorM :: (Storable a, Storable b, Monad m) => (a -> m b) -> Vector a -> m (Vector b)
+mapVectorM f v = do
+    w <- return $! unsafePerformIO $! createVector (dim v)
+    mapVectorM' w 0 (dim v -1)
+    return w
+    where mapVectorM' w' !k !t
+              | k == t               = do
+                                       x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
+                                       y <- f x
+                                       return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
+              | otherwise            = do
+                                       x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
+                                       y <- f x
+                                       _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
+                                       mapVectorM' w' (k+1) t
+{-# INLINE mapVectorM #-}
+
+-- | monadic map over Vectors
+mapVectorM_ :: (Storable a, Monad m) => (a -> m ()) -> Vector a -> m ()
+mapVectorM_ f v = do
+    mapVectorM' 0 (dim v -1)
+    where mapVectorM' !k !t
+              | k == t            = do
+                                    x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
+                                    f x
+              | otherwise         = do
+                                    x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
+                                    _ <- f x
+                                    mapVectorM' (k+1) t
+{-# INLINE mapVectorM_ #-}
+
+-- | monadic map over Vectors with the zero-indexed index passed to the mapping function
+--    the monad @m@ must be strict
+mapVectorWithIndexM :: (Storable a, Storable b, Monad m) => (Int -> a -> m b) -> Vector a -> m (Vector b)
+mapVectorWithIndexM f v = do
+    w <- return $! unsafePerformIO $! createVector (dim v)
+    mapVectorM' w 0 (dim v -1)
+    return w
+    where mapVectorM' w' !k !t
+              | k == t               = do
+                                       x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
+                                       y <- f k x
+                                       return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
+              | otherwise            = do
+                                       x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
+                                       y <- f k x
+                                       _ <- return $! inlinePerformIO $! unsafeWith w' $! \q -> pokeElemOff q k y
+                                       mapVectorM' w' (k+1) t
+{-# INLINE mapVectorWithIndexM #-}
+
+-- | monadic map over Vectors with the zero-indexed index passed to the mapping function
+mapVectorWithIndexM_ :: (Storable a, Monad m) => (Int -> a -> m ()) -> Vector a -> m ()
+mapVectorWithIndexM_ f v = do
+    mapVectorM' 0 (dim v -1)
+    where mapVectorM' !k !t
+              | k == t            = do
+                                    x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k
+                                    f k x
+              | otherwise         = do
+                                    x <- return $! inlinePerformIO $! unsafeWith v $! \p -> peekElemOff p k 
+                                    _ <- f k x
+                                    mapVectorM' (k+1) t
+{-# INLINE mapVectorWithIndexM_ #-}
+
+
+mapVectorWithIndex :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b
+--mapVectorWithIndex g = head . mapVectorWithIndexM (\a b -> [g a b])
+mapVectorWithIndex f v = unsafePerformIO $ do
+    w <- createVector (dim v)
+    unsafeWith v $ \p ->
+        unsafeWith w $ \q -> do
+            let go (-1) = return ()
+                go !k = do x <- peekElemOff p k
+                           pokeElemOff      q k (f k x)
+                           go (k-1)
+            go (dim v -1)
+    return w
+{-# INLINE mapVectorWithIndex #-}
+
+--------------------------------------------------------------------------------
+
+
+#ifdef BINARY
+
+-- a 64K cache, with a Double taking 13 bytes in Bytestring,
+-- implies a chunk size of 5041
+chunk :: Int
+chunk = 5000
+
+chunks :: Int -> [Int]
+chunks d = let c = d `div` chunk
+               m = d `mod` chunk
+           in if m /= 0 then reverse (m:(replicate c chunk)) else (replicate c chunk)
+
+putVector v = mapM_ put $! toList v
+
+getVector d = do
+              xs <- replicateM d get
+              return $! fromList xs
+
+--------------------------------------------------------------------------------
+
+toByteString :: Storable t => Vector t -> BS.ByteString
+toByteString v = BS.PS (castForeignPtr fp) (sz*o) (sz * dim v)
+  where
+    (fp,o,_n) = unsafeToForeignPtr v
+    sz = sizeOf (v@>0)
+
+
+fromByteString :: Storable t => BS.ByteString -> Vector t
+fromByteString (BS.PS fp o n) = r
+  where
+    r = unsafeFromForeignPtr (castForeignPtr (updPtr (`plusPtr` o) fp)) 0 n'
+    n' = n `div` sz
+    sz = sizeOf (r@>0)
+
+--------------------------------------------------------------------------------
+
+instance (Binary a, Storable a) => Binary (Vector a) where
+
+    put v = do
+            let d = dim v
+            put d
+            mapM_ putVector $! takesV (chunks d) v
+
+    -- put = put . v2bs
+
+    get = do
+          d <- get
+          vs <- mapM getVector $ chunks d
+          return $! vjoin vs
+
+    -- get = fmap bs2v get
+
+#endif
+
+
+-------------------------------------------------------------------
+
+{- | creates a Vector of the specified length using the supplied function to
+     to map the index to the value at that index.
+
+@> buildVector 4 fromIntegral
+4 |> [0.0,1.0,2.0,3.0]@
+
+-}
+buildVector :: Storable a => Int -> (Int -> a) -> Vector a
+buildVector len f =
+    fromList $ map f [0 .. (len - 1)]
+
+
+-- | zip for Vectors
+zipVector :: (Storable a, Storable b, Storable (a,b)) => Vector a -> Vector b -> Vector (a,b)
+zipVector = zipVectorWith (,)
+
+-- | unzip for Vectors
+unzipVector :: (Storable a, Storable b, Storable (a,b)) => Vector (a,b) -> (Vector a,Vector b)
+unzipVector = unzipVectorWith id
+
+-------------------------------------------------------------------
+
-- 
cgit v1.2.3