Changeset 12518 for third-party

Timestamp:

08/20/06 14:51:42 (2 years ago)

Author:

cmarcelo

Message:

* HsJudy?: Add instance of HashTable? for MapM.

Location:

third-party/HsJudy

Files:

• Judy/CollectionsM.hs (modified) (2 diffs)
• Makefile (modified) (1 diff)
• Makefile.static (modified) (1 diff)
• tests/TestHT.hs (added)

third-party/HsJudy/Judy/CollectionsM.hs

@@ -9 +9 @@
 import Foreign
 import Data.IORef
-import qualified Data.Map as DM
-
+import qualified Data.Map       as DM
+import qualified Data.HashTable as HT
 
 import Prelude hiding (lookup)
@@ -130 +130 @@
         writeIORef x y'
         writeIORef y x'
+
+instance MapM (HT.HashTable String a) String a IO where
+    new = HT.new (==) HT.hashString
+    delete k m = (HT.delete m k) >> (return True)
+    member k m = do
+        x <- HT.lookup m k
+        return $ case x of
+            Nothing -> False
+            Just _  -> True
+    lookup = flip HT.lookup
+    insert k a m = HT.insert m k a
+    alter f k m = do
+        x <- HT.lookup m k
+        case x of
+            Nothing -> case (f Nothing) of
+                Nothing -> return Nothing
+                Just y  -> (HT.insert m k y) >> (return $ Just y)
+            Just x  -> case (f (Just x)) of
+                Nothing -> (HT.delete m k)   >> (return Nothing)
+                Just y  -> (HT.insert m k y) >> (return $ Just y)
+    fromList = HT.fromList HT.hashString
+    toList = HT.toList
+    elems = (fmap (map snd)) . HT.toList
+    keys  = (fmap (map fst)) . HT.toList
+    mapToList f = (fmap (map f')) . HT.toList
+        where f' (a,b) = f a b
+    swapMaps x y = do
+        x' <- HT.toList x
+        y' <- HT.toList y
+        mapM_ (\(a,_) -> HT.delete x a) x'
+        mapM_ (\(a,_) -> HT.delete y a) y'
+        mapM_ (\(a,b) -> HT.insert x a b) y'
+        mapM_ (\(a,b) -> HT.insert y a b) x'
+
+instance MapM (HT.HashTable Int a) Int a IO where
+    new = HT.new (==) HT.hashInt
+    delete k m = (HT.delete m k) >> (return True)
+    member k m = do
+        x <- HT.lookup m k
+        return $ case x of
+            Nothing -> False
+            Just _  -> True
+    lookup = flip HT.lookup
+    insert k a m = HT.insert m k a
+    alter f k m = do
+        x <- HT.lookup m k
+        case x of
+            Nothing -> case (f Nothing) of
+                Nothing -> return Nothing
+                Just y  -> (HT.insert m k y) >> (return $ Just y)
+            Just x  -> case (f (Just x)) of
+                Nothing -> (HT.delete m k)   >> (return Nothing)
+                Just y  -> (HT.insert m k y) >> (return $ Just y)
+    fromList = HT.fromList HT.hashInt
+    toList = HT.toList
+    elems = (fmap (map snd)) . HT.toList
+    keys  = (fmap (map fst)) . HT.toList
+    mapToList f = (fmap (map f')) . HT.toList
+        where f' (a,b) = f a b
+    swapMaps x y = do
+        x' <- HT.toList x
+        y' <- HT.toList y
+        mapM_ (\(a,_) -> HT.delete x a) x'
+        mapM_ (\(a,_) -> HT.delete y a) y'
+        mapM_ (\(a,b) -> HT.insert x a b) y'
+        mapM_ (\(a,b) -> HT.insert y a b) x'

third-party/HsJudy/Makefile

@@ -3 +3 @@
 
 CC=$(GHC)
-TESTS=TestBS TestJL TestJSL TestJHS TestHash TestIntMap TestStrMap TestDM
+TESTS=TestBS TestJL TestJSL TestJHS TestHash TestIntMap TestStrMap TestDM TestHT
 #HSC2HS=/usr/bin/hsc2hs
 HSC2HS=hsc2hs

third-party/HsJudy/Makefile.static

@@ -1 +1 @@
 # Makefile for static linkage
 
-TESTS=TestBS TestJL TestJSL TestJHS TestHash TestIntMap TestStrMap TestDM
+TESTS=TestBS TestJL TestJSL TestJHS TestHash TestIntMap TestStrMap TestDM TestHT
 
 GHC=ghc # -debug