impure-containers 0.4.0 → 0.4.1

raw patch · 10 files changed

+216/−68 lines, 10 filesdep +criteriondep ~basedep ~containersdep ~hashablePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: criterion

Dependency ranges changed: base, containers, hashable, primitive, vector

API changes (from Hackage documentation)

Files

• bench/Main.hs +4/−0
• impure-containers.cabal +18/−7
• src/Data/Graph/Immutable.hs +62/−38
• src/Data/Graph/Mutable.hs +16/−14
• src/Data/HashMap/Mutable/Internal/UnsafeTricks.hs +1/−0
• src/Data/Maybe/Unsafe.hs +81/−0
• src/Data/Primitive/Array/Maybe.hs +2/−1
• src/Data/Primitive/MutVar/Maybe.hs +1/−0
• src/Data/Trie/Immutable/Bits.hs +8/−7
• test/Spec.hs +23/−1

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = return ()

@@ -1,5 +1,5 @@ name:                impure-containers-version:             0.4.0+version:             0.4.1 synopsis:            Mutable containers in haskell description:         Please see README.md homepage:            https://github.com/andrewthad/impure-containers#readme@@ -25,7 +25,6 @@     -- Data.Heap.Mutable.ModelB     Data.Heap.Mutable.ModelC     Data.Heap.Mutable.ModelD-    -- Data.Vector.Unique     Data.Graph.Immutable     Data.Graph.Mutable     Data.Trie.Mutable.Bits@@ -37,6 +36,7 @@     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@@ -47,11 +47,11 @@     Data.HashMap.Mutable.Internal.UnsafeTricks     Data.HashMap.Mutable.Internal.Utils   build-depends:-      base >= 4.7 && < 5-    , hashable-    , primitive-    , vector-    , containers+      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 @@ -124,6 +124,17 @@     , 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

