Permalink
Browse files

Give EnumMapSet it's own data structure

Replace 'EMM k Bitmap' with custom data with unpacked strict BitMap in Tip.
  • Loading branch information...
1 parent 7f7188c commit 8281b8562e4cdbed08e4fc7275b0234e20723853 @bovinespirit committed Oct 16, 2012
Showing with 34 additions and 9 deletions.
  1. +2 −1 Data/EnumMapMap/Base.hs
  2. +32 −8 Data/EnumMapSet.hs
View
@@ -41,10 +41,11 @@ module Data.EnumMapMap.Base(
Prefix,
Mask,
Nat,
- Key,
intFromNat,
shiftRL,
shiftLL,
+ branchMask,
+ mask,
bin,
tip,
shorter,
View
@@ -54,23 +54,32 @@ import GHC.Exts (Word(..), Int(..))
import GHC.Prim (indexInt8OffAddr#)
#include "MachDeps.h"
-import Data.EnumMapMap.Base ((:&)(..), K(..), EMM(..),
+import Data.EnumMapMap.Base ((:&)(..), K(..),
IsEmm,
EnumMapMap,
- Prefix, Nat,
- intFromNat, bin,
+ Prefix, Nat, Mask,
+ branchMask, mask,
+ intFromNat,
shiftRL, shiftLL,
nomatch, zero,
- join, shorter,
+ shorter,
foldlStrict)
import qualified Data.EnumMapMap.Base as EMM
type EnumMapSet k = EnumMapMap k ()
type BitMap = Word
+-- This is used instead of @EMM k BitMap@ in order to unpack the 'BitMap' in
+-- 'Tip'. Hopefully this will lead to much optimisation by GHC.
+data EMS k = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask
+ !(EMS k) !(EMS k)
+ | Tip {-# UNPACK #-} !Int {-# UNPACK #-} !BitMap
+ | Nil
+ deriving (Show)
+
instance (Enum k) => IsEmm (K k) where
- data EnumMapMap (K k) v = KSC (EMM k BitMap)
+ data EnumMapMap (K k) v = KSC (EMS k)
emptySubTrees e@(KSC emm) =
case emm of
@@ -328,7 +337,7 @@ toList = foldr (:) []
Helper functions
---------------------------------------------------------------------}
-insertBM :: Prefix -> BitMap -> EMM k BitMap -> EMM k BitMap
+insertBM :: Prefix -> BitMap -> EMS k -> EMS k
insertBM !kx !bm t
= case t of
Bin p m l r
@@ -340,7 +349,7 @@ insertBM !kx !bm t
| otherwise -> join kx (Tip kx bm) kx' t
Nil -> Tip kx bm
-deleteBM :: Prefix -> BitMap -> EMM k BitMap -> EMM k BitMap
+deleteBM :: Prefix -> BitMap -> EMS k -> EMS k
deleteBM !kx !bm t
= case t of
Bin p m l r
@@ -352,10 +361,25 @@ deleteBM !kx !bm t
| otherwise -> t
Nil -> Nil
+join :: Prefix -> EMS k -> Prefix -> EMS k -> EMS k
+join p1 t1 p2 t2
+ | zero p1 m = Bin p m t1 t2
+ | otherwise = Bin p m t2 t1
+ where
+ m = branchMask p1 p2
+ p = mask p1 m
+{-# INLINE join #-}
+
+bin :: Prefix -> Mask -> EMS k -> EMS k -> EMS k
+bin _ _ l Nil = l
+bin _ _ Nil r = r
+bin p m l r = Bin p m l r
+{-# INLINE bin #-}
+
{--------------------------------------------------------------------
@tip@ assures that we never have empty bitmaps within a tree.
--------------------------------------------------------------------}
-tip :: Prefix -> BitMap -> EMM k BitMap
+tip :: Prefix -> BitMap -> EMS k
tip _ 0 = Nil
tip kx bm = Tip kx bm
{-# INLINE tip #-}

0 comments on commit 8281b85

Please sign in to comment.