summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorandrewthad <>2018-06-22 18:07:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-06-22 18:07:00 (GMT)
commit0c6533a0a802d030f934bd2749f8e5fc5a8b7d8a (patch)
tree098941ba88d91801986aa3ce32aec529ce6ca6cc
parente9a1a8113e6b3b1c83291f91de384551e001aa1b (diff)
version 0.5.0HEAD0.5.0master
-rw-r--r--LICENSE.md (renamed from LICENSE)5
-rw-r--r--README.md4
-rw-r--r--Setup.hs2
-rw-r--r--impure-containers.cabal258
-rw-r--r--src/Data/ArrayList/Generic.hs12
-rw-r--r--src/Data/Graph/Immutable.hs19
-rw-r--r--src/Data/Graph/Mutable.hs14
-rw-r--r--src/Data/Graph/Types.hs7
-rw-r--r--src/Data/Graph/Types/Internal.hs23
-rw-r--r--src/Data/HashMap/Mutable/Basic.hs28
-rw-r--r--src/Data/HashMap/Mutable/Internal/Array.hs10
-rw-r--r--src/Data/HashMap/Mutable/Internal/CacheLine.hs9
-rw-r--r--src/Data/HashMap/Mutable/Internal/CheapPseudoRandomBitStream.hs8
-rw-r--r--src/Data/HashMap/Mutable/Internal/IntArray.hs2
-rw-r--r--src/Data/HashMap/Mutable/Internal/Linear/Bucket.hs10
-rw-r--r--src/Data/HashMap/Mutable/Internal/UnsafeTricks.hs8
-rw-r--r--src/Data/HashMap/Mutable/Internal/Utils.hs10
-rw-r--r--src/Data/Heap/Mutable/ModelC.hs36
-rw-r--r--src/Data/Heap/Mutable/ModelD.hs8
-rw-r--r--src/Data/Maybe/Unsafe.hs15
-rw-r--r--src/Data/Primitive/Array/Maybe.hs16
-rw-r--r--src/Data/Primitive/Bool.hs48
-rw-r--r--src/Data/Primitive/MutVar/Maybe.hs17
-rw-r--r--src/Data/Primitive/PrimArray.hs17
-rw-r--r--src/Data/Trie/Immutable/Bits.hs14
-rw-r--r--src/Data/Trie/Mutable/Bits.hs10
-rw-r--r--src/ImpureContainers/MByteArray.hs278
-rw-r--r--src/ImpureContainers/Misc/Mobility.hs32
-rw-r--r--src/ImpureContainers/PrimRef.hs397
-rw-r--r--test/Spec.hs76
30 files changed, 1068 insertions, 325 deletions
diff --git a/LICENSE b/LICENSE.md
index 9beb3f9..467b7ff 100644
--- a/LICENSE
+++ b/LICENSE.md
@@ -1,4 +1,5 @@
-Copyright Andrew Martin (c) 2016
+Copyright Andrew Martin 2016-2018
+Copyright Remy Goldschmidt 2018
All rights reserved.
@@ -27,4 +28,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..218d421
--- /dev/null
+++ b/README.md
@@ -0,0 +1,4 @@
+impure-containers
+=================
+
+Available on [hackage](http://hackage.haskell.org/package/impure-containers).
diff --git a/Setup.hs b/Setup.hs
index 9a994af..4467109 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,2 +1,2 @@
-import Distribution.Simple
+import Distribution.Simple
main = defaultMain
diff --git a/impure-containers.cabal b/impure-containers.cabal
index c8b0fd2..8a8e937 100644
--- a/impure-containers.cabal
+++ b/impure-containers.cabal
@@ -1,142 +1,162 @@
-name: impure-containers
-version: 0.4.3
-synopsis: Mutable containers in haskell
-description: Please see README.md
-homepage: https://github.com/andrewthad/impure-containers#readme
-license: BSD3
-license-file: LICENSE
-author: Andrew Martin
-maintainer: andrew.thaddeus@gmail.com
-copyright: 2016 Andrew Martin
-category: web
-build-type: Simple
-cabal-version: >=1.10
-extra-source-files:
- cbits/Makefile
- , cbits/check.c
- , cbits/defs.h
- , cbits/sse-42-check.c
+--------------------------------------------------------------------------------
+
+name: impure-containers
+version: 0.5.0
+stability: Experimental
+build-type: Simple
+cabal-version: >= 1.10
+category: Data Structures
+copyright: Copyright 2016 Andrew Martin
+ , Copyright 2018 Remy Goldschmidt
+author: Andrew Martin
+maintainer: andrew.thaddeus@gmail.com
+license: BSD3
+license-file: LICENSE.md
+homepage: https://github.com/andrewthad/impure-containers
+bug-reports: https://github.com/andrewthad/impure-containers/issues
+synopsis: Mutable containers in Haskell.
+description: Please see README.md
+extra-source-files: README.md
+ , cbits/Makefile
+ , cbits/check.c
+ , cbits/defs.h
+ , cbits/sse-42-check.c
+tested-with: GHC == 8.0.2
+
+--------------------------------------------------------------------------------
+
+source-repository head
+ type: git
+ tag: master
+ location: https://github.com/andrewthad/impure-containers
+
+--------------------------------------------------------------------------------
+
+flag unsafe-tricks
+ description: If enabled, turn on unsafe GHC tricks.
+ default: True
+
+flag bounds-checking
+ description: If enabled, use bounds-checking array accesses.
+ default: False
+
+flag debug
+ description: If enabled, spew debugging output to stdout.
+ default: False
+
+flag sse42
+ description: If enabled, use SSE 4.2 extensions to search cache
+ lines very efficiently.
+ The portable flag forces this off.
+ default: False
+
+flag portable
+ description: If enabled, use only pure Haskell code and no
+ GHC extensions.
+ default: False
+
+--------------------------------------------------------------------------------
library
- hs-source-dirs: src
- exposed-modules:
- Data.HashMap.Mutable.Basic
- -- Data.Heap.Mutable.ModelA
- -- Data.Heap.Mutable.ModelB
- Data.Heap.Mutable.ModelC
- Data.Heap.Mutable.ModelD
- Data.Graph.Immutable
- Data.Graph.Mutable
- Data.Trie.Mutable.Bits
- Data.Trie.Immutable.Bits
- Data.ArrayList.Generic
- Data.Graph.Types
- Data.Graph.Types.Internal
- Data.Primitive.PrimArray
- Data.Primitive.Array.Maybe
- Data.Primitive.MutVar.Maybe
- Data.Primitive.Bool
- Data.Maybe.Unsafe
- -- Data.Containers.Impure.Internal
- other-modules:
- Data.HashMap.Mutable.Internal.Array
- Data.HashMap.Mutable.Internal.CacheLine
- Data.HashMap.Mutable.Internal.CheapPseudoRandomBitStream
- Data.HashMap.Mutable.Internal.IntArray
- Data.HashMap.Mutable.Internal.Linear.Bucket
- Data.HashMap.Mutable.Internal.UnsafeTricks
- Data.HashMap.Mutable.Internal.Utils
- build-depends:
- base >= 4.8 && < 5
- , hashable >= 1.2 && < 1.3
- , primitive >= 0.6 && < 0.7
- , vector >= 0.11 && < 0.13
- , containers > 0.5 && < 0.6
- , ghc-prim
- default-language: Haskell2010
+ hs-source-dirs: src
+ exposed-modules: Data.HashMap.Mutable.Basic
+ -- , Data.Heap.Mutable.ModelA
+ -- , Data.Heap.Mutable.ModelB
+ , Data.Heap.Mutable.ModelC
+ , Data.Heap.Mutable.ModelD
+ , Data.Graph.Immutable
+ , Data.Graph.Mutable
+ , Data.Trie.Mutable.Bits
+ , Data.Trie.Immutable.Bits
+ , Data.ArrayList.Generic
+ , Data.Graph.Types
+ , Data.Graph.Types.Internal
+ , Data.Primitive.PrimArray
+ , Data.Primitive.Array.Maybe
+ , Data.Primitive.MutVar.Maybe
+ , Data.Primitive.Bool
+ , Data.Maybe.Unsafe
+ -- , Data.Containers.Impure.Internal
+ , ImpureContainers.PrimRef
+ , ImpureContainers.MByteArray
+ , ImpureContainers.Misc.Mobility
+ other-modules: Data.HashMap.Mutable.Internal.Array
+ , Data.HashMap.Mutable.Internal.CacheLine
+ , Data.HashMap.Mutable.Internal.CheapPseudoRandomBitStream
+ , Data.HashMap.Mutable.Internal.IntArray
+ , Data.HashMap.Mutable.Internal.Linear.Bucket
+ , Data.HashMap.Mutable.Internal.UnsafeTricks
+ , Data.HashMap.Mutable.Internal.Utils
+ build-depends: base >= 4.8 && < 5
+ , hashable >= 1.2 && < 1.3
+ , primitive >= 0.6 && < 0.7
+ , vector >= 0.11 && < 0.13
+ , containers > 0.5 && < 0.6
+ , ghc-prim
+ default-language: Haskell2010
if flag(sse42) && !flag(portable)
- cc-options: -DUSE_SSE_4_2 -msse4.2
- cpp-options: -DUSE_SSE_4_2
- C-sources: cbits/sse-42.c
+ cc-options: -DUSE_SSE_4_2 -msse4.2
+ cpp-options: -DUSE_SSE_4_2
+ c-sources: cbits/sse-42.c
if !flag(portable) && !flag(sse42)
- C-sources: cbits/default.c
+ c-sources: cbits/default.c
if !flag(portable)
- C-sources: cbits/common.c
+ c-sources: cbits/common.c
if flag(portable)
- cpp-options: -DNO_C_SEARCH -DPORTABLE
+ cpp-options: -DNO_C_SEARCH -DPORTABLE
if !flag(portable) && flag(unsafe-tricks) && impl(ghc)
- build-depends: ghc-prim
- cpp-options: -DUNSAFETRICKS
+ build-depends: ghc-prim
+ cpp-options: -DUNSAFETRICKS
if flag(debug)
- cpp-options: -DDEBUG
+ cpp-options: -DDEBUG
if flag(bounds-checking)
- cpp-options: -DBOUNDS_CHECKING
-
- -- ghc-prof-options: -prof -auto-all
-
- ghc-options:
- -Wall -fwarn-tabs -funbox-strict-fields
- -fno-warn-unused-do-bind
- -- Turn this one back on later
- -- -O2
-
-Flag unsafe-tricks
- Description: turn on unsafe GHC tricks
- Default: True
+ cpp-options: -DBOUNDS_CHECKING
-Flag bounds-checking
- Description: if on, use bounds-checking array accesses
- Default: False
+ -- ghc-prof-options: -prof -auto-all
-Flag debug
- Description: if on, spew debugging output to stdout
- Default: False
+ ghc-options: -Wall
+ -fwarn-tabs
+ -funbox-strict-fields
+ -fno-warn-unused-do-bind
+ -- -- Turn this one back on later
+ -- -O2
-Flag sse42
- Description: if on, use SSE 4.2 extensions to search cache lines very
- efficiently. The portable flag forces this off.
- Default: False
-
-Flag portable
- Description: if on, use only pure Haskell code and no GHC extensions.
- Default: False
+--------------------------------------------------------------------------------
test-suite impure-containers-test
- type: exitcode-stdio-1.0
- hs-source-dirs: test
- main-is: Spec.hs
- build-depends:
- base
- , impure-containers
- , containers
- , test-framework
- , test-framework-quickcheck2
- , QuickCheck
- , HUnit
- , test-framework-hunit
- , vector
- , transformers
- ghc-options: -threaded -rtsopts -with-rtsopts=-N
- default-language: Haskell2010
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Spec.hs
+ build-depends: base
+ , impure-containers
+ , containers
+ , test-framework
+ , test-framework-quickcheck2
+ , QuickCheck
+ , HUnit
+ , test-framework-hunit
+ , vector
+ , transformers
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ default-language: Haskell2010
+
+--------------------------------------------------------------------------------
benchmark impure-containers-bench
- type: exitcode-stdio-1.0
- hs-source-dirs: bench
- main-is: Main.hs
- build-depends:
- base
- , impure-containers
- , criterion
- ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2
- default-language: Haskell2010
-
-source-repository head
- type: git
- location: https://github.com/andrewthad/impure-containers
+ type: exitcode-stdio-1.0
+ hs-source-dirs: bench
+ main-is: Main.hs
+ build-depends: base
+ , impure-containers
+ , criterion
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2
+ default-language: Haskell2010
+
+--------------------------------------------------------------------------------
diff --git a/src/Data/ArrayList/Generic.hs b/src/Data/ArrayList/Generic.hs
index 57194fa..6f3b97d 100644
--- a/src/Data/ArrayList/Generic.hs
+++ b/src/Data/ArrayList/Generic.hs
@@ -2,15 +2,15 @@
module Data.ArrayList.Generic where
-import Control.Monad.Primitive
-import Data.Vector.Generic.Mutable (MVector)
-import Data.Vector.Generic (Vector, Mutable)
-import Data.Primitive.MutVar
+import Control.Monad.Primitive
+import Data.Primitive.MutVar
+import Data.Vector.Generic (Mutable, Vector)
+import qualified Data.Vector.Generic as GV
+import Data.Vector.Generic.Mutable (MVector)
import qualified Data.Vector.Generic.Mutable as GM
-import qualified Data.Vector.Generic as GV
data ArrayList v s a = ArrayList
- { arrayListSize :: !(MutVar s Int)
+ { arrayListSize :: !(MutVar s Int)
, arrayListVector :: !(MutVar s (v s a))
}
diff --git a/src/Data/Graph/Immutable.hs b/src/Data/Graph/Immutable.hs
index 2cd998d..179eee0 100644
--- a/src/Data/Graph/Immutable.hs
+++ b/src/Data/Graph/Immutable.hs
@@ -56,6 +56,7 @@ import Data.Word
import Control.Monad.ST (runST)
import Data.Primitive.MutVar
import Data.Coerce (coerce)
+import Data.Semigroup (Semigroup)
import qualified Data.Graph.Mutable as Mutable
import qualified Data.ArrayList.Generic as ArrayList
import qualified Data.HashMap.Mutable.Basic as HashTable
@@ -64,6 +65,7 @@ import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
+import qualified Data.Semigroup as SG
-- | Lookup a 'Vertex' by its label.
lookupVertex :: Eq v => v -> Graph g e v -> Maybe (Vertex g)
@@ -85,12 +87,12 @@ mapVertices f (Graph sg) = Graph sg
-- | Map of the edges in the graph.
mapEdges :: (Vertex g -> Vertex g -> e -> d) -> Graph g e v -> Graph g d v
-mapEdges f (Graph (SomeGraph v verts edges)) = Graph $ SomeGraph v verts $
+mapEdges f (Graph (SomeGraph v verts edges)) = Graph $ SomeGraph v verts $
V.imap
( \outerIx edgeVals ->
let vertIxs = V.unsafeIndex verts outerIx
in V.imap
- ( \sourceIx edgeVal ->
+ ( \sourceIx edgeVal ->
let destIx = U.unsafeIndex vertIxs sourceIx
in f (Vertex sourceIx) (Vertex destIx) edgeVal
) edgeVals
@@ -236,7 +238,7 @@ dijkstraDistance :: (Num e, Ord e)
-> Vertex g -- ^ End vertex
-> Graph g e v -- ^ Graph
-> Maybe e
-dijkstraDistance start end g =
+dijkstraDistance start end g =
getMinDistance $ atVertex end
( dijkstra
(\_ _ mdist e -> addMinDistance mdist e)
@@ -259,9 +261,12 @@ instance Ord a => Ord (MinDistance a) where
Nothing -> LT
Just bval -> compare aval bval
+instance Ord a => Semigroup (MinDistance a) where
+ (<>) = min
+
instance Ord a => Monoid (MinDistance a) where
mempty = MinDistance Nothing
- mappend ma mb = min ma mb
+ mappend = (SG.<>)
-- | This is a generalization of Dijkstra\'s algorithm. Like the original,
-- it takes a start 'Vertex' but unlike the original, it does not take
@@ -319,12 +324,12 @@ dijkstra ::
-> t (Vertex g) -- ^ Start vertices
-> Graph g e v -- ^ Graph
-> Graph g e s
-dijkstra f s0 v0 g =
+dijkstra f s0 v0 g =
fst $ runST $ dijkstraGeneral f (\_ _ _ -> return ()) s0 () v0 g
-- Traverse every vertex in the graph and monadically fold
-- their values.
-dijkstraFoldM ::
+dijkstraFoldM ::
(Ord s, Monoid s, Foldable t, PrimMonad m)
=> (v -> v -> s -> e -> s) -- ^ Weight function
-> (v -> s -> x -> m x) -- ^ Monadic fold function
@@ -333,7 +338,7 @@ dijkstraFoldM ::
-> t (Vertex g) -- ^ Start vertices
-> Graph g e v -- ^ Graph
-> m x
-dijkstraFoldM f mf s0 acc v0 g =
+dijkstraFoldM f mf s0 acc v0 g =
fmap snd $ dijkstraGeneral f mf s0 acc v0 g
-- | This is not exported
diff --git a/src/Data/Graph/Mutable.hs b/src/Data/Graph/Mutable.hs
index 5684ede..44c2a2c 100644
--- a/src/Data/Graph/Mutable.hs
+++ b/src/Data/Graph/Mutable.hs
@@ -14,14 +14,14 @@ module Data.Graph.Mutable
, verticesURead
) where
-import Data.Graph.Types.Internal
-import Control.Monad.Primitive
-import qualified Data.Vector.Mutable as MV
+import Control.Monad.Primitive
+import Data.Graph.Types.Internal
+import Data.Hashable (Hashable)
+import qualified Data.HashMap.Mutable.Basic as HashTable
+import Data.Primitive.MutVar
+import qualified Data.Vector.Mutable as MV
+import Data.Vector.Unboxed (Unbox)
import qualified Data.Vector.Unboxed.Mutable as MU
-import Data.Vector.Unboxed (Unbox)
-import Data.Primitive.MutVar
-import Data.Hashable (Hashable)
-import qualified Data.HashMap.Mutable.Basic as HashTable
{- $mutgraph
Operations that mutate a 'MGraph'. Vertices and edges can both be added,
diff --git a/src/Data/Graph/Types.hs b/src/Data/Graph/Types.hs
index 26a0a92..c44e94d 100644
--- a/src/Data/Graph/Types.hs
+++ b/src/Data/Graph/Types.hs
@@ -1,7 +1,6 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE BangPatterns #-}
module Data.Graph.Types
( SomeGraph
, Graph
@@ -15,5 +14,5 @@ module Data.Graph.Types
, STGraph
) where
-import Data.Graph.Types.Internal
+import Data.Graph.Types.Internal
diff --git a/src/Data/Graph/Types/Internal.hs b/src/Data/Graph/Types/Internal.hs
index a6323d4..6527dc8 100644
--- a/src/Data/Graph/Types/Internal.hs
+++ b/src/Data/Graph/Types/Internal.hs
@@ -1,7 +1,6 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}
@@ -16,14 +15,14 @@
--
module Data.Graph.Types.Internal where
-import Data.HashMap.Mutable.Basic (MHashMap)
-import Data.Vector (Vector,MVector)
-import Data.Primitive.MutVar (MutVar)
-import Data.Hashable (Hashable)
-import GHC.Generics (Generic)
-import Control.Monad.ST (RealWorld)
-import qualified Data.Vector.Unboxed as U
+import Control.Monad.ST (RealWorld)
+import Data.Hashable (Hashable)
+import Data.HashMap.Mutable.Basic (MHashMap)
+import Data.Primitive.MutVar (MutVar)
+import Data.Vector (MVector, Vector)
+import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
+import GHC.Generics (Generic)
-- | A 'Graph' with edges labeled by @e@ and vertices labeled by @v@.
-- The @g@ type variable is a phatom type that associates a
@@ -77,8 +76,8 @@ instance Hashable IntPair
-- delete vertices.
data MGraph s g e v = MGraph
{ mgraphVertexIndex :: !(MHashMap s v Int)
- , mgraphCurrentId :: !(MutVar s Int)
- , mgraphEdges :: !(MHashMap s IntPair e)
+ , mgraphCurrentId :: !(MutVar s Int)
+ , mgraphEdges :: !(MHashMap s IntPair e)
}
type IOGraph = MGraph RealWorld
diff --git a/src/Data/HashMap/Mutable/Basic.hs b/src/Data/HashMap/Mutable/Basic.hs
index 4ad5955..701622f 100644
--- a/src/Data/HashMap/Mutable/Basic.hs
+++ b/src/Data/HashMap/Mutable/Basic.hs
@@ -32,26 +32,29 @@ module Data.HashMap.Mutable.Basic
------------------------------------------------------------------------------
-import Control.Exception (assert)
-import Control.Monad hiding (foldM, mapM_)
-import Control.Monad.ST (ST)
-import Control.Monad.Primitive (PrimMonad,PrimState,unsafePrimToPrim)
+import Control.Exception (assert)
+import Control.Monad hiding (foldM, mapM_)
+import Control.Monad.Primitive (PrimMonad, PrimState, unsafePrimToPrim)
+import Control.Monad.ST (ST)
import Data.Bits
-import Data.Hashable (Hashable)
-import qualified Data.Hashable as H
+import Data.Hashable (Hashable)
import Data.Maybe
import Data.Monoid
-import qualified Data.Primitive.ByteArray as A
-import Data.Primitive.MutVar (MutVar,readMutVar,writeMutVar,newMutVar)
+import Data.Primitive.MutVar (MutVar, newMutVar, readMutVar, writeMutVar)
import Data.STRef
+import Data.Semigroup (Semigroup)
import GHC.Exts
-import Prelude hiding (lookup, mapM_, read)
+import Prelude hiding (lookup, mapM_, read)
+import qualified Data.Hashable as H
+import qualified Data.Primitive.ByteArray as A
+import qualified Data.Primitive.ByteArray as A
------------------------------------------------------------------------------
import Data.HashMap.Mutable.Internal.Array
import Data.HashMap.Mutable.Internal.CacheLine
import Data.HashMap.Mutable.Internal.IntArray (Elem)
import qualified Data.HashMap.Mutable.Internal.IntArray as U
import Data.HashMap.Mutable.Internal.Utils
+import qualified Data.Semigroup as SG
------------------------------------------------------------------------------
@@ -364,11 +367,12 @@ data Slot = Slot {
------------------------------------------------------------------------------
+instance Semigroup Slot where
+ Slot x1 b1 <> Slot x2 b2 = if x1 == maxBound then Slot x2 b2 else Slot x1 b1
+
instance Monoid Slot where
mempty = Slot maxBound 0
- (Slot x1 b1) `mappend` (Slot x2 b2) =
- if x1 == maxBound then Slot x2 b2 else Slot x1 b1
-
+ mappend = (SG.<>)
------------------------------------------------------------------------------
-- Returns the slot in the array where it would be safe to write the given key.
diff --git a/src/Data/HashMap/Mutable/Internal/Array.hs b/src/Data/HashMap/Mutable/Internal/Array.hs
index 68905c4..173485e 100644
--- a/src/Data/HashMap/Mutable/Internal/Array.hs
+++ b/src/Data/HashMap/Mutable/Internal/Array.hs
@@ -8,15 +8,15 @@ module Data.HashMap.Mutable.Internal.Array
) where
+import Control.Monad.Primitive (PrimMonad, PrimState)
import Control.Monad.ST
-import Control.Monad.Primitive (PrimMonad,PrimState)
#ifdef BOUNDS_CHECKING
-import qualified Data.Vector.Mutable as M
-import Data.Vector.Mutable (MVector)
+import Data.Vector.Mutable (MVector)
+import qualified Data.Vector.Mutable as M
#else
-import qualified Data.Primitive.Array as M
-import Data.Primitive.Array (MutableArray)
+import Data.Primitive.Array (MutableArray)
+import qualified Data.Primitive.Array as M
#endif
diff --git a/src/Data/HashMap/Mutable/Internal/CacheLine.hs b/src/Data/HashMap/Mutable/Internal/CacheLine.hs
index b481562..4842afe 100644
--- a/src/Data/HashMap/Mutable/Internal/CacheLine.hs
+++ b/src/Data/HashMap/Mutable/Internal/CacheLine.hs
@@ -20,8 +20,9 @@ module Data.HashMap.Mutable.Internal.CacheLine
) where
import Control.Monad
-import Control.Monad.ST (ST)
-import Control.Monad.Primitive (PrimMonad,PrimState,unsafePrimToPrim)
+import Control.Monad.Primitive
+ (PrimMonad, PrimState, unsafePrimToPrim)
+import Control.Monad.ST (ST)
import Data.HashMap.Mutable.Internal.IntArray (Elem, IntArray)
import qualified Data.HashMap.Mutable.Internal.IntArray as M
@@ -31,7 +32,7 @@ import Foreign.C.Types
#else
import Data.Bits
import Data.Int
-import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed as U
import GHC.Int
#endif
@@ -39,7 +40,7 @@ import Data.HashMap.Mutable.Internal.Utils
import GHC.Exts
#if __GLASGOW_HASKELL__ >= 707
-import GHC.Exts (isTrue#)
+import GHC.Exts (isTrue#)
#else
isTrue# :: Bool -> Bool
isTrue# = id
diff --git a/src/Data/HashMap/Mutable/Internal/CheapPseudoRandomBitStream.hs b/src/Data/HashMap/Mutable/Internal/CheapPseudoRandomBitStream.hs
index e0f40ce..ed8ac09 100644
--- a/src/Data/HashMap/Mutable/Internal/CheapPseudoRandomBitStream.hs
+++ b/src/Data/HashMap/Mutable/Internal/CheapPseudoRandomBitStream.hs
@@ -9,11 +9,11 @@ module Data.HashMap.Mutable.Internal.CheapPseudoRandomBitStream
import Control.Applicative
import Control.Monad.ST
-import Data.Bits ((.&.))
+import Data.Bits ((.&.))
import Data.STRef
-import Data.Vector.Unboxed (Vector)
-import qualified Data.Vector.Unboxed as V
-import Data.Word (Word, Word32, Word64)
+import Data.Vector.Unboxed (Vector)
+import qualified Data.Vector.Unboxed as V
+import Data.Word (Word, Word32, Word64)
import Data.HashMap.Mutable.Internal.Utils
diff --git a/src/Data/HashMap/Mutable/Internal/IntArray.hs b/src/Data/HashMap/Mutable/Internal/IntArray.hs
index a9f9590..ee6f6aa 100644
--- a/src/Data/HashMap/Mutable/Internal/IntArray.hs
+++ b/src/Data/HashMap/Mutable/Internal/IntArray.hs
@@ -17,8 +17,8 @@ module Data.HashMap.Mutable.Internal.IntArray
) where
------------------------------------------------------------------------------
+import Control.Monad.Primitive (PrimMonad, PrimState)
import Control.Monad.ST
-import Control.Monad.Primitive (PrimMonad,PrimState)
import Data.Bits
import qualified Data.Primitive.ByteArray as A
import Data.Primitive.Types (Addr (..))
diff --git a/src/Data/HashMap/Mutable/Internal/Linear/Bucket.hs b/src/Data/HashMap/Mutable/Internal/Linear/Bucket.hs
index 438d03a..5c81436 100644
--- a/src/Data/HashMap/Mutable/Internal/Linear/Bucket.hs
+++ b/src/Data/HashMap/Mutable/Internal/Linear/Bucket.hs
@@ -23,16 +23,18 @@ module Data.HashMap.Mutable.Internal.Linear.Bucket
------------------------------------------------------------------------------
-import Control.Monad hiding (foldM, mapM_)
+import Control.Monad hiding
+ (foldM, mapM_)
import qualified Control.Monad
-import Control.Monad.ST (ST)
+import Control.Monad.ST (ST)
#ifdef DEBUG
import Data.HashMap.Mutable.Internal.Utils (unsafeIOToST)
#endif
import Data.HashMap.Mutable.Internal.Array
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe)
import Data.STRef
-import Prelude hiding (lookup, mapM_)
+import Prelude hiding
+ (lookup, mapM_)
------------------------------------------------------------------------------
import Data.HashMap.Mutable.Internal.UnsafeTricks
diff --git a/src/Data/HashMap/Mutable/Internal/UnsafeTricks.hs b/src/Data/HashMap/Mutable/Internal/UnsafeTricks.hs
index cfea119..9ed834c 100644
--- a/src/Data/HashMap/Mutable/Internal/UnsafeTricks.hs
+++ b/src/Data/HashMap/Mutable/Internal/UnsafeTricks.hs
@@ -1,8 +1,6 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
-#ifdef UNSAFETRICKS
{-# LANGUAGE MagicHash #-}
-#endif
module Data.HashMap.Mutable.Internal.UnsafeTricks
( Key
@@ -17,15 +15,15 @@ module Data.HashMap.Mutable.Internal.UnsafeTricks
) where
import Control.Monad.Primitive
-import Data.Vector.Mutable (MVector)
-import qualified Data.Vector.Mutable as M
+import Data.Vector.Mutable (MVector)
+import qualified Data.Vector.Mutable as M
#ifdef UNSAFETRICKS
import GHC.Exts
import GHC.Types
import Unsafe.Coerce
#if __GLASGOW_HASKELL__ >= 707
-import GHC.Exts (isTrue#)
+import GHC.Exts (isTrue#)
#else
isTrue# :: Bool -> Bool
isTrue# = id
diff --git a/src/Data/HashMap/Mutable/Internal/Utils.hs b/src/Data/HashMap/Mutable/Internal/Utils.hs
index cbcbaa6..fea7ff1 100644
--- a/src/Data/HashMap/Mutable/Internal/Utils.hs
+++ b/src/Data/HashMap/Mutable/Internal/Utils.hs
@@ -22,10 +22,10 @@ module Data.HashMap.Mutable.Internal.Utils
, unsafeIOToST
) where
-import Data.Bits hiding (shiftL)
+import Data.Bits hiding (shiftL)
import Data.HashMap.Mutable.Internal.IntArray (Elem)
-import Data.Vector (Vector)
-import qualified Data.Vector as V
+import Data.Vector (Vector)
+import qualified Data.Vector as V
#if __GLASGOW_HASKELL__ >= 503
import GHC.Exts
#else
@@ -34,9 +34,9 @@ import Data.Word
#endif
#if MIN_VERSION_base(4,4,0)
-import Control.Monad.ST.Unsafe (unsafeIOToST)
+import Control.Monad.ST.Unsafe (unsafeIOToST)
#else
-import Control.Monad.ST (unsafeIOToST)
+import Control.Monad.ST (unsafeIOToST)
#endif
------------------------------------------------------------------------------
diff --git a/src/Data/Heap/Mutable/ModelC.hs b/src/Data/Heap/Mutable/ModelC.hs
index a25cf5e..c29a58b 100644
--- a/src/Data/Heap/Mutable/ModelC.hs
+++ b/src/Data/Heap/Mutable/ModelC.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | This module provides a variant of a mutable binary min heap that is used elsewhere to implement
@@ -44,24 +44,24 @@
module Data.Heap.Mutable.ModelC where
-import Control.Monad
-import Control.Monad.Primitive
-import Data.Primitive.MutVar
-import Data.Primitive.Types (sizeOf#)
-import GHC.Types (Int(..))
-import Data.Vector (Vector,MVector)
-import Data.Bits (unsafeShiftL,unsafeShiftR)
-import Data.Word
-import Data.Coerce
-import Data.Vector.Unboxed (Unbox)
-import Data.Primitive.Array
-import Data.Primitive.ByteArray
-import Debug.Trace
-import qualified Data.Primitive.Array as A
-import qualified Data.Vector as V
-import qualified Data.Vector.Mutable as MV
-import qualified Data.Vector.Unboxed as U
+import Control.Monad
+import Control.Monad.Primitive
+import Data.Bits (unsafeShiftL, unsafeShiftR)
+import Data.Coerce
+import Data.Primitive.Array
+import qualified Data.Primitive.Array as A
+import Data.Primitive.ByteArray
+import Data.Primitive.MutVar
+import Data.Primitive.Types (sizeOf#)
+import Data.Vector (MVector, Vector)
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as MV
+import Data.Vector.Unboxed (Unbox)
+import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
+import Data.Word
+import Debug.Trace
+import GHC.Types (Int (..))
{-@ type Positive = {n:Int | n > 0} @-}
diff --git a/src/Data/Heap/Mutable/ModelD.hs b/src/Data/Heap/Mutable/ModelD.hs
index 8918914..f8b620f 100644
--- a/src/Data/Heap/Mutable/ModelD.hs
+++ b/src/Data/Heap/Mutable/ModelD.hs
@@ -1,10 +1,10 @@
module Data.Heap.Mutable.ModelD where
+import Control.Monad
+import Control.Monad.Primitive
import qualified Data.Heap.Mutable.ModelC as I
-import Debug.Trace
-import Data.Primitive.MutVar
-import Control.Monad.Primitive
-import Control.Monad
+import Data.Primitive.MutVar
+import Debug.Trace
data Heap s p = Heap
{ heapRaw :: !(I.RawHeap s p)
diff --git a/src/Data/Maybe/Unsafe.hs b/src/Data/Maybe/Unsafe.hs
index 69b7742..ac26804 100644
--- a/src/Data/Maybe/Unsafe.hs
+++ b/src/Data/Maybe/Unsafe.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE MagicHash, BangPatterns #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
module Data.Maybe.Unsafe (UnsafeMaybe
,just
,nothing
@@ -6,12 +7,12 @@ module Data.Maybe.Unsafe (UnsafeMaybe
,maybe
,toMaybe) where
-import Unsafe.Coerce
-import System.IO.Unsafe
-import System.Mem.StableName
-import GHC.Prim
-import GHC.Types
-import Prelude hiding (maybe)
+import GHC.Prim
+import GHC.Types
+import Prelude hiding (maybe)
+import System.IO.Unsafe
+import System.Mem.StableName
+import Unsafe.Coerce
thunk :: Int -> Int
thunk x = error "bang"
diff --git a/src/Data/Primitive/Array/Maybe.hs b/src/Data/Primitive/Array/Maybe.hs
index 8835743..f0c1fa7 100644
--- a/src/Data/Primitive/Array/Maybe.hs
+++ b/src/Data/Primitive/Array/Maybe.hs
@@ -1,23 +1,23 @@
{-# LANGUAGE MagicHash #-}
-- | This uses some unsafe hackery.
-module Data.Primitive.Array.Maybe
+module Data.Primitive.Array.Maybe
( MutableMaybeArray
, newMaybeArray
, readMaybeArray
, writeMaybeArray
) where
-import Control.Monad.Primitive
-import Data.Primitive.Array
-import GHC.Prim (reallyUnsafePtrEquality#)
-import GHC.Exts (Any)
-import Unsafe.Coerce (unsafeCoerce)
+import Control.Monad.Primitive
+import Data.Primitive.Array
+import GHC.Exts (Any)
+import GHC.Prim (reallyUnsafePtrEquality#)
+import Unsafe.Coerce (unsafeCoerce)
newtype MutableMaybeArray s a = MutableMaybeArray (MutableArray s Any)
unsafeToMaybe :: Any -> Maybe a
-unsafeToMaybe a =
+unsafeToMaybe a =
case reallyUnsafePtrEquality# a nothingSurrogate of
0# -> Just (unsafeCoerce a)
_ -> Nothing
@@ -32,7 +32,7 @@ newMaybeArray i ma = case ma of
Just a -> do
x <- newArray i (unsafeCoerce a)
return (MutableMaybeArray x)
- Nothing -> do
+ Nothing -> do
x <- newArray i nothingSurrogate
return (MutableMaybeArray x)
diff --git a/src/Data/Primitive/Bool.hs b/src/Data/Primitive/Bool.hs
index 2767cbc..86adec7 100644
--- a/src/Data/Primitive/Bool.hs
+++ b/src/Data/Primitive/Bool.hs
@@ -1,15 +1,15 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
-module Data.Primitive.Bool
+module Data.Primitive.Bool
( BoolByte(..)
) where
-import Data.Primitive.Types
+import Data.Primitive.Types
import qualified Data.Primitive.Types as P
-import Data.Word
-import GHC.Prim
-import GHC.Types (Int(..))
+import Data.Word
+import GHC.Prim
+import GHC.Types (Int (..))
{-@ data BoolByte = BoolByte { getBoolByte :: Bool } @-}
newtype BoolByte = BoolByte { getBoolByte :: Bool }
@@ -40,28 +40,28 @@ fromBool (BoolByte b) = case b of
instance Prim BoolByte where
sizeOf# _ = 1#
alignment# _ = 1#
- indexByteArray# arr# i# = toBool# (indexWord8Array# arr# i#)
- readByteArray# arr# i# s# =
- case readWord8Array# arr# i# s# of
- { (# s1#, x# #) -> (# s1#, toBool# x# #) }
- writeByteArray# arr# i# b s# =
- writeWord8Array# arr# i# (fromBool# b) s#
+ indexByteArray# arr# i# = toBool# (indexWord8Array# arr# i#)
+ readByteArray# arr# i# s# =
+ case readWord8Array# arr# i# s# of
+ { (# s1#, x# #) -> (# s1#, toBool# x# #) }
+ writeByteArray# arr# i# b s# =
+ writeWord8Array# arr# i# (fromBool# b) s#
setByteArray# arr# i# n# b s# = P.setByteArray# arr# i# n# (fromBool b) s#
indexOffAddr# addr# i# = toBool (indexOffAddr# addr# i#)
- readOffAddr# addr# i# s# =
+ readOffAddr# addr# i# s# =
case readOffAddr# addr# i# s# of
(# s1#, w #) -> (# s1#, toBool w #)
writeOffAddr# addr# i# b s# = writeOffAddr# addr# i# (fromBool b) s#
- setOffAddr# addr# i# n# b s# =
+ setOffAddr# addr# i# n# b s# =
setOffAddr# addr# i# n# (fromBool b) s#
- {-# INLINE sizeOf# #-}
- {-# INLINE alignment# #-}
- {-# INLINE indexByteArray# #-}
- {-# INLINE readByteArray# #-}
- {-# INLINE writeByteArray# #-}
- {-# INLINE setByteArray# #-}
- {-# INLINE indexOffAddr# #-}
- {-# INLINE readOffAddr# #-}
- {-# INLINE writeOffAddr# #-}
- {-# INLINE setOffAddr# #-}
+ {-# INLINE sizeOf# #-}
+ {-# INLINE alignment# #-}
+ {-# INLINE indexByteArray# #-}
+ {-# INLINE readByteArray# #-}
+ {-# INLINE writeByteArray# #-}
+ {-# INLINE setByteArray# #-}
+ {-# INLINE indexOffAddr# #-}
+ {-# INLINE readOffAddr# #-}
+ {-# INLINE writeOffAddr# #-}
+ {-# INLINE setOffAddr# #-}
diff --git a/src/Data/Primitive/MutVar/Maybe.hs b/src/Data/Primitive/MutVar/Maybe.hs
index e9493c5..dd54d99 100644
--- a/src/Data/Primitive/MutVar/Maybe.hs
+++ b/src/Data/Primitive/MutVar/Maybe.hs
@@ -1,21 +1,20 @@
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
-module Data.Primitive.MutVar.Maybe
+module Data.Primitive.MutVar.Maybe
( MutMaybeVar
, newMutMaybeVar
, readMutMaybeVar
, writeMutMaybeVar
) where
-import Data.Primitive.MutVar
-import Control.Monad.Primitive
+import Control.Monad.Primitive
+import Data.Primitive.MutVar
-import Unsafe.Coerce
-import GHC.Prim
-import GHC.Types
+import GHC.Prim
+import GHC.Types
+import Unsafe.Coerce
-import Data.Maybe
+import Data.Maybe
newtype MutMaybeVar s a = MutMaybeVar (MutVar s Any)
diff --git a/src/Data/Primitive/PrimArray.hs b/src/Data/Primitive/PrimArray.hs
index a4bef61..4e2bc1b 100644
--- a/src/Data/Primitive/PrimArray.hs
+++ b/src/Data/Primitive/PrimArray.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
-module Data.Primitive.PrimArray
+module Data.Primitive.PrimArray
( MutablePrimArray(..)
, newPrimArray
, readPrimArray
@@ -10,11 +10,12 @@ module Data.Primitive.PrimArray
, setPrimArray
) where
-import Control.Monad.Primitive
-import Data.Primitive.ByteArray
-import Data.Primitive.Types
-import GHC.Prim (newByteArray#,quotInt#,sizeofMutableByteArray#,(*#))
-import GHC.Types (Int(..))
+import Control.Monad.Primitive
+import Data.Primitive.ByteArray
+import Data.Primitive.Types
+import GHC.Prim
+ (newByteArray#, quotInt#, sizeofMutableByteArray#, (*#))
+import GHC.Types (Int (..))
newtype MutablePrimArray s a = MutablePrimArray (MutableByteArray s)
@@ -39,7 +40,7 @@ sizeofMutablePrimArray p@(MutablePrimArray (MutableByteArray arr#)) =
{-# INLINE sizeofMutablePrimArray #-}
setPrimArray
- :: (Prim a, PrimMonad m)
+ :: (Prim a, PrimMonad m)
=> MutablePrimArray (PrimState m) a -- ^ array to fill
-> Int -- ^ offset into array
-> Int -- ^ number of values to fill
diff --git a/src/Data/Trie/Immutable/Bits.hs b/src/Data/Trie/Immutable/Bits.hs
index a54c0d6..fe46b47 100644
--- a/src/Data/Trie/Immutable/Bits.hs
+++ b/src/Data/Trie/Immutable/Bits.hs
@@ -7,13 +7,13 @@ module Data.Trie.Immutable.Bits
, freeze
) where
-import Prelude hiding (lookup)
-import Control.Monad.Primitive
-import Data.Bits
-import Data.Primitive.ByteArray
-import Data.Primitive.MutVar.Maybe
-import Data.Trie.Mutable.Bits (MTrie(..))
-import Data.Maybe.Unsafe
+import Control.Monad.Primitive
+import Data.Bits
+import Data.Maybe.Unsafe
+import Data.Primitive.ByteArray
+import Data.Primitive.MutVar.Maybe
+import Data.Trie.Mutable.Bits (MTrie (..))
+import Prelude hiding (lookup)
data Trie k v = Trie
{ trieValue :: !(UnsafeMaybe v)
diff --git a/src/Data/Trie/Mutable/Bits.hs b/src/Data/Trie/Mutable/Bits.hs
index 0e6fa6e..fb51db9 100644
--- a/src/Data/Trie/Mutable/Bits.hs
+++ b/src/Data/Trie/Mutable/Bits.hs
@@ -8,11 +8,11 @@ module Data.Trie.Mutable.Bits
, insertPrefix
) where
-import Prelude hiding (lookup)
-import Control.Monad.Primitive
-import Data.Bits
-import Data.Primitive.ByteArray
-import Data.Primitive.MutVar.Maybe
+import Control.Monad.Primitive
+import Data.Bits
+import Data.Primitive.ByteArray
+import Data.Primitive.MutVar.Maybe
+import Prelude hiding (lookup)
data MTrie s k v = MTrie
{ mtrieValue :: !(MutMaybeVar s v)
diff --git a/src/ImpureContainers/MByteArray.hs b/src/ImpureContainers/MByteArray.hs
new file mode 100644
index 0000000..0013bb2
--- /dev/null
+++ b/src/ImpureContainers/MByteArray.hs
@@ -0,0 +1,278 @@
+--------------------------------------------------------------------------------
+
+{-# LANGUAGE MagicHash #-}
+
+--------------------------------------------------------------------------------
+
+-- | FIXME: doc
+module ImpureContainers.MByteArray
+ ( -- * 'MByteArray'
+ MByteArray
+ , underlyingMutableByteArray#
+
+ -- ** Creation
+ , new, newPinned, newAlignedPinned
+
+ -- ** Element access
+ , read, write
+
+ -- ** Freezing and thawing
+ , unsafeFreeze, unsafeThaw
+
+ -- ** Block operations
+ , copyFromIByteArray
+ , copyFromMByteArray
+ , move
+ , set
+ , fill
+
+ -- ** Information
+ , sizeof
+ , same
+ , contents
+ ) where
+
+--------------------------------------------------------------------------------
+
+import Prelude ()
+
+import Data.Bool (Bool)
+import Data.Int (Int)
+import Data.Word (Word8)
+
+import Control.Monad.Primitive
+import Data.Coerce (coerce)
+import Data.Primitive (Addr, Prim)
+import qualified Data.Primitive
+
+import qualified GHC.Prim
+
+--------------------------------------------------------------------------------
+
+-- | FIXME: doc
+type MByteArray s = Data.Primitive.MutableByteArray s
+
+-- | FIXME: doc
+type IByteArray = Data.Primitive.ByteArray
+
+--------------------------------------------------------------------------------
+
+-- | FIXME: doc
+underlyingMutableByteArray#
+ :: MByteArray s
+ -- ^ FIXME: doc
+ -> GHC.Prim.MutableByteArray# s
+ -- ^ FIXME: doc
+underlyingMutableByteArray# (Data.Primitive.MutableByteArray mba) = mba
+{-# INLINE underlyingMutableByteArray# #-}
+
+--------------------------------------------------------------------------------
+
+-- | Create a new mutable byte array of the specified size in bytes.
+new
+ :: (PrimMonad m)
+ => Int
+ -- ^ FIXME: doc
+ -> m (MByteArray (PrimState m))
+ -- ^ FIXME: doc
+new = Data.Primitive.newByteArray
+{-# INLINE new #-}
+
+-- | Create a /pinned/ byte array of the specified size in bytes.
+-- The garbage collector is guaranteed not to move it.
+newPinned
+ :: (PrimMonad m)
+ => Int
+ -- ^ FIXME: doc
+ -> m (MByteArray (PrimState m))
+ -- ^ FIXME: doc
+newPinned = Data.Primitive.newPinnedByteArray
+{-# INLINE newPinned #-}
+
+-- | Create a /pinned/ byte array of the specified size in bytes and with the
+-- give alignment. The garbage collector is guaranteed not to move it.
+newAlignedPinned
+ :: (PrimMonad m)
+ => Int
+ -- ^ FIXME: doc
+ -> Int
+ -- ^ FIXME: doc
+ -> m (MByteArray (PrimState m))
+ -- ^ FIXME: doc
+newAlignedPinned = Data.Primitive.newAlignedPinnedByteArray
+{-# INLINE newAlignedPinned #-}
+
+-- | Yield a pointer to the array's data.
+-- This operation is only safe on /pinned/ byte arrays allocated by
+-- 'newPinnedByteArray' or 'newAlignedPinnedByteArray'.
+contents
+ :: MByteArray s
+ -- ^ FIXME: doc
+ -> Addr
+ -- ^ FIXME: doc
+contents = Data.Primitive.mutableByteArrayContents
+{-# INLINE contents #-}
+
+-- | Check if the two arrays refer to the same memory block.
+same
+ :: MByteArray s
+ -- ^ FIXME: doc
+ -> MByteArray s
+ -- ^ FIXME: doc
+ -> Bool
+ -- ^ FIXME: doc
+same = Data.Primitive.sameMutableByteArray
+{-# INLINE same #-}
+
+-- | Convert a mutable byte array to an immutable one without copying.
+-- The array should not be modified after the conversion.
+unsafeFreeze
+ :: (PrimMonad m)
+ => MByteArray (PrimState m)
+ -- ^ FIXME: doc
+ -> m IByteArray
+ -- ^ FIXME: doc
+unsafeFreeze = Data.Primitive.unsafeFreezeByteArray
+{-# INLINE unsafeFreeze #-}
+
+-- | Convert an immutable byte array to a mutable one without copying. The
+-- original array should not be used after the conversion.
+unsafeThaw
+ :: (PrimMonad m)
+ => IByteArray
+ -- ^ FIXME: doc
+ -> m (MByteArray (PrimState m))
+ -- ^ FIXME: doc
+unsafeThaw = Data.Primitive.unsafeThawByteArray
+{-# INLINE unsafeThaw #-}
+
+-- | Size of the mutable byte array in bytes.
+sizeof
+ :: MByteArray s
+ -- ^ FIXME: doc
+ -> Int
+ -- ^ FIXME: doc
+sizeof = Data.Primitive.sizeofMutableByteArray
+{-# INLINE sizeof #-}
+
+-- | Read a primitive value from the byte array. The offset is given in
+-- elements of type @a@ rather than in bytes.
+read
+ :: (Prim a, PrimMonad m)
+ => MByteArray (PrimState m)
+ -- ^ FIXME: doc
+ -> Int
+ -- ^ FIXME: doc
+ -> m a
+ -- ^ FIXME: doc
+read = Data.Primitive.readByteArray
+{-# INLINE read #-}
+
+-- | Write a primitive value to the byte array. The offset is given in
+-- elements of type @a@ rather than in bytes.
+write
+ :: (Prim a, PrimMonad m)
+ => MByteArray (PrimState m)
+ -- ^ FIXME: doc
+ -> Int
+ -- ^ FIXME: doc
+ -> a
+ -- ^ FIXME: doc
+ -> m ()
+ -- ^ FIXME: doc
+write = Data.Primitive.writeByteArray
+{-# INLINE write #-}
+
+-- | Copy a slice of an immutable byte array to a mutable byte array.
+copyFromIByteArray
+ :: (PrimMonad m)
+ => MByteArray (PrimState m)
+ -- ^ [FIXME: doc] destination array
+ -> Int
+ -- ^ [FIXME: doc] offset into destination array
+ -> IByteArray
+ -- ^ [FIXME: doc] source array
+ -> Int
+ -- ^ [FIXME: doc] offset into source array
+ -> Int
+ -- ^ [FIXME: doc] number of bytes to copy
+ -> m ()
+ -- ^ FIXME: doc
+copyFromIByteArray = Data.Primitive.copyByteArray
+{-# INLINE copyFromIByteArray #-}
+
+-- | Copy a slice of a mutable byte array into another array.
+-- The two slices must not overlap.
+copyFromMByteArray
+ :: (PrimMonad m)
+ => MByteArray (PrimState m)
+ -- ^ [FIXME: doc] destination array
+ -> Int
+ -- ^ [FIXME: doc] offset into destination array
+ -> MByteArray (PrimState m)
+ -- ^ [FIXME: doc] source array
+ -> Int
+ -- ^ [FIXME: doc] offset into source array
+ -> Int
+ -- ^ [FIXME: doc] number of bytes to copy
+ -> m ()
+ -- ^ FIXME: doc
+copyFromMByteArray = Data.Primitive.copyMutableByteArray
+{-# INLINE copyFromMByteArray #-}
+
+-- | Copy a slice of a mutable byte array into another array.
+-- The given arrays are allowed to overlap.
+move
+ :: (PrimMonad m)
+ => MByteArray (PrimState m)
+ -- ^ [FIXME: doc] destination array
+ -> Int
+ -- ^ [FIXME: doc] offset into destination array
+ -> MByteArray (PrimState m)
+ -- ^ [FIXME: doc] source array
+ -> Int
+ -- ^ [FIXME: doc] offset into source array
+ -> Int
+ -- ^ [FIXME: doc] number of bytes to copy
+ -> m ()
+ -- ^ FIXME: doc
+move = Data.Primitive.moveByteArray
+{-# INLINE move #-}
+
+-- | Fill a slice of a mutable byte array with a value.
+--
+-- The offset and length parameters are given as a number of elements
+-- of type @a@ rather than in bytes. In other words, the offset and length
+-- work like C arrays, rather than like C pointers.
+set
+ :: (Prim a, PrimMonad m)
+ => MByteArray (PrimState m)
+ -- ^ [FIXME: doc] array to fill
+ -> Int
+ -- ^ [FIXME: doc] offset into array
+ -> Int
+ -- ^ [FIXME: doc] number of values to fill
+ -> a
+ -- ^ [FIXME: doc] value to fill with
+ -> m ()
+ -- ^ FIXME: doc
+set = Data.Primitive.setByteArray
+{-# INLINE set #-}
+
+-- | Fill a slice of a mutable byte array with a byte.
+fill
+ :: (PrimMonad m)
+ => MByteArray (PrimState m)
+ -- ^ [FIXME: doc] array to fill
+ -> Int
+ -- ^ [FIXME: doc] offset into array
+ -> Int
+ -- ^ [FIXME: doc] number of bytes to fill
+ -> Word8
+ -- ^ [FIXME: doc] byte to fill with
+ -> m ()
+ -- ^ FIXME: doc
+fill = Data.Primitive.fillByteArray
+{-# INLINE fill #-}
+
+--------------------------------------------------------------------------------
diff --git a/src/ImpureContainers/Misc/Mobility.hs b/src/ImpureContainers/Misc/Mobility.hs
new file mode 100644
index 0000000..7eb65ba
--- /dev/null
+++ b/src/ImpureContainers/Misc/Mobility.hs
@@ -0,0 +1,32 @@
+--------------------------------------------------------------------------------
+
+{-# LANGUAGE DataKinds #-}
+
+--------------------------------------------------------------------------------
+
+-- | FIXME: doc
+module ImpureContainers.Misc.Mobility
+ ( Mobility (Mobile, Pinned)
+ , M
+ , P
+ ) where
+
+--------------------------------------------------------------------------------
+
+-- | FIXME: doc
+data Mobility
+ = -- | FIXME: doc
+ Mobile
+ | -- | FIXME: doc
+ Pinned
+ deriving (Eq, Ord, Enum, Bounded, Show, Read)
+
+--------------------------------------------------------------------------------
+
+-- | FIXME: doc
+type M = 'Mobile
+
+-- | FIXME: doc
+type P = 'Pinned
+
+--------------------------------------------------------------------------------
diff --git a/src/ImpureContainers/PrimRef.hs b/src/ImpureContainers/PrimRef.hs
new file mode 100644
index 0000000..b629c96
--- /dev/null
+++ b/src/ImpureContainers/PrimRef.hs
@@ -0,0 +1,397 @@
+--------------------------------------------------------------------------------
+
+-- License:
+-- Copyright 2015 Edward Kmett
+-- Copyright 2018 Remy Goldschmidt
+--
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+--
+-- 1. Redistributions of source code must retain the above copyright
+-- notice, this list of conditions and the following disclaimer.
+--
+-- 2. Redistributions in binary form must reproduce the above copyright
+-- notice, this list of conditions and the following disclaimer in the
+-- documentation and/or other materials provided with the distribution.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+--------------------------------------------------------------------------------
+
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE Unsafe #-}
+
+--------------------------------------------------------------------------------
+
+-- | Unboxed primitive references.
+--
+-- Note: Edward Kmett wrote everything in this module. It was sitting
+-- unpackaged on GitHub, so I took it and published it as a part of
+-- this package.
+module ImpureContainers.PrimRef
+ ( -- * 'PrimRef'
+ PrimRef
+
+ -- ** Creation
+ , new
+ , newPinned
+ , newAlignedPinned
+
+ -- ** Simple functions
+ , read
+ , write
+ , contents
+
+ -- ** Atomic mutators
+ , atomicReadInt
+ , atomicWriteInt
+ , casInt
+ , fetchAddInt
+ , fetchSubInt
+ , fetchAndInt
+ , fetchNandInt
+ , fetchOrInt
+ , fetchXorInt
+
+ -- ** Unsafe functions
+ , unsafeToMByteArray
+ , unsafeFromMByteArray
+ ) where
+
+--------------------------------------------------------------------------------
+
+import Prelude ()
+
+import Control.Applicative (pure)
+import Data.Eq (Eq ((==)))
+import Data.Function (($))
+
+import Control.Monad.Primitive
+ (PrimMonad, PrimState, primitive, primitive_)
+
+import Data.Primitive (Addr, Prim, alignment, sizeOf)
+
+import qualified GHC.Prim as GHC.Prim
+import GHC.Types (Int (I#))
+
+import ImpureContainers.MByteArray (MByteArray)
+import qualified ImpureContainers.MByteArray as MByteArray
+
+--------------------------------------------------------------------------------
+
+-- FIXME: when GHC supports creating newtypes in kind #, we should create a
+-- type called PrimRef# to reduce indirections even further.
+-- see https://ghc.haskell.org/trac/ghc/ticket/1311 for progress.
+
+-- | FIXME: doc
+newtype PrimRef s a
+ = MkPrimRef (MByteArray s)
+
+type role PrimRef nominal nominal
+
+--------------------------------------------------------------------------------
+
+-- | Create a primitive reference.
+new
+ :: (PrimMonad m, Prim a)
+ => a
+ -- ^ FIXME: doc
+ -> m (PrimRef (PrimState m) a)
+ -- ^ FIXME: doc
+new a = do
+ m <- MByteArray.new (sizeOf a)
+ MByteArray.write m 0 a
+ pure (MkPrimRef m)
+{-# INLINE new #-}
+
+-- | Create a pinned primitive reference.
+newPinned
+ :: (PrimMonad m, Prim a)
+ => a
+ -- ^ FIXME: doc
+ -> m (PrimRef (PrimState m) a)
+ -- ^ FIXME: doc
+newPinned a = do
+ m <- MByteArray.newPinned (sizeOf a)
+ MByteArray.write m 0 a
+ pure (MkPrimRef m)
+{-# INLINE newPinned #-}
+
+-- | Create a pinned primitive reference with the appropriate alignment for
+-- its contents.
+newAlignedPinned
+ :: (PrimMonad m, Prim a)
+ => a
+ -- ^ FIXME: doc
+ -> m (PrimRef (PrimState m) a)
+ -- ^ FIXME: doc
+newAlignedPinned a = do
+ m <- MByteArray.newAlignedPinned (sizeOf a) (alignment a)
+ MByteArray.write m 0 a
+ pure (MkPrimRef m)
+{-# INLINE newAlignedPinned #-}
+
+-- | Read a primitive value from the reference
+read
+ :: (PrimMonad m, Prim a)
+ => PrimRef (PrimState m) a
+ -- ^ FIXME: doc
+ -> m a
+ -- ^ FIXME: doc
+read (MkPrimRef m) = MByteArray.read m 0
+{-# INLINE read #-}
+
+-- | Write a primitive value to the reference
+write
+ :: (PrimMonad m, Prim a)
+ => PrimRef (PrimState m) a
+ -- ^ FIXME: doc
+ -> a
+ -- ^ FIXME: doc
+ -> m ()
+ -- ^ FIXME: doc
+write (MkPrimRef m) a = MByteArray.write m 0 a
+{-# INLINE write #-}
+
+-- | FIXME: doc
+instance Eq (PrimRef s a) where
+ (MkPrimRef m) == (MkPrimRef n) = MByteArray.same m n
+ {-# INLINE (==) #-}
+
+-- | Yield a pointer to the data of a 'PrimRef'.
+--
+-- This operation is only safe on pinned byte arrays allocated by
+-- 'newPinned' or 'newAlignedPinned'.
+contents
+ :: PrimRef s a
+ -- ^ FIXME: doc
+ -> Addr
+ -- ^ FIXME: doc
+contents (MkPrimRef m) = MByteArray.contents m
+{-# INLINE contents #-}
+
+--------------------------------------------------------------------------------
+
+-- | Given a reference, read an element.
+--
+-- Implies a full memory barrier.
+atomicReadInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> m Int
+ -- ^ A 'PrimMonad' action that reads the primitive reference and returns
+ -- its current value as an 'Int'.
+atomicReadInt (MkPrimRef mba) = primitive $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ case GHC.Prim.atomicReadIntArray# m 0# s of
+ (# s', result #) -> (# s', I# result #)
+
+-- | Given a reference, write an element.
+--
+-- Implies a full memory barrier.
+atomicWriteInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> Int
+ -- ^ The new value the primitive reference should take on.
+ -> m ()
+ -- ^ A 'PrimMonad' action that writes the given 'Int' to the given
+ -- primitive reference.
+atomicWriteInt (MkPrimRef mba) (I# x) = primitive_ $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ GHC.Prim.atomicWriteIntArray# m 0# x s
+
+-- | Given a primitive reference, the expected old value, and the new value,
+-- perform an atomic compare-and-swap, i.e.: write the new value if the
+-- current value matches the provided old value.
+--
+-- Returns the value of the element before the operation.
+--
+-- Implies a full memory barrier.
+casInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> Int
+ -- ^ The expected old value.
+ -> Int
+ -- ^ The new value.
+ -> m Int
+ -- ^ A 'PrimMonad' action that atomically writes the new value to the
+ -- primitive reference if the current value matches the expected old value,
+ -- and then returns the old value of the primitive reference.
+casInt (MkPrimRef mba) (I# oldValue) (I# newValue) = primitive $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ case GHC.Prim.casIntArray# m 0# oldValue newValue s of
+ (# s', result #) -> (# s', I# result #)
+
+-- | Given a reference, and a value to add, atomically add the value to the
+-- element.
+--
+-- Returns the value of the element before the operation.
+--
+-- Implies a full memory barrier.
+fetchAddInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> Int
+ -- ^ An 'Int' to add to the current value of the primitive reference.
+ -> m Int
+ -- ^ A 'PrimMonad' action that atomically sets the value of the given
+ -- primitive reference to the result of adding the given 'Int' to its
+ -- current value, and then returns the value the primitive reference
+ -- had before this modification.
+fetchAddInt (MkPrimRef mba) (I# x) = primitive $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ case GHC.Prim.fetchAddIntArray# m 0# x s of
+ (# s', result #) -> (# s', I# result #)
+
+-- | Given a reference and a value to subtract, atomically subtract the value
+-- from the element.
+--
+-- Returns the value of the element before the operation.
+--
+-- Implies a full memory barrier.
+fetchSubInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> Int
+ -- ^ An 'Int' to subtract from the current value of the primitive reference.
+ -> m Int
+ -- ^ A 'PrimMonad' action that atomically sets the value of the given
+ -- primitive reference to the result of subtracting the given 'Int' from
+ -- its current value, and then returns the value the primitive reference
+ -- had before this modification.
+fetchSubInt (MkPrimRef mba) (I# x) = primitive $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ case GHC.Prim.fetchSubIntArray# m 0# x s of
+ (# s', result #) -> (# s', I# result #)
+
+-- | Given a reference and a value with which to bitwise AND, atomically AND
+-- the value with the element.
+--
+-- Returns the value of the element before the operation.
+--
+-- Implies a full memory barrier.
+fetchAndInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> Int
+ -- ^ An 'Int' to AND with the current value of the primitive reference.
+ -> m Int
+ -- ^ A 'PrimMonad' action that atomically sets the value of the given
+ -- primitive reference to the result of bitwise ANDing the given 'Int'
+ -- with the primitive reference's current value, and then returns the value
+ -- the primitive reference had before this modification.
+fetchAndInt (MkPrimRef mba) (I# x) = primitive $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ case GHC.Prim.fetchAndIntArray# m 0# x s of
+ (# s', result #) -> (# s', I# result #)
+
+-- | Given a reference and a value with which to bitwise NAND, atomically NAND
+-- the value with the element.
+--
+-- Returns the value of the element before the operation.
+--
+-- Implies a full memory barrier.
+fetchNandInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> Int
+ -- ^ An 'Int' to NAND with the current value of the primitive reference.
+ -> m Int
+ -- ^ A 'PrimMonad' action that atomically sets the value of the given
+ -- primitive reference to the result of bitwise NANDing the given 'Int'
+ -- with the primitive reference's current value, and then returns the value
+ -- the primitive reference had before this modification.
+fetchNandInt (MkPrimRef mba) (I# x) = primitive $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ case GHC.Prim.fetchNandIntArray# m 0# x s of
+ (# s', result #) -> (# s', I# result #)
+
+-- | Given a reference and a value with which to bitwise OR, atomically OR
+-- the value with the element.
+--
+-- Returns the value of the element before the operation.
+--
+-- Implies a full memory barrier.
+fetchOrInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> Int
+ -- ^ An 'Int' to OR with the current value of the primitive reference.
+ -> m Int
+ -- ^ A 'PrimMonad' action that atomically sets the value of the given
+ -- primitive reference to the result of bitwise ORing the given 'Int'
+ -- with the primitive reference's current value, and then returns the value
+ -- the primitive reference had before this modification.
+fetchOrInt (MkPrimRef mba) (I# x) = primitive $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ case GHC.Prim.fetchOrIntArray# m 0# x s of
+ (# s', result #) -> (# s', I# result #)
+
+-- | Given a reference, and a value with which to bitwise XOR, atomically XOR
+-- the value with the element.
+--
+-- Returns the value of the element before the operation.
+--
+-- Implies a full memory barrier.
+fetchXorInt
+ :: (PrimMonad m)
+ => PrimRef (PrimState m) Int
+ -- ^ A primitive reference.
+ -> Int
+ -- ^ An 'Int' to XOR with the current value of the primitive reference.
+ -> m Int
+ -- ^ A 'PrimMonad' action that atomically sets the value of the given
+ -- primitive reference to the result of bitwise XORing the given 'Int'
+ -- with the primitive reference's current value, and then returns the value
+ -- the primitive reference had before this modification.
+fetchXorInt (MkPrimRef mba) (I# x) = primitive $ \s -> do
+ let m = MByteArray.underlyingMutableByteArray# mba
+ case GHC.Prim.fetchXorIntArray# m 0# x s of
+ (# s', result #) -> (# s', I# result #)
+
+--------------------------------------------------------------------------------
+
+-- | FIXME: doc
+unsafeToMByteArray
+ :: PrimRef s a
+ -- ^ FIXME: doc
+ -> MByteArray s
+ -- ^ FIXME: doc
+unsafeToMByteArray (MkPrimRef mba) = mba
+{-# INLINE unsafeToMByteArray #-}
+
+-- | FIXME: doc
+unsafeFromMByteArray
+ :: MByteArray s
+ -- ^ FIXME: doc
+ -> PrimRef s a
+ -- ^ FIXME: doc
+unsafeFromMByteArray = MkPrimRef
+{-# INLINE unsafeFromMByteArray #-}
+
+--------------------------------------------------------------------------------
diff --git a/test/Spec.hs b/test/Spec.hs
index e5a11ec..0f26b37 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -2,40 +2,42 @@
module Main (main) where
-import Test.QuickCheck (Gen, Arbitrary(..), choose, shrinkIntegral,
- listOf, vectorOf)
-import Test.Framework (defaultMain, testGroup, Test)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (Assertion,(@?=))
-import Data.Monoid (All(..))
-import Data.Traversable
-import Data.Foldable
-import Control.Applicative
-import Data.Coerce
-import Data.Functor.Compose
-
-import Data.Word
-import Data.Functor.Identity
-import Data.Function (on)
-import Data.List (groupBy)
-import Control.Monad
-import Control.Monad.ST
-import qualified Data.List as List
-import qualified Data.Set as Set
-import qualified Data.Map.Strict as Map
-import Debug.Trace
-
-import Data.Primitive.Array.Maybe
-
-import qualified Data.Vector as V
-import qualified Data.ArrayList.Generic as ArrayList
-import qualified Data.Heap.Mutable.ModelD as HeapD
-import qualified Data.Graph.Mutable as MGraph
-import qualified Data.Graph.Immutable as Graph
-import qualified Data.Trie.Mutable.Bits as BitTrie
-import qualified Data.Maybe.Unsafe as UMaybe
-import Data.Maybe.Unsafe hiding (maybe)
+import Control.Applicative
+import Data.Coerce
+import Data.Foldable
+import Data.Functor.Compose
+import Data.Monoid (All (..))
+import Data.Traversable
+import Test.Framework
+ (Test, defaultMain, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@?=))
+import Test.QuickCheck
+ (Arbitrary (..), Gen, choose, listOf, shrinkIntegral,
+ vectorOf)
+
+import Control.Monad
+import Control.Monad.ST
+import Data.Function (on)
+import Data.Functor.Identity
+import Data.List (groupBy)
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import Data.Word
+import Debug.Trace
+
+import Data.Primitive.Array.Maybe
+
+import qualified Data.ArrayList.Generic as ArrayList
+import qualified Data.Graph.Immutable as Graph
+import qualified Data.Graph.Mutable as MGraph
+import qualified Data.Heap.Mutable.ModelD as HeapD
+import Data.Maybe.Unsafe hiding (maybe)
+import qualified Data.Maybe.Unsafe as UMaybe
+import qualified Data.Trie.Mutable.Bits as BitTrie
+import qualified Data.Vector as V
main :: IO ()
main = defaultMain tests
@@ -177,9 +179,9 @@ dijkstraEasyDistance xs =
(Just _,Nothing) -> False
(Just start, Just end) ->
let expected = Min (sum xs)
- in expected == Graph.atVertex end
- (Graph.dijkstra
- (\_ _ (Min x) distance -> Min (x + distance))
+ in expected == Graph.atVertex end
+ (Graph.dijkstra
+ (\_ _ (Min x) distance -> Min (x + distance))
(Min 0) (Identity start) g
)