[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