Change handling of Monad in MVector and get rid of GADTs
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sat, 12 Jul 2008 06:32:30 +0000 (06:32 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Sat, 12 Jul 2008 06:32:30 +0000 (06:32 +0000)
Data/Vector.hs
Data/Vector/IVector.hs
Data/Vector/MVector.hs
Data/Vector/Mutable.hs
Data/Vector/Unboxed.hs
Data/Vector/Unboxed/Mutable.hs

index 5d79a33..a1df02d 100644 (file)
@@ -33,7 +33,7 @@ instance IVector Vector a where
   {-# INLINE create #-}
   create init = runST (do_create init)
     where
-      do_create :: ST s (Mut.Vector (ST s) a) -> ST s (Vector a)
+      do_create :: ST s (Mut.Vector s a) -> ST s (Vector a)
       do_create init = do
                          Mut.Vector i n marr# <- init
                          ST (\s# -> case unsafeFreezeArray# marr# s# of
index 31bd21a..ea28ffe 100644 (file)
@@ -75,12 +75,11 @@ import Prelude hiding ( length,
                         elem, notElem,
                         foldl, foldl1, foldr, foldr1 )
 
--- | Class of immutable vectors. Just like with 'MVector', the type of the
--- elements can be restricted by using GADTs.
+-- | Class of immutable vectors.
 --
 class IVector v a where
   -- | Construct a pure vector from a monadic initialiser.
-  create       :: (forall mv m. MVector mv m a => m (mv a)) -> v a
+  create       :: (forall mv m. MVector mv m a => m (mv a)) -> v a
 
   -- | Length of the vector (not fusible!)
   vlength      :: v a -> Int
index d519e61..b26d0c3 100644 (file)
@@ -12,7 +12,7 @@
 --
 
 module Data.Vector.MVector (
-  MVector(..),
+  MVectorPure(..), MVector(..),
 
   slice, new, newWith, read, write, copy, grow, unstream
 ) where
@@ -33,56 +33,47 @@ import Prelude hiding ( length, read )
 gROWTH_FACTOR :: Double
 gROWTH_FACTOR = 1.5
 
--- | Class of mutable vectors. The type @m@ is the monad in which the mutable
--- vector can be transformed and @a@ is the type of elements. A vector does
--- not necessarily have to be generic in either of them (indeed, it would be
--- unusual for a vector to be generic in the monad). Use GADTs if this is the
--- case. For instance, regular boxed vectors are defined as
---
--- > data Vector m a where
--- >   Vector :: !Int -> !Int -> MutableArray# s a -> Vector (ST s) a
---
--- This is a bit clumsy but I haven't been able to find a better solution. In
--- particular, using a type function for the monad triggers
--- <http://hackage.haskell.org/trac/ghc/ticket/2440> and is probably less
--- portable.
---
-class Monad m => MVector v m a where
+-- | Basic pure functions on mutable vectors
+class MVectorPure v a where
   -- | Length of the mutable vector
-  length           :: v a -> Int
+  length           :: v a -> Int
 
   -- | Yield a part of the mutable vector without copying it. No range checks!
-  unsafeSlice      :: v m a -> Int  -- ^ starting index
-                            -> Int  -- ^ length of the slice
-                            -> v m a
+  unsafeSlice      :: v a -> Int  -- ^ starting index
+                          -> Int  -- ^ length of the slice
+                          -> v a
+
+  -- Check whether two vectors overlap.
+  overlaps         :: v a -> v a -> Bool
 
+-- | Class of mutable vectors. The type @m@ is the monad in which the mutable
+-- vector can be transformed and @a@ is the type of elements.
+--
+class (Monad m, MVectorPure v a) => MVector v m a where
   -- | Create a mutable vector of the given length. Length is not checked!
-  unsafeNew        :: Int -> m (v a)
+  unsafeNew        :: Int -> m (v a)
 
   -- | Create a mutable vector of the given length and fill it with an
   -- initial value. Length is not checked!
-  unsafeNewWith    :: Int -> a -> m (v a)
+  unsafeNewWith    :: Int -> a -> m (v a)
 
   -- | Yield the element at the given position. Index is not checked!
-  unsafeRead       :: v a -> Int -> m a
+  unsafeRead       :: v a -> Int -> m a
 
   -- | Replace the element at the given position. Index is not checked!
-  unsafeWrite      :: v a -> Int -> a -> m ()
+  unsafeWrite      :: v a -> Int -> a -> m ()
 
   -- | Write the value at each position.
-  set              :: v a -> a -> m ()
+  set              :: v a -> a -> m ()
 
   -- | Copy a vector. The two vectors may not overlap. This is not checked!
-  unsafeCopy       :: v a   -- ^ target
-                   -> v a   -- ^ source
+  unsafeCopy       :: v a   -- ^ target
+                   -> v a   -- ^ source
                    -> m ()
 
   -- | Grow a vector by the given number of elements. The length is not
   -- checked!
-  unsafeGrow       :: v m a -> Int -> m (v m a)
-
-  -- Check whether two vectors overlap.
-  overlaps         :: v m a -> v m a -> Bool
+  unsafeGrow       :: v a -> Int -> m (v a)
 
   {-# INLINE unsafeNewWith #-}
   unsafeNewWith n x = do
@@ -120,50 +111,50 @@ class Monad m => MVector v m a where
       n = length v
 
 -- | Test whether the index is valid for the vector
-inBounds :: MVector v m a => v m a -> Int -> Bool
+inBounds :: MVectorPure v a => v a -> Int -> Bool
 {-# INLINE inBounds #-}
 inBounds v i = i >= 0 && i < length v
 
 -- | Yield a part of the mutable vector without copying it. Safer version of
 -- 'unsafeSlice'.
-slice :: MVector v m a => v m a -> Int -> Int -> v m a
+slice :: MVectorPure v a => v a -> Int -> Int -> v a
 {-# INLINE slice #-}
 slice v i n = assert (i >=0 && n >= 0 && i+n <= length v)
             $ unsafeSlice v i n
 
 -- | Create a mutable vector of the given length. Safer version of
 -- 'unsafeNew'.
-new :: MVector v m a => Int -> m (v a)
+new :: MVector v m a => Int -> m (v a)
 {-# INLINE new #-}
 new n = assert (n >= 0) $ unsafeNew n
 
 -- | Create a mutable vector of the given length and fill it with an
 -- initial value. Safer version of 'unsafeNewWith'.
-newWith :: MVector v m a => Int -> a -> m (v a)
+newWith :: MVector v m a => Int -> a -> m (v a)
 {-# INLINE newWith #-}
 newWith n x = assert (n >= 0) $ unsafeNewWith n x
 
 -- | Yield the element at the given position. Safer version of 'unsafeRead'.
-read :: MVector v m a => v a -> Int -> m a
+read :: MVector v m a => v a -> Int -> m a
 {-# INLINE read #-}
 read v i = assert (inBounds v i) $ unsafeRead v i
 
 -- | Replace the element at the given position. Safer version of
 -- 'unsafeWrite'.
-write :: MVector v m a => v a -> Int -> a -> m ()
+write :: MVector v m a => v a -> Int -> a -> m ()
 {-# INLINE write #-}
 write v i x = assert (inBounds v i) $ unsafeWrite v i x
 
 -- | Copy a vector. The two vectors may not overlap. Safer version of
 -- 'unsafeCopy'.
-copy :: MVector v m a => v m a -> v m a -> m ()
+copy :: MVector v m a => v a -> v a -> m ()
 {-# INLINE copy #-}
 copy dst src = assert (not (dst `overlaps` src) && length dst == length src)
              $ unsafeCopy dst src
 
 -- | Grow a vector by the given number of elements. Safer version of
 -- 'unsafeGrow'.
-grow :: MVector v m a => v m a -> Int -> m (v m a)
+grow :: MVector v m a => v a -> Int -> m (v a)
 {-# INLINE grow #-}
 grow v by = assert (by >= 0)
           $ unsafeGrow v by
@@ -172,13 +163,13 @@ grow v by = assert (by >= 0)
 -- | Create a new mutable vector and fill it with elements from the 'Stream'.
 -- The vector will grow logarithmically if the 'Size' hint of the 'Stream' is
 -- inexact.
-unstream :: MVector v m a => Stream a -> m (v a)
+unstream :: MVector v m a => Stream a -> m (v a)
 {-# INLINE unstream #-}
 unstream s = case upperBound (Stream.size s) of
                Just n  -> unstreamMax     s n
                Nothing -> unstreamUnknown s
 
-unstreamMax :: MVector v m a => Stream a -> Int -> m (v a)
+unstreamMax :: MVector v m a => Stream a -> Int -> m (v a)
 {-# INLINE unstreamMax #-}
 unstreamMax s n
   = do
@@ -187,7 +178,7 @@ unstreamMax s n
       n' <- Stream.foldM put 0 s
       return $ slice v 0 n'
 
-unstreamUnknown :: MVector v m a => Stream a -> m (v a)
+unstreamUnknown :: MVector v m a => Stream a -> m (v a)
 {-# INLINE unstreamUnknown #-}
 unstreamUnknown s
   = do
index ced0233..ea56ded 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, GADTs, FlexibleInstances #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances #-}
 
 -- |
 -- Module      : Data.Vector.Mutable
@@ -16,7 +16,7 @@ module Data.Vector.Mutable ( Vector(..) )
 where
 
 import qualified Data.Vector.MVector as MVector
-import           Data.Vector.MVector ( MVector )
+import           Data.Vector.MVector ( MVector, MVectorPure )
 
 import GHC.Prim ( MutableArray#,
                   newArray#, readArray#, writeArray#, sameMutableArray#, (+#) )
@@ -25,25 +25,24 @@ import GHC.ST   ( ST(..) )
 
 import GHC.Base ( Int(..) )
 
-#ifndef __HADDOCK__
-data Vector m a where
-  Vector :: {-# UNPACK #-} !Int
-         -> {-# UNPACK #-} !Int
-         -> MutableArray# s a
-         -> Vector (ST s) a
-#else
--- | Type of mutable boxed vectors. This is actually a GADT:
---
--- > data Vector m a where
--- >   Vector :: !Int -> !Int -> MutableArray# s a -> Vector (ST s) a
---
-data Vector m a = forall s. Vector !Int !Int (MutableArray# s a)
-#endif
+-- | Mutable boxed vectors. They live in the 'ST' monad.
+data Vector s a = Vector {-# UNPACK #-} !Int
+                         {-# UNPACK #-} !Int
+                                        (MutableArray# s a)
 
-instance MVector Vector (ST s) a where
+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
 
@@ -58,18 +57,12 @@ instance MVector Vector (ST s) a where
       case writeArray# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)
     )
 
-  {-# 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
 
-unsafeNew :: Int -> ST s (Vector (ST s) a)
+unsafeNew :: Int -> ST s (Vector s a)
 {-# INLINE unsafeNew #-}
 unsafeNew n = unsafeNewWith n (error "Data.Vector.Mutable: uninitialised elemen t")
 
-unsafeNewWith :: Int -> a -> ST s (Vector (ST s) a)
+unsafeNewWith :: Int -> a -> ST s (Vector s a)
 {-# INLINE unsafeNewWith #-}
 unsafeNewWith (I# n#) x = ST (\s# ->
     case newArray# n# x s# of
index 794c95e..ff40932 100644 (file)
@@ -34,7 +34,7 @@ instance Unbox a => IVector Vector a where
   {-# INLINE create #-}
   create init = runST (do_create init)
     where
-      do_create :: ST s (Mut.Vector (ST s) a) -> ST s (Vector a)
+      do_create :: ST s (Mut.Vector s a) -> ST s (Vector a)
       do_create init = do
                          Mut.Vector i n marr# <- init
                          ST (\s# -> case unsafeFreezeByteArray# marr# s# of
index 2dacab0..56e647f 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, GADTs, ScopedTypeVariables #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}
 
 -- |
 -- Module      : Data.Vector.Unboxed.Mutable
@@ -16,7 +16,7 @@ module Data.Vector.Unboxed.Mutable ( Vector(..) )
 where
 
 import qualified Data.Vector.MVector as MVector
-import           Data.Vector.MVector ( MVector )
+import           Data.Vector.MVector ( MVector, MVectorPure )
 import           Data.Vector.Unboxed.Unbox
 
 import GHC.Prim ( MutableByteArray#,
@@ -26,25 +26,24 @@ import GHC.ST   ( ST(..) )
 
 import GHC.Base ( Int(..) )
 
-#ifndef __HADDOCK__
-data Vector m a where
-   Vector :: {-# UNPACK #-} !Int
-          -> {-# UNPACK #-} !Int
-          -> MutableByteArray# s
-          -> Vector (ST s) a
-#else
--- | Type of mutable unboxed vectors. This is actually a GADT:
---
--- > data Vector m a where
--- >   Vector :: !Int -> !Int -> MutableByteArray# s -> Vector (ST s) a
---
-data Vector m a = forall s. Vector !Int !Int (MutableByteArray# s)
-#endif
+-- | Mutable unboxed vectors. They live in the 'ST' monad.
+data Vector s a = Vector {-# UNPACK #-} !Int
+                         {-# UNPACK #-} !Int
+                                        (MutableByteArray# s)
 
-instance Unbox a => MVector Vector (ST s) a where
+instance Unbox a => 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#)
+    = sameMutableByteArray# arr1# arr2#
+      && (between i j (j+n) || between j i (i+m))
+    where
+      between x y z = x >= y && x < z
+
+
+instance Unbox a => MVector (Vector s) (ST s) a where
   {-# INLINE unsafeNew #-}
   unsafeNew (I# n#) = ST (\s# ->
       case newByteArray# (size# (undefined :: a) n#) s# of
@@ -59,10 +58,4 @@ instance Unbox a => MVector Vector (ST s) a where
       case write# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)
     )
 
-  {-# INLINE overlaps #-}
-  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