Added benchmarks for initTails

Benchmarks showed that some specialized instances of initTails based on splitOn were slower than the default definition, so I removed them.
Added reccommended flags for benchmarking.
Added change log entry.

mono-traversable/ChangeLog.md

@@ -1,5 +1,11 @@
 # ChangeLog for mono-traversable
 
+## 1.0.17.0
+
+* Added `inits`, `tails`, `initTails` to class `IsSequence` with tests and benchmarks for `initTails`.
+* Improved ghc benchmark flags.
+* Removed extraneous constraint `IsSequence` from `initMay`.
+
 ## 1.0.16.0
 
 * Added MonoPointed instance for bytestring Builder

mono-traversable/bench/InitTails.hs

@@ -0,0 +1,90 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+module InitTails (initTailsBenchmarks) where
+
+#if MIN_VERSION_gauge(0,2,0)
+import Gauge
+#else
+import Gauge.Main
+#endif
+
+import Data.Sequences as Ss
+import Data.MonoTraversable
+import Type.Reflection (Typeable, typeRep)
+import Control.DeepSeq
+import Data.Foldable (foldl')
+import Data.Functor ((<&>))
+
+import Data.ByteString (StrictByteString)
+import Data.ByteString.Lazy (LazyByteString)
+import qualified Data.Text as TS
+import qualified Data.Text.Lazy as TL
+import Data.Sequence (Seq)
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as VU
+import qualified Data.Vector.Storable as VS
+
+initTailsBenchmarks :: Benchmark
+initTailsBenchmarks = bgroup "InitTails"
+  [ bmg @[Char]
+  , bmg @StrictByteString
+  , bmg @LazyByteString
+  , bmg @TS.Text
+  , bmg @TL.Text
+  , bmg @(Seq Char)
+  , bmg @(V.Vector  Char)
+  , bmg @(VU.Vector Char)
+  , bmg @(VS.Vector Char)
+  ]
+
+bmg :: forall seq.
+  ( TestLabel seq
+  , NFData seq
+  , IsSequence seq
+  , Num (Index seq)
+  , Enum (Element seq)
+  ) => Benchmark
+bmg = bgroup (testLabel @seq) $ bm <$> labelledLengths
+  where
+  bm :: (String,[Int]) -> Benchmark
+  bm (label,lengths) = bgroup label $
+    [ ("weak", weakConsume)
+    , ("deep", deepConsume)
+    ] <&> \(wdLabel,consume) -> bench wdLabel
+      $ nf (map $ consume . initTails @seq)
+      $ (`Ss.replicate` (toEnum 65)) . fromIntegral <$> lengths
+  labelledLengths =
+    [ ("tiny",    [0,1,2,5,10])
+    , ("small",   [100,150,200,300])
+    , ("medium",  [1000,1500,2000,2500])
+    , ("large",   [10000,20000,50000])
+    , ("extream", [1000000])
+    ]
+
+class Typeable a => TestLabel a where
+  testLabel :: String
+  testLabel = show $ typeRep @a
+instance TestLabel [Char]
+instance TestLabel StrictByteString where testLabel = "StrictByteString"
+instance TestLabel LazyByteString   where testLabel = "LazyByteString"
+instance TestLabel TS.Text          where testLabel = "StrictText"
+instance TestLabel TL.Text          where testLabel = "LazyText"
+instance TestLabel (Seq Char)       where testLabel = "Seq"
+instance TestLabel (V.Vector Char)  where testLabel = "Vector"
+instance TestLabel (VU.Vector Char) where testLabel = "UnboxedVector"
+instance TestLabel (VS.Vector Char) where testLabel = "StorableVector"
+
+
+-- *Consume used to keep memory usage lower
+deepConsume :: NFData seq => [(seq,seq)] -> ()
+deepConsume = foldl' (\() (is,ts) -> deepseq is $ deepseq ts ()) ()
+
+weakConsume :: [(seq,seq)] -> ()
+weakConsume = foldl' (\() (_,_) -> ()) ()
+

mono-traversable/bench/sorting.hs → mono-traversable/bench/Sorting.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+module Sorting (sortingBenchmarks) where
 
 #if MIN_VERSION_gauge(0,2,0)
 import Gauge
@@ -12,17 +13,20 @@ import qualified Data.List
 import qualified System.Random.MWC as MWC
 import qualified Data.Vector as V
 import qualified Data.Vector.Unboxed as U
+import System.IO.Unsafe (unsafePerformIO)
+
+sortingBenchmarks :: Benchmark
+sortingBenchmarks
+  = bgroup "Sorting"
+  $ unsafePerformIO
+  $ mapM mkGroup [10, 100, 1000, 10000]
 
 asVector :: V.Vector a -> V.Vector a
 asVector = id
 
 asUVector :: U.Vector a -> U.Vector a
 asUVector = id
 
-main :: IO ()
-main = do
-    mapM mkGroup [10, 100, 1000, 10000] >>= defaultMain
-
 mkGroup :: Int -> IO Benchmark
 mkGroup size = do
     gen <- MWC.create

mono-traversable/bench/main.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE CPP #-}
+
+#if MIN_VERSION_gauge(0,2,0)
+import Gauge
+#else
+import Gauge.Main
+#endif
+
+import Sorting (sortingBenchmarks)
+import InitTails (initTailsBenchmarks)
+
+
+main :: IO ()
+main = defaultMain
+  [ sortingBenchmarks
+  , initTailsBenchmarks
+  ]

mono-traversable/mono-traversable.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.7.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -72,18 +72,26 @@ test-suite test
     , vector
   default-language: Haskell2010
 
-benchmark sorting
+benchmark all
   type: exitcode-stdio-1.0
-  main-is: sorting.hs
+  main-is: main.hs
   other-modules:
+      InitTails
+      Sorting
       Paths_mono_traversable
   hs-source-dirs:
       bench
-  ghc-options: -Wall -O2
+  ghc-options: -Wall -O2 -with-rtsopts=-A32m
   build-depends:
       base
+    , bytestring
+    , containers
+    , deepseq
     , gauge
     , mono-traversable
     , mwc-random
+    , text
     , vector
   default-language: Haskell2010
+  if impl(ghc >= 8.6)
+    ghc-options: -fproc-alignment=64

mono-traversable/package.yaml

@@ -45,15 +45,23 @@ tests:
     - unordered-containers
     - foldl
 benchmarks:
-  sorting:
-    main: sorting.hs
+  all:
+    main: main.hs
     source-dirs: bench
     ghc-options:
     - -Wall
     - -O2
+    - -with-rtsopts=-A32m
+    when:
+      - condition: impl(ghc >= 8.6)
+        ghc-options: -fproc-alignment=64
     dependencies:
     - base
     - gauge
     - mono-traversable
+    - text
+    - containers
+    - bytestring
     - vector
     - mwc-random
+    - deepseq

mono-traversable/src/Data/Sequences.hs

@@ -711,9 +711,6 @@ instance SemiSequence S.ByteString where
     {-# INLINE cons #-}
     {-# INLINE snoc #-}
 
-initTailsViaSplitAt :: IsSequence seq => seq -> [(seq, seq)]
-initTailsViaSplitAt x = fmap (`splitAt` x) [0 .. lengthIndex x]
-
 instance IsSequence S.ByteString where
     fromList = S.pack
     lengthIndex = S.length
@@ -769,9 +766,6 @@ instance IsSequence S.ByteString where
     {-# INLINE indexEx #-}
     {-# INLINE unsafeIndex #-}
 
-    initTails = initTailsViaSplitAt
-    {-# INLINE initTails #-}
-
 instance SemiSequence T.Text where
     type Index T.Text = Int
     intersperse = T.intersperse
@@ -836,9 +830,6 @@ instance IsSequence T.Text where
     {-# INLINE indexEx #-}
     {-# INLINE unsafeIndex #-}
 
-    initTails = initTailsViaSplitAt
-    {-# INLINE initTails #-}
-
 instance SemiSequence L.ByteString where
     type Index L.ByteString = Int64
     intersperse = L.intersperse
@@ -1027,7 +1018,8 @@ instance IsSequence (Seq.Seq a) where
     initTails = its . (,) mempty
       where
       its x@(is, y Seq.:<| ts) = x : its (is Seq.:|> y, ts)
-      its (_, Seq.Empty) = mempty
+      its x@(_, Seq.Empty) = [x]
+    {-# INLINE initTails #-}
 
 instance SemiSequence (V.Vector a) where
     type Index (V.Vector a) = Int
@@ -1102,9 +1094,6 @@ instance IsSequence (V.Vector a) where
     {-# INLINE indexEx #-}
     {-# INLINE unsafeIndex #-}
 
-    initTails = initTailsViaSplitAt
-    {-# INLINE initTails #-}
-
 instance U.Unbox a => SemiSequence (U.Vector a) where
     type Index (U.Vector a) = Int
 
@@ -1178,9 +1167,6 @@ instance U.Unbox a => IsSequence (U.Vector a) where
     {-# INLINE indexEx #-}
     {-# INLINE unsafeIndex #-}
 
-    initTails = initTailsViaSplitAt
-    {-# INLINE initTails #-}
-
 instance VS.Storable a => SemiSequence (VS.Vector a) where
     type Index (VS.Vector a) = Int
     reverse = VS.reverse
@@ -1254,9 +1240,6 @@ instance VS.Storable a => IsSequence (VS.Vector a) where
     {-# INLINE indexEx #-}
     {-# INLINE unsafeIndex #-}
 
-    initTails = initTailsViaSplitAt
-    {-# INLINE initTails #-}
-
 -- | @'splitElem'@ splits a sequence into components delimited by separator
 -- element. It's equivalent to 'splitWhen' with equality predicate:
 --

mono-traversable/test/Main.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE CPP #-}
@@ -39,13 +40,14 @@ import qualified Data.IntMap as IntMap
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Set as Set
 import qualified Control.Foldl as Foldl
+import Data.String (IsString, fromString)
 
 import Control.Arrow (second)
 import Control.Applicative
 import Control.Monad.Trans.Writer
 
 import Prelude (Bool (..), ($), IO, Eq (..), fromIntegral, Ord (..), String, mod, Int, Integer, show,
-                return, asTypeOf, (.), Show, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, maybe)
+                return, asTypeOf, (.), Show, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, maybe, Char)
 import qualified Prelude
 
 newtype NonEmpty' a = NonEmpty' (NE.NonEmpty a)
@@ -93,6 +95,10 @@ fromListAs xs _ = fromList xs
 mapFromListAs :: IsMap a => [(ContainerKey a, MapValue a)] -> a -> a
 mapFromListAs xs _ = mapFromList xs
 
+instance IsString (V.Vector Char) where fromString = V.fromList
+instance IsString (U.Vector Char) where fromString = U.fromList
+instance IsString (VS.Vector Char) where fromString = VS.fromList
+
 main :: IO ()
 main = hspec $ do
     describe "onull" $ do
@@ -232,11 +238,15 @@ main = hspec $ do
               it "empty" $ initTails emptyTyp @?= [("","")]
               it "one element" $ initTails ("a" <> emptyTyp) @?= [("","a"), ("a","")]
               it "two elements" $ initTails ("ab" <> emptyTyp) @?= [("","ab"), ("a","b"), ("ab","")]
+        test "String" (mempty :: String)
         test "StrictBytestring" S.empty
         test "LazyBytestring" L.empty
         test "StrictText" T.empty
         test "LazyText" TL.empty
-        test "String" (mempty :: String)
+        test "Seq" Seq.empty
+        test "Vector" (mempty :: V.Vector Char)
+        test "Unboxed Vector" (mempty :: U.Vector Char)
+        test "Storable Vector" (mempty :: VS.Vector Char)
 
     describe "NonNull" $ do
         describe "fromNonEmpty" $ do