Use primitive-types in D.V.Primitive
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 16 Nov 2009 04:32:02 +0000 (04:32 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 16 Nov 2009 04:32:02 +0000 (04:32 +0000)
Data/Vector/Primitive.hs
Data/Vector/Primitive/Mutable/IO.hs
Data/Vector/Primitive/Mutable/ST.hs
Data/Vector/Primitive/Prim.hs [deleted file]
vector.cabal

index 0adecb4..d21993a 100644 (file)
@@ -66,7 +66,8 @@ module Data.Vector.Primitive (
 import           Data.Vector.IVector ( IVector(..) )
 import qualified Data.Vector.IVector            as IV
 import qualified Data.Vector.Primitive.Mutable.ST as Mut
-import           Data.Vector.Primitive.Prim
+import           Data.Primitive.ByteArray
+import           Data.Primitive ( Prim )
 
 import Control.Monad.ST ( runST )
 
@@ -92,7 +93,7 @@ import qualified Prelude
 -- | Unboxed vectors of primitive types
 data Vector a = Vector {-# UNPACK #-} !Int
                        {-# UNPACK #-} !Int
-                                      ByteArray#
+                       {-# UNPACK #-} !ByteArray
 
 instance (Show a, Prim a) => Show (Vector a) where
     show = (Prelude.++ " :: Data.Vector.Primitive.Vector") . ("fromList " Prelude.++) . show . toList
@@ -100,18 +101,18 @@ instance (Show a, Prim a) => Show (Vector a) where
 instance Prim a => IVector Vector a where
   {-# INLINE vnew #-}
   vnew init = runST (do
-                       Mut.Vector i n marr# <- init
-                       ST (\s# -> case unsafeFreezeByteArray# marr# s# of
-                            (# s2#, arr# #) -> (# s2#, Vector i n arr# #)))
+                       Mut.Vector i n marr <- init
+                       arr <- unsafeFreezeByteArray 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#) = return (at# arr# (i# +# j#))
+  unsafeIndexM (Vector i _ arr) j = return (indexByteArray arr (i+j))
 
 instance (Prim a, Eq a) => Eq (Vector a) where
   {-# INLINE (==) #-}
index 9412088..dbd1499 100644 (file)
@@ -17,7 +17,7 @@ where
 
 import           Data.Vector.MVector ( MVector(..), MVectorPure(..) )
 import qualified Data.Vector.Primitive.Mutable.ST as STV
-import           Data.Vector.Primitive.Prim ( Prim )
+import           Data.Primitive ( Prim )
 
 import GHC.Base   ( RealWorld )
 import GHC.ST     ( ST(..) )
index ab77081..edbbe24 100644 (file)
@@ -17,10 +17,8 @@ where
 
 import qualified Data.Vector.MVector as MVector
 import           Data.Vector.MVector ( MVector, MVectorPure )
-import           Data.Vector.Primitive.Prim
-
-import GHC.Prim ( MutableByteArray#,
-                  newByteArray#, sameMutableByteArray#, (+#) )
+import           Data.Primitive.ByteArray
+import           Data.Primitive ( Prim, sizeOf )
 
 import GHC.ST   ( ST(..) )
 
@@ -29,15 +27,15 @@ import GHC.Base ( Int(..) )
 -- | Mutable unboxed vectors. They live in the 'ST' monad.
 data Vector s a = Vector {-# UNPACK #-} !Int
                          {-# UNPACK #-} !Int
-                                        (MutableByteArray# s)
+                         {-# UNPACK #-} !(MutableByteArray s)
 
 instance Prim a => MVectorPure (Vector s) a where
   length (Vector _ n _) = n
-  unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#
+  unsafeSlice (Vector i _ arr) j m = Vector (i+j) m arr
 
   {-# INLINE overlaps #-}
-  overlaps (Vector i m arr1#) (Vector j n arr2#)
-    = sameMutableByteArray# arr1# arr2#
+  overlaps (Vector i m arr1) (Vector j n arr2)
+    = sameMutableByteArray arr1 arr2
       && (between i j (j+n) || between j i (i+m))
     where
       between x y z = x >= y && x < z
@@ -45,18 +43,15 @@ instance Prim a => MVectorPure (Vector s) a where
 
 instance Prim a => MVector (Vector s) (ST s) a where
   {-# INLINE unsafeNew #-}
-  unsafeNew (I# n#) = ST (\s# ->
-      case newByteArray# (size# (undefined :: a) n#) s# of
-        (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)
-    )
+  unsafeNew n = do
+                  arr <- newByteArray (n * sizeOf (undefined :: a))
+                  return (Vector 0 n arr)
 
   {-# INLINE unsafeRead #-}
-  unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (read# arr# (i# +# j#))
+  unsafeRead (Vector i _ arr) j = readByteArray arr (i+j)
 
   {-# INLINE unsafeWrite #-}
-  unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->
-      case write# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)
-    )
+  unsafeWrite (Vector i _ arr) j x = writeByteArray arr (i+j) x
 
   {-# INLINE clear #-}
   clear _ = return ()
diff --git a/Data/Vector/Primitive/Prim.hs b/Data/Vector/Primitive/Prim.hs
deleted file mode 100644 (file)
index df5d1cd..0000000
+++ /dev/null
@@ -1,89 +0,0 @@
-{-# LANGUAGE MagicHash, UnboxedTuples, CPP #-}
-
--- |
--- Module      : Data.Vector.Primitive.Prim
--- Copyright   : (c) Roman Leshchinskiy 2008
--- License     : BSD-style
---
--- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
--- Stability   : experimental
--- Portability : non-portable
--- 
--- Primitives for manipulating unboxed arrays of primitive types.
---
-
-module Data.Vector.Primitive.Prim (
-  Prim(..)
-) where
-
-import GHC.Base (
-    Int(..), Char(..),
-  )
-import GHC.Float (
-    Float(..), Double(..)
-  )
-import GHC.Word (
-    Word(..), Word8(..), Word16(..), Word32(..), Word64(..)
-  )
-import GHC.Int (
-    Int8(..), Int16(..), Int32(..), Int64(..)
-  )
-
-import GHC.Prim
-import Data.Array.Base (
-    wORD_SCALE, fLOAT_SCALE, dOUBLE_SCALE
-  )
-
--- | Class of types that can be stored in primitive arrays
-class Prim a where
-  -- | Yield the size in bytes of a 'ByteArray#' which can store @n@ elements
-  size#  :: a     -- ^ Dummy type parameter, never evaluated
-         -> Int#  -- ^ Number of elements
-         -> Int#
-
-  -- | Indexing
-  at#    :: ByteArray# -> Int# -> a
-
-  -- | Yield the element at the given position
-  read#  :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
-
-  -- | Store the given element at the given position
-  write# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
-
--- FIXME: use Template Haskell as soon as it properly supports unboxed types
--- and especially tuples
-#define derivePrim(ty, ctr, scale, idx, rd, wr)  \
-instance Prim ty where {                         \
-  size#  _         = scale                       \
-; at#    arr# i#   = ctr (idx arr# i#)           \
-; read#  arr# i# s# = case rd arr# i# s# of      \
-                        { (# s1#, x# #) -> (# s1#, ctr x# #) } \
-; write# arr# i# (ctr x#) s# = wr arr# i# x# s# }
-
-derivePrim(Word, W#, wORD_SCALE,
-           indexWordArray#, readWordArray#, writeWordArray#)
-derivePrim(Word8, W8#, (\n# -> n#),
-           indexWord8Array#, readWord8Array#, writeWord8Array#)
-derivePrim(Word16, W16#, (*# 2#),
-           indexWord16Array#, readWord16Array#, writeWord16Array#)
-derivePrim(Word32, W32#, (*# 4#),
-           indexWord32Array#, readWord32Array#, writeWord32Array#)
-derivePrim(Word64, W64#, (*# 8#),
-           indexWord64Array#, readWord64Array#, writeWord64Array#)
-derivePrim(Int, I#, wORD_SCALE,
-           indexIntArray#, readIntArray#, writeIntArray#)
-derivePrim(Int8, I8#, (\n# -> n#),
-           indexInt8Array#, readInt8Array#, writeInt8Array#)
-derivePrim(Int16, I16#, (*# 2#),
-           indexInt16Array#, readInt16Array#, writeInt16Array#)
-derivePrim(Int32, I32#, (*# 4#),
-           indexInt32Array#, readInt32Array#, writeInt32Array#)
-derivePrim(Int64, I64#, (*# 8#),
-           indexInt64Array#, readInt64Array#, writeInt64Array#)
-derivePrim(Float, F#, fLOAT_SCALE,
-           indexFloatArray#, readFloatArray#, writeFloatArray#)
-derivePrim(Double, D#, dOUBLE_SCALE,
-           indexDoubleArray#, readDoubleArray#, writeDoubleArray#)
-derivePrim(Char, C#, (*# 4#),
-           indexWideCharArray#, readWideCharArray#, writeWideCharArray#)
-
index 50c01c8..aae3f19 100644 (file)
@@ -44,7 +44,6 @@ Library
         Data.Vector.MVector.New
         Data.Vector.IVector
 
-        Data.Vector.Primitive.Prim
         Data.Vector.Primitive.Mutable.ST
         Data.Vector.Primitive.Mutable.IO
         Data.Vector.Primitive
@@ -63,7 +62,7 @@ Library
         phases.h
 
   Build-Depends: base >= 2 && < 4, array, ghc-prim,
-                 ghc >= 6.9
+                 ghc >= 6.9, primitive-types
 
 -- -finline-if-enough-args is ESSENTIAL. If we don't have this the partial application
 -- of e.g. Stream.Monadic.++ to the monad dictionary at the use site in Stream.++ causes