Commit 139877fb authored by Bastian Kauschke's avatar Bastian Kauschke
Browse files

refactor Main.hs

parent e38e705e
...@@ -27,6 +27,7 @@ import Options.Applicative ...@@ -27,6 +27,7 @@ import Options.Applicative
import Copar.Algorithm import Copar.Algorithm
import qualified Copar.Parser as P import qualified Copar.Parser as P
import Copar.Coalgebra.Parser (SymbolTable)
import Copar.PartitionPrinter import Copar.PartitionPrinter
import Copar.FunctorPrinter import Copar.FunctorPrinter
import Copar.Functors import Copar.Functors
...@@ -448,52 +449,11 @@ main = do ...@@ -448,52 +449,11 @@ main = do
stats <- initStats (refineStats r) (refineStatsJson r) stats <- initStats (refineStats r) (refineStatsJson r)
withTimeStat stats "overall-duration" $ do withTimeStat stats "overall-duration" $ do
(_, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do (_f, symbolTable, encoding, partition) <-
readCoalgebra (refineParseConfig r) (refineInputFile r) refinementStep stats
>>= \case (refineInputFile r)
Left err -> hPutStrLn stderr err >> exitFailure (refineParseConfig r)
Right res -> evaluate res (refineEnableOpt r)
logStat stats "states" (tshow (Encoding.size encoding))
logStat stats "edges" (tshow (Encoding.numEdges encoding))
let isFirstSort x = sortedSort x == 1
logStat
stats
"explicit-states"
(tshow (length (V.filter isFirstSort (Encoding.structure encoding))))
partition <- case statsType stats of
NoStats ->
withTimeStat stats "algorithm-duration" (
stToIO (refine (Proxy :: Proxy (Desorted SomeFunctor)) encoding (refineEnableOpt r))
)
_ -> do
(part, algoStats) <-
withTimeStat stats "algorithm-duration"
$ refineWithStats (Proxy :: Proxy (Desorted SomeFunctor)) encoding (refineEnableOpt r)
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))
logStat stats
"size1-skipped"
(tshow (size1Skipped algoStats))
return part
logStat stats
"final-partition-size"
(tshow (Partition.numBlocks partition))
logStat stats
"explicit-final-partition-size"
(tshow (length (restrictPartitionToSort1 encoding partition)))
withTimeStat withTimeStat
stats stats
...@@ -506,52 +466,11 @@ main = do ...@@ -506,52 +466,11 @@ main = do
stats <- initStats (minimizeStats r) (minimizeStatsJson r) stats <- initStats (minimizeStats r) (minimizeStatsJson r)
withTimeStat stats "overall-duration" $ do withTimeStat stats "overall-duration" $ do
(f, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do (f, symbolTable, encoding, part) <-
readCoalgebra (minimizeParseConfig r) (minimizeInputFile r) refinementStep stats
>>= \case (minimizeInputFile r)
Left err -> hPutStrLn stderr err >> exitFailure (minimizeParseConfig r)
Right res -> evaluate res (minimizeEnableOpt r)
logStat stats "states" (tshow (Encoding.size encoding))
logStat stats "edges" (tshow (Encoding.numEdges encoding))
let isFirstSort x = sortedSort x == 1
logStat
stats
"explicit-states"
(tshow (length (V.filter isFirstSort (Encoding.structure encoding))))
part <- case statsType stats of
NoStats ->
withTimeStat stats "algorithm-duration" (
stToIO (refine (Proxy :: Proxy (Desorted SomeFunctor)) encoding (minimizeEnableOpt r))
)
_ -> do
(part, algoStats) <-
withTimeStat stats "algorithm-duration"
$ refineWithStats (Proxy :: Proxy (Desorted SomeFunctor)) encoding (minimizeEnableOpt r)
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))
logStat stats
"size1-skipped"
(tshow (size1Skipped algoStats))
return part
logStat stats
"final-partition-size"
(tshow (Partition.numBlocks part))
logStat stats
"explicit-final-partition-size"
(tshow (length (restrictPartitionToSort1 encoding part)))
(encoding', symbolTable') <- withTimeStat stats "minimize-duration" $ (encoding', symbolTable') <- withTimeStat stats "minimize-duration" $
evaluate (minimize f encoding symbolTable part) evaluate (minimize f encoding symbolTable part)
...@@ -661,6 +580,62 @@ helpOverview argv0 = ...@@ -661,6 +580,62 @@ helpOverview argv0 =
paragraph = line <> line paragraph = line <> line
noflow x = softline <> x <> softline noflow x = softline <> x <> softline
refinementStep :: Stats -> Maybe FilePath -> P.Config -> Bool
-> IO ( FunctorExpression SomeFunctor Sort
, SymbolTable
, Encoding.Encoding _ _
, Partition.Partition
)
refinementStep stats inputFile parseConfig enableOpt = do
(f, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
readCoalgebra (parseConfig) (inputFile)
>>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate res
logStat stats "states" (tshow (Encoding.size encoding))
logStat stats "edges" (tshow (Encoding.numEdges encoding))
let isFirstSort x = sortedSort x == 1
logStat
stats
"explicit-states"
(tshow (length (V.filter isFirstSort (Encoding.structure encoding))))
part <- case statsType stats of
NoStats ->
withTimeStat stats "algorithm-duration" (
stToIO (refine (Proxy :: Proxy (Desorted SomeFunctor)) encoding enableOpt)
)
_ -> do
(part, algoStats) <-
withTimeStat stats "algorithm-duration"
$ refineWithStats (Proxy :: Proxy (Desorted SomeFunctor)) encoding enableOpt
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))
logStat stats
"size1-skipped"
(tshow (size1Skipped algoStats))
return part
logStat stats
"final-partition-size"
(tshow (Partition.numBlocks part))
logStat stats
"explicit-final-partition-size"
(tshow (length (restrictPartitionToSort1 encoding part)))
return (f, symbolTable, encoding, part)
printHelp :: Text -> Maybe HelpCommand -> IO () printHelp :: Text -> Maybe HelpCommand -> IO ()
printHelp argv0 Nothing = putDoc (helpOverview argv0) >> putStrLn "" printHelp argv0 Nothing = putDoc (helpOverview argv0) >> putStrLn ""
printHelp _ (Just HelpListFunctors) = printHelp _ (Just HelpListFunctors) =
......
Supports Markdown
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