packages feed

leaky-0.1.0.0: Types.hs

-------------------------------------------------------------------------------

  -- XXX Note that -dcore-lint exposes a bug in GHC with this module,
  -- so we cannot have it on when Types.hs recompiles.
  -- Incidentally, this error happens with -O2 but not -O0...
  {-  OPTIONS_GHC -dno-core-lint #-}  -- nonesuch, unfortunately

  {-  OPTIONS_GHC -O2 #-}
  {-# OPTIONS_GHC -O0 #-}

  {-# LANGUAGE CPP #-}

  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE StandaloneDeriving #-}

-------------------------------------------------------------------------------

  module Types where

  import Control.DeepSeq.Bounded
  import Control.DeepSeq.Generics

--import Generics.SOP.TH
  import GHC.Generics ( Generic )
  import Data.Typeable ( Typeable )
  import Data.Data ( Data )

  import System.Random

  import Data.List ( foldl' )


#if 0
#if FORCING_STRATEGY == 4
  import Seqaid.Runtime ( seqaid )
#endif
#if FORCING_STRATEGY >= 5
--import Seqaid.Runtime  -- comes in with Seqaid.TH
  import Seqaid.TH
#endif
#endif

-------------------------------------------------------------------------------

  type State = TA

  doWork :: Num a => Blob a -> a
  doWork (Blob lst) = foldl' (+) 0 lst

  data Blob a = Blob [a]
    deriving (Show,Generic,Typeable,Data)

  instance (NFData a,Num a) => NFData (Blob a) where rnf x = force (doWork x) `seq` ()
  instance (NFData a,Num a) => NFDataN (Blob a) where rnfn n x = force (doWork x) `seq` ()
  instance (NFData a,Num a,Typeable a) => NFDataP (Blob a) where rnfp p x = force (doWork x) `seq` ()

-- XXX Why exactly is this needed, when it wasn't needed when
-- everything was in one module??...
#if 0
  {-# NOINLINE hackblah #-}
  hackblah :: IO StdGen
  hackblah = getStdGen
#else
  deriving instance Typeable StdGen
  instance NFData StdGen where rnf x = ()
  instance NFDataN StdGen where rnfn n x = ()
  instance NFDataP StdGen where rnfp p x = ()
#endif

#if 1
  -- (No strict fields.)
  data TA = A1 Int | A2 TB Int TC
  data TB = B1 | B2 TC | B3 Int TA TB
#if USE_STRICT_BLOB
  -- Note: I think Blob must NOT have a strictness bang (!).
  -- Later: I doubt it matters, the way doing Blob's now...
  data TC = C1 Int TC | C2 Int | C3 TC (Blob Int) ![Int] TC
#else
  data TC = C1 Int TC | C2 Int | C3 TC ![Int] TC
#endif
#else
  -- All Int fields strict (!):
  data TA = A1 !Int | A2 TB !Int TC
  data TB = B1 | B2 TC | B3 !Int TA TB
#if USE_STRICT_BLOB
  -- Note: I think Blob must NOT have a strictness bang (!).
  -- Later: I doubt it matters, the way doing Blob's now...
  data TC = C1 !Int TC | C2 !Int | C3 TC (Blob Int) ![Int] TC
#else
  data TC = C1 !Int TC | C2 !Int | C3 TC ![Int] TC
#endif
#endif

#if FORCING_STRATEGY >= 5
  -- LATER: XXX Exactly the opposite is true now; I have
  -- switched off the use of -fplugin-opt= flags, and am
  -- opting for the seqaidTH splice meta-call to signal
  -- to the plugin (via presence of SeqaidAnnIncludeList
  -- annotation) that the module is to be processed.
  --   If you leave this splice active, you get an error,
  -- at the present time (that's the reason for USE_SECOND_MODULE).
  ------
  -- No need to comment this out when not in use; the TH code knows
  -- if the plugin is slated to run on a module or not.
--seqaidTH
#endif

-------------------------------------------------------------------------------