Re: Haskell' - class aliases

2008-04-25 Thread John Meacham
On Thu, Apr 24, 2008 at 10:21:03PM +0200, Wolfgang Jeltsch wrote:
> Am Donnerstag, 24. April 2008 21:27 schrieb John Meacham:
> > On Thu, Apr 24, 2008 at 08:48:15PM +0200, Wolfgang Jeltsch wrote:
> > […]
> 
> > > I also have some remark: Why not write
> > >
> > > > class Eq a => Num a = (Additive a, Multiplicative a)
> > >
> > > instead of
> > >
> > > > class Num a = Eq a => (Additive a, Multiplicative a)
> >
> > Well, because you can think of 'Num a' as an alias for 'Eq a =>
> > (Additive a, Multiplicative a)', not that Eq is a superclass of Num
> > which the class declaration syntax implies.
> 
> Hmm, in what way is Num a an alias for Eq a => (Additive a, Multiplicative 
> a)?  
> You cannot write this:
> 
> > square :: (Eq a => (Additive a, Multiplicative a)) => a -> a
> 
> I would say: “Under the condition that Eq a holds, Num a is an alias for 
> (Additive a, Multiplicative a).  And this seems to be perfectly expressed by 
> my above proposal.

Hmm... I guess it depends on how you think about it. I tend to think
about them in terms of what they are rewritten to rather than a
proposition about classes. but perhaps that makes more sense. Will mull
on it some..

John

-- 
John Meacham - ⑆repetae.net⑆john⑈
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: Haskell' - class aliases

2008-04-25 Thread Twan van Laarhoven

Simon Peyton-Jones wrote:


Is this the most up-to-date description of the proposal?
http://repetae.net/recent/out/classalias.html


Has anyone looked at my (confusingly named and horribly written) variant?

  http://haskell.org/haskellwiki/Superclass_defaults


My idea is to split class aliases into two separate things:

  1. Superclass defaults: allow a class declaration to contain defaults for 
methods from superclasses. Allow an instance declaration to be for multiple 
classes at once, using the most specific defaults:


   instance (FooBar a, Foo a, Bar a)
 -- pick the defaults from FooBar, since it is a subclass
 -- of both Foo and Bar.

  2. Class aliases: simply an alias for zero or more classes.

   class alias FooAndBar a = (Foo a, Bar a)

 In a context FooAndBar a is simply replaced by (Foo a, Bar a). For 
instantiation purposes the class alias could override the default methods as if 
it was a subclass of Foo and Bar. No new methods can be added.

 Alternatively class aliases could be just macros, like type synonyms.


Part 1 applies for instance to the Functor/Applicative/Monad hierarchy, fmap 
could have a default in terms of (>>=).

Part 2 is useful for splitting classes up into smaller bits.


Twan
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: Haskell' - class aliases

2008-04-25 Thread John Meacham
On Fri, Apr 25, 2008 at 05:37:17PM +0100, Simon Peyton-Jones wrote:
> John
> 
> OK here's a question about class alisas. You propose:
> 
>class Foo a where
> foo :: a -> [a]
> foo x = []
>class Bar a where
> bar :: a -> a
> bar x = [x]
> 
>class alias FooBar a = (Foo a, Bar a) where
> foobar :: a -> a
> foobar x = x
> 
> foo x = bar x
> 
> I have a few minor questions about this that'd be worth clarifying on your 
> main page
>   (a) I assume you can add a method 'foobar' not declared
> in either Foo or Bar.  Your very first example has this.
> But it's contradicted later when you say that "One can declare an 
> instance
> of Num either by giving separate instances for Eq, Additive, 
> Multiplicative"

No, I didn't mean to imply that. as you noted, that would mean that an
alias would not be a simple preprocessing. what you can do is create a real
class FooBar which has both foo and bar as superclasses, then create an
alias for all three so you can create a single instance to define all
three.

