[Haskell-beginners] Question on data/type
Phillip Pirrip
ppirrip at gmail.com
Tue Nov 17 21:46:45 EST 2009
Hi,
Thanks everyone for their patience on my question and took the time to write back. I was thinking to re-phrase my question (to correct some typo etc), but many of you have already guessed my intent. I am trying to write a simple Matrix library, as my little learning exercise, so
TypeConA : Scalar
TypeConB : 1D array
TypeConC : 2D array /matrix.
So I would like to have one typeclass for operations like Scalar +/* Matrix etc.
Felipe: you are way ahead of me (like showing me the answer before I do my exam), and I really appreciate your example code, since that is the level of understanding of Haskell I am looking forward to. I don't think I really understand the code yet, but I will give it a try and let you know. As this moment my level of understanding is basic Haskell syntax, basic Monad (going to try Monad/IArray for in-place non-destruction update) and just started to read up on Control.Applicative (and arrows) and Existential types. I have never even heard of phantom types until now.
BTW, how do I generate "literate" Haskell code? I keep reading it but I still don't know how to make one (I am assuming it is more complicated then just type the code in with ">" in emacs).
//pip
On 2009-11-17, at 6:40 AM, Felipe Lessa wrote:
> (This e-mail is literate Haskell)
>
> Not that this is the right solution to your problems, but...
>
>> {-# LANGUAGE GADTs, EmptyDataDecls,
>> FlexibleInstances, FlexibleContexts #-}
>>
>> import Control.Applicative
>
> This requires EmptyDataDecls:
>
>> data TypeConA
>> data TypeConB
>> data TypeConC
>
> We're gonna use those empty data types as phantom types in our
> data type below. This requires GADTs:
>
>> data TypeCon t a where
>> ValConA :: a -> TypeCon TypeConA a
>> ValConB :: [TypeCon TypeConA a] -> TypeCon TypeConB a
>> ValConC :: [TypeCon TypeConB a] -> TypeCon TypeConC a
>
> Using the phantom types we tell the type system what kind of
> value we want. Now, some useful instances because we can't
> derive them:
>
>> instance Show a => Show (TypeCon t a) where
>> showsPrec n x = showParen (n > 10) $
>> case x of
>> ValConA a -> showString "ValConA " . showsPrec 11 a
>> ValConB a -> showString "ValConB " . showsPrec 11 a
>> ValConC a -> showString "ValConC " . showsPrec 11 a
>>
>> instance Eq a => Eq (TypeCon t a) where
>> (ValConA a) == (ValConA b) = (a == b)
>> (ValConB a) == (ValConB b) = (a == b)
>> (ValConC a) == (ValConC b) = (a == b)
>> _ == _ = error "never here"
>
> The 't' phantom type guarantees that we'll never reach that
> last definition, e.g.
>
> *Main> (ValConA True) == (ValConB [])
>
> <interactive>:1:19:
> Couldn't match expected type `TypeConA'
> against inferred type `TypeConB'
> Expected type: TypeCon TypeConA Bool
> Inferred type: TypeCon TypeConB a
> In the second argument of `(==)', namely `(ValConB [])'
> In the expression: (ValConA True) == (ValConB [])
>
>> instance Functor (TypeCon t) where
>> fmap f (ValConA a) = ValConA (f a)
>> fmap f (ValConB a) = ValConB (fmap (fmap f) a)
>> fmap f (ValConC a) = ValConC (fmap (fmap f) a)
>
> Now, if you want applicative then you'll need FlexibleInstances
> because we can't write 'pure :: a -> TypeCon t a'; this signature
> means that the user of the function may choose any 't' he wants,
> but we can give him only one of the 't's that appear in the
> constructors above.
>
>> instance Applicative (TypeCon TypeConA) where
>> pure x = ValConA x
>> (ValConA f) <*> (ValConA x) = ValConA (f x)
>> _ <*> _ = error "never here"
>>
>> instance Applicative (TypeCon TypeConB) where
>> pure x = ValConB [pure x]
>> (ValConB fs) <*> (ValConB xs) = ValConB (fmap (<*>) fs <*> xs)
>> _ <*> _ = error "never here"
>>
>> instance Applicative (TypeCon TypeConC) where
>> pure x = ValConC [pure x]
>> (ValConC fs) <*> (ValConC xs) = ValConC (fmap (<*>) fs <*> xs)
>> _ <*> _ = error "never here"
>
> Now that we have applicative we can also write, using
> FlexibleContexts,
>
>> liftBinOp :: Applicative (TypeCon t) => (a->b->c)
>> -> TypeCon t a -> TypeCon t b -> TypeCon t c
>> liftBinOp = liftA2
>
> We need that 'Applicative' constraint because the type system
> doesn't know that we have already defined all possible
> 'Applicative' instances, so we have to live with that :).
>
> And then we can simply write
>
>> instance (Applicative (TypeCon t), Num a) =>
>> Num (TypeCon t a) where
>> (+) = liftA2 (+)
>> (-) = liftA2 (-)
>> (*) = liftA2 (*)
>> negate = fmap negate
>> abs = fmap abs
>> signum = fmap signum
>> fromInteger = pure . fromInteger
>
> Finally,
>
> *Main> let x1 = ValConB [ValConA 10, ValConA 7]
> *Main> let x2 = ValConB [ValConA 5, ValConA 13]
> *Main> x1 * x2
> ValConB [ValConA 50,ValConA 130,ValConA 35,ValConA 91]
>
> HTH,
>
> --
> Felipe.
More information about the Beginners
mailing list