#define DO_TRACE 0
#define HANDLE_ATTRS_DATA_CONSTRAINT 0
#define INCLUDE_SHOW_INSTANCES 0
#if ! HASKELL98_FRAGMENT
#endif
module Control.DeepSeq.Bounded.NFDataP
(
#if OVERLOADED_STRINGS
deepseqp, forcep
, deepseqp_, forcep_
#else
deepseqp, forcep
, deepseqp_, forcep_
#endif
#if USE_PING_PATNODE
, DeepSeqBounded_PingException(..)
#endif
, module Control.DeepSeq.Bounded.Pattern
, module Control.DeepSeq.Bounded.PatUtil
, NFDataP(..)
, handleAttrs
)
where
import Control.DeepSeq.Bounded.Pattern
import Control.DeepSeq.Bounded.Compile
import Control.DeepSeq.Bounded.PatUtil ( unionPats, liftPats )
#if 1
import Control.DeepSeq.Bounded.PatUtil (
probDensRose
, weightedRose
, unzipRose
, showRose
#if ! HASKELL98_FRAGMENT
, Shape
, shapeOf
, ghom
#endif
)
#endif
import Control.DeepSeq.Bounded.NFDataN
#if USE_WW_DEEPSEQ
import Control.DeepSeq ( NFData )
import Control.DeepSeq ( rnf )
#endif
#if HANDLE_ATTRS_DATA_CONSTRAINT
import Data.Data
#endif
import Data.Typeable ( Typeable )
#if 1
import Data.Typeable ( typeOf )
#else
#if __GLASGOW_HASKELL__ >= 781
import Data.Typeable ( typeRep )
#else
import Data.Typeable ( typeOf )
#endif
#endif
import Data.Typeable ( mkTyCon3, mkTyConApp )
import Data.Typeable ( typeRepTyCon )
#if USE_PAR_PATNODE
import Control.Parallel ( par )
#endif
#if USE_PSEQ_PATNODE
import Control.Parallel ( pseq )
#endif
#if USE_PING_PATNODE
import Control.Concurrent ( myThreadId, killThread )
import Control.Concurrent ( forkIO )
#endif
import Control.Concurrent ( threadDelay )
import Data.Int
import Data.Word
import Data.Ratio
import Data.Complex
import Data.Array
import Data.Fixed
import Data.Version
import Data.Maybe ( Maybe(..), isJust, fromJust, isNothing )
import Control.Exception ( Exception )
import Control.Exception ( asyncExceptionFromException )
import Control.Exception ( throwTo )
import Control.Exception ( throw )
import Control.Exception( AsyncException( UserInterrupt ) )
import Control.Monad ( liftM )
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Unsafe ( unsafeDupablePerformIO )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Exception ( evaluate )
import System.Random ( randomIO )
import Debug.Trace ( trace )
#if USE_PING_PATNODE
data DeepSeqBounded_PingException = DeepSeqBounded_PingException String
deriving (Show, Typeable)
instance Exception DeepSeqBounded_PingException
#endif
#if DO_TRACE
mytrace = trace
#else
mytrace _ = id
#endif
#if OVERLOADED_STRINGS
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
deepseqp_ :: NFDataP_ictx a => Pattern -> a -> b -> b
#else
#if INCLUDE_SHOW_INSTANCES
deepseqp_ :: (Show a, NFDataP a) => Pattern -> a -> b -> b
#else
deepseqp_ :: NFDataP a => Pattern -> a -> b -> b
#endif
#endif
deepseqp_ = deepseqp
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
forcep_ :: NFDataP_ictx a => Pattern -> a -> a
#else
#if INCLUDE_SHOW_INSTANCES
forcep_ :: (Show a, NFDataP a) => Pattern -> a -> a
#else
forcep_ :: NFDataP a => Pattern -> a -> a
#endif
#endif
forcep_ = forcep
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
deepseqp :: NFDataP_ictx a => Pattern -> a -> b -> b
#else
#if INCLUDE_SHOW_INSTANCES
deepseqp :: (Show a, NFDataP a) => Pattern -> a -> b -> b
#else
deepseqp :: NFDataP a => Pattern -> a -> b -> b
#endif
#endif
deepseqp pat a b = rnfp pat a `seq` b
#if 0
($!!) :: (NFData a) => (a -> b) -> a -> b
f $!! x = x `deepseq` f x
#endif
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
forcep :: NFDataP_ictx a => Pattern -> a -> a
#else
#if INCLUDE_SHOW_INSTANCES
forcep :: (Show a, NFDataP a) => Pattern -> a -> a
#else
forcep :: NFDataP a => Pattern -> a -> a
#endif
#endif
forcep pat x = deepseqp pat x x
#else
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
deepseqp :: NFDataP_ictx a => String -> a -> b -> b
#else
#if INCLUDE_SHOW_INSTANCES
deepseqp :: (Show a, NFDataP a) => String -> a -> b -> b
#else
deepseqp :: NFDataP a => String -> a -> b -> b
#endif
#endif
#if 0
#elif 0
deepseqp patstr a b = fromJust $ deepseqp_ (compilePat patstr) a b
#elif 1
deepseqp patstr = deepseqp_ (compilePat patstr)
#elif 0
deepseqp patstr a b = rnfp (compilePat patstr) a `seq` b
#endif
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
deepseqp_ :: NFDataP_ictx a => Pattern -> a -> b -> b
#else
#if INCLUDE_SHOW_INSTANCES
deepseqp_ :: (Show a, NFDataP a) => Pattern -> a -> b -> b
#else
deepseqp_ :: NFDataP a => Pattern -> a -> b -> b
#endif
#endif
#if 0
#elif 0
deepseqp_ pat@(Node WI _) _ b = b
deepseqp_ pat@(Node (TR as) chs) a b = if elem ta treps then doit `seq` b else b
where ta = show $ typeRepTyCon $ typeOf a
doit = rnfp pat a `seq` b
treps = typeConstraints as
deepseqp_ pat@(Node (TI as) chs) a b = if elem ta treps then b else doit `seq` b
where ta = show $ typeRepTyCon $ typeOf a
doit = rnfp pat a `seq` b
treps = typeConstraints as
deepseqp_ pat a b = rnfp pat a `seq` b
#elif 1
deepseqp_ pat a b = rnfp pat a `seq` b
#endif
#if 0
($!!) :: (NFData a) => (a -> b) -> a -> b
f $!! x = x `deepseq` f x
#endif
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
forcep :: NFDataP_ictx a => String -> a -> a
#else
#if INCLUDE_SHOW_INSTANCES
forcep :: (Show a, NFDataP a) => String -> a -> a
#else
forcep :: NFDataP a => String -> a -> a
#endif
#endif
#if 0
#elif 0
forcep patstr x
| p = fromJust ma
| otherwise = undefined::a
where ma = deepseqp_ (compilePat patstr) x x
p = isJust ma
#elif 0
forcep patstr x = fromJust $ deepseqp_ (compilePat patstr) x x
#elif 0
forcep patstr x
| b = x
| otherwise = fromJust y
where y = deepseqp_ (compilePat patstr) x (Just x)
pat@(Node pas chs) = compilePat patstr
b | WI <- pas = True
| TR <- pas = True
| TN <- pas = True
| TW <- pas = True
| TI <- pas = True
| otherwise = False
#elif 1
forcep patstr x = deepseqp_ (compilePat patstr) x x
#endif
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
forcep_ :: NFDataP_ictx a => Pattern -> a -> a
#else
#if INCLUDE_SHOW_INSTANCES
forcep_ :: (Show a, NFDataP a) => Pattern -> a -> a
#else
forcep_ :: NFDataP a => Pattern -> a -> a
#endif
#endif
#if 0
forcep_ pat x = fromJust $ deepseqp_ pat x x
#else
forcep_ pat x = deepseqp_ pat x x
#endif
#endif
#if ! HASKELL98_FRAGMENT
#if __GLASGOW_HASKELL__ >= 710
type NFDataP_cctx a
= (
Typeable a
#if HANDLE_ATTRS_DATA_CONSTRAINT
, Data a
#endif
, NFDataN a
#if USE_WW_DEEPSEQ
, NFData a
#endif
)
#if 0
type NFDataP_ictx a
= (
Typeable a
#if HANDLE_ATTRS_DATA_CONSTRAINT
, Data a
#endif
, NFDataN a
#if USE_WW_DEEPSEQ
, NFData a
#endif
, NFDataP a
#if INCLUDE_SHOW_INSTANCES
, Show a
#endif
)
#else
type NFDataP_ictx a
= (
NFDataP_cctx a
, NFDataP a
#if INCLUDE_SHOW_INSTANCES
, Show a
#endif
)
#endif
#endif
#endif
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
class NFDataP_cctx a => NFDataP a where
#else
class (
Typeable a
#if HANDLE_ATTRS_DATA_CONSTRAINT
, Data a
#endif
, NFDataN a
#if USE_WW_DEEPSEQ
, NFData a
#endif
) => NFDataP a where
#endif
#if INCLUDE_SHOW_INSTANCES
rnfp :: Show a => Pattern -> a -> ()
#else
rnfp :: Pattern -> a -> ()
#endif
#if 0
#endif
#if 1
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
#else
rnfp (Node WI{} _) _ = ()
#endif
rnfp (Node (TR as) chs) d = if elem td treps then d `seq` () else ()
where td = show $ typeRepTyCon $ typeOf d
treps = typeConstraints as
rnfp (Node (TI as) chs) d = if elem td treps then () else d `seq` ()
where td = show $ typeRepTyCon $ typeOf d
treps = typeConstraints as
#if USE_WW_DEEPSEQ
rnfp (Node (TW as) chs) d = if elem td treps then d `seq` () else ()
where td = show $ typeRepTyCon $ typeOf d
treps = typeConstraints as
#endif
#if 1
rnfp _ d = d `seq` ()
#else
rnfp pat a | not $ patternShapeOK pat a = ()
| otherwise = rnf a
#endif
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
rnfp' :: NFDataP_ictx a => PatNode -> () -> a -> ()
#else
#if USE_WW_DEEPSEQ
rnfp' :: (Typeable a, NFDataN a, NFData a) => PatNode -> () -> a -> ()
#else
rnfp' :: (Typeable a, NFDataN a) => PatNode -> () -> a -> ()
#endif
#endif
rnfp' pas recurs d
=
let
td = show $ typeRepTyCon $ typeOf d
as = getPatNodeAttrs pas
treps = typeConstraints as
n = depth as
in
#if USE_PAR_PATNODE
if doSpark as
then
case pas of
WS{} -> () `par` ()
WR{} -> recurs `par` ()
WN{} -> rnfn n d `par` ()
#if USE_WW_DEEPSEQ
WW{} -> rnf d `par` ()
#endif
WI{} -> error "rnfp: unexpected =WI (please report this bug!)"
_ -> error $ "rnfp: Unexpected PatNode (with doSpark): " ++ show pas ++ "(please report this bug!)"
else
#endif
case pas of
WR{} -> recurs
WS{} -> ()
WN{} -> rnfn n d
#if USE_WW_DEEPSEQ
WW{} -> rnf d
#endif
#if 0
TR{} -> if elem td treps then recurs else ()
#endif
#if 0
TS{} -> if elem td treps then () else ()
#endif
TN{} -> if elem td treps then rnfn n d else ()
#if USE_WW_DEEPSEQ
TW{} -> if elem td treps then rnf d else ()
#endif
#if 0
NTR{} -> if not $ elem td treps then recurs else ()
NTN{} -> if not $ elem td treps then rnfn n d else ()
#if USE_WW_DEEPSEQ
NTW{} -> if not $ elem td treps then rnf d else ()
#endif
#endif
WI{} -> error "rnfp: unexpected WI (please report this bug!)"
TR{} -> error "rnfp: unexpected TR (please report this bug!)"
TI{} -> error "rnfp: unexpected TI (please report this bug!)"
_ -> error $ "rnfp: Unexpected PatNode: " ++ show pas ++ " (please report this bug!)"
#if 0
compose = (.)
#endif
instance NFDataP Int
instance NFDataP Word
instance NFDataP Integer
instance NFDataP Float
instance NFDataP Double
instance NFDataP Char
instance NFDataP Bool
instance NFDataP ()
instance NFDataP Int8
instance NFDataP Int16
instance NFDataP Int32
instance NFDataP Int64
instance NFDataP Word8
instance NFDataP Word16
instance NFDataP Word32
instance NFDataP Word64
instance Typeable a => NFDataP (Fixed a)
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b) => NFDataP (a -> b)
#else
instance (
Typeable a, Typeable b
#if HANDLE_ATTRS_DATA_CONSTRAINT
, Data a, Data b
#endif
) => NFDataP (a -> b)
#endif
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, Integral a) => NFDataP (Ratio a) where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Integral a, NFDataP a) => NFDataP (Ratio a) where
#else
instance (Integral a, NFDataP a) => NFDataP (Ratio a) where
#endif
#endif
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat x = rnfp pat (numerator x, denominator x)
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, RealFloat a) => NFDataP (Complex a) where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, RealFloat a, NFDataP a) => NFDataP (Complex a) where
#else
instance (RealFloat a, NFDataP a) => NFDataP (Complex a) where
#endif
#endif
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
2 -> let [px,py] = chs
(x:+y) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [ rnfp px x
, rnfp py y
]
#else
in rnfp px x
`seq` rnfp py y
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "(Complex a)" pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance NFDataP_ictx a => NFDataP (Maybe a) where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, NFDataP a) => NFDataP (Maybe a) where
#else
instance NFDataP a => NFDataP (Maybe a) where
#endif
#endif
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) Nothing
| not $ null chs = pat_match_fail
| otherwise = ()
where
pat_match_fail = patMatchFail' "Nothing" pas chs ()
rnfp (Node pas chs) (Just d)
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
1 -> let [p_J] = chs
in rnfp p_J d
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "Just" pas chs d
rnfp (Node pas chs) d = patMatchFail pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b) => NFDataP (Either a b) where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Show b, NFDataP a, NFDataP b) => NFDataP (Either a b) where
#else
instance (NFDataP a, NFDataP b) => NFDataP (Either a b) where
#endif
#endif
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp (Node pas chs) (Left d)
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
1 -> let [p_L] = chs
in rnfp p_L d
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "Left" pas chs d
rnfp (Node pas chs) (Right d)
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
1 -> let [p_R] = chs
in rnfp p_R d
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "Right" pas chs d
rnfp (Node pas chs) d = patMatchFail pas chs d
instance NFDataP Data.Version.Version where
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
2 -> let [pbr,ptags] = chs
Data.Version.Version branch tags = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [rnfp pbr branch, rnfp ptags tags]
#else
in rnfp pbr branch
`seq` rnfp ptags tags
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "Data.Version.Version" pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance NFDataP_ictx a => NFDataP [a] where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, NFDataP a) => NFDataP [a] where
#else
instance NFDataP a => NFDataP [a] where
#endif
#endif
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp _ [] = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
2 -> let [px,pxs] = chs
(x:xs) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [rnfp px x, rnfp pxs xs]
#else
in rnfp px x
`seq` rnfp pxs xs
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "[a]" pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (Ix a, NFDataP_ictx a, NFDataP_ictx b) => NFDataP (Array a b) where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Show b, Ix a, NFDataP a, NFDataP b) => NFDataP (Array a b) where
#else
instance (Ix a, NFDataP a, NFDataP b) => NFDataP (Array a b) where
#endif
#endif
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pas x = rnfp pas (bounds x, Data.Array.elems x)
`seq` ()
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b) => NFDataP (a,b) where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a,Typeable a,NFDataP a, Show b,Typeable b,NFDataP b) => NFDataP (a,b) where
#else
instance (Typeable a,NFDataP a, Typeable b,NFDataP b) => NFDataP (a,b) where
#endif
#endif
rnfp p x | handleAttrs p x `seq` p == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
2 -> let [px,py] = chs
(x,y) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [rnfp px x, rnfp py y]
#else
in rnfp px x
`seq` rnfp py y
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "(,)" pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b, NFDataP_ictx c) => NFDataP (a,b,c) where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Typeable a, NFDataP a, Show b, Typeable b, NFDataP b, Show c, Typeable c, NFDataP c) => NFDataP (a,b,c) where
#else
instance (Typeable a, NFDataP a, Typeable b, NFDataP b, Typeable c, NFDataP c) => NFDataP (a,b,c) where
#endif
#endif
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
3 ->
let [px,py,pz] = chs
(x,y,z) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [ rnfp px x
, rnfp py y
, rnfp pz z
]
#else
in ( rnfp px x)
`seq` ( rnfp py y)
`seq` ( rnfp pz z)
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "(,,)" pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b, NFDataP_ictx c, NFDataP_ictx d) => NFDataP (a,b,c,d) where
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Typeable a, NFDataP a, Show b, Typeable b, NFDataP b, Show c, Typeable c, NFDataP c, Show d, Typeable d, NFDataP d) => NFDataP (a,b,c,d) where
#else
instance (Typeable a, NFDataP a, Typeable b, NFDataP b, Typeable c, NFDataP c, Typeable d, NFDataP d) => NFDataP (a,b,c,d) where
#endif
#endif
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
4 -> let [px1,px2,px3,px4] = chs
(x1,x2,x3,x4) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [ rnfp px1 x1
, rnfp px2 x2
, rnfp px3 x3
, rnfp px4 x4
]
#else
in rnfp px1 x1
`seq` rnfp px2 x2
`seq` rnfp px3 x3
`seq` rnfp px4 x4
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "(,,,)" pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b, NFDataP_ictx c, NFDataP_ictx d, NFDataP_ictx e) =>
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Typeable a, NFDataP a, Show b, Typeable b, NFDataP b, Show c, Typeable c, NFDataP c, Show d, Typeable d, NFDataP d, Show e, Typeable e, NFDataP e) =>
#else
instance (Typeable a, NFDataP a, Typeable b, NFDataP b, Typeable c, NFDataP c, Typeable d, NFDataP d, Typeable e, NFDataP e) =>
#endif
#endif
NFDataP (a, b, c, d, e) where
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
5 -> let [px1,px2,px3,px4,px5] = chs
(x1,x2,x3,x4,x5) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [ rnfp px1 x1
, rnfp px2 x2
, rnfp px3 x3
, rnfp px4 x4
, rnfp px5 x5
]
#else
in rnfp px1 x1
`seq` rnfp px2 x2
`seq` rnfp px3 x3
`seq` rnfp px4 x4
`seq` rnfp px5 x5
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "(,,,,)" pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b, NFDataP_ictx c, NFDataP_ictx d, NFDataP_ictx e, NFDataP_ictx f) =>
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Typeable a, NFDataP a, Show b, Typeable b, NFDataP b, Show c, Typeable c, NFDataP c, Show d, Typeable d, NFDataP d, Show e, Typeable e, NFDataP e, Show f, Typeable f, NFDataP f) =>
#else
instance (Typeable a, NFDataP a, Typeable b, NFDataP b, Typeable c, NFDataP c, Typeable d, NFDataP d, Typeable e, NFDataP e, Typeable f, NFDataP f) =>
#endif
#endif
NFDataP (a, b, c, d, e, f) where
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
6 -> let [px1,px2,px3,px4,px5,px6] = chs
(x1,x2,x3,x4,x5,x6) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [ rnfp px1 x1
, rnfp px2 x2
, rnfp px3 x3
, rnfp px4 x4
, rnfp px5 x5
, rnfp px6 x6
]
#else
in rnfp px1 x1
`seq` rnfp px2 x2
`seq` rnfp px3 x3
`seq` rnfp px4 x4
`seq` rnfp px5 x5
`seq` rnfp px6 x6
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "(,,,,,)" pas chs d
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b, NFDataP_ictx c, NFDataP_ictx d, NFDataP_ictx e, NFDataP_ictx f, NFDataP_ictx g) =>
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Typeable a, NFDataP a, Show b, Typeable b, NFDataP b, Show c, Typeable c, NFDataP c, Show d, Typeable d, NFDataP d, Show e, Typeable e, NFDataP e, Show f, Typeable f, NFDataP f, Show g, Typeable g, NFDataP g) =>
#else
instance (Typeable a, NFDataP a, Typeable b, NFDataP b, Typeable c, NFDataP c, Typeable d, NFDataP d, Typeable e, NFDataP e, Typeable f, NFDataP f, Typeable g, NFDataP g) =>
#endif
#endif
NFDataP (a, b, c, d, e, f, g) where
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
7 -> let [px1,px2,px3,px4,px5,px6,px7] = chs
(x1,x2,x3,x4,x5,x6,x7) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [ rnfp px1 x1
, rnfp px2 x2
, rnfp px3 x3
, rnfp px4 x4
, rnfp px5 x5
, rnfp px6 x6
, rnfp px7 x7
]
#else
in rnfp px1 x1
`seq` rnfp px2 x2
`seq` rnfp px3 x3
`seq` rnfp px4 x4
`seq` rnfp px5 x5
`seq` rnfp px6 x6
`seq` rnfp px7 x7
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "(,,,,,,)" pas chs d
#if 0
#if ( ! HASKELL98_FRAGMENT ) && ( __GLASGOW_HASKELL__ >= 710 )
instance (NFDataP_ictx a, NFDataP_ictx b, NFDataP_ictx c, NFDataP_ictx d, NFDataP_ictx e, NFDataP_ictx f, NFDataP_ictx g, NFDataP_ictx h) =>
#else
#if INCLUDE_SHOW_INSTANCES
instance (Show a, Typeable a, NFDataP a, Show b, Typeable b, NFDataP b, Show c, Typeable c, NFDataP c, Show d, Typeable d, NFDataP d, Show e, Typeable e, NFDataP e, Show f, Typeable f, NFDataP f, Show g, Typeable g, NFDataP g, Show h, Typeable h, NFDataP h) =>
#else
instance (Typeable a, NFDataP a, Typeable b, NFDataP b, Typeable c, NFDataP c, Typeable d, NFDataP d, Typeable e, NFDataP e, Typeable f, NFDataP f, Typeable g, NFDataP g, Typeable h, NFDataP h) =>
#endif
#endif
NFDataP (a, b, c, d, e, f, g, h) where
rnfp p x | handleAttrs p x == Node XX [] = undefined
rnfp (Node WI{} _) _ = ()
rnfp pat@(Node pas chs) d
| TR{} <- pas = if elem td treps then recurs else ()
#if USE_WW_DEEPSEQ
| TI{} <- pas = if elem td treps then () else rnf d
| TW{} <- pas = if elem td treps then rnf d else ()
#else
| TI{} <- pas = if elem td treps then () else rnfn 999999 d
#endif
| otherwise = rnfp' pas recurs d
where
as = getPatNodeAttrs pas
treps = typeConstraints as
td = show $ typeRepTyCon $ typeOf d
recurs = case length chs of
0 -> case pas of
WS{} -> ()
_ -> pat_match_fail
8 -> let [px1,px2,px3,px4,px5,px6,px7,px8] = chs
(x1,x2,x3,x4,x5,x6,x7,x8) = d
#if USE_PSEQ_PATNODE
in pseq_condition pat [ rnfp px1 x1
, rnfp px2 x2
, rnfp px3 x3
, rnfp px4 x4
, rnfp px5 x5
, rnfp px6 x6
, rnfp px7 x7
, rnfp px8 x8
]
#else
in rnfp px1 x1
`seq` rnfp px2 x2
`seq` rnfp px3 x3
`seq` rnfp px4 x4
`seq` rnfp px5 x5
`seq` rnfp px6 x6
`seq` rnfp px7 x7
`seq` rnfp px8 x8
#endif
`seq` ()
_ -> pat_match_fail
pat_match_fail = patMatchFail' "(,,,,,,,)" pas chs d
#endif
patMatchFail :: (Show a, Show b) => a -> b -> c -> ()
patMatchFail pas chs d
#if WARN_PATTERN_MATCH_FAILURE
= ( unsafePerformIO $! putStrLn $! "NFDataP: warning: couldn't match " ++ show pas ++ " (having children " ++ show chs ++ ")" ) `seq` ()
#else
= ()
#endif
patMatchFail' :: (Show a, Show b) => String -> a -> b -> c -> ()
patMatchFail' inst pas chs d
#if WARN_PATTERN_MATCH_FAILURE
= ( unsafePerformIO $! putStrLn $! "NFDataP: warning: instance " ++ inst ++ ": bad PatNode child list" ) `seq` patMatchFail pas chs d
#else
= ()
#endif
#if 0
handleAttrs pat@(Node p _) x = pat
#else
#if ! HASKELL98_FRAGMENT
#if HANDLE_ATTRS_DATA_CONSTRAINT
handleAttrs :: forall d. Data d => Pattern -> d -> Pattern
handleAttrs (Node p _) x
#else
handleAttrs :: forall d. Typeable d => Pattern -> d -> Pattern
handleAttrs (Node p _) x
#endif
#else
handleAttrs :: Pattern -> a -> Pattern
handleAttrs (Node p _) _
#endif
#if 0
| uniqueID as == 4 && trace ("HERE! "++show p++"\n"++show as) False = undefined
| uniqueID as == 9 && trace ("HERE! "++show p++"\n"++show as) False = undefined
| uniqueID as == 11 && trace ("HERE! "++show p++"\n"++show as) False = undefined
#endif
| otherwise = unsafePerformIO $ do
let p0 = p
p1 <- if doDelay as
then dly p0 b
else return p0
#if USE_TRACE_PATNODE
p2 <- if doTrace as
then trc p1 b msg_trc
else return p1
#else
let p2 = p1
#endif
#if USE_PING_PATNODE
p3 <- if doPing as
then png p2 b msg_png
else return p2
#else
let p3 = p2
#endif
#if USE_DIE_PATNODE
p4 <- if doDie as
then die p3 b msg_die
else return p3
#else
let p4 = p3
#endif
#if USE_TIMING_PATNODE
p5 <- if doTiming as
then timing p4 b msg_timing
else return p4
#else
let p5 = p4
#endif
return $! Node p5 []
| otherwise = Node p []
where
#if 1
b = False
#else
b = unsafePerformIO $ ( randomIO :: IO Bool )
#endif
dly p b
| otherwise = do
if b
then do
!_ <- threadDelay $ delayus as
return p
else do
!_ <- threadDelay $ delayus as
return p
#if USE_TRACE_PATNODE
msg_trc = "NFDataP: TRACE: " ++ show (uniqueID as)
#if ! HASKELL98_FRAGMENT
++ " " ++ show (typeOf x)
#if HANDLE_ATTRS_DATA_CONSTRAINT
++ "\n" ++ showRose (shapeOf x)
#endif
#endif
trc p b msg
| otherwise = do
if b
then do
!_ <- trace msg $ return ()
return p
else do
!_ <- trace msg $ return ()
return p
#endif
#if USE_PING_PATNODE
msg_png = "NFDataP: PING: " ++ show (uniqueID as)
#if ! HASKELL98_FRAGMENT
++ " " ++ show (typeOf x)
#if HANDLE_ATTRS_DATA_CONSTRAINT
++ "\n" ++ showRose (shapeOf x)
#endif
#endif
png p b msg
#if 1
| isNothing mpngtid = do
if b
then do
return p
else do
return p
#else
| isNothing mpngtid = False
#endif
| otherwise = do
if b
then do
!_ <- forkIO $ throw $ DeepSeqBounded_PingException msg
return p
else do
!_ <- forkIO $ throw $ DeepSeqBounded_PingException msg
return p
where mpngtid = pingParentTID as
#endif
#if USE_DIE_PATNODE
msg_die = "NFDataP: DIE: " ++ show (uniqueID as)
#if ! HASKELL98_FRAGMENT
++ " " ++ show (typeOf x)
#if HANDLE_ATTRS_DATA_CONSTRAINT
++ "\n" ++ showRose (shapeOf x)
#endif
#endif
die p b msg = do
if b
then do
putStrLn msg >> myThreadId >>= killThread
return p
else do
putStrLn msg >> myThreadId >>= killThread
return p
#endif
#if USE_TIMING_PATNODE
msg_timing = "NFDataP: TIMING: " ++ show (uniqueID as)
#if ! HASKELL98_FRAGMENT
++ " " ++ show (typeOf x)
#if HANDLE_ATTRS_DATA_CONSTRAINT
++ "\n" ++ showRose (shapeOf x)
#endif
#endif
timing p b msg = do
if b
then do
return p
else do
return p
#endif
as = getPatNodeAttrs p
#endif
#if USE_PSEQ_PATNODE
pseq_condition :: Pattern -> [()] -> ()
#if 0
#elif 1
pseq_condition pat@(Node pn cs) fs
| isNothing mperm = foldr seq () fs
| otherwise = foldr pseq () $ map (\i->(fs!!i)) perm
where
mperm = pseqPerm $ getPatNodeAttrs pn
perm = fromJust mperm
#elif 0
pseq_condition pat@(Node pn cs) fs
= foldr pseq () fs'
where
mperm = pseqPerm $ getPatNodeAttrs pn
perm = fromJust mperm
fs' | isNothing mperm = fs
| otherwise = map (\i->(fs!!i)) perm
#elif 0
pseq_condition pats fs = foldr seq () fs
#endif
#endif