It might be possible to add this though and have it automatically create
an appropriate class and a class alias. but I think that might muddy the
intent of class aliases if not all can be described as simple aliases
for other existing classes. So we can reserve that as a possible future
extension. it is easy enough to manually create the 'foobar' containing
class in any case and if you don't export it from your module, you get
the equivalent effect.

> 
>   (b) And I assume that you don't need to repeat the type
> signatures for 'foo' and 'bar'.

Yup, no need to repeat type signatures.

> 
>   (c) I think you intend that you can override the default methods
> for foo and bar; and I have done so for method 'foo'.

Yes. being able to override default instances is a key part, otherwise
you wouldn't be able to, for instance, create appropriate 'Num'
compatible methods from your advanced 'NewNum' class alias. But you are
not forced to do so. 

> 
> Question: how does the above differ from this?
> 
>class (Foo a, Bar a) => FooBarSC a where
> foobar :: a -> a
> 
> Here Foo, Bar are simply superclasses.  From the point of view of a type 
> signature there *no* difference:
> 
> f :: (FooBarSC a) => ...
> 
> gives access to all the methods of Foo and Bar.  So what's the difference?
> 
> Answer (I believe): when you give an instance of FooBar
> you give implementations for all methods of
> Foo, Bar, and FooBar.

Yes, it is because you cannot declare an instance of FooBarSC and have it also
create the ones for Foo and Bar, and because you can't create new
default instances for 'foo' and 'bar' that refer to 'foobar'.

> 
> So the obvious question is: do we really need a new construct?  Why
> not just use FooBarSC?  Then we'd have to allow you to give
> implementations for superclass methods too:
> instance FooBarSC Int where
>   foobar = ...
>   foo = ...
>   bar = ...
> 
> I think I believe (like you) that this is a bad idea.  The main reason
> is that it's a totally unclear whether, given a FooBarSC Int instance
> declaration, should there be an instance for (Foo Int), always, never,
> or optionally?


Yes. and it breaks one of the major haskell properties I am not willing
to give up,

That when you add an import to your module (or any module you depend
on), your program will either fail to compile or have the _exact_ same
meaning.

> However, I think you might want to articulate the reasons carefully,
> because we have two features that are really extremely close.

Yes, I think the above might help with the lattice case, where you have
a strict hierarchy of classes and the superclass tree mirrors your class
aliases, but this may not be the case in general. in particular, we
don't want to necessarily redo the numeric hierarchy as a strict
generalization or splitting up of the current prelude numerical
hierarchy, and the superclass method gets a little hairy when you want
to do things like that and don't want to end up with every method in its
own class.

> To put it another way, you could imagine re-expressing your proposal
> like this:
> 
>   class (Eq a) && (Additive a, Multiplicative a) => Num a
> 
> meaning this: when you give an instance for (FooBar T) you
> 
>  * MUST give implementations for the methods of Addititive and
>  Applicative
> 
>  * MUST NOT give implementations for methods of Eq; rather the Eq T
>  instance must be in scope.
> 
> This is, I believe, what you mean by class alias Num a = Eq a =>
> (Additive a, Multiplicative a)
> 
> Now I'm not necessarily suggesting this as concrete syntax.  But my
> point is that you're really asking for small modification of the
> existing superclass mechanism, that divides the superclasses into two
> groups, the "flat" ones (like Additive and Multiplicative) and the
> "nested" ones (like Eq). 

Re: RFC: qualified vs unqualified names in defining instance methods

2008-04-25 Thread Simon Marlow

Claus Reinke wrote:


i originally filed this as a bug, until Simon PJ kindly pointed
me to the Haskell 98 report, which forces GHC to behave
this way.. i guess i'll remember this oddity for a while, so
i can live with it, but if it is irksome that the report allows
me to refer to a name that is not in scope, it is far from obvious why 
it needs to prevent me from referring to a

