Re: [Haskell-cafe] Context for type parameters of type constructors

2004-03-30 Thread Henning Thielemann


On Tue, 30 Mar 2004, Dylan Thurston wrote:

> If you use multi-parameter type classes, then in your instance
> declaration you can specify exactly what requirements you need.  For
> instance: 
>
> > class VectorSpace v a where
> >   zero :: v
> >   add :: v -> v -> v
> >   scale :: a -> v -> v

Multi-parameter type classes aren't Haskell 98, are they? I tried to stay
away from them. I didn't get the point yet why the context for 'data'
is not sufficient for the 'instance' method definition.


___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Context for type parameters of type constructors

2004-03-30 Thread MR K P SCHUPKE

>I didn't get the point yet why the context for 'data'
>is not sufficient for the 'instance' method definition.


Not sure who's relpy you're replying to, but I thought my response was
pretty clear (I would though)... The problem is that to define 'zero'
the type of the 'zero' must unify with the vector type. If you define
vector operations as (v a) then a is a polymorphic variable. However
the definition of zero implies that a is an Integral .. these are
not the same type:

(forall a . a) is not (forall a . Integral a => a)

and thats where the type error comes from. You have two choices,
drop the definition of zero, or use multi-parameter type classes.

You could get rid of zero and have:

class VectorSpace v where
   set :: Num a => a -> v a
   add :: Num a => v a -> v a -> v a
   scale :: Num a => a -> v a -> v a

Should do the trick! (zero becomes "set 0")

Regards,
Keean.
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Context for type parameters of type constructors

2004-03-30 Thread Henning Thielemann

On Tue, 30 Mar 2004, MR K P SCHUPKE wrote:

> >I didn't get the point yet why the context for 'data'
> >is not sufficient for the 'instance' method definition.
> 
> Not sure who's relpy you're replying to,

This was clearly an answer to Dylan Thurston.

> but I thought my response was pretty clear (I would though)... 

I'm not sure you got the point of my question. :-(

> You could get rid of zero and have:
> 
> class VectorSpace v where
>set :: Num a => a -> v a
>add :: Num a => v a -> v a -> v a
>scale :: Num a => a -> v a -> v a
> 
> Should do the trick! (zero becomes "set 0")

This wouldn't change much because the compiler also complains about the
other instance definitions, e.g.
  instance VectorSpace VList where
add (VList x) (VList y) = VList (zipWith (+) x y)
 is rejected because the compiler don't believes that the type of x and y
is in class Num. 

My question was why he doesn't believe that. My definition
  data (Num a) => VList a = VList [a]
 clearly states that VLists will ever get types of class Num as
parameters. 


___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Context for type parameters of type constructors

2004-03-30 Thread Keith Wansbrough
 
> My question was why he doesn't believe that. My definition
>   data (Num a) => VList a = VList [a]
>  clearly states that VLists will ever get types of class Num as
> parameters. 

Ah.  Constraints on datatype declarations are a misfeature of Haskell, and 
have no useful effect.  You shouldn't use them.

--KW 8-)
-- 
Keith Wansbrough <[EMAIL PROTECTED]>
http://www.cl.cam.ac.uk/users/kw217/
University of Cambridge Computer Laboratory.

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Context for type parameters of type constructors

2004-03-30 Thread Henning Thielemann

On Tue, 30 Mar 2004, Keith Wansbrough wrote:

> > My question was why he doesn't believe that. My definition
> >   data (Num a) => VList a = VList [a]
> >  clearly states that VLists will ever get types of class Num as
> > parameters. 
> 
> Ah.  Constraints on datatype declarations are a misfeature of Haskell, and 
> have no useful effect.  You shouldn't use them.

Ok.

Btw. ghc suggests:
VectorSpace.lhs:37:
Could not deduce (Num a) from the context (VectorSpace VList)
  arising from the literal `0' at VectorSpace.lhs:37
Probable fix:
Add (Num a) to the class or instance method `zero'
^^^

I know how to add context information to the signature in a class
definition. But how can I add context information at the point of
instantation of a method?


___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] What are Kind errors and how do you fix them?

2004-03-30 Thread S. Alexander Jacobson
I want to thank everybody for the kind
explanations of kind errors.

I think I now understand them (figured it out
through a LOT of trial and error).  The problem
(as Carl and others noted) was I was testing
various ways of doing things using synonyms rather
than data types and didn't know that you can't do
that!

Based on my recent experience as a new coder,
here are some words of advice for future
beginners:

* Beware the monomorphism restriction!
* Avoid type synonyms in instance declarations!
* use newtype whenever possible (also see quickcheck docs)
* you can't use existential types except through class methods!
* you must wrap existential types if you want to
  use them in record-style data declarations
  (No, I have no idea why this is, but it
   appears to be true nonetheless)

The problem with this sort of list is that it is
probably only useful after you have already made
these mistakes.   Oh well.

-Alex-


_
S. Alexander Jacobson  mailto:[EMAIL PROTECTED]
tel:917-770-6565   http://alexjacobson.com
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Adding Ord constraint to instance Monad Set?

