From 115c4a55abbe64e52e2f27f5230148ba628d9e37 Mon Sep 17 00:00:00 2001 From: min-nguyen Date: Mon, 9 Oct 2023 17:49:24 +0100 Subject: [PATCH] Using Writer monad for recording bench rows --- Benchmarks/benchmarks.csv | 134 +++++++++++++++++++------------------- test/Benchmark/Util.purs | 56 ++++------------ test/Util.purs | 61 ++++++++--------- 3 files changed, 109 insertions(+), 142 deletions(-) diff --git a/Benchmarks/benchmarks.csv b/Benchmarks/benchmarks.csv index ae20a7fd3..20cc0dc9d 100644 --- a/Benchmarks/benchmarks.csv +++ b/Benchmarks/benchmarks.csv @@ -1,67 +1,67 @@ -Test-Name,Trace-Bwd,Trace-Eval,Trace-Fwd,Graph-Bwd,Graph-BwdAll,Graph-BwdDual,Graph-Eval,Graph-Fwd,Graph-FwdAsDeMorgan,Graph-FwdDual -arithmetic,17.0,10.0,2.0,1.0,1.0,1.0,4.0,0.0,5.0,0.0 -array,10.0,11.0,4.0,1.0,2.0,0.0,10.0,0.0,4.0,0.0 -compose,14.0,23.0,1.0,1.0,0.0,0.0,2.0,0.0,5.0,0.0 -dicts,8.0,7.0,2.0,1.0,2.0,0.0,8.0,0.0,5.0,0.0 -div-mod-quot-rem,8.0,7.0,5.0,0.0,3.0,1.0,5.0,2.0,4.0,0.0 -factorial,13.0,9.0,8.0,0.0,32.0,0.0,7.0,0.0,158.0,0.0 -filter,16.0,14.0,3.0,1.0,1.0,0.0,5.0,6.0,3.0,0.0 -first-class-constr,10.0,11.0,3.0,0.0,2.0,0.0,5.0,1.0,3.0,0.0 -flatten,10.0,10.0,3.0,2.0,3.0,1.0,8.0,0.0,8.0,0.0 -foldr_sumSquares,9.0,10.0,3.0,0.0,2.0,0.0,6.0,0.0,2.0,0.0 -lexicalScoping,8.0,7.0,1.0,1.0,0.0,0.0,1.0,0.0,11.0,0.0 -length,10.0,8.0,1.0,1.0,3.0,0.0,2.0,0.0,2.0,0.0 -lookup,7.0,11.0,5.0,1.0,1.0,0.0,6.0,0.0,3.0,0.0 -map,8.0,10.0,3.0,1.0,2.0,1.0,6.0,0.0,3.0,0.0 -mergeSort,18.0,18.0,16.0,0.0,2.0,0.0,18.0,0.0,6.0,0.0 -normalise,14.0,17.0,2.0,0.0,1.0,0.0,3.0,0.0,10.0,0.0 -pattern-match,9.0,15.0,6.0,0.0,1.0,0.0,8.0,0.0,6.0,0.0 -range,26.0,18.0,13.0,1.0,2.0,0.0,15.0,0.0,8.0,0.0 -records,10.0,8.0,3.0,0.0,1.0,0.0,8.0,0.0,4.0,0.0 -reverse,7.0,13.0,1.0,0.0,0.0,0.0,6.0,0.0,3.0,0.0 -dtw/next-indices,62.0,80.0,57.0,2.0,151.0,2.0,84.0,6.0,768.0,0.0 -dtw/cost-matrix,64.0,55.0,39.0,2.0,8.0,1.0,84.0,3.0,108.0,0.0 -dtw/matrix-update,11.0,7.0,2.0,1.0,1.0,0.0,3.0,0.0,3.0,0.0 -desugar/list-comp-1,16.0,24.0,16.0,1.0,2.0,0.0,20.0,0.0,7.0,0.0 -desugar/list-comp-2,53.0,56.0,59.0,1.0,9.0,1.0,73.0,2.0,27.0,0.0 -desugar/list-comp-3,19.0,18.0,13.0,1.0,1.0,0.0,17.0,0.0,8.0,0.0 -desugar/list-comp-4,10.0,11.0,4.0,1.0,1.0,0.0,9.0,0.0,4.0,0.0 -desugar/list-comp-5,7.0,15.0,4.0,0.0,1.0,0.0,5.0,1.0,3.0,0.0 -desugar/list-comp-6,11.0,9.0,0.0,0.0,0.0,0.0,1.0,0.0,2.0,0.0 -desugar/list-comp-7,12.0,15.0,6.0,0.0,0.0,0.0,7.0,1.0,3.0,0.0 -desugar/list-enum,10.0,12.0,2.0,2.0,6.0,0.0,6.0,0.0,8.0,0.0 -add,10.0,5.0,0.0,0.0,0.0,1.0,1.0,1.0,2.0,0.0 -array/lookup,19.0,22.0,18.0,1.0,0.0,0.0,31.0,0.0,17.0,0.0 -array/dims,11.0,16.0,2.0,0.0,1.0,0.0,12.0,1.0,3.0,0.0 -convolution/edgeDetect,1082.0,1427.0,1619.0,30.0,38.0,0.0,2479.0,9.0,4066.0,305.0 -convolution/emboss,901.0,1188.0,1282.0,25.0,32.0,0.0,1958.0,2.0,3739.0,362.0 -convolution/gaussian,996.0,1264.0,1357.0,26.0,34.0,1.0,2052.0,2.0,3828.0,372.0 -dict/create,8.0,6.0,0.0,1.0,3.0,0.0,1.0,0.0,2.0,0.0 -dict/difference,6.0,7.0,1.0,1.0,1.0,0.0,3.0,0.0,6.0,0.0 -dict/disjointUnion,6.0,5.0,0.0,1.0,1.0,0.0,1.0,0.0,6.0,0.0 -dict/foldl,32.0,41.0,18.0,2.0,1.0,0.0,22.0,1.0,10.0,0.0 -dict/intersectionWith,11.0,8.0,2.0,1.0,1.0,1.0,4.0,1.0,10.0,0.0 -dict/fromRecord,6.0,9.0,1.0,1.0,3.0,1.0,1.0,0.0,2.0,0.0 -dict/get,8.0,5.0,1.0,5.0,1.0,0.0,2.0,0.0,2.0,0.0 -dict/map,23.0,12.0,3.0,0.0,1.0,0.0,5.0,1.0,9.0,0.0 -divide,11.0,7.0,0.0,0.0,0.0,0.0,2.0,0.0,3.0,0.0 -filter,12.0,9.0,3.0,1.0,1.0,0.0,5.0,0.0,3.0,0.0 -intersperse,7.0,6.0,7.0,0.0,2.0,1.0,3.0,0.0,5.0,1.0 -intersperse,6.0,9.0,2.0,1.0,1.0,0.0,5.0,1.0,3.0,3.0 -length,12.0,7.0,1.0,1.0,1.0,0.0,2.0,0.0,7.0,1.0 -list-comp,30.0,31.0,29.0,1.0,3.0,5.0,37.0,2.0,21.0,3.0 -list-comp,33.0,45.0,28.0,1.0,2.0,0.0,36.0,3.0,9.0,6.0 -lookup,9.0,10.0,7.0,2.0,0.0,1.0,6.0,1.0,2.0,4.0 -map,12.0,10.0,1.0,1.0,3.0,1.0,2.0,1.0,2.0,0.0 -multiply,11.0,15.0,0.0,0.0,1.0,0.0,6.0,1.0,2.0,0.0 -nth,7.0,11.0,1.0,0.0,1.0,0.0,2.0,0.0,3.0,0.0 -section-5-example,25.0,30.0,28.0,1.0,6.0,0.0,39.0,2.0,12.0,4.0 -section-5-example,41.0,43.0,28.0,1.0,3.0,0.0,37.0,1.0,13.0,6.0 -section-5-example,25.0,30.0,23.0,1.0,2.0,0.0,36.0,3.0,11.0,7.0 -zeros,22.0,15.0,1.0,2.0,1.0,1.0,18.0,0.0,5.0,1.0 -zeros,25.0,17.0,2.0,1.0,7.0,1.0,3.0,1.0,5.0,1.0 -zipWith,7.0,9.0,5.0,1.0,2.0,0.0,4.0,2.0,3.0,3.0 -graphics/background,7.0,8.0,1.0,2.0,4.0,5.0,9.0,1.0,19.0,0.0 -graphics/grouped-bar-chart,108.0,143.0,148.0,6.0,1492.0,1.0,247.0,406.0,3997.0,0.0 -graphics/line-chart,195.0,231.0,213.0,10.0,2052.0,2.0,452.0,868.0,3877.0,0.0 -graphics/stacked-bar-chart,71.0,96.0,86.0,5.0,261.0,0.0,161.0,158.0,208.0,0.0 \ No newline at end of file +Test-Name,Graph-Bwd,Graph-BwdAll,Graph-BwdDual,Graph-Eval,Graph-Fwd,Graph-FwdAsDeMorgan,Graph-FwdDual,Trace-Bwd,Trace-Eval,Trace-Fwd +arithmetic,1.0,1.0,0.0,14.0,0.0,5.0,0.0,12.0,13.0,2.0 +array,2.0,1.0,0.0,8.0,0.0,4.0,0.0,11.0,14.0,6.0 +compose,0.0,1.0,0.0,7.0,0.0,2.0,0.0,9.0,7.0,1.0 +dicts,1.0,2.0,1.0,9.0,2.0,3.0,0.0,12.0,7.0,2.0 +div-mod-quot-rem,0.0,4.0,0.0,17.0,1.0,5.0,0.0,8.0,13.0,1.0 +factorial,1.0,35.0,0.0,19.0,0.0,146.0,0.0,14.0,18.0,5.0 +filter,1.0,1.0,0.0,9.0,0.0,2.0,0.0,8.0,13.0,4.0 +first-class-constr,0.0,1.0,1.0,13.0,0.0,3.0,0.0,8.0,12.0,3.0 +flatten,2.0,2.0,0.0,17.0,0.0,3.0,0.0,10.0,16.0,7.0 +foldr_sumSquares,1.0,1.0,0.0,10.0,0.0,3.0,0.0,8.0,12.0,4.0 +lexicalScoping,1.0,1.0,0.0,2.0,0.0,3.0,0.0,23.0,17.0,1.0 +length,3.0,0.0,0.0,3.0,0.0,3.0,0.0,7.0,6.0,1.0 +lookup,2.0,1.0,0.0,26.0,0.0,4.0,0.0,20.0,40.0,6.0 +map,1.0,3.0,1.0,27.0,1.0,5.0,1.0,8.0,12.0,2.0 +mergeSort,1.0,1.0,0.0,43.0,0.0,6.0,0.0,23.0,32.0,22.0 +normalise,1.0,1.0,0.0,5.0,0.0,3.0,0.0,6.0,6.0,4.0 +pattern-match,1.0,2.0,0.0,17.0,0.0,5.0,0.0,8.0,13.0,5.0 +range,2.0,2.0,0.0,53.0,0.0,12.0,0.0,24.0,32.0,11.0 +records,1.0,1.0,0.0,22.0,0.0,4.0,0.0,11.0,14.0,10.0 +reverse,2.0,1.0,0.0,6.0,0.0,3.0,0.0,8.0,20.0,3.0 +dtw/next-indices,2.0,143.0,0.0,206.0,6.0,741.0,1.0,50.0,130.0,51.0 +dtw/cost-matrix,2.0,7.0,1.0,196.0,2.0,118.0,1.0,46.0,119.0,33.0 +dtw/matrix-update,0.0,1.0,0.0,7.0,1.0,3.0,0.0,9.0,8.0,2.0 +desugar/list-comp-1,1.0,2.0,0.0,51.0,0.0,7.0,0.0,23.0,37.0,15.0 +desugar/list-comp-2,1.0,10.0,0.0,208.0,1.0,28.0,0.0,38.0,111.0,44.0 +desugar/list-comp-3,1.0,2.0,0.0,47.0,0.0,7.0,0.0,14.0,32.0,10.0 +desugar/list-comp-4,1.0,1.0,0.0,20.0,0.0,3.0,0.0,9.0,16.0,3.0 +desugar/list-comp-5,0.0,1.0,0.0,15.0,0.0,3.0,0.0,8.0,17.0,3.0 +desugar/list-comp-6,1.0,0.0,0.0,1.0,0.0,9.0,0.0,11.0,11.0,1.0 +desugar/list-comp-7,1.0,1.0,0.0,16.0,0.0,3.0,0.0,11.0,19.0,3.0 +desugar/list-enum,1.0,6.0,0.0,13.0,0.0,7.0,0.0,8.0,15.0,2.0 +add,0.0,1.0,0.0,2.0,1.0,1.0,0.0,6.0,6.0,0.0 +array/lookup,0.0,1.0,0.0,69.0,0.0,16.0,0.0,15.0,44.0,18.0 +array/dims,0.0,1.0,0.0,7.0,0.0,3.0,0.0,9.0,10.0,3.0 +convolution/edgeDetect,31.0,44.0,1.0,6144.0,9.0,4437.0,341.0,1144.0,3552.0,1402.0 +convolution/emboss,24.0,35.0,0.0,5347.0,2.0,4085.0,334.0,890.0,3084.0,1182.0 +convolution/gaussian,26.0,36.0,1.0,4913.0,1.0,3813.0,360.0,828.0,2827.0,1306.0 +dict/create,2.0,5.0,0.0,5.0,1.0,6.0,0.0,11.0,30.0,0.0 +dict/difference,1.0,1.0,0.0,3.0,0.0,7.0,0.0,6.0,7.0,1.0 +dict/disjointUnion,1.0,1.0,0.0,2.0,0.0,3.0,0.0,10.0,6.0,0.0 +dict/foldl,2.0,2.0,0.0,46.0,0.0,13.0,0.0,15.0,18.0,5.0 +dict/intersectionWith,2.0,1.0,2.0,28.0,1.0,4.0,0.0,26.0,17.0,18.0 +dict/fromRecord,0.0,1.0,0.0,1.0,1.0,2.0,0.0,9.0,7.0,0.0 +dict/get,0.0,2.0,0.0,3.0,0.0,2.0,0.0,8.0,7.0,1.0 +dict/map,1.0,1.0,0.0,11.0,0.0,4.0,0.0,10.0,10.0,3.0 +divide,0.0,0.0,0.0,2.0,0.0,4.0,0.0,5.0,13.0,0.0 +filter,1.0,1.0,0.0,15.0,0.0,3.0,0.0,13.0,16.0,2.0 +intersperse,1.0,1.0,0.0,10.0,1.0,3.0,0.0,8.0,7.0,2.0 +intersperse,1.0,2.0,0.0,7.0,0.0,2.0,1.0,7.0,10.0,4.0 +length,1.0,1.0,0.0,8.0,0.0,2.0,0.0,6.0,15.0,1.0 +list-comp,1.0,2.0,1.0,94.0,2.0,13.0,3.0,28.0,67.0,29.0 +list-comp,1.0,1.0,0.0,77.0,1.0,7.0,2.0,24.0,65.0,24.0 +lookup,0.0,0.0,1.0,14.0,0.0,3.0,1.0,10.0,14.0,4.0 +map,0.0,0.0,0.0,8.0,0.0,3.0,0.0,10.0,8.0,1.0 +multiply,1.0,2.0,0.0,1.0,0.0,1.0,0.0,8.0,15.0,0.0 +nth,0.0,0.0,0.0,4.0,1.0,3.0,0.0,7.0,18.0,1.0 +section-5-example,1.0,3.0,1.0,87.0,1.0,7.0,4.0,25.0,71.0,30.0 +section-5-example,1.0,2.0,0.0,83.0,1.0,10.0,2.0,23.0,58.0,25.0 +section-5-example,2.0,2.0,0.0,111.0,1.0,9.0,3.0,21.0,62.0,28.0 +zeros,1.0,1.0,0.0,4.0,1.0,2.0,0.0,10.0,7.0,2.0 +zeros,0.0,0.0,0.0,3.0,0.0,2.0,0.0,5.0,8.0,5.0 +zipWith,1.0,2.0,0.0,13.0,0.0,2.0,1.0,9.0,14.0,6.0 +graphics/background,2.0,4.0,0.0,12.0,2.0,20.0,0.0,9.0,12.0,3.0 +graphics/grouped-bar-chart,6.0,853.0,1.0,526.0,250.0,2585.0,0.0,107.0,294.0,134.0 +graphics/line-chart,9.0,1953.0,1.0,799.0,856.0,3744.0,0.0,139.0,443.0,191.0 +graphics/stacked-bar-chart,4.0,228.0,0.0,288.0,143.0,189.0,0.0,64.0,173.0,70.0 \ No newline at end of file diff --git a/test/Benchmark/Util.purs b/test/Benchmark/Util.purs index ec99a7780..7ba117bb9 100644 --- a/test/Benchmark/Util.purs +++ b/test/Benchmark/Util.purs @@ -2,67 +2,38 @@ module Benchmark.Util where import Prelude -import Control.Monad.Writer (WriterT, runWriterT) +import Control.Monad.Writer.Class (class MonadWriter, tell) import Data.Array (intersperse, fromFoldable) as A import Data.List (fold) -import Data.Map (Map, unionWith, fromFoldable, keys, values) +import Data.Map (Map, singleton, unionWith, fromFoldable, keys, values) import Effect.Class (class MonadEffect, liftEffect) import Test.Spec.Microtime (microtime) import Util (type (×), (×)) -data BenchRow = BenchRow TraceRow GraphRow +newtype BenchRow = BenchRow (Map String Number) newtype BenchAcc = BenchAcc (Array (String × BenchRow)) -type WithBenchAcc g a = WriterT BenchAcc g a - -runWithBenchAcc :: forall g a. Monad g => WithBenchAcc g a -> g (a × BenchAcc) -runWithBenchAcc = runWriterT - -derive newtype instance Semigroup BenchAcc -derive newtype instance Monoid BenchAcc - -type TraceRow = Map String Number --- { tEval :: Number --- , tBwd :: Number --- , tFwd :: Number --- } - -type GraphRow = Map String Number - --- { tEval :: Number --- , tBwd :: Number --- , tBwdDual :: Number --- , tBwdAll :: Number --- , tFwd :: Number --- , tFwdDual :: Number --- , tFwdAsDemorgan :: Number --- } - instance Show BenchAcc where show (BenchAcc rows) = fold $ A.intersperse "\n" ([ showHeader ] <> (showRow <$> rows)) where - BenchRow tr_empty gr_empty = mempty + BenchRow empty_row = mempty showHeader :: String showHeader = - fold $ A.intersperse "," ([ "Test-Name" ] <> A.fromFoldable (keys tr_empty) <> A.fromFoldable (keys gr_empty)) + fold $ A.intersperse "," ([ "Test-Name" ] <> A.fromFoldable (keys empty_row)) showRow :: String × BenchRow -> String - showRow (test_name × (BenchRow trRow grRow)) = - fold $ A.intersperse "," ([ test_name ] <> (show <$> A.fromFoldable (values trRow <> values grRow))) + showRow (test_name × (BenchRow row)) = + fold $ A.intersperse "," ([ test_name ] <> (show <$> A.fromFoldable (values row))) instance Semigroup BenchRow where - append (BenchRow trRow1 gRow1) (BenchRow trRow2 gRow2) = - BenchRow - (unionWith (+) trRow1 trRow2) - (unionWith (+) gRow1 gRow2) + append (BenchRow row1) (BenchRow row2) = BenchRow (unionWith (+) row1 row2) instance Monoid BenchRow where mempty = BenchRow - (fromFoldable [ ("Trace-Eval" × 0.0), ("Trace-Bwd" × 0.0), ("Trace-Fwd" × 0.0) ]) - (fromFoldable [ ("Graph-Eval" × 0.0), ("Graph-Bwd" × 0.0), ("Graph-Fwd" × 0.0), ("Graph-BwdDual" × 0.0), ("Graph-BwdAll" × 0.0), ("Graph-FwdDual" × 0.0), ("Graph-FwdAsDeMorgan" × 0.0) ]) + (fromFoldable [ ("Trace-Eval" × 0.0), ("Trace-Bwd" × 0.0), ("Trace-Fwd" × 0.0), ("Graph-Eval" × 0.0), ("Graph-Bwd" × 0.0), ("Graph-Fwd" × 0.0), ("Graph-BwdDual" × 0.0), ("Graph-BwdAll" × 0.0), ("Graph-FwdDual" × 0.0), ("Graph-FwdAsDeMorgan" × 0.0) ]) tdiff :: Number -> Number -> Number tdiff x y = sub y x @@ -70,9 +41,10 @@ tdiff x y = sub y x preciseTime :: forall m. MonadEffect m => m Number preciseTime = liftEffect microtime -bench :: forall m a. MonadEffect m => (Unit -> m a) -> m (a × Number) -bench prog = do +bench :: forall m a. MonadEffect m => MonadWriter BenchRow m => String -> (Unit -> m a) -> m a +bench name prog = do t1 <- preciseTime - a <- prog unit + r <- prog unit t2 <- preciseTime - pure (a × tdiff t1 t2) \ No newline at end of file + tell (BenchRow $ singleton name (tdiff t1 t2)) + pure r diff --git a/test/Util.purs b/test/Util.purs index 02a22f519..1e2a4f263 100644 --- a/test/Util.purs +++ b/test/Util.purs @@ -4,16 +4,18 @@ import Prelude hiding (absurd) import App.Fig (LinkFigSpec) import App.Util (Selector) -import Benchmark.Util (BenchRow(..), GraphRow, TraceRow, bench) +import Benchmark.Util (BenchRow(..), bench) import Control.Monad.Error.Class (class MonadError, class MonadThrow) +import Control.Monad.Writer.Class (class MonadWriter) +import Control.Monad.Writer.Trans (runWriterT) import Data.Foldable (foldl) import Data.Int (toNumber) import Data.List (elem) import Data.List.Lazy (List, length, replicateM) import Data.Set (subset) import Data.String (null) -import Data.Map (fromFoldable, union) import DataType (dataTypeFor, typeName) +import Data.Tuple (snd) import Desug (desugGC) import Effect.Aff (Aff) import Effect.Aff.Class (class MonadAff) @@ -49,10 +51,11 @@ test file progCxt tconfig (n × is_bench) = do gconfig <- initialConfig progCxt s <- open file testPretty s - rows <- replicateM n $ do - trRow <- testTrace s gconfig.γ tconfig - grRow <- testGraph s gconfig tconfig is_bench - pure $ BenchRow trRow grRow + rows <- (map snd) <$> + ( replicateM n $ runWriterT $ do + testTrace s gconfig.γ tconfig + testGraph s gconfig tconfig is_bench + ) pure $ averageRows rows testPretty :: forall m a. MonadAff m => MonadError Error m => Ann a => SE.Expr a -> m Unit @@ -64,7 +67,7 @@ testPretty s = do log ("NEW\n" <> show (erase s')) fail "not equal" -testTrace :: forall m. MonadAff m => MonadError Error m => Raw SE.Expr -> Env Vertex -> TestConfig -> m TraceRow +testTrace :: forall m. MonadAff m => MonadError Error m => MonadWriter BenchRow m => Raw SE.Expr -> Env Vertex -> TestConfig -> m Unit testTrace s γ { δv, bwd_expect, fwd_expect } = do -- | Desugaring Galois connections for Unit and Boolean type selections GC desug <- desugGC s @@ -72,18 +75,18 @@ testTrace s γ { δv, bwd_expect, fwd_expect } = do -- | Eval let e = desug.fwd s - { gc: GC eval, v } × t_eval <- bench $ \_ -> + { gc: GC eval, v } <- bench "Trace-Eval" $ \_ -> traceGC (erase <$> γ) e -- | Backward - (γ𝔹 × e𝔹) × t_bwd <- bench $ \_ -> do + (γ𝔹 × e𝔹) <- bench "Trace-Bwd" $ \_ -> do let γ𝔹 × e𝔹 × _ = eval.bwd (δv (botOf v)) pure (γ𝔹 × e𝔹) let s𝔹 = desug𝔹.bwd e𝔹 -- | Forward (round-tripping) let e𝔹' = desug𝔹.fwd s𝔹 - v𝔹 × t_fwd <- bench $ \_ -> do + v𝔹 <- bench "Trace-Fwd" $ \_ -> do pure (eval.fwd (γ𝔹 × e𝔹' × top)) -- | Check backward selections @@ -94,9 +97,7 @@ testTrace s γ { δv, bwd_expect, fwd_expect } = do when logging $ log (prettyP v𝔹) checkPretty "Trace-based value" fwd_expect v𝔹 - pure (fromFoldable [ "Trace-Eval" × t_eval, "Trace-Bwd" × t_bwd, "Trace-Fwd" × t_fwd ]) - -testGraph :: forall m. MonadAff m => MonadError Error m => Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> Boolean -> m GraphRow +testGraph :: forall m. MonadAff m => MonadError Error m => MonadWriter BenchRow m => Raw SE.Expr -> GraphConfig GraphImpl -> TestConfig -> Boolean -> m Unit testGraph s gconfig { δv, bwd_expect, fwd_expect } is_bench = do -- | Desugaring Galois connections for Unit and Boolean type selections GC desug <- desugGC s @@ -104,11 +105,11 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } is_bench = do -- | Eval let e = desug.fwd s - { gc: GC eval, eα, g, vα } × t_eval <- bench $ \_ -> + { gc: GC eval, eα, g, vα } <- bench "Graph-Eval" $ \_ -> graphGC gconfig e -- | Backward - (e𝔹 × αs_out × αs_in) × t_bwd <- bench $ \_ -> do + (e𝔹 × αs_out × αs_in) <- bench "Graph-Bwd" $ \_ -> do let αs_out = selectαs (δv (botOf vα)) vα αs_in = eval.bwd αs_out @@ -116,7 +117,7 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } is_bench = do let s𝔹 = desug𝔹.bwd e𝔹 -- | Forward (round-tripping) - (v𝔹 × αs_out') × t_fwd <- bench $ \_ -> do + (v𝔹 × αs_out') <- bench "Graph-Fwd" $ \_ -> do let αs_out' = eval.fwd αs_in pure (select𝔹s vα αs_out' × αs_out') @@ -130,18 +131,9 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } is_bench = do αs_out `shouldSatisfy "fwd ⚬ bwd round-tripping property"` (flip subset αs_out') - let benchmarks = fromFoldable [ "Graph-Eval" × t_eval, "Graph-Bwd" × t_bwd, "Graph-Fwd" × t_fwd ] - - if not is_bench then pure benchmarks - else do - -- | Forward (round-tripping) using De Morgan dual - v𝔹_demorgan × t_fwdAsDeMorgan <- bench $ \_ -> do - let - gfwd_demorgan = G.fwdSliceDeMorgan αs_in g - pure (select𝔹s vα (vertices gfwd_demorgan) <#> not) - + unless (not is_bench) do -- | De Morgan dual of backward - e𝔹_dual × t_bwdDual <- bench $ \_ -> do + e𝔹_dual <- bench "Graph-BwdDual" $ \_ -> do let αs_out_dual = selectαs (δv (botOf vα)) vα gbwd_dual = G.bwdSliceDual αs_out_dual g @@ -149,15 +141,21 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } is_bench = do pure (select𝔹s eα αs_in_dual) -- | Backward (all outputs selected) - e𝔹_all × t_bwdAll <- bench $ \_ -> do + e𝔹_all <- bench "Graph-BwdAll" $ \_ -> do pure (select𝔹s eα $ eval.bwd (vertices vα)) -- | De Morgan dual of forward - v𝔹_dual × t_fwdDual <- bench $ \_ -> do + v𝔹_dual <- bench "Graph-FwdDual" $ \_ -> do let gfwd_dual = G.fwdSliceDual αs_in g pure (select𝔹s vα (vertices gfwd_dual)) + -- | Forward (round-tripping) using De Morgan dual + v𝔹_demorgan <- bench "Graph-FwdAsDeMorgan" $ \_ -> do + let + gfwd_demorgan = G.fwdSliceDeMorgan αs_in g + pure (select𝔹s vα (vertices gfwd_demorgan) <#> not) + -- | To avoid unused variables when benchmarking when logging do log (prettyP v𝔹_demorgan) @@ -165,9 +163,6 @@ testGraph s gconfig { δv, bwd_expect, fwd_expect } is_bench = do log (prettyP e𝔹_all) log (prettyP v𝔹_dual) - pure $ union benchmarks - (fromFoldable [ ("Graph-BwdDual" × t_bwdDual), ("Graph-BwdAll" × t_bwdAll), ("Graph-FwdDual" × t_fwdDual), ("Graph-FwdAsDeMorgan" × t_fwdAsDeMorgan) ]) - type TestSpec = { file :: String , fwd_expect :: String @@ -212,4 +207,4 @@ averageRows rows = average $ foldl (<>) mempty rows where runs = toNumber $ length rows - average (BenchRow tr gr) = BenchRow (map (_ `div` runs) tr) (map (_ `div` runs) gr) + average (BenchRow row) = BenchRow (map (_ `div` runs) row)