Commit 6f351b49 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢
Browse files

Merge branch 'main-refactor' [#47]

parents e38e705e a285d396
{-# LANGUAGE AllowAmbiguousTypes #-}
module Copar.CoalgebraPrinter (printEncoding) where
module Copar.CoalgebraPrinter (printCoalgebra, printEncoding) where
import Control.Monad.ST
import qualified Data.HashMap.Strict as HM
......@@ -14,10 +14,22 @@ import qualified Data.Vector.Utils as V
import qualified Data.List as List
import Data.Maybe (fromJust)
import Copar.FunctorExpression.Type (FunctorExpression (..))
import Copar.FunctorExpression.Sorts (Sort, sortTable)
import Copar.FunctorExpression.Desorting
import Copar.Coalgebra.Parser
import Copar.Coalgebra.Printer
import Copar.RefinementInterface
import Copar.Functors.SomeFunctor
import Copar.FunctorPrinter (printParseableFunctor)
printCoalgebra :: FunctorExpression SomeFunctor Sort
-> Encoding (Label (Desorted SomeFunctor)) (F1 (Desorted SomeFunctor))
-> SymbolTable -> Build.Builder
printCoalgebra f encoding symbols =
Build.fromText (printParseableFunctor f) <>
"\n\n" <>
(printEncoding encoding symbols (sortTable f))
printEncoding :: forall f. (ParseMorphism f, PrintMorphism f)
=> Encoding (Label (Desorted f)) (F1 (Desorted f))
......
......@@ -27,12 +27,13 @@ import Options.Applicative
import Copar.Algorithm
import qualified Copar.Parser as P
import Copar.Coalgebra.Parser (SymbolTable)
import Copar.PartitionPrinter
import Copar.FunctorPrinter
import Copar.Functors
import Copar.FunctorDescription
import qualified Data.CoalgebraEncoding as Encoding
import Copar.FunctorExpression.Sorts (Sort, sortedSort, sortTable)
import Copar.FunctorExpression.Sorts (Sort, sortedSort)
import qualified Data.Partition as Partition
import Copar.Functors.SomeFunctor (SomeFunctor)
import Copar.FunctorExpression.Type (FunctorExpression (..))
......@@ -448,52 +449,11 @@ main = do
stats <- initStats (refineStats r) (refineStatsJson r)
withTimeStat stats "overall-duration" $ do
(_, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
readCoalgebra (refineParseConfig r) (refineInputFile r)
>>= \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))))
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)))
(_f, symbolTable, encoding, partition) <-
refinementStep stats
(refineInputFile r)
(refineParseConfig r)
(refineEnableOpt r)
withTimeStat
stats
......@@ -506,60 +466,17 @@ main = do
stats <- initStats (minimizeStats r) (minimizeStatsJson r)
withTimeStat stats "overall-duration" $ do
(f, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
readCoalgebra (minimizeParseConfig r) (minimizeInputFile r)
>>= \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 (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)))
(f, symbolTable, encoding, part) <-
refinementStep stats
(minimizeInputFile r)
(minimizeParseConfig r)
(minimizeEnableOpt r)
(encoding', symbolTable') <- withTimeStat stats "minimize-duration" $
evaluate (minimize f encoding symbolTable part)
withTimeStat stats "output-duration" $ do
T.putStrLn $ printParseableFunctor f
T.putStrLn ""
LT.putStrLn $ Build.toLazyText $ printEncoding encoding' symbolTable' (sortTable f)
LT.putStrLn $ Build.toLazyText $ printCoalgebra f encoding' symbolTable'
finalizeStats stats
(GraphCommand r) -> do
(_, (symbolTable, encoding)) <- do
......@@ -591,9 +508,7 @@ main = do
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate res
T.putStrLn $ printParseableFunctor f
T.putStrLn ""
LT.putStrLn $ Build.toLazyText $ printEncoding encoding symbolTable (sortTable f)
LT.putStrLn $ Build.toLazyText $ printCoalgebra f encoding symbolTable
helpOverview :: Text -> Doc AnsiStyle
......@@ -661,6 +576,62 @@ helpOverview argv0 =
paragraph = line <> line
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 argv0 Nothing = putDoc (helpOverview argv0) >> putStrLn ""
printHelp _ (Just HelpListFunctors) =
......
......@@ -19,11 +19,9 @@ import qualified Copar.Parser as P
import Copar.PartitionPrinter
import Copar.Coalgebra.Parser
import Copar.CoalgebraPrinter
import Copar.FunctorPrinter
import Copar.Minimize
import Copar.Functors.SomeFunctor
import Copar.FunctorExpression.Desorting (Desorted)
import Copar.FunctorExpression.Sorts (sortTable)
main :: IO ()
main = do
......@@ -95,10 +93,7 @@ testFileMinimize mini =
let
(enc', symTab') = minimize f enc symTab part
return (LT.unpack . Build.toLazyText $ Build.fromText (printParseableFunctor f)
<> "\n\n"
<> printEncoding enc' symTab' (sortTable f)
<> "\n")
return (LT.unpack . Build.toLazyText $ printCoalgebra f enc' symTab' <> "\n")
testFileMinimizeIdentity :: FilePath -> Spec
testFileMinimizeIdentity file =
......@@ -111,9 +106,7 @@ testFileMinimizeIdentity file =
let
(enc', symTab') = minimize f enc symTab part
coalgebra = Build.fromText (printParseableFunctor f)
<> "\n\n"
<> printEncoding enc' (anonymizeSymbols symTab') (sortTable f)
coalgebra = printCoalgebra f enc' (anonymizeSymbols symTab')
reparsed = P.parseCoalgebra P.defaultConfig "(minimized)" $ LT.toStrict (Build.toLazyText coalgebra)
case reparsed of
......@@ -123,7 +116,4 @@ testFileMinimizeIdentity file =
let
(enc''', symTab''') = minimize f' enc'' symTab'' part'
Build.fromText (printParseableFunctor f)
<> "\n\n"
<> (printEncoding enc''' (anonymizeSymbols symTab''') (sortTable f')) `shouldBe`
coalgebra
printCoalgebra f' enc''' (anonymizeSymbols symTab''') `shouldBe` coalgebra
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