diff --git a/Control/Monad/Primitive.hs b/Control/Monad/Primitive.hs --- a/Control/Monad/Primitive.hs +++ b/Control/Monad/Primitive.hs @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Primitive state-transformer monads -- diff --git a/Data/Primitive.hs b/Data/Primitive.hs --- a/Data/Primitive.hs +++ b/Data/Primitive.hs @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Reexports all primitive operations -- module Data.Primitive ( diff --git a/Data/Primitive/Addr.hs b/Data/Primitive/Addr.hs --- a/Data/Primitive/Addr.hs +++ b/Data/Primitive/Addr.hs @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Primitive operations on machine addresses -- diff --git a/Data/Primitive/Array.hs b/Data/Primitive/Array.hs --- a/Data/Primitive/Array.hs +++ b/Data/Primitive/Array.hs @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Primitive boxed arrays -- @@ -26,7 +26,7 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) -import Data.Primitive.Internal.Compat ( mkNoRepType ) +import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -- | Boxed arrays data Array a = Array (Array# a) deriving ( Typeable ) @@ -81,7 +81,7 @@ -- Now, indexing is executed immediately although the returned element is -- still not evaluated. -- -indexArrayM :: Monad m => Array a -> Int -> m a +indexArrayM :: Monad m => Array a -> Int -> m a {-# INLINE indexArrayM #-} indexArrayM (Array arr#) (I# i#) = case indexArray# arr# i# of (# x #) -> return x @@ -106,7 +106,7 @@ sameMutableArray :: MutableArray s a -> MutableArray s a -> Bool {-# INLINE sameMutableArray #-} sameMutableArray (MutableArray arr#) (MutableArray brr#) - = sameMutableArray# arr# brr# + = isTrue# (sameMutableArray# arr# brr#) -- | Copy a slice of an immutable array to a mutable array. copyArray :: PrimMonad m @@ -165,4 +165,3 @@ toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.Array.MutableArray" - diff --git a/Data/Primitive/ByteArray.hs b/Data/Primitive/ByteArray.hs --- a/Data/Primitive/ByteArray.hs +++ b/Data/Primitive/ByteArray.hs @@ -8,7 +8,7 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Primitive operations on ByteArrays -- @@ -47,7 +47,7 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) -import Data.Primitive.Internal.Compat ( mkNoRepType ) +import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -- | Byte arrays data ByteArray = ByteArray ByteArray# deriving ( Typeable ) @@ -99,7 +99,7 @@ sameMutableByteArray :: MutableByteArray s -> MutableByteArray s -> Bool {-# INLINE sameMutableByteArray #-} sameMutableByteArray (MutableByteArray arr#) (MutableByteArray brr#) - = sameMutableByteArray# arr# brr# + = isTrue# (sameMutableByteArray# arr# brr#) -- | Convert a mutable byte array to an immutable one without copying. The -- array should not be modified after the conversion. @@ -263,4 +263,3 @@ toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "Data.Primitive.ByteArray.MutableByteArray" - diff --git a/Data/Primitive/Internal/Compat.hs b/Data/Primitive/Internal/Compat.hs --- a/Data/Primitive/Internal/Compat.hs +++ b/Data/Primitive/Internal/Compat.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE MagicHash #-} + -- | -- Module : Data.Primitive.Internal.Compat -- Copyright : (c) Roman Leshchinskiy 2011-2012 @@ -5,17 +7,32 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Compatibility functions -- -module Data.Primitive.Internal.Compat (mkNoRepType) where +module Data.Primitive.Internal.Compat ( + isTrue# + , mkNoRepType + ) where #if MIN_VERSION_base(4,2,0) import Data.Data (mkNoRepType) #else import Data.Data (mkNorepType) +#endif +#if MIN_VERSION_base(4,7,0) +import GHC.Exts (isTrue#) +#endif + + + +#if !MIN_VERSION_base(4,2,0) mkNoRepType = mkNorepType #endif +#if !MIN_VERSION_base(4,7,0) +isTrue# :: Bool -> Bool +isTrue# b = b +#endif diff --git a/Data/Primitive/Internal/Operations.hs b/Data/Primitive/Internal/Operations.hs --- a/Data/Primitive/Internal/Operations.hs +++ b/Data/Primitive/Internal/Operations.hs @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Internal operations -- diff --git a/Data/Primitive/MachDeps.hs b/Data/Primitive/MachDeps.hs --- a/Data/Primitive/MachDeps.hs +++ b/Data/Primitive/MachDeps.hs @@ -6,7 +6,7 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Machine-dependent constants -- diff --git a/Data/Primitive/MutVar.hs b/Data/Primitive/MutVar.hs --- a/Data/Primitive/MutVar.hs +++ b/Data/Primitive/MutVar.hs @@ -7,13 +7,13 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Primitive boxed mutable variables -- module Data.Primitive.MutVar ( MutVar(..), - + newMutVar, readMutVar, writeMutVar, @@ -25,6 +25,7 @@ import Control.Monad.Primitive ( PrimMonad(..), primitive_ ) import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, readMutVar#, writeMutVar#, atomicModifyMutVar# ) +import Data.Primitive.Internal.Compat ( isTrue# ) import Data.Typeable ( Typeable ) -- | A 'MutVar' behaves like a single-element mutable array associated @@ -33,7 +34,7 @@ deriving ( Typeable ) instance Eq (MutVar s a) where - MutVar mva# == MutVar mvb# = sameMutVar# mva# mvb# + MutVar mva# == MutVar mvb# = isTrue# (sameMutVar# mva# mvb#) -- | Create a new 'MutVar' with the specified initial value newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a) @@ -57,7 +58,7 @@ {-# INLINE atomicModifyMutVar #-} atomicModifyMutVar (MutVar mv#) f = primitive $ atomicModifyMutVar# mv# f --- | Mutate the contents of a 'MutVar' +-- | Mutate the contents of a 'MutVar' modifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () {-# INLINE modifyMutVar #-} modifyMutVar (MutVar mv#) g = primitive_ $ \s# -> diff --git a/Data/Primitive/Types.hs b/Data/Primitive/Types.hs --- a/Data/Primitive/Types.hs +++ b/Data/Primitive/Types.hs @@ -7,7 +7,7 @@ -- -- Maintainer : Roman Leshchinskiy -- Portability : non-portable --- +-- -- Basic types and classes for primitive array operations -- @@ -42,20 +42,20 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) -import Data.Primitive.Internal.Compat ( mkNoRepType ) +import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) -- | A machine address data Addr = Addr Addr# deriving ( Typeable ) instance Eq Addr where - Addr a# == Addr b# = eqAddr# a# b# - Addr a# /= Addr b# = neAddr# a# b# + Addr a# == Addr b# = isTrue# (eqAddr# a# b#) + Addr a# /= Addr b# = isTrue# (neAddr# a# b#) instance Ord Addr where - Addr a# > Addr b# = gtAddr# a# b# - Addr a# >= Addr b# = geAddr# a# b# - Addr a# < Addr b# = ltAddr# a# b# - Addr a# <= Addr b# = leAddr# a# b# + Addr a# > Addr b# = isTrue# (gtAddr# a# b#) + Addr a# >= Addr b# = isTrue# (geAddr# a# b#) + Addr a# < Addr b# = isTrue# (ltAddr# a# b#) + Addr a# <= Addr b# = isTrue# (leAddr# a# b#) instance Data Addr where toConstr _ = error "toConstr" @@ -181,4 +181,3 @@ derivePrim(Addr, Addr, sIZEOF_PTR, aLIGNMENT_PTR, indexAddrArray#, readAddrArray#, writeAddrArray#, setAddrArray#, indexAddrOffAddr#, readAddrOffAddr#, writeAddrOffAddr#, setAddrOffAddr#) - diff --git a/primitive.cabal b/primitive.cabal --- a/primitive.cabal +++ b/primitive.cabal @@ -1,11 +1,12 @@ Name: primitive -Version: 0.5.0.1 +Version: 0.5.1.0 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Maintainer: Roman Leshchinskiy Copyright: (c) Roman Leshchinskiy 2009-2012 -Homepage: http://code.haskell.org/primitive +Homepage: https://github.com/haskell/primitive +Bug-Reports: https://github.com/haskell/primitive/issues Category: Data Synopsis: Primitive memory-related operations Description: @@ -23,7 +24,7 @@ * Efficient block fill operations: @setByteArray@, @setAddr@ . -Cabal-Version: >= 1.2 +Cabal-Version: >= 1.6 Build-Type: Simple Library @@ -55,3 +56,6 @@ cc-options: -msse2 } +source-repository head + type: git + location: https://github.com/haskell/primitive