diff --git a/observable-sharing.cabal b/observable-sharing.cabal --- a/observable-sharing.cabal +++ b/observable-sharing.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: observable-sharing -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Simple observable sharing -- description: license: BSD3 @@ -10,7 +10,8 @@ author: Atze van der Ploeg , Markus Aronsson maintainer: mararon@chalmers.se --- copyright: +-- copyright: +homepage: https://github.com/atzeus/observable-sharing category: Data build-type: Simple -- extra-source-files: @@ -26,6 +27,6 @@ -- other-modules: -- other-extensions: build-depends: base >=4.8 && <4.9, - unordered-containers + containers hs-source-dirs: .,src default-language: Haskell2010 diff --git a/src/Data/Ref/Map.hs b/src/Data/Ref/Map.hs --- a/src/Data/Ref/Map.hs +++ b/src/Data/Ref/Map.hs @@ -2,6 +2,7 @@ module Data.Ref.Map ( Map + , Name , empty , singleton , null @@ -14,15 +15,16 @@ , union , difference , intersection - , map - , filter ) where import Data.Ref +import Data.List (find, deleteBy) +import Data.Function (on) import Unsafe.Coerce -- lets use all the unsafe operations! -import System.Mem.StableName (hashStableName) +import System.Mem.StableName -import qualified Data.HashMap.Lazy as H +import Data.IntMap (IntMap) +import qualified Data.IntMap as M import Prelude hiding (null, lookup, map, filter) @@ -30,6 +32,9 @@ -- * Reference indexed maps -------------------------------------------------------------------------------- +-- | Shorthand +type Name = StableName + -- | HideType, for hiding types! data HideType f where @@ -38,76 +43,74 @@ -- | A reference indexed map. -- -- useful for associating info with a reference. -data Map f = Map (H.HashMap Int (HideType f)) +data Map f = Map (IntMap [(HideType Name, HideType f)]) -------------------------------------------------------------------------------- -- ** Construction -- | Construct an empty map. empty :: Map f -empty = Map H.empty +empty = Map M.empty -- | Construct a map with a single element. -singleton :: Ref a -> f a -> Map f -singleton (Ref u _) v = Map $ H.singleton (hashStableName u) (Hide v) +singleton :: Name a -> f a -> Map f +singleton n v = Map $ M.singleton (hashStableName n) [(Hide n, Hide v)] -------------------------------------------------------------------------------- -- ** Basic interface -- | Returns 'True' if the map is empty, 'False' otherwise. null :: Map f -> Bool -null (Map m) = H.null m +null (Map m) = M.null m -- | Returns the number of elements stored in this map. size :: Map f -> Int -size (Map m) = H.size m +size (Map m) = M.size m --- | Returns 'True' if the reference is present in the map, 'False' otherwise. -member :: Ref a -> Map f -> Bool -member (Ref u _) (Map m) = H.member (hashStableName u) m +-- | Returns 'True' if the name is present in the map, 'False' otherwise. +member :: Name a -> Map f -> Bool +member n (Map m) = M.member (hashStableName n) m --- | Returns the value associated with the reference, or 'Nothing' if the reference --- has no value associated to it. -lookup :: Ref a -> Map f -> Maybe (f a) -lookup (Ref u _) (Map m) = fmap unsafeCoerce $ H.lookup (hashStableName u) m +-- | Finds the value associated with the name, or 'Nothing' if the name has no +-- value associated to it. +lookup :: Name a -> Map f -> Maybe (f a) +lookup n (Map m) = case M.lookup (hashStableName n) m of + Nothing -> Nothing + Just xs -> fmap unsafeCoerce $ find (\(Hide x, _) -> eqStableName x n) xs -- | Associates a reference with the specified value. If the map already contains -- a mapping for the reference, the old value is replaced. insert :: Ref a -> f a -> Map f -> Map f -insert (Ref u _) v (Map m) = Map $ H.insert (hashStableName u) (Hide v) m +insert (Ref n _) v (Map m) = Map $ M.insertWith (++) (hashStableName n) [(Hide n, Hide v)] m -- | Removes the associated value of a reference, if any is present in the map. delete :: Ref a -> Map f -> Map f -delete (Ref u _) (Map m) = Map $ H.delete (hashStableName u) m +delete (Ref n _) map@(Map m) = Map $ M.update del (hashStableName n) m + where + del (_:[]) = Nothing + del xs = Just $ deleteBy apa (Hide n, undefined) xs + apa (Hide x, _) (Hide y, _) = eqStableName x y -- | Updates the associated value of a reference, if any is present in the map. adjust :: (f a -> f b) -> Ref a -> Map f -> Map f -adjust f (Ref u _) (Map m) = Map $ H.adjust (\(Hide v) -> Hide $ f $ unsafeCoerce v) (hashStableName u) m +adjust f (Ref n _) (Map m) = Map $ M.adjust fun (hashStableName n) m + where + fun xs = fmap (\p@(Hide x, _) -> if eqStableName x n then apa p else p) xs + apa (n, Hide v) = (n, Hide $ f $ unsafeCoerce v) -------------------------------------------------------------------------------- -- ** Combine -- | Union of two maps (left biased). union :: Map f -> Map f -> Map f -union (Map m) (Map n) = Map $ H.union m n +union (Map m) (Map n) = Map $ M.union m n -- | Difference of two maps. difference :: Map f -> Map f -> Map f -difference (Map m) (Map n) = Map $ H.difference m n +difference (Map m) (Map n) = Map $ M.difference m n -- | Intersectino of two maps. intersection :: Map f -> Map f -> Map f -intersection (Map m) (Map n) = Map $ H.intersection m n - --------------------------------------------------------------------------------- --- ** Transformations - --- | Transforms a map by applying the given function to each value. -map :: (f a -> f b) -> Map f -> Map f -map f (Map m) = Map $ H.map (\(Hide v) -> Hide $ f $ unsafeCoerce v) m - --- | Filter this map by retaining only elements which values satisfy a predicate. -filter :: (f a -> Bool) -> Map f -> Map f -filter f (Map m) = Map $ H.filter (\(Hide v) -> f $ unsafeCoerce v) m +intersection (Map m) (Map n) = Map $ M.intersection m n --------------------------------------------------------------------------------