[Haskell-cafe] Tricks with GMap -- question about conflicts w/
indexed type families
Ryan Newton
newton at mit.edu
Fri Jun 4 14:32:33 EDT 2010
GMaps -- families of map implementations indexed by the key type --
are an example on the wiki:
http://www.haskell.org/haskellwiki/GHC/Type_families
I've been using something like this myself. It sure would be nice to
have a fully developed version on Hackage, and I may try to submit
this myself if no one else has already done it. But I'm running into
a problem in achieving a particular optimization that I want --
namely, small tuple keys packed into Ints.
For example, with a key type (Int16,Int16) it's possible to pack the
key into a plain Int and use Data.IntMap.
In fact, in the rough/partial implementation here
(http://people.csail.mit.edu/newton/gmap/GMap.hs) I have a class for
things that fit in a word:
class FitInWord v where
toWord :: v -> Word
fromWord :: Word -> v
(Or fitInInt for that matter.) Which includes things like small tuples:
instance FitInWord (Int16,Int16) where
toWord (a,b) = shiftL (fromIntegral a) 16 + (fromIntegral b)
fromWord n = (fromIntegral$ shiftR n 16,
fromIntegral$ n .&. 0xFFFF)
(If you know a better idea than using templates/program generation to
generate every combination of small scalar tuples that fit in a
word.... let me know.)
What I would next *like* to do is something like the following:
import qualified Data.IntMap as DI
instance FitInWord t => GMapKey t where
data GMap t v = GMapInt (DI.IntMap v) deriving Show
empty = GMapInt DI.empty
lookup k (GMapInt m) = DI.lookup (wordToInt$ toWord k) m
insert k v (GMapInt m) = GMapInt (DI.insert (wordToInt$ toWord k) v m)
alter fn k (GMapInt m) = GMapInt (DI.alter fn (wordToInt$ toWord k) m)
toList (GMapInt m) = map (\ (i,v) -> (fromWord$ intToWord i, v)) $
DI.toList m
The problem is that there's already a more general instance of GMapKey
that handles pairs by representing them as nested GMaps:
instance (GMapKey a, GMapKey b) => GMapKey (a, b) where
data GMap (a, b) v = GMapPair (GMap a (GMap b v))
....
Ideally, I want both of these to coexist (and to prioritize the more
specific one). With normal type classes, OverlappingInstances can
handle this, but with type families I get an error like the following:
Conflicting family instance declarations:
data instance GMap t v -- Defined at Intel/GMap.hs:108:7-10
data instance GMap (a, b) v -- Defined at Intel/GMap.hs:225:7-10
Any fixes?
Thanks,
-Ryan
More information about the Haskell-Cafe
mailing list