diff --git a/Control/DeepSeq.hs b/Control/DeepSeq.hs --- a/Control/DeepSeq.hs +++ b/Control/DeepSeq.hs @@ -7,20 +7,18 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Safe #-} {-# LANGUAGE TypeOperators #-} - -#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} -#endif - -#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE EmptyCase #-} -#endif #if __GLASGOW_HASKELL__ >= 811 && __GLASGOW_HASKELL__ < 901 -- For the Option instance (https://gitlab.haskell.org/ghc/ghc/issues/15028) {-# OPTIONS_GHC -Wno-deprecations #-} #endif +#define BYTEARRAY_IN_BASE (__GLASGOW_HASKELL__ >= 903) +-- At the moment of writing GHC source tree has not yet bumped `base` version, +-- so using __GLASGOW_HASKELL__ as a proxy instead of MIN_VERSION_base(4,17,0). + ----------------------------------------------------------------------------- -- | -- Module : Control.DeepSeq @@ -109,62 +107,47 @@ import Foreign.C.Types import System.Exit ( ExitCode(..) ) import System.Mem.StableName ( StableName ) - -#if MIN_VERSION_base(4,6,0) import Data.Ord ( Down(Down) ) -#else -import Control.DeepSeq.BackDoor ( Down(Down) ) -#endif - -#if MIN_VERSION_base(4,7,0) import Data.Proxy ( Proxy(Proxy) ) -#endif #if MIN_VERSION_base(4,10,0) import Data.Type.Equality ( (:~:), (:~~:) ) -#elif MIN_VERSION_base(4,9,0) +#else import Data.Type.Equality ( (:~:) ) -#elif MIN_VERSION_base(4,7,0) -import Control.DeepSeq.BackDoor ( (:~:) ) #endif -#if MIN_VERSION_base(4,8,0) import Data.Functor.Identity ( Identity(..) ) import Data.Typeable ( rnfTypeRep, rnfTyCon ) import Data.Void ( Void, absurd ) import Numeric.Natural ( Natural ) -#else -import Data.Typeable ( typeRepTyCon, typeRepArgs, tyConPackage, tyConModule, tyConName ) -#endif -#if MIN_VERSION_base(4,9,0) import Data.List.NonEmpty ( NonEmpty (..) ) import Data.Semigroup as Semi -#endif -#if MIN_VERSION_base(4,9,0) import GHC.Stack.Types ( CallStack(..), SrcLoc(..) ) import Data.Functor.Compose import qualified Data.Functor.Sum as Functor import qualified Data.Functor.Product as Functor -#elif MIN_VERSION_base(4,8,1) -import GHC.Stack ( CallStack(..) ) -import GHC.SrcLoc ( SrcLoc(..) ) -#endif import GHC.Fingerprint.Type ( Fingerprint(..) ) import GHC.Generics +#ifdef MIN_VERSION_ghc_prim +#if MIN_VERSION_ghc_prim(0,7,0) +import GHC.Tuple (Solo (..)) +#endif +#endif + +#if BYTEARRAY_IN_BASE +import Data.Array.Byte (ByteArray(..)) +#endif + -- | Hidden internal type-class class GNFData arity f where grnf :: RnfArgs arity a -> f a -> () instance GNFData arity V1 where -#if __GLASGOW_HASKELL__ >= 708 grnf _ x = case x of {} -#else - grnf _ !_ = error "Control.DeepSeq.rnf: uninhabited type" -#endif data Zero data One @@ -184,17 +167,11 @@ grnf args = grnf args . unM1 {-# INLINEABLE grnf #-} -#if MIN_VERSION_base(4,9,0) - -- | Because 'URec' did not exist prior to @base-4.9@, this instance is only - -- defined on @base-4.9@ or later. - -- - -- @since 1.4.5.0 instance GNFData arity (URec a) where grnf _ = rwhnf -- Every URec data instance consists of a single data -- constructor containing a single strict field, so reducing -- any URec instance to WHNF suffices to reduce it to NF. {-# INLINEABLE grnf #-} -#endif instance (GNFData arity a, GNFData arity b) => GNFData arity (a :*: b) where grnf args (x :*: y) = grnf args x `seq` grnf args y @@ -215,6 +192,7 @@ grnf args = liftRnf (grnf args) . unComp1 infixr 0 $!! +infixr 0 `deepseq` -- | 'deepseq': fully evaluates the first argument, before returning the -- second. @@ -452,7 +430,6 @@ -- | @since 1.4.4.0 instance NFData MaskingState where rnf = rwhnf -#if MIN_VERSION_base(4,7,0) -- |@since 1.4.0.0 instance NFData (Proxy a) where rnf Proxy = () -- |@since 1.4.3.0 @@ -464,7 +441,6 @@ instance NFData1 ((:~:) a) where liftRnf _ = rwhnf -- | @since 1.4.3.0 instance NFData2 (:~:) where liftRnf2 _ _ = rwhnf -#endif #if MIN_VERSION_base(4,10,0) -- | @since 1.4.3.0 @@ -475,7 +451,6 @@ instance NFData2 (:~~:) where liftRnf2 _ _ = rwhnf #endif -#if MIN_VERSION_base(4,8,0) -- |@since 1.4.0.0 instance NFData a => NFData (Identity a) where rnf = rnf1 @@ -492,7 +467,6 @@ -- |@since 1.4.0.0 instance NFData Natural where rnf = rwhnf -#endif -- |@since 1.3.0.0 instance NFData (Fixed a) where rnf = rwhnf @@ -507,7 +481,6 @@ --Rational and complex numbers. -#if MIN_VERSION_base(4,9,0) -- | Available on @base >=4.9@ -- -- @since 1.4.3.0 @@ -540,9 +513,6 @@ rnf = rnf1 instance NFData a => NFData (Ratio a) where -#else -instance (Integral a, NFData a) => NFData (Ratio a) where -#endif rnf x = rnf (numerator x, denominator x) instance (NFData a) => NFData (Complex a) where @@ -594,27 +564,16 @@ -- We should use MIN_VERSION array(0,5,1,1) but that's not possible. -- There isn't an underscore to not break C preprocessor -#if __GLASGOW_HASKELL__ >= 711 instance (NFData a, NFData b) => NFData (Array a b) where -#else -instance (Ix a, NFData a, NFData b) => NFData (Array a b) where -#endif rnf x = rnf (bounds x, Data.Array.elems x) -#if __GLASGOW_HASKELL__ >= 711 -- |@since 1.4.3.0 instance (NFData a) => NFData1 (Array a) where -#else --- |@since 1.4.3.0 -instance (Ix a, NFData a) => NFData1 (Array a) where -#endif liftRnf r x = rnf (bounds x) `seq` liftRnf r (Data.Array.elems x) -#if __GLASGOW_HASKELL__ >= 711 -- |@since 1.4.3.0 instance NFData2 Array where liftRnf2 r r' x = liftRnf2 r r (bounds x) `seq` liftRnf r' (Data.Array.elems x) -#endif -- |@since 1.4.0.0 instance NFData a => NFData (Down a) where rnf = rnf1 @@ -673,7 +632,6 @@ instance NFData Unique where rnf = rwhnf -- assumes `newtype Unique = Unique Integer` -#if MIN_VERSION_base(4,8,0) -- | __NOTE__: Prior to @deepseq-1.4.4.0@ this instance was only defined for @base-4.8.0.0@ and later. -- -- @since 1.4.0.0 @@ -685,21 +643,7 @@ -- @since 1.4.0.0 instance NFData TyCon where rnf tycon = rnfTyCon tycon -#else --- | __NOTE__: Prior to @deepseq-1.4.4.0@ this instance was only defined for @base-4.8.0.0@ and later. --- --- @since 1.4.0.0 -instance NFData TypeRep where - rnf tr = rnf (typeRepTyCon tr) `seq` rnf (typeRepArgs tr) --- | __NOTE__: Prior to @deepseq-1.4.4.0@ this instance was only defined for @base-4.8.0.0@ and later. --- --- @since 1.4.0.0 -instance NFData TyCon where - rnf tc = rnf (tyConPackage tc) `seq` - rnf (tyConModule tc) `seq` - rnf (tyConName tc) -#endif -- | __NOTE__: Only strict in the reference and not the referenced value. -- @@ -862,7 +806,6 @@ ---------------------------------------------------------------------------- -- instances previously provided by semigroups package -#if MIN_VERSION_base(4,9,0) -- |@since 1.4.2.0 instance NFData a => NFData (NonEmpty a) where rnf = rnf1 -- |@since 1.4.3.0 @@ -914,12 +857,10 @@ instance NFData1 Option where liftRnf r (Option a) = liftRnf r a #endif -#endif ---------------------------------------------------------------------------- -- GHC.Stack -#if MIN_VERSION_base(4,9,0) -- |@since 1.4.2.0 instance NFData SrcLoc where rnf (SrcLoc a b c d e f g) = rnf a `seq` rnf b `seq` rnf c `seq` @@ -931,26 +872,20 @@ rnf (PushCallStack a b c) = rnf a `seq` rnf b `seq` rnf c rnf (FreezeCallStack a) = rnf a -#elif MIN_VERSION_base(4,8,1) --- |@since 1.4.2.0 -instance NFData SrcLoc where - -- base-4.8 didn't expose the 'SrcLoc' constructor - rnf sl = rnf (srcLocPackage sl) `seq` - rnf (srcLocModule sl) `seq` - rnf (srcLocFile sl) `seq` - rnf (srcLocStartLine sl) `seq` - rnf (srcLocStartCol sl) `seq` - rnf (srcLocEndLine sl) `seq` - rnf (srcLocEndCol sl) - --- |@since 1.4.2.0 -instance NFData CallStack where - rnf = rnf . getCallStack -#endif - ---------------------------------------------------------------------------- -- Tuples +#ifdef MIN_VERSION_ghc_prim +#if MIN_VERSION_ghc_prim(0,7,0) +-- |@since 1.4.6.0 +instance NFData a => NFData (Solo a) where + rnf (Solo a) = rnf a +-- |@since 1.4.6.0 +instance NFData1 Solo where + liftRnf r (Solo a) = r a +#endif +#endif + instance (NFData a, NFData b) => NFData (a,b) where rnf = rnf2 -- |@since 1.4.3.0 instance (NFData a) => NFData1 ((,) a) where liftRnf = liftRnf2 rnf @@ -1028,3 +963,12 @@ instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7) => NFData2 ((,,,,,,,,) a1 a2 a3 a4 a5 a6 a7) where liftRnf2 r r' (x1,x2,x3,x4,x5,x6,x7,x8,x9) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` rnf x7 `seq` r x8 `seq` r' x9 + +---------------------------------------------------------------------------- +-- ByteArray + +#if BYTEARRAY_IN_BASE +-- |@since 1.4.6.0 +instance NFData ByteArray where + rnf (ByteArray _) = () +#endif diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,15 +1,27 @@ # Changelog for [`deepseq` package](http://hackage.haskell.org/package/deepseq) +## 1.4.7.0 + + * Add instances for `Solo` (GHC-9) + ([#69](https://github.com/haskell/deepseq/pull/69)) + * Add once again `infixr 0 deepseq` + ([#56](https://github.com/haskell/deepseq/pull/56), [#74](https://github.com/haskell/deepseq/issues/74)) + * Add `NFData` instance for `ByteArray` + ([#65](https://github.com/haskell/deepseq/pull/65)) + * Drop support for GHC 7 to simplify CPP + ([#75](https://github.com/haskell/deepseq/pull/75)) + ## 1.4.6.1 - * Revert `infixr 0 deepseq`; this is a breaking change and requires a major version bump + * Revert `infixr 0 deepseq`; this does not appear in the version of `deepseq` pinned to GHC 9.2.1 ## 1.4.6.0 + * Bundled with GHC 9.2.1 * Remove instances for Data.Semigroup.Option for GHC >= 9.2 ([#62](https://github.com/haskell/deepseq/pull/62)) - * Set `infixr 0` for `deepseq` - Makes infix use of 'deepseq' parse the same way as infix use of 'seq' + * Set the `infixr 0 deepseq` to be consistent with `seq` + ([#56](https://github.com/haskell/deepseq/pull/56)) ## 1.4.5.0 diff --git a/deepseq.cabal b/deepseq.cabal --- a/deepseq.cabal +++ b/deepseq.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: deepseq -version: 1.4.6.1 +version: 1.4.7.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 @@ -26,16 +26,13 @@ build-type: Simple tested-with: - GHC==9.2.1, GHC==9.0.1, - GHC==8.10.7, - GHC==8.6.5, GHC==8.6.4,GHC==8.6.3,GHC==8.6.3,GHC==8.6.1, - GHC==8.4.4, GHC==8.4.3, GHC==8.4.2, GHC==8.4.1, - GHC==8.2.2, GHC==8.2.1, - GHC==8.0.2, - GHC==7.10.3, - GHC==7.8.4, - GHC==7.6.3, - GHC==7.4.2 + GHC==9.2.1, + GHC==9.0.1, + GHC==8.10.7, + GHC==8.6.5, GHC==8.6.4, GHC==8.6.3, GHC==8.6.2, GHC==8.6.1, + GHC==8.4.4, GHC==8.4.3, GHC==8.4.2, GHC==8.4.1, + GHC==8.2.2, + GHC==8.0.2 extra-source-files: changelog.md @@ -49,53 +46,44 @@ BangPatterns CPP DefaultSignatures + EmptyCase FlexibleContexts FlexibleInstances GADTs MultiParamTypeClasses + PolyKinds Safe TypeOperators - -- GHC.Generics lived in `ghc-prim` for GHC 7.2 & GHC 7.4 - if impl(ghc == 7.4.*) - build-depends: ghc-prim == 0.2.* - - if impl(ghc>=7.6) - other-extensions: PolyKinds - - if impl(ghc>=7.8) - other-extensions: EmptyCase + -- Solo lives in ghc-prim in GHC-9.0 (and maybe still in GHC-9.2) + if impl(ghc >=9.0) + build-depends: ghc-prim - build-depends: base >= 4.5 && < 4.17, + build-depends: base >= 4.9 && < 4.17, array >= 0.4 && < 0.6 ghc-options: -Wall exposed-modules: Control.DeepSeq other-modules: Control.DeepSeq.BackDoor -test-suite deepseq-generics-tests - default-language: Haskell2010 - type: exitcode-stdio-1.0 - hs-source-dirs: . tests - main-is: Main.hs - other-extensions: - CPP - BangPatterns - DefaultSignatures - DeriveDataTypeable - DeriveGeneric - FlexibleContexts - Safe - TupleSections - TypeOperators - - ghc-options: -Wall - - build-depends: - array, - base, - ghc-prim, - -- end of packages with inherited version constraints - test-framework == 0.8.*, - test-framework-hunit == 0.3.*, - HUnit >= 1.2 && < 1.7 +test-suite test + Default-Language: Haskell2010 + hs-source-dirs: tests + main-is: Main.hs + type: exitcode-stdio-1.0 + build-depends: + array, + base, + deepseq, + ghc-prim + ghc-options: -Wall + other-extensions: + CPP + BangPatterns + DefaultSignatures + DeriveDataTypeable + DeriveGeneric + FlexibleContexts + Safe + TupleSections + TypeOperators diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -15,13 +15,9 @@ import Data.Typeable import Data.Word import GHC.Generics +import System.Exit (exitFailure) import System.IO.Unsafe (unsafePerformIO) --- import Test.Framework (defaultMain, testGroup, testCase) -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.HUnit - -- IUT import Control.DeepSeq @@ -47,9 +43,13 @@ 0 <- resetSeqState () <- act st <- resetSeqState - unless (st == expectedState) $ - assertFailure ("withSeqState: actual seq-state ("++show st++") doesn't match expected value ("++ - show expectedState++")") + unless (st == expectedState) $ do + putStrLn $ "withSeqState: actual seq-state (" ++ + show st ++ + ") doesn't match expected value (" ++ + show expectedState ++ + ")" + exitFailure seqState :: IORef Word64 seqState = unsafePerformIO $ newIORef 0 @@ -66,7 +66,7 @@ go x | testBit x i = error ("setSeqState: flag #"++show i++" already set") | otherwise = (setBit x i, ()) --- weird type whose NFData instacne calls 'setSeqState' when rnf-ed +-- weird type whose NFData instance calls 'setSeqState' when rnf-ed data SeqSet = SeqSet !Int | SeqIgnore deriving Show @@ -85,15 +85,21 @@ assertRnfEx :: () -> IO () assertRnfEx v = handleJust isWanted (const $ return ()) $ do () <- evaluate v - assertFailure "failed to trigger expected RnfEx exception" + putStrLn "failed to trigger expected RnfEx exception" + exitFailure where isWanted = guard . (== RnfEx) ---------------------------------------------------------------------------- -case_1, case_2, case_3 :: Test.Framework.Test -case_4_1, case_4_2, case_4_3, case_4_4 :: Test.Framework.Test +testCase :: String -> IO a -> IO a +testCase testName io = do + putStrLn testName + io + +case_1, case_2, case_3 :: IO () +case_4_1, case_4_2, case_4_3, case_4_4 :: IO () #if __GLASGOW_HASKELL__ >= 706 -case_4_1b, case_4_2b, case_4_3b, case_4_4b :: Test.Framework.Test +case_4_1b, case_4_2b, case_4_3b, case_4_4b :: IO () #endif newtype Case1 = Case1 Int @@ -176,12 +182,10 @@ ---------------------------------------------------------------------------- main :: IO () -main = defaultMain [tests] - where - tests = testGroup "" - [ case_1, case_2, case_3 - , case_4_1, case_4_2, case_4_3, case_4_4 +main = sequence_ + [ case_1, case_2, case_3 + , case_4_1, case_4_2, case_4_3, case_4_4 #if __GLASGOW_HASKELL__ >= 706 - , case_4_1b, case_4_2b, case_4_3b, case_4_4b + , case_4_1b, case_4_2b, case_4_3b, case_4_4b #endif - ] + ]