LogicGrowsOnTrees-processes 1.0.0.0.1 → 1.0.0.1
raw patch · 4 files changed
+123/−23 lines, 4 filesdep +criteriondep ~LogicGrowsOnTreesdep ~cerealnew-component:exe:count-all-trivial-tree-leaves
Dependencies added: criterion
Dependency ranges changed: LogicGrowsOnTrees, cereal
Files
- LogicGrowsOnTrees-processes.cabal +38/−8
- benchmarks/benchmark.hs +47/−0
- examples/count-all-trivial-tree-leaves.hs +24/−0
- sources/LogicGrowsOnTrees/Parallel/Adapter/Processes.hs +14/−15
LogicGrowsOnTrees-processes.cabal view
@@ -1,5 +1,5 @@ Name: LogicGrowsOnTrees-processes-Version: 1.0.0.0.1+Version: 1.0.0.1 License: BSD3 License-file: LICENSE Author: Gregory Crosswhite@@ -22,15 +22,15 @@ Source-Repository this Type: git Location: git://github.com/gcross/LogicGrowsOnTrees-processes.git- Tag: 1.0.0.0.1+ Tag: 1.0.0.1 Library Build-depends:- LogicGrowsOnTrees == 1.0.*,+ LogicGrowsOnTrees >= 1.0 && < 1.2, base > 4 && < 5, bytestring >= 0.9 && < 0.11,- cereal == 0.3.*,+ cereal >= 0.3 && < 0.5, cmdtheline == 0.2.*, containers >= 0.4 && < 0.6, filepath == 1.3.*,@@ -65,9 +65,9 @@ Hs-source-dirs: examples Build-depends: LogicGrowsOnTrees-processes,- LogicGrowsOnTrees == 1.0.*,+ LogicGrowsOnTrees >= 1.0 && < 1.2, base > 4 && < 5,- cereal == 0.3.*,+ cereal >= 0.3 && < 0.5, cmdtheline == 0.2.* if flag(examples) Buildable: True@@ -78,15 +78,45 @@ if flag(pattern-warnings) GHC-Options: -fwarn-incomplete-patterns +Executable count-all-trivial-tree-leaves+ Main-is: count-all-trivial-tree-leaves.hs+ Hs-source-dirs: examples+ Build-depends:+ LogicGrowsOnTrees-processes,+ LogicGrowsOnTrees >= 1.0 && < 1.2,+ base > 4 && < 5,+ cereal >= 0.3 && < 0.5,+ cmdtheline == 0.2.*+ if flag(examples)+ Buildable: True+ else+ Buildable: False+ if flag(warnings)+ GHC-Options: -Wall -fno-warn-name-shadowing+ if flag(pattern-warnings)+ GHC-Options: -fwarn-incomplete-patterns++Benchmark benchmark+ Type: exitcode-stdio-1.0+ Main-is: benchmark.hs+ Hs-source-dirs: benchmarks+ Build-depends:+ LogicGrowsOnTrees-processes,+ LogicGrowsOnTrees >= 1.0 && < 1.2,+ base > 4 && < 5,+ criterion >= 0.6 && < 0.9+ if flag(warnings)+ GHC-Options: -Wall -fno-warn-name-shadowing+ Test-Suite tests Type: exitcode-stdio-1.0 Main-is: tests.hs Hs-source-dirs: tests Build-depends: LogicGrowsOnTrees-processes,- LogicGrowsOnTrees == 1.0.*,+ LogicGrowsOnTrees >= 1.0 && < 1.2, base > 4 && < 5,- cereal == 0.3.*,+ cereal >= 0.3 && < 0.5, hslogger == 1.2.*, hslogger-template == 2.0.*, HUnit == 1.2.*,
+ benchmarks/benchmark.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE UnicodeSyntax #-}++import Criterion.Main+import Data.Monoid+import System.Environment++import LogicGrowsOnTrees+import LogicGrowsOnTrees.Checkpoint+import LogicGrowsOnTrees.Utils.PerfectTree+import LogicGrowsOnTrees.Utils.WordSum+import qualified LogicGrowsOnTrees.Parallel.Adapter.Processes as Processes+import qualified LogicGrowsOnTrees.Parallel.Adapter.Threads as Threads+import LogicGrowsOnTrees.Parallel.Adapter.Threads (setNumberOfWorkers)+import LogicGrowsOnTrees.Parallel.Common.Worker (exploreTreeGeneric)+import LogicGrowsOnTrees.Parallel.ExplorationMode (ExplorationMode(AllMode))+import LogicGrowsOnTrees.Parallel.Main+import LogicGrowsOnTrees.Parallel.Purity (Purity(Pure))++main = defaultMain+ [bench "list" $ nf (getWordSum . mconcat . trivialPerfectTree 2) depth+ ,bench "tree" $ nf (getWordSum . exploreTree . trivialPerfectTree 2) depth+ ,bench "tree w/ checkpointing" $ nf (getWordSum . exploreTreeStartingFromCheckpoint Unexplored . trivialPerfectTree 2) depth+ ,bench "tree using worker" $ exploreTreeGeneric AllMode Pure (trivialPerfectTree 2 depth)+ ,bench "tree using single thread (direct)" $ Threads.exploreTree (setNumberOfWorkers 1) (trivialPerfectTree 2 depth)+ ,bench "tree using single thread (main)" $+ withArgs ["-n1"] $+ simpleMainForExploreTree+ Threads.driver+ (const $ return ())+ (trivialPerfectTree 2 depth)+ ,bench "tree using single process (direct)" $+ Processes.runExplorer+ (const AllMode)+ Pure+ (return ((),()))+ (const $ return ())+ (const $ trivialPerfectTree 2 depth)+ (\_ _ → return mempty)+ (\_ _ → setNumberOfWorkers 1)+ ,bench "tree using single process (main)" $+ withArgs ["-n1"] $+ simpleMainForExploreTree+ Processes.driver+ (const $ return ())+ (trivialPerfectTree 2 depth)+ ]+ where depth = 15
+ examples/count-all-trivial-tree-leaves.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UnicodeSyntax #-}++import Control.Applicative++import System.Console.CmdTheLine++import LogicGrowsOnTrees.Parallel.Main+import LogicGrowsOnTrees.Parallel.Adapter.Processes+import LogicGrowsOnTrees.Utils.PerfectTree+import LogicGrowsOnTrees.Utils.WordSum++main =+ mainForExploreTree+ driver+ (makeArityAndDepthTermAtPositions 0 1)+ (defTI { termDoc = "count the leaves of a tree" })+ (\_ (RunOutcome _ termination_reason) → do+ case termination_reason of+ Aborted _ → error "search aborted"+ Completed (WordSum count) → print count+ Failure _ message → error $ "error: " ++ message+ )+ (trivialPerfectTree <$> arity <*> depth)
sources/LogicGrowsOnTrees/Parallel/Adapter/Processes.hs view
@@ -23,6 +23,8 @@ , fork , getCurrentProgressAsync , getCurrentProgress+ , getCurrentStatisticsAsync+ , getCurrentStatistics , getNumberOfWorkersAsync , getNumberOfWorkers , requestProgressUpdateAsync@@ -31,7 +33,7 @@ , setNumberOfWorkers , setWorkloadBufferSize -- * Outcome types- , RunOutcome(..)+ , RunOutcome , RunStatistics(..) , TerminationReason(..) -- * Generic runner functions@@ -48,18 +50,17 @@ import Control.Applicative ((<$>),(<*>),Applicative,liftA2) import Control.Arrow (second)-import Control.Concurrent (ThreadId,forkIO,getNumCapabilities,killThread)+import Control.Concurrent (forkIO) import Control.Exception (AsyncException(ThreadKilled,UserInterrupt),SomeException,catch,catchJust,fromException)-import Control.Monad (forever,liftM2,unless,void)+import Control.Monad (forever,liftM2) import Control.Monad.CatchIO (MonadCatchIO) import Control.Monad.IO.Class (MonadIO,liftIO) import Control.Monad.Trans.State.Strict (get,modify) import qualified Data.Foldable as Fold-import Data.Function (fix) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap-import Data.Maybe (fromJust,fromMaybe)+import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(mempty)) import Data.Serialize (Serialize) @@ -70,17 +71,14 @@ import System.IO (Handle,hGetLine,stdin,stdout) import System.IO.Error (isEOFError) import qualified System.Log.Logger as Logger-import System.Log.Logger (Priority(DEBUG,INFO,ERROR))+import System.Log.Logger (Priority(DEBUG,ERROR)) import System.Log.Logger.TH import System.Process (CreateProcess(..),CmdSpec(RawCommand),StdStream(..),ProcessHandle,createProcess,interruptProcessGroupOf) -import LogicGrowsOnTrees (Tree,TreeIO,TreeT)-import LogicGrowsOnTrees.Checkpoint+import LogicGrowsOnTrees (TreeT) import LogicGrowsOnTrees.Parallel.Common.Message-import qualified LogicGrowsOnTrees.Parallel.Common.Process as Process-import LogicGrowsOnTrees.Parallel.Common.Process+import LogicGrowsOnTrees.Parallel.Common.Process (runWorker,runWorkerUsingHandles) import LogicGrowsOnTrees.Parallel.Common.RequestQueue-import LogicGrowsOnTrees.Parallel.Common.Worker import LogicGrowsOnTrees.Parallel.Common.Workgroup hiding (C,unwrapC) import LogicGrowsOnTrees.Parallel.ExplorationMode import LogicGrowsOnTrees.Parallel.Main@@ -95,13 +93,12 @@ import LogicGrowsOnTrees.Parallel.Purity import LogicGrowsOnTrees.Utils.Handle import LogicGrowsOnTrees.Utils.Word_-import LogicGrowsOnTrees.Workload -------------------------------------------------------------------------------- ----------------------------------- Loggers ------------------------------------ -------------------------------------------------------------------------------- -deriveLoggers "Logger" [DEBUG,INFO,ERROR]+deriveLoggers "Logger" [DEBUG,ERROR] -------------------------------------------------------------------------------- ------------------------------------ Driver ------------------------------------@@ -142,6 +139,7 @@ , optDoc = "This *required* option specifies the number of worker processes to spawn." } ) Nothing )+{-# INLINE driver #-} -------------------------------------------------------------------------------- ---------------------------------- Controller ----------------------------------@@ -197,7 +195,6 @@ starting_progress (C controller) = do- request_queue ← newRequestQueue runWorkgroup exploration_mode mempty@@ -238,7 +235,7 @@ sendConfigurationTo write_handle modify . IntMap.insert worker_id $ Worker{..} - destroyWorker worker_id worker_is_active = do+ destroyWorker worker_id _ = do debugM $ "Sending QuitWorker to " ++ show worker_id ++ "..." get >>= liftIO@@ -277,6 +274,7 @@ ) starting_progress controller+{-# INLINE runSupervisor #-} {-| Explores the given tree using multiple processes to achieve parallelism. @@ -366,6 +364,7 @@ return $ Just (configuration,termination_result) where sentinel = ["explorer","worker","bee"]+{-# INLINE runExplorer #-} -------------------------------------------------------------------------------- ------------------------------- Utility funtions -------------------------------