packages feed

stable-maps (empty) → 0.0.1

raw patch · 6 files changed

+327/−0 lines, 6 filesdep +basedep +containersdep +ghc-primsetup-changed

Dependencies added: base, containers, ghc-prim

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2010, Edward Kmett++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 Edward Kmett 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Mem/StableName/Dynamic.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE TypeFamilies, Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  System.Mem.StableName.Dynamic+-- Copyright   :  (c) Edward Kmett 2010+-- License     :  BSD3+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  GHC only+--+-- Dynamic stable names are a way of performing fast (O(1)), not-quite-exact comparison between objects.+--+-- Dynamic stable names solve the following problem: suppose you want to build a hash table with Haskell objects as keys, but you want to use pointer equality for comparison; maybe because the keys are large and hashing would be slow, or perhaps because the keys are infinite in size. We can't build a hash table using the address of the object as the key, because objects get moved around by the garbage collector, meaning a re-hash would be necessary after every garbage collection.+-----------------------------------------------------------------------------++module System.Mem.StableName.Dynamic +    ( DynamicStableName(..)+    , hashDynamicStableName+    , makeDynamicStableName+    , wrapStableName+    ) where++import GHC.Prim++import System.Mem.StableName (StableName, makeStableName, hashStableName)+import Unsafe.Coerce (unsafeCoerce)++{-|+  An abstract name for an object, that supports equality and hashing.++  Dynamic stable names have the following property:++  * If @sn1 :: DynamicStableName@ and @sn2 :: DynamicStableName@ and @sn1 == sn2@+   then @sn1@ and @sn2@ were created by calls to @makeStableName@ on +   the same object.++  The reverse is not necessarily true: if two dynamic stable names are not+  equal, then the objects they name may still be equal.  Note in particular+  that `makeDynamicStableName` may return a different `DynamicStableName` +  after an object is evaluated.++  Dynamic Stable Names are similar to Stable Pointers ("Foreign.StablePtr"),+  but differ in the following ways:++  * There is no @freeDynamicStableName@ operation, unlike "Foreign.StablePtr"s.+    Dynamic Stable Names are reclaimed by the runtime system when they are no+    longer needed.++  * There is no @deRefDynamicStableName@ operation.  You can\'t get back from+    a dynamic stable name to the original Haskell object.  The reason for+    this is that the existence of a stable name for an object does not+    guarantee the existence of the object itself; it can still be garbage+    collected.++-}++newtype DynamicStableName = DynamicStableName (StableName Any)++-- | Makes a 'DynamicStableName' for an arbitrary object.  The object passed as+-- the first argument is not evaluated by 'makeDynamicStableName'.+makeDynamicStableName :: t -> IO DynamicStableName+makeDynamicStableName a = do+    s <- makeStableName a+    return (wrapStableName s)++-- | Convert a 'DynamicStableName' to an 'Int'.  The 'Int' returned is not+-- necessarily unique; several 'DynamicStableName's may map to the same 'Int'+-- (in practice however, the chances of this are small, so the result+-- of 'hashDynamicStableName' makes a good hash key).+hashDynamicStableName :: DynamicStableName -> Int+hashDynamicStableName (DynamicStableName sn) = hashStableName sn++instance Eq DynamicStableName where+    DynamicStableName sn1 == DynamicStableName sn2 = sn1 == sn2++wrapStableName :: StableName a -> DynamicStableName+wrapStableName s = DynamicStableName (unsafeCoerce s)
+ System/Mem/StableName/Dynamic/Map.hs view
@@ -0,0 +1,82 @@+module System.Mem.StableName.Dynamic.Map+    ( Map+    , empty+    , null+    , singleton+    , member+    , notMember+    , insert+    , insertWith++    ) where++import qualified Prelude+import Prelude hiding (lookup, null)+import System.Mem.StableName.Dynamic+import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)+import Unsafe.Coerce (unsafeCoerce)++newtype Map a = Map { getMap :: IntMap [(DynamicStableName, a)] } ++empty :: Map a+empty = Map IntMap.empty++null :: Map a -> Bool+null (Map m) = IntMap.null m++singleton :: DynamicStableName -> a -> Map a+singleton k v = Map $ IntMap.singleton (hashDynamicStableName k) [(k,v)]++member :: DynamicStableName -> Map a -> Bool+member k m = case lookup k m of+    Nothing -> False+    Just _ -> True++notMember :: DynamicStableName -> Map a -> Bool+notMember k m = not $ member k m ++insert :: DynamicStableName -> a -> Map a -> Map a+insert k v = Map . IntMap.insertWith (++) (hashDynamicStableName k) [(k,v)] . getMap+    +-- | /O(log n)/. Insert with a function for combining the new value and old value.+-- @'insertWith' f key value mp@+-- will insert the pair (key, value) into @mp@ if the key does not exist+-- in the map. If the key does exist, the function will insert the pair+-- @(key, f new_value old_value)@+insertWith :: (a -> a -> a) -> DynamicStableName -> a -> Map a -> Map a+insertWith f k v = Map . IntMap.insertWith go (hashDynamicStableName k) [(k,v)] . getMap +    where +        go _ ((k',v'):kvs) +            | k == k' = (k', f v v') : kvs+            | otherwise = (k',v') : go undefined kvs+        go _ [] = []++-- | Same as 'insertWith', but with the combining function applied strictly.+insertWith' :: (a -> a -> a) -> DynamicStableName -> a -> Map a -> Map a+insertWith' f k v = Map . IntMap.insertWith go (hashDynamicStableName k) [(k,v)] . getMap +    where +        go _ ((k',v'):kvs) +            | k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs+            | otherwise = (k', v') : go undefined kvs+        go _ [] = []++-- | /O(log n)/. Lookup the value at a key in the map.+-- +-- The function will return the corresponding value as a @('Just' value)@+-- or 'Nothing' if the key isn't in the map.+lookup :: DynamicStableName -> Map v -> Maybe v+lookup k (Map m) = do+    pairs <- IntMap.lookup (hashDynamicStableName k) m+    Prelude.lookup k pairs++find :: DynamicStableName -> Map v -> v+find k m = case lookup k m of+    Nothing -> error "Map.find: element not in the map"+    Just x -> x ++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns the default value @def@+-- when the key is not in the map.+findWithDefault :: v -> DynamicStableName -> Map v -> v+findWithDefault dflt k m = maybe dflt id $ lookup k m
+ System/Mem/StableName/Map.hs view
@@ -0,0 +1,114 @@+module System.Mem.StableName.Map +    ( empty+    , null+    , singleton+    , member+    , notMember+    , insert+    , insertWith+    , insertWith'+    , adjust+    , lookup+    , find+    , findWithDefault+    ) where++import GHC.Prim (Any)+import qualified Prelude+import Prelude hiding (lookup, null, any)+import System.Mem.StableName+import System.Mem.StableName.Dynamic+import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)+import Unsafe.Coerce (unsafeCoerce)++newtype Map f = Map { getMap :: IntMap [(DynamicStableName, f Any)] } ++-- unsafe combinators+any :: f a -> f Any+any = unsafeCoerce++liftAny1 :: (f a -> f a) -> f Any -> f Any +liftAny1 f a = unsafeCoerce $ f (unsafeCoerce a)++empty :: Map f+empty = Map IntMap.empty++null :: Map f -> Bool+null (Map m) = IntMap.null m++singleton :: StableName a -> f a -> Map f+singleton k v = Map $ IntMap.singleton (hashDynamicStableName dk) [(dk, any v)]+    where+        dk = wrapStableName k++member :: StableName a -> Map f -> Bool+member k m = case lookup k m of+    Nothing -> False+    Just _ -> True++notMember :: StableName a -> Map f -> Bool+notMember k m = not $ member k m ++insert :: StableName a -> f a -> Map f -> Map f+insert k v = +    Map . +    IntMap.insertWith (++) (hashDynamicStableName dk) [(dk,any v)] . +    getMap+    where +        dk = wrapStableName k++-- | /O(log n)/. Insert with a function for combining the new value and old value.+-- @'insertWith' f key value mp@+-- will insert the pair (key, value) into @mp@ if the key does not exist+-- in the map. If the key does exist, the function will insert the pair+-- @(key, f new_value old_value)@+insertWith :: (f a -> f a -> f a) -> StableName a -> f a -> Map f -> Map f+insertWith f k v = Map . IntMap.insertWith go (hashDynamicStableName dk) [(dk,any v)] . getMap +    where +        dk = wrapStableName k+        go _ ((k',v'):kvs) +            | dk == k' = (k', liftAny1 (f v) v') : kvs+            | otherwise = (k',v') : go undefined kvs+        go _ [] = [(dk, any v)]++-- | Same as 'insertWith', but with the combining function applied strictly.+insertWith' :: (f a -> f a -> f a) -> StableName a -> f a -> Map f -> Map f+insertWith' f k v = Map . IntMap.insertWith go (hashDynamicStableName dk) [(dk, any v)] . getMap +    where +        dk = wrapStableName k+        go _ ((k',v'):kvs) +            | dk == k' = let v'' = liftAny1 (f v) v' in v'' `seq` (k', v'') : kvs+            | otherwise = (k', v') : go undefined kvs+        go _ [] = [(dk, any v)]++adjust :: (f a -> f a) -> StableName a -> Map f -> Map f+adjust f k = Map . IntMap.adjust go (hashDynamicStableName dk) . getMap+    where+        dk = wrapStableName k+        go ((k',v):kvs)+            | dk == k' = (k', liftAny1 f v) : kvs+            | otherwise = (k', v) : go kvs+        go [] = []++-- | /O(log n)/. Lookup the value at a key in the map.+-- +-- The function will return the corresponding value as a @('Just' value)@+-- or 'Nothing' if the key isn't in the map.+lookup :: StableName a -> Map f -> Maybe (f a)+lookup k (Map m) = do+    pairs <- IntMap.lookup (hashDynamicStableName dk) m+    unsafeCoerce $ Prelude.lookup dk pairs+    where+        dk = wrapStableName k ++find :: StableName a -> Map f -> f a +find k m = case lookup k m of+    Nothing -> error "Map.find: element not in the map"+    Just x -> x ++-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns+-- the value at key @k@ or returns the default value @def@+-- when the key is not in the map.+findWithDefault :: f a -> StableName a -> Map f -> f a+findWithDefault dflt k m = maybe dflt id $ lookup k m
+ stable-maps.cabal view
@@ -0,0 +1,21 @@+Name:              stable-maps+Version:           0.0.1+Synopsis:          Heterogeneous maps keyed by StableNames+Description:       Provides an API for inserting heterogeneous data in a collection keyed by StableNames and for later retrieving it.+Homepage:          http://github.com/ekmett/stable-maps+License:           BSD3+License-file:      LICENSE+Author:            Edward Kmett+Maintainer:        ekmett@gmail.com+Category:          Math+Build-type:        Simple+Cabal-version:     >=1.6++Library+  Exposed-modules: System.Mem.StableName.Map+                   System.Mem.StableName.Dynamic+                   System.Mem.StableName.Dynamic.Map+  Build-depends:   base >= 4 && < 5,+                   containers >= 0.3 && < 0.4,+                   ghc-prim >= 0.2 && < 0.3+  GHC-Options:     -Wall