[Haskell-cafe] how to factorize propagation of a function over a data type
TP
paratribulations at free.fr
Mon Dec 2 22:01:29 UTC 2013
Andras Slemmer wrote:
> As far as I understand this is not what you're looking for, as you want
> the mapBar function to be agnostic wrt what type the leaves contain. The
> minimal assumption that this requires is that the leaf types are a member
> of FooClass, and indeed you can write such a map:
>
> mapBar :: (forall a. FooClass a => a -> a) -> Bar -> Bar
> mapBar f (Bar1 i) = Bar1 (f i)
> mapBar f (Bar2 r) = Bar2 (f r)
> mapBar f (Exp1 e1 e2) = Exp1 (mapBar f e1) (mapBar f e2)
> mapBar f (Exp2 e1 e2) = Exp2 (mapBar f e1) (mapBar f e2)
>
> instance FooClass Bar where
> foo1 = mapBar foo1
> foo2 = mapBar foo2
>
> I think this is closer to what you were looking for. The above map
> requires -XRankNTypes, because mapBar requires a function that is fully
> polymorphic ('a' will instantiate to Integer and Float respectively). If
> you haven't used higher ranked types before I think it is instructive to
> think about why the above signature works and the one you wrote doesn't.
> In particular think about at which point the polymorphic type 'a' is
> instantiated in both cases, or rather what the "scope" of 'a' is.
Thanks a lot. This solution has already been proposed to me in the afternoon
by JC Mincke in a private communication.
Indeed I did not know RankNTypes. I think I understand your explanation in
terms of "scope" of 'a':
In the type signature
propagate :: (FooClass a)=> Bar -> (a->a) -> Bar
which is in fact implicitly
propagate :: forall a. (FooClass a)=> Bar -> (a->a) -> Bar
it is supposed that the type signature of propagate is valid for a given
value of the type variable a, i.e. a given type. Thus we obtain an error if
we apply recursively propagate to different types in the code of propagate.
Whereas in the type signature
propagate :: Bar -> (forall a. (FooClass a) => a->a) -> Bar
the type signature of propagate is such that it allows several values for
the type variable `a` in its second argument `a->a`.
PS: a working code corresponding to my last example:
-------------
{-# LANGUAGE RankNTypes #-}
class FooClass a where
foo1 :: a -> a
foo2 :: a -> a
instance FooClass Integer where
foo1 v = 1
foo2 v = 2
instance FooClass Float where
foo1 v = 0.25
foo2 v = 0.5
data Bar = Bar1 Integer
| Bar2 Float
| Exp1 Bar Bar
| Exp2 Bar Bar
deriving Show
propagate :: Bar -> (forall a. (FooClass a) => a->a) -> Bar
propagate v f = case v of
Bar1 i -> Bar1 (f i)
Bar2 fl -> Bar2 (f fl)
Exp1 b1 b2 -> Exp1 (propagate b1 f) (propagate b2 f)
Exp2 b1 b2 -> Exp2 (propagate b1 f) (propagate b2 f)
-- The two previous lines may be replaced by:
-- Exp1 b1 b2 -> Exp1 (f b1) (f b2)
-- Exp2 b1 b2 -> Exp2 (f b1) (f b2)
instance FooClass Bar where
foo1 b = propagate b foo1
foo2 b = propagate b foo2
main = do
let a = Bar1 3
let b = Bar1 4
let c = Bar2 0.4
let d = Exp1 (Exp2 a c) b
print d
print $ foo1 d
print $ foo2 d
---------------
More information about the Haskell-Cafe
mailing list