-- | Module taken from Dean Harington's post to the Haskell mailing list
-- on Fri, 17 Aug 2001.
--
-- URL is currently
-- <http://www.haskell.org/pipermail/haskell/2001-August/007712.html>
--
-- This module provides 'deepSeq' and '$!!' which correspond to 'seq' and '$!'
-- except that they try to evaluate everything in the argument.  For example,
-- if a list is provided, the whole list must be evaluated.
--
-- For purposes of Haddock, empty instance declarations with @where@
-- have had the @where@ deleted.

module Util.DeepSeq where

class  DeepSeq a  where
   deepSeq :: a -> b -> b
   deepSeq = a -> b -> b
seq                        -- default, for simple cases

infixr 0 `deepSeq`, $!!

($!!) :: (DeepSeq a) => (a -> b) -> a -> b
a -> b
f $!! :: (a -> b) -> a -> b
$!! a
x = a
x a -> b -> b
forall a b. DeepSeq a => a -> b -> b
`deepSeq` a -> b
f a
x


instance  DeepSeq ()

instance  (DeepSeq a) => DeepSeq [a]  where
   deepSeq :: [a] -> b -> b
deepSeq [] b
y = b
y
   deepSeq (a
x:[a]
xs) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
x (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ [a] -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq [a]
xs b
y

instance  (DeepSeq a,DeepSeq b) => DeepSeq (a,b)  where
   deepSeq :: (a, b) -> b -> b
deepSeq (a
a,b
b) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq b
b b
y

instance  (DeepSeq a,DeepSeq b,DeepSeq c) => DeepSeq (a,b,c)  where
   deepSeq :: (a, b, c) -> b -> b
deepSeq (a
a,b
b,c
c) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq b
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ c -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq c
c b
y

instance  (DeepSeq a,DeepSeq b,DeepSeq c,DeepSeq d) => DeepSeq (a,b,c,d)  where
   deepSeq :: (a, b, c, d) -> b -> b
deepSeq (a
a,b
b,c
c,d
d) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq b
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ c -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq c
c (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ d -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq d
d b
y

instance  (DeepSeq a,DeepSeq b,DeepSeq c,DeepSeq d,DeepSeq e) => DeepSeq (a,b,c,d,e)  where
   deepSeq :: (a, b, c, d, e) -> b -> b
deepSeq (a
a,b
b,c
c,d
d,e
e) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq b
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ c -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq c
c (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ d -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq d
d (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ e -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq e
e b
y

instance  (DeepSeq a,DeepSeq b,DeepSeq c,DeepSeq d,DeepSeq e,DeepSeq f) => DeepSeq (a,b,c,d,e,f)  where
   deepSeq :: (a, b, c, d, e, f) -> b -> b
deepSeq (a
a,b
b,c
c,d
d,e
e,f
f) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq b
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ c -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq c
c (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ d -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq d
d (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ e -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq e
e (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ f -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq f
f b
y

instance  (DeepSeq a,DeepSeq b,DeepSeq c,DeepSeq d,DeepSeq e,DeepSeq f,DeepSeq g) => DeepSeq (a,b,c,d,e,f,g)  where
   deepSeq :: (a, b, c, d, e, f, g) -> b -> b
deepSeq (a
a,b
b,c
c,d
d,e
e,f
f,g
g) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
a (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq b
b (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ c -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq c
c (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ d -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq d
d (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ e -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq e
e (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ f -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq f
f (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ g -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq g
g b
y

instance  DeepSeq Bool

instance  DeepSeq Char

instance  (DeepSeq a) => DeepSeq (Maybe a)  where
   deepSeq :: Maybe a -> b -> b
deepSeq Maybe a
Nothing b
y = b
y
   deepSeq (Just a
x) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
x b
y

instance  (DeepSeq a, DeepSeq b) => DeepSeq (Either a b)  where
   deepSeq :: Either a b -> b -> b
deepSeq (Left a
a) b
y = a -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq a
a b
y
   deepSeq (Right b
b) b
y = b -> b -> b
forall a b. DeepSeq a => a -> b -> b
deepSeq b
b b
y

instance  DeepSeq Ordering

instance  DeepSeq Integer
instance  DeepSeq Int
instance  DeepSeq Float
instance  DeepSeq Double