From d8891e31669a4dd602b0558b6064920420d31710 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 3 Feb 2014 16:55:55 +0200 Subject: [PATCH] Update judy patch --- patching/patches/judy-0.2.1.patch | 577 ------------------------------ patching/patches/judy-0.2.2.patch | 13 + 2 files changed, 13 insertions(+), 577 deletions(-) delete mode 100644 patching/patches/judy-0.2.1.patch create mode 100644 patching/patches/judy-0.2.2.patch diff --git a/patching/patches/judy-0.2.1.patch b/patching/patches/judy-0.2.1.patch deleted file mode 100644 index 3cfa7ee6..00000000 --- a/patching/patches/judy-0.2.1.patch +++ /dev/null @@ -1,577 +0,0 @@ -diff -ru orig/Data/Judy.hsc new/Data/Judy.hsc ---- orig/Data/Judy.hsc 2014-02-02 18:54:27.414781709 +0200 -+++ new/Data/Judy.hsc 2014-02-02 18:54:26.000000000 +0200 -@@ -16,61 +16,92 @@ - -- data sets. - -- - -- The memory used by a Judy array is nearly proportional to the ---- population (number of elements). Note that as Judy is allocated on ---- C language side, GHC's profiling system won't report memory use by ---- Judy arrays. -+-- population (number of elements). - -- - -- For further references to the implementation, see: - -- - -- * - -- ---- Building a simple word-index table. About 4x faster than using an 'IntMap' -+-- /Examples/: - -- ---- > ---- > import Control.Monad -+-- Generate 1 million random integers. Report the largest one we see. -+-- -+-- > import System.Random.Mersenne - -- > import qualified Data.Judy as J -+-- > import Control.Monad - -- > - -- > main = do ---- > j <- J.new :: IO (J.JudyL Int) ---- > forM_ [1..10000000] $ \n -> J.insert n (fromIntegral n :: Int) j ---- > v <- J.lookup 100 j ---- > print v ---- > -+-- > g <- getStdGen -+-- > rs <- randoms g -+-- > j <- J.new :: IO (J.JudyL Int) -+-- > forM_ (take 1000000 rs) $ \n -> -+-- > J.insert n 1 j -+-- > v <- J.findMax j -+-- > case v of -+-- > Nothing -> print "Done." -+-- > Just (k,_) -> print k - -- ---- Running this: -+-- Compile it: - -- ---- > $ ghc -O2 --make A.hs ---- > [1 of 1] Compiling Main ( A.hs, A.o ) ---- > Linking A ... ---- ---- > $ time ./A ---- > Just 100 ---- > ./A 1.95s user 0.08s system 99% cpu 2.028 total -+-- > $ ghc -O2 --make Test.hs -+-- -+-- Running it: -+-- -+-- > $ time ./Test -+-- > 18446712059962695226 -+-- > ./Test 0.65s user 0.03s system 99% cpu 0.680 total -+-- -+-- /Notes/: -+-- -+-- * /By default this library is threadsafe/. -+-- -+-- * /Multiple Haskell threads may operate on the arrays simultaneously. You can compile without locks if you know you're running in a single threaded fashion with: cabal install -funsafe/ -+-- -+-- Sun Sep 27 17:12:24 PDT 2009: The library has only lightly been tested. - -- -- - module Data.Judy ( - - -- * Basic types - JudyL, Key - -- -- * Operations -+ -- * Construction - , Data.Judy.new -+ -+ -- * Queries -+ , Data.Judy.null - , Data.Judy.size -- , Data.Judy.insert -- -- insertWith -+ , Data.Judy.member - , Data.Judy.lookup -- -- member -+ -+ -- * Insertion and removal -+ , Data.Judy.insert -+-- , Data.Judy.insertWith - , Data.Judy.delete -- -- adjust -- -- update -+ , Data.Judy.adjust -+ -+ -- * Min/Max -+ , Data.Judy.findMin -+ , Data.Judy.findMax - ---- memoryUsed -+ -- * Conversion -+ , Data.Judy.keys -+ , Data.Judy.elems -+ -+-- memoryUsed - - -- * Judy-storable types - , JE(..) - - ) where - -+#if !defined(UNSAFE) -+import Control.Concurrent -+#endif -+import Control.Applicative ((<$>)) -+ -+import Data.Char (chr) -+import System.IO.Unsafe -+ - import Foreign hiding (new) - import Foreign.C.Types - import Foreign.ForeignPtr -@@ -124,30 +155,36 @@ - ------------------------------------------------------------------------ - -- JudyL Arrays - ---- | A JudyL array is a finite map from Word to Word values. -+-- | A JudyL array is a mutable, finite map from Word to Word values. -+-- It is threadsafe by default. - -- - -- A value is addressed by a key. The array may be sparse, and the key may - -- be any word-sized value. There are no duplicate keys. - -- - -- Values may be any instance of the JE class. - -- --newtype JudyL a = JudyL { unJudyL :: ForeignPtr JudyL_ } -- deriving Show -+newtype JudyL a = -+ JudyL { unJudyL :: -+#if !defined(UNSAFE) -+ MVar -+#endif -+ (ForeignPtr JudyL_) } - - type JudyL_ = Ptr JudyLArray - - data JudyLArray - ---- | Allocate a new empty JudyL array. A finalizer is associated with ---- the JudyL array, that will free it automatically once the last ---- reference has been dropped. Note that if you store pointers in the ---- Judy array we have no way of deallocating those -- you'll need to track ---- those yourself (e.g. via StableName or ForeignPtr). ---- ---- The Haskell GC will track references to the foreign resource, but the ---- foreign resource won't exert any heap pressure on the GC, meaning ---- that finalizers will be run much later than you expect. An explicit ---- 'performGC' can help with this. -+instance Show (JudyL a) where show _ = "" -+ -+-- | Allocate a new empty JudyL array. -+-- -+-- A finalizer is associated with the JudyL array, that will cause the -+-- garbage collector to free it automatically once the last reference -+-- has been dropped on the Haskell side. -+-- -+-- /Note: The Haskell GC will track references to the foreign resource, but the foreign resource won't exert any heap pressure on the GC, meaning that finalizers will be run much later than you expect. An explicit 'performGC' can help with this./ -+-- -+-- /Note: that if you store pointers in the Judy array we have no way of deallocating those -- you'll need to track those yourself (e.g. via StableName or ForeignPtr)/ - -- - new :: JE a => IO (JudyL a) - new = do -@@ -157,7 +194,14 @@ - -- note that the Haskell GC doesn't really know costly the arrays are. - addForeignPtrFinalizer c_judyl_free_ptr fp - withForeignPtr fp $ \p -> poke p (castPtr nullPtr) -+ -+#if defined(UNSAFE) - return $! JudyL fp -+#else -+ -- and make it threadsafe. -+ mv <- newMVar fp -+ return $! JudyL mv -+#endif - - ------------------------------------------------------------------------ - -@@ -216,15 +260,46 @@ - -- Any existing key will be overwritten. - -- - insert :: JE a => Key -> a -> JudyL a -> IO () --insert k v j = do -- withForeignPtr (unJudyL j) $ \p -> do -+insert k v m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif - v_ptr <- c_judy_lins p (fromIntegral k) nullError - if v_ptr == judyErrorPtr - then memoryError - else poke v_ptr =<< toWord v - {-# INLINE insert #-} - ---- TODO: fuse construction with uvectors. -+{- -+-- | Insert with a function, combining new value and old value. -+-- -+-- * If the key does not exist in the map, the value will be inserted. -+-- * If the key does exist, the combining function will be applied: f new old -+-- -+insertWith :: JE a => (a -> a -> a) -> Key -> a -> JudyL a -> IO () -+insertWith f k v m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif -+ v_ptr <- c_judy_lins p (fromIntegral k) nullError -+ if v_ptr == judyErrorPtr -+ then memoryError -+ --- WRONG! -+ else if v_ptr == nullPtr -+ -- not in the map -+ then poke v_ptr =<< toWord v -+ else do -+ old_v <- fromWord =<< peek v_ptr -+ new_v <- toWord (f v old_v) -+ poke v_ptr new_v -+{-# INLINE insertWith #-} -+-} - - ------------------------------------------------------------------------ - -@@ -248,8 +323,13 @@ - -- | Lookup a value associated with a key in the JudyL array. Return - -- Nothing if no value is found. - lookup :: JE a => Key -> JudyL a -> IO (Maybe a) --lookup k j = do -- withForeignPtr (unJudyL j) $ \p -> do -+lookup k m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif - q <- peek p -- get the actual judy array - v_ptr <- c_judy_lget q (fromIntegral k) nullError - if v_ptr == judyErrorPtr -@@ -257,10 +337,49 @@ - else if v_ptr == nullPtr - then return Nothing - else do -- v_word <- peek v_ptr -- return . Just =<< fromWord v_word -+ v <- fromWord =<< peek v_ptr -+ return . Just $! v - {-# INLINE lookup #-} - -+-- | Is the key a member of the map? -+member :: Key -> JudyL a -> IO Bool -+member k m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif -+ q <- peek p -- get the actual judy array -+ v_ptr <- c_judy_lget q (fromIntegral k) nullError -+ if v_ptr == judyErrorPtr -+ then memoryError -+ else return $! v_ptr /= nullPtr -+{-# INLINE member #-} -+ -+-- | Update a value at a specific key with the result of the provided -+-- function. When the key is not a member of the map, no change is made. -+adjust :: JE a => (a -> a) -> Key -> JudyL a -> IO () -+adjust f k m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif -+ q <- peek p -- get the actual judy array -+ v_ptr <- c_judy_lget q (fromIntegral k) nullError -+ if v_ptr == judyErrorPtr -+ then memoryError -+ else if v_ptr == nullPtr -+ then return () -+ else do -+ old_v <- fromWord =<< peek v_ptr -+ new_v <- toWord (f old_v) -+ poke v_ptr new_v -+{-# INLINE adjust #-} -+ -+ - -- > JudyLDel(&PJLArray, Index, &JError) - -- - -- as: -@@ -277,8 +396,13 @@ - -- | Delete the Index\/Value pair from the JudyL array. - -- - delete :: Key -> JudyL a -> IO () --delete k j = do -- withForeignPtr (unJudyL j) $ \p -> do -+delete k m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif - i <- c_judy_ldel p (fromIntegral k) nullError - if i == judyError then memoryError else return () - {-# INLINE delete #-} -@@ -301,18 +425,194 @@ - foreign import ccall unsafe "JudyLCount" - c_judy_lcount :: JudyL_ -> Key -> Key -> JError -> IO CInt - -+-- | /O(1)/, null. Is the map empty? -+null :: JudyL a -> IO Bool -+null m = (== 0) <$> size m -+{-# INLINE null #-} -+ - -- | /O(1)/, size. The number of elements in the map. - size :: JudyL a -> IO Int --size j = do -- withForeignPtr (unJudyL j) $ \p -> do -+size m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif - q <- peek p -- get the actual judy array - r <- c_judy_lcount q 0 (-1) nullError - return $! fromIntegral r - {-# INLINE size #-} - ---- TODO: fromList ---- TODO: toList ---- TODO: update -+------------------------------------------------------------------------ -+-- Iteration -+ -+ -+-- | -+-- > JLF(PValue, PJLArray, Index) // JudyLFirst() -+-- -+-- Search (inclusive) for the first index present that is equal to or greater -+-- than the passed Index. (Start with Index = 0 to find the first index in the -+-- array.) JLF() is typically used to begin a sorted-order scan of the indexes -+-- present in a JudyL array. -+-- -+-- If successful, Index is returned set to the found index, and PValue is -+-- returned set to a pointer to Index's Value. If unsuccessful, PValue is returned -+-- set to NULL, and Index contains no useful information. PValue must be tested -+-- for non-NULL prior to using Index, since a search failure is possible. -+-- -+foreign import ccall unsafe "JudyLFirst" -+ c_judy_lfirst :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word) -+ -+foreign import ccall unsafe "JudyLNext" -+ c_judy_lnext :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word) -+ -+foreign import ccall unsafe "JudyLPrev" -+ c_judy_lprev :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word) -+ -+foreign import ccall unsafe "JudyLLast" -+ c_judy_llast :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word) -+ -+ -+-- | findMin. Find the minimal key, and its associated value, in the map. -+-- Nothing if the map is empty. -+-- -+findMin :: JE a => JudyL a -> IO (Maybe (Key, a)) -+findMin m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif -+ q <- peek p -- get the actual judy array -+ alloca $ \k_ptr -> do -+ poke k_ptr 0 -- start at 0 -+ v_ptr <- c_judy_lfirst q k_ptr nullError -+ if v_ptr == nullPtr -+ then return Nothing -- empty -+ else do -+ v <- fromWord =<< peek v_ptr -+ k <- peek k_ptr -+ return . Just $! (k, v) -+{-# INLINE findMin #-} -+ -+-- | findMax. Find the maximal key, and its associated value, in the map. -+-- Nothing if the map is empty. -+-- -+findMax :: JE a => JudyL a -> IO (Maybe (Key, a)) -+findMax m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif -+ q <- peek p -- get the actual judy array -+ alloca $ \k_ptr -> do -+ poke k_ptr (-1) -- start at 0 -+ v_ptr <- c_judy_llast q k_ptr nullError -+ if v_ptr == nullPtr -+ then return Nothing -- empty -+ else do -+ v <- fromWord =<< peek v_ptr -+ k <- peek k_ptr -+ return . Just $! (k, v) -+{-# INLINE findMax #-} -+ -+------------------------------------------------------------------------ -+ -+-- | Return all keys of the map, /lazily/, in ascending order. -+keys :: JudyL a -> IO [Key] -+keys m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif -+ q <- peek p -- get the actual judy array -+ -+ -- Lazily loop through the keys -+ let go i = unsafeInterleaveIO (do -+ -- dellocate -+ r <- alloca $ \k_ptr -> do -+ poke k_ptr i -+ v_ptr <- c_judy_lnext q k_ptr nullError -+ if v_ptr == nullPtr -+ then return Nothing -+ else do -+ k <- peek k_ptr -+ return (Just k) -+ -+ case r of -+ Nothing -> return [] -+ Just k -> do xs <- go k -+ return (k:xs) -+ ) -+ -+ -+ -- Get the ball rolling with the first valid key -+ r <- alloca $ \k_ptr -> do -+ poke k_ptr 0 -+ v_ptr <- c_judy_lfirst q k_ptr nullError -+ if v_ptr == nullPtr -+ then return Nothing -+ else do -+ k <- peek k_ptr -+ return $! Just k -+ case r of -+ Nothing -> return [] -+ Just k -> do -+ xs <- go k -+ return (k : xs) -+ -+-- | Return all elems of the map, /lazily/, in ascending order. -+elems :: JE a => JudyL a -> IO [a] -+elems m = do -+#if !defined(UNSAFE) -+ withMVar (unJudyL m) $ \m_ -> -+ withForeignPtr m_ $ \p -> do -+#else -+ withForeignPtr (unJudyL m) $ \p -> do -+#endif -+ q <- peek p -- get the actual judy array -+ -+ -- Lazily loop through the keys -+ let go i = unsafeInterleaveIO (do -+ -- dellocate -+ r <- alloca $ \k_ptr -> do -+ poke k_ptr i -+ v_ptr <- c_judy_lnext q k_ptr nullError -+ if v_ptr == nullPtr -+ then return Nothing -+ else do -+ k <- peek k_ptr -+ v <- fromWord =<< peek v_ptr -+ return (Just (k,v)) -+ -+ case r of -+ Nothing -> return [] -+ Just (k,v) -> do xs <- go k -+ return (v:xs) -+ ) -+ -+ -+ -- Get the ball rolling with the first valid key -+ r <- alloca $ \k_ptr -> do -+ poke k_ptr 0 -+ v_ptr <- c_judy_lfirst q k_ptr nullError -+ if v_ptr == nullPtr -+ then return Nothing -+ else do -+ k <- peek k_ptr -+ v <- fromWord =<< peek v_ptr -+ return (Just (k,v)) -+ case r of -+ Nothing -> return [] -+ Just (k,v) -> do -+ xs <- go k -+ return (v : xs) - - ------------------------------------------------------------------------ - -- Judy errors -@@ -383,6 +683,8 @@ - -- You need to be able to convert the structure to a Word value, - -- or a word-sized pointer. - -- -+-- /Note: that it is possible to convert any Haskell value into a JE-type, via a StablePtr. This allocates an entry in the runtime's stable pointer table, giving you a pointer that may be passed to C, and that when dereferenced in Haskell will yield the original Haskell value. See the source for an example of this with strict bytestrings./ -+-- - class JE a where - -- | Convert the Haskell value to a word-sized type that may be stored in a JudyL - toWord :: a -> IO Word -@@ -489,23 +791,3 @@ - memoryError :: a - memoryError = error "Data.Judy: memory error with JudyL" - {-# NOINLINE memoryError #-} -- -------------------------------------------------------------------------- ---- ---- - Could be any Storable ---- - Could be any Haskell value thanks to StablePtr ---- - ST-based interface ---- - Freeze/Pure interface. ---- ---- TODO: make it thread safe. ---- ---- TODO: hash interface based on the document (cache hash, C function). ---- IntMap interface. ---- Split out basic interface. ---- ---- Binary instance? ---- ---- Fast bytestrings. ---- Performance benchmarks. ---- Type families to pick different underlying representations. ---- -diff -ru orig/judy.cabal new/judy.cabal ---- orig/judy.cabal 2014-02-02 18:54:27.418781709 +0200 -+++ new/judy.cabal 2014-02-02 18:54:26.000000000 +0200 -@@ -13,6 +13,10 @@ - build-type: Simple - tested-with: GHC ==6.8.2 - -+flag unsafe -+ description: Compile the library without locks. Code may be faster, but not threadsafe -+ default: False -+ - library - exposed-modules: Data.Judy - -@@ -34,3 +38,5 @@ - includes: haskell-judy.h - install-includes: haskell-judy.h - -+ if flag(unsafe) -+ cpp-options: -DUNSAFE -Only in orig: NOTES -Only in orig: tests diff --git a/patching/patches/judy-0.2.2.patch b/patching/patches/judy-0.2.2.patch new file mode 100644 index 00000000..d00baf90 --- /dev/null +++ b/patching/patches/judy-0.2.2.patch @@ -0,0 +1,13 @@ +diff -ru orig/Data/Judy.hsc new/Data/Judy.hsc +--- orig/Data/Judy.hsc 2014-02-03 16:55:49.814832674 +0200 ++++ new/Data/Judy.hsc 2014-02-03 16:55:49.000000000 +0200 +@@ -104,6 +104,7 @@ + import Foreign hiding (new) + import Foreign.C.Types + import Foreign.ForeignPtr ++import Data.Char (chr) + + import GHC.Ptr + import GHC.Base +Only in orig: NOTES +Only in orig: tests