{-# 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 -> BList
unpack (Pedigree Int
_ BList
x) = BList
x
cons :: a -> [a] -> [a]
cons = (:)
empty :: [a]
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 { Pedigree -> Int
ivarCounter :: {-# UNPACK #-} !Int, 
	         Pedigree -> BList
treePath    :: !BList }

instance SplittableState Pedigree where
  splitState :: Pedigree -> (Pedigree, Pedigree)
splitState (Pedigree Int
cnt BList
bl) = 
    (Int -> BList -> Pedigree
Pedigree Int
cnt (Bool -> BList -> BList
forall a. a -> [a] -> [a]
cons Bool
False BList
bl), 
     Int -> BList -> Pedigree
Pedigree Int
cnt (Bool -> BList -> BList
forall a. a -> [a] -> [a]
cons Bool
True BList
bl))

pedigree :: ParFuture iv p => S.StateT Pedigree p Pedigree
pedigree :: StateT Pedigree p Pedigree
pedigree = StateT Pedigree p Pedigree
forall (m :: * -> *) s. Monad m => StateT s m s
S.get

runParPedigree :: Monad p => ParPedigreeT p a -> p a
runParPedigree :: ParPedigreeT p a -> p a
runParPedigree ParPedigreeT p a
m = ParPedigreeT p a -> Pedigree -> p a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT ParPedigreeT p a
m (Int -> BList -> Pedigree
Pedigree Int
0 BList
forall a. [a]
empty)