name that *is* in scope (Malcolm mentioned parsing
ambiguities as the reason for this, but in my case, GHC
recognizes the qualified name and *complains* about it).


Is it too hard to remember that in an instance declaration you can give 
bindings for methods of the class being instantiated only?  To me, the 
oddity is that the method name must be in scope at all - this is a 
definition, not a reference, with a fixed set of things that can be defined.


However, there is a consistency issue with record construction.  The 
fields of a record construction are very much like the methods in an 
instance declaration: they are bindings for already-defined identifiers, 
and the set of available identifiers is known statically.  In Haskell 98:


aexp->  qcon { fbind1 , ... , fbindn }
fbind   ->  qvar = exp

so record fields can be referred to by qualified names, and in fact you 
are required to use the name by which the field is in scope - but GHC's 
DisambiguateRecordFields extension relaxes this so you're allowed to use 
the unqualified name.


So, in summary:

 - Haskell 98 is completely inconsistent here.

 - GHC + DisambiguateRecordFields is a bit more consistent
   in that unqualified names are allowed in both settings, but
   still allows qualified names in one setting but not the other.

So whatever we do we should be consistent.

It would be slightly strange if record construction required the 
unqualified name, but record update required the qualified name, when 
the field name is only in scope qualified.  So that indicates that we 
should allow either form in record construction (and instance 
declaration), i.e. Claus's suggestion + DisambiguateRecordFields.


Cheers,
Simon

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: RFC: qualified vs unqualified names in defining instance methods

2008-04-25 Thread Claus Reinke

I think that the H98 change was a good one.  Qualified names should
only be used in _uses_ of variables (to disambiguate) and not in
definitions because (hopefully) there is nothing to disambiguate in a
definition.


