EXPERIMENTAL: Unboxing infrastructure
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 7 Dec 2009 16:02:22 +0000 (16:02 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 7 Dec 2009 16:02:22 +0000 (16:02 +0000)
Data/Vector/Generic.hs
Data/Vector/Generic/New.hs
Data/Vector/Primitive.hs
Data/Vector/Storable.hs
Data/Vector/Unboxed/Base.hs
internal/GenUnboxTuple.hs
internal/unbox-tuple-instances

index c8c29fd..02d7df6 100644 (file)
@@ -150,6 +150,11 @@ class MVector (Mutable v) a => Vector v a where
   --
   basicUnsafeIndexM  :: Monad m => v a -> Int -> m a
 
+  elemseq :: v a -> a -> b -> b
+
+  {-# INLINE elemseq #-}
+  elemseq _ = \_ x -> x
+
 -- Fusion
 -- ------
 
@@ -164,9 +169,9 @@ new m = new' undefined m
 -- See http://hackage.haskell.org/trac/ghc/ticket/2600
 new' :: Vector v a => v a -> New a -> v a
 {-# INLINE_STREAM new' #-}
-new' _ m = runST (do
-                    mv <- New.run m
-                    unsafeFreeze mv)
+new' _ m = m `seq` runST (do
+                            mv <- New.run m
+                            unsafeFreeze mv)
 
 -- | Convert a vector to a 'Stream'
 stream :: Vector v a => v a -> Stream a
@@ -240,9 +245,11 @@ singleton :: Vector v a => a -> v a
 singleton x = unstream (Stream.singleton x)
 
 -- | Vector of the given length with the given value in each position
-replicate :: Vector v a => Int -> a -> v a
+replicate :: forall v a. Vector v a => Int -> a -> v a
 {-# INLINE replicate #-}
-replicate n = unstream . Stream.replicate n
+replicate n x = elemseq (undefined :: v a) x
+              $ unstream
+              $ Stream.replicate n x
 
 -- | Prepend an element
 cons :: Vector v a => a -> v a -> v a
index d26b876..a47e648 100644 (file)
@@ -30,7 +30,7 @@ import Prelude hiding ( init, tail, take, drop, reverse, map, filter )
 
 #include "vector.h"
 
-newtype New a = New (forall mv s. MVector mv a => ST s (mv s a))
+data New a = New (forall mv s. MVector mv a => ST s (mv s a))
 
 run :: MVector mv a => New a -> ST s (mv s a)
 {-# INLINE run #-}
@@ -46,7 +46,7 @@ modify (New p) q = New (do { v <- p; q v; return v })
 
 unstream :: Stream a -> New a
 {-# INLINE_STREAM unstream #-}
-unstream s = New (MVector.unstream s)
+unstream s = s `seq` New (MVector.unstream s)
 
 transform :: (forall m. Monad m => MStream m a -> MStream m a) -> New a -> New a
 {-# INLINE_STREAM transform #-}
@@ -118,19 +118,19 @@ drop n m = apply (\v -> MVector.unsafeSlice v
 
 unsafeAccum :: (a -> b -> a) -> New a -> Stream (Int, b) -> New a
 {-# INLINE_STREAM unsafeAccum #-}
-unsafeAccum f m s = modify m (\v -> MVector.unsafeAccum f v s)
+unsafeAccum f m s = s `seq` modify m (\v -> MVector.unsafeAccum f v s)
 
 accum :: (a -> b -> a) -> New a -> Stream (Int, b) -> New a
 {-# INLINE_STREAM accum #-}
-accum f m s = modify m (\v -> MVector.accum f v s)
+accum f m s = s `seq` modify m (\v -> MVector.accum f v s)
 
 unsafeUpdate :: New a -> Stream (Int, a) -> New a
 {-# INLINE_STREAM unsafeUpdate #-}
-unsafeUpdate m s = modify m (\v -> MVector.unsafeUpdate v s)
+unsafeUpdate m s = s `seq` modify m (\v -> MVector.unsafeUpdate v s)
 
 update :: New a -> Stream (Int, a) -> New a
 {-# INLINE_STREAM update #-}
-update m s = modify m (\v -> MVector.update v s)
+update m s = s `seq` modify m (\v -> MVector.update v s)
 
 reverse :: New a -> New a
 {-# INLINE_STREAM reverse #-}
index b99be90..f4939b6 100644 (file)
@@ -115,6 +115,9 @@ instance Prim a => G.Vector Vector a where
   {-# INLINE basicUnsafeIndexM #-}
   basicUnsafeIndexM (Vector i _ arr) j = return (indexByteArray arr (i+j))
 
+  {-# INLINE elemseq #-}
+  elemseq _ = seq
+
 instance (Prim a, Eq a) => Eq (Vector a) where
   {-# INLINE (==) #-}
   (==) = G.eq
index fc11e5d..a242e7d 100644 (file)
@@ -125,6 +125,9 @@ instance Storable a => G.Vector Vector a where
                                      . inlinePerformIO
                                      $ withForeignPtr p (`peekElemOff` (i+j))
 
+  {-# INLINE elemseq #-}
+  elemseq _ = seq
+
 instance (Storable a, Eq a) => Eq (Vector a) where
   {-# INLINE (==) #-}
   (==) = G.eq
index 76b19ae..3311032 100644 (file)
@@ -1,4 +1,5 @@
-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts,
+             ScopedTypeVariables #-}
 -- |
 -- Module      : Data.Vector.Unboxed.Base
 -- Copyright   : (c) Roman Leshchinskiy 2009
@@ -95,6 +96,9 @@ instance G.Vector Vector () where
   {-# INLINE basicUnsafeIndexM #-}
   basicUnsafeIndexM (V_Unit _) i = return ()
 
+  {-# INLINE elemseq #-}
+  elemseq _ = seq
+
 
 -- ---------------
 -- Primitive types
@@ -131,10 +135,12 @@ instance G.Vector Vector ty where {                                     \
 ; {-# INLINE basicLength #-}                                            \
 ; {-# INLINE basicUnsafeSlice #-}                                       \
 ; {-# INLINE basicUnsafeIndexM #-}                                      \
+; {-# INLINE elemseq #-}                                                \
 ; unsafeFreeze (mcon v) = con `liftM` G.unsafeFreeze v                  \
 ; basicLength (con v) = G.basicLength v                                 \
 ; basicUnsafeSlice (con v) i n = con $ G.basicUnsafeSlice v i n         \
-; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i }
+; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i                 \
+; elemseq _ = seq }
 
 newtype instance MVector s Int = MV_Int (P.MVector s Int)
 newtype instance Vector    Int = V_Int  (P.Vector    Int)
@@ -265,10 +271,12 @@ instance G.Vector Vector Bool where
   {-# INLINE basicLength #-}
   {-# INLINE basicUnsafeSlice #-}
   {-# INLINE basicUnsafeIndexM #-}
+  {-# INLINE elemseq #-}
   unsafeFreeze (MV_Bool v) = V_Bool `liftM` G.unsafeFreeze v
   basicLength (V_Bool v) = G.basicLength v
   basicUnsafeSlice (V_Bool v) i n = V_Bool $ G.basicUnsafeSlice v i n
   basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i
+  elemseq _ = seq
 
 -- -------
 -- Complex
@@ -308,11 +316,14 @@ instance (RealFloat a, Unbox a) => G.Vector Vector (Complex a) where
   {-# INLINE basicLength #-}
   {-# INLINE basicUnsafeSlice #-}
   {-# INLINE basicUnsafeIndexM #-}
+  {-# INLINE elemseq #-}
   unsafeFreeze (MV_Complex v) = V_Complex `liftM` G.unsafeFreeze v
   basicLength (V_Complex v) = G.basicLength v
   basicUnsafeSlice (V_Complex v) i n = V_Complex $ G.basicUnsafeSlice v i n
   basicUnsafeIndexM (V_Complex v) i
                 = uncurry (:+) `liftM` G.basicUnsafeIndexM v i
+  elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x
+                       $ G.elemseq (undefined :: Vector a) y z
 
 -- ------
 -- Tuples
index 11b145a..c176841 100644 (file)
@@ -181,8 +181,12 @@ generate n =
                         | vs <- varss | v <- vars]
                $ text "return" <+> tuple vars)
 
-    
-         
+    gen_elemseq rec
+      = (char '_' <+> tuple vars <+> var 'x',
+         vcat [qG rec <+> parens (text "undefined :: Vector" <+> v)
+                      <+> v <+> char '$' | v <- vars]
+         <+> var 'x')
+
 
     mk_do cmds ret = hang (text "do")
                           2
@@ -210,4 +214,5 @@ generate n =
     methods_Vector  = [("unsafeFreeze",           gen_unsafeFreeze)
                       ,("basicLength",            gen_length "V")
                       ,("basicUnsafeSlice",       gen_unsafeSlice "G" "V")
-                      ,("basicUnsafeIndexM",      gen_basicUnsafeIndexM)]
+                      ,("basicUnsafeIndexM",      gen_basicUnsafeIndexM)
+                      ,("elemseq",                gen_elemseq)]
index 5921e74..584269e 100644 (file)
@@ -80,6 +80,10 @@ instance (Unbox a, Unbox b) => G.Vector Vector (a, b) where
           a <- G.basicUnsafeIndexM as i_
           b <- G.basicUnsafeIndexM bs i_
           return (a, b)
+  {-# INLINE elemseq  #-}
+  elemseq _ (a, b) x_
+      = G.elemseq (undefined :: Vector a) a $
+        G.elemseq (undefined :: Vector b) b $ x_
 #endif
 #ifdef DEFINE_MUTABLE
 zip :: (Unbox a, Unbox b) => MVector s a ->
@@ -207,6 +211,11 @@ instance (Unbox a,
           b <- G.basicUnsafeIndexM bs i_
           c <- G.basicUnsafeIndexM cs i_
           return (a, b, c)
+  {-# INLINE elemseq  #-}
+  elemseq _ (a, b, c) x_
+      = G.elemseq (undefined :: Vector a) a $
+        G.elemseq (undefined :: Vector b) b $
+        G.elemseq (undefined :: Vector c) c $ x_
 #endif
 #ifdef DEFINE_MUTABLE
 zip3 :: (Unbox a, Unbox b, Unbox c) => MVector s a ->
@@ -366,6 +375,12 @@ instance (Unbox a,
           c <- G.basicUnsafeIndexM cs i_
           d <- G.basicUnsafeIndexM ds i_
           return (a, b, c, d)
+  {-# INLINE elemseq  #-}
+  elemseq _ (a, b, c, d) x_
+      = G.elemseq (undefined :: Vector a) a $
+        G.elemseq (undefined :: Vector b) b $
+        G.elemseq (undefined :: Vector c) c $
+        G.elemseq (undefined :: Vector d) d $ x_
 #endif
 #ifdef DEFINE_MUTABLE
 zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s a ->
@@ -564,6 +579,13 @@ instance (Unbox a,
           d <- G.basicUnsafeIndexM ds i_
           e <- G.basicUnsafeIndexM es i_
           return (a, b, c, d, e)
+  {-# INLINE elemseq  #-}
+  elemseq _ (a, b, c, d, e) x_
+      = G.elemseq (undefined :: Vector a) a $
+        G.elemseq (undefined :: Vector b) b $
+        G.elemseq (undefined :: Vector c) c $
+        G.elemseq (undefined :: Vector d) d $
+        G.elemseq (undefined :: Vector e) e $ x_
 #endif
 #ifdef DEFINE_MUTABLE
 zip5 :: (Unbox a,
@@ -811,6 +833,14 @@ instance (Unbox a,
           e <- G.basicUnsafeIndexM es i_
           f <- G.basicUnsafeIndexM fs i_
           return (a, b, c, d, e, f)
+  {-# INLINE elemseq  #-}
+  elemseq _ (a, b, c, d, e, f) x_
+      = G.elemseq (undefined :: Vector a) a $
+        G.elemseq (undefined :: Vector b) b $
+        G.elemseq (undefined :: Vector c) c $
+        G.elemseq (undefined :: Vector d) d $
+        G.elemseq (undefined :: Vector e) e $
+        G.elemseq (undefined :: Vector f) f $ x_
 #endif
 #ifdef DEFINE_MUTABLE
 zip6 :: (Unbox a,