Changeset 12505 for third-party

Timestamp:

08/20/06 08:18:46 (2 years ago)

Author:

cmarcelo

Message:

* HsJudy?: swapMaps is now part of MapM. Also, now we have a
instance of MapM for IORef (Data.Map.Map a b).

Location:

third-party/HsJudy

Files:

• Judy/CollectionsM.hs (modified) (3 diffs)
• Judy/Hash.hs (modified) (3 diffs)
• Judy/IntMap.hs (modified) (3 diffs)
• Judy/StrMap.hs (modified) (3 diffs)
• Makefile (modified) (1 diff)
• Makefile.static (modified) (1 diff)
• tests/TestDM.hs (added)
• tests/TestHash.hs (modified) (1 diff)
• tests/TestIntMap.hs (modified) (1 diff)
• tests/TestStrMap.hs (modified) (1 diff)

third-party/HsJudy/Judy/CollectionsM.hs

@@ -1 +1 @@
 {-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
 
-module Judy.CollectionsM where 
+module Judy.CollectionsM (
+    MapM (..),
+    MapF (..)
+) where 
 
 import Judy.Freeze
 import Foreign
+import Data.IORef
+import qualified Data.Map as DM
+
 
 import Prelude hiding (lookup)
@@ -53 +59 @@
     mapToList :: (k -> a -> b) -> c -> m [b]
 
+    swapMaps :: c -> c -> m ()
+
 
 
@@ -81 +89 @@
     toListF :: c -> [(k, a)]
 
+instance (Ord k) => MapM (IORef (DM.Map k a)) k a IO where
+    new = newIORef DM.empty
+    delete k m = do
+        modifyIORef m (\x -> DM.delete k x)
+        return True
+    member k m = do
+        m' <- readIORef m
+        return $ DM.member k m'
+    lookup k m = do
+        m' <- readIORef m
+        return $ DM.lookup k m'
+    insert k a m = modifyIORef m (\x -> DM.insert k a x)
+    alter f k m = do
+        m' <- readIORef m
+        case DM.lookup k m' of
+            Nothing -> case (f Nothing) of
+                Nothing -> return Nothing
+                Just y  -> (insert k y m) >> (return $ Just y)
+            Just x  -> case (f (Just x)) of
+                Nothing -> (delete k m)   >> (return Nothing)
+                Just y  -> (insert k y m) >> (return $ Just y)
+    fromList = newIORef . DM.fromList
+    toList m = do
+        m' <- readIORef m
+        return $ DM.toList m'
+    elems m = do
+        m' <- readIORef m
+        return $ DM.elems m'
+    keys m = do
+        m' <- readIORef m
+        return $ DM.keys m'
+    mapToList f m = do
+        m' <- readIORef m
+        let l = DM.toList m'
+        let f' (k,a) = f k a
+        return $ map f' l
+    swapMaps x y = do
+        x' <- readIORef x
+        y' <- readIORef y
+        writeIORef x y'
+        writeIORef y x'

third-party/HsJudy/Judy/Hash.hs

@@ -4 +4 @@
 
 module Judy.Hash (
-    Stringable (..),
     Hash (..),
 
     -- FIXME: need to move to MapM api
-    swapMaps, freeze
+    freeze
 ) where
 
@@ -47 +46 @@
     keys = keys_
     mapToList = mapToList_
+    swapMaps = swapMaps_
 
 instance (Stringable k, Refeable a) => Freezable (Hash k a) where
     freeze m = do
         m' <- new_
-        swapMaps m' m
+        swapMaps_ m' m
         return (Frozen m')
 
@@ -220 +220 @@
 
 
-swapMaps :: Hash k a -> Hash k a -> IO ()
-swapMaps (Hash j1) (Hash j2) = do
+swapMaps_ :: Hash k a -> Hash k a -> IO ()
+swapMaps_ (Hash j1) (Hash j2) = do
     withForeignPtr j1 $ \p1 -> withForeignPtr j2 $ \p2 -> do
         v1 <- peek p1

third-party/HsJudy/Judy/IntMap.hs

@@ -5 +5 @@
 module Judy.IntMap (
     IntMap (..),
-    swapMaps, freeze,
+    
+    freeze,
     toRevList,
     size,
@@ -48 +49 @@
     keys = keys_
     mapToList = mapToList_
+    swapMaps = swapMaps_
 
 instance (ReversibleHashIO k, Refeable a) => Freezable (IntMap k a) where
     freeze m = do
         m' <- new_
-        swapMaps m' m
+        swapMaps_ m' m
         return (Frozen m')
 
@@ -304 +306 @@
     fromRef v
 
-swapMaps :: IntMap k a -> IntMap k a -> IO ()
-swapMaps (IntMap j1) (IntMap j2) = do
+swapMaps_ :: IntMap k a -> IntMap k a -> IO ()
+swapMaps_ (IntMap j1) (IntMap j2) = do
     withForeignPtr j1 $ \p1 -> withForeignPtr j2 $ \p2 -> do
         v1 <- peek p1

third-party/HsJudy/Judy/StrMap.hs

@@ -5 +5 @@
 module Judy.StrMap (
     StrMap (..),
-    swapMaps,
+
     freeze,
     toRevList
@@ -46 +46 @@
     keys = keys_
     mapToList = mapToList_
+    swapMaps = swapMaps_
 
 instance (Stringable k, Refeable a) => Freezable (StrMap k a) where
     freeze m = do
         m' <- new_
-        swapMaps m' m
+        swapMaps_ m' m
         return (Frozen m')
 
@@ -214 +215 @@
     fromRef v
 
-swapMaps :: StrMap k a -> StrMap k a -> IO ()
-swapMaps (StrMap j1) (StrMap j2) = do
+swapMaps_ :: StrMap k a -> StrMap k a -> IO ()
+swapMaps_ (StrMap j1) (StrMap j2) = do
     withForeignPtr j1 $ \p1 -> withForeignPtr j2 $ \p2 -> do
         v1 <- peek p1

third-party/HsJudy/Makefile

@@ -3 +3 @@
 
 CC=$(GHC)
-TESTS=TestBS TestJL TestJSL TestJHS TestHash TestIntMap TestStrMap
+TESTS=TestBS TestJL TestJSL TestJHS TestHash TestIntMap TestStrMap TestDM
 #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
+TESTS=TestBS TestJL TestJSL TestJHS TestHash TestIntMap TestStrMap TestDM
 
 GHC=ghc # -debug

third-party/HsJudy/tests/TestHash.hs

@@ -15 +15 @@
 
 type M = J.Hash
-swapMaps = J.swapMaps
 
 main = no_plan $ do

third-party/HsJudy/tests/TestIntMap.hs

@@ -99 +99 @@
     lookup 3 m2 .=> Just 42
 
-    J.swapMaps m1 m2
+    swapMaps m1 m2
     lookup 2 m1 .=> Just 42
     lookup 2 m2 .=> Just 3

third-party/HsJudy/tests/TestStrMap.hs

@@ -15 +15 @@
 
 type M = J.StrMap
-swapMaps = J.swapMaps
 
 newStringInt = new :: IO (M String Int)