summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorathanclark <>2016-04-26 07:23:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-04-26 07:23:00 (GMT)
commit3d582ec707ef89e00f57d97b437e458e525afb02 (patch)
tree0b60b299bef4da2c543ed8938bad4f848472500e
version 0.0.00.0.0
-rw-r--r--HSet.cabal25
-rw-r--r--LICENSE30
-rw-r--r--Setup.hs2
-rw-r--r--src/Data/HSet/Mutable.hs53
-rw-r--r--src/Data/HSet/Types.hs27
5 files changed, 137 insertions, 0 deletions
diff --git a/HSet.cabal b/HSet.cabal
new file mode 100644
index 0000000..8250834
--- /dev/null
+++ b/HSet.cabal
@@ -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
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..fae4f7c
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Data/HSet/Mutable.hs b/src/Data/HSet/Mutable.hs
new file mode 100644
index 0000000..b3bf3e9
--- /dev/null
+++ b/src/Data/HSet/Mutable.hs
@@ -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
diff --git a/src/Data/HSet/Types.hs b/src/Data/HSet/Types.hs
new file mode 100644
index 0000000..dea5eaa
--- /dev/null
+++ b/src/Data/HSet/Types.hs
@@ -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)