impure-containers 0.4.3 → 0.5.0

raw patch · 31 files changed

+1092/−349 lines, 31 filesdep ~basedep ~containerssetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers

API changes (from Hackage documentation)

Files

• LICENSE +0/−30
• LICENSE.md +31/−0
• README.md +4/−0
• Setup.hs +1/−1
• impure-containers.cabal +138/−118
• src/Data/ArrayList/Generic.hs +6/−6
• src/Data/Graph/Immutable.hs +12/−7
• src/Data/Graph/Mutable.hs +7/−7
• src/Data/Graph/Types.hs +3/−4
• src/Data/Graph/Types/Internal.hs +11/−12
• src/Data/HashMap/Mutable/Basic.hs +16/−12
• src/Data/HashMap/Mutable/Internal/Array.hs +5/−5
• src/Data/HashMap/Mutable/Internal/CacheLine.hs +5/−4
• src/Data/HashMap/Mutable/Internal/CheapPseudoRandomBitStream.hs +4/−4
• src/Data/HashMap/Mutable/Internal/IntArray.hs +1/−1
• src/Data/HashMap/Mutable/Internal/Linear/Bucket.hs +6/−4
• src/Data/HashMap/Mutable/Internal/UnsafeTricks.hs +3/−5
• src/Data/HashMap/Mutable/Internal/Utils.hs +5/−5
• src/Data/Heap/Mutable/ModelC.hs +18/−18
• src/Data/Heap/Mutable/ModelD.hs +4/−4
• src/Data/Maybe/Unsafe.hs +8/−7
• src/Data/Primitive/Array/Maybe.hs +8/−8
• src/Data/Primitive/Bool.hs +24/−24
• src/Data/Primitive/MutVar/Maybe.hs +8/−9
• src/Data/Primitive/PrimArray.hs +9/−8
• src/Data/Trie/Immutable/Bits.hs +7/−7
• src/Data/Trie/Mutable/Bits.hs +5/−5
• src/ImpureContainers/MByteArray.hs +278/−0
• src/ImpureContainers/Misc/Mobility.hs +32/−0
• src/ImpureContainers/PrimRef.hs +397/−0
• test/Spec.hs +36/−34

@@ -1,30 +0,0 @@-Copyright Andrew Martin (c) 2016--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * 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.--    * Neither the name of Andrew Martin nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"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 COPYRIGHT-OWNER 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.

@@ -0,0 +1,31 @@+Copyright Andrew Martin    2016-2018+Copyright Remy Goldschmidt 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 COPYRIGHT+OWNER 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.

@@ -0,0 +1,4 @@+impure-containers+=================++Available on [hackage](http://hackage.haskell.org/package/impure-containers).

@@ -1,2 +1,2 @@-import Distribution.Simple+import           Distribution.Simple main = defaultMain

@@ -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--Flag bounds-checking-  Description: if on, use bounds-checking array accesses-  Default: False+    cpp-options:          -DBOUNDS_CHECKING -Flag debug-  Description: if on, spew debugging output to stdout-  Default: False+  -- ghc-prof-options:       -prof -auto-all -Flag sse42-  Description: if on, use SSE 4.2 extensions to search cache lines very-               efficiently. The portable flag forces this off.-  Default: False+  ghc-options:            -Wall+                          -fwarn-tabs+                          -funbox-strict-fields+                          -fno-warn-unused-do-bind+                          -- -- Turn this one back on later+                          -- -O2 -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+  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+--------------------------------------------------------------------------------

@@ -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))   } 

@@ -56,6 +56,7 @@ 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.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 @@  -- | 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 @@   -> 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 @@       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 @@   -> 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 @@   -> 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

@@ -14,14 +14,14 @@   , 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,

@@ -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 @@   , STGraph   ) where -import Data.Graph.Types.Internal+import           Data.Graph.Types.Internal 

@@ -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 @@ --   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

@@ -32,26 +32,29 @@   -------------------------------------------------------------------------------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 @@   ------------------------------------------------------------------------------+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.

@@ -8,15 +8,15 @@   ) 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  

@@ -20,8 +20,9 @@   ) 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 @@ #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           GHC.Exts  #if __GLASGOW_HASKELL__ >= 707-import           GHC.Exts                         (isTrue#)+import           GHC.Exts                               (isTrue#) #else isTrue# :: Bool -> Bool isTrue# = id

@@ -9,11 +9,11 @@  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 

@@ -17,8 +17,8 @@   ) 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 (..))

@@ -23,16 +23,18 @@   -------------------------------------------------------------------------------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 

@@ -1,8 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP          #-}-#ifdef UNSAFETRICKS {-# LANGUAGE MagicHash    #-}-#endif  module Data.HashMap.Mutable.Internal.UnsafeTricks   ( Key@@ -17,15 +15,15 @@   ) 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

@@ -22,10 +22,10 @@   , 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 @@ #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  ------------------------------------------------------------------------------

@@ -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} @-}

@@ -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)

@@ -1,4 +1,5 @@-{-# LANGUAGE MagicHash, BangPatterns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash    #-} module Data.Maybe.Unsafe (UnsafeMaybe                          ,just                          ,nothing@@ -6,12 +7,12 @@                          ,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"

@@ -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 @@   Just a -> do     x <- newArray i (unsafeCoerce a)     return (MutableMaybeArray x)-  Nothing -> do +  Nothing -> do     x <- newArray i nothingSurrogate     return (MutableMaybeArray x) 

@@ -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 @@ 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# #-} 

@@ -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) 

@@ -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 @@   , 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 @@ {-# 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

@@ -7,13 +7,13 @@   , 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)

@@ -8,11 +8,11 @@   , 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)

@@ -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 #-}++--------------------------------------------------------------------------------

@@ -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++--------------------------------------------------------------------------------

@@ -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 #-}++--------------------------------------------------------------------------------

@@ -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           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 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           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           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 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 @@         (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                 )