[Haskell-cafe] Class Quantification
oleg at okmij.org
oleg at okmij.org
Thu Oct 2 00:41:41 EDT 2008
Bas van Dijk wrote:
> ... it's possible to define 'foo' and 'bar' like so:
>
> > foo :: (Num c, Num d) => (forall b. Num b => a -> b) -> a -> (c, d)
> > foo f x = (f x, f x)
>
> > bar :: (Read c, Read d) => (forall b. Read b => a -> b) -> a -> (c, d)
> > bar f x = (f x, f x)
>
> Which allows us to write:
>
> > testFoo = foo fromInteger 1 :: (Int, Float)
> > testBar = bar read "1" :: (Int, Float)
>
> Now I would like to generalise 'foo' and 'bar' to 'bla' so that I can write:
>
> testBla1 = bla fromInteger 1 :: (Int, Float)
> testBla2 = bla read "1" :: (Int, Float)
Quantification over classes is *easily* achievable in
Haskell. Although functional dependencies are required, overlapping or
undecidable instances are not. The technique is also far simpler than
that in SYB3 and takes only a few lines to write. The complete code
follows. One may note that Rank2 types are *not* needed. Therefore, we
do not even have to give signature to the function bla as it can be
inferred. That technique suggests that Rank2 types are already present
in some form in Haskell (even Haskell98) already.
In more detail, the technique is explained in
Class-parameterized classes, and the type-level logarithm
http://okmij.org/ftp/Haskell/types.html#peano-arithm
Type-class overloaded functions: second-order typeclass programming with
backtracking
http://okmij.org/ftp/Haskell/types.html#poly2
Here is the code
{-# LANGUAGE RankNTypes, MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-- the result type determines the argument type
class RApply l a b | l b -> a where
rapply :: l -> a -> b
-- the expected instance
instance RApply (a->b) a b where
rapply = ($)
data LRead = LRead
instance Read b => RApply LRead String b where
rapply _ = read
data LFromInt = LFromInt
instance Num b => RApply LFromInt Integer b where
rapply _ = fromInteger
bla x arg = (rapply x arg, rapply x arg)
testBla1 = bla LFromInt 1 :: (Int, Float)
testBla2 = bla LRead "1" :: (Int, Float)
More information about the Haskell-Cafe
mailing list