@@ -14,6 +14,7 @@   ( -- * Graph Operations     lookupVertex   , lookupEdge+  , atVertex   , mapVertices   , traverseVertices_   , traverseEdges_@@ -26,14 +27,15 @@   , with     -- * Algorithms   , dijkstra-  , dijkstraMonoidal-  , dijkstraMonoidalCover+  , dijkstraDistance+  , dijkstraFoldM     -- * Size and Vertex   , sizeInt   , vertexInt     -- * Vertices   , verticesRead   , verticesLength+  , verticesTraverse   , verticesTraverse_   , verticesToVertexList   , verticesToVector@@ -71,6 +73,9 @@     Nothing -> Nothing     Just ix -> Just (V.unsafeIndex (V.unsafeIndex edges x) ix) +atVertex :: Vertex g -> Graph g e v -> v+atVertex v g = verticesRead (vertices g) v+ -- | Not the same as 'fmap' because the function also takes the vertex id. mapVertices :: (Vertex g -> a -> b) -> Graph g e a -> Graph g e b mapVertices f (Graph sg) = Graph sg@@ -93,7 +98,6 @@         ) allVertices  -- | Traverse the neighbors of a specific vertex.---   Change this to use unsafeRead some time soon. traverseNeighbors_ :: Applicative m   => (Vertex g -> v -> e -> m a)   -> Vertex g@@ -101,13 +105,13 @@   -> m () traverseNeighbors_ f (Vertex x) (Graph g) =   let allVertices  = graphVertices g-      theVertices  = graphOutboundNeighborVertices g V.! x-      edges        = graphOutboundNeighborEdges g V.! x+      theVertices  = V.unsafeIndex (graphOutboundNeighborVertices g) x+      edges        = V.unsafeIndex (graphOutboundNeighborEdges g) x       numNeighbors = U.length theVertices       go !i = if i < numNeighbors-        then let vertexNum = theVertices U.! i-                 vertexVal = allVertices V.! vertexNum-                 edgeVal = edges V.! i+        then let vertexNum = U.unsafeIndex theVertices i+                 vertexVal = V.unsafeIndex allVertices vertexNum+                 edgeVal = V.unsafeIndex edges i               in f (Vertex vertexNum) vertexVal edgeVal *> go (i + 1)         else pure ()    in go 0@@ -118,7 +122,7 @@ vertices (Graph (SomeGraph v _ _)) = Vertices v  -- | Set the vertices of a graph.-setVertices :: Vertices g v -> Graph g e v -> Graph g e v+setVertices :: Vertices g v -> Graph g e w -> Graph g e v setVertices (Vertices x) (Graph (SomeGraph _ a b)) = Graph (SomeGraph x a b)  -- | Get the number of vertices in a graph.@@ -207,16 +211,17 @@ --   The source code of this function provides an example of how to use --   the generalized variants of Dijkstra\'s algorithm provided by this --   module.-dijkstra :: (Num e, Ord e)+dijkstraDistance :: (Num e, Ord e)   => Vertex g -- ^ Start vertex   -> Vertex g -- ^ End vertex   -> Graph g e v -- ^ Graph   -> Maybe e-dijkstra start end g = getMinDistance-  ( dijkstraMonoidal+dijkstraDistance start end g = +  getMinDistance $ atVertex end+  ( dijkstra     (\_ _ mdist e -> addMinDistance mdist e)     (MinDistance (Just 0))-    start end g+    (Identity start) g   )   where addMinDistance (MinDistance m) e = MinDistance (fmap (+ e) m) @@ -238,17 +243,6 @@   mempty = MinDistance Nothing   mappend ma mb = min ma mb --- | A generalized version of Dijkstra\'s algorithm.-dijkstraMonoidal :: (Ord s, Monoid s)-  => (v -> v -> s -> e -> s) -- Weight combining function-  -> s           -- ^ Weight to assign start vertex-  -> Vertex g    -- ^ Start vertex-  -> Vertex g    -- ^ End vertex-  -> Graph g e v -- ^ Graph-  -> s-dijkstraMonoidal f s start end g =-  verticesRead (dijkstraMonoidalCover f s (Identity start) g) end- -- | This is a generalization of Dijkstra\'s algorithm. Like the original, --   it takes a start 'Vertex' but unlike the original, it does not take --   an end. It will continue traversing the 'Graph' until it has touched@@ -298,14 +292,41 @@ -- --   This function could be written without unsafely pattern matching --   on 'Vertex', but doing so allows us to use a faster heap implementation.-dijkstraMonoidalCover ::+dijkstra ::      (Ord s, Monoid s, Foldable t)   => (v -> v -> s -> e -> s) -- ^ Weight function-  -> s                 -- ^ Weight to assign start vertex-  -> t (Vertex g)      -- ^ Start vertices-  -> Graph g e v       -- ^ Graph-  -> Vertices g s-dijkstraMonoidalCover f s0 v0 g = runST $ do+  -> s -- ^ Weight to assign start vertex+  -> t (Vertex g) -- ^ Start vertices+  -> Graph g e v -- ^ Graph+  -> Graph g e s+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 :: +     (Ord s, Monoid s, Foldable t, PrimMonad m)+  => (v -> v -> s -> e -> s) -- ^ Weight function+  -> (v -> s -> x -> m x) -- ^ Monadic fold function+  -> s -- ^ Weight to assign start vertex+  -> x -- ^ Initial accumulator+  -> t (Vertex g) -- ^ Start vertices+  -> Graph g e v -- ^ Graph+  -> m x+dijkstraFoldM f mf s0 acc v0 g = +  fmap snd $ dijkstraGeneral f mf s0 acc v0 g++-- | This is not exported+dijkstraGeneral ::+     (Ord s, Monoid s, Foldable t, PrimMonad m)+  => (v -> v -> s -> e -> s) -- ^ Weight function+  -> (v -> s -> x -> m x) -- ^ Monadic fold+  -> s -- ^ Weight to assign start vertex+  -> x -- ^ Initial fold value+  -> t (Vertex g) -- ^ Start vertices+  -> Graph g e v -- ^ Graph+  -> m (Graph g e s, x)+dijkstraGeneral f step s0 x0 v0 g = do   let theSize = size g       oldVertices = vertices g   newVertices <- Mutable.verticesReplicate theSize mempty@@ -318,10 +339,10 @@     -- We know it's ok in this case because the min heap does not     -- create Ints that we did not push onto it.     Heap.unsafePush s0 (getVertexInternal v) heap-  let go = do+  let go x = do         m <- Heap.pop heap         case m of-          Nothing -> return True+          Nothing -> return (BoolWith True x)           Just (s,unwrappedVertexIx) -> do             -- Unsafe cast from Int to Vertex             let vertex = Vertex unwrappedVertexIx@@ -336,13 +357,16 @@                   (getVertexInternal neighborVertex)                   heap               ) vertex g-            return False-      runMe = do-        isDone <- go-        if isDone then return () else runMe-  runMe+            xNext <- step value s x+            return (BoolWith False xNext)+      runMe x = do+        BoolWith isDone xNext <- go x+        if isDone then return xNext else runMe xNext+  xFinal <- runMe x0   newVerticesFrozen <- verticesFreeze newVertices-  return newVerticesFrozen+  return (setVertices newVerticesFrozen g, xFinal)++data BoolWith a = BoolWith Bool !a  -- mutableIForM_ :: PrimMonad m => MVector (PrimState m) a -> (Int -> a -> m b) -> m () -- mutableIForM_ m f = forM_ (take (MV.length m) (enumFrom 0)) $ \i -> do

