[Haskell-cafe] Selecting Array type
Jeff φ
jeff1.61803 at gmail.com
Thu Feb 21 01:48:12 EST 2008
On 2/19/08, Ryan Ingram <ryani.spam at gmail.com> wrote:
>
> 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
> . . .
>
>
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.
> . . .
>
>
-- 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
>
Thanks for showing me this technique. I studied your code for several
hours. And, I've read Oleg's "Strongly Typed Heterogeneous Collections."
As a learning exercise, I modified your code. I managed to shorten it a
bit, but I had a couple of surprises. Please see my comments in the code
below.
{-# OPTIONS_GHC
-fglasgow-exts
-fbreak-on-exception
-fallow-undecidable-instances
-fallow-overlapping-instances
#-}
module SmartArray where
import IO
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 ArrTypeCast a b | a -> b, b->a where
arrTypeCast :: a i e -> b i e
instance ArrTypeCast x x where
arrTypeCast = id
-- SURPRISE 1: If function, arrTypeCast, is removed, (from both
-- the class and instance) GHC assumes the kind of a and b are *,
-- instead of * -> * -> * and produce . . .
--
-- report3.hs:37:24:
-- `UArray' is not applied to enough type arguments
-- Expected kind `*', but `UArray' has kind `* -> * -> *'
-- In the type `(ArrTypeCast a UArray, IArray a Bool) =>
-- SmartArraySelector a Bool'
-- In the instance declaration for `SmartArraySelector a Bool'
--
-- It appears that functions defined in a class can constrain the
-- type variables of the class. To me, this seems a bit magical
-- and unexpected.
class (IArray a e) => SmartArraySelector a e | e -> a
-- instances of SmartArraySelector for all boxed types (For
-- breivity, not all unboxed types are listed.)
instance (ArrTypeCast a UArray, IArray a Bool)
=> SmartArraySelector a Bool
instance (ArrTypeCast a UArray, IArray a Char)
=> SmartArraySelector a Char
instance (ArrTypeCast a UArray, IArray a Double)
=> SmartArraySelector a Double
instance (ArrTypeCast a UArray, IArray a Float)
=> SmartArraySelector a Float
instance (ArrTypeCast a UArray, IArray a Int)
=> SmartArraySelector a Int
-- SURPRISE 2: The class SmartArraySelector has the type
-- assertion, (IArray a e). It seems like adding an additional
-- IArray assertion to each instance is redundant. However,
-- if I remove the assertion (IArray a Int) above, GHC
-- reports . . .
--
-- report3.hs:37:24:
-- `UArray' is not applied to enough type arguments
-- Expected kind `*', but `UArray' has kind `* -> * -> *'
-- In the type `(ArrTypeCast a UArray, IArray a Bool) =>
-- SmartArraySelector a Bool'
-- In the instance declaration for `SmartArraySelector a Bool'
--
-- Why is this second type assertion required?
instance (ArrTypeCast a Array, IArray a b)
=> SmartArraySelector a b
test :: SmartArraySelector a e => e -> a Int e
test e = smartArray (0,10) [ (i,e) | i <- [0..10]]
I'd love to find a good article that describes the ins and outs of multi
parameter types, functional dependencies, and type assertions, in enough
detail to resolve these surprises. A step-by-step walk through showing how
the compiler resolve a type and selects an instance would be awesome.
Usually, when I'm having trouble getting Haskell's type system to do what I
want, I resort to trial and error tactics. I wish I had a better foundation
so I could take a more intelligent approach to type hacking.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20080221/b047391f/attachment.htm
More information about the Haskell-Cafe
mailing list