diff --git a/library/StmHamt/Hamt.hs b/library/StmHamt/Hamt.hs --- a/library/StmHamt/Hamt.hs +++ b/library/StmHamt/Hamt.hs @@ -12,6 +12,7 @@ lookupExplicitly, reset, unfoldM, + listT, ) where @@ -22,6 +23,7 @@ import qualified StmHamt.Constructors.Hash as HashConstructors import qualified StmHamt.Accessors.Hash as HashAccessors import qualified StmHamt.UnfoldMs as UnfoldMs +import qualified StmHamt.ListT as ListT import qualified PrimitiveExtras.SmallArray as SmallArray import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray @@ -123,6 +125,9 @@ unfoldM :: Hamt a -> UnfoldM STM a unfoldM = UnfoldMs.hamtElements + +listT :: Hamt a -> ListT STM a +listT = ListT.hamtElements null :: Hamt a -> STM Bool null (Hamt branchSsaVar) = do diff --git a/library/StmHamt/ListT.hs b/library/StmHamt/ListT.hs new file mode 100644 --- /dev/null +++ b/library/StmHamt/ListT.hs @@ -0,0 +1,19 @@ +module StmHamt.ListT where + +import StmHamt.Prelude hiding (filter, all) +import StmHamt.Types +import ListT +import qualified PrimitiveExtras.SmallArray as SmallArray +import qualified PrimitiveExtras.SparseSmallArray as SparseSmallArray + + +hamtElements :: Hamt a -> ListT STM a +hamtElements (Hamt var) = tVarValue var >>= SparseSmallArray.elementsListT >>= branchElements + +branchElements :: Branch a -> ListT STM a +branchElements = \ case + LeavesBranch _ array -> SmallArray.elementsListT array + BranchesBranch hamt -> hamtElements hamt + +tVarValue :: TVar a -> ListT STM a +tVarValue var = lift (readTVar var) diff --git a/library/StmHamt/Prelude.hs b/library/StmHamt/Prelude.hs --- a/library/StmHamt/Prelude.hs +++ b/library/StmHamt/Prelude.hs @@ -3,8 +3,8 @@ module Exports, traversePair, modifyTVar', - forMInPositiveRange_, - forMInNegativeRange_, + forMInAscendingRange_, + forMInDescendingRange_, ) where @@ -72,6 +72,10 @@ import Text.Read as Exports (Read(..), readMaybe, readEither) import Unsafe.Coerce as Exports +-- transformers +------------------------- +import Control.Monad.Trans.Class as Exports + -- hashable ------------------------- import Data.Hashable as Exports (Hashable(..)) @@ -93,6 +97,10 @@ import DeferredFolds.Unfold as Exports (Unfold(..)) import DeferredFolds.UnfoldM as Exports (UnfoldM(..)) +-- list-t +------------------------- +import ListT as Exports (ListT(..)) + -- | A replacement for the missing 'Traverse' instance of pair in base < 4.7. {-# INLINE traversePair #-} traversePair :: Functor f => (a -> f b) -> (c, a) -> f (c, b) @@ -105,12 +113,12 @@ x <- readTVar var writeTVar var $! f x -{-# INLINE forMInPositiveRange_ #-} -forMInPositiveRange_ :: Applicative m => Int -> Int -> (Int -> m a) -> m () -forMInPositiveRange_ !startN !endN f = +{-# INLINE forMInAscendingRange_ #-} +forMInAscendingRange_ :: Applicative m => Int -> Int -> (Int -> m a) -> m () +forMInAscendingRange_ !startN !endN f = ($ startN) $ fix $ \loop !n -> if n < endN then f n *> loop (succ n) else pure () -{-# INLINE forMInNegativeRange_ #-} -forMInNegativeRange_ :: Applicative m => Int -> Int -> (Int -> m a) -> m () -forMInNegativeRange_ !startN !endN f = +{-# INLINE forMInDescendingRange_ #-} +forMInDescendingRange_ :: Applicative m => Int -> Int -> (Int -> m a) -> m () +forMInDescendingRange_ !startN !endN f = ($ pred startN) $ fix $ \loop !n -> if n >= endN then f n *> loop (pred n) else pure () diff --git a/stm-hamt.cabal b/stm-hamt.cabal --- a/stm-hamt.cabal +++ b/stm-hamt.cabal @@ -1,49 +1,27 @@ -name: - stm-hamt -version: - 1.1.0.1 -synopsis: - STM-specialised Hash Array Mapped Trie +name: stm-hamt +version: 1.1.1 +synopsis: STM-specialised Hash Array Mapped Trie description: A low-level data-structure, which can be used to implement higher-level interfaces like hash-map and hash-set. Such implementations are presented by . -category: - Data Structures, STM, Concurrency -homepage: - https://github.com/nikita-volkov/stm-hamt -bug-reports: - https://github.com/nikita-volkov/stm-hamt/issues -author: - Nikita Volkov -maintainer: - Nikita Volkov -copyright: - (c) 2016, Nikita Volkov -license: - MIT -license-file: - LICENSE -build-type: - Simple -cabal-version: - >=1.10 - -source-repository head - type: - git - location: - git://github.com/nikita-volkov/stm-hamt.git +category: Data Structures, STM, Concurrency +homepage: https://github.com/nikita-volkov/stm-hamt +bug-reports: https://github.com/nikita-volkov/stm-hamt/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2016, Nikita Volkov +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >=1.10 library - hs-source-dirs: - library - default-extensions: - Arrows, BangPatterns, BinaryLiterals, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 + hs-source-dirs: library + default-extensions: Arrows, BangPatterns, BinaryLiterals, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 exposed-modules: StmHamt.Hamt StmHamt.SizedHamt @@ -55,25 +33,23 @@ StmHamt.Prelude StmHamt.Types StmHamt.UnfoldMs + StmHamt.ListT build-depends: base >=4.6 && <5, deferred-folds >=0.6.5 && <0.7, focus >=1 && <1.1, hashable <2, + list-t >=1.0.1 && <1.1, primitive >=0.6.4 && <0.7, - primitive-extras >=0.6 && <0.7 + primitive-extras >=0.6.6 && <0.7, + transformers >=0.5 && <0.6 test-suite test - type: - exitcode-stdio-1.0 - hs-source-dirs: - test - default-extensions: - Arrows, BangPatterns, BinaryLiterals, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 - main-is: - Main.hs + type: exitcode-stdio-1.0 + hs-source-dirs: test + default-extensions: Arrows, BangPatterns, BinaryLiterals, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 + main-is: Main.hs other-modules: Main.Gens Main.Transaction @@ -89,27 +65,19 @@ tasty-quickcheck >=0.9 && <0.11 benchmark concurrent-insertion-bench - type: - exitcode-stdio-1.0 - hs-source-dirs: - concurrent-insertion-bench - default-extensions: - Arrows, BangPatterns, BinaryLiterals, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 - ghc-options: - -O2 -threaded "-with-rtsopts=-N" - main-is: - Main.hs + type: exitcode-stdio-1.0 + hs-source-dirs: concurrent-insertion-bench + default-extensions: Arrows, BangPatterns, BinaryLiterals, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 + ghc-options: -O2 -threaded "-with-rtsopts=-N" + main-is: Main.hs build-depends: + async >=2.0 && <3, criterion ==1.5.*, - mwc-random >=0.13 && <0.15, - mwc-random-monad ==0.7.*, - -- data: - list-t, focus, - stm-hamt, - -- general: free >=4.5 && <6, - async >=2.0 && <3, - rebase <2 + list-t, + mwc-random >=0.13 && <0.15, + mwc-random-monad ==0.7.*, + rebase <2, + stm-hamt