Permalink
Browse files

repo initialized. builds

  • Loading branch information...
0 parents commit 4eef59d8aab9620726c0aabf9944fecbdf3145f0 @ekmett committed Jun 16, 2010
Showing with 316 additions and 0 deletions.
  1. +31 −0 LICENSE
  2. +76 −0 System/Mem/StableName/Dynamic.hs
  3. +74 −0 System/Mem/StableName/Dynamic/Map.hs
  4. +116 −0 System/Mem/StableName/Map.hs
  5. +19 −0 stable-maps.cabal
31 LICENSE
@@ -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.
@@ -0,0 +1,76 @@
+{-# 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
+ ) 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)
@@ -0,0 +1,74 @@
+module System.Mem.StableName.Dynamic.Map
+ ( DynamicStableMap
+ , insertDynamicStableMap
+ , lookupDynamicStableMap
+ ) where
+
+import System.Mem.StableName.Dynamic
+import 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) = 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 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 (hash k) [(k,v)] . getMap
+ where
+ go ((k',v'):dvs)
+ | k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs
+ | otherwise = (k,v') : insert' 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 = 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 m = maybe dflt id $ lookup k m
@@ -0,0 +1,116 @@
+module System.Mem.StableName.Map
+ ( empty
+ , null
+ , singleton
+ , member
+ , notMember
+ , insert
+ , insertWith
+ , insertWith'
+ , adjust
+ , lookup
+ , find
+ , findWithDefault
+ ) where
+
+import System.Mem.StableName
+import 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
+
+some :: f Any -> f a
+some = unsafeCoerce
+
+liftAny1 :: (f a -> f a) -> f Any -> f Any
+liftAny1 f a = unsafeCoerce $ f (unsafeCoerce a)
+
+liftAny2 :: (f a -> f a -> f a) -> f Any -> f Any -> f Any
+liftAny2 f a b = unsafeCoerce $ f (unsafeCoerce a) (unsafeCoerce a)
+
+empty :: Map f
+empty = Map IntMap.empty
+
+null :: Map f -> Bool
+null (Map m) = 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 :: 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 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', liftAny2 f v v') : kvs
+ | otherwise = (k',v') : go kvs
+ go _ [] = [(dk, any v)]
+
+-- | Same as 'insertWith', but with the combining function applied strictly.
+insertWith' :: (f a -> f a -> f a) -> StableName a -> 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'' = liftAny2 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 = 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 m = maybe dflt id $ lookup k m
@@ -0,0 +1,19 @@
+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
+ GHC-Options: -Wall

0 comments on commit 4eef59d

Please sign in to comment.