[Haskell-cafe] Selecting Array type

Ryan Ingram ryani.spam at gmail.com
Wed Feb 20 20:40:55 EST 2008


Oleg's done a lot of work here; there's a bunch of magic that can be
done with TypeCast.  I took my inspiration from here:
http://okmij.org/ftp/Haskell/typecast.html#ambiguity-resolution

Here are some tests in ghci (note that I specialized the index type in
"test" to Int to make this shorter; doing so isn't technically
required):
Prelude SmartArray> :t test (1::Int)
test (1::Int) :: Data.Array.Base.UArray Int Int
Prelude SmartArray> :t test (1::Int, 2::Int)
test (1::Int, 2::Int) :: GHC.Arr.Array Int (Int, Int)
Prelude SmartArray> :t test "Foo"
test "Foo" :: GHC.Arr.Array Int [Char]
Prelude SmartArray> :t test False
test False :: Data.Array.Base.UArray Int Bool
Prelude SmartArray>

The trick is to represent whether a type is boxed or not via a
type-level boolean, which you can then use to affect the instance
selecton.  Here is the source:


{-# OPTIONS_GHC
   -fglasgow-exts
   -fbreak-on-exception
   -fallow-undecidable-instances
   -fallow-overlapping-instances
#-}
module SmartArray where
import Data.Ix
import Data.Array.Unboxed
import Data.Complex

type SmartArray i e = (Ix i, SmartArraySelector a e) => (a i e)

-- smartArray is similar to array function from Data.Array. But, it
-- will return a UArray if e can be unboxed.  Otherwise, it returns an Array.

smartArray :: (i, i) -> [(i, e)] -> SmartArray i e
smartArray bnd eLst = array bnd eLst

class (IArray a e) => SmartArraySelector a e | e -> a

-- SmartArraySelector selects UArray for all types that can be
-- unboxed.  An instance has to be created for each unboxed type.  I'd
-- like to avoid listing all unboxed types here.  However, since there
-- are only a few unboxed types, it's not too burdensome to list them
-- all.  (For brevity, I didn't create all possible instances.)

class IsUnboxed t b | t -> b

instance TypeCast b HTrue => IsUnboxed Bool b
instance TypeCast b HTrue => IsUnboxed Char b
instance TypeCast b HTrue => IsUnboxed Double b
instance TypeCast b HTrue => IsUnboxed Float b
instance TypeCast b HTrue => IsUnboxed Int b
instance TypeCast b HFalse => IsUnboxed a b   -- overlap here

class IArray a t => ArraySelector b t a | b t -> a
   -- where array' :: Ix i => b -> (i,i) -> [(i,t)] -> a i t

instance IArray UArray a => ArraySelector HTrue  a UArray -- where
array' _ = array
instance ArraySelector HFalse a Array -- where array' _ = array

instance (IsUnboxed t b, ArraySelector b t a) => SmartArraySelector a t

test :: SmartArraySelector a e => e -> a Int e
test e = smartArray (0,10) [ (i,e) | i <- [0..10]]



-- Magic toolbox that solves everything!  Thanks Oleg!

data HTrue
data HFalse

class TypeCast   a b   | a -> b, b->a   where typeCast   :: a -> b
class TypeCast'  t a b | t a -> b, t b -> a where typeCast'  :: t->a->b
class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
instance TypeCast'  () a b => TypeCast a b where typeCast x = typeCast' () x
instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
instance TypeCast'' () a a where typeCast'' _ x  = x


More information about the Haskell-Cafe mailing list