@@ -23,10 +23,11 @@ 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,--- and edges can be deleted, but vertices cannot be deleted. Providing such--- an operation would undermine the safety that this library provides.+{- $mutgraph+   Operations that mutate a 'MGraph'. Vertices and edges can both be added,+   and edges can be deleted, but vertices cannot be deleted. Providing such+   an operation would undermine the safety that this library provides.+-}  -- | This does two things: --@@ -60,16 +61,17 @@     Nothing -> HashTable.insert edges (IntPair a b) e     Just eOld -> HashTable.insert edges (IntPair a b) (combine eOld e) --- | $mutvertices--- Operations that mutate a 'MVertices' or a 'MUVertices'. These functions have nothing--- to do with 'MGraph' and are not usually needed by end users of this library. They--- are useful for users writing algorithms that need to mark vertices in a graph as--- it is traversed.------ All of these operations are--- wrappers around operations from @Data.Vector.Mutable@ and @Data.Vector.Unbox.Mutable@.--- As long as you do not import @Data.Graph.Types.Internal@, this library guarentees that--- these operations will not fail at runtime.+{- $mutvertices+   Operations that mutate a 'MVertices' or a 'MUVertices'. These functions have nothing+   to do with 'MGraph' and are not usually needed by end users of this library. They+   are useful for users writing algorithms that need to mark vertices in a graph as+   it is traversed.++   All of these operations are+   wrappers around operations from @Data.Vector.Mutable@ and @Data.Vector.Unbox.Mutable@.+   As long as you do not import @Data.Graph.Types.Internal@, this library guarentees that+   these operations will not fail at runtime.+-}  verticesReplicate :: PrimMonad m => Size g -> v -> m (MVertices (PrimState m) g v) verticesReplicate (Size i) v = fmap MVertices (MV.replicate i v)

@@ -21,6 +21,7 @@ import qualified Data.Vector.Mutable as M #ifdef UNSAFETRICKS import           GHC.Exts+import           GHC.Types import           Unsafe.Coerce  #if __GLASGOW_HASKELL__ >= 707

