{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances #-}
-- Adding a special case to an existing library of overloaded functions
-- The special case will overlap with the general case implemented
-- in the library. Since the library uses associated data types,
-- overlapping instances are not permitted. This code
-- demonstrates a work-around.
-- It was developed in response to a real-life optimization problem
-- posed by Ryan Newton on the Haskell-Cafe mailing list on June 4, 2010:
-- http://www.haskell.org/pipermail/haskell-cafe/2010-June/078590.html
module GMapSpec where
import Data.Int
import Data.Word
import Data.Bits
import qualified Data.IntMap as IM
-- The library in question is GMap, of
-- generic maps specialized to the data type of the key.
-- To make the present code self-contained we reproduce the
-- representative bits of the library:
-- ===== Begin a simplified GMap package
-- A simplified class GMapKey
class GMapKey t where
data GMap t :: * -> *
empty :: GMap t v
lookup :: t -> GMap t v -> Maybe v
instance GMapKey Int16 where
data GMap Int16 v = GMI16 (IM.IntMap v)
empty = GMI16 $ IM.empty
lookup k (GMI16 m) = IM.lookup (fromIntegral k) m
instance GMapKey Int32 where
data GMap Int32 v = GMI32 (IM.IntMap v)
empty = GMI32 $ IM.empty
lookup k (GMI32 m) = IM.lookup (fromIntegral k) m
-- Generic instance for pairs
instance (GMapKey a, GMapKey b) => GMapKey (a, b) where
data GMap (a, b) v = GMapPair (GMap a (GMap b v))
empty = GMapPair $ empty
lookup k (GMapPair m) = error "Invoking the generic instance for pairs"
-- ===== End the simplified GMap package
-- If the key is a pair of Int8s or Int16s or some other data
-- that can be packed in a single Int32, we are better off
-- packing the pair into an Int32 and using the GMapKey Int32
-- instance rather than using the generic GMap instance for
-- the pairs. Alas, we cannot add the desired specific
-- (Int8,Int8) instance for GMapKey because it overlaps
-- the existing generic GMapKey (a,b) instance.
-- Since GMapKey has an associated data type GMap, overlapping
-- instances are not allowed.
-- The following is an optimization, which should appear in a different
-- module. The optimization should not disturb the original GMap code.
-- The following optimization is Ryan Newton's code
-- A class for values that fit within one word
class FitInWord v where
toWord :: v -> Word
fromWord :: Word -> v
instance FitInWord (Int16,Int16) where
toWord (a,b) = shiftL (fromIntegral a) 16 + (fromIntegral b)
fromWord n = (fromIntegral$ shiftR n 16,
fromIntegral$ n .&. 0xFFFF)
-- Now we wish to define optimized instances of GMapKey for
-- pairs of items that fit within a word.
-- The following answers Ryan Newton's question
-- Define our own product type, to avoid overlapping instances with the
-- general GMapKey for pairs
-- It's a newtype: it has no run-time overhead
newtype OptimalPair a b = OptimalPair (a,b)
instance FitInWord (a,b) => GMapKey (OptimalPair a b) where
data GMap (OptimalPair a b) v = GMapInt (IM.IntMap v) deriving Show
empty = GMapInt IM.empty
lookup (OptimalPair k) (GMapInt m) = IM.lookup (fromIntegral$ toWord k) m
-- Auxiliary class to choose the appropriate pair
class ChoosePairRepr a b pr | a b -> pr where
choose_pair :: (a,b) -> pr
choosen_pair :: pr -> (a,b)
instance ChoosePairRepr Int16 Int16 (OptimalPair Int16 Int16) where
choose_pair = OptimalPair
choosen_pair (OptimalPair p) = p
-- Repeat the above for all other optimal pairs:
-- (Int8, Int16), (Int16, Int8), etc.
-- Template Haskell is very good to generate all such boiler-plate instances
-- Choose a generic pair for all other pairs of values
instance pr ~ (a,b) => ChoosePairRepr a b pr where
choose_pair = id
choosen_pair = id
-- tests
-- A specific instance is chosen
test1 = let m = empty in
GMapSpec.lookup (choose_pair (1::Int16,2::Int16)) m
-- Nothing
-- A general pair instance is chosen
test2 = let m = empty in
GMapSpec.lookup (choose_pair (1::Int32,2::Int16)) m
-- *** Exception: Invoking the generic instance for pairs
-- The approach is not limited to pairs and can be used
-- to convert a range of specific data types of keys to a more packed
-- representation.