module Control.LVish.Logical (asyncAnd, asyncOr, andMap, orMap) where
import Control.LVish.Basics
import Control.LVish.Internal (Par(WrapPar), unsafeDet)
import Control.LVish.SchedIdempotent (liftIO, HandlerPool)
import Data.LVar.IVar as IV
import qualified Data.Atomics.Counter as C
asyncAnd :: Maybe HandlerPool -> (Par d s Bool) -> (Par d s Bool) -> (Bool -> Par d s ()) -> Par d s ()
asyncAnd hp leftM rightM kont = do
cnt <- io$ C.newCounter 0
let launch m = forkHP hp $
do b <- m
case b of
True -> do n <- io$ C.incrCounter 1 cnt
if n==2
then kont True
else return ()
False ->
do n <- io$ C.incrCounter 100 cnt
if n < 200
then kont False
else return ()
launch leftM
launch rightM
return ()
asyncOr :: Maybe HandlerPool -> (Par d s Bool) -> (Par d s Bool) -> (Bool -> Par d s ()) -> Par d s ()
asyncOr hp leftM rightM kont = do
cnt <- io$ C.newCounter 0
let launch m = forkHP hp $
do b <- m
case b of
False -> do n <- io$ C.incrCounter 1 cnt
if n==2
then kont False
else return ()
True ->
do n <- io$ C.incrCounter 100 cnt
if n < 200
then kont True
else return ()
launch leftM
launch rightM
return ()
andMap :: Maybe HandlerPool -> (a -> Par d s Bool) -> [a] -> Par d s Bool
andMap = makeMapper asyncAnd
orMap :: Maybe HandlerPool -> (a -> Par d s Bool) -> [a] -> Par d s Bool
orMap = makeMapper asyncOr
makeMapper :: (Maybe HandlerPool -> (Par d s Bool) -> (Par d s Bool) -> (Bool -> Par d s ()) -> Par d s ()) ->
Maybe HandlerPool -> (a -> Par d s Bool) -> [a] -> Par d s Bool
makeMapper asyncOp hp fn ls = aloop ls
where
aloop [] = return True
aloop [x] = fn x
aloop ls2 = do let (x,y) = fastChop ls2
tmp <- IV.new
asyncOp hp (aloop x) (aloop y) (IV.put tmp)
IV.get tmp
fastChop :: [a] -> ([a],[a])
fastChop ls = loop [] ls ls
where
loop !acc !rst1 !rst2 =
case rst2 of
[] -> (acc,rst1)
[_] -> (acc,rst1)
_:_:rst2' -> let (hd:rst1') = rst1 in
loop (hd:acc) rst1' rst2'
io :: IO a -> Par d s a
io = WrapPar . liftIO