deepseq-bounded-0.5.0: src/Control/DeepSeq/Bounded/NFDataN.hs
-------------------------------------------------------------------------------
{- LANGUAGE CPP #-} -- specified in .cabal default-extensions
#define USE_NFDATA_SUPERCLASS 0
-------------------------------------------------------------------------------
-- Later: I'm not so sure about this, actually; is the arithmetic
-- on n actually not piling up thunks, without the bang-patterns?
--
-- It would be easy to get rid of the bang-patterns.
-- The Complex instance is done as an example.
-- If you do go with the case's, probably want -fno-warn-name-shadowing.
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-------------------------------------------------------------------------------
-- |
-- Module : Control.DeepSeq.Bounded.NFDataN
-- Copyright : (c) 2014, Andrew G. Seniuk
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : Andrew Seniuk <rasfar@gmail.com>
-- Stability : provisional
-- Portability : portable
--
-- This module provides an overloaded function, 'deepseqn', for partially
-- (or fully) evaluating data structures to a given depth.
--
-------------------------------------------------------------------------------
module Control.DeepSeq.Bounded.NFDataN (
-- * Depth-bounded analogues of 'deepseq' and 'force'
deepseqn
, forcen
-- * Class of things that can be evaluated to an arbitrary finite depth
, NFDataN(..)
) where
-------------------------------------------------------------------------------
--import qualified Data.Generics.Shape as S -- not actually used
#if USE_NFDATA_SUPERCLASS
import Control.DeepSeq
#endif
--import Data.Data
import Data.Int
import Data.Word
import Data.Ratio
import Data.Complex
import Data.Array
import Data.Fixed
import Data.Version
-------------------------------------------------------------------------------
-- infixr 0 $!!
-------------------------------------------------------------------------------
-- | @'deepseqn' n x y@ evaluates @x@ to depth n, before returning @y@.
--
-- This is used when expression @x@ also appears in @y@, but mere
-- evaluation of @y@ does not force the embedded @x@ subexpression
-- as deeply as we wish.
--
-- The name 'deepseqn' 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, @'deepseqn' n@ traverses (evaluates) the entire
-- top @n@ levels of the data structure.
--
-- A typical use is to ensure any exceptions hidden within lazy
-- fields of a data structure do not leak outside the scope of the
-- exception handler; another is to force evaluation of a data structure in
-- one thread, before passing it to another thread (preventing work moving
-- to the wrong threads). Unlike "DeepSeq", potentially infinite coinductive
-- data types are supported by principled bounding of deep evaluation.
--
-- It is also useful for diagnostic purposes when trying to understand
-- and manipulate space\/time trade-offs in lazy code,
-- and as a less indiscriminate substitute for 'deepseq'.
--
-- Furthermore, 'deepseqn' can sometimes a better solution than
-- using stict fields in your data structures, because the
-- latter will behave strictly everywhere that its constructors
-- are used, instead of just where its laziness is problematic.
--
-- There may be possible applications to the prevention of resource leaks
-- in lazy streaming, but I'm not certain.
--
deepseqn :: NFDataN a => Int -> a -> b -> b
deepseqn n a b = rnfn n a `seq` b
#if 1
-- XXX Need to double-check that this makes sense; didn't think
-- it through -- when b != a, things are not so simple.
-- XXX Partially-applied; is that okay in GHC RULES?
{-# RULES
"deepseqn/composition" forall n1 n2 x. (.) (deepseqn n2) (deepseqn n1) x = deepseqn ( max n1 n2 ) x
#-}
#endif
-------------------------------------------------------------------------------
#if 0
-- As per DeepSeq:
-- | the deep analogue of '$!'. In the expression @f $!! x@, @x@ is
-- fully evaluated before the function @f@ is applied to it.
($!!) :: NFData a => (a -> b) -> a -> b
f $!! x = x `deepseq` f x
#endif
-------------------------------------------------------------------------------
-- | 'forcen' is a variant of 'deepseqn' that is useful in some circumstances.
--
-- > forcen n x = deepseqn n x x
--
-- @forcen n x@ evaluates @x@ to depth @n@, and then returns it.
-- Recall that, in common with all Haskell functions, @forcen@ only
-- performs evaluation when upstream demand actually occurs,
-- so essentially it turns shallow evaluation into depth-@n@ evaluation.
forcen :: NFDataN a => Int -> a -> a
forcen n x = deepseqn n x x
#if 1
{-# RULES
"forcen/composition" forall n1 n2 x. (.) (forcen n2) (forcen n1) x = forcen ( max n1 n2 ) x
#-}
#endif
-------------------------------------------------------------------------------
-- | A class of types that can be evaluated to arbitrary depth.
#if USE_NFDATA_SUPERCLASS
class NFData a => NFDataN a where
#else
class NFDataN a where
#endif
#if 0
-- | rnf should reduce its argument to normal form (that is, fully
-- evaluate all sub-components), and then return '()'.
--
-- The default implementation of 'rnf' is
--
-- > rnf a = a `seq` ()
--
-- which may be convenient when defining instances for data types with
-- no unevaluated fields (e.g. enumerations).
rnf :: a -> ()
rnf a = a `seq` ()
#endif
rnfn :: Int -> a -> ()
#if USE_NFDATA_SUPERCLASS
-- ?? not sure about this (whatever, we'll override it)
#if 1
rnfn n a | n <= 0 = () -- case needed? (seems to be!)
| otherwise = rnf a
#else
rnfn _ a = rnf a
#endif
#else
#if 0
#elif 1
rnfn n x | n <= 0 = ()
| otherwise = x `seq` ()
#elif 0
rnfn _ x = x `seq` ()
#elif 0
rnfn _ _ = ()
#endif
#endif
#if 1
{-# RULES
"rnfn/composition" forall n1 n2 x. (.) (rnfn n2) (rnfn n1) x = rnfn ( max n1 n2 ) x
#-}
-- "rnfp/composition" forall p1 p2 x. compose (rnfp p2) (rnfp p1) x = rnfp ( unionPat [p1, p2] ) x
-- "rnfp/composition" forall p1 p2 x. ( rnfp p2 . rnfp p1 ) x = rnfp ( unionPat [p1, p2] ) x
#endif
-------------------------------------------------------------------------------
instance NFDataN Int
instance NFDataN Word
instance NFDataN Integer
instance NFDataN Float
instance NFDataN Double
instance NFDataN Char
instance NFDataN Bool
instance NFDataN ()
instance NFDataN Int8
instance NFDataN Int16
instance NFDataN Int32
instance NFDataN Int64
instance NFDataN Word8
instance NFDataN Word16
instance NFDataN Word32
instance NFDataN Word64
instance NFDataN (Fixed a)
-- [Quoted from deepseq:]
-- This instance is for convenience and consistency with 'seq'.
-- This assumes that WHNF is equivalent to NF for functions.
instance NFDataN (a -> b)
#if 0
instance NFDataN a => NFDataN (IO a) where
rnfn !n x = () -- XXX ignore if in IO (cludge easing an experiment...)
#endif
-- not taken to be a level of depth
instance (Integral a, NFDataN a) => NFDataN (Ratio a) where
rnfn !n x = rnfn n (numerator x, denominator x)
instance (RealFloat a, NFDataN a) => NFDataN (Complex a) where
#if 1
rnfn n (x:+y) = case n of
n | n <= 0 -> ()
_ -> let n' = -1+n in
rnfn n' x `seq`
rnfn n' y `seq`
()
#else
rnfn !n (x:+y)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x `seq`
rnfn n' y `seq`
()
#endif
instance NFDataN a => NFDataN (Maybe a) where
rnfn _ Nothing = ()
rnfn !n (Just x)
| n <= 0 = ()
| otherwise = rnfn (-1+n) x
instance (NFDataN a, NFDataN b) => NFDataN (Either a b) where
rnfn !n (Left x)
| n <= 0 = ()
| otherwise = rnfn (-1+n) x
rnfn !n (Right y)
| n <= 0 = ()
| otherwise = rnfn (-1+n) y
instance NFDataN Data.Version.Version where
rnfn !n (Data.Version.Version branch tags)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' branch `seq` rnfn n' tags
instance NFDataN a => NFDataN [a] where
rnfn _ [] = ()
rnfn !n (x:xs)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x `seq` rnfn n' xs
-- not taken to be a level of depth
instance (Ix a, NFDataN a, NFDataN b) => NFDataN (Array a b) where
rnfn !n x = rnfn n (bounds x, Data.Array.elems x)
instance (NFDataN a, NFDataN b) => NFDataN (a,b) where
rnfn !n (x,y)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x `seq` rnfn n' y
instance (NFDataN a, NFDataN b, NFDataN c) => NFDataN (a,b,c) where
rnfn !n (x,y,z)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x `seq` rnfn n' y `seq` rnfn n' z
instance (NFDataN a, NFDataN b, NFDataN c, NFDataN d) => NFDataN (a,b,c,d) where
rnfn !n (x1,x2,x3,x4)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x1 `seq`
rnfn n' x2 `seq`
rnfn n' x3 `seq`
rnfn n' x4
instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5) =>
NFDataN (a1, a2, a3, a4, a5) where
rnfn !n (x1,x2,x3,x4,x5)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x1 `seq`
rnfn n' x2 `seq`
rnfn n' x3 `seq`
rnfn n' x4 `seq`
rnfn n' x5
instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5, NFDataN a6) =>
NFDataN (a1, a2, a3, a4, a5, a6) where
rnfn !n (x1,x2,x3,x4,x5,x6)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x1 `seq`
rnfn n' x2 `seq`
rnfn n' x3 `seq`
rnfn n' x4 `seq`
rnfn n' x5 `seq`
rnfn n' x6
instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5, NFDataN a6, NFDataN a7) =>
NFDataN (a1, a2, a3, a4, a5, a6, a7) where
rnfn !n (x1,x2,x3,x4,x5,x6,x7)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x1 `seq`
rnfn n' x2 `seq`
rnfn n' x3 `seq`
rnfn n' x4 `seq`
rnfn n' x5 `seq`
rnfn n' x6 `seq`
rnfn n' x7
instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5, NFDataN a6, NFDataN a7, NFDataN a8) =>
NFDataN (a1, a2, a3, a4, a5, a6, a7, a8) where
rnfn !n (x1,x2,x3,x4,x5,x6,x7,x8)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x1 `seq`
rnfn n' x2 `seq`
rnfn n' x3 `seq`
rnfn n' x4 `seq`
rnfn n' x5 `seq`
rnfn n' x6 `seq`
rnfn n' x7 `seq`
rnfn n' x8
instance (NFDataN a1, NFDataN a2, NFDataN a3, NFDataN a4, NFDataN a5, NFDataN a6, NFDataN a7, NFDataN a8, NFDataN a9) =>
NFDataN (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
rnfn !n (x1,x2,x3,x4,x5,x6,x7,x8,x9)
| n <= 0 = ()
| otherwise = let n' = -1+n in
rnfn n' x1 `seq`
rnfn n' x2 `seq`
rnfn n' x3 `seq`
rnfn n' x4 `seq`
rnfn n' x5 `seq`
rnfn n' x6 `seq`
rnfn n' x7 `seq`
rnfn n' x8 `seq`
rnfn n' x9
-------------------------------------------------------------------------------