diff --git a/benchrunner/Benchrunner.hs b/benchrunner/Benchrunner.hs index adcccb0..a3d5914 100644 --- a/benchrunner/Benchrunner.hs +++ b/benchrunner/Benchrunner.hs @@ -2,98 +2,35 @@ module Main where -import Data.Int ( Int64 ) -import System.Random ( Random, newStdGen, randoms ) -import Data.Proxy ( Proxy(..) ) -import Control.DeepSeq ( NFData, force ) import Data.List.Split ( splitOn ) import System.Environment ( getArgs ) -import Control.Monad ( unless, replicateM ) -import Text.Read +import Control.Monad ( unless ) +import Control.DeepSeq ( NFData ) + +import qualified Array as A import Linear.Common -import Types as T -import qualified Data.Primitive.Types as P +import ForeignFunctionImports as FFI +import qualified Vector as V +import Input import qualified Measure as M +import Sort +import Utils +import qualified Microbench as MB + import qualified Insertion as I import qualified QuickSort as Q import qualified DpsMergeSort4 as DMS import qualified DpsMergeSort4Par as DMSP import qualified PiecewiseFallbackSort as PFS import qualified PiecewiseFallbackSortPar as PFSP -import qualified Microbench as MB -import qualified Array as A -import qualified Data.Vector.Unboxed as V import qualified Data.Vector.Algorithms.Insertion as ISDVS import qualified Data.Vector.Algorithms.Merge as MSDVS import qualified Data.Vector.Algorithms.Intro as QSDVS --------------------------------------------------------------------------------- - -getInput :: Benchmark -> Maybe Int -> IO (Input Int64) -getInput bench mb_size = case bench of - GenerateArray -> pure $ IntIn (mb 10000000) - FillArray -> pure $ EltsIn (mb 10000000) 1024 - CopyArray -> pure $ ArrayIn (A.make (mb 10000000) 1) - SumArray -> pure $ ArrayIn (A.make (mb 10000000) 1) - Fib -> pure $ IntIn (mb 45) - OurSort alg -> case alg of - Insertionsort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 100) - Quicksort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 1000000) - Mergesort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 8000000) - Optsort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 8000000) - _ -> error "getInput: Unexpected Input!" - where - mb x = case mb_size of - Nothing -> x - Just y -> y - -getInputAsDataVector :: SortAlgo -> Maybe Int -> IO Vec -getInputAsDataVector bench mb_size = case bench of - Insertionsort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 100) - Quicksort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 1000000) - Mergesort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 8000000) - _ -> error "getInputAsDataVector: TODO sort function not implemented!" - where - mb x = case mb_size of - Nothing -> x - Just y -> y - -getInputAsList :: SortAlgo -> Maybe Int -> IO [Int64] -getInputAsList bench mb_size = case bench of - Insertionsort -> randList (Proxy :: Proxy Int64) (mb 100) - Quicksort -> randList (Proxy :: Proxy Int64) (mb 1000000) - Mergesort -> randList (Proxy :: Proxy Int64) (mb 8000000) - _ -> error "getInputAsDataVector: TODO sort function not implemented!" - where - mb x = case mb_size of - Nothing -> x - Just y -> y - -copyInput :: (Input Int64) -> IO (Input Int64) -copyInput i = case i of - ArrayIn arr -> pure $ ArrayIn (A.copy arr 0 (A.make (A.size arr) (A.get arr 0)) 0 (A.size arr)) - _ -> error "TODO: copyInput not implemented!" - -copyInputIterTimes :: Input Int64 -> Int -> IO [A.Array Int64] -copyInputIterTimes inp iters = do - copiedInputs <- replicateM iters (copyInput inp) - return [arr | ArrayIn arr <- copiedInputs] - -randArray :: forall a. (Random a, NFData a, P.Prim a) => Proxy a -> Int -> IO (A.Array a) -randArray _ty size = do - rng <- newStdGen - let ls :: [a] - ls = take size $ randoms rng - !arr = force (A.fromList ls) - pure arr - -randList :: forall a. (Random a, NFData a) => Proxy a -> Int -> IO [a] -randList _ty size = do - rng <- newStdGen - let ls :: [a] - ls = take size $ randoms rng - pure (force ls) +-- +-- Table of sorting functions +-- sortFn :: (Show a, A.HasPrimOrd a, NFData a) => SortAlgo -> ParOrSeq -> (A.Array a -. A.Array a) sortFn bench parorseq = case (bench,parorseq) of @@ -104,6 +41,7 @@ sortFn bench parorseq = case (bench,parorseq) of (Optsort, Seq) -> PFS.pfsort (Optsort, Par) -> PFSP.pfsort oth -> error $ "sortFn: unknown configuration: " ++ show oth +{-# INLINABLE sortFn #-} vectorSortFn :: SortAlgo -> ParOrSeq -> VecSort vectorSortFn bench parorseq = case (bench,parorseq) of @@ -111,20 +49,27 @@ vectorSortFn bench parorseq = case (bench,parorseq) of (Mergesort, Seq) -> MSDVS.sort (Quicksort, Seq) -> QSDVS.sort oth -> error $ "sortFn: unknown configuration: " ++ show oth - --------------------------------------------------------------------------------- - -isSorted :: Ord a => [a] -> Bool -isSorted [] = True -isSorted [_] = True -isSorted (x:y:xs) = x <= y && isSorted (y:xs) - -readBench :: String -> Benchmark -readBench s = case readMaybe s of - Just b -> b - Nothing -> case readMaybe s of - Just srt -> OurSort srt - Nothing -> read s +{-# INLINABLE vectorSortFn #-} + +sortFnC :: SortAlgo -> FFI.SortFn +sortFnC alg = case alg of + Insertionsort -> FFI.c_insertionsort + Mergesort -> FFI.c_mergesort + Quicksort -> FFI.c_quicksort + _ -> error "sortFnC: Csort not implemented!" +{-# INLINABLE sortFnC #-} + +sortFnCxx :: SortAlgo -> FFI.SortFnCxx +sortFnCxx alg = case alg of + Insertionsort -> FFI.cxx_int_insertionsort + Mergesort -> FFI.cxx_int_mergesort + Quicksort -> FFI.cxx_int_quicksort + _ -> error "sortFnCxx: Csort not implemented!" +{-# INLINABLE sortFnCxx #-} + +-- +-- Select which benchmark to run +-- -- dobench :: Benchmark -> ParOrSeq -> Maybe Int -> IO () dobench :: Benchmark -> ParOrSeq -> Maybe Int -> Int -> IO () @@ -204,23 +149,22 @@ dobench bench parorseq mb_size iters = do putStrLn "Sorted: OK" pure (V.length inPutVec, V.length res0, tmed0, tall0) OurSort alg -> do - ArrayIn arr <- getInput bench mb_size - arrs <- copyInputIterTimes (ArrayIn arr) iters + (ArrayIn arr) <- getInput bench mb_size let fn = sortFn alg parorseq putStrLn $ "array size = " ++ show (A.size arr) - (res0, tmed0, tall0) <- M.benchOnArrays fn arrs + (res0, tmed0, tall0) <- M.benchOnArrays fn arr iters unless (isSorted (A.toList res0)) (error $ show bench ++ ": result not sorted.") putStrLn "Sorted: OK" pure (A.size arr, A.size res0, tmed0, tall0) CSort alg -> do arr <- getInputAsList alg mb_size - (res0, tmed0, tall0) <- M.benchAndRunCSorts alg arr iters + (res0, tmed0, tall0) <- M.benchAndRunCSorts (sortFnC alg) arr iters unless (isSorted (res0)) (error $ show bench ++ ": result not sorted.") putStrLn "Sorted: OK" pure (length arr, length res0, tmed0, tall0) CxxSort alg -> do arr <- getInputAsList alg mb_size - (res0, tmed0, tall0) <- M.benchAndRunCxxSorts alg arr iters + (res0, tmed0, tall0) <- M.benchAndRunCxxSorts (sortFnCxx alg) arr iters unless (isSorted (res0)) (error $ show bench ++ ": result not sorted.") putStrLn "Sorted: OK" pure (length arr, length res0, tmed0, tall0) diff --git a/benchrunner/Input.hs b/benchrunner/Input.hs new file mode 100644 index 0000000..7eb840e --- /dev/null +++ b/benchrunner/Input.hs @@ -0,0 +1,80 @@ +-- | Benchmarks and inputs + +module Input where + +import Sort +import Utils + +import qualified Array as A +import qualified Vector as V + +import Data.Proxy (Proxy (..)) +import Data.Int (Int64) +import Text.Read + +data Benchmark + = GenerateArray + | FillArray + | CopyArray + | SumArray + | Fib + | OurSort SortAlgo + | VectorSort SortAlgo + | CSort SortAlgo + | CxxSort SortAlgo + deriving (Eq, Show, Read) + +readBench :: String -> Benchmark +readBench s = case readMaybe s of + Just b -> b + Nothing -> case readMaybe s of + Just srt -> OurSort srt + Nothing -> read s + +data Input a + = EltsIn + Int {- number of elements -} + a {- element -} + | ArrayIn (A.Array a) + | IntIn Int + deriving Show + +getInput :: Benchmark -> Maybe Int -> IO (Input Int64) +getInput bench mb_size = case bench of + GenerateArray -> pure $ IntIn (mb 10000000) + FillArray -> pure $ EltsIn (mb 10000000) 1024 + CopyArray -> pure $ ArrayIn (A.make (mb 10000000) 1) + SumArray -> pure $ ArrayIn (A.make (mb 10000000) 1) + Fib -> pure $ IntIn (mb 45) + OurSort alg -> case alg of + Insertionsort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 100) + Quicksort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 1000000) + Mergesort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 8000000) + Optsort -> ArrayIn <$> randArray (Proxy :: Proxy Int64) (mb 8000000) + _ -> error "getInput: Unexpected Input!" + where + mb x = case mb_size of + Nothing -> x + Just y -> y + +getInputAsDataVector :: SortAlgo -> Maybe Int -> IO Vec +getInputAsDataVector bench mb_size = case bench of + Insertionsort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 100) + Quicksort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 1000000) + Mergesort -> V.fromList <$> randList (Proxy :: Proxy Int64) (mb 8000000) + _ -> error "getInputAsDataVector: TODO sort function not implemented!" + where + mb x = case mb_size of + Nothing -> x + Just y -> y + +getInputAsList :: SortAlgo -> Maybe Int -> IO [Int64] +getInputAsList bench mb_size = case bench of + Insertionsort -> randList (Proxy :: Proxy Int64) (mb 100) + Quicksort -> randList (Proxy :: Proxy Int64) (mb 1000000) + Mergesort -> randList (Proxy :: Proxy Int64) (mb 8000000) + _ -> error "getInputAsDataVector: TODO sort function not implemented!" + where + mb x = case mb_size of + Nothing -> x + Just y -> y diff --git a/benchrunner/MVector.hs b/benchrunner/MVector.hs new file mode 100644 index 0000000..00e3329 --- /dev/null +++ b/benchrunner/MVector.hs @@ -0,0 +1,9 @@ +-- | Reexport of the right kind of mutable vectors + +module MVector + ( + module Data.Vector.Unboxed.Mutable + ) + where + +import Data.Vector.Unboxed.Mutable diff --git a/benchrunner/Measure.hs b/benchrunner/Measure.hs index a50ee8f..591c5b4 100644 --- a/benchrunner/Measure.hs +++ b/benchrunner/Measure.hs @@ -1,4 +1,4 @@ -module Measure (benchAndRunCSorts, benchAndRunCxxSorts, benchAndRunDataVecSorts, benchOnArrays, bench, benchPar, dotrialIO, benchIO, benchParIO) where +module Measure where import Control.Exception (evaluate) import Control.Monad.Par hiding (runParIO) @@ -8,20 +8,14 @@ import Data.Int import System.Mem (performMajorGC) import Data.Time.Clock (getCurrentTime, diffUTCTime) -import Foreign as F import qualified Array as A -import Types as T (SortAlgo(..), Vec, VecSort) -import qualified Data.List as L -import qualified Data.Vector.Unboxed as V -import qualified ForeignFunctionImports as FFI -import qualified Data.Vector.Unboxed.Mutable as MV - --------------------------------------------------------------------------------- +import Foreign as F +import ForeignFunctionImports as FFI +import Sort +import Utils +import qualified Vector as V +import qualified MVector as MV -median :: [Double] -> Double -median ls = (L.sort ls) !! (length ls `div` 2) - --------------------------------------------------------------------------------- benchPar :: (NFData a, NFData b) => (a -> Par b) -> a -> Int -> IO (b, Double, Double) @@ -57,7 +51,6 @@ benchIO f arg iters = do batchtime = sum times return $! (last results, selftimed, batchtime) - {-# NOINLINE dotrialPar #-} dotrialPar :: (NFData a, NFData b) => (a -> Par b) -> a -> IO (b, Double) @@ -96,24 +89,6 @@ dotrialIO f arg = do -------------------------------------------------------------------------------- -bench :: (NFData a, Show b, NFData b) => (a %p -> b) -> a -> Int -> IO (b, Double, Double) -bench f arg iters = do - let !arg2 = force arg - !tups <- mapM (\_ -> dotrial f arg2) [1..iters] - let (results, times) = unzip tups - let selftimed = median times - batchtime = sum times - return $! (last results, selftimed, batchtime) - -benchOnArrays :: (NFData a, Show b, NFData b, Show a) => (A.Array a %p -> b) -> [A.Array a] -> IO (b, Double, Double) -benchOnArrays f arrArgs = do - let !arg2s = force arrArgs - !tups <- mapM (\arg2' -> dotrial f (force arg2')) arg2s - let (results, times) = unzip tups - let selftimed = median times - batchtime = sum times - return $! (last results, selftimed, batchtime) - {-# NOINLINE dotrial #-} dotrial :: (NFData a, Show b, NFData b) => (a %p -> b) -> a -> IO (b, Double) dotrial f arg = do @@ -125,13 +100,40 @@ dotrial f arg = do putStrLn ("iter time: " ++ show delt) return $! (a,delt) + +bench :: (NFData a, Show b, NFData b) => (a %p -> b) -> a -> Int -> IO (b, Double, Double) +bench f arg iters = do + let !arg2 = force arg + !tups <- mapM (\_ -> dotrial f arg2) [1..iters] + let (results, times) = unzip tups + let selftimed = median times + batchtime = sum times + return $! (last results, selftimed, batchtime) + +benchOnArrays :: + (NFData a, Show b, NFData b, Show a, A.HasPrim a) => + (A.Array a %p -> b) -> A.Array a -> Int -> IO (b, Double, Double) +benchOnArrays f arr iters = do + let go (i, a) + | i == 0 = pure Nothing + | otherwise = do + !b <- copyArrayInplaceIO arr a + res <- dotrial f b + pure $ Just (res, (i - 1, b)) + !tups <- unfoldrM go (iters, A.make (A.size arr) (A.get arr 0)) + + let (results, times) = unzip tups + selftimed = median times + batchtime = sum times + pure (last results, selftimed, batchtime) + benchAndRunDataVecSorts :: VecSort -> Vec -> Int -> IO (Vec, Double, Double) -benchAndRunDataVecSorts sortFn inVec iters = do +benchAndRunDataVecSorts sortfn inVec iters = do !tups <- mapM (\_ -> do mvec <- V.thaw inVec mvecCopy <- MV.new (MV.length mvec) MV.copy mvecCopy mvec - res <- dotrialLocal sortFn mvecCopy + res <- dotrialLocal sortfn mvecCopy pure res ) [1..iters] let (results, times) = unzip tups @@ -150,29 +152,15 @@ benchAndRunDataVecSorts sortFn inVec iters = do arg' <- V.freeze arg return $! (arg', delt) -sortFnC :: SortAlgo -> FFI.SortFn -sortFnC alg = case alg of - Insertionsort -> FFI.c_insertionsort - Mergesort -> FFI.c_mergesort - Quicksort -> FFI.c_quicksort - _ -> error "sortFnC: Csort not implemented!" - -sortFnCxx :: SortAlgo -> FFI.SortFnCxx -sortFnCxx alg = case alg of - Insertionsort -> FFI.cxx_int_insertionsort - Mergesort -> FFI.cxx_int_mergesort - Quicksort -> FFI.cxx_int_quicksort - _ -> error "sortFnCxx: Csort not implemented!" - -- return type : IO ([Int64], Double, Double) -- [Int64]: sorted output array from the last iteration that was run -- Double: median runtime from the iterations that were run (selftimed) -- Double: Total time taken to run all the iterations (batchtime) -benchAndRunCSorts :: SortAlgo -> [Int64] -> Int -> IO ([Int64], Double, Double) -benchAndRunCSorts salg arr iters = do +benchAndRunCSorts :: FFI.SortFn -> [Int64] -> Int -> IO ([Int64], Double, Double) +benchAndRunCSorts fn arr iters = do !tups <- mapM (\_ -> do !ptr <- newArray arr - res <- dotrialC salg (length arr) ptr + res <- dotrialC fn (length arr) ptr pure res ) [1..iters] let (results, times) = unzip tups @@ -181,9 +169,8 @@ benchAndRunCSorts salg arr iters = do batchtime = sum times return $! (last results, selftimed, batchtime) where - dotrialC alg arrLength ptr = do + dotrialC fn arrLength ptr = do performMajorGC - let fn = sortFnC alg t1 <- getCurrentTime !sortedPtr <- fn ptr (fromIntegral arrLength) (fromIntegral $ F.sizeOf (undefined :: Int64)) t2 <- getCurrentTime @@ -196,11 +183,11 @@ benchAndRunCSorts salg arr iters = do -- [Int64]: sorted output array from the last iteration that was run -- Double: median runtime from the iterations that were run (selftimed) -- Double: Total time taken to run all the iterations (batchtime) -benchAndRunCxxSorts :: SortAlgo -> [Int64] -> Int -> IO ([Int64], Double, Double) -benchAndRunCxxSorts salg arr iters = do +benchAndRunCxxSorts :: FFI.SortFnCxx -> [Int64] -> Int -> IO ([Int64], Double, Double) +benchAndRunCxxSorts fn arr iters = do !tups <- mapM (\_ -> do !ptr <- newArray arr - res <- dotrialCxx salg (length arr) ptr + res <- dotrialCxx fn (length arr) ptr pure res ) [1..iters] let (results, times) = unzip tups @@ -209,9 +196,8 @@ benchAndRunCxxSorts salg arr iters = do batchtime = sum times return $! (last results, selftimed, batchtime) where - dotrialCxx alg arrLength ptr = do + dotrialCxx fn arrLength ptr = do performMajorGC - let fn = sortFnCxx alg t1 <- getCurrentTime !sortedPtr <- fn ptr (fromIntegral arrLength) t2 <- getCurrentTime diff --git a/benchrunner/Sort.hs b/benchrunner/Sort.hs new file mode 100644 index 0000000..2ee625e --- /dev/null +++ b/benchrunner/Sort.hs @@ -0,0 +1,26 @@ +-- | Encode sorting functions as an ADT +module Sort where + +import Data.Int (Int64) +import Control.Monad.Primitive (PrimState) + +import qualified Data.Vector.Unboxed as V +import qualified Data.Vector.Unboxed.Mutable as MV +import qualified ForeignFunctionImports as FFI +import Control.DeepSeq (NFData) +import Linear.Common + +data ParOrSeq = Seq | Par | ParM + deriving (Eq, Show, Read) + +data SortAlgo + = Insertionsort + | Mergesort + | Quicksort + | Optsort -- piecewise fallback + deriving (Eq, Show, Read) + +type MVec = MV.MVector (PrimState IO) Int64 +type Vec = V.Vector Int64 +type VecSort = MVec -> IO () + diff --git a/benchrunner/Types.hs b/benchrunner/Types.hs deleted file mode 100644 index 42e9df6..0000000 --- a/benchrunner/Types.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Types (SortAlgo(..), Benchmark(..), ParOrSeq(..), Input(..), MVec, Vec, VecSort) where - -import Data.Int (Int64) -import Control.Monad.Primitive (PrimState) - -import qualified Array as A -import qualified Data.Vector.Unboxed as V -import qualified Data.Vector.Unboxed.Mutable as MV - -data SortAlgo - = Insertionsort - | Mergesort - | Quicksort - | Optsort -- piecewise fallback - deriving (Eq, Show, Read) - -data Benchmark - = GenerateArray - | FillArray - | CopyArray - | SumArray - | Fib - | OurSort SortAlgo - | VectorSort SortAlgo - | CSort SortAlgo - | CxxSort SortAlgo - deriving (Eq, Show, Read) - -data ParOrSeq = Seq | Par | ParM - deriving (Eq, Show, Read) - -data Input a - = EltsIn - Int {- number of elements -} - a {- element -} - | ArrayIn (A.Array a) - | IntIn Int - deriving Show - -type MVec = MV.MVector (PrimState IO) Int64 -type Vec = V.Vector Int64 -type VecSort = MVec -> IO () diff --git a/benchrunner/Utils.hs b/benchrunner/Utils.hs new file mode 100644 index 0000000..1dd1208 --- /dev/null +++ b/benchrunner/Utils.hs @@ -0,0 +1,63 @@ +-- | Kitchen sink +module Utils where + +import qualified Array as A +import System.Random (Random, randoms, newStdGen) +import Control.DeepSeq (NFData, force) +import qualified Data.Primitive.Types as P +import Data.Proxy (Proxy) +import Control.Monad +import qualified Data.List as L + +-- List utils + +median :: [Double] -> Double +median ls = (L.sort ls) !! (length ls `div` 2) + +-- |See 'Data.List.unfoldr'. This is a monad-friendly version of that. +unfoldrM :: (Monad m) => (a -> m (Maybe (b, a))) -> a -> m [b] +unfoldrM f = go + where + go z = do + x <- f z + case x of + Nothing -> return mzero + Just (x', z') -> do + xs <- go z' + return (return x' `mplus` xs) + +isSorted :: Ord a => [a] -> Bool +isSorted [] = True +isSorted [_] = True +isSorted (x:y:xs) = x <= y && isSorted (y:xs) + +-- Random stuff + +randArray :: forall a. (Random a, NFData a, P.Prim a) => Proxy a -> Int -> IO (A.Array a) +randArray _ty size = do + rng <- newStdGen + let ls :: [a] + ls = take size $ randoms rng + !arr = force (A.fromList ls) + pure arr + +randList :: forall a. (Random a, NFData a) => Proxy a -> Int -> IO [a] +randList _ty size = do + rng <- newStdGen + let ls :: [a] + ls = take size $ randoms rng + pure (force ls) + +-- Array / IO stuff +-- +-- In benchrunner, we don't use the linear part of the Array interface, +-- so, we need means to sequentialize operations to not get into a pickle. +-- The easiest solution is to pretend to do IO. + +copyArrayIO :: A.HasPrim a => A.Array a -> IO (A.Array a) +copyArrayIO arr = pure (A.copy arr 0 (A.make (A.size arr) (A.get arr 0)) 0 (A.size arr)) +{-# NOINLINE copyArrayIO #-} + +copyArrayInplaceIO :: A.HasPrim a => A.Array a -> A.Array a -> IO (A.Array a) +copyArrayInplaceIO src dst = pure (A.copy src 0 dst 0 (A.size src)) +{-# NOINLINE copyArrayInplaceIO #-} diff --git a/benchrunner/Vector.hs b/benchrunner/Vector.hs new file mode 100644 index 0000000..51ca121 --- /dev/null +++ b/benchrunner/Vector.hs @@ -0,0 +1,9 @@ +-- | Reexport of the right kind of vectors + +module Vector + ( + module Data.Vector.Unboxed + ) + where + +import Data.Vector.Unboxed diff --git a/benchrunner/benchrunner.cabal b/benchrunner/benchrunner.cabal index f327a9a..e18358c 100644 --- a/benchrunner/benchrunner.cabal +++ b/benchrunner/benchrunner.cabal @@ -8,7 +8,11 @@ executable benchrunner main-is: Benchrunner.hs other-modules: Measure , ForeignFunctionImports - , Types + , Input + , Sort + , Utils + , Vector + , MVector -- other-extensions: build-depends: base , lh-array-sort diff --git a/src/Array/Mutable.hs b/src/Array/Mutable.hs index 8b7a878..415e74e 100644 --- a/src/Array/Mutable.hs +++ b/src/Array/Mutable.hs @@ -145,10 +145,10 @@ splitAt m = Unsafe.toLinear (\xs -> (slice xs 0 m, slice xs m (size xs))) {-# INLINABLE append #-} -- PRE-CONDITION: the two slices are backed by the same array and should be contiguous. append :: Array a -. Array a -. Array a -append xs ys = +append xs' ys' = let !res = Unsafe.toLinear (\xs -> case xs of - (Array !l1 _r1 !a1) -> Unsafe.toLinear (\ys -> case ys of - (Array _l2 !r2 _a2) -> Array l1 r2 a1)) xs ys + (Array l1 _r1 !a1) -> Unsafe.toLinear (\ys -> case ys of + (Array _l2 !r2 _a2) -> Array l1 r2 a1)) xs' ys' in res -- token xs == token ys