{-# LANGUAGE BangPatterns #-}{-# LANGUAGE CPP #-}#if __GLASGOW_HASKELL__ >= 702{-# LANGUAGE DefaultSignatures #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE TypeOperators #-}# if MIN_VERSION_array(0,4,0){-# LANGUAGE Safe #-}# endif#endif------------------------------------------------------------------------------- |-- Module : Control.DeepSeq-- Copyright : (c) The University of Glasgow 2001-2009-- License : BSD-style (see the file LICENSE)---- Maintainer : libraries@haskell.org-- Stability : stable-- Portability : portable---- This module provides an overloaded function, 'deepseq', for fully-- evaluating data structures (that is, evaluating to \"Normal Form\").---- A typical use is to prevent resource leaks in lazy IO programs, by-- forcing all characters from a file to be read. For example:---- > import System.IO-- > import Control.DeepSeq-- >-- > main = do-- > h <- openFile "f" ReadMode-- > s <- hGetContents h-- > s `deepseq` hClose h-- > return s---- 'deepseq' differs from 'seq' as it traverses data structures deeply,-- for example, 'seq' will evaluate only to the first constructor in-- the list:---- > > [1,2,undefined] `seq` 3-- > 3---- While 'deepseq' will force evaluation of all the list elements:---- > > [1,2,undefined] `deepseq` 3-- > *** Exception: Prelude.undefined---- Another common use is to ensure any exceptions hidden within lazy-- fields of a data structure do not leak outside the scope of the-- exception handler, or to force evaluation of a data structure in one-- thread, before passing to another thread (preventing work moving to-- the wrong threads).---- /Since: 1.1.0.0/moduleControl.DeepSeq(deepseq ,($!! ),force ,NFData (..),)whereimportControl.ApplicativeimportControl.Concurrent(ThreadId)importData.IntimportData.WordimportData.RatioimportData.CompleximportData.ArrayimportData.FixedimportData.VersionimportData.MonoidimportData.Unique(Unique)importForeign.C.TypesimportSystem.Mem.StableName(StableName)#if MIN_VERSION_base(4,6,0)importData.Ord(Down(Down))#endif#if MIN_VERSION_base(4,7,0)importData.Proxy(Proxy(Proxy))#endif#if MIN_VERSION_base(4,8,0)importData.Functor.Identity(Identity(..))importData.Typeable(TypeRep,TyCon,rnfTypeRep,rnfTyCon)importData.Void(Void,absurd)importNumeric.Natural(Natural)#endif#if __GLASGOW_HASKELL__ >= 702importGHC.Fingerprint.Type(Fingerprint(..))importGHC.Generics-- | Hidden internal type-classclassGNFData f wheregrnf ::f a ->()instanceGNFData V1wheregrnf =error"Control.DeepSeq.rnf: uninhabited type"instanceGNFData U1wheregrnf U1=()instanceNFData a =>GNFData (K1i a )wheregrnf =rnf .unK1{-# INLINEABLE grnf #-}instanceGNFData a =>GNFData (M1i c a )wheregrnf =grnf .unM1{-# INLINEABLE grnf #-}instance(GNFData a ,GNFData b )=>GNFData (a :*: b )wheregrnf (x :*:y )=grnf x `seq`grnf y {-# INLINEABLE grnf #-}instance(GNFData a ,GNFData b )=>GNFData (a :+: b )wheregrnf (L1x )=grnf x grnf(R1x )=grnf x {-# INLINEABLE grnf #-}#endifinfixr0$!!-- | 'deepseq': fully evaluates the first argument, before returning the-- second.---- The name 'deepseq' is used to illustrate the relationship to 'seq':-- where 'seq' is shallow in the sense that it only evaluates the top-- level of its argument, 'deepseq' traverses the entire data structure-- evaluating it completely.---- 'deepseq' can be useful for forcing pending exceptions,-- eradicating space leaks, or forcing lazy I/O to happen. It is-- also useful in conjunction with parallel Strategies (see the-- @parallel@ package).---- There is no guarantee about the ordering of evaluation. The-- implementation may evaluate the components of the structure in-- any order or in parallel. To impose an actual order on-- evaluation, use 'pseq' from "Control.Parallel" in the-- @parallel@ package.---- /Since: 1.1.0.0/deepseq::NFData a =>a ->b ->b deepseq a b =rnf a `seq`b -- | the deep analogue of '$!'. In the expression @f $!! x@, @x@ is-- fully evaluated before the function @f@ is applied to it.---- /Since: 1.2.0.0/($!!)::(NFData a )=>(a ->b )->a ->b f $!! x =x `deepseq `f x -- | a variant of 'deepseq' that is useful in some circumstances:---- > force x = x `deepseq` x---- @force x@ fully evaluates @x@, and then returns it. Note that-- @force x@ only performs evaluation when the value of @force x@-- itself is demanded, so essentially it turns shallow evaluation into-- deep evaluation.---- 'force' can be conveniently used in combination with @ViewPatterns@:---- > {-# LANGUAGE BangPatterns, ViewPatterns #-}-- > import Control.DeepSeq-- >-- > someFun :: ComplexData -> SomeResult-- > someFun (force -> !arg) = {- 'arg' will be fully evaluated -}---- Another useful application is to combine 'force' with-- 'Control.Exception.evaluate' in order to force deep evaluation-- relative to other 'IO' operations:---- > import Control.Exception (evaluate)-- > import Control.DeepSeq-- >-- > main = do-- > result <- evaluate $ force $ pureComputation-- > {- 'result' will be fully evaluated at this point -}-- > return ()---- /Since: 1.2.0.0/force::(NFData a )=>a ->a force x =x `deepseq `x -- | A class of types that can be fully evaluated.---- /Since: 1.1.0.0/classNFData a where-- | 'rnf' should reduce its argument to normal form (that is, fully-- evaluate all sub-components), and then return '()'.---- === 'Generic' 'NFData' deriving---- 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---- Starting with GHC 7.10, the example above can be written more-- concisely by enabling the new @DeriveAnyClass@ extension:---- > {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}-- >-- > import GHC.Generics (Generic)-- > import Control.DeepSeq-- >-- > data Foo a = Foo a String-- > deriving (Eq, Generic, NFData)-- >-- > data Colour = Red | Green | Blue-- > deriving (Generic, NFData)-- >---- === Compatibility with previous @deepseq@ versions---- Prior to version 1.4.0.0, the default implementation of the 'rnf'-- method was defined as---- @'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 ()---- or alternatively---- > {-# LANGUAGE BangPatterns #-}-- > instance NFData Colour where rnf !_ = ()--rnf ::a ->()#if __GLASGOW_HASKELL__ >= 702defaultrnf::(Generica ,GNFData (Repa ))=>a ->()rnf =grnf .from#endifinstanceNFData Intwherernf !_=()instanceNFData Wordwherernf !_=()instanceNFData Integerwherernf !_=()instanceNFData Floatwherernf !_=()instanceNFData Doublewherernf !_=()instanceNFData Charwherernf !_=()instanceNFData Boolwherernf !_=()instanceNFData ()wherernf !_=()instanceNFData Int8wherernf !_=()instanceNFData Int16wherernf !_=()instanceNFData Int32wherernf !_=()instanceNFData Int64wherernf !_=()instanceNFData Word8wherernf !_=()instanceNFData Word16wherernf !_=()instanceNFData Word32wherernf !_=()instanceNFData Word64wherernf !_=()#if MIN_VERSION_base(4,7,0)-- |/Since: 1.4.0.0/instanceNFData (Proxya )wherernf Proxy=()#endif#if MIN_VERSION_base(4,8,0)-- |/Since: 1.4.0.0/instanceNFData a =>NFData (Identitya )wherernf =rnf .runIdentity-- | Defined as @'rnf' = 'absurd'@.---- /Since: 1.4.0.0/instanceNFData Voidwherernf =absurd-- |/Since: 1.4.0.0/instanceNFData Naturalwherernf !_=()#endif-- |/Since: 1.3.0.0/instanceNFData (Fixeda )wherernf !_=()-- |This instance is for convenience and consistency with 'seq'.-- This assumes that WHNF is equivalent to NF for functions.---- /Since: 1.3.0.0/instanceNFData (a ->b )wherernf !_=()--Rational and complex numbers.#if __GLASGOW_HASKELL__ >= 711instanceNFDataa=>NFData(Ratioa)where#elseinstance(Integrala ,NFData a )=>NFData (Ratioa )where#endifrnf x =rnf (numeratorx ,denominatorx )#if MIN_VERSION_base(4,4,0)instance(NFData a )=>NFData (Complexa )where#elseinstance(RealFloata,NFDataa)=>NFData(Complexa)where#endifrnf (x :+y )=rnf x `seq`rnf y `seq`()instanceNFData a =>NFData (Maybea )wherernf Nothing=()rnf(Justx )=rnf x instance(NFData a ,NFData b )=>NFData (Eithera b )wherernf (Leftx )=rnf x rnf(Righty )=rnf y -- |/Since: 1.3.0.0/instanceNFData Data.Version.Versionwherernf (Data.Version.Versionbranch tags )=rnf branch `seq`rnf tags instanceNFData a =>NFData [a ]wherernf []=()rnf(x :xs )=rnf x `seq`rnf xs -- |/Since: 1.4.0.0/instanceNFData a =>NFData (ZipLista )wherernf =rnf .getZipList-- |/Since: 1.4.0.0/instanceNFData a =>NFData (Consta b )wherernf =rnf .getConst#if __GLASGOW_HASKELL__ >= 711instance(NFDataa,NFDatab)=>NFData(Arrayab)where#elseinstance(Ixa ,NFData a ,NFData b )=>NFData (Arraya b )where#endifrnf x =rnf (boundsx ,Data.Array.elemsx )#if MIN_VERSION_base(4,6,0)-- |/Since: 1.4.0.0/instanceNFData a =>NFData (Downa )wherernf (Downx )=rnf x #endif-- |/Since: 1.4.0.0/instanceNFData a =>NFData (Duala )wherernf =rnf .getDual-- |/Since: 1.4.0.0/instanceNFData a =>NFData (Firsta )wherernf =rnf .getFirst-- |/Since: 1.4.0.0/instanceNFData a =>NFData (Lasta )wherernf =rnf .getLast-- |/Since: 1.4.0.0/instanceNFData Anywherernf =rnf .getAny-- |/Since: 1.4.0.0/instanceNFData Allwherernf =rnf .getAll-- |/Since: 1.4.0.0/instanceNFData a =>NFData (Suma )wherernf =rnf .getSum-- |/Since: 1.4.0.0/instanceNFData a =>NFData (Producta )wherernf =rnf .getProduct-- |/Since: 1.4.0.0/instanceNFData (StableNamea )wherernf !_=()-- assumes `data StableName a = StableName (StableName# a)`-- |/Since: 1.4.0.0/instanceNFData ThreadIdwherernf !_=()-- assumes `data ThreadId = ThreadId ThreadId#`-- |/Since: 1.4.0.0/instanceNFData Uniquewherernf !_=()-- assumes `newtype Unique = Unique Integer`#if MIN_VERSION_base(4,8,0)-- | __NOTE__: Only defined for @base-4.8.0.0@ and later---- /Since: 1.4.0.0/instanceNFData TypeRepwherernf tyrep =rnfTypeReptyrep -- | __NOTE__: Only defined for @base-4.8.0.0@ and later---- /Since: 1.4.0.0/instanceNFData TyConwherernf tycon =rnfTyContycon #endif------------------------------------------------------------------------------ GHC Specifics#if __GLASGOW_HASKELL__ >= 702-- |/Since: 1.4.0.0/instanceNFData Fingerprintwherernf (Fingerprint__)=()#endif------------------------------------------------------------------------------ Foreign.C.Types-- |/Since: 1.4.0.0/instanceNFData CCharwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CSCharwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CUCharwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CShortwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CUShortwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CIntwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CUIntwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CLongwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CULongwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CPtrdiffwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CSizewherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CWcharwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CSigAtomicwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CLLongwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CULLongwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CIntPtrwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CUIntPtrwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CIntMaxwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CUIntMaxwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CClockwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CTimewherernf !_=()#if MIN_VERSION_base(4,4,0)-- |/Since: 1.4.0.0/instanceNFData CUSecondswherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CSUSecondswherernf !_=()#endif-- |/Since: 1.4.0.0/instanceNFData CFloatwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CDoublewherernf !_=()-- NOTE: The types `CFile`, `CFPos`, and `CJmpBuf` below are not-- newtype wrappers rather defined as field-less single-constructor-- types.-- |/Since: 1.4.0.0/instanceNFData CFilewherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CFposwherernf !_=()-- |/Since: 1.4.0.0/instanceNFData CJmpBufwherernf !_=()------------------------------------------------------------------------------ Tuplesinstance(NFData a ,NFData b )=>NFData (a ,b )wherernf (x ,y )=rnf x `seq`rnf y instance(NFData a ,NFData b ,NFData c )=>NFData (a ,b ,c )wherernf (x ,y ,z )=rnf x `seq`rnf y `seq`rnf z instance(NFData a ,NFData b ,NFData c ,NFData d )=>NFData (a ,b ,c ,d )wherernf (x1 ,x2 ,x3 ,x4 )=rnf x1 `seq`rnf x2 `seq`rnf x3 `seq`rnf x4 instance(NFData a1 ,NFData a2 ,NFData a3 ,NFData a4 ,NFData a5 )=>NFData (a1 ,a2 ,a3 ,a4 ,a5 )wherernf (x1 ,x2 ,x3 ,x4 ,x5 )=rnf x1 `seq`rnf x2 `seq`rnf x3 `seq`rnf x4 `seq`rnf x5 instance(NFData a1 ,NFData a2 ,NFData a3 ,NFData a4 ,NFData a5 ,NFData a6 )=>NFData (a1 ,a2 ,a3 ,a4 ,a5 ,a6 )wherernf (x1 ,x2 ,x3 ,x4 ,x5 ,x6 )=rnf x1 `seq`rnf x2 `seq`rnf x3 `seq`rnf x4 `seq`rnf x5 `seq`rnf x6 instance(NFData a1 ,NFData a2 ,NFData a3 ,NFData a4 ,NFData a5 ,NFData a6 ,NFData a7 )=>NFData (a1 ,a2 ,a3 ,a4 ,a5 ,a6 ,a7 )wherernf (x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 )=rnf x1 `seq`rnf x2 `seq`rnf x3 `seq`rnf x4 `seq`rnf x5 `seq`rnf x6 `seq`rnf x7 instance(NFData a1 ,NFData a2 ,NFData a3 ,NFData a4 ,NFData a5 ,NFData a6 ,NFData a7 ,NFData a8 )=>NFData (a1 ,a2 ,a3 ,a4 ,a5 ,a6 ,a7 ,a8 )wherernf (x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 )=rnf x1 `seq`rnf x2 `seq`rnf x3 `seq`rnf x4 `seq`rnf x5 `seq`rnf x6 `seq`rnf x7 `seq`rnf x8 instance(NFData a1 ,NFData a2 ,NFData a3 ,NFData a4 ,NFData a5 ,NFData a6 ,NFData a7 ,NFData a8 ,NFData a9 )=>NFData (a1 ,a2 ,a3 ,a4 ,a5 ,a6 ,a7 ,a8 ,a9 )wherernf (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`rnf x8 `seq`rnf x9