module Control.Monad.Par.AList
(
AList(..),
empty, singleton, cons, head, tail, length, null, append,
toList, fromList,
parBuildThresh, parBuildThreshM,
parBuild, parBuildM,
)
where
import Control.DeepSeq
import Prelude hiding (length,head,tail,null)
import qualified Prelude as P
import Control.Monad.Par
data AList a = ANil | ASing a | Append (AList a) (AList a) | AList [a]
instance NFData a => NFData (AList a) where
rnf ANil = ()
rnf (ASing a) = rnf a
rnf (Append l r) = rnf l `seq` rnf r
rnf (AList l) = rnf l
#if 0
data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
instance Traversable Tree
traverse f Empty = pure Empty
traverse f (Leaf x) = Leaf <$> f x
traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
#endif
instance Show a => Show (AList a) where
show al = "fromList "++ show (toList al)
append :: AList a -> AList a -> AList a
append ANil r = r
append l ANil = l
append l r = Append l r
empty :: AList a
empty = ANil
singleton :: a -> AList a
singleton = ASing
fromList :: [a] -> AList a
fromList = AList
cons :: a -> AList a -> AList a
cons x ANil = ASing x
cons x al = Append (ASing x) al
head :: AList a -> a
head al =
case loop al of
Just x -> x
Nothing -> error "cannot take head of an empty AList"
where
loop al =
case al of
Append l r -> case loop l of
x@(Just _) -> x
Nothing -> loop r
ASing x -> Just x
AList (h:_) -> Just h
AList [] -> Nothing
ANil -> Nothing
tail :: AList a -> AList a
tail al =
case loop al of
Just x -> x
Nothing -> error "cannot take tail of an empty AList"
where
loop al =
case al of
Append l r -> case loop l of
(Just x) -> Just (Append x r)
Nothing -> loop r
ASing _ -> Just ANil
AList (_:t) -> Just (AList t)
AList [] -> Nothing
ANil -> Nothing
length :: AList a -> Int
length ANil = 0
length (ASing _) = 1
length (Append l r) = length l + length r
length (AList l) = P.length l
null :: AList a -> Bool
null = (==0) . length
toList :: AList a -> [a]
toList a = go a []
where go ANil rest = rest
go (ASing a) rest = a : rest
go (Append l r) rest = go l $! go r rest
go (AList xs) rest = xs ++ rest
appendM :: AList a -> AList a -> Par (AList a)
appendM x y = return (append x y)
parBuildThresh :: NFData a => Int -> InclusiveRange -> (Int -> a) -> Par (AList a)
parBuildThresh threshold range fn =
parMapReduceRangeThresh threshold range
(return . singleton . fn) appendM empty
parBuildThreshM :: NFData a => Int -> InclusiveRange -> (Int -> Par a) -> Par (AList a)
parBuildThreshM threshold range fn =
parMapReduceRangeThresh threshold range
((fmap singleton) . fn) appendM empty
parBuild :: NFData a => InclusiveRange -> (Int -> a) -> Par (AList a)
parBuild range fn =
parMapReduceRange range (return . singleton . fn) appendM empty
parBuildM :: NFData a => InclusiveRange -> (Int -> Par a) -> Par (AList a)
parBuildM range fn =
parMapReduceRange range ((fmap singleton) . fn) appendM empty