diff --git a/library/StmHamt/Constructors/Branch.hs b/library/StmHamt/Constructors/Branch.hs --- a/library/StmHamt/Constructors/Branch.hs +++ b/library/StmHamt/Constructors/Branch.hs @@ -3,7 +3,7 @@ import StmHamt.Prelude import StmHamt.Types import qualified StmHamt.IntOps as IntOps -import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray +import qualified PrimitiveExtras.By6Bits as By6Bits singleton :: Int -> a -> Branch a @@ -18,6 +18,6 @@ in if index1 == index2 then do deeperBranch <- pair (IntOps.nextDepth depth) hash1 branch1 hash2 branch2 - var <- newTVar (SparseSmallArray.singleton index1 deeperBranch) + var <- newTVar (By6Bits.singleton index1 deeperBranch) return (BranchesBranch (Hamt var)) - else BranchesBranch . Hamt <$> newTVar (SparseSmallArray.pair index1 branch1 index2 branch2) + else BranchesBranch . Hamt <$> newTVar (By6Bits.pair index1 branch1 index2 branch2) diff --git a/library/StmHamt/Focuses.hs b/library/StmHamt/Focuses.hs --- a/library/StmHamt/Focuses.hs +++ b/library/StmHamt/Focuses.hs @@ -8,7 +8,7 @@ import Focus import qualified StmHamt.IntOps as IntOps import qualified StmHamt.Constructors.Branch as BranchConstructors -import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray +import qualified PrimitiveExtras.By6Bits as By6Bits import qualified PrimitiveExtras.SmallArray as SmallArray @@ -16,10 +16,10 @@ onBranchElement depth hash testElement elementFocus@(Focus concealElement revealElement) = let ~(Focus concealLeaves revealLeaves) = SmallArray.onFoundElementFocus testElement (const False) elementFocus - branchesVarFocus :: Int -> Focus (TVar (SparseSmallArray (Branch a))) STM b + branchesVarFocus :: Int -> Focus (TVar (By6Bits (Branch a))) STM b branchesVarFocus depth = let !branchIndex = IntOps.indexAtDepth depth hash - in onTVarValue (SparseSmallArray.onElementAtFocus branchIndex (branchFocus ( depth))) + in onTVarValue (By6Bits.onElementAtFocus branchIndex (branchFocus ( depth))) branchFocus :: Int -> Focus (Branch a) STM b branchFocus depth = Focus concealBranch revealBranch where concealBranch = fmap (fmap (fmap (LeavesBranch hash))) concealLeaves @@ -42,13 +42,13 @@ let branchIndex = IntOps.indexAtDepth depth hash Focus concealBranches revealBranches = - SparseSmallArray.onElementAtFocus branchIndex $ + By6Bits.onElementAtFocus branchIndex $ onBranchElement depth hash test focus concealHamt = let hamtChangeStm = \ case Leave -> return Leave Set !branches -> Set . Hamt <$> newTVar branches - Remove -> Set . Hamt <$> newTVar SparseSmallArray.empty + Remove -> Set . Hamt <$> newTVar By6Bits.empty in concealBranches >>= traverse hamtChangeStm revealHamt (Hamt branchesVar) = do branches <- readTVar branchesVar @@ -56,5 +56,5 @@ case branchesChange of Leave -> return (result, Leave) Set !newBranches -> writeTVar branchesVar newBranches $> (result, Leave) - Remove -> writeTVar branchesVar SparseSmallArray.empty $> (result, Leave) + Remove -> writeTVar branchesVar By6Bits.empty $> (result, Leave) in Focus concealHamt revealHamt diff --git a/library/StmHamt/Hamt.hs b/library/StmHamt/Hamt.hs --- a/library/StmHamt/Hamt.hs +++ b/library/StmHamt/Hamt.hs @@ -24,14 +24,14 @@ import qualified StmHamt.ListT as ListT import qualified StmHamt.IntOps as IntOps import qualified PrimitiveExtras.SmallArray as SmallArray -import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray +import qualified PrimitiveExtras.By6Bits as By6Bits new :: STM (Hamt a) -new = Hamt <$> newTVar SparseSmallArray.empty +new = Hamt <$> newTVar By6Bits.empty newIO :: IO (Hamt a) -newIO = Hamt <$> newTVarIO SparseSmallArray.empty +newIO = Hamt <$> newTVarIO By6Bits.empty focus :: (Eq key, Hashable key) => Focus element STM result -> (element -> key) -> key -> Hamt element -> STM result focus focus elementToKey key = focusExplicitly focus (hash key) ((==) key . elementToKey) @@ -62,9 +62,9 @@ !branchIndex = IntOps.indexAtDepth depth hash in do branchArray <- readTVar var - case SparseSmallArray.lookup branchIndex branchArray of + case By6Bits.lookup branchIndex branchArray of Nothing -> do - writeTVar var $! SparseSmallArray.insert branchIndex (LeavesBranch hash (pure element)) branchArray + writeTVar var $! By6Bits.insert branchIndex (LeavesBranch hash (pure element)) branchArray return True Just branch -> case branch of LeavesBranch leavesHash leavesArray -> if leavesHash == hash @@ -72,18 +72,18 @@ Just (leavesIndex, _) -> let !newLeavesArray = SmallArray.set leavesIndex element leavesArray !newBranch = LeavesBranch hash newLeavesArray - !newBranchArray = SparseSmallArray.replace branchIndex newBranch branchArray + !newBranchArray = By6Bits.replace branchIndex newBranch branchArray in do writeTVar var newBranchArray return False Nothing -> let newLeavesArray = SmallArray.cons element leavesArray in do - writeTVar var $! SparseSmallArray.replace branchIndex (LeavesBranch hash newLeavesArray) branchArray + writeTVar var $! By6Bits.replace branchIndex (LeavesBranch hash newLeavesArray) branchArray return True else do hamt <- pair (IntOps.nextDepth depth) hash (LeavesBranch hash (pure element)) leavesHash (LeavesBranch leavesHash leavesArray) - writeTVar var $! SparseSmallArray.replace branchIndex (BranchesBranch hamt) branchArray + writeTVar var $! By6Bits.replace branchIndex (BranchesBranch hamt) branchArray return True BranchesBranch hamt -> loop (IntOps.nextDepth depth) hamt in loop 0 @@ -97,9 +97,9 @@ in if index1 == index2 then do deeperHamt <- pair (IntOps.nextDepth depth) hash1 branch1 hash2 branch2 - var <- newTVar (SparseSmallArray.singleton index1 (BranchesBranch deeperHamt)) + var <- newTVar (By6Bits.singleton index1 (BranchesBranch deeperHamt)) return (Hamt var) - else Hamt <$> newTVar (SparseSmallArray.pair index1 branch1 index2 branch2) + else Hamt <$> newTVar (By6Bits.pair index1 branch1 index2 branch2) {-| Returns a flag, specifying, whether the size has been affected. @@ -115,7 +115,7 @@ !index = IntOps.indexAtDepth depth hash in do branchArray <- readTVar var - case SparseSmallArray.lookup index branchArray of + case By6Bits.lookup index branchArray of Just branch -> case branch of LeavesBranch leavesHash leavesArray -> if leavesHash == hash then return (SmallArray.find test leavesArray) @@ -125,7 +125,7 @@ in loop 0 reset :: Hamt a -> STM () -reset (Hamt branchSsaVar) = writeTVar branchSsaVar SparseSmallArray.empty +reset (Hamt branchSsaVar) = writeTVar branchSsaVar By6Bits.empty unfoldlM :: Hamt a -> UnfoldlM STM a unfoldlM = UnfoldlM.hamtElements @@ -136,7 +136,7 @@ null :: Hamt a -> STM Bool null (Hamt branchSsaVar) = do branchSsa <- readTVar branchSsaVar - return (SparseSmallArray.null branchSsa) + return (By6Bits.null branchSsa) {-| Render the structure of HAMT. @@ -144,7 +144,7 @@ introspect :: Show a => Hamt a -> STM String introspect (Hamt branchArrayVar) = do branchArray <- readTVar branchArrayVar - indexedList <- traverse (traverse introspectBranch) (SparseSmallArray.toIndexedList branchArray) + indexedList <- traverse (traverse introspectBranch) (By6Bits.toIndexedList branchArray) return $ "[" <> intercalate ", " (fmap (\ (i, branchString) -> "(" <> show i <> ", " <> branchString <> ")") indexedList) <> "]" where diff --git a/library/StmHamt/ListT.hs b/library/StmHamt/ListT.hs --- a/library/StmHamt/ListT.hs +++ b/library/StmHamt/ListT.hs @@ -4,11 +4,11 @@ import StmHamt.Types import ListT import qualified PrimitiveExtras.SmallArray as SmallArray -import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray +import qualified PrimitiveExtras.By6Bits as By6Bits hamtElements :: Hamt a -> ListT STM a -hamtElements (Hamt var) = tVarValue var >>= SparseSmallArray.elementsListT >>= branchElements +hamtElements (Hamt var) = tVarValue var >>= By6Bits.elementsListT >>= branchElements branchElements :: Branch a -> ListT STM a branchElements = \ case diff --git a/library/StmHamt/Prelude.hs b/library/StmHamt/Prelude.hs --- a/library/StmHamt/Prelude.hs +++ b/library/StmHamt/Prelude.hs @@ -90,7 +90,7 @@ -- primitive-extras ------------------------- -import PrimitiveExtras.SparseSmallArray as Exports (SparseSmallArray) +import PrimitiveExtras.By6Bits as Exports (By6Bits) -- deferred-folds ------------------------- diff --git a/library/StmHamt/Types.hs b/library/StmHamt/Types.hs --- a/library/StmHamt/Types.hs +++ b/library/StmHamt/Types.hs @@ -13,6 +13,6 @@ {-| STM-specialized Hash Array Mapped Trie. -} -newtype Hamt element = Hamt (TVar (SparseSmallArray (Branch element))) +newtype Hamt element = Hamt (TVar (By6Bits (Branch element))) data Branch element = BranchesBranch !(Hamt element) | LeavesBranch !Int !(SmallArray element) diff --git a/library/StmHamt/UnfoldlM.hs b/library/StmHamt/UnfoldlM.hs --- a/library/StmHamt/UnfoldlM.hs +++ b/library/StmHamt/UnfoldlM.hs @@ -4,11 +4,11 @@ import StmHamt.Types import DeferredFolds.UnfoldlM import qualified PrimitiveExtras.SmallArray as SmallArray -import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray +import qualified PrimitiveExtras.By6Bits as By6Bits hamtElements :: Hamt a -> UnfoldlM STM a -hamtElements (Hamt var) = tVarValue var >>= SparseSmallArray.elementsUnfoldlM >>= branchElements +hamtElements (Hamt var) = tVarValue var >>= By6Bits.elementsUnfoldlM >>= branchElements branchElements :: Branch a -> UnfoldlM STM a branchElements = \ case diff --git a/stm-hamt.cabal b/stm-hamt.cabal --- a/stm-hamt.cabal +++ b/stm-hamt.cabal @@ -1,5 +1,5 @@ name: stm-hamt -version: 1.2.0.4 +version: 1.2.0.5 synopsis: STM-specialised Hash Array Mapped Trie description: A low-level data-structure, @@ -40,7 +40,7 @@ hashable <2, list-t >=1.0.1 && <1.1, primitive >=0.7 && <0.8, - primitive-extras >=0.8 && <0.9, + primitive-extras >=0.9 && <0.10, transformers >=0.5 && <0.6 test-suite test