Commit 17eafbd9 authored by Bastian Holst's avatar Bastian Holst
Browse files

Add various strategies using a bag-of-tasks

This commit adds various new strategies using a bag-of-tasks
approach. The strategies resemble breadth-first search and
depth-first-search and are parametrized with strategies to
split the work-queues/stacks.
parent 1977541b
{-# LANGUAGE Rank2Types #-}
import Control.Monad.SearchTree
import Control.Monad
import MonadSearch
import MonadList
import Strategies
import Control.Parallel.Strategies
import Control.Concurrent.Bag.Safe (SplitFunction, TaskBufferSTM (..), takeFirst)
import qualified Curry_Prelude as CP
external_d_C_getAllValues :: NormalForm a =>
......@@ -12,14 +14,15 @@ external_d_C_getAllValues :: NormalForm a =>
-> Cover
-> ConstStore
-> CP.C_IO (CP.OP_List a)
external_d_C_getAllValues sy x c s = fromIO $ do
external_d_C_getAllValues (Strategy sy) x c s = fromIO $ do
let tree = encapsulatedSearch x c s
list <- getStrategy sy tree
list <- sy tree
hlist <- evalIOList list
return $ hlist2clist hlist
where
hlist2clist [] = CP.OP_List
hlist2clist (x:xs) = CP.OP_Cons x $ hlist2clist xs
external_d_C_getAllValues (Functions _ allValues) x c s = fromIO $ do
let tree = encapsulatedSearch x c s
list <- allValues tree
return $ hlist2clist list
external_d_C_getOneValue :: NormalForm a =>
C_Strategy a
......@@ -27,16 +30,24 @@ external_d_C_getOneValue :: NormalForm a =>
-> Cover
-> ConstStore
-> CP.C_IO (CP.C_Maybe a)
external_d_C_getOneValue sy x c s = fromIO $ do
external_d_C_getOneValue (Strategy sy) x c s = fromIO $ do
let tree = encapsulatedSearch x c s
list <- getStrategy sy tree
list <- sy tree
liftM hmaybe2cmaybe $ listIOToMaybe list
where
hmaybe2cmaybe Nothing = CP.C_Nothing
hmaybe2cmaybe (Just a) = CP.C_Just a
external_d_C_getOneValue (Functions oneValue _) x c s = fromIO $ do
let tree = encapsulatedSearch x c s
mb <- oneValue tree
return $ hmaybe2cmaybe mb
hmaybe2cmaybe Nothing = CP.C_Nothing
hmaybe2cmaybe (Just a) = CP.C_Just a
hlist2clist [] = CP.OP_List
hlist2clist (x:xs) = CP.OP_Cons x $ hlist2clist xs
data C_Strategy a
= Strategy { getStrategy :: SearchTree a -> IO (IOList a) }
= Strategy { getStrategy :: SearchTree a -> IO (IOList a) }
| Functions { getOneValue :: SearchTree a -> IO (Maybe a), getAllValues :: SearchTree a -> IO [a] }
external_d_C_parSearch :: Cover -> ConstStore -> C_Strategy a
external_d_C_parSearch _ _ = Strategy (fromList . parSearch)
......@@ -61,3 +72,27 @@ external_d_C_splitPower _ _ = Strategy $ fromList . splitPower
external_d_C_bfsParallel :: Cover -> ConstStore -> C_Strategy a
external_d_C_bfsParallel _ _ = Strategy $ fromList . bfsParallel
data C_SplitStrategy a
= SplitStrategy { getSplit :: TaskBufferSTM b => Maybe (SplitFunction b a) }
external_d_C_dfsBag :: C_SplitStrategy a -> Cover -> ConstStore -> C_Strategy a
external_d_C_dfsBag split _ _ = let s = flip $ dfsBag $ getSplit split in Functions (s getResult) (s getAllResults)
external_d_C_fdfsBag :: C_SplitStrategy a -> Cover -> ConstStore -> C_Strategy a
external_d_C_fdfsBag split _ _ = let s = flip $ fdfsBag $ getSplit split in Functions (s getResult) (s getAllResults)
external_d_C_bfsBag :: C_SplitStrategy a -> Cover -> ConstStore -> C_Strategy a
external_d_C_bfsBag split _ _ = let s = flip $ bfsBag $ getSplit split in Functions (s getResult) (s getAllResults)
external_d_C_commonBuffer :: Cover -> ConstStore -> C_SplitStrategy a
external_d_C_commonBuffer _ _ = SplitStrategy Nothing
external_d_C_takeFirst :: Cover -> ConstStore -> C_SplitStrategy a
external_d_C_takeFirst _ _ = SplitStrategy $ Just takeFirst
external_d_C_splitVertical :: Cover -> ConstStore -> C_SplitStrategy a
external_d_C_splitVertical _ _ = SplitStrategy $ Just splitVertical
external_d_C_splitHalf :: Cover -> ConstStore -> C_SplitStrategy a
external_d_C_splitHalf _ _ = SplitStrategy $ Just splitHalf
......@@ -22,6 +22,13 @@ module ParallelSearch
, splitAlternating
, splitPower
, bfsParallel
, dfsBag
, fdfsBag
, bfsBag
, takeFirst
, splitVertical
, splitHalf
, commonBuffer
) where
--- Gets all values of an expression using the given Strategy.
......@@ -68,3 +75,26 @@ splitPower external
--- compared to the sequencial breadth first search.
bfsParallel :: Strategy a
bfsParallel external
data SplitStrategy _ -- internally defined
dfsBag :: SplitStrategy a -> Strategy a
dfsBag external
fdfsBag :: SplitStrategy a -> Strategy a
fdfsBag external
bfsBag :: SplitStrategy a -> Strategy a
bfsBag external
commonBuffer :: SplitStrategy a
commonBuffer external
takeFirst :: SplitStrategy a
takeFirst external
splitVertical :: SplitStrategy a
splitVertical external
splitHalf :: SplitStrategy a
splitHalf external
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment