Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

bug fix for caches

  • Loading branch information...
commit d4faea24aa89a9d842608d43cf1230c19a0cff4b 1 parent 6dd5b50
@ekmett authored
Showing with 20 additions and 12 deletions.
  1. +17 −10 Data/Interned/IntSet.hs
  2. +3 −2 Data/Interned/Internal.hs
View
27 Data/Interned/IntSet.hs
@@ -115,6 +115,7 @@ import qualified Data.List as List
import Data.Monoid (Monoid(..))
import Data.Maybe (fromMaybe)
import Data.Interned.Internal
+import Data.Bits
import Data.Function (on)
import Data.Hashable
import Text.Read
@@ -165,11 +166,24 @@ data UninternedIntSet
| UTip !Int
| UBin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet
+
tip :: Int -> IntSet
tip n = intern (UTip n)
+{--------------------------------------------------------------------
+ @bin@ assures that we never have empty trees within a tree.
+--------------------------------------------------------------------}
+bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
+bin _ _ l Nil = l
+bin _ _ Nil r = r
+--bin p m l r = bin_ p m l r
+bin p m l r
+ | m .&. (m - 1) /= 0 = error "illegal mask"
+ | otherwise = intern (UBin p m l r)
+
bin_ :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
-bin_ p m l r = intern (UBin p m l r)
+bin_ = bin
+--bin_ p m l r = intern (UBin p m l r)
instance Interned IntSet where
type Uninterned IntSet = UninternedIntSet
@@ -193,7 +207,7 @@ instance Interned IntSet where
instance Hashable (Description IntSet) where
hash DNil = 0
- hash (DTip n) = hash n
+ hash (DTip n) = 1 `hashWithSalt` n
hash (DBin p m l r) = hash p `hashWithSalt` m `hashWithSalt` l `hashWithSalt` r
intSetCache :: Cache IntSet
@@ -818,7 +832,7 @@ instance Ord IntSet where
-- compare s1 s2 = compare (toAscList s1) (toAscList s2)
{--------------------------------------------------------------------
- Eq
+ Hashable
--------------------------------------------------------------------}
instance Hashable IntSet where
hash = hash . identity
@@ -857,13 +871,6 @@ join p1 t1 p2 t2
m = branchMask p1 p2
p = mask p1 m
-{--------------------------------------------------------------------
- @bin@ assures that we never have empty trees within a tree.
---------------------------------------------------------------------}
-bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
-bin _ _ l Nil = l
-bin _ _ Nil r = r
-bin p m l r = bin_ p m l r
{--------------------------------------------------------------------
View
5 Data/Interned/Internal.hs
@@ -57,6 +57,7 @@ mkCache = result where
type Id = Int
class ( Eq (Description t)
+ , Show t -- HACK
, Hashable (Description t)
) => Interned t where
data Description t
@@ -82,7 +83,7 @@ intern !bt = unsafeDupablePerformIO $ modifyAdvice $ modifyMVar slot go
!dt = describe bt
!hdt = hash dt
!wid = cacheWidth dt
- (q,r) = hdt `divMod` wid
+ r = hdt `mod` wid
go (CacheState i m) = case HashMap.lookup dt m of
Nothing -> k i m
@@ -91,7 +92,7 @@ intern !bt = unsafeDupablePerformIO $ modifyAdvice $ modifyMVar slot go
case mt of
Just t -> return (CacheState i m, t)
Nothing -> k i m
- k i m = do let t = identify (q * i + r) bt
+ k i m = do let t = identify (wid * i + r) bt
wt <- t `seq` mkWeakPtr t $ Just remove
return (CacheState (i + 1) (HashMap.insert dt wt m), t)
remove = modifyMVar_ slot $
Please sign in to comment.
Something went wrong with that request. Please try again.