Re: [Haskell-cafe] Re: FlexibleContexts and FlexibleInstances

2009-06-11 Thread Claus Reinke

|What you describe is exactly how I would *want* things to work. It's
|nice to hear my wishes echoed from a user perspective. :-)

actually, I was describing how things seem to work right now.

| Only MultiParamTypeClasses does (and neither extension is needed in the
| module defining 'f', if 'T' is imported, which suggests that
| MultiParamTypeClasses is propagated to importers - this isn't true for
| most other extensions). The documentation still points to -fglasgow-exts, so
| it doesn't seem to answer these questions..
|
|Right you are - which seems very strange to me. GHC accepts the module
|defining 'f' with no flags at all, even though it is clearly not
|Haskell 98. I'd go so far as to say that's a bug (as opposed to just
|unwanted/unexpected behavior).

It is not that strange, really (it ought to be documented, but the fan-
out from glasgow-exts/hugs mode to more detailed extensions has
been fairly recent, compared to the lifetime of these features):

if module 'A' exports multiparameter type classes, importers of those
classes have to have MultiParamTypeClasses on - there are no legal
uses of those imports otherwise (while FlexibleInstances/Contexts can
just affect a subset of use sites).

| No. FlexibleInstances is about instance *heads*, FlexibleContexts is about
| contexts everywhere (in practice, there are some bugs;-).
|
|Right, this is exactly what I *want* should happen, both as a user and
|as an implementor, but that's not how GHC does it. FlexibleInstances
|do enable FlexibleContexts for contexts in instance declarations -
|which I think is a wart.
|
| class T a b -- requires MultiParamTypeClasses instance T a a -- requires
| FlexibleInstances instance Eq () = T a [b] -- requires FlexibleContexts
| instance Eq [a] = T a b -- requires UndecidableInstances

Perhaps I should have been more explicit, but if you try that example
by adding one line after the other, starting from zero extensions, you'll 
find that FlexibleInstances does not enable FlexibleContexts (at least not 
in my versions of GHC, which always stop at the first class of language 
errors and force me into an iterative cycle of code, error, add one 
pragma, error, add another pragma, ..).


Claus


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: [Haskell-cafe] Re: FlexibleContexts and FlexibleInstances

2009-06-11 Thread Isaac Dupree

Claus Reinke wrote:

if module 'A' exports multiparameter type classes, importers of those
classes have to have MultiParamTypeClasses on - there are no legal
uses of those imports otherwise (while FlexibleInstances/Contexts can
just affect a subset of use sites).


say we have

module A where { class Coerce a b where coerce :: a - b }
module B where { import A ; co a = coerce a }

Syntactically, module B doesn't require MultiParamTypeClasses because 
the signature that's involved is only discovered during type inference. 
 Something to beware of if those restrictions need to be implemented 
somehow in GHC.



Niklas Broberg wrote:

If there is any interest, I can also propose these cases as bug reports to GHC.


please do!

-Isaac
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: [Haskell-cafe] Re: FlexibleContexts and FlexibleInstances

2009-06-11 Thread David Menendez
On Thu, Jun 11, 2009 at 4:16 AM, Claus Reinkeclaus.rei...@talk21.com wrote:
 |What you describe is exactly how I would *want* things to work. It's
 |nice to hear my wishes echoed from a user perspective. :-)

 actually, I was describing how things seem to work right now.

 | Only MultiParamTypeClasses does (and neither extension is needed in the
 | module defining 'f', if 'T' is imported, which suggests that
 | MultiParamTypeClasses is propagated to importers - this isn't true for
 | most other extensions). The documentation still points to -fglasgow-exts,
 so
 | it doesn't seem to answer these questions..
 |
 |Right you are - which seems very strange to me. GHC accepts the module
 |defining 'f' with no flags at all, even though it is clearly not
 |Haskell 98. I'd go so far as to say that's a bug (as opposed to just
 |unwanted/unexpected behavior).

 It is not that strange, really (it ought to be documented, but the fan-
 out from glasgow-exts/hugs mode to more detailed extensions has
 been fairly recent, compared to the lifetime of these features):

 if module 'A' exports multiparameter type classes, importers of those
 classes have to have MultiParamTypeClasses on - there are no legal
 uses of those imports otherwise (while FlexibleInstances/Contexts can
 just affect a subset of use sites).

It's more complicated than that. If you have two modules A and B,
defined like so:

{-# LANGUAGE MultiParamTypeClasses #-}

module A where

class Foo a b where
foo :: a - b

instance Foo Bool Int where
foo True = 1
foo False = 0

--

module B where

import A

bar :: (Foo a b) = [a] - [b]
bar = map foo

I can load B.hs into GHCi and call bar without problems. So the import
of Foo is fine. But you still get an error if you try to declare an
instance of Foo in B.hs.

instance Foo Bool Integer where
foo True = 1
foo False = 0

B.hs:8:0:
Illegal instance declaration for `Foo Bool Integer'
(Only one type can be given in an instance head.
 Use -XMultiParamTypeClasses if you want to allow more.)
In the instance declaration for `Foo Bool Integer'
Failed, modules loaded: A.


-- 
Dave Menendez d...@zednenem.com
http://www.eyrie.org/~zednenem/
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: [Haskell-cafe] Re: FlexibleContexts and FlexibleInstances

2009-06-11 Thread Claus Reinke

   {-# LANGUAGE MultiParamTypeClasses #-}
   module A where
   class Foo a b where  foo :: a - b

   instance Foo Bool Int where
   foo True = 1
   foo False = 0

   module B where
   import A

   bar :: (Foo a b) = [a] - [b]
   bar = map foo

I can load B.hs into GHCi and call bar without problems. So the import
of Foo is fine. But you still get an error if you try to declare an
instance of Foo in B.hs.

   instance Foo Bool Integer where
   foo True = 1
   foo False = 0

B.hs:8:0:
   Illegal instance declaration for `Foo Bool Integer'
   (Only one type can be given in an instance head.
Use -XMultiParamTypeClasses if you want to allow more.)
   In the instance declaration for `Foo Bool Integer'
Failed, modules loaded: A.


Ah, that is one definite bug waiting for a ticket, then:
- inheritance of MultiParamTypeClasses is not specified
- if it is inherited, the instance in B should be permitted
- if it is not inherited, the context in B should not be permitted

Claus


___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users