[commit: packages/deepseq] master, typeable-with-kinds: Merge `deepseq-generics` into `deepseq` (3b5c957)
git at git.haskell.org
git at git.haskell.org
Thu Mar 19 11:35:15 UTC 2015
Repository : ssh://git@git.haskell.org/deepseq
On branches: master,typeable-with-kinds
Link : http://git.haskell.org/packages/deepseq.git/commitdiff/3b5c957ce7bba7b63b4483a43c6762c3f5d8ee28
>---------------------------------------------------------------
commit 3b5c957ce7bba7b63b4483a43c6762c3f5d8ee28
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date: Thu Oct 16 11:19:16 2014 +0200
Merge `deepseq-generics` into `deepseq`
This also replaces the existing `rnf x = seq x ()` default
implementation with a `Generics`-based `DefaultSignature` `rnf` method
implementation
This requires to drop support for GHCs older than GHC 7.2 to avoid
conditional exports due to lack of `Generics` support
For more details, see original proposal
http://permalink.gmane.org/gmane.comp.lang.haskell.libraries/23031
>---------------------------------------------------------------
3b5c957ce7bba7b63b4483a43c6762c3f5d8ee28
Control/DeepSeq.hs | 118 +++++++++++++++++++++++++++++++++++++++++------------
changelog.md | 15 ++++++-
deepseq.cabal | 24 ++++++++---
3 files changed, 124 insertions(+), 33 deletions(-)
diff --git a/Control/DeepSeq.hs b/Control/DeepSeq.hs
index 88aa5c3..f451b1b 100644
--- a/Control/DeepSeq.hs
+++ b/Control/DeepSeq.hs
@@ -1,6 +1,12 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
-#if __GLASGOW_HASKELL__ >= 702 && MIN_VERSION_array(0,4,0)
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeOperators #-}
+# if MIN_VERSION_array(0,4,0)
{-# LANGUAGE Safe #-}
+# endif
#endif
-----------------------------------------------------------------------------
-- |
@@ -59,6 +65,37 @@ import Data.Array
import Data.Fixed
import Data.Version
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+
+-- | Hidden internal type-class
+class GNFData f where
+ grnf :: f a -> ()
+
+instance GNFData V1 where
+ grnf = error "Control.DeepSeq.rnf: uninhabited type"
+
+instance GNFData U1 where
+ grnf U1 = ()
+
+instance NFData a => GNFData (K1 i a) where
+ grnf = rnf . unK1
+ {-# INLINEABLE grnf #-}
+
+instance GNFData a => GNFData (M1 i c a) where
+ grnf = grnf . unM1
+ {-# INLINEABLE grnf #-}
+
+instance (GNFData a, GNFData b) => GNFData (a :*: b) where
+ grnf (x :*: y) = grnf x `seq` grnf y
+ {-# INLINEABLE grnf #-}
+
+instance (GNFData a, GNFData b) => GNFData (a :+: b) where
+ grnf (L1 x) = grnf x
+ grnf (R1 x) = grnf x
+ {-# INLINEABLE grnf #-}
+#endif
+
infixr 0 $!!
-- | 'deepseq': fully evaluates the first argument, before returning the
@@ -108,46 +145,77 @@ force x = x `deepseq` x
--
-- /Since: 1.1.0.0/
class NFData a where
- -- | rnf should reduce its argument to normal form (that is, fully
+ -- | 'rnf' should reduce its argument to normal form (that is, fully
-- evaluate all sub-components), and then return '()'.
--
- -- The default implementation of 'rnf' is
+ -- Starting with GHC 7.2, you can automatically derive instances
+ -- for types possessing a 'Generic' instance.
+ --
+ -- > {-# LANGUAGE DeriveGeneric #-}
+ -- >
+ -- > import GHC.Generics (Generic)
+ -- > import Control.DeepSeq
+ -- >
+ -- > data Foo a = Foo a String
+ -- > deriving (Eq, Generic)
+ -- >
+ -- > instance NFData a => NFData (Foo a)
+ -- >
+ -- > data Colour = Red | Green | Blue
+ -- > deriving Generic
+ -- >
+ -- > instance NFData Colour
+ --
+ -- __Compatibility Note__: Prior to version 1.4.0, the default
+ -- implementation of 'rnf' was \"@'rnf' a = 'seq' a ()@\",
+ -- however, starting with @deepseq-1.4.0.0@, the default
+ -- implementation is based on @DefaultSignatures@ allowing for
+ -- more accurate auto-derived 'NFData' instances. If you need the
+ -- previously used exact default 'rnf' method implementation
+ -- semantics, use
+ --
+ -- > instance NFData Colour where rnf x = seq x ()
--
- -- > rnf a = a `seq` ()
+ -- or alternatively
+ --
+ -- > {-# LANGUAGE BangPatterns #-}
+ -- > instance NFData Colour where rnf !_ = ()
--
- -- which may be convenient when defining instances for data types with
- -- no unevaluated fields (e.g. enumerations).
rnf :: a -> ()
- rnf a = a `seq` ()
-instance NFData Int
-instance NFData Word
-instance NFData Integer
-instance NFData Float
-instance NFData Double
+#if __GLASGOW_HASKELL__ >= 702
+ default rnf :: (Generic a, GNFData (Rep a)) => a -> ()
+ rnf = grnf . from
+#endif
+
+instance NFData Int where rnf !_ = ()
+instance NFData Word where rnf !_ = ()
+instance NFData Integer where rnf !_ = ()
+instance NFData Float where rnf !_ = ()
+instance NFData Double where rnf !_ = ()
-instance NFData Char
-instance NFData Bool
-instance NFData ()
+instance NFData Char where rnf !_ = ()
+instance NFData Bool where rnf !_ = ()
+instance NFData () where rnf !_ = ()
-instance NFData Int8
-instance NFData Int16
-instance NFData Int32
-instance NFData Int64
+instance NFData Int8 where rnf !_ = ()
+instance NFData Int16 where rnf !_ = ()
+instance NFData Int32 where rnf !_ = ()
+instance NFData Int64 where rnf !_ = ()
-instance NFData Word8
-instance NFData Word16
-instance NFData Word32
-instance NFData Word64
+instance NFData Word8 where rnf !_ = ()
+instance NFData Word16 where rnf !_ = ()
+instance NFData Word32 where rnf !_ = ()
+instance NFData Word64 where rnf !_ = ()
-- |/Since: 1.3.0.0/
-instance NFData (Fixed a)
+instance NFData (Fixed a) where rnf !_ = ()
-- |This instance is for convenience and consistency with 'seq'.
-- This assumes that WHNF is equivalent to NF for functions.
--
-- /Since: 1.3.0.0/
-instance NFData (a -> b)
+instance NFData (a -> b) where rnf !_ = ()
--Rational and complex numbers.
diff --git a/changelog.md b/changelog.md
index e978a31..9d1b80d 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,8 +1,19 @@
# Changelog for [`deepseq` package](http://hackage.haskell.org/package/deepseq)
-## 1.3.0.3 *TBA*
+## 1.4.0.0 *TBA*
- * Bundled with GHC 7.10
+ * Bundled with GHC 7.10.1
+ * Switch to Generics based `DefaultSignature` `rnf` method
+ implementation (based on code from `deepseq-generics`)
+
+ **Compatibility Note**: if you need the exact default-method
+ semantics of `deepseq` prior to 1.4, replace occurences of
+
+ instance NFData XYZ
+
+ by
+
+ instance NFData XYZ where rnf x = seq x ()
## 1.3.0.2 *Nov 2013*
diff --git a/deepseq.cabal b/deepseq.cabal
index 856c3fb..261b01d 100644
--- a/deepseq.cabal
+++ b/deepseq.cabal
@@ -1,5 +1,5 @@
name: deepseq
-version: 1.3.0.3
+version: 1.4.0.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD3
license-file: LICENSE
@@ -27,7 +27,7 @@ description:
which builds on top of this package.
build-type: Simple
cabal-version: >=1.10
-tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC==7.2.2, GHC==7.2.1, GHC==7.0.4, GHC==7.0.3, GHC==7.0.2, GHC==7.0.1
+tested-with: GHC==7.8.3, GHC==7.8.2, GHC==7.8.1, GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC==7.2.2, GHC==7.2.1, GHC==7.0.4, GHC==7.0.3, GHC==7.0.2, GHC==7.0.1
extra-source-files: changelog.md
@@ -37,10 +37,22 @@ source-repository head
library
default-language: Haskell2010
- other-extensions: CPP
- if impl(ghc >= 7.2)
- other-extensions: Safe
- exposed-modules: Control.DeepSeq
+ other-extensions:
+ BangPatterns
+ CPP
+
+ if impl(ghc>=7.2)
+ -- Enable Generics-backed DefaultSignatures for `rnf`
+ other-extensions:
+ DefaultSignatures
+ FlexibleContexts
+ Safe
+ TypeOperators
+
+ build-depends: ghc-prim >= 0.2 && < 0.4
+
build-depends: base >= 4.3 && < 4.9,
array >= 0.3 && < 0.6
ghc-options: -Wall
+
+ exposed-modules: Control.DeepSeq
More information about the ghc-commits
mailing list