@@ -0,0 +1,81 @@+{-# LANGUAGE MagicHash, BangPatterns #-}+module Data.Maybe.Unsafe (UnsafeMaybe+                         ,just+                         ,nothing+                         ,fromMaybe+                         ,maybe+                         ,toMaybe) where++import Unsafe.Coerce+import System.IO.Unsafe+import System.Mem.StableName+import GHC.Prim+import GHC.Types+import Prelude hiding (maybe)++thunk :: Int -> Int+thunk x = error "bang"+{-# NOINLINE thunk #-}++thunkStableName :: StableName (Int -> Int)+thunkStableName = unsafePerformIO (makeStableName thunk)++-- | nothingSurrogate stands in for the value Nothing; we distinguish it by pointer+nothingSurrogate :: Any+nothingSurrogate = unsafeCoerce thunk+{-# NOINLINE nothingSurrogate #-}++nothingStableName :: StableName Any+nothingStableName = unsafePerformIO (makeStableName nothingSurrogate)++newtype UnsafeMaybe a = UnsafeMaybe Any++instance Functor UnsafeMaybe where+  fmap f = maybe nothing (just . f)++instance Applicative UnsafeMaybe where+  pure = just+  {-# INLINE pure #-}+  -- (UnsafeMaybe f) <*> (UnsafeMaybe x) = case reallyUnsafePtrEquality# f nothingSurrogate of+  --   0# -> case reallyUnsafePtrEquality# x nothingSurrogate of+  --     0# -> just ((unsafeCoerce f) (unsafeCoerce x))+  --     _  -> nothing+  --   _  -> nothing+  mf <*> mx = maybe nothing (\f -> maybe nothing (just . f) mx) mf+  {-# INLINE (<*>) #-}++instance Monad UnsafeMaybe where+  return = just+  -- (UnsafeMaybe x) >>= f = case reallyUnsafePtrEquality# x nothingSurrogate of+  --   0# -> f (unsafeCoerce x)+  --   _  -> nothing+  mx >>= f = maybe nothing f mx+++just :: a -> UnsafeMaybe a+just a = UnsafeMaybe (unsafeCoerce a)++nothing :: UnsafeMaybe a+nothing = UnsafeMaybe nothingSurrogate++fromMaybe :: Maybe a -> UnsafeMaybe a+fromMaybe (Just a) = just a+fromMaybe Nothing  = nothing+{-# INLINE fromMaybe #-}++maybe :: b -> (a -> b) -> UnsafeMaybe a -> b+maybe !def transform (UnsafeMaybe !a) = case eqStableName thunkStableName named ||+                                            eqStableName nothingStableName named of+  False -> transform (unsafeCoerce a)+  True  -> def+  where named = unsafePerformIO (makeStableName a)+{-# INLINE maybe #-}++-- toMaybe :: UnsafeMaybe a -> Maybe a+-- toMaybe (UnsafeMaybe a) = case reallyUnsafePtrEquality# a nothingSurrogate of+--   0# -> Just (unsafeCoerce a)+--   _  -> Nothing+-- {-# INLINE toMaybe #-}++toMaybe :: UnsafeMaybe a -> Maybe a+toMaybe = maybe Nothing Just

@@ -10,7 +10,8 @@  import Control.Monad.Primitive import Data.Primitive.Array-import GHC.Prim (reallyUnsafePtrEquality#,Any)+import GHC.Prim (reallyUnsafePtrEquality#)+import GHC.Exts (Any) import Unsafe.Coerce (unsafeCoerce)  newtype MutableMaybeArray s a = MutableMaybeArray (MutableArray s Any)

@@ -13,6 +13,7 @@  import Unsafe.Coerce import GHC.Prim+import GHC.Types  import Data.Maybe 

@@ -13,15 +13,16 @@ import Data.Primitive.ByteArray import Data.Primitive.MutVar.Maybe import Data.Trie.Mutable.Bits (MTrie(..))+import Data.Maybe.Unsafe  data Trie k v = Trie-  { trieValue :: !(Maybe v)-  , trieLeft  :: !(Maybe (Trie k v))-  , trieRight :: !(Maybe (Trie k v))+  { trieValue :: !(UnsafeMaybe v)+  , trieLeft  :: !(UnsafeMaybe (Trie k v))+  , trieRight :: !(UnsafeMaybe (Trie k v))   }  empty :: Trie k v-empty = Trie Nothing Nothing Nothing+empty = Trie nothing nothing nothing  -- | This gives the best match, that is, the --   value stored at the longest prefix that@@ -30,7 +31,7 @@   => Trie k v   -> k   -> Maybe v-lookup theTrie theKey = go Nothing theTrie theKey where+lookup theTrie theKey = toMaybe (go nothing theTrie theKey) where   totalBits :: Int   totalBits = finiteBitSize theKey   -- mask :: k@@ -39,7 +40,7 @@   zero = zeroBits   go !mres (Trie mval mleft mright) key =     let chosen = if (mask .&. key) == zero then mleft else mright-     in case chosen of+     in case toMaybe chosen of           Nothing -> mval           Just nextTrie -> go mval nextTrie (unsafeShiftL key 1) @@ -55,5 +56,5 @@     immutableRight <- case mright of       Just right -> fmap Just $ go right       Nothing -> return Nothing-    return (Trie mval immutableLeft immutableRight)+    return undefined --(Trie mval immutableLeft immutableRight) 

@@ -16,6 +16,7 @@ import Data.Functor.Compose  import Data.Word+import Data.Functor.Identity import Data.Function (on) import Data.List (groupBy) import Control.Monad@@ -33,6 +34,8 @@ 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)  main :: IO () main = defaultMain tests@@ -58,6 +61,10 @@     [ testProperty "Basic Insert and Lookup" bitTrieBasic     , testProperty "Prefixes" bitTriePrefix     ]+  , testGroup "Unsafe Maybe"+    [ testCase "Unsafe Maybe functions" unsafeMaybeWorks+    -- , testProperty "Unsafe Maybe Quickcheck props" unsafeMaybeProp+    ]   ]  testElements :: Int@@ -170,7 +177,11 @@         (Just _,Nothing)  -> False         (Just start, Just end) ->           let expected = Min (sum xs)-           in expected == Graph.dijkstraMonoidal (\_ _ (Min x) distance -> Min (x + distance)) (Min 0) start end g+           in expected == Graph.atVertex end +                (Graph.dijkstra +                  (\_ _ (Min x) distance -> Min (x + distance)) +                  (Min 0) (Identity start) g+                )  data Thing = Foo | Bar Int | Baz Bool   deriving (Eq,Show)@@ -195,6 +206,17 @@     , Just $ Baz True, Nothing     , Nothing, Just (Bar 15)     )++unsafeMaybeWorks :: IO ()+unsafeMaybeWorks = (a,b,c,d,e,f,g,h) @?= (Nothing,Just 0,1,Nothing,Just 3,Nothing,Just 4,Nothing)+  where a = toMaybe $ nothing :: Maybe Int+        b = toMaybe $ just (0 :: Int)+        c = UMaybe.maybe (0 :: Int) (+1) (just 0)+        d = toMaybe $ nothing :: Maybe Int+        e = toMaybe $ fmap (+1) (just 2)+        f = toMaybe $ fmap (+1) nothing+        g = toMaybe $ just (just 4) >>= id+        h = toMaybe $ UMaybe.maybe nothing (const nothing) nothing :: Maybe Int  bitTrieBasic :: [Word8] -> Bool bitTrieBasic xs =