@@ -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
4+@@ -16,61 +16,92 @@
5+ -- data sets.
6+ --
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
10+--- Judy arrays.
11++-- population (number of elements).
12+ --
13+ -- For further references to the implementation, see:
14+ --
15+ -- * <http://en.wikipedia.org/wiki/Judy_array>
16+ --
17+--- Building a simple word-index table. About 4x faster than using an 'IntMap'
18++-- /Examples/:
19+ --
20+--- >
21+--- > import Control.Monad
22++-- Generate 1 million random integers. Report the largest one we see.
23++--
24++-- > import System.Random.Mersenne
25+ -- > import qualified Data.Judy as J
26++-- > import Control.Monad
27+ -- >
28+ -- > main = do
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
32+--- > print v
33+--- >
34++-- > g <- getStdGen
35++-- > rs <- randoms g
36++-- > j <- J.new :: IO (J.JudyL Int)
37++-- > forM_ (take 1000000 rs) $ \n ->
38++-- > J.insert n 1 j
39++-- > v <- J.findMax j
40++-- > case v of
41++-- > Nothing -> print "Done."
42++-- > Just (k,_) -> print k
43+ --
44+--- Running this:
45++-- Compile it:
46+ --
47+--- > $ ghc -O2 --make A.hs
48+--- > [1 of 1] Compiling Main ( A.hs, A.o )
49+--- > Linking A ...
50+---
51+--- > $ time ./A
52+--- > Just 100
53+--- > ./A 1.95s user 0.08s system 99% cpu 2.028 total
54++-- > $ ghc -O2 --make Test.hs
55++--
56++-- Running it:
57++--
58++-- > $ time ./Test
59++-- > 18446712059962695226
60++-- > ./Test 0.65s user 0.03s system 99% cpu 0.680 total
61++--
62++-- /Notes/:
63++--
64++-- * /By default this library is threadsafe/.
65++--
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/
67++--
68++-- Sun Sep 27 17:12:24 PDT 2009: The library has only lightly been tested.
69+ --
70+-
71+ module Data.Judy (
72+
73+ -- * Basic types
74+ JudyL, Key
75+
76+- -- * Operations
77++ -- * Construction
78+ , Data.Judy.new
79++
80++ -- * Queries
81++ , Data.Judy.null
82+ , Data.Judy.size
83+- , Data.Judy.insert
84+- -- insertWith
85++ , Data.Judy.member
86+ , Data.Judy.lookup
87+- -- member
88++
89++ -- * Insertion and removal
90++ , Data.Judy.insert
91++-- , Data.Judy.insertWith
92+ , Data.Judy.delete
93+- -- adjust
94+- -- update
95++ , Data.Judy.adjust
96++
97++ -- * Min/Max
98++ , Data.Judy.findMin
99++ , Data.Judy.findMax
100+
101+--- memoryUsed
102++ -- * Conversion
103++ , Data.Judy.keys
104++ , Data.Judy.elems
105++
106++-- memoryUsed
107+
108+ -- * Judy-storable types
109+ , JE(..)
110+
111+ ) where
112+
113++#if !defined(UNSAFE)
114++import Control.Concurrent
115++#endif
116++import Control.Applicative ((<$>))
117++
118++import Data.Char (chr)
119++import System.IO.Unsafe
120++
121+ import Foreign hiding (new)
122+ import Foreign.C.Types
123+ import Foreign.ForeignPtr
124+@@ -124,30 +155,36 @@
125+ ------------------------------------------------------------------------
126+ -- JudyL Arrays
127+
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.
131+ --
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.
134+ --
135+ -- Values may be any instance of the JE class.
136+ --
137+-newtype JudyL a = JudyL { unJudyL :: ForeignPtr JudyL_ }
138+- deriving Show
139++newtype JudyL a =
140++ JudyL { unJudyL ::
141++#if !defined(UNSAFE)
142++ MVar
143++#endif
144++ (ForeignPtr JudyL_) }
145+
146+ type JudyL_ = Ptr JudyLArray
147+
148+ data JudyLArray
149+
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).
155+---
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>"
161++
162++-- | Allocate a new empty JudyL array.
163++--
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.
167++--
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./
169++--
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)/
171+ --
172+ new :: JE a => IO (JudyL a)
173+ new = do
174+@@ -157,7 +194,14 @@
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)
178++
179++#if defined(UNSAFE)
180+ return $! JudyL fp
181++#else
182++ -- and make it threadsafe.
183++ mv <- newMVar fp
184++ return $! JudyL mv
185++#endif
186+
187+ ------------------------------------------------------------------------
188+
189+@@ -216,15 +260,46 @@
190+ -- Any existing key will be overwritten.
191+ --
192+ insert :: JE a => Key -> a -> JudyL a -> IO ()
193+-insert k v j = do
194+- withForeignPtr (unJudyL j) $ \p -> do
195++insert k v m = do
196++#if !defined(UNSAFE)
197++ withMVar (unJudyL m) $ \m_ ->
198++ withForeignPtr m_ $ \p -> do
199++#else
200++ withForeignPtr (unJudyL m) $ \p -> do
201++#endif
202+ v_ptr <- c_judy_lins p (fromIntegral k) nullError
203+ if v_ptr == judyErrorPtr
204+ then memoryError
205+ else poke v_ptr =<< toWord v
206+ {-# INLINE insert #-}
207+
208+--- TODO: fuse construction with uvectors.
209++{-
210++-- | Insert with a function, combining new value and old value.
211++--
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
214++--
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
220++#else
221++ withForeignPtr (unJudyL m) $ \p -> do
222++#endif
223++ v_ptr <- c_judy_lins p (fromIntegral k) nullError
224++ if v_ptr == judyErrorPtr
225++ then memoryError
226++ --- WRONG!
227++ else if v_ptr == nullPtr
228++ -- not in the map
229++ then poke v_ptr =<< toWord v
230++ else do
231++ old_v <- fromWord =<< peek v_ptr
232++ new_v <- toWord (f v old_v)
233++ poke v_ptr new_v
234++{-# INLINE insertWith #-}
235++-}
236+
237+ ------------------------------------------------------------------------
238+
239+@@ -248,8 +323,13 @@
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)
243+-lookup k j = do
244+- withForeignPtr (unJudyL j) $ \p -> do
245++lookup k m = do
246++#if !defined(UNSAFE)
247++ withMVar (unJudyL m) $ \m_ ->
248++ withForeignPtr m_ $ \p -> do
249++#else
250++ withForeignPtr (unJudyL m) $ \p -> do
251++#endif
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
257+ then return Nothing
258+ else do
259+- v_word <- peek v_ptr
260+- return . Just =<< fromWord v_word
261++ v <- fromWord =<< peek v_ptr
262++ return . Just $! v
263+ {-# INLINE lookup #-}
264+
265++-- | Is the key a member of the map?
266++member :: Key -> JudyL a -> IO Bool
267++member k m = do
268++#if !defined(UNSAFE)
269++ withMVar (unJudyL m) $ \m_ ->
270++ withForeignPtr m_ $ \p -> do
271++#else
272++ withForeignPtr (unJudyL m) $ \p -> do
273++#endif
274++ q <- peek p -- get the actual judy array
275++ v_ptr <- c_judy_lget q (fromIntegral k) nullError
276++ if v_ptr == judyErrorPtr
277++ then memoryError
278++ else return $! v_ptr /= nullPtr
279++{-# INLINE member #-}
280++
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 ()
284++adjust f k m = do
285++#if !defined(UNSAFE)
286++ withMVar (unJudyL m) $ \m_ ->
287++ withForeignPtr m_ $ \p -> do
288++#else
289++ withForeignPtr (unJudyL m) $ \p -> do
290++#endif
291++ q <- peek p -- get the actual judy array
292++ v_ptr <- c_judy_lget q (fromIntegral k) nullError
293++ if v_ptr == judyErrorPtr
294++ then memoryError
295++ else if v_ptr == nullPtr
296++ then return ()
297++ else do
298++ old_v <- fromWord =<< peek v_ptr
299++ new_v <- toWord (f old_v)
300++ poke v_ptr new_v
301++{-# INLINE adjust #-}
302++
303++
304+ -- > JudyLDel(&PJLArray, Index, &JError)
305+ --
306+ -- as:
307+@@ -277,8 +396,13 @@
308+ -- | Delete the Index\/Value pair from the JudyL array.
309+ --
310+ delete :: Key -> JudyL a -> IO ()
311+-delete k j = do
312+- withForeignPtr (unJudyL j) $ \p -> do
313++delete k m = do
314++#if !defined(UNSAFE)
315++ withMVar (unJudyL m) $ \m_ ->
316++ withForeignPtr m_ $ \p -> do
317++#else
318++ withForeignPtr (unJudyL m) $ \p -> do
319++#endif
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
326+
327++-- | /O(1)/, null. Is the map empty?
328++null :: JudyL a -> IO Bool
329++null m = (== 0) <$> size m
330++{-# INLINE null #-}
331++
332+ -- | /O(1)/, size. The number of elements in the map.
333+ size :: JudyL a -> IO Int
334+-size j = do
335+- withForeignPtr (unJudyL j) $ \p -> do
336++size m = do
337++#if !defined(UNSAFE)
338++ withMVar (unJudyL m) $ \m_ ->
339++ withForeignPtr m_ $ \p -> do
340++#else
341++ withForeignPtr (unJudyL m) $ \p -> do
342++#endif
343+ q <- peek p -- get the actual judy array
344+ r <- c_judy_lcount q 0 (-1) nullError
345+ return $! fromIntegral r
346+ {-# INLINE size #-}
347+
348+--- TODO: fromList
349+--- TODO: toList
350+--- TODO: update
351++------------------------------------------------------------------------
352++-- Iteration
353++
354++
355++-- |
356++-- > JLF(PValue, PJLArray, Index) // JudyLFirst()
357++--
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.
362++--
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.
367++--
368++foreign import ccall unsafe "JudyLFirst"
369++ c_judy_lfirst :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word)
370++
371++foreign import ccall unsafe "JudyLNext"
372++ c_judy_lnext :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word)
373++
374++foreign import ccall unsafe "JudyLPrev"
375++ c_judy_lprev :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word)
376++
377++foreign import ccall unsafe "JudyLLast"
378++ c_judy_llast :: JudyL_ -> Ptr Key -> JError -> IO (Ptr Word)
379++
380++
381++-- | findMin. Find the minimal key, and its associated value, in the map.
382++-- Nothing if the map is empty.
383++--
384++findMin :: JE a => JudyL a -> IO (Maybe (Key, a))
385++findMin m = do
386++#if !defined(UNSAFE)
387++ withMVar (unJudyL m) $ \m_ ->
388++ withForeignPtr m_ $ \p -> do
389++#else
390++ withForeignPtr (unJudyL m) $ \p -> do
391++#endif
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
398++ else do
399++ v <- fromWord =<< peek v_ptr
400++ k <- peek k_ptr
401++ return . Just $! (k, v)
402++{-# INLINE findMin #-}
403++
404++-- | findMax. Find the maximal key, and its associated value, in the map.
405++-- Nothing if the map is empty.
406++--
407++findMax :: JE a => JudyL a -> IO (Maybe (Key, a))
408++findMax m = do
409++#if !defined(UNSAFE)
410++ withMVar (unJudyL m) $ \m_ ->
411++ withForeignPtr m_ $ \p -> do
412++#else
413++ withForeignPtr (unJudyL m) $ \p -> do
414++#endif
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
421++ else do
422++ v <- fromWord =<< peek v_ptr
423++ k <- peek k_ptr
424++ return . Just $! (k, v)
425++{-# INLINE findMax #-}
426++
427++------------------------------------------------------------------------
428++
429++-- | Return all keys of the map, /lazily/, in ascending order.
430++keys :: JudyL a -> IO [Key]
431++keys m = do
432++#if !defined(UNSAFE)
433++ withMVar (unJudyL m) $ \m_ ->
434++ withForeignPtr m_ $ \p -> do
435++#else
436++ withForeignPtr (unJudyL m) $ \p -> do
437++#endif
438++ q <- peek p -- get the actual judy array
439++
440++ -- Lazily loop through the keys
441++ let go i = unsafeInterleaveIO (do
442++ -- dellocate
443++ r <- alloca $ \k_ptr -> do
444++ poke k_ptr i
445++ v_ptr <- c_judy_lnext q k_ptr nullError
446++ if v_ptr == nullPtr
447++ then return Nothing
448++ else do
449++ k <- peek k_ptr
450++ return (Just k)
451++
452++ case r of
453++ Nothing -> return []
454++ Just k -> do xs <- go k
455++ return (k:xs)
456++ )
457++
458++
459++ -- Get the ball rolling with the first valid key
460++ r <- alloca $ \k_ptr -> do
461++ poke k_ptr 0
462++ v_ptr <- c_judy_lfirst q k_ptr nullError
463++ if v_ptr == nullPtr
464++ then return Nothing
465++ else do
466++ k <- peek k_ptr
467++ return $! Just k
468++ case r of
469++ Nothing -> return []
470++ Just k -> do
471++ xs <- go k
472++ return (k : xs)
473++
474++-- | Return all elems of the map, /lazily/, in ascending order.
475++elems :: JE a => JudyL a -> IO [a]
476++elems m = do
477++#if !defined(UNSAFE)
478++ withMVar (unJudyL m) $ \m_ ->
479++ withForeignPtr m_ $ \p -> do
480++#else
481++ withForeignPtr (unJudyL m) $ \p -> do
482++#endif
483++ q <- peek p -- get the actual judy array
484++
485++ -- Lazily loop through the keys
486++ let go i = unsafeInterleaveIO (do
487++ -- dellocate
488++ r <- alloca $ \k_ptr -> do
489++ poke k_ptr i
490++ v_ptr <- c_judy_lnext q k_ptr nullError
491++ if v_ptr == nullPtr
492++ then return Nothing
493++ else do
494++ k <- peek k_ptr
495++ v <- fromWord =<< peek v_ptr
496++ return (Just (k,v))
497++
498++ case r of
499++ Nothing -> return []
500++ Just (k,v) -> do xs <- go k
501++ return (v:xs)
502++ )
503++
504++
505++ -- Get the ball rolling with the first valid key
506++ r <- alloca $ \k_ptr -> do
507++ poke k_ptr 0
508++ v_ptr <- c_judy_lfirst q k_ptr nullError
509++ if v_ptr == nullPtr
510++ then return Nothing
511++ else do
512++ k <- peek k_ptr
513++ v <- fromWord =<< peek v_ptr
514++ return (Just (k,v))
515++ case r of
516++ Nothing -> return []
517++ Just (k,v) -> do
518++ xs <- go k
519++ return (v : xs)
520+
521+ ------------------------------------------------------------------------
522+ -- Judy errors
523+@@ -383,6 +683,8 @@
524+ -- You need to be able to convert the structure to a Word value,
525+ -- or a word-sized pointer.
526+ --
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./
528++--
529+ class JE a where
530+ -- | Convert the Haskell value to a word-sized type that may be stored in a JudyL
531+ toWord :: a -> IO Word
532+@@ -489,23 +791,3 @@
533+ memoryError :: a
534+ memoryError = error "Data.Judy: memory error with JudyL"
535+ {-# NOINLINE memoryError #-}
536+-
537+-------------------------------------------------------------------------
538+---
539+--- - Could be any Storable
540+--- - Could be any Haskell value thanks to StablePtr
541+--- - ST-based interface
542+--- - Freeze/Pure interface.
543+---
544+--- TODO: make it thread safe.
545+---
546+--- TODO: hash interface based on the document (cache hash, C function).
547+--- IntMap interface.
548+--- Split out basic interface.
549+---
550+--- Binary instance?
551+---
552+--- Fast bytestrings.
553+--- Performance benchmarks.
554+--- Type families to pick different underlying representations.
555+---
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
559+@@ -13,6 +13,10 @@
560+ build-type: Simple
561+ tested-with: GHC ==6.8.2
562+
563++flag unsafe
564++ description: Compile the library without locks. Code may be faster, but not threadsafe
565++ default: False
566++
567+ library
568+ exposed-modules: Data.Judy
569+
570+@@ -34,3 +38,5 @@
571+ includes: haskell-judy.h
572+ install-includes: haskell-judy.h
573+
574++ if flag(unsafe)
575++ cpp-options: -DUNSAFE
576+Only in orig: NOTES
577+Only in orig: tests