Benchmarking experiments with recursion-schemes (from https://www.reddit.com/r/haskell/comments/9xg585/are_recursionschemes_no_longer_faster_than/)

Prop.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}

module Main where

import Prelude hiding ((<>))

import Data.Functor.Foldable
import Data.Functor.Foldable.TH

import Criterion.Main

data Prop =
    PVar String
  | PUnary  Op Prop
  | PBinary Op Prop Prop

data Op = Neg | And deriving (Eq, Ord)

-- makeBaseFunctor ''Prop

data PropF a = PVarF String | PUnaryF Op a | PBinaryF Op a a
  deriving (Functor, Foldable, Traversable)

type instance Base Prop = PropF
instance Recursive Prop where
  project (PVar s) = PVarF s
  project (PUnary o p) = PUnaryF o p
  project (PBinary o p1 p2) = PBinaryF o p1 p2
  -- {-# INLINE project #-}

  cata f = c where c = f . fmap c . project
  -- cata f = go where
  --   go (PVar s) = f (PVarF s)
  --   go (PUnary o p) = f (PUnaryF o (go p))
  --   go (PBinary o p1 p2) = f (PBinaryF o (go p1) (go p2))
  {-# INLINEABLE cata #-}

propDepth :: Prop -> Int
propDepth = go
  where
  go PVar{}                     = 0
  go (PUnary _ child)           = 1 + go child
  go (PBinary  _ child1 child2) = 1 + max (go child1) (go child2)

propDepthF :: Prop -> Int
propDepthF = cata alg
  where
  alg PVarF{}                    = 0
  alg (PUnaryF  _ depth)         = 1 + depth
  alg (PBinaryF _ depth1 depth2) = 1 + max depth1 depth2

pattern PNot p     = PUnary  Neg p
pattern PAnd p1 p2 = PBinary And p1 p2

prop :: Prop
prop = PNot (PAnd (PNot (PNot (PVar "X"))) (PVar "Y"))

main :: IO ()
main =
  defaultMain $
    [ bench "vanilla-propDepth" $ nf propDepth prop
    , bench "cata-propDepth" $ nf propDepthF prop ]