Add list and IntMap benchmarks

Author: Jaro Reinders

bench/Bench.hs

@@ -4,6 +4,8 @@ import Test.Tasty.Bench
 import qualified Fleet.Array as Fleet
 import Quicksort (quicksort)
 import qualified QuicksortA
+import qualified QuicksortIM
+import qualified Data.List as List
 
 class Indexable a where
   (!) :: a -> Int -> Int
@@ -59,4 +61,6 @@ main = do
     , bench "quicksort array" $ whnfIO (QuicksortA.clone marr >>= \marr' -> QuicksortA.quicksort marr' 0 9973)
     , bench "quicksort fleet" $ whnf (Quicksort.quicksort 0 9973) (Fleet.copy arr0)
     , bench "quicksort fleet copy" $ whnf (Quicksort.quicksort 0 9973 . Fleet.copy) arr0
+    , bench "quicksort intmap" $ whnf (QuicksortIM.quicksort 0 9973) (QuicksortIM.fromList list)
+    , bench "sort" $ nf (\xs -> List.sort xs) list
     ]

bench/QuicksortIM.hs

@@ -0,0 +1,49 @@
+{-# OPTIONS_GHC -Wno-name-shadowing -ddump-simpl -ddump-to-file -dsuppress-all -dno-suppress-type-signatures -dno-typeable-binds #-}
+module QuicksortIM (fromList, quicksort) where
+
+import qualified Data.IntMap as IntMap
+import Data.IntMap (IntMap)
+
+newtype MutArr a = MA (IntMap a)
+
+readMA :: MutArr a -> Int -> a
+readMA (MA m) i = m IntMap.! i
+
+writeMA :: Int -> a -> MutArr a -> MutArr a
+writeMA i x (MA m) = MA (IntMap.insert i x m)
+
+fromList :: [a] -> MutArr a
+fromList xs = MA (IntMap.fromDistinctAscList (zip [0..] xs))
+
+toList :: MutArr a -> [a]
+toList (MA m) = map snd (IntMap.toList m)
+
+swap :: Int -> Int -> MutArr a -> MutArr a
+swap !i !j !arr =
+  let
+    x = readMA arr i
+    y = readMA arr j
+  in writeMA j x (writeMA i y arr)
+
+{-# INLINEABLE quicksort #-}
+quicksort :: Ord a => Int -> Int -> MutArr a -> MutArr a
+quicksort !l !r !arr 
+  | r - l <= 1 = arr
+  | otherwise =
+    let
+      x = readMA arr (r - 1)
+      (arr1, m) = partition l (r - 1) x arr
+      arr2 = swap (r - 1) m arr1
+      arr3 = quicksort (m + 1) r arr2
+    in
+      quicksort l m arr3
+
+{-# INLINEABLE partition #-}
+partition :: Ord a => Int -> Int -> a -> MutArr a -> (MutArr a, Int)
+partition l r x = go l l where
+  go !m !i !arr
+    | i == r = (arr, m)
+    | otherwise =
+      if readMA arr i <= x then
+        go (m + 1) (i + 1) (swap i m arr)
+      else go m (i + 1) arr

fleet-array.cabal

@@ -2,11 +2,11 @@ cabal-version:   3.8
 name:            fleet-array
 version:         0.1.0.0
 license:         BSD-3-Clause
-license-file: LICENSE
+license-file:    LICENSE
 author:          Jaro Reinders
 maintainer:      [email protected]
 build-type:      Simple
-category: Data, Data Structures, Array
+category:        Data, Data Structures, Array
 synopsis: Fleet arrays are pure, but support fast updates if used linearly
 tested-with: GHC ==9.10.1 || ==9.8.4 || ==9.6.6
 description:
@@ -27,16 +27,16 @@ common warnings
 
 library
     import: warnings
-    exposed-modules: Fleet.Array
-    build-depends: base ^>= {4.18,4.19,4.20}
-    hs-source-dirs: src/
+    exposed-modules:  Fleet.Array
+    build-depends:    base ^>= {4.18,4.19,4.20}
+    hs-source-dirs:   src/
     default-language: GHC2021
 
 benchmark fleet-array-bench
     import:           warnings
     main-is:          Bench.hs
-    other-modules: Array, Quicksort, QuicksortA
-    build-depends:    base, fleet-array, tasty-bench ^>= {0.4.1}
+    other-modules:    Array, Quicksort, QuicksortA, QuicksortIM
+    build-depends:    base, fleet-array, tasty-bench ^>= {0.4.1}, containers
     hs-source-dirs:   bench/
     default-language: GHC2021