{-# LANGUAGE CPP, DeriveDataTypeable #-}
{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fwarn-unused-imports #-}
module Control.Monad.Par.AList
{-# DEPRECATED "This structure does not perform well, and will be removed in future versions" #-}
(
AList(..),
empty, singleton, cons, head, tail, length, null, append,
toList, fromList, fromListBalanced,
filter, map, partition,
parBuildThresh, parBuildThreshM,
parBuild, parBuildM,
depth, balance
)
where
import Control.DeepSeq
import Prelude hiding (length,head,tail,null,map,filter)
import qualified Prelude as P
import qualified Data.List as L
import qualified Control.Monad.Par.Combinator as C
import Control.Monad.Par.Class
import Data.Typeable
import qualified Data.Serialize as S
data AList a = ANil | ASing a | Append (AList a) (AList a) | AList [a]
deriving (Typeable)
instance NFData a => NFData (AList a) where
rnf :: AList a -> ()
rnf AList a
ANil = ()
rnf (ASing a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
rnf (Append AList a
l AList a
r) = AList a -> ()
forall a. NFData a => a -> ()
rnf AList a
l () -> () -> ()
forall a b. a -> b -> b
`seq` AList a -> ()
forall a. NFData a => a -> ()
rnf AList a
r
rnf (AList [a]
l) = [a] -> ()
forall a. NFData a => a -> ()
rnf [a]
l
instance Show a => Show (AList a) where
show :: AList a -> String
show AList a
al = String
"fromList "String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show (AList a -> [a]
forall a. AList a -> [a]
toList AList a
al)
instance S.Serialize a => S.Serialize (AList a) where
put :: Putter (AList a)
put AList a
al = Putter [a]
forall t. Serialize t => Putter t
S.put (AList a -> [a]
forall a. AList a -> [a]
toList AList a
al)
get :: Get (AList a)
get = do [a]
x <- Get [a]
forall t. Serialize t => Get t
S.get
AList a -> Get (AList a)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> AList a
forall a. [a] -> AList a
fromList [a]
x)
{-# INLINE append #-}
append :: AList a -> AList a -> AList a
append :: forall a. AList a -> AList a -> AList a
append AList a
ANil AList a
r = AList a
r
append AList a
l AList a
ANil = AList a
l
append AList a
l AList a
r = AList a -> AList a -> AList a
forall a. AList a -> AList a -> AList a
Append AList a
l AList a
r
{-# INLINE empty #-}
empty :: AList a
empty :: forall a. AList a
empty = AList a
forall a. AList a
ANil
{-# INLINE singleton #-}
singleton :: a -> AList a
singleton :: forall a. a -> AList a
singleton = a -> AList a
forall a. a -> AList a
ASing
{-# INLINE fromList #-}
fromList :: [a] -> AList a
fromList :: forall a. [a] -> AList a
fromList = [a] -> AList a
forall a. [a] -> AList a
AList
fromListBalanced :: [a] -> AList a
fromListBalanced :: forall a. [a] -> AList a
fromListBalanced [a]
xs = [a] -> Int -> AList a
forall {a}. [a] -> Int -> AList a
go [a]
xs ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [a]
xs)
where
go :: [a] -> Int -> AList a
go [a]
_ Int
0 = AList a
forall a. AList a
ANil
go [a]
ls Int
1 = case [a]
ls of
(a
h:[a]
_) -> a -> AList a
forall a. a -> AList a
ASing a
h
[] -> String -> AList a
forall a. HasCallStack => String -> a
error String
"the impossible happened"
go [a]
ls Int
n =
let (Int
q,Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
2 in
AList a -> AList a -> AList a
forall a. AList a -> AList a -> AList a
Append ([a] -> Int -> AList a
go [a]
ls Int
q)
([a] -> Int -> AList a
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
q [a]
ls) (Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
r))
balance :: AList a -> AList a
balance :: forall a. AList a -> AList a
balance = [a] -> AList a
forall a. [a] -> AList a
fromListBalanced ([a] -> AList a) -> (AList a -> [a]) -> AList a -> AList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AList a -> [a]
forall a. AList a -> [a]
toList
{-# INLINE cons #-}
cons :: a -> AList a -> AList a
cons :: forall a. a -> AList a -> AList a
cons a
x AList a
ANil = a -> AList a
forall a. a -> AList a
ASing a
x
cons a
x AList a
al = AList a -> AList a -> AList a
forall a. AList a -> AList a -> AList a
Append (a -> AList a
forall a. a -> AList a
ASing a
x) AList a
al
head :: AList a -> a
head :: forall a. AList a -> a
head AList a
al =
case AList a -> Maybe a
forall {a}. AList a -> Maybe a
loop AList a
al of
Just a
x -> a
x
Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
error String
"cannot take head of an empty AList"
where
loop :: AList a -> Maybe a
loop AList a
al =
case AList a
al of
Append AList a
l AList a
r -> case AList a -> Maybe a
loop AList a
l of
x :: Maybe a
x@(Just a
_) -> Maybe a
x
Maybe a
Nothing -> AList a -> Maybe a
loop AList a
r
ASing a
x -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
AList (a
h:[a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
h
AList [] -> Maybe a
forall a. Maybe a
Nothing
AList a
ANil -> Maybe a
forall a. Maybe a
Nothing
tail :: AList a -> AList a
tail :: forall a. AList a -> AList a
tail AList a
al =
case AList a -> Maybe (AList a)
forall {a}. AList a -> Maybe (AList a)
loop AList a
al of
Just AList a
x -> AList a
x
Maybe (AList a)
Nothing -> String -> AList a
forall a. HasCallStack => String -> a
error String
"cannot take tail of an empty AList"
where
loop :: AList a -> Maybe (AList a)
loop AList a
al =
case AList a
al of
Append AList a
l AList a
r -> case AList a -> Maybe (AList a)
loop AList a
l of
(Just AList a
x) -> AList a -> Maybe (AList a)
forall a. a -> Maybe a
Just (AList a -> AList a -> AList a
forall a. AList a -> AList a -> AList a
Append AList a
x AList a
r)
Maybe (AList a)
Nothing -> AList a -> Maybe (AList a)
loop AList a
r
ASing a
_ -> AList a -> Maybe (AList a)
forall a. a -> Maybe a
Just AList a
forall a. AList a
ANil
AList (a
_:[a]
t) -> AList a -> Maybe (AList a)
forall a. a -> Maybe a
Just ([a] -> AList a
forall a. [a] -> AList a
AList [a]
t)
AList [] -> Maybe (AList a)
forall a. Maybe a
Nothing
AList a
ANil -> Maybe (AList a)
forall a. Maybe a
Nothing
length :: AList a -> Int
length :: forall a. AList a -> Int
length AList a
ANil = Int
0
length (ASing a
_) = Int
1
length (Append AList a
l AList a
r) = AList a -> Int
forall a. AList a -> Int
length AList a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AList a -> Int
forall a. AList a -> Int
length AList a
r
length (AList [a]
l) = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [a]
l
{-# INLINE null #-}
null :: AList a -> Bool
null :: forall a. AList a -> Bool
null = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) (Int -> Bool) -> (AList a -> Int) -> AList a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AList a -> Int
forall a. AList a -> Int
length
toList :: AList a -> [a]
toList :: forall a. AList a -> [a]
toList AList a
a = AList a -> [a] -> [a]
forall {a}. AList a -> [a] -> [a]
go AList a
a []
where go :: AList a -> [a] -> [a]
go AList a
ANil [a]
rest = [a]
rest
go (ASing a
a) [a]
rest = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest
go (Append AList a
l AList a
r) [a]
rest = AList a -> [a] -> [a]
go AList a
l ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$! AList a -> [a] -> [a]
go AList a
r [a]
rest
go (AList [a]
xs) [a]
rest = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rest
partition :: (a -> Bool) -> AList a -> (AList a, AList a)
partition :: forall a. (a -> Bool) -> AList a -> (AList a, AList a)
partition a -> Bool
p AList a
a = AList a -> (AList a, AList a) -> (AList a, AList a)
go AList a
a (AList a
forall a. AList a
ANil, AList a
forall a. AList a
ANil)
where go :: AList a -> (AList a, AList a) -> (AList a, AList a)
go AList a
ANil (AList a, AList a)
acc = (AList a, AList a)
acc
go (ASing a
a) (AList a
ys, AList a
ns) | a -> Bool
p a
a = (a
a a -> AList a -> AList a
forall a. a -> AList a -> AList a
`cons` AList a
ys, AList a
ns)
go (ASing a
a) (AList a
ys, AList a
ns) | Bool
otherwise = (AList a
ys, a
a a -> AList a -> AList a
forall a. a -> AList a -> AList a
`cons` AList a
ns)
go (Append AList a
l AList a
r) (AList a, AList a)
acc = AList a -> (AList a, AList a) -> (AList a, AList a)
go AList a
l ((AList a, AList a) -> (AList a, AList a))
-> (AList a, AList a) -> (AList a, AList a)
forall a b. (a -> b) -> a -> b
$! AList a -> (AList a, AList a) -> (AList a, AList a)
go AList a
r (AList a, AList a)
acc
go (AList [a]
xs) (AList a
ys, AList a
ns) = ([a] -> AList a
forall a. [a] -> AList a
AList [a]
ys' AList a -> AList a -> AList a
forall a. AList a -> AList a -> AList a
`append` AList a
ys, [a] -> AList a
forall a. [a] -> AList a
AList [a]
ns' AList a -> AList a -> AList a
forall a. AList a -> AList a -> AList a
`append` AList a
ns)
where
([a]
ys', [a]
ns') = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition a -> Bool
p [a]
xs
depth :: AList a -> Int
depth :: forall a. AList a -> Int
depth AList a
ANil = Int
0
depth (ASing a
_) = Int
1
depth (AList [a]
_) = Int
1
depth (Append AList a
l AList a
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (AList a -> Int
forall a. AList a -> Int
depth AList a
l) (AList a -> Int
forall a. AList a -> Int
depth AList a
r)
filter :: (a -> Bool) -> AList a -> AList a
filter :: forall a. (a -> Bool) -> AList a -> AList a
filter a -> Bool
p AList a
l = AList a -> AList a
loop AList a
l
where
loop :: AList a -> AList a
loop AList a
ANil = AList a
forall a. AList a
ANil
loop o :: AList a
o@(ASing a
x) = if a -> Bool
p a
x then AList a
o else AList a
forall a. AList a
ANil
loop (AList [a]
ls) = [a] -> AList a
forall a. [a] -> AList a
AList([a] -> AList a) -> [a] -> AList a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
P.filter a -> Bool
p [a]
ls
loop (Append AList a
x AList a
y) =
let l :: AList a
l = AList a -> AList a
loop AList a
x
r :: AList a
r = AList a -> AList a
loop AList a
y in
case (AList a
l,AList a
r) of
(AList a
ANil,AList a
ANil) -> AList a
forall a. AList a
ANil
(AList a
ANil,AList a
y) -> AList a
y
(AList a
x,AList a
ANil) -> AList a
x
(AList a
x,AList a
y) -> AList a -> AList a -> AList a
forall a. AList a -> AList a -> AList a
Append AList a
x AList a
y
map :: (a -> b) -> AList a -> AList b
map :: forall a b. (a -> b) -> AList a -> AList b
map a -> b
_ AList a
ANil = AList b
forall a. AList a
ANil
map a -> b
f (ASing a
x) = b -> AList b
forall a. a -> AList a
ASing (a -> b
f a
x)
map a -> b
f (AList [a]
l) = [b] -> AList b
forall a. [a] -> AList a
AList ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
P.map a -> b
f [a]
l)
map a -> b
f (Append AList a
x AList a
y) = AList b -> AList b -> AList b
forall a. AList a -> AList a -> AList a
Append ((a -> b) -> AList a -> AList b
forall a b. (a -> b) -> AList a -> AList b
map a -> b
f AList a
x) ((a -> b) -> AList a -> AList b
forall a b. (a -> b) -> AList a -> AList b
map a -> b
f AList a
y)
parBuildThresh :: (NFData a, ParFuture f p) => Int -> C.InclusiveRange -> (Int -> a) -> p (AList a)
parBuildThresh :: forall a (f :: * -> *) (p :: * -> *).
(NFData a, ParFuture f p) =>
Int -> InclusiveRange -> (Int -> a) -> p (AList a)
parBuildThresh Int
threshold InclusiveRange
range Int -> a
fn =
Int
-> InclusiveRange
-> (Int -> p (AList a))
-> (AList a -> AList a -> p (AList a))
-> AList a
-> p (AList a)
forall a (iv :: * -> *) (p :: * -> *).
(NFData a, ParFuture iv p) =>
Int
-> InclusiveRange -> (Int -> p a) -> (a -> a -> p a) -> a -> p a
C.parMapReduceRangeThresh Int
threshold InclusiveRange
range
(AList a -> p (AList a)
forall a. a -> p a
forall (m :: * -> *) a. Monad m => a -> m a
return (AList a -> p (AList a)) -> (Int -> AList a) -> Int -> p (AList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AList a
forall a. a -> AList a
singleton (a -> AList a) -> (Int -> a) -> Int -> AList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
fn) AList a -> AList a -> p (AList a)
forall (f :: * -> *) (p :: * -> *) a.
ParFuture f p =>
AList a -> AList a -> p (AList a)
appendM AList a
forall a. AList a
empty
parBuildThreshM :: (NFData a, ParFuture f p) => Int -> C.InclusiveRange -> (Int -> p a) -> p (AList a)
parBuildThreshM :: forall a (f :: * -> *) (p :: * -> *).
(NFData a, ParFuture f p) =>
Int -> InclusiveRange -> (Int -> p a) -> p (AList a)
parBuildThreshM Int
threshold InclusiveRange
range Int -> p a
fn =
Int
-> InclusiveRange
-> (Int -> p (AList a))
-> (AList a -> AList a -> p (AList a))
-> AList a
-> p (AList a)
forall a (iv :: * -> *) (p :: * -> *).
(NFData a, ParFuture iv p) =>
Int
-> InclusiveRange -> (Int -> p a) -> (a -> a -> p a) -> a -> p a
C.parMapReduceRangeThresh Int
threshold InclusiveRange
range
(\Int
x -> Int -> p a
fn Int
x p a -> (a -> p (AList a)) -> p (AList a)
forall a b. p a -> (a -> p b) -> p b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AList a -> p (AList a)
forall a. a -> p a
forall (m :: * -> *) a. Monad m => a -> m a
return (AList a -> p (AList a)) -> (a -> AList a) -> a -> p (AList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AList a
forall a. a -> AList a
singleton) AList a -> AList a -> p (AList a)
forall (f :: * -> *) (p :: * -> *) a.
ParFuture f p =>
AList a -> AList a -> p (AList a)
appendM AList a
forall a. AList a
empty
parBuild :: (NFData a, ParFuture f p) => C.InclusiveRange -> (Int -> a) -> p (AList a)
parBuild :: forall a (f :: * -> *) (p :: * -> *).
(NFData a, ParFuture f p) =>
InclusiveRange -> (Int -> a) -> p (AList a)
parBuild InclusiveRange
range Int -> a
fn =
InclusiveRange
-> (Int -> p (AList a))
-> (AList a -> AList a -> p (AList a))
-> AList a
-> p (AList a)
forall a (iv :: * -> *) (p :: * -> *).
(NFData a, ParFuture iv p) =>
InclusiveRange -> (Int -> p a) -> (a -> a -> p a) -> a -> p a
C.parMapReduceRange InclusiveRange
range (AList a -> p (AList a)
forall a. a -> p a
forall (m :: * -> *) a. Monad m => a -> m a
return (AList a -> p (AList a)) -> (Int -> AList a) -> Int -> p (AList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AList a
forall a. a -> AList a
singleton (a -> AList a) -> (Int -> a) -> Int -> AList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
fn) AList a -> AList a -> p (AList a)
forall (f :: * -> *) (p :: * -> *) a.
ParFuture f p =>
AList a -> AList a -> p (AList a)
appendM AList a
forall a. AList a
empty
parBuildM :: (NFData a, ParFuture f p) => C.InclusiveRange -> (Int -> p a) -> p (AList a)
parBuildM :: forall a (f :: * -> *) (p :: * -> *).
(NFData a, ParFuture f p) =>
InclusiveRange -> (Int -> p a) -> p (AList a)
parBuildM InclusiveRange
range Int -> p a
fn =
InclusiveRange
-> (Int -> p (AList a))
-> (AList a -> AList a -> p (AList a))
-> AList a
-> p (AList a)
forall a (iv :: * -> *) (p :: * -> *).
(NFData a, ParFuture iv p) =>
InclusiveRange -> (Int -> p a) -> (a -> a -> p a) -> a -> p a
C.parMapReduceRange InclusiveRange
range (\Int
x -> Int -> p a
fn Int
x p a -> (a -> p (AList a)) -> p (AList a)
forall a b. p a -> (a -> p b) -> p b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AList a -> p (AList a)
forall a. a -> p a
forall (m :: * -> *) a. Monad m => a -> m a
return (AList a -> p (AList a)) -> (a -> AList a) -> a -> p (AList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> AList a
forall a. a -> AList a
singleton) AList a -> AList a -> p (AList a)
forall (f :: * -> *) (p :: * -> *) a.
ParFuture f p =>
AList a -> AList a -> p (AList a)
appendM AList a
forall a. AList a
empty
instance Eq a => Eq (AList a) where
AList a
a == :: AList a -> AList a -> Bool
== AList a
b = AList a -> [a]
forall a. AList a -> [a]
toList AList a
a [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== AList a -> [a]
forall a. AList a -> [a]
toList AList a
b
appendM :: ParFuture f p => AList a -> AList a -> p (AList a)
appendM :: forall (f :: * -> *) (p :: * -> *) a.
ParFuture f p =>
AList a -> AList a -> p (AList a)
appendM AList a
x AList a
y = AList a -> p (AList a)
forall a. a -> p a
forall (m :: * -> *) a. Monad m => a -> m a
return (AList a -> AList a -> AList a
forall a. AList a -> AList a -> AList a
append AList a
x AList a
y)