HSet (empty) → 0.0.0

raw patch · 5 files changed

+137/−0 lines, 5 filesdep +basedep +containersdep +hashablesetup-changed

Dependencies added: base, containers, hashable, hashtables

Files

• HSet.cabal +25/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• src/Data/HSet/Mutable.hs +53/−0
• src/Data/HSet/Types.hs +27/−0

@@ -0,0 +1,25 @@+Name:                   HSet+Version:                0.0.0+Author:                 Athan Clark <athan.clark@gmail.com>+Maintainer:             Athan Clark <athan.clark@gmail.com>+License:                BSD3+License-File:           LICENSE+Synopsis:               Faux heterogeneous sets+Cabal-Version:          >= 1.10+Build-Type:             Simple+Category:               Data++Library+  Default-Language:     Haskell2010+  HS-Source-Dirs:       src+  GHC-Options:          -Wall+  Exposed-Modules:      Data.HSet.Mutable+  Other-Modules:        Data.HSet.Types+  Build-Depends:        base >= 4.8 && < 5+                      , containers+                      , hashtables+                      , hashable++Source-Repository head+  Type:                 git+  Location:             https://github.com/athanclark/HSet

@@ -0,0 +1,30 @@+Copyright (c) 2016, Athan Clark++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 Athan Clark 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,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,53 @@+module Data.HSet.Mutable+  ( HKey+  , HSet+  , new+  , insert+  , lookup+  , delete+  ) where++import Data.HSet.Types++import Prelude hiding (lookup, length)+import Data.Maybe (fromMaybe)++import Data.Typeable.Internal (Fingerprint, TypeRep (TypeRep))+import Data.Dynamic++import           Data.HashTable.ST.Basic (HashTable)+import qualified Data.HashTable.ST.Basic as HT+import Control.Monad.ST++++data HSet s = HSet+  { hSetValues :: {-# UNPACK #-} !(HashTable s HKey' Dynamic)+  , hSetCount  :: {-# UNPACK #-} !(HashTable s Fingerprint Int)+  }+++new :: ST s (HSet s)+new = HSet <$> HT.new <*> HT.new+++insert :: ( Typeable a+          ) => a -> HSet s -> ST s (HKey a)+insert x (HSet xs count) = do+  let (TypeRep f _ _ _) = typeOf x+  c <- fromMaybe 0 <$> HT.lookup count f+  HT.insert count f (c+1)+  let k = HKey' f c+  HT.insert xs k (toDyn x)+  pure (HKey k)+++lookup :: ( Typeable a+          ) => HKey a -> HSet s -> ST s (Maybe a)+lookup (HKey k) (HSet xs _) = (>>= fromDynamic) <$> HT.lookup xs k+++delete :: HKey a -> HSet s -> ST s ()+delete (HKey k@(HKey' f _)) (HSet xs count) = do+  HT.delete count f+  HT.delete xs k

@@ -0,0 +1,27 @@+{-# LANGUAGE+    DeriveGeneric+  #-}++module Data.HSet.Types where++import Data.Typeable.Internal (Fingerprint (..))++import GHC.Generics+import Data.Hashable++++data HKey' = HKey'+  { getTypeIndex :: {-# UNPACK #-} !Fingerprint+  , getTypeCount :: {-# UNPACK #-} !Int+  } deriving (Eq, Generic)++instance Hashable Fingerprint where+  hashWithSalt s (Fingerprint x y) =+    s `hashWithSalt` x `hashWithSalt` y++instance Hashable HKey'++newtype HKey a = HKey+  { getHKey :: HKey'+  } deriving (Eq)