Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add 'equals' and 'nequals' for Eq instance

Remove unused utility functions
  • Loading branch information...
commit 28ec08e35d2d000fc5e2920145928318681f810d 1 parent 49ba13a
authored October 16, 2012
75  Data/EnumMapSet.hs
@@ -56,11 +56,11 @@ import           GHC.Prim (indexInt8OffAddr#)
56 56
 
57 57
 import           Data.EnumMapMap.Base ((:&)(..), K(..), EMM(..),
58 58
                                        IsEmm,
59  
-                                       EnumMapMap(..),
60  
-                                       Prefix, Mask, Key, Nat,
  59
+                                       EnumMapMap,
  60
+                                       Prefix, Nat,
61 61
                                        intFromNat, bin,
62 62
                                        shiftRL, shiftLL,
63  
-                                       match, nomatch, zero,
  63
+                                       nomatch, zero,
64 64
                                        join, shorter,
65 65
                                        foldlStrict)
66 66
 import qualified Data.EnumMapMap.Base as EMM
@@ -223,6 +223,24 @@ instance (Enum k) => IsEmm (K k) where
223 223
 
224 224
           go Nil _ = Nil
225 225
 
  226
+    equal (KSC ems1) (KSC ems2) = go ems1 ems2
  227
+        where
  228
+          go (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
  229
+              = (m1 == m2) && (p1 == p2) && (go l1 l2) && (go r1 r2)
  230
+          go (Tip kx1 bm1) (Tip kx2 bm2)
  231
+              = kx1 == kx2 && bm1 == bm2
  232
+          go Nil Nil = True
  233
+          go _   _   = False
  234
+
  235
+    nequal (KSC ems1) (KSC ems2) = go ems1 ems2
  236
+        where
  237
+          go (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
  238
+              = (m1 /= m2) || (p1 /= p2) || (go l1 l2) || (go r1 r2)
  239
+          go (Tip kx1 bm1) (Tip kx2 bm2)
  240
+              = kx1 /= kx2 || bm1 /= bm2
  241
+          go Nil Nil = False
  242
+          go _   _   = True
  243
+
226 244
     insertWith = undefined
227 245
     insertWithKey = undefined
228 246
     lookup = undefined
@@ -303,6 +321,10 @@ toList :: IsEmm k => EnumMapSet k -> [k]
303 321
 toList = foldr (:) []
304 322
 
305 323
 {---------------------------------------------------------------------
  324
+  Instances
  325
+---------------------------------------------------------------------}
  326
+
  327
+{---------------------------------------------------------------------
306 328
   Helper functions
307 329
 ---------------------------------------------------------------------}
308 330
 
@@ -375,19 +397,6 @@ bitcount a0 x0 = go a0 x0
375 397
         go a x = go (a + 1) (x .&. (x-1))
376 398
 {-# INLINE bitcount #-}
377 399
 
378  
-highestBitMask :: Nat -> Nat
379  
-highestBitMask x0
380  
-  = case (x0 .|. shiftRL x0 1) of
381  
-     x1 -> case (x1 .|. shiftRL x1 2) of
382  
-      x2 -> case (x2 .|. shiftRL x2 4) of
383  
-       x3 -> case (x3 .|. shiftRL x3 8) of
384  
-        x4 -> case (x4 .|. shiftRL x4 16) of
385  
-#if !(defined(__GLASGOW_HASKELL__) && WORD_SIZE_IN_BITS==32)
386  
-         x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms
387  
-#endif
388  
-          x6 -> (x6 `xor` (shiftRL x6 1))
389  
-{-# INLINE highestBitMask #-}
390  
-
391 400
 {----------------------------------------------------------------------
392 401
   Folds over a BitMap.
393 402
 
@@ -395,19 +404,9 @@ highestBitMask x0
395 404
   Data/IntSet/Base.hs in 'containers 5.0'.
396 405
 ----------------------------------------------------------------------}
397 406
 
398  
-lowestBitSet :: Nat -> Int
399  
-highestBitSet :: Nat -> Int
400  
-foldlBits :: Int -> (a -> Int -> a) -> a -> Nat -> a
401  
-foldl'Bits :: Int -> (a -> Int -> a) -> a -> Nat -> a
402 407
 foldrBits :: Int -> (Int -> a -> a) -> a -> Nat -> a
403  
-foldr'Bits :: Int -> (Int -> a -> a) -> a -> Nat -> a
404 408
 
405  
-{-# INLINE lowestBitSet #-}
406  
-{-# INLINE highestBitSet #-}
407  
-{-# INLINE foldlBits #-}
408  
-{-# INLINE foldl'Bits #-}
409 409
 {-# INLINE foldrBits #-}
410  
-{-# INLINE foldr'Bits #-}
411 410
 
412 411
 indexOfTheOnlyBit :: Nat -> Int
413 412
 {-# INLINE indexOfTheOnlyBit #-}
@@ -443,32 +442,8 @@ revNat x1 = case ((x1 `shiftRL` 1) .&. 0x5555555555555555) .|. ((x1 .&. 0x555555
443 442
                      x5 -> case ((x5 `shiftRL` 16) .&. 0x0000FFFF0000FFFF) .|. ((x5 .&. 0x0000FFFF0000FFFF) `shiftLL` 16) of
444 443
                        x6 -> ( x6 `shiftRL` 32             ) .|. ( x6               `shiftLL` 32);
445 444
 #endif
446  
-
447  
-lowestBitSet x = indexOfTheOnlyBit (lowestBitMask x)
448  
-
449  
-highestBitSet x = indexOfTheOnlyBit (highestBitMask x)
450  
-
451  
-foldlBits prefix f z bitmap = go bitmap z
452  
-  where go bm acc | bm == 0 = acc
453  
-                  | otherwise = case lowestBitMask bm of
454  
-                                  bitmask -> bitmask `seq` case indexOfTheOnlyBit bitmask of
455  
-                                    bi -> bi `seq` go (bm `xor` bitmask) ((f acc) $! (prefix+bi))
456  
-
457  
-foldl'Bits prefix f z bitmap = go bitmap z
458  
-  where go bm !acc | bm == 0 = acc
459  
-                   | otherwise = case lowestBitMask bm of
460  
-                                  bitmask -> bitmask `seq` case indexOfTheOnlyBit bitmask of
461  
-                                    bi -> bi `seq` go (bm `xor` bitmask) ((f acc) $! (prefix+bi))
462  
-
463 445
 foldrBits prefix f z bitmap = go (revNat bitmap) z
464 446
   where go bm acc | bm == 0 = acc
465 447
                   | otherwise = case lowestBitMask bm of
466 448
                                   bitmask -> bitmask `seq` case indexOfTheOnlyBit bitmask of
467 449
                                     bi -> bi `seq` go (bm `xor` bitmask) ((f $! (prefix+(WORD_SIZE_IN_BITS-1)-bi)) acc)
468  
-
469  
-foldr'Bits prefix f z bitmap = go (revNat bitmap) z
470  
-  where go bm !acc | bm == 0 = acc
471  
-                   | otherwise = case lowestBitMask bm of
472  
-                                  bitmask -> bitmask `seq` case indexOfTheOnlyBit bitmask of
473  
-                                    bi -> bi `seq` go (bm `xor` bitmask) ((f $! (prefix+(WORD_SIZE_IN_BITS-1)-bi)) acc)
474  
-
16  test/EnumMapSetVsIntSet.hs
@@ -199,3 +199,19 @@ main = hspec $ do
199 199
            runPropDuoL2 IS.intersection EMS.intersection
200 200
       prop "Level 3" $
201 201
            runPropDuoL3 IS.intersection EMS.intersection
  202
+
  203
+    describe "equals" $ do
  204
+      prop "Level 1" $
  205
+           runPropDuo1 (==) (==)
  206
+      prop "Level 2" $
  207
+           runPropDuo2 (==) (==)
  208
+      prop "Level 3" $
  209
+           runPropDuo3 (==) (==)
  210
+
  211
+    describe "nequals" $ do
  212
+      prop "Level 1" $
  213
+           runPropDuo1 (/=) (/=)
  214
+      prop "Level 2" $
  215
+           runPropDuo2 (/=) (/=)
  216
+      prop "Level 3" $
  217
+           runPropDuo3 (/=) (/=)

0 notes on commit 28ec08e

Please sign in to comment.
Something went wrong with that request. Please try again.