2004-03-30 Thread S. Alexander Jacobson
Following the declaration of "instance Monad []"
in the prelude, and puzzling over the absence of
its equivalent from Data.Set, I naively typed:

   instance Monad Set where
m >>= k = concatSets (mapSet k m)
return x = unitSet x
fail s = emptySet

   concatSets sets = foldl union emptySet (setToList sets)
   instance (Eq b,Ord b) => Ord (Set b) where
compare set1 set2 = compare (setToList set1) (setToList set2)

and got the following error:

Could not deduce (Ord b) from the context (Monad Set)
  arising from use of `concatSets' at dbMeta3.hs:242
Probable fix:
Add (Ord b) to the class or instance method `>>='
In the definition of `>>=': >>= m k = concatSets (mapSet k m)
In the definition for method `>>='
In the instance declaration for `Monad Set'

Since I obviously can't modify the class
declaration for Monad, the question arises:

   How does one add (Orb b) to the instance method '>>='?

(Aside: it be really nice if the error messages
suggested textual changes or at least provide
sample syntax in addition to the conceptual
recommendation.)

-Alex-

PS I assume the reason that Set is not declared as
a Monad in Data.Set is oversight rather than
incompatibility

PPS I want to thank everyone who has been
taking the time to answer all of my questions.
I'll try to collect my various learnings into a
useful beginners page once I reach the point where
I think I can create a useful document.

_
S. Alexander Jacobson  mailto:[EMAIL PROTECTED]
tel:917-770-6565   http://alexjacobson.com
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Adding Ord constraint to instance Monad Set?

2004-03-30 Thread Benjamin Franksen
On Wednesday 31 March 2004 00:11, S. Alexander Jacobson wrote:
> Following the declaration of "instance Monad []"
> in the prelude, and puzzling over the absence of
> its equivalent from Data.Set, I naively typed:
>
>instance Monad Set where
>   m >>= k = concatSets (mapSet k m)
>   return x = unitSet x
>   fail s = emptySet
>
>concatSets sets = foldl union emptySet (setToList sets)
>instance (Eq b,Ord b) => Ord (Set b) where
>   compare set1 set2 = compare (setToList set1) (setToList set2)
>
> and got the following error:
>
> Could not deduce (Ord b) from the context (Monad Set)
>   arising from use of `concatSets' at dbMeta3.hs:242
> Probable fix:
> Add (Ord b) to the class or instance method `>>='

I am not quite sure what that means either. I used to understand it as meaning 
"Add (Ord b) either to the type of method '>>=' (in the class) or to the 
class itself or to the instance in which method '>>=' is defined". Now, the 
last is actually impossible in this case, since the instance declaration 
nowhere mentions a type variable to which the context could be added.

> In the definition of `>>=': >>= m k = concatSets (mapSet k m)
> In the definition for method `>>='
> In the instance declaration for `Monad Set'
>
> Since I obviously can't modify the class
> declaration for Monad, the question arises:
>
>How does one add (Orb b) to the instance method '>>='?

One can't (in this case, otherwise see above remarks).

> PS I assume the reason that Set is not declared as
> a Monad in Data.Set is oversight rather than
> incompatibility

I fear your assumption is wrong. I really can't see how to restrict the 
'element' types in instances of class Monad. BTW, even multi-parameter 
classes don't help here.

Now, as i think a little more about it, i believe what you want to do makes no 
sense. The monad operation '>>=' works on monads over *different* 'element' 
(i.e. argument) types (look at the type of '>>='). Your implementation only 
works if argument types are the same. I can't see how this can be generalized 
to different argument types even if both are instances of class Ord.

Maybe sets simply aren't (i.e. can't be made) monads in any natural way.

Ben
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Adding Ord constraint to instance Monad Set?

2004-03-30 Thread Wolfgang Jeltsch
Am Mittwoch, 31. März 2004 00:11 schrieb S. Alexander Jacobson:
> [...]

> Could not deduce (Ord b) from the context (Monad Set)
>   arising from use of `concatSets' at dbMeta3.hs:242
> Probable fix:
> Add (Ord b) to the class or instance method `>>='
> In the definition of `>>=': >>= m k = concatSets (mapSet k m)
> In the definition for method `>>='
> In the instance declaration for `Monad Set'

> [...]

> (Aside: it be really nice if the error messages
> suggested textual changes or at least provide
> sample syntax in addition to the conceptual
> recommendation.)

Hey, what do you want from a compiler?  That it writes you your code? ;-)  
IMO, error messages like the one above are *very* useful; they give you hints 
about what you can do.  If you don't know what the hints mean, you have to 
have a look at the Report or whatever.  (Well, in this special case, I have 
to admit that I also don't know what is meant with "adding a constraint to a 
class or instance method".  I'd say: "adding a constraint to a class, a 
method (declared with the class) or an instance".)

> -Alex-

Wolfgang

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Adding Ord constraint to instance Monad Set?

2004-03-30 Thread Wolfgang Jeltsch
Am Mittwoch, 31. März 2004 03:11 schrieb Benjamin Franksen:
> >instance Monad Set where
> >   m >>= k = concatSets (mapSet k m)
> >   return x = unitSet x
> >   fail s = emptySet
> >
> >concatSets sets = foldl union emptySet (setToList sets)
> >instance (Eq b,Ord b) => Ord (Set b) where
> >   compare set1 set2 = compare (setToList set1) (setToList set2)> [...]

> [...]

> Now, as i think a little more about it, i believe what you want to do makes
> no sense. The monad operation '>>=' works on monads over *different*
> 'element' (i.e. argument) types (look at the type of '>>='). Your
> implementation only works if argument types are the same. I can't see how
> this can be generalized to different argument types even if both are
> instances of class Ord.

I disagree.  AFAICS, his implementation also works with different element 
types.  Am I overlooking something?

> [...]

> Ben

Wolfgang

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Adding Ord constraint to instance Monad Set?

2004-03-30 Thread Tomasz Zielonka
On Wed, Mar 31, 2004 at 08:48:35AM +0200, Wolfgang Jeltsch wrote:
> > Now, as i think a little more about it, i believe what you want to do makes
> > no sense. The monad operation '>>=' works on monads over *different*
> > 'element' (i.e. argument) types (look at the type of '>>='). Your
> > implementation only works if argument types are the same. I can't see how
> > this can be generalized to different argument types even if both are
> > instances of class Ord.
> 
> I disagree.  AFAICS, his implementation also works with different element 
> types.  Am I overlooking something?

I think the real issue is that you can't restrict the types on which
monad operates without modifying the Monad class.

Think about this code:

  f :: Monad m => a -> m a
  f x = do
  return id
  return putStrLn
  return x

It shouldn't be used in a Set monad, because it internally operates on
uncomparable values, but the type signature doesn't reflect this fact.


You can try to define a different version of Monad using multiparameter
type classes, something like:

class M m a b where
(>>>=) :: m a -> (a -> m b) -> m b
...

but it would complicate type signature contexts a lot, for example you
would have

  (\a b c d -> a >>>= b >>>= c >>>= d) 
  :: forall m a b b1 b2.
  (M m b1 b2, M m b b1, M m a b) =>
  m a -> (a -> m b) -> (b -> m b1) -> (b1 -> m b2) -> m b2

instead of

  (\a b c d -> a >>= b >>= c >>= d) 
  :: forall m a b b1 b2.
  (Monad m) =>
  m a -> (a -> m b) -> (b -> m b1) -> (b1 -> m b2) -> m b2

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Adding Ord constraint to instance Monad Set?

2004-03-30 Thread Wolfgang Jeltsch
Am Mittwoch, 31. März 2004 09:32 schrieben Sie:
> On Wed, Mar 31, 2004 at 08:48:35AM +0200, Wolfgang Jeltsch wrote:
> > > Now, as i think a little more about it, i believe what you want to do
> > > makes no sense. The monad operation '>>=' works on monads over
> > > *different* 'element' (i.e. argument) types (look at the type of
> > > '>>='). Your implementation only works if argument types are the same.
> > > I can't see how this can be generalized to different argument types
> > > even if both are instances of class Ord.
> >
> > I disagree.  AFAICS, his implementation also works with different element
> > types.  Am I overlooking something?
>
> I think the real issue is that you can't restrict the types on which
> monad operates without modifying the Monad class.

Exactly.  You would be able to define a meaningful Monad instance for Set if 
Monad would have an Ord restriction on its "element" types.  But since Monad 
doesn't have this restriction, you cannot make a meaningful Monad instance of 
Set.

> [...]

Wolfgang

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Adding Ord constraint to instance Monad Set?

2004-03-30 Thread Henning Thielemann

On Tue, 30 Mar 2004, S. Alexander Jacobson wrote:

> Following the declaration of "instance Monad []"
> in the prelude, and puzzling over the absence of
> its equivalent from Data.Set, I naively typed:
> 
>instance Monad Set where
>   m >>= k = concatSets (mapSet k m)
>   return x = unitSet x
>   fail s = emptySet
> 
>concatSets sets = foldl union emptySet (setToList sets)
>instance (Eq b,Ord b) => Ord (Set b) where
>   compare set1 set2 = compare (setToList set1) (setToList set2)
> 
> and got the following error:
> 
> Could not deduce (Ord b) from the context (Monad Set)
>   arising from use of `concatSets' at dbMeta3.hs:242
> Probable fix:
> Add (Ord b) to the class or instance method `>>='
> In the definition of `>>=': >>= m k = concatSets (mapSet k m)
> In the definition for method `>>='
> In the instance declaration for `Monad Set'

Surprisingly this is exact the same problem I posed in my mail "Context
for type parameters of type constructors" just before. I wanted to create
the class VectorSpace which is the analogon to Monad in your example. I'm
excited if the answers to your question will help me. :-) 


___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe