@@ -0,0 +1,577 @@
1+diff -ru orig/Data/Judy.hsc new/Data/Judy.hsc
2+--- orig/Data/Judy.hsc 2014-02-02 18:54:27.414781709 +0200
3++++ new/Data/Judy.hsc 2014-02-02 18:54:26.000000000 +0200
7+ -- The memory used by a Judy array is nearly proportional to the
8+--- population (number of elements). Note that as Judy is allocated on
9+--- C language side, GHC's profiling system won't report memory use by
11++-- population (number of elements).
13+ -- For further references to the implementation, see:
15+ -- * <http://en.wikipedia.org/wiki/Judy_array>
17+--- Building a simple word-index table. About 4x faster than using an 'IntMap'
21+--- > import Control.Monad
22++-- Generate 1 million random integers. Report the largest one we see.
24++-- > import System.Random.Mersenne
25+ -- > import qualified Data.Judy as J
26++-- > import Control.Monad
29+--- > j <- J.new :: IO (J.JudyL Int)
30+--- > forM_ [1..10000000] $ \n -> J.insert n (fromIntegral n :: Int) j
31+--- > v <- J.lookup 100 j
36++-- > j <- J.new :: IO (J.JudyL Int)
37++-- > forM_ (take 1000000 rs) $ \n ->
39++-- > v <- J.findMax j
41++-- > Nothing -> print "Done."
42++-- > Just (k,_) -> print k
47+--- > $ ghc -O2 --make A.hs
48+--- > [1 of 1] Compiling Main ( A.hs, A.o )
53+--- > ./A 1.95s user 0.08s system 99% cpu 2.028 total
54++-- > $ ghc -O2 --make Test.hs
59++-- > 18446712059962695226
60++-- > ./Test 0.65s user 0.03s system 99% cpu 0.680 total
64++-- * /By default this library is threadsafe/.
66++-- * /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/
68++-- Sun Sep 27 17:12:24 PDT 2009: The library has only lightly been tested.
89++ -- * Insertion and removal
91++-- , Data.Judy.insertWith
108+ -- * Judy-storable types
113++#if !defined(UNSAFE)
114++import Control.Concurrent
116++import Control.Applicative ((<$>))
118++import Data.Char (chr)
119++import System.IO.Unsafe
121+ import Foreign hiding (new)
122+ import Foreign.C.Types
123+ import Foreign.ForeignPtr
124+@@ -124,30 +155,36 @@
125+ ------------------------------------------------------------------------
128+--- | A JudyL array is a finite map from Word to Word values.
129++-- | A JudyL array is a mutable, finite map from Word to Word values.
130++-- It is threadsafe by default.
132+ -- A value is addressed by a key. The array may be sparse, and the key may
133+ -- be any word-sized value. There are no duplicate keys.
135+ -- Values may be any instance of the JE class.
137+-newtype JudyL a = JudyL { unJudyL :: ForeignPtr JudyL_ }
141++#if !defined(UNSAFE)
144++ (ForeignPtr JudyL_) }
146+ type JudyL_ = Ptr JudyLArray
150+--- | Allocate a new empty JudyL array. A finalizer is associated with
151+--- the JudyL array, that will free it automatically once the last
152+--- reference has been dropped. Note that if you store pointers in the
153+--- Judy array we have no way of deallocating those -- you'll need to track
154+--- those yourself (e.g. via StableName or ForeignPtr).
156+--- The Haskell GC will track references to the foreign resource, but the
157+--- foreign resource won't exert any heap pressure on the GC, meaning
158+--- that finalizers will be run much later than you expect. An explicit
159+--- 'performGC' can help with this.
160++instance Show (JudyL a) where show _ = "<Judy a>"
162++-- | Allocate a new empty JudyL array.
164++-- A finalizer is associated with the JudyL array, that will cause the
165++-- garbage collector to free it automatically once the last reference
166++-- has been dropped on the Haskell side.
168++-- /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./
170++-- /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)/
172+ new :: JE a => IO (JudyL a)
175+ -- note that the Haskell GC doesn't really know costly the arrays are.
176+ addForeignPtrFinalizer c_judyl_free_ptr fp
177+ withForeignPtr fp $ \p -> poke p (castPtr nullPtr)
182++ -- and make it threadsafe.
187+ ------------------------------------------------------------------------
189+@@ -216,15 +260,46 @@
190+ -- Any existing key will be overwritten.
192+ insert :: JE a => Key -> a -> JudyL a -> IO ()
194+- withForeignPtr (unJudyL j) $ \p -> do
196++#if !defined(UNSAFE)
197++ withMVar (unJudyL m) $ \m_ ->
198++ withForeignPtr m_ $ \p -> do
200++ withForeignPtr (unJudyL m) $ \p -> do
202+ v_ptr <- c_judy_lins p (fromIntegral k) nullError
203+ if v_ptr == judyErrorPtr
205+ else poke v_ptr =<< toWord v
206+ {-# INLINE insert #-}
208+--- TODO: fuse construction with uvectors.
210++-- | Insert with a function, combining new value and old value.
212++-- * If the key does not exist in the map, the value will be inserted.
213++-- * If the key does exist, the combining function will be applied: f new old
215++insertWith :: JE a => (a -> a -> a) -> Key -> a -> JudyL a -> IO ()
216++insertWith f k v m = do
217++#if !defined(UNSAFE)
218++ withMVar (unJudyL m) $ \m_ ->
219++ withForeignPtr m_ $ \p -> do
221++ withForeignPtr (unJudyL m) $ \p -> do
223++ v_ptr <- c_judy_lins p (fromIntegral k) nullError
224++ if v_ptr == judyErrorPtr
227++ else if v_ptr == nullPtr
229++ then poke v_ptr =<< toWord v
231++ old_v <- fromWord =<< peek v_ptr
232++ new_v <- toWord (f v old_v)
234++{-# INLINE insertWith #-}
237+ ------------------------------------------------------------------------
240+ -- | Lookup a value associated with a key in the JudyL array. Return
241+ -- Nothing if no value is found.
242+ lookup :: JE a => Key -> JudyL a -> IO (Maybe a)
244+- withForeignPtr (unJudyL j) $ \p -> do
246++#if !defined(UNSAFE)
247++ withMVar (unJudyL m) $ \m_ ->
248++ withForeignPtr m_ $ \p -> do
250++ withForeignPtr (unJudyL m) $ \p -> do
252+ q <- peek p -- get the actual judy array
253+ v_ptr <- c_judy_lget q (fromIntegral k) nullError
254+ if v_ptr == judyErrorPtr
255+@@ -257,10 +337,49 @@
256+ else if v_ptr == nullPtr
259+- v_word <- peek v_ptr
260+- return . Just =<< fromWord v_word
261++ v <- fromWord =<< peek v_ptr
263+ {-# INLINE lookup #-}
265++-- | Is the key a member of the map?
266++member :: Key -> JudyL a -> IO Bool
268++#if !defined(UNSAFE)
269++ withMVar (unJudyL m) $ \m_ ->
270++ withForeignPtr m_ $ \p -> do
272++ withForeignPtr (unJudyL m) $ \p -> do
274++ q <- peek p -- get the actual judy array
275++ v_ptr <- c_judy_lget q (fromIntegral k) nullError
276++ if v_ptr == judyErrorPtr
278++ else return $! v_ptr /= nullPtr
279++{-# INLINE member #-}
281++-- | Update a value at a specific key with the result of the provided
282++-- function. When the key is not a member of the map, no change is made.
283++adjust :: JE a => (a -> a) -> Key -> JudyL a -> IO ()
285++#if !defined(UNSAFE)
286++ withMVar (unJudyL m) $ \m_ ->
287++ withForeignPtr m_ $ \p -> do
289++ withForeignPtr (unJudyL m) $ \p -> do
291++ q <- peek p -- get the actual judy array
292++ v_ptr <- c_judy_lget q (fromIntegral k) nullError
293++ if v_ptr == judyErrorPtr
295++ else if v_ptr == nullPtr
298++ old_v <- fromWord =<< peek v_ptr
299++ new_v <- toWord (f old_v)
301++{-# INLINE adjust #-}
304+ -- > JudyLDel(&PJLArray, Index, &JError)
308+ -- | Delete the Index\/Value pair from the JudyL array.
310+ delete :: Key -> JudyL a -> IO ()
312+- withForeignPtr (unJudyL j) $ \p -> do
314++#if !defined(UNSAFE)
315++ withMVar (unJudyL m) $ \m_ ->
316++ withForeignPtr m_ $ \p -> do
318++ withForeignPtr (unJudyL m) $ \p -> do
320+ i <- c_judy_ldel p (fromIntegral k) nullError
321+ if i == judyError then memoryError else return ()
322+ {-# INLINE delete #-}
323+@@ -301,18 +425,194 @@
324+ foreign import ccall unsafe "JudyLCount"
325+ c_judy_lcount :: JudyL_ -> Key -> Key -> JError -> IO CInt
327++-- | /O(1)/, null. Is the map empty?
328++null :: JudyL a -> IO Bool
329++null m = (== 0) <$> size m
332+ -- | /O(1)/, size. The number of elements in the map.
333+ size :: JudyL a -> IO Int
335+- withForeignPtr (unJudyL j) $ \p -> do
337++#if !defined(UNSAFE)
338++ withMVar (unJudyL m) $ \m_ ->
339++ withForeignPtr m_ $ \p -> do
341++ withForeignPtr (unJudyL m) $ \p -> do
343+ q <- peek p -- get the actual judy array
344+ r <- c_judy_lcount q 0 (-1) nullError
345+ return $! fromIntegral r
351++------------------------------------------------------------------------
356++-- > JLF(PValue, PJLArray, Index) // JudyLFirst()
358++-- Search (inclusive) for the first index present that is equal to or greater
359++-- than the passed Index. (Start with Index = 0 to find the first index in the
360++-- array.) JLF() is typically used to begin a sorted-order scan of the indexes
361++-- present in a JudyL array.
363++-- If successful, Index is returned set to the found index, and PValue is
364++-- returned set to a pointer to Index's Value. If unsuccessful, PValue is returned
365++-- set to NULL, and Index contains no useful information. PValue must be tested
366++-- for non-NULL prior to using Index, since a search failure is possible.
368++foreign import ccall unsafe "JudyLFirst"
369++ c_judy_lfirst :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word)
371++foreign import ccall unsafe "JudyLNext"
372++ c_judy_lnext :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word)
374++foreign import ccall unsafe "JudyLPrev"
375++ c_judy_lprev :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word)
377++foreign import ccall unsafe "JudyLLast"
378++ c_judy_llast :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word)
381++-- | findMin. Find the minimal key, and its associated value, in the map.
382++-- Nothing if the map is empty.
384++findMin :: JE a => JudyL a -> IO (Maybe (Key, a))
386++#if !defined(UNSAFE)
387++ withMVar (unJudyL m) $ \m_ ->
388++ withForeignPtr m_ $ \p -> do
390++ withForeignPtr (unJudyL m) $ \p -> do
392++ q <- peek p -- get the actual judy array
393++ alloca $ \k_ptr -> do
394++ poke k_ptr 0 -- start at 0
395++ v_ptr <- c_judy_lfirst q k_ptr nullError
396++ if v_ptr == nullPtr
397++ then return Nothing -- empty
399++ v <- fromWord =<< peek v_ptr
401++ return . Just $! (k, v)
402++{-# INLINE findMin #-}
404++-- | findMax. Find the maximal key, and its associated value, in the map.
405++-- Nothing if the map is empty.
407++findMax :: JE a => JudyL a -> IO (Maybe (Key, a))
409++#if !defined(UNSAFE)
410++ withMVar (unJudyL m) $ \m_ ->
411++ withForeignPtr m_ $ \p -> do
413++ withForeignPtr (unJudyL m) $ \p -> do
415++ q <- peek p -- get the actual judy array
416++ alloca $ \k_ptr -> do
417++ poke k_ptr (-1) -- start at 0
418++ v_ptr <- c_judy_llast q k_ptr nullError
419++ if v_ptr == nullPtr
420++ then return Nothing -- empty
422++ v <- fromWord =<< peek v_ptr
424++ return . Just $! (k, v)
425++{-# INLINE findMax #-}
427++------------------------------------------------------------------------
429++-- | Return all keys of the map, /lazily/, in ascending order.
430++keys :: JudyL a -> IO [Key]
432++#if !defined(UNSAFE)
433++ withMVar (unJudyL m) $ \m_ ->
434++ withForeignPtr m_ $ \p -> do
436++ withForeignPtr (unJudyL m) $ \p -> do
438++ q <- peek p -- get the actual judy array
440++ -- Lazily loop through the keys
441++ let go i = unsafeInterleaveIO (do
443++ r <- alloca $ \k_ptr -> do
445++ v_ptr <- c_judy_lnext q k_ptr nullError
446++ if v_ptr == nullPtr
447++ then return Nothing
453++ Nothing -> return []
454++ Just k -> do xs <- go k
459++ -- Get the ball rolling with the first valid key
460++ r <- alloca $ \k_ptr -> do
462++ v_ptr <- c_judy_lfirst q k_ptr nullError
463++ if v_ptr == nullPtr
464++ then return Nothing
469++ Nothing -> return []
474++-- | Return all elems of the map, /lazily/, in ascending order.
475++elems :: JE a => JudyL a -> IO [a]
477++#if !defined(UNSAFE)
478++ withMVar (unJudyL m) $ \m_ ->
479++ withForeignPtr m_ $ \p -> do
481++ withForeignPtr (unJudyL m) $ \p -> do
483++ q <- peek p -- get the actual judy array
485++ -- Lazily loop through the keys
486++ let go i = unsafeInterleaveIO (do
488++ r <- alloca $ \k_ptr -> do
490++ v_ptr <- c_judy_lnext q k_ptr nullError
491++ if v_ptr == nullPtr
492++ then return Nothing
495++ v <- fromWord =<< peek v_ptr
496++ return (Just (k,v))
499++ Nothing -> return []
500++ Just (k,v) -> do xs <- go k
505++ -- Get the ball rolling with the first valid key
506++ r <- alloca $ \k_ptr -> do
508++ v_ptr <- c_judy_lfirst q k_ptr nullError
509++ if v_ptr == nullPtr
510++ then return Nothing
513++ v <- fromWord =<< peek v_ptr
514++ return (Just (k,v))
516++ Nothing -> return []
521+ ------------------------------------------------------------------------
524+ -- You need to be able to convert the structure to a Word value,
525+ -- or a word-sized pointer.
527++-- /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./
530+ -- | Convert the Haskell value to a word-sized type that may be stored in a JudyL
531+ toWord :: a -> IO Word
534+ memoryError = error "Data.Judy: memory error with JudyL"
535+ {-# NOINLINE memoryError #-}
537+-------------------------------------------------------------------------
539+--- - Could be any Storable
540+--- - Could be any Haskell value thanks to StablePtr
541+--- - ST-based interface
542+--- - Freeze/Pure interface.
544+--- TODO: make it thread safe.
546+--- TODO: hash interface based on the document (cache hash, C function).
547+--- IntMap interface.
548+--- Split out basic interface.
552+--- Fast bytestrings.
553+--- Performance benchmarks.
554+--- Type families to pick different underlying representations.
556+diff -ru orig/judy.cabal new/judy.cabal
557+--- orig/judy.cabal 2014-02-02 18:54:27.418781709 +0200
558++++ new/judy.cabal 2014-02-02 18:54:26.000000000 +0200
561+ tested-with: GHC ==6.8.2
564++ description: Compile the library without locks. Code may be faster, but not threadsafe
568+ exposed-modules: Data.Judy
571+ includes: haskell-judy.h
572+ install-includes: haskell-judy.h
575++ cpp-options: -DUNSAFE