You need to enable ScopedTypeVariables, and add a forall to introduce the type variable at the top level. The local variable will then be the *same* 'a' instead of a fresh one:

š {-# LANGUAGE ScopedTypeVariables #-}

š data D a = D1 a | D2 a (a -> a)

š f :: forall a. Eq a => D a -> a
š f (D1 x) š = x
š f (D2 x g) = let y :: Eq a => a
š š š š š š š š š šy = g x
š š š š š š š šin šif x == y then x else g y

š main = putStr $ shows (f (D2 (1 :: Int) succ)) "\n"


On Wed, Nov 14, 2012 at 1:03 PM, Serge D. Mechveliani <mechvel@botik.ru> wrote:
Please,
how to correctly set an explicit type for a local value in the body of
a polymorphic function?

Example (tested under šghc-7.6.1):

š data D a = D1 a | D2 a (a -> a)

š f :: Eq a => D a -> a
š f (D1 x) š = x
š f (D2 x g) = let -- y :: Eq a => a
š š š š š š š š š šy = g x
š š š š š š š šin šif x == y then x else g y

š main = putStr $ shows (f (D2 (1 :: Int) succ)) "\n"


This is compiled by š šghc --make Main

Now I need, for a certain reason, to explicitly set the type for šy šin
`let', šwith the meaning:
"this very `a' which is in the signature for šf"
(and I think that this type Haskell assignes to šy šin š"y = g x").

I need to declare this type in a separate line: šy :: <what ever it is>.

Both š`y :: a' šand š`y :: Eq a => a' šare not compiled.

Please, copy the answer to šmechvel@botik.ru

Thanks,

------
Sergei

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe