btree 0.3.1 → 0.4.0

raw patch · 4 files changed

+4/−593 lines, 4 filesdep +initializePVP ok

version bump matches the API change (PVP)

Dependencies added: initialize

API changes (from Hackage documentation)

Files

• btree.cabal +3/−3
• src/ArrayList.hs +0/−322
• src/BTree/Store.hs +1/−135
• test/Spec.hs +0/−133

@@ -1,5 +1,5 @@ name: btree-version: 0.3.1+version: 0.4.0 synopsis: B-Tree on Unmanaged Heap -- description: homepage: https://github.com/andrewthad/btree@@ -8,7 +8,7 @@ author: Andrew Martin maintainer: andrew.thaddeus@gmail.com copyright: 2017 Andrew Martin-category: Web+category: Data build-type: Simple extra-source-files: README.md cabal-version: >=1.10@@ -20,9 +20,9 @@     BTree     BTree.Store     BTree.Linear-    ArrayList   build-depends:       base >= 4.9 && < 5+    , initialize >= 0.1.1.0 && < 0.2.0.0     , ghc-prim >= 0.5 && < 0.6     , primitive >= 0.6.4 && < 0.7   default-language: Haskell2010

@@ -1,322 +0,0 @@-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}--module ArrayList-  ( ArrayList-  , size-  , with-  , new-  , free-  , pushR-  , pushArrayR-  , popL-  , dropWhileL-  , dropWhileScanL-  , dropScanL-  , dropL-  , dump-  , dumpMap-  , dumpList-  , clear-  , showDebug-  ) where--import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal.Array-import Data.Primitive.PrimArray-import GHC.Prim (RealWorld)-import GHC.Int (Int(..))-import GHC.Ptr (Ptr(..))-import GHC.IO (IO(..))-import GHC.Prim ((*#),copyAddrToByteArray#)-import Data.Primitive hiding (sizeOf)-import Data.Primitive.Types-import Data.Bits (unsafeShiftR)-import BTree.Store (Initialize(..),Deinitialize(..))-import Control.Monad (when)-import Data.Primitive.Ptr (copyPtrToMutablePrimArray)-import qualified Data.Primitive as PM-import qualified Foreign.Marshal.Alloc as FMA-import qualified Foreign.Storable as FS---- Special value for Ptr: If the pointer is null, then--- it is understood that the ArrayList is of length 0.--- For such an ArrayList, it is understood that--- all of the fields should be 0.-data ArrayList a = ArrayList-  {-# UNPACK #-} !Int -- start index (in elements)-  {-# UNPACK #-} !Int -- used length (in elements)-  {-# UNPACK #-} !Int -- buffer length (in elements)-  {-# UNPACK #-} !(Ptr a) -- all the data--instance Storable (ArrayList a) where-  sizeOf _ = wordSz * 4-  alignment _ = wordSz-  {-# INLINE peek #-}-  peek ptr = ArrayList-    <$> peek (castPtr ptr)-    <*> peek (plusPtr ptr wordSz)-    <*> peek (plusPtr ptr (wordSz + wordSz))-    <*> peek (plusPtr ptr (wordSz + wordSz + wordSz))-  {-# INLINE poke #-}-  poke ptr (ArrayList a b c d) = do-    poke (castPtr ptr) a-    poke (plusPtr ptr wordSz) b-    poke (plusPtr ptr (wordSz + wordSz)) c-    poke (plusPtr ptr (wordSz + wordSz + wordSz)) d--instance Storable a => Initialize (ArrayList a) where-  {-# INLINE initialize #-}-  initialize (Ptr addr#) = setAddr (Addr addr#) 4 (0 :: Int)--wordSz :: Int-wordSz = PM.sizeOf (undefined :: Int)-  -initialSize :: Int-initialSize = 4--size :: ArrayList a -> Int-size (ArrayList _ len _ _) = len--with :: Storable a => (ArrayList a -> IO (ArrayList a,b)) -> IO b-with f = do-  initial <- new-  (final,a) <- f initial-  free final-  return a--new :: forall a. Storable a => IO (ArrayList a)-new = return (ArrayList 0 0 0 nullPtr)--{-# INLINABLE pushR #-}-pushR :: forall a. Storable a => ArrayList a -> a -> IO (ArrayList a)-pushR (ArrayList start len bufLen ptr) a = if start + len < bufLen-  then do-    poke (advancePtr ptr (start + len)) a-    return (ArrayList start (len + 1) bufLen ptr)-  else if-    | len == 0 -> do-        when (bufLen /= 0) (fail "ArrayList.pushR: invariant violated")-        when (start /= 0) (fail "ArrayList.pushR: invariant violated")-        when (ptr /= nullPtr) (fail "ArrayList.pushR: invariant violated")-        ptr <- FMA.mallocBytes (FS.sizeOf (undefined :: a) * initialSize)-        poke ptr a-        return (ArrayList 0 1 initialSize ptr)-    | len < half bufLen -> do-        moveArray ptr (advancePtr ptr start) len-        poke (advancePtr ptr len) a-        return (ArrayList 0 (len + 1) bufLen ptr)-    | otherwise -> do-        newPtr <- FMA.mallocBytes (FS.sizeOf (undefined :: a) * bufLen * 2)-        moveArray newPtr (advancePtr ptr start) len-        FMA.free ptr-        poke (advancePtr newPtr len) a-        return (ArrayList 0 (len + 1) (bufLen * 2) newPtr)--{-# INLINE pushArrayR #-}-pushArrayR :: forall a. (Storable a, Prim a) => ArrayList a -> PrimArray a -> IO (ArrayList a)-pushArrayR (ArrayList start len bufLen ptr) as =-  -- I think this should actually be less than or equal to-  if start + len + asLen < bufLen-    then do-      copyPrimArrayToPtr (advancePtr ptr (start + len)) as 0 asLen-      return (ArrayList start (len + asLen) bufLen ptr)-    else if-      -- this might give poor guarentees concerning worst-      -- case behaviors, but whatever for now.-      | len == 0 -> do-          when (bufLen /= 0) (fail "ArrayList.pushArrayR: invariant violated")-          when (start /= 0) (fail "ArrayList.pushArrayR: invariant violated")-          when (ptr /= nullPtr) (fail "ArrayList.pushArrayR: invariant violated")-          let newBufLen = twiceUntilExceeds initialSize asLen-          ptr <- FMA.mallocBytes (FS.sizeOf (undefined :: a) * newBufLen)-          copyPrimArrayToPtr ptr as 0 asLen-          return (ArrayList 0 asLen newBufLen ptr)-      | len < half bufLen && asLen < half bufLen -> do-          moveArray ptr (advancePtr ptr start) len-          copyPrimArrayToPtr (advancePtr ptr len) as 0 asLen-          return (ArrayList 0 (len + asLen) bufLen ptr)-      | otherwise -> do-          let newBufLen = twiceUntilExceeds (2 * bufLen) (len + asLen)-          newPtr <- FMA.mallocBytes (FS.sizeOf (undefined :: a) * newBufLen)-          moveArray newPtr (advancePtr ptr start) len-          FMA.free ptr-          copyPrimArrayToPtr (advancePtr newPtr len) as 0 asLen-          return (ArrayList 0 (len + asLen) newBufLen newPtr)-  where-  asLen = sizeofPrimArray as--twiceUntilExceeds :: Int -> Int -> Int-twiceUntilExceeds !i !limit = go i where -  go !n = if n > limit-    then n-    else go (n * 2)- --popL :: forall a. Storable a => ArrayList a -> IO (ArrayList a, Maybe a)-popL xs@(ArrayList start len bufLen ptr)-  | len < 1 = return (xs, Nothing)-  | otherwise = do-      a <- peek (advancePtr ptr start)-      newArrList <- minimizeMemory (ArrayList (start + 1) (len - 1) bufLen ptr)-      return (newArrList, Just a)--{-# INLINE dropWhileL #-}-dropWhileL :: forall a. Storable a-  => ArrayList a-  -> (a -> IO Bool) -- ^ predicate-  -> IO (ArrayList a,Int)-dropWhileL (ArrayList start len bufLen ptr) p = do-  let go :: Int -> IO Int-      go !i = if i < len-        then do-          a <- peek (advancePtr ptr (start + i))-          b <- p a-          if b-            then go (i + 1)-            else return i-        else return i-  dropped <- go 0-  newArrList <- minimizeMemory $ ArrayList (start + dropped) (len - dropped) bufLen ptr-  return (newArrList,dropped)--{-# INLINE dropWhileScanL #-}-dropWhileScanL :: forall a b. Storable a-  => ArrayList a-  -> b-  -> (b -> a -> IO (Bool,b))-  -> IO (ArrayList a,Int,b)-dropWhileScanL (ArrayList start len bufLen ptr) b0 p = do-  let go :: Int -> b -> IO (Int,b)-      go !i !b = if i < len-        then do-          !a <- peek (advancePtr ptr (start + i))-          (!shouldContinue,!b') <- p b a-          if shouldContinue-            then go (i + 1) b'-            else return (i,b')-        else return (i,b)-  (dropped,b') <- go 0 b0-  newArrList <- minimizeMemory $ ArrayList (start + dropped) (len - dropped) bufLen ptr-  return (newArrList,dropped,b')--{-# INLINE dropScanL #-}-dropScanL :: forall a b. Storable a-  => ArrayList a-  -> Int-  -> b-  -> (b -> a -> IO b)-  -> IO (ArrayList a, b)-dropScanL (ArrayList start len bufLen ptr) n b0 p = do-  let !m = min n len-  let go :: Int -> b -> IO b-      go !i !b = if i < m-        then do-          a <- peek (advancePtr ptr (start + i))-          b' <- p b a-          go (i + 1) b'-        else return b-  b' <- go 0 b0-  newArrList <- minimizeMemory $ ArrayList (start + m) (len - m) bufLen ptr-  return (newArrList,b')--{-# INLINE dropL #-}-dropL :: forall a. Storable a => ArrayList a -> Int -> IO (ArrayList a)-dropL (ArrayList start len bufLen ptr) n = do-  let m = min n len-  minimizeMemory $ ArrayList (start + m) (len - m) bufLen ptr--{-# INLINE minimizeMemory #-}-minimizeMemory :: forall a. Storable a => ArrayList a -> IO (ArrayList a)-minimizeMemory xs@(ArrayList start len bufLen ptr)-    -- We do not drop below a certain size, since then we would-    -- end up doing frequent reallocations. Although, once the size-    -- reaches zero, we deallocate entirely since this can save a lot-    -- of memory when we have many empty ArrayLists.-  | len == 0 = do-      FMA.free ptr-      return (ArrayList 0 0 0 nullPtr)-  | bufLen <= initialSize = return xs-  | len < eighth bufLen = do-      newPtr <- FMA.mallocBytes (FS.sizeOf (undefined :: a) * div bufLen 2)-      moveArray newPtr (advancePtr ptr start) len-      FMA.free ptr-      return (ArrayList 0 len (div bufLen 2) newPtr)-  | otherwise = return (ArrayList start len bufLen ptr)-  --{-# INLINE half #-}-half :: Int -> Int-half x = unsafeShiftR x 1--{-# INLINE quarter #-}-quarter :: Int -> Int-quarter x = unsafeShiftR x 2--{-# INLINE eighth #-}-eighth :: Int -> Int-eighth x = unsafeShiftR x 3--{-# INLINE sixteenth #-}-sixteenth :: Int -> Int-sixteenth x = unsafeShiftR x 4---- | This should not be used in production code.-dumpList :: (Prim a, Storable a) => ArrayList a -> IO (ArrayList a, [a])-dumpList xs@(ArrayList _ len _ _) = do-  marr <- newPrimArray len-  newXs <- dump xs marr 0-  arr <- unsafeFreezePrimArray marr-  return (newXs,primArrayToListN len arr)--primArrayToListN :: forall a. Prim a => Int -> PrimArray a -> [a]-primArrayToListN len arr = go 0-  where-  go :: Int -> [a]-  go !ix = if ix < len-    then indexPrimArray arr ix : go (ix + 1)-    else []- --- | Deletes all elements from the linked list, copying them---   into the buffer specified by the pointer. Returns an---   empty linked list.-dump :: (Prim a, Storable a)-  => ArrayList a -> MutablePrimArray RealWorld a -> Int -> IO (ArrayList a)-dump xs@(ArrayList start len _ ptr) marr ix = do-  copyPtrToMutablePrimArray marr ix (advancePtr ptr start) len-  clear xs---- | Dump the elements into a 'MutablePrimArray', mapping over them---   first. This is a fairly niche function.-dumpMap :: (Storable a, Prim b)-  => ArrayList a -> (a -> b) -> MutablePrimArray RealWorld b -> Int -> IO (ArrayList a)-dumpMap xs@(ArrayList start len _ ptr) f marr ix = do-  let go :: Int -> IO ()-      go !i = if i < len-        then do-          a <- peekElemOff ptr (start + i)-          writePrimArray marr (ix + i) (f a)-        else return ()-  go 0-  clear xs---- | Does not affect the contents of the ArrayList-showDebug :: forall a. (Prim a, Storable a, Show a) => ArrayList a -> IO String-showDebug (ArrayList start len _ ptr) = do-  marr <- newPrimArray len-  copyPtrToMutablePrimArray marr 0 (plusPtr ptr (start * PM.sizeOf (undefined :: a))) len-  arr <- unsafeFreezePrimArray marr-  return (show (primArrayToListN len arr :: [a]))--clear :: Storable a => ArrayList a -> IO (ArrayList a)-clear xs@(ArrayList _ len _ _) = dropL xs len---- | Final consumer of the ArrayList.-free :: ArrayList a -> IO ()-free (ArrayList _ _ _ ptr) = FMA.free ptr-  

@@ -30,6 +30,7 @@   , inlineModifyWithM   ) where +import Initialize import Prelude hiding (lookup) import Foreign.Storable import Foreign.Ptr@@ -49,46 +50,6 @@  data Node k v -class Storable a => Initialize a where-  initialize :: Ptr a -> IO ()-  -- ^ Initialize the memory at a pointer. An implementation-  --   of this function may do nothing, or if the data contains-  --   more pointers, @initialize@ may allocate additional memory.-  initializeElemOff :: Ptr a -> Int -> IO ()-  -- ^ Can be overridden for efficiency-  initializeElemOff ptr ix = do-    initialize (plusPtr ptr (ix * sizeOf (undefined :: a)) :: Ptr a)-  initializeElems :: Ptr a -> Int -> IO ()-  -- ^ Initialize a pointer representing an array with-  --   a given number of elements. This has a default implementation-  --   but may be overriden for efficency.-  initializeElems ptr n = go 0-    where-    go !i = if i < n-      then do-        initialize (plusPtr ptr (i * sizeOf (undefined :: a)) :: Ptr a)-        go (i + 1)-      else return ()--class Storable a => Deinitialize a where-  deinitialize :: Ptr a -> IO ()-  deinitializeElemOff :: Ptr a -> Int -> IO ()-  -- ^ Can be overridden for efficiency-  deinitializeElemOff ptr ix =-    deinitialize (plusPtr ptr (ix * sizeOf (undefined :: a)) :: Ptr a)-  -- ^ Free any memory in the data structure pointed to.-  deinitializeElems :: Ptr a -> Int -> IO ()-  -- ^ Free any memory pointed to by elements of the array.-  --   This has a default implementation-  --   but may be overriden for efficency.-  deinitializeElems ptr n = go 0-    where-    go !i = if i < n-      then do-        deinitialize (plusPtr ptr (i * sizeOf (undefined :: a)) :: Ptr a)-        go (i + 1)-      else return ()- instance Storable (BTree k v) where   sizeOf _ = 2 * sizeOf (undefined :: Int)   alignment _ = alignment (undefined :: Int)@@ -116,103 +77,8 @@     bt <- peek ptr     free bt -newtype Uninitialized a = Uninitialized a-  deriving (Storable)--instance Storable a => Initialize (Uninitialized a) where-  initialize _ = return ()-  initializeElemOff _ _ = return ()-  initializeElems _ _ = return ()--instance Storable a => Deinitialize (Uninitialized a) where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()--instance Initialize Word8 where-  initialize _ = return ()-  initializeElemOff _ _ = return ()-  initializeElems _ _ = return ()--instance Deinitialize Word8 where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()--instance Initialize Word16 where-  initialize _ = return ()-  initializeElemOff _ _ = return ()-  initializeElems _ _ = return ()--instance Deinitialize Word16 where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()--instance Initialize Word64 where-  initialize _ = return ()-  initializeElemOff _ _ = return ()-  initializeElems _ _ = return ()--instance Deinitialize Word64 where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()---instance Initialize Word where-  initialize ptr = poke ptr (0 :: Word)-  initializeElemOff ptr off = pokeElemOff ptr off (0 :: Word)-  initializeElems ptr elemLen = PA.setAddr (ptrToAddr ptr) elemLen (0 :: Word)--instance Deinitialize Word where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()--instance Initialize Int where-  initialize ptr = poke ptr (0 :: Int)-  initializeElemOff ptr off = pokeElemOff ptr off (0 :: Int)-  initializeElems ptr elemLen = PA.setAddr (ptrToAddr ptr) elemLen (0 :: Int)--instance Initialize Int64 where-  initialize ptr = poke ptr (0 :: Int64)-  initializeElemOff ptr off = pokeElemOff ptr off (0 :: Int64)-  initializeElems ptr elemLen = PA.setAddr (ptrToAddr ptr) elemLen (0 :: Int64)- ptrToAddr :: Ptr a -> PA.Addr ptrToAddr (Ptr x) = PA.Addr x--instance Initialize Word32 where-  initialize _ = return ()-  initializeElemOff _ _ = return ()-  initializeElems _ _ = return ()--instance Deinitialize Word32 where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()--instance Deinitialize Int where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()--instance Deinitialize Int64 where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()--instance Initialize Char where-  initialize _ = return ()-  initializeElemOff _ _ = return ()-  initializeElems _ _ = return ()--instance Deinitialize Char where-  deinitialize _ = return ()-  deinitializeElemOff _ _ = return ()-  deinitializeElems _ _ = return ()-  newtype Arr a = Arr { getArr :: Ptr a } data KeysValues k v = KeysValues !(Arr k) !(Arr v)

@@ -44,7 +44,6 @@ import qualified BTree as B import qualified BTree.Linear as BTL import qualified BTree.Store as BTS-import qualified ArrayList as AL import qualified Data.Set as S import qualified Data.Primitive.PrimArray as P @@ -121,18 +120,6 @@   -- , testPropDepth 1050 "large maps with Word16" (over word16SeriesSingles f)   ] -arraylistTests :: [TestTree]-arraylistTests =-  [ testPropDepth 10 "arraylist inserts followed by dump (short)" (over word16Series arrayListInsertions)-  , testPropDepth 150 "arraylist inserts followed by dump (long)" (over word32Series arrayListInsertions)-  , testPropDepth 150 "arraylist inserts followed by repeated pop (long)" (over word32Series pushPop)-  , testPropDepth 50 "arraylist dropWhile" (over word32Series arrayListDropWhile)-  , testPropDepth 50 "insert array" (over word32Series arrayListInsertArray)-  , testPropDepth 100 "insert big array" (over word32Series arrayListInsertBigArray)-  , testPropDepth 100 "insert big arrays" (over word32Series arrayListInsertArrays)-  -- , testPropDepth 150 "arraylist push, pop, twice (long)" (over word32Series pushPopTwice)-  ]- scProps :: TestTree scProps = testGroup "smallcheck"   [ testGroup "unmanaged heap" (smallcheckTests orderingStorable)@@ -141,90 +128,8 @@   -- , testGroup "unmanaged heap nested diverse" (smallcheckTests orderingNestedDiverse)   -- deletion does not work yet   -- , testGroup "unmanaged heap deletions" (smallcheckTests deletionStorable)-  , testGroup "arraylist" arraylistTests   ] -arrayListInsertions :: (Eq a, Show a, Prim a, Storable a) => [a] -> Either String String-arrayListInsertions xs = unsafePerformIO $ AL.with $ \a0 -> do-  a1 <- foldlM AL.pushR a0 xs-  (a2,ys) <- AL.dumpList a1-  return $ (,) a2 $ if xs == ys-    then Right "good"-    else Left ("expected " ++ show xs ++ " but got " ++ show ys)--pushPop :: forall a. (Eq a, Show a, Prim a, Storable a) => [a] -> Either String String-pushPop xs = unsafePerformIO $ AL.with $ \a0 -> do-  a1 <- foldlM AL.pushR a0 xs-  let go :: AL.ArrayList a -> IO (AL.ArrayList a, [a])-      go al = do-        (al',m) <- AL.popL al-        case m of-          Nothing -> return (al',[])-          Just a -> fmap (second (a:)) (go al')-  (a2,ys) <- go a1-  return $ (,) a2 $ if xs == ys-    then Right "good"-    else Left $ "expected " ++ show xs ++ " but got " ++ show ys--arrayListDropWhile :: forall a. (Hashable a, Eq a, Show a, Prim a, Storable a) => [a] -> Either String String-arrayListDropWhile xs = unsafePerformIO $ AL.with $ \a0 ->-  case deterministicShuffle xs of-    [] -> return (a0, Right "good")-    x : _ -> do-     a1 <- foldlM AL.pushR a0 xs-     (a2,_) <- AL.dropWhileL a1 (\y -> return (y /= x))-     (a3,ys) <- AL.dumpList a2-     let expected = L.dropWhile (/= x) xs-     return $ (,) a3 $ if expected == ys-       then Right "good"-       else Left ("expected " ++ show expected ++ " but got " ++ show ys ++ " using pivot of " ++ show x)-  -arrayListInsertArray :: forall a. (Hashable a, Eq a, Show a, Prim a, Storable a)-  => [a] -> Either String String-arrayListInsertArray xs = unsafePerformIO $ AL.with $ \a0 -> do-  a1 <- foldlM AL.pushArrayR a0 (map singletonPrimArray xs)-  let go :: AL.ArrayList a -> IO (AL.ArrayList a, [a])-      go al = do-        (al',m) <- AL.popL al-        case m of-          Nothing -> return (al',[])-          Just a -> fmap (second (a:)) (go al')-  (a2,ys) <- go a1-  return $ (,) a2 $ if xs == ys-    then Right "good"-    else Left $ "expected " ++ show xs ++ " but got " ++ show ys-  -arrayListInsertBigArray :: forall a. (Hashable a, Eq a, Show a, Prim a, Storable a)-  => [a] -> Either String String-arrayListInsertBigArray xs = unsafePerformIO $ AL.with $ \a0 -> do-  a1 <- AL.pushArrayR a0 (fromList xs)-  let go :: AL.ArrayList a -> IO (AL.ArrayList a, [a])-      go al = do-        (al',m) <- AL.popL al-        case m of-          Nothing -> return (al',[])-          Just a -> fmap (second (a:)) (go al')-  (a2,ys) <- go a1-  return $ (,) a2 $ if xs == ys-    then Right "good"-    else Left $ "expected " ++ show xs ++ " but got " ++ show ys--arrayListInsertArrays :: forall a. (Hashable a, Eq a, Show a, Prim a, Storable a)-  => [a] -> Either String String-arrayListInsertArrays xs = unsafePerformIO $ AL.with $ \a0 -> do-  a1 <- AL.pushArrayR a0 (fromList xs)-  a2 <- AL.pushArrayR a1 (fromList xs)-  let go :: AL.ArrayList a -> IO (AL.ArrayList a, [a])-      go al = do-        (al',m) <- AL.popL al-        case m of-          Nothing -> return (al',[])-          Just a -> fmap (second (a:)) (go al')-  (a3,zs) <- go a2-  return $ (,) a3 $ if zs == (xs ++ xs)-    then Right "good"-    else Left $ "expected " ++ show (xs ++ xs) ++ " but got " ++ show zs- unitTests :: TestTree unitTests = testGroup "Unit tests"   [ testCase "put followed by get (tests lookup,insert,toAscList)" $ do@@ -263,12 +168,6 @@           xs' = map (\x -> (x,x)) xs       actual <- return (runST (B.fromList (B.Context (BTL.Context 4)) xs' >>= B.toAscList))       actual @?= S.toAscList (S.fromList xs')-  , testCase "ArrayList dropWhileScanL on empty" $ do-      xs <- AL.new-      (xs',n,r) <- AL.dropWhileScanL xs (55 :: Word32) (\b a -> return (True,b + a))-      n @?= 0-      r @?= 55-      AL.free xs'   ]  testPropDepth :: Testable IO a => Int -> String -> a -> TestTree@@ -343,21 +242,6 @@     then Right "good"     else Left (notice (show expected) (show actual) layout) --- orderingCompact :: (Show n, Ord n, Prim n)---   => Int -- ^ degree of b-tree---   -> [Positive n] -- ^ values to insert---   -> Either Reason Reason--- orderingCompact degree xs' = ---   let xs = map getPositive xs'---       expected = map (\x -> (x,x)) $ S.toAscList $ S.fromList xs---       (actual,layout) = runST $ withToken $ \c -> do---         m0 <- BTC.new c degree---         m1 <- foldlM (\ !m !x -> BTC.insert c m x x) m0 xs---         (,) <$> BTC.toAscList m1 <*> BTC.debugMap m1---   in if actual == expected---     then Right "good"---     else Left (notice (show expected) (show actual) layout)- orderingStorable :: (Hashable x, Show x, Eq x, Ord x, Storable x, BTS.Initialize x, BTS.Deinitialize x)   => [x] -- ^ values to insert   -> Either Reason Reason@@ -371,23 +255,6 @@               else Left (notice (show expected) (show actual) "layout not available")         return (e,m1)    in result---- this does all insertions followed by all deletions--- deletionStorable :: KnownNat n---   => [Padded n] -- ^ values to insert---   -> Either Reason Reason--- deletionStorable xs = ---   let expected = map (\x -> (x,x)) $ S.toAscList $ S.fromList xs---       result = unsafePerformIO $ BTS.with $ \m0 -> do---         m1 <- foldlM (\ !m !x -> BTS.insert m x x) m0 xs---         m2 <- foldlM (\ !m !x -> BTS.delete m x) m1 (deterministicShuffle xs)---         actual <- BTS.toAscList m2---         let e = if actual == []---               then Right "good"---               else Left (notice "empty list" (show actual) "layout not available")---         return (e,m2)---    in result-  -- let us begin the most dangerous game. orderingNested :: (Bounded x, Integral x, Hashable x, Show x, Eq x, Ord x, Storable x, BTS.Initialize x, BTS.Deinitialize x)