Add RAList benchmarks

Author: phadej

.gitignore

@@ -4,3 +4,4 @@ dist-newstyle/
 cabal.project.local
 tmp/
 *.agdai
+bench.html

cabal.project

@@ -12,7 +12,8 @@ packages: vec-optics
 
 packages: tests
 
-tests: true
+tests:      True
+benchmarks; True
 
 package dec
   ghc-options: -Wall

ral/bench/Bench.hs

@@ -0,0 +1,59 @@
+module Main where
+
+import Criterion.Main (bench, bgroup, defaultMain, whnf)
+
+import qualified Data.List            as L
+import qualified Data.RAList          as R
+import qualified Data.RAList.NonEmpty as NER
+import qualified Data.Vector          as V
+import qualified Data.Vector.Unboxed  as U
+
+list :: [Int]
+list = [1 .. 10000]
+
+ralist :: R.RAList Int
+ralist = R.fromList list
+
+vector :: V.Vector Int
+vector = V.fromList list
+
+uvector :: U.Vector Int
+uvector = U.fromList list
+
+rlast :: R.RAList a -> a
+rlast (R.NonEmpty r) = NER.last r
+rlast R.Empty        = error "rlast Empty"
+
+main :: IO ()
+main = defaultMain
+    [ bgroup "Last"
+        [ bench "List"           $ whnf L.last list
+        , bench "RAList"         $ whnf  rlast ralist
+        , bench "Vector"         $ whnf V.last vector
+        , bench "Vector.Unboxed" $ whnf U.last uvector
+        ]
+    , bgroup "Index"
+        [ bench "List"           $ whnf (\xs -> xs L.!! (L.length xs - 1)) list
+        , bench "RAList"         $ whnf (\xs -> xs R.!  (R.length xs - 1)) ralist
+        , bench "Vector"         $ whnf (\xs -> xs V.!  (V.length xs - 1)) vector
+        , bench "Vector.Unboxed" $ whnf (\xs -> xs U.!  (U.length xs - 1)) uvector
+        ]
+    , bgroup "Cons"
+        [ bench "List"           $ whnf (0 :)      list
+        , bench "RAList"         $ whnf (R.cons 0) ralist
+        , bench "Vector"         $ whnf (V.cons 0) vector
+        , bench "Vector.Unboxed" $ whnf (U.cons 0) uvector
+        ]
+    , bgroup "Length"
+        [ bench "List"           $ whnf L.length list
+        , bench "RAList"         $ whnf R.length ralist
+        , bench "Vector"         $ whnf V.length vector
+        , bench "Vector.Unboxed" $ whnf U.length uvector
+        ]
+    , bgroup "LastAfterCons"
+        [ bench "List"           $ whnf (\xs -> L.last $ 0 : xs     ) list
+        , bench "RAList"         $ whnf (\xs ->  rlast $ R.cons 0 xs) ralist
+        , bench "Vector"         $ whnf (\xs -> V.last $ V.cons 0 xs) vector
+        , bench "Vector.Unboxed" $ whnf (\xs -> U.last $ U.cons 0 xs) uvector
+        ]
+    ]

ral/ral.cabal

@@ -98,3 +98,15 @@ library
 -- if impl(ghc >= 8.0)
 --  build-depends: dump-core
 --  ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html
+
+benchmark ral-bench
+  type:             exitcode-stdio-1.0
+  default-language: Haskell2010
+  hs-source-dirs:   bench
+  ghc-options:      -Wall -fprint-explicit-kinds -threaded
+  main-is:          Bench.hs
+  build-depends:
+    , base
+    , criterion
+    , ral
+    , vector

ral/src/Data/RAList.hs

@@ -15,6 +15,8 @@ module Data.RAList (
     (!),
     (!?),
     uncons,
+    length,
+    null,
     -- * Conversions
     toList,
     fromList,

ral/src/Data/RAList/Internal.hs

@@ -18,6 +18,8 @@ module Data.RAList.Internal (
     -- * Indexing
     (!),
     (!?),
+    length,
+    null,
     -- * Conversions
     toList,
     fromList,
@@ -75,11 +77,8 @@ instance I.Foldable RAList where
     foldMap f (NonEmpty xs) = I.foldMap f xs
 
 #if MIN_VERSION_base(4,8,0)
-    length Empty = 0
-    length (NonEmpty xs) = I.length xs
-
-    null Empty        = True
-    null (NonEmpty _) = False
+    length = length
+    null   = null
 #endif
 
 instance NFData a => NFData (RAList a) where
@@ -197,6 +196,14 @@ fromList (x:xs) = NonEmpty (NE.fromNonEmpty (x :| xs))
 Empty       !? _ = Nothing
 NonEmpty xs !? i = xs NE.!? i
 
+length :: RAList a -> Int
+length Empty         = 0
+length (NonEmpty xs) = NE.length xs
+
+null :: RAList a -> Bool
+null Empty        = True
+null (NonEmpty _) = False
+
 -------------------------------------------------------------------------------
 -- Folds
 -------------------------------------------------------------------------------

ral/src/Data/RAList/NonEmpty.hs

@@ -19,6 +19,8 @@ module Data.RAList.NonEmpty (
     last,
     uncons,
     tail,
+    length,
+    null,
     -- * Conversions
     toNonEmpty,
     fromNonEmpty,

ral/src/Data/RAList/NonEmpty/Internal.hs

@@ -21,6 +21,8 @@ module Data.RAList.NonEmpty.Internal (
     (!?),
     head,
     last,
+    length,
+    null,
     -- * Conversions
     toNonEmpty,
     toList,
@@ -112,13 +114,8 @@ instance I.Foldable NERAList where
     foldMap f (NE xs) = I.foldMap f xs
 
 #if MIN_VERSION_base(4,8,0)
-    length (NE xs) = go 0 1 xs where
-        go :: Int -> Int -> NERAList' n a -> Int
-        go !acc s (Last  _)   = acc + s
-        go  acc s (Cons0   r) = go acc       (s + s) r
-        go  acc s (Cons1 _ r) = go (acc + s) (s + s) r
-
-    null _ = False
+    length = length
+    null   = null
 #endif
 
 #ifdef MIN_VERSION_semigroupoids
@@ -292,6 +289,16 @@ last' (Last t)    = Tr.last t
 last' (Cons0 r)   = last' r
 last' (Cons1 _ r) = last' r
 
+length :: NERAList a -> Int
+length (NE xs) = go 0 1 xs where
+    go :: Int -> Int -> NERAList' n a -> Int
+    go !acc s (Last  _)   = acc + s
+    go  acc s (Cons0   r) = go acc       (s + s) r
+    go  acc s (Cons1 _ r) = go (acc + s) (s + s) r
+
+null :: NERAList a -> Bool
+null _ = False
+
 -------------------------------------------------------------------------------
 -- Folds
 -------------------------------------------------------------------------------