From c815cc81cde1ed8bf7f6286aa21f01ccdb5eeba3 Mon Sep 17 00:00:00 2001
From: Hans-Peter Deifel <hpd@hpdeifel.de>
Date: Mon, 23 Jul 2018 10:54:55 +0200
Subject: [PATCH] Add a micro-benchmark suite
Currently this just contains one very simple benchmark for the
morphism parser, but more will come in time.
---
ma.cabal | 26 ++++++++++++++++++++++++++
src/Data/MorphismEncoding.hs | 9 +++++++--
src/MA/Coalgebra/Parser.hs | 4 +++-
src/MA/FunctorExpression/Sorts.hs | 3 ++-
src/MA/Functors/Polynomial.hs | 10 +++++++---
5 files changed, 45 insertions(+), 7 deletions(-)
diff --git a/ma.cabal b/ma.cabal
index cf045bf..c22fe86 100644
--- a/ma.cabal
+++ b/ma.cabal
@@ -161,3 +161,29 @@ test-suite examples
, directory
, text
, extra
+
+benchmark bench
+ type: exitcode-stdio-1.0
+ hs-source-dirs: bench
+ main-is: BenchMain.hs
+ other-modules: BenchMorphParser
+ default-extensions: GADTs
+ , StandaloneDeriving
+ , DeriveFunctor
+ , DeriveFoldable
+ , DeriveTraversable
+ , TypeFamilies
+ , InstanceSigs
+ , OverloadedStrings
+ , TupleSections
+ , ScopedTypeVariables
+ , TypeApplications
+ , RankNTypes
+ build-depends: base
+ , ma
+ , criterion
+ , text
+ , megaparsec
+ , deepseq
+ default-language: Haskell2010
+ ghc-options: -Wall
diff --git a/src/Data/MorphismEncoding.hs b/src/Data/MorphismEncoding.hs
index e96ab36..de6a8c6 100644
--- a/src/Data/MorphismEncoding.hs
+++ b/src/Data/MorphismEncoding.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
@@ -27,6 +29,9 @@ module Data.MorphismEncoding
) where
import Data.Bifunctor
+import GHC.Generics (Generic)
+
+import Control.DeepSeq
import Data.Vector (Vector)
import qualified Data.Vector as V
@@ -47,7 +52,7 @@ data Edge a = Edge
, label :: a
, to :: {-# UNPACK #-} State
}
- deriving (Show, Eq, Functor)
+ deriving (Show, Eq, Functor, Generic, NFData)
-- | A generic graph (automaton) structure with labeled nodes and edges.
--
@@ -56,7 +61,7 @@ data Encoding a h1 = Encoding
{ eStructure :: Vector h1
, eEdges :: Vector (Edge a)
}
- deriving (Show, Eq)
+ deriving (Show, Eq, Generic, NFData)
instance Bifunctor Encoding where
first f e = e{ eEdges = fmap (fmap f) (eEdges e) }
diff --git a/src/MA/Coalgebra/Parser.hs b/src/MA/Coalgebra/Parser.hs
index 5660d42..340a2bf 100644
--- a/src/MA/Coalgebra/Parser.hs
+++ b/src/MA/Coalgebra/Parser.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -20,6 +21,7 @@ import qualified Data.Text as T
import Lens.Micro.Platform
import Text.Megaparsec hiding (State)
import qualified Data.Vector as V
+import Control.DeepSeq (NFData)
import MA.FunctorExpression.Type
import MA.FunctorExpression.Sorts (Sort)
@@ -82,7 +84,7 @@ checkUndefinedRefs = use (symbolTable . to M.toList . to (filter isUndefined)) >
isUndefined = (==Undefined) . snd . snd
newtype SymbolTable = SymbolTable { fromSymbolTable :: M.HashMap State Text }
- deriving (Show,Eq,Ord)
+ deriving (Show,Eq,Ord,NFData)
finalizeState ::
ParserState l h1 -> (SymbolTable, Encoding (Sort, l) (Sort, h1))
diff --git a/src/MA/FunctorExpression/Sorts.hs b/src/MA/FunctorExpression/Sorts.hs
index b877559..7539196 100644
--- a/src/MA/FunctorExpression/Sorts.hs
+++ b/src/MA/FunctorExpression/Sorts.hs
@@ -26,6 +26,7 @@ import Data.Text.Lazy.Builder.Int as Build
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
+import Control.DeepSeq (NFData)
import MA.FunctorExpression.Type
import MA.FunctorExpression.Pretty
@@ -33,7 +34,7 @@ import MA.FunctorExpression.Pretty
-- | Sorts are basically unique integers for every sub-expression in a functor
-- expression.
newtype Sort = Sort Int
- deriving (Eq, Show, Ord, Num, Integral, Real, Enum)
+ deriving (Eq, Show, Ord, Num, Integral, Real, Enum, NFData)
-- | Assigns each sub-expression a different sort, starting with 1.
annotateSorts :: Traversable f => FunctorExpression f a -> FunctorExpression f Sort
diff --git a/src/MA/Functors/Polynomial.hs b/src/MA/Functors/Polynomial.hs
index 3e81402..c34af7a 100644
--- a/src/MA/Functors/Polynomial.hs
+++ b/src/MA/Functors/Polynomial.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -27,6 +29,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (fromMaybe)
import Data.Tuple (swap)
+import GHC.Generics (Generic)
import qualified Data.Vector.Algorithms.Intro as V (sort)
import Data.Text (Text)
@@ -37,6 +40,7 @@ import Text.Megaparsec
import Data.Eq.Deriving (deriveEq1)
import Text.Show.Deriving (deriveShow1)
import Lens.Micro
+import Control.DeepSeq (NFData)
import MA.Coalgebra.Parser
import MA.Coalgebra.RefinementTypes
@@ -136,11 +140,11 @@ parseFiniteNatExp = FiniteNatExp <$> L.decimal
-- Index into coproduct and corresponding product value
data SumValue a = SumValue Int (ProductValue a)
- deriving (Eq, Ord, Show, Functor)
+ deriving (Eq, Ord, Show, Functor, Generic, NFData)
data ProductValue a =
ProductValue (Vector (FactorValue a))
- deriving (Eq, Ord, Show, Functor)
+ deriving (Eq, Ord, Show, Functor, Generic, NFData)
data FactorValue a
= -- | Index of constant in vector of possible values
@@ -149,7 +153,7 @@ data FactorValue a
| IdValue a
-- | Essentially the same as a product of "IdValue"s
| ExponentialValue (Vector a)
- deriving (Eq, Ord, Show, Functor)
+ deriving (Eq, Ord, Show, Functor, Generic, NFData)
data Three = ToRest | ToCompound | ToSub
--
GitLab