From dbe7ecb25a28ca563d3c1d768f2d2333b5ff1a85 Mon Sep 17 00:00:00 2001 From: Mikhail Glushenkov Date: Mon, 17 Aug 2015 03:37:32 +0200 Subject: [PATCH] Fix GHC 7.10 warnings. --- Data/Vector.hs | 5 ++++- Data/Vector/Fusion/Bundle.hs | 2 +- Data/Vector/Fusion/Bundle/Monadic.hs | 14 +++++++++++--- Data/Vector/Fusion/Stream/Monadic.hs | 14 +++++++++++--- Data/Vector/Fusion/Util.hs | 4 +++- Data/Vector/Primitive.hs | 2 ++ Data/Vector/Storable.hs | 2 ++ Data/Vector/Unboxed.hs | 2 ++ Data/Vector/Unboxed/Base.hs | 6 +++++- include/vector.h | 1 - 10 files changed, 41 insertions(+), 11 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index db6dfb7..b100ad9 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -187,11 +187,14 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault ) -import Data.Monoid ( Monoid(..) ) import qualified Control.Applicative as Applicative import qualified Data.Foldable as Foldable import qualified Data.Traversable as Traversable +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +#endif + #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts (IsList(..)) #endif diff --git a/Data/Vector/Fusion/Bundle.hs b/Data/Vector/Fusion/Bundle.hs index 53bddda..aeb2945 100644 --- a/Data/Vector/Fusion/Bundle.hs +++ b/Data/Vector/Fusion/Bundle.hs @@ -111,7 +111,7 @@ type Bundle = M.Bundle Id type MBundle = M.Bundle inplace :: (forall m. Monad m => S.Stream m a -> S.Stream m b) - -> (Size -> Size) -> Bundle v a -> Bundle v b + -> (Size -> Size) -> Bundle v a -> Bundle v b {-# INLINE_FUSED inplace #-} inplace f g b = b `seq` M.fromStream (f (M.elements b)) (g (M.size b)) diff --git a/Data/Vector/Fusion/Bundle/Monadic.hs b/Data/Vector/Fusion/Bundle/Monadic.hs index 66789d9..9f9a81a 100644 --- a/Data/Vector/Fusion/Bundle/Monadic.hs +++ b/Data/Vector/Fusion/Bundle/Monadic.hs @@ -101,12 +101,20 @@ import Prelude hiding ( length, null, scanl, scanl1, enumFromTo, enumFromThenTo ) -import Data.Int ( Int8, Int16, Int32, Int64 ) -import Data.Word ( Word8, Word16, Word32, Word, Word64 ) +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) + +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word ) +#endif #include "vector.h" #include "MachDeps.h" +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ()) -- | Monadic streams @@ -888,6 +896,7 @@ enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len :: Monad m => Integer -> Integer -> Bundle m v Integer #-} +#if WORD_SIZE_IN_BITS > 32 -- FIXME: the "too large" test is totally wrong enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a @@ -906,7 +915,6 @@ enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done -#if WORD_SIZE_IN_BITS > 32 {-# RULES diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs index a0c13e4..7297587 100644 --- a/Data/Vector/Fusion/Stream/Monadic.hs +++ b/Data/Vector/Fusion/Stream/Monadic.hs @@ -89,8 +89,12 @@ import Prelude hiding ( length, null, scanl, scanl1, enumFromTo, enumFromThenTo ) -import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) + +#if !MIN_VERSION_base(4,8,0) import Data.Word ( Word8, Word16, Word32, Word, Word64 ) +#endif #if __GLASGOW_HASKELL__ >= 708 import GHC.Types ( SPEC(..) ) @@ -101,6 +105,10 @@ import GHC.Exts ( SpecConstrAnnotation(..) ) #include "vector.h" #include "MachDeps.h" +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + #if __GLASGOW_HASKELL__ < 708 data SPEC = SPEC | SPEC2 #if __GLASGOW_HASKELL__ >= 700 @@ -1403,6 +1411,8 @@ enumFromTo_big_word x y = x `seq` y `seq` Stream step x +#if WORD_SIZE_IN_BITS > 32 + -- FIXME: the "too large" test is totally wrong enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a {-# INLINE_FUSED enumFromTo_big_int #-} @@ -1412,8 +1422,6 @@ enumFromTo_big_int x y = x `seq` y `seq` Stream step x step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done -#if WORD_SIZE_IN_BITS > 32 - {-# RULES "enumFromTo [Stream]" diff --git a/Data/Vector/Fusion/Util.hs b/Data/Vector/Fusion/Util.hs index 50f6b4d..cef9d0a 100644 --- a/Data/Vector/Fusion/Util.hs +++ b/Data/Vector/Fusion/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Module : Data.Vector.Fusion.Util -- Copyright : (c) Roman Leshchinskiy 2009 @@ -16,7 +17,9 @@ module Data.Vector.Fusion.Util ( delay_inline, delayed_min ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative (Applicative(..)) +#endif -- | Identity monad newtype Id a = Id { unId :: a } @@ -55,4 +58,3 @@ delay_inline f = f delayed_min :: Int -> Int -> Int {-# INLINE [0] delayed_min #-} delayed_min m n = min m n - diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs index 251b595..1e9f54b 100644 --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -164,7 +164,9 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault ) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid ( Monoid(..) ) +#endif #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs index 1d0f46e..1a60dde 100644 --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -169,7 +169,9 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) import Text.Read ( Read(..), readListPrecDefault ) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid ( Monoid(..) ) +#endif #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs index 1b2062f..b9addc7 100644 --- a/Data/Vector/Unboxed.hs +++ b/Data/Vector/Unboxed.hs @@ -186,7 +186,9 @@ import Prelude hiding ( length, null, import Text.Read ( Read(..), readListPrecDefault ) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid ( Monoid(..) ) +#endif #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts (IsList(..)) diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs index ee41966..56c6735 100644 --- a/Data/Vector/Unboxed/Base.hs +++ b/Data/Vector/Unboxed/Base.hs @@ -30,10 +30,14 @@ import Control.DeepSeq ( NFData(rnf) ) import Control.Monad.Primitive import Control.Monad ( liftM ) -import Data.Word ( Word, Word8, Word16, Word32, Word64 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word ) +#endif + #if __GLASGOW_HASKELL__ >= 707 import Data.Typeable ( Typeable ) #else diff --git a/include/vector.h b/include/vector.h index df9200c..1568bb2 100644 --- a/include/vector.h +++ b/include/vector.h @@ -18,4 +18,3 @@ import qualified Data.Vector.Internal.Check as Ck #define PHASE_STREAM Please use "PHASE_FUSED" instead #define INLINE_STREAM Please use "INLINE_FUSED" instead -