Repository : ssh://darcs.haskell.org//srv/darcs/packages/primitive On branch : master
http://hackage.haskell.org/trac/ghc/changeset/56697cbacddcc8165d27db5cd9e03001642ba5c5 >--------------------------------------------------------------- commit 56697cbacddcc8165d27db5cd9e03001642ba5c5 Author: Roman Leshchinskiy <[email protected]> Date: Fri Aug 26 22:54:07 2011 +0000 Fix various deprecation warnings >--------------------------------------------------------------- Control/Monad/Primitive.hs | 4 ++++ Data/Primitive/Array.hs | 9 +++++---- Data/Primitive/ByteArray.hs | 9 +++++---- Data/Primitive/Internal/Compat.hs | 10 ++++++++++ Data/Primitive/MachDeps.hs | 2 -- Data/Primitive/Types.hs | 7 ++++--- primitive.cabal | 4 ++++ 7 files changed, 32 insertions(+), 13 deletions(-) diff --git a/Control/Monad/Primitive.hs b/Control/Monad/Primitive.hs index f4fd670..4761b3c 100644 --- a/Control/Monad/Primitive.hs +++ b/Control/Monad/Primitive.hs @@ -21,7 +21,11 @@ module Control.Monad.Primitive ( import GHC.Prim ( State#, RealWorld, touch# ) import GHC.Base ( unsafeCoerce#, realWorld# ) +#if MIN_VERSION_base(4,2,0) +import GHC.IO ( IO(..) ) +#else import GHC.IOBase ( IO(..) ) +#endif import GHC.ST ( ST(..) ) -- | Class of primitive state-transformer monads diff --git a/Data/Primitive/Array.hs b/Data/Primitive/Array.hs index 993dad9..d0d140a 100644 --- a/Data/Primitive/Array.hs +++ b/Data/Primitive/Array.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns, CPP #-} +{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable, BangPatterns #-} -- | -- Module : Data.Primitive.Array @@ -25,7 +25,8 @@ import GHC.Base ( Int(..) ) import GHC.Prim import Data.Typeable ( Typeable ) -import Data.Data ( Data(..), mkNorepType ) +import Data.Data ( Data(..) ) +import Data.Primitive.Internal.Compat ( mkNoRepType ) -- | Boxed arrays data Array a = Array (Array# a) deriving ( Typeable ) @@ -156,10 +157,10 @@ copyMutableArray !src !soff !dst !doff !len = go 0 instance Typeable a => Data (Array a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.Array.Array" + dataTypeOf _ = mkNoRepType "Data.Primitive.Array.Array" instance (Typeable s, Typeable a) => Data (MutableArray s a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.Array.MutableArray" + dataTypeOf _ = mkNoRepType "Data.Primitive.Array.MutableArray" diff --git a/Data/Primitive/ByteArray.hs b/Data/Primitive/ByteArray.hs index 8806718..ae98cee 100644 --- a/Data/Primitive/ByteArray.hs +++ b/Data/Primitive/ByteArray.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MagicHash, UnboxedTuples, ForeignFunctionInterface, - UnliftedFFITypes, DeriveDataTypeable, CPP #-} + UnliftedFFITypes, DeriveDataTypeable #-} -- | -- Module : Data.Primitive.ByteArray @@ -35,7 +35,8 @@ import GHC.Base ( Int(..) ) import GHC.Prim import Data.Typeable ( Typeable ) -import Data.Data ( Data(..), mkNorepType ) +import Data.Data ( Data(..) ) +import Data.Primitive.Internal.Compat ( mkNoRepType ) -- | Byte arrays data ByteArray = ByteArray ByteArray# deriving ( Typeable ) @@ -273,10 +274,10 @@ foreign import ccall unsafe "primitive-memops.h memset_off" instance Data ByteArray where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.ByteArray.ByteArray" + dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.ByteArray" instance Typeable s => Data (MutableByteArray s) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.ByteArray.MutableByteArray" + dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.MutableByteArray" diff --git a/Data/Primitive/Internal/Compat.hs b/Data/Primitive/Internal/Compat.hs new file mode 100644 index 0000000..5414765 --- /dev/null +++ b/Data/Primitive/Internal/Compat.hs @@ -0,0 +1,10 @@ +module Data.Primitive.Internal.Compat (mkNoRepType) where + +#if MIN_VERSION_base(4,2,0) +import Data.Data (mkNoRepType) +#else +import Data.Data (mkNorepType) + +mkNoRepType = mkNorepType +#endif + diff --git a/Data/Primitive/MachDeps.hs b/Data/Primitive/MachDeps.hs index 5bb828e..326be4a 100644 --- a/Data/Primitive/MachDeps.hs +++ b/Data/Primitive/MachDeps.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- Module : Data.Primitive.MachDeps -- Copyright : (c) Roman Leshchinskiy 2009 diff --git a/Data/Primitive/Types.hs b/Data/Primitive/Types.hs index c97a8e3..3206878 100644 --- a/Data/Primitive/Types.hs +++ b/Data/Primitive/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE UnboxedTuples, MagicHash, CPP, DeriveDataTypeable #-} +{-# LANGUAGE UnboxedTuples, MagicHash, DeriveDataTypeable #-} -- | -- Module : Data.Primitive.Types @@ -36,7 +36,8 @@ import GHC.Int ( import GHC.Prim import Data.Typeable ( Typeable ) -import Data.Data ( Data(..), mkNorepType ) +import Data.Data ( Data(..) ) +import Data.Primitive.Internal.Compat ( mkNoRepType ) -- | A machine address data Addr = Addr Addr# deriving ( Typeable ) @@ -54,7 +55,7 @@ instance Ord Addr where instance Data Addr where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNorepType "Data.Primitive.Types.Addr" + dataTypeOf _ = mkNoRepType "Data.Primitive.Types.Addr" -- | Class of types supporting primitive array operations diff --git a/primitive.cabal b/primitive.cabal index 0ab3c30..8db51f1 100644 --- a/primitive.cabal +++ b/primitive.cabal @@ -30,6 +30,7 @@ Cabal-Version: >= 1.2 Build-Type: Simple Library + Extensions: CPP Exposed-Modules: Control.Monad.Primitive Data.Primitive @@ -39,6 +40,9 @@ Library Data.Primitive.ByteArray Data.Primitive.Addr + Other-Modules: + Data.Primitive.Internal.Compat + Build-Depends: base >= 4 && < 5, ghc-prim Ghc-Options: -O2 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