i was not suggesting to disallow the unqualified def
(even though it irks me as an unneccesary exception).
only that i be allowed to use a qualified name to make
the code less confusing to read (not to mention that the
qualified name is in scope, the unqualified name isn't..). 


By the way, method definitions already have a distinction between what
is on the LHS and what is on the RHS. For example, consider the
following instance:

instance Show a => Show (Maybe a) where
  show Nothing = "Nothing"
  show (Just a)   = "Just " ++ show a

Here "show" is not a recursive function because the "show" on the RHS
is different from the "show" on the LHS.


actually, both 'show's refer to the same thing here, method 'show' in 
class 'Show', and the disambiguation is via the types. now compare 
this with an instance from the class alias encoding i posted in the

other thread:

   instance (FooBar a how, How (CFoo a) (Derived (CFooBar a))) 
 => Foo a (Derived (CFooBar a)) where 
 foo = foo


is it obvious to you which foo refers to what? and though it
looks similar to your example, the disambiguation is not via
types (alone), but via what is in scope, plus the exception that 
i can/have to refer to something that isn't in scope on the left 
hand side.


for reference (spoiler ahead;-), in this example:

- 'Foo' is in scope as both 'FooAndBar.Foo' and 'Foo'
- the lhs 'foo' is not in scope, but refers to 'FooAndBar.foo',
   which is in scope
- the rhs 'foo' is in scope as both 'FooBar.foo' and 'foo',
   and comes from 'FooBar a how', not from any 'Foo'

in the same module, we have:

   class How (CFooBar a) how => FooBar a how where
 foo :: a -> Bool
 foo _ = True
 bar :: Int -> a -> [a]

here, the lhs 'foo' refers to 'FooBar.foo', which is also in
scope as 'foo', and belongs to class 'FooBar'! so the left
hand side 'foo's in the definitions refer to different things.

i originally filed this as a bug, until Simon PJ kindly pointed
me to the Haskell 98 report, which forces GHC to behave
this way.. i guess i'll remember this oddity for a while, so
i can live with it, but if it is irksome that the report allows
me to refer to a name that is not in scope, it is far from 
obvious why it needs to prevent me from referring to a

name that *is* in scope (Malcolm mentioned parsing
ambiguities as the reason for this, but in my case, GHC
recognizes the qualified name and *complains* about it).

claus


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: RFC: qualified vs unqualified names in defining instance methods

2008-04-25 Thread Iavor Diatchki
Hello,
I think that the H98 change was a good one.  Qualified names should
only be used in _uses_ of variables (to disambiguate) and not in
definitions because (hopefully) there is nothing to disambiguate in a
definition.

By the way, method definitions already have a distinction between what
is on the LHS and what is on the RHS. For example, consider the
following instance:

instance Show a => Show (Maybe a) where
   show Nothing = "Nothing"
   show (Just a)   = "Just " ++ show a

Here "show" is not a recursive function because the "show" on the RHS
is different from the "show" on the LHS.
So my preference is to keep the status quo on this issue.

-Iavor



On Fri, Apr 25, 2008 at 7:09 AM, Claus Reinke <[EMAIL PROTECTED]> wrote:
> consider Haskell 98 report, section 4.3.2 "Instance Declarations":
>
>The declarations d may contain bindings only for the class methods of C.
> It is illegal to give a binding for a class method that is not in scope, but
> the   name under which it is in scope is immaterial; in particular, it may
> be a   qualified name. (This rule is identical to that used for subordinate
> names   in export lists --- Section 5.2.) For example, this is legal, even
> though   range is in scope only with the qualified name Ix.range.
>  module A where
>import qualified Ix
>
>instance Ix.Ix T where
>  range = ...
>
>  i consider this confusing (see example at the end), but even
>  worse is that the reference to 5.2 appears to rule out the use of qualified
> names when defining instance methods.
>
>  while this abbreviation of qualified names as unqualified names when
> unambiguous may be harmless in the majority of cases, it
>  seems wrong that the more appropriate explicit disambiguation
>  via qualified names is ruled out entirely.
>  i submit that 4.3.2 should be amended so that qualified names are permitted
> when defining instance methods.
>
>  here's an example to show that the unambiguity holds only on the
>  lhs of the method definition, and that the forced use of unqualified
>  names can be confusing:
>
>module QI where
>  import Prelude hiding (Functor(..))
>import qualified Prelude (Functor(..))
>  data X a = X a deriving Show
>  instance Prelude.Functor X where fmap f (X a) = X (f a)
>where q = (reverse fmap,Prelude.fmap not [True],reverse QI.fmap)
>  fmap = "fmap"
>
>  note that there are two unqualified uses of 'fmap' in the instance
>  declaration, referring to different qualified names:
>  - in the lhs, 'fmap' refers to 'Prelude.fmap', which isn't in scope
>unqualified, only qualified
>
>  - in the rhs, 'fmap' refers to 'QI.fmap'
>
>  claus
>
>
>  ___
>  Haskell-prime mailing list
>  Haskell-prime@haskell.org
>  http://www.haskell.org/mailman/listinfo/haskell-prime
>
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


RE: Haskell' - class aliases

2008-04-25 Thread Simon Peyton-Jones
John

OK here's a question about class alisas. You propose:

   class Foo a where
foo :: a -> [a]
foo x = []
   class Bar a where
bar :: a -> a
bar x = [x]

   class alias FooBar a = (Foo a, Bar a) where
foobar :: a -> a
foobar x = x

foo x = bar x

I have a few minor questions about this that'd be worth clarifying on your main 
page
  (a) I assume you can add a method 'foobar' not declared
in either Foo or Bar.  Your very first example has this.
But it's contradicted later when you say that "One can declare an 
instance
of Num either by giving separate instances for Eq, Additive, 
Multiplicative"

  (b) And I assume that you don't need to repeat the type
signatures for 'foo' and 'bar'.

  (c) I think you intend that you can override the default methods
for foo and bar; and I have done so for method 'foo'.

Question: how does the above differ from this?

   class (Foo a, Bar a) => FooBarSC a where
foobar :: a -> a

Here Foo, Bar are simply superclasses.  From the point of view of a type 
signature there *no* difference:

f :: (FooBarSC a) => ...

gives access to all the methods of Foo and Bar.  So what's the difference?

Answer (I believe): when you give an instance of FooBar
you give implementations for all methods of
Foo, Bar, and FooBar.

So the obvious question is: do we really need a new construct?  Why not just 
use FooBarSC?  Then we'd have to allow you to give implementations for 
superclass methods too:
instance FooBarSC Int where
  foobar = ...
  foo = ...
  bar = ...

I think I believe (like you) that this is a bad idea.  The main reason is that 
it's a totally unclear whether, given a FooBarSC Int instance declaration, 
should there be an instance for (Foo Int), always, never, or optionally?

However, I think you might want to articulate the reasons carefully, because we 
have two features that are really extremely close.

To put it another way, you could imagine re-expressing your proposal like this:

  class (Eq a) && (Additive a, Multiplicative a) => Num a

meaning this: when you give an instance for (FooBar T) you

 * MUST give implementations for the methods
of Addititive and Applicative

 * MUST NOT give implementations for methods of Eq;
rather the Eq T instance must be in scope.

This is, I believe, what you mean by
  class alias Num a = Eq a => (Additive a, Multiplicative a)

Now I'm not necessarily suggesting this as concrete syntax.  But my point is 
that you're really asking for small modification of the existing superclass 
mechanism, that divides the superclasses into two groups, the "flat" ones (like 
Additive and Multiplicative) and the "nested" ones (like Eq).  Is that right? 
If so, a syntax that is more suggestive of the current superclass declaration 
looks better to me.

This close relationship also suggests strongly that the answer to (a) above 
should be 'yes', since you can certainly add methods to a class with 
superclasses.


I won't say more until I'm sure I've understood your intent.

Simon



___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: Haskell' - class aliases

2008-04-25 Thread Claus Reinke

Is this the most up-to-date description of the proposal?
http://repetae.net/recent/out/classalias.html


what sounds nice about the class alias proposal is that it is pure
sugar, at least to the extent that type aliases are, but the design 
principle behind it seems to be that there should be a separate 
class for each method (as in Clean?), and that any compound 
classes should really just be class aliases (made to look like 
compound classes by the sugar), so that rearranging compound
classes comes down to defining more aliases for the same 
single-method base classes.


since this looks like class equivalence plus namespace handling,
i was wondering how far one could get without the proposed 
extension. this is slightly more difficult than the proposed translation

(which splits compound aliases into their components, so that the
alias class is always translated away), but it might still be of interest.

consider the 'class alias FooBar a = (Foo a,Bar a)' example
from the proposal page. we define FooBar and Foor/Bar in
separate modules and use that for namespace management.

- FooAndBar defines Foo and Bar, as well as a type X
   which is an instance of both

- FooBar defines FooBar, implicit derivations of FooBar 
   from Foo/Bar and vice-versa (the aliasing part), as well 
   as a type Y which is an instance of FooBar


   FooBar also arranges for Y to be an instance of Foo/Bar,
   and for X to be an instance of FooBar, via the implicit
   derivations, but controlled by instances of How

note the class 'How' and its instances, which ensure that 
any type class instance is either defined, or derived (in

a unique, specified way), but never both.

problems:

(1) instance method definitions by qualified names are
   not permitted, leading to the confusing 'foo = foo'
   (cf separate thread)
   
(2) overlapping instances, due to the derived instances;
   it seems this can be held in check by the use of 'How', 
   at the expense of some extra parameters/contexts/

   instances to control how each instance is defined/derived

example session:

   *FooBar> foo (X 1)
   False
   *FooBar> bar 0 (X 1)
   [X 1]
   *FooBar> foo (Y 1)
   True
   *FooBar> bar 0 (Y 1)
   [Y 1,Y 1]

   *FooBar> FooAndBar.foo (X 1)
   False
   *FooBar> FooAndBar.foo (Y 1)
   True
   *FooBar> FooAndBar.bar 0 (X 1)
   [X 1]
   *FooBar> FooAndBar.bar 0 (Y 1)
   [Y 1,Y 1]

   *FooBar> :t foo
   foo :: (FooBar a how) => a -> Bool
   *FooBar> :t FooAndBar.foo
   FooAndBar.foo :: (Foo a how) => a -> Bool
   *FooBar> :t bar
   bar :: (FooBar a how) => Int -> a -> [a]
   *FooBar> :t FooAndBar.bar
   FooAndBar.bar :: (Bar b how) => Int -> b -> [b]

i don't think i'd recommend this encoding style (it does not
quite fullfill the criterion of simplicity!-), but there you are:
class aliases encoded.

hth,
claus

ps. (for the TF vs FD fans: replacing FD class 'How' 
   with a TF doesn't seem to work; a bug?)




FooAndBar.hs
Description: Binary data


FooBar.hs
Description: Binary data
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: RFC: qualified vs unqualified names in defining instance methods

2008-04-25 Thread Malcolm Wallace
It is illegal to give a binding for a class method that is not in  
scope, but thename under which it is in scope is immaterial; in  
particular, it may be aqualified name.


I believe this was a change introduced in H'98 to tidy up the  
language.  Previously, if a class was imported qualified, it was only  
possible to declare an instance method by using a qualified name on  
the lhs.  It was felt that this was an oddity, because there are no  
other situations in which it was even possible to define a variable  
with an explicitly-qualified name, and in any case the qualification  
was entirely redundant, because there was no ambiguity.


Additionally, permitting a qualified name to appear in the  
definitional position of any declaration led to ambiguity in parsing.


Regards,
Malcolm

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: The monomorphism restriction and monomorphic pattern bindings

2008-04-25 Thread Neil Mitchell
Hi Simon,

Those additional reasons given are much more compelling, and should
definately go on the wiki. I think the essential point is that it
makes reasoning about the code simpler - regardless of the effect on
implementation.

My main remaining reservation is that:

(x) /= x
[EMAIL PROTECTED] /= x

It really worries me that

(caf) = foo

Can be in an entirely different complexity class from caf = foo. It
seems like the kind of "refactoring" that beginners will be
immediately drawn to, and even experienced programmers will get
tripped up on. Anyone doing (caf) is virtually going to be required to
add a comment just above stating that the brackets are essential.

Does it still work if you relax the definitions so that [EMAIL PROTECTED] is a
pattern binding only if y is a pattern binding, and (x) is a pattern
binding only if x is a pattern binding?

Thanks

Neil


On 4/25/08, Simon Peyton-Jones <[EMAIL PROTECTED]> wrote:
> | The report doesn't actually mention this translation although it is
>  | widely used to implement pattern bindings, and in some compilers (not
>  | GHC) the translation is done before type checking.
>  |
>  | What's interesting to me is that perhaps this gives us a way to
>  | understand what the static semantics of pattern bindings should be,
>  | absent MPB. e.g.
>
>
> Yes, that's a fine point.  If this became the formal definition of the 
> *static* semantics of pattern bindings, that would be a significant 
> improvement, because it'd give us a precise way to answer the various 
> questions I asked. (We might or might not like the answers, but at least we 
> could answer them.)
>
>
>  Simon
>  ___
>  Haskell-prime mailing list
>  Haskell-prime@haskell.org
>  http://www.haskell.org/mailman/listinfo/haskell-prime
>
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


RFC: qualified vs unqualified names in defining instance methods

2008-04-25 Thread Claus Reinke

consider Haskell 98 report, section 4.3.2 "Instance Declarations":

   The declarations d may contain bindings only for the class methods of C. 
   It is illegal to give a binding for a class method that is not in scope, but the 
   name under which it is in scope is immaterial; in particular, it may be a 
   qualified name. (This rule is identical to that used for subordinate names 
   in export lists --- Section 5.2.) For example, this is legal, even though 
   range is in scope only with the qualified name Ix.range. 


 module A where
   import qualified Ix

   instance Ix.Ix T where
 range = ...

i consider this confusing (see example at the end), but even
worse is that the reference to 5.2 appears to rule out the use of 
qualified names when defining instance methods.


while this abbreviation of qualified names as unqualified names 
when unambiguous may be harmless in the majority of cases, it

seems wrong that the more appropriate explicit disambiguation
via qualified names is ruled out entirely. 

i submit that 4.3.2 should be amended so that qualified names 
are permitted when defining instance methods.


here's an example to show that the unambiguity holds only on the
lhs of the method definition, and that the forced use of unqualified
names can be confusing:

   module QI where
   
   import Prelude hiding (Functor(..))

   import qualified Prelude (Functor(..))
   
   data X a = X a deriving Show
   
   instance Prelude.Functor X where 
 fmap f (X a) = X (f a)

   where q = (reverse fmap,Prelude.fmap not [True],reverse QI.fmap)
   
   fmap = "fmap"


note that there are two unqualified uses of 'fmap' in the instance
declaration, referring to different qualified names: 


- in the lhs, 'fmap' refers to 'Prelude.fmap', which isn't in scope
   unqualified, only qualified

- in the rhs, 'fmap' refers to 'QI.fmap'

claus


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


Re: Suggestion regarding (.) and map

2008-04-25 Thread apfelmus

Dan Doel wrote:
If you do want to generalize (.), you have to decide whether you 
want to generalize it as composition of arrows, or as functor application. 
The former isn't a special case of the latter (with the current Functor, at 
least).


By annotating functors with the category they operate on, you can 
reconcile both seemingly different generalizations


   class Category (~>) => Functor (~>) f where
  (.) :: (a ~> b) -> (f a -> f b)

  -- functor application
   instance Functor (->) [] where
  (.) = map

  -- arrow composition
   instance Category (~>) => Functor (~>) (d ~>) where
  (.) = (<<<)


Regards,
apfelmus

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


RE: The monomorphism restriction and monomorphic pattern bindings

2008-04-25 Thread Sittampalam, Ganesh
Simon Peyton Jones wrote:

> 3. I'm more concerned about the programmer than the implementation.  
> Consider
>(f,g) = (negate, show)
> What type do you expect 'f' to have?  A straightforward answer might
be
>f :: (Num a, Show b) => a -> a
> If you don't want that, you need to explain a more complicated typing 
> rule for pattern bindings.I'll ask the same about
>(f,g) = (reverse, length)
> A simple and consistent story is that all the pattern bound variables 
> are generalised over all the class constraints and all the type 
> variables of the RHS.  But I bet that is not what you want.

I think this is reasonable. In general, something of type (Num a, Show
b) => (a -> a, b -> String), might have an occurrence of b hidden inside
a -> a. I
wouldn't expect specific expressions of this type to be given special 
treatment.

Cheers,

Ganesh

==
Please access the attached hyperlink for an important electronic communications 
disclaimer: 

http://www.credit-suisse.com/legal/en/disclaimer_email_ib.html
==

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime


RE: The monomorphism restriction and monomorphic pattern bindings

2008-04-25 Thread Simon Peyton-Jones
| The report doesn't actually mention this translation although it is
| widely used to implement pattern bindings, and in some compilers (not
| GHC) the translation is done before type checking.
|
| What's interesting to me is that perhaps this gives us a way to
| understand what the static semantics of pattern bindings should be,
| absent MPB. e.g.

Yes, that's a fine point.  If this became the formal definition of the *static* 
semantics of pattern bindings, that would be a significant improvement, because 
it'd give us a precise way to answer the various questions I asked. (We might 
or might not like the answers, but at least we could answer them.)

Simon
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-prime