[Haskell-cafe] Tricks with GMap -- question about conflicts w/ indexed type families

[oleg at okmij.org]

Ryan Newton wrote:

> 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
>
> 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:

First of all, if we forget about data families, OverlappingInstances
still won't give us the desired behavior. GHC chooses overlapping
instances based only on the instance head type, disregarding all
constraints. Therefore, when asked to choose an instance for
GMapKey (Int16,Int16), GHC would choose the second instance as it is
more specific: the type (a,b) is more specific that the type t. Again,
the constraints such as FitInWord are not used when choosing instances.
This issue is discussed in detail at

Choosing a type-class instance based on the context
	http://okmij.org/ftp/Haskell/types.html#class-based-overloading
and on the Wiki Page
	http://haskell.org/haskellwiki/GHC/AdvancedOverlap

These pages explain how can we make class constraints bear on the
instance selection.

But we still have the second problem: data families do not permit
overlapping declarations. At first blush, it appears impossible to
define GMapKey for specific pairs and default to the generic GMap
instance for general pairs. Fortunately, a solution exists, shown
below. The idea is to define an auxiliary type class (without data
families). Such a type class permits overlapping instances and so
makes possible the desired behavior of specific instances with the
generic default.

{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances #-}

module GM where

import Data.Int
import Data.Word
import Data.Bits
import qualified Data.IntMap as IM

-- ===== 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

-- 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
        GM.lookup (choose_pair (1::Int16,2::Int16)) m
-- Nothing

-- A general pair instance is chosen
test2 = let m = empty in
        GM.lookup (choose_pair (1::Int32,2::Int16)) m
-- *** Exception: Invoking the generic instance for pairs