monad-par-extras-0.3: Control/Monad/Par/Pedigree.hs

{-# LANGUAGE TypeSynonymInstances, CPP, FlexibleInstances, BangPatterns #-}

-- | This module extends a Par monad with /pedigree/.  That is, it
--   allows a running computation to look up its position in the
--   dynamic binary tree of `fork` calls ("ancestry").

module Control.Monad.Par.Pedigree
 (
   pedigree, ParPedigreeT
 , unpack, runParPedigree
 ) 
 where 

import Control.Monad.Par.Class
import Control.Monad.Par.State
import Control.Monad.Trans.State.Strict as S 

-- It's running slightly better with normal lists for parfib:
#if 0 
import Data.BitList
type BList = BitList
#else
type BList = [Bool]
unpack (Pedigree _ x) = x
cons = (:)
empty = []
#endif

type ParPedigreeT p a = S.StateT Pedigree p a

-- type Pedigree = BList
-- -- | Trivial instance.
-- instance SplittableState Pedigree where
--   splitState bl = (cons False bl, cons True bl)

data Pedigree = 
      Pedigree { ivarCounter :: {-# UNPACK #-} !Int, 
	         treePath    :: !BList }

instance SplittableState Pedigree where
  splitState (Pedigree cnt bl) = 
    (Pedigree cnt (cons False bl), 
     Pedigree cnt (cons True bl))

pedigree :: ParFuture iv p => S.StateT Pedigree p Pedigree
pedigree = S.get

runParPedigree :: Monad p => ParPedigreeT p a -> p a
runParPedigree m = S.evalStateT m (Pedigree 0 empty)