diff --git a/copar.cabal b/copar.cabal
index 11832c0949832f6c55b6f16ffe57ff4a857a81af..27879e008a1a673c7e4f62942cff2b0c50db2872 100644
--- a/copar.cabal
+++ b/copar.cabal
@@ -64,6 +64,7 @@ library
, Copar.Dot
, Copar.PrettyShow
, Copar.RewriteFunctors
+ , Copar.Timing
default-extensions: GADTs
, StandaloneDeriving
, DeriveFunctor
@@ -96,6 +97,7 @@ library
, deriving-compat
, ieee754 >= 0.8.0 && <0.9
, vector-th-unbox >= 0.2 && <0.3
+ , scientific >= 0.3.6 && < 0.4
ghc-options: -Wall -Wno-name-shadowing
if flag(release)
cpp-options: -DRELEASE
@@ -113,7 +115,7 @@ executable copar
, deepseq
, optparse-applicative
, json
- , scientific
+ , scientific >= 0.3.6 && < 0.4
, prettyprinter
, prettyprinter-ansi-terminal
, prettyprinter-convert-ansi-wl-pprint
diff --git a/src/Copar/Algorithm.hs b/src/Copar/Algorithm.hs
index 8619356d60db53d4de1794cf223cb2de0bf0408d..1b794bac34256c44f4910d0214007160b077b073 100644
--- a/src/Copar/Algorithm.hs
+++ b/src/Copar/Algorithm.hs
@@ -7,8 +7,6 @@ module Copar.Algorithm
import Control.Monad.ST
import Data.STRef
import Data.Proxy
-import Data.Bifunctor (second)
-import Data.Maybe (fromJust)
import Control.Monad.Extra (whileM)
import Control.Monad.Reader
@@ -23,11 +21,16 @@ import Copar.Coalgebra.RefinementTypes
import Copar.Algorithm.Types
import Copar.Algorithm.Initialize
import Copar.Algorithm.Split
+import Copar.Timing
-- | Metrics about the algorithm's execution.
data AlgoStatistics = AlgoStatistics
{ initialBlocks :: Int -- ^ Size of the initial partition
, splitCount :: Int -- ^ Overall count of 'split' operations
+ , initTime :: Integer -- ^ Time in picoseconds spend in the initialize
+ -- procedure
+ , refineTime :: Integer -- ^ Time in picoseconds spend in the rest of the
+ -- algorithm (calling split until the queue is empty)
}
-- | Returns the count of 'split' calls
@@ -47,37 +50,34 @@ refine :: forall f s.
=> Proxy f
-> Encoding (Label f) (F1 f)
-> ST s Partition
-refine Proxy = fmap fst . refineImpl False (Proxy @f)
+refine Proxy encoding = do
+ queue <- Queue.empty (size encoding)
+ (blocks, state) <- initialize @f encoding
+ mapM_ (Queue.enqueue queue) blocks
+
+ _ <- processQueue queue state
+
+ Partition.freeze (partition state)
+
-- | Seme as 'refine', but also reports some statistics about the algorithm's
-- execution.
-refineWithStats :: forall f s.
- RefinementInterface f
+refineWithStats
+ :: forall f
+ . RefinementInterface f
=> Proxy f
-> Encoding (Label f) (F1 f)
- -> ST s (Partition, AlgoStatistics)
-refineWithStats Proxy =
- fmap (second fromJust) . refineImpl True (Proxy @f)
-
-refineImpl :: forall f s.
- RefinementInterface f
- => Bool
- -> Proxy f
- -> Encoding (Label f) (F1 f)
- -> ST s (Partition, Maybe AlgoStatistics)
-refineImpl collectStats Proxy encoding = do
- queue <- Queue.empty (size encoding)
- (blocks, state) <- initialize @f encoding
- mapM_ (Queue.enqueue queue) blocks
+ -> IO (Partition, AlgoStatistics)
+refineWithStats Proxy encoding = do
+ queue <- stToIO $ Queue.empty (size encoding)
+ (initTime, (blocks, state)) <- withTime (stToIO $ initialize @f encoding)
+ mapM_ (stToIO . Queue.enqueue queue) blocks
let initialBlocks = length blocks
- splitCount <- processQueue queue state
+ (refineTime, splitCount) <- withTime (stToIO $ processQueue queue state)
- part <- Partition.freeze (partition state)
+ part <- stToIO $ Partition.freeze (partition state)
- let stats =
- if collectStats
- then Just (AlgoStatistics initialBlocks splitCount)
- else Nothing
+ let stats = (AlgoStatistics initialBlocks splitCount initTime refineTime)
return (part, stats)
diff --git a/src/Copar/Timing.hs b/src/Copar/Timing.hs
new file mode 100644
index 0000000000000000000000000000000000000000..1bf33a8d247ad499f2ed41ffc561e9a725acb8c0
--- /dev/null
+++ b/src/Copar/Timing.hs
@@ -0,0 +1,21 @@
+module Copar.Timing (withTime, showTimeDiff) where
+
+import System.CPUTime
+
+import Data.Text ( Text )
+import qualified Data.Text as T
+import Data.Scientific
+
+-- | Run an IO action and return its result together with its execution time in
+-- picoseconds.
+withTime :: IO a -> IO (Integer, a)
+withTime action = do
+ time1 <- getCPUTime
+ res <- action
+ time2 <- getCPUTime
+ return (time2 - time1, res)
+
+-- | Return the time as seconds
+showTimeDiff :: Integer -> Text
+showTimeDiff picoseconds =
+ T.pack (formatScientific Fixed (Just 10) (scientific picoseconds (-12)))
diff --git a/src/main/Main.hs b/src/main/Main.hs
index 4ced26b932be10bdcf2f776604763357b40b4a1e..7a6c55ad35d21e43fe0161c0508ec880b7f0f13b 100644
--- a/src/main/Main.hs
+++ b/src/main/Main.hs
@@ -48,6 +48,7 @@ import Copar.Functors.SomeFunctor (SomeFunctor)
import Copar.FunctorExpression.Type (FunctorExpression)
import Copar.Dot
import Copar.RewriteFunctors
+import Copar.Timing
----------------------------------------------------------------------
-- CLI Options
@@ -338,8 +339,8 @@ main = do
(RefineCommand r) -> do
stats <- initStats (refineStats r) (refineStatsJson r)
- withTime stats "overall-duration" $ do
- (f, (symbolTable, encoding)) <- withTime stats "parse-duration" $ do
+ withTimeStat stats "overall-duration" $ do
+ (f, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
let transPolicy = if (refineApplyTransformations r)
then ApplyTransformations
@@ -359,18 +360,22 @@ main = do
(tshow (length (V.filter isFirstSort (Encoding.structure encoding))))
partition <- case statsType stats of
- NoStats -> withTime stats "refine-duration" (stToIO (refine f encoding))
+ NoStats -> withTimeStat stats "algorithm-duration" (stToIO (refine f encoding))
_ -> do
- (part, algoStats) <- withTime stats "refine-duration" $
- (stToIO (refineWithStats f encoding))
+ (part, algoStats) <- withTimeStat stats "algorithm-duration" $
+ (refineWithStats f encoding)
logStat
stats
"initial-partition-size"
(tshow (initialBlocks algoStats))
+ logStat stats "initialize-duration"
+ (showTimeDiff (initTime algoStats))
logStat
stats
"split-operation-count"
(tshow (splitCount algoStats))
+ logStat stats "refine-duration"
+ (showTimeDiff (refineTime algoStats))
return part
logStat
@@ -383,7 +388,7 @@ main = do
"explicit-final-partition-size"
(tshow (length (restrictPartitionToSort1 encoding partition)))
- withTime stats "output-duration"
+ withTimeStat stats "output-duration"
(outputPartition (refineOutputFile r) encoding symbolTable partition)
finalizeStats stats
@@ -434,21 +439,13 @@ tabularize table = do
T.putStr "\n"
-withTime :: Stats -> Text -> IO a -> IO a
-withTime stats name action = case statsType stats of
+withTimeStat :: Stats -> Text -> IO a -> IO a
+withTimeStat stats name action = case statsType stats of
NoStats -> action
_ -> do
- time1 <- getCPUTime
- res <- action
- time2 <- getCPUTime
-
- logStat stats name (showTimeDiff (time2 - time1))
-
+ (duration, res) <- withTime action
+ logStat stats name (showTimeDiff duration)
return res
--- | Output the time as seconds
-showTimeDiff :: Integer -> Text
-showTimeDiff picoseconds = T.pack (formatScientific Fixed (Just 10) (scientific picoseconds (-12)))
-
tshow :: Show a => a -> Text
tshow = T.pack . show