stm-hamt 1.2.0.4 → 1.2.0.5
raw patch · 8 files changed
+31/−31 lines, 8 filesdep ~primitive-extrasPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: primitive-extras
API changes (from Hackage documentation)
Files
- library/StmHamt/Constructors/Branch.hs +3/−3
- library/StmHamt/Focuses.hs +6/−6
- library/StmHamt/Hamt.hs +14/−14
- library/StmHamt/ListT.hs +2/−2
- library/StmHamt/Prelude.hs +1/−1
- library/StmHamt/Types.hs +1/−1
- library/StmHamt/UnfoldlM.hs +2/−2
- stm-hamt.cabal +2/−2
library/StmHamt/Constructors/Branch.hs view
@@ -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)
library/StmHamt/Focuses.hs view
@@ -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
library/StmHamt/Hamt.hs view
@@ -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
library/StmHamt/ListT.hs view
@@ -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
library/StmHamt/Prelude.hs view
@@ -90,7 +90,7 @@ -- primitive-extras --------------------------import PrimitiveExtras.SparseSmallArray as Exports (SparseSmallArray)+import PrimitiveExtras.By6Bits as Exports (By6Bits) -- deferred-folds -------------------------
library/StmHamt/Types.hs view
@@ -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)
library/StmHamt/UnfoldlM.hs view
@@ -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
stm-hamt.cabal view
@@ -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