Use primitive-types in Data.Vector
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 16 Nov 2009 05:15:50 +0000 (05:15 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 16 Nov 2009 05:15:50 +0000 (05:15 +0000)
This allows us to unify D.V.Mutable.ST and D.V.Mutable.IO

Data/Vector.hs
Data/Vector/Mutable.hs [new file with mode: 0644]
Data/Vector/Mutable/IO.hs [deleted file]
Data/Vector/Mutable/ST.hs [deleted file]
vector.cabal

index 08384d4..8f395e4 100644 (file)
@@ -65,14 +65,11 @@ module Data.Vector (
 
 import           Data.Vector.IVector ( IVector(..) )
 import qualified Data.Vector.IVector    as IV
-import qualified Data.Vector.Mutable.ST as Mut
+import qualified Data.Vector.Mutable    as Mut
+import           Data.Primitive.Array
 
 import Control.Monad.ST ( runST )
 
-import GHC.ST   ( ST(..) )
-import GHC.Prim ( Array#, unsafeFreezeArray#, indexArray#, (+#) )
-import GHC.Base ( Int(..) )
-
 import Prelude hiding ( length, null,
                         replicate, (++),
                         head, last,
@@ -90,7 +87,7 @@ import qualified Prelude
 
 data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
-                                      (Array# a)
+                       {-# UNPACK #-} !(Array a)
 
 instance Show a => Show (Vector a) where
     show = (Prelude.++ " :: Data.Vector.Vector") . ("fromList " Prelude.++) . show . toList
@@ -98,19 +95,18 @@ instance Show a => Show (Vector a) where
 instance IVector Vector a where
   {-# INLINE vnew #-}
   vnew init = runST (do
-                       Mut.Vector i n marr# <- init
-                       ST (\s# -> case unsafeFreezeArray# marr# s# of
-                               (# s2#, arr# #) -> (# s2#, Vector i n arr# #)))
+                       Mut.Vector i n marr <- init
+                       arr <- unsafeFreezeArray marr
+                       return (Vector i n arr))
 
   {-# INLINE vlength #-}
   vlength (Vector _ n _) = n
 
   {-# INLINE unsafeSlice #-}
-  unsafeSlice (Vector i _ arr#) j n = Vector (i+j) n arr#
+  unsafeSlice (Vector i _ arr) j n = Vector (i+j) n arr
 
   {-# INLINE unsafeIndexM #-}
-  unsafeIndexM (Vector (I# i#) _ arr#) (I# j#)
-    = case indexArray# arr# (i# +# j#) of (# x #) -> return x
+  unsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j)
 
 instance Eq a => Eq (Vector a) where
   {-# INLINE (==) #-}
diff --git a/Data/Vector/Mutable.hs b/Data/Vector/Mutable.hs
new file mode 100644 (file)
index 0000000..cf69961
--- /dev/null
@@ -0,0 +1,66 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+
+-- |
+-- Module      : Data.Vector.Mutable
+-- Copyright   : (c) Roman Leshchinskiy 2008-2009
+-- License     : BSD-style
+--
+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+-- Stability   : experimental
+-- Portability : non-portable
+-- 
+-- Mutable boxed vectors.
+--
+
+module Data.Vector.Mutable ( Vector(..), IOVector, STVector )
+where
+
+import qualified Data.Vector.MVector as MVector
+import           Data.Vector.MVector ( MVector, MVectorPure )
+import           Data.Primitive.Array
+import           Control.Monad.Primitive ( PrimMonad )
+import           Control.Monad.ST ( ST )
+
+-- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@).
+data Vector m a = Vector {-# UNPACK #-} !Int
+                         {-# UNPACK #-} !Int
+                         {-# UNPACK #-} !(MutableArray m a)
+
+type IOVector = Vector IO
+type STVector s = Vector (ST s)
+
+instance MVectorPure (Vector m) a where
+  length (Vector _ n _) = n
+  unsafeSlice (Vector i _ arr) j m = Vector (i+j) m arr
+
+  {-# INLINE overlaps #-}
+  overlaps (Vector i m arr1) (Vector j n arr2)
+    = sameMutableArray arr1 arr2
+      && (between i j (j+n) || between j i (i+m))
+    where
+      between x y z = x >= y && x < z
+
+
+instance PrimMonad m => MVector (Vector m) m a where
+  {-# INLINE unsafeNew #-}
+  unsafeNew n = do
+                  arr <- newArray n uninitialised
+                  return (Vector 0 n arr)
+
+  {-# INLINE unsafeNewWith #-}
+  unsafeNewWith n x = do
+                        arr <- newArray n x
+                        return (Vector 0 n arr)
+
+  {-# INLINE unsafeRead #-}
+  unsafeRead (Vector i _ arr) j = readArray arr (i+j)
+
+  {-# INLINE unsafeWrite #-}
+  unsafeWrite (Vector i _ arr) j x = writeArray arr (i+j) x
+
+  {-# INLINE clear #-}
+  clear v = MVector.set v uninitialised
+
+uninitialised :: a
+uninitialised = error "Data.Vector.Mutable: uninitialised element"
+
diff --git a/Data/Vector/Mutable/IO.hs b/Data/Vector/Mutable/IO.hs
deleted file mode 100644 (file)
index dcc6e8a..0000000
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-
--- |
--- Module      : Data.Vector.Mutable.IO
--- Copyright   : (c) Roman Leshchinskiy 2009
--- License     : BSD-style
---
--- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
--- Stability   : experimental
--- Portability : non-portable
--- 
--- Mutable boxed vectors in the IO monad.
---
-
-module Data.Vector.Mutable.IO ( Vector(..) )
-where
-
-import           Data.Vector.MVector ( MVector(..), MVectorPure(..) )
-import qualified Data.Vector.Mutable.ST as STV
-
-import GHC.Base   ( RealWorld )
-import GHC.ST     ( ST(..) )
-import GHC.IOBase ( IO(..) )
-
-import Prelude hiding ( length )
-
--- | IO-based mutable vectors
-newtype Vector a = Vector (STV.Vector RealWorld a)
-
-instance MVectorPure Vector a where
-  {-# INLINE length #-}
-  length (Vector v) = length v
-
-  {-# INLINE unsafeSlice #-}
-  unsafeSlice (Vector v) j m = Vector (unsafeSlice v j m)
-
-  {-# INLINE overlaps #-}
-  overlaps (Vector v1) (Vector v2) = overlaps v1 v2
-
-instance MVector Vector IO a where
-  {-# INLINE unsafeNew #-}
-  unsafeNew n = Vector `fmap` stToIO (unsafeNew n)
-
-  {-# INLINE unsafeNewWith #-}
-  unsafeNewWith n x = Vector `fmap` stToIO (unsafeNewWith n x)
-
-  {-# INLINE unsafeRead #-}
-  unsafeRead (Vector v) i = stToIO (unsafeRead v i)
-
-  {-# INLINE unsafeWrite #-}
-  unsafeWrite (Vector v) i x = stToIO (unsafeWrite v i x)
-
-  {-# INLINE clear #-}
-  clear (Vector v) = stToIO (clear v)
-
-stToIO :: ST RealWorld a -> IO a
-stToIO (ST m) = IO m
-
diff --git a/Data/Vector/Mutable/ST.hs b/Data/Vector/Mutable/ST.hs
deleted file mode 100644 (file)
index ab302be..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
-{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances #-}
-
--- |
--- Module      : Data.Vector.Mutable.ST
--- Copyright   : (c) Roman Leshchinskiy 2008
--- License     : BSD-style
---
--- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
--- Stability   : experimental
--- Portability : non-portable
--- 
--- Mutable boxed vectors in the ST monad.
---
-
-module Data.Vector.Mutable.ST ( Vector(..) )
-where
-
-import qualified Data.Vector.MVector as MVector
-import           Data.Vector.MVector ( MVector, MVectorPure )
-
-import GHC.Prim ( MutableArray#,
-                  newArray#, readArray#, writeArray#, sameMutableArray#, (+#) )
-
-import GHC.ST   ( ST(..) )
-
-import GHC.Base ( Int(..) )
-
--- | Mutable boxed vectors. They live in the 'ST' monad.
-data Vector s a = Vector {-# UNPACK #-} !Int
-                         {-# UNPACK #-} !Int
-                                        (MutableArray# s a)
-
-instance MVectorPure (Vector s) a where
-  length (Vector _ n _) = n
-  unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#
-
-  {-# INLINE overlaps #-}
-  overlaps (Vector i m arr1#) (Vector j n arr2#)
-    = sameMutableArray# arr1# arr2#
-      && (between i j (j+n) || between j i (i+m))
-    where
-      between x y z = x >= y && x < z
-
-
-instance MVector (Vector s) (ST s) a where
-  {-# INLINE unsafeNew #-}
-  unsafeNew = unsafeNew
-
-  {-# INLINE unsafeNewWith #-}
-  unsafeNewWith = unsafeNewWith
-
-  {-# INLINE unsafeRead #-}
-  unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (readArray# arr# (i# +# j#))
-
-  {-# INLINE unsafeWrite #-}
-  unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->
-      case writeArray# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)
-    )
-
-  {-# INLINE clear #-}
-  clear v = MVector.set v uninitialised
-
-
-uninitialised :: a
-uninitialised = error "Data.Vector.Mutable: uninitialised elemen t"
-
-unsafeNew :: Int -> ST s (Vector s a)
-{-# INLINE unsafeNew #-}
-unsafeNew n = unsafeNewWith n uninitialised
-
-unsafeNewWith :: Int -> a -> ST s (Vector s a)
-{-# INLINE unsafeNewWith #-}
-unsafeNewWith (I# n#) x = ST (\s# ->
-    case newArray# n# x s# of
-      (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)
-  )
-
index 04db113..593217a 100644 (file)
@@ -51,8 +51,7 @@ Library
         Data.Vector.Storable.Mutable
         Data.Vector.Storable
 
-        Data.Vector.Mutable.ST
-        Data.Vector.Mutable.IO
+        Data.Vector.Mutable
         Data.Vector
   Include-Dirs:
         include