Absolutely right!  Thank you Claus, I will look into this.

Simon

| note that things are going wrong in this area even without my patch.
| consider this module
| --------------------------
| {-# OPTIONS_GHC -fglasgow-exts #-}
| module Main where
| class C a b where
|   c1 :: Num b => a -> b
|   c2 :: (Num b,Show b) => a -> b
|   c3 :: forall a. a -> b
| --------------------------
|
| and this ghci-6.6.1 session for it:
|
|     *Main> :b Main
|     class C a b where
|       c1 :: (Num b) => a -> b
|       c2 :: (Num b, Show b) => a -> b
|       c3 :: a -> b
|
|     *Main> :t c3
|     c3 :: (C a b) => a1 -> b
|
|     *Main> :set -fglasgow-exts
|     *Main> :b Main
|     class C a b where
|       c1 :: (Num b) => a -> b
|       c2 :: (Num b, Show b) => a -> b
|       c3 :: forall a. a -> b
|
| apparently, the printing of C uses dropForAlls on c3, without
| considering scope issues, so the output of that first browse is
| simply wrong. also, i wonder how the ghci-session can be in
| *Main without having -fglasgow-exts set? these issues are still
| with us in today's head.
|
| claus
|
| >> |     class C a where c :: (Num b) => a -> b
| >> |     c :: C a -> forall b. (Num b) => a -> b
| >>
| >> I think the right thing here is to change Type.dropForAlls,
| >> so that it drops for-alls nested to the right of arrows.  Then
| >> you'd get   c :: (C a, Num b) => a -> b
| >
| > yes, that makes sense. but i'm wary of those type-manipulating
| > functions, as they only operate on the structure of the types,
| > not seeming to look at scopes. what if the inner forall shadows
| > a type variable binding from the outer forall? or, if i want to
| > lift the inner forall outwards, what if the inner forall captures
| > a type variable in the context? do i really have to do all this
| > myself, just to print out the type associated with a name?
| >
| >> |     class C a where c :: forall b. (Num b) => a -> b
| >> |     c :: forall a. (C a) => forall b. (Num b) => a -> b
| >>
| >> This *really is* c's type, so it's only honest to say so.
| >
| > shouldn't the correct type be something that would be
| > valid source code as well?
| >
| >    c :: forall a, b. (C a, Num b) => a -> b
| >
| > the type shouldn't distinguish between class methods and
| > other overloaded functions, should it?
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to