diff --git a/ma.cabal b/ma.cabal
index cf045bfad990bb0c22667701f19bec10d1191a4f..c22fe86a0e6e5614f87737ef3cdd97c5b55cc597 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 e96ab3621f9bcbad4f1e6457a723252794267197..de6a8c64cb4be7ebe55b5962704330ccbe46a79b 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 5660d42581153c7da988783e1424e0201181fbb0..340a2bf33ba0059e08f0f5c9f3255325426ffde2 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 b877559bb8b23d6875575c29d39905f21d26c182..7539196b884710a9d99a84030d945d4d5b076fdf 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 3e81402b68cc81009a7db890f9fff8ac8ea85eaf..c34af7a853b54b341bbe2138a461046529b8390d 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