Re: [Haskell-cafe] Ambiguous type signature in class declaration

2005-04-27 Thread Bo Herlin
Doh, i have another question:
Lets say i do as you wrote:
> class CRank a b where
>   rank :: a -> b -> Maybe Integer -- Nothing means b is out of range 
or badly constructed
>   unrank :: a -> Integer -> Maybe b -- Nothing means rank is out of range
>
> class CCountable a where
>   count :: a -> Maybe Integer -- Nothing means infinity

how do i make a test-class like this:
> class (CRank a b,CCountable a) => CTestable a where
>   testOne :: a -> Integer -> Bool
>   testUpTo :: a -> Integer -> Bool
>   testOne x r = ((unrank x r) >>= (rank x)) == (Just r)
>   testUpTo x mr = foldr1 (&&) (map (testOne x) [0..m])
> where
>   m = f (count x)
>   f Nothing = mr
>   f (Just y) = min (y-1) mr
this gives me:
ERROR "./Cafe.lhs":14 - Undefined type variable "b"
If i remove the b like "class (CRank a,CCountable a) => CTestable a 
where" i get:

ERROR "./Cafe.lhs":14 - Wrong number of arguments for class "CRank"
As a Haskell-newbee i get totally confused.
/Bo
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Ambiguous type signature in class declaration

2005-04-27 Thread Bo Herlin
Ok, i got it now, thanks for the help.
/Bo
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] fptools in darcs now available

2005-04-27 Thread John Goerzen
Hello,

I am pleased to announce that I have used tailor.py to successfully
convert the entire history of fptools HEAD branch, dating back to
1996, from CVS to darcs.  For those of you that don't know, fptools
represents the development area for the GHC Haskell compiler as well
as many other related projects.  It contains 21,949 changesets.

You may check out the darcs repository by running:

   darcs get --partial http://darcs.complete.org/fptools

*IMPORTANT REQUEST* PLEASE use --partial when you download this.  If
you really want a full copy of the repo to play with, contact me
offline and I can give you a tar.bz2 somewhere.  This server is not
really set up to handle requests for 21,000 individual files.

Currently, there is one checkpoint, made near the present time.  I am
going to try to add some more at various points in history if that
would be useful.  I'm not quite sure how to checkpoint old versions in
a repo yet, though, so if anyone has tips...  send 'em my way.

Anyway, comments welcome.

I intend to sync this up with the CVS sources every few days until
either 1) the fptools people adopt darcs, or 2) it becomes apparent
that it's not being useful for people.

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


Re: [Haskell-cafe] Ambiguous type signature in class declaration

2005-04-27 Thread Benjamin Franksen
On Wednesday 27 April 2005 22:12, Benjamin Franksen wrote:
> Another trick is to split the class: 
>
>   class Countable a where
> count :: a -> Maybe Integer -- Nothing means infinity
>
>   class Countable a => CRank a b where
> rank :: ...
> ...

This solution has similar disadvantages as the fundep variant, that is, there 
can be only one instance for 'Countable Prime' and not two different ones 
(like an infinite count for Integer Primes and a finite one for Ints). In 
fact, this seems to be a standard way to achieve the effect of fundeps 
without actually using them (although I have read somewhere that it doesn't 
work in all cases).

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


Re: [Haskell-cafe] Ambiguous type signature in class declaration

2005-04-27 Thread Benjamin Franksen
On Wednesday 27 April 2005 19:12, Bo Herlin wrote:
> I am trying to make a class like this:
>  > class CRank a b where
>  >   rank :: a -> b -> Maybe Integer -- Nothing means b is out of range
>
> or badly constructed
>
>  >   unrank :: a -> Integer -> Maybe b -- Nothing means rank is out of
>  > range count :: a -> Maybe Integer -- Nothing means infinity
>
> but all i get is
>
> ERROR "./Cafe.lhs":8 - Ambiguous type signature in class declaration
> *** ambiguous type : CRank a b => a -> Maybe Integer
> *** assigned to: count

The type variable 'b' does not appear on the right side of the '=>' in the 
type of 'count'. The compiler complains about an 'ambigous type signature', 
because the type of 'b', and hence of 'count', cannot be determined from its 
arguments. Thus, if there are instances

  instance CRank Prime Integer where ...
  instance CRank Prime Int where ...

then these would have different implementations for 'count'. Which one should 
be chosen if you write

  count Prime

the infinite result for Integers or the (presumably) finite result for Ints? 

Functional dependencies only help if you never want to declare both of the 
above instances. If this is not the case (and therefore you don't want to use 
a fundep 'a -> b'), you can disambiguate the signature by giving it a second 
(phantom) argument to indicate the type:

class CRank a b where
  ...
  count :: a -> b -> Maybe Integer
-- implementations must not evaluate 2nd argument

and call it like this

  let n = count Prime (undefined::Integer)

Admittedly, the extra argument is not very nice and neither is the 
'undefined'. Another trick is to split the class:

  class Countable a where
count :: a -> Maybe Integer -- Nothing means infinity

  class Countable a => CRank a b where
rank :: ...
...

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


Re: [Haskell-cafe] Ambiguous type signature in class declaration

2005-04-27 Thread robert dockins
See:
http://haskell.org/hawiki/FunDeps
 > class CRank a b where
 >   rank :: a -> b -> Maybe Integer -- Nothing means b is out of range 
or badly constructed
 >   unrank :: a -> Integer -> Maybe b -- Nothing means rank is out of 
range
 >   count :: a -> Maybe Integer -- Nothing means infinity

[snip]
but all i get is
ERROR "./Cafe.lhs":8 - Ambiguous type signature in class declaration
*** ambiguous type : CRank a b => a -> Maybe Integer
*** assigned to: count
Any suggestions anyone?

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


[Haskell-cafe] Ambiguous type signature in class declaration

2005-04-27 Thread Bo Herlin
Hi
I am trying to make a class like this:
> class CRank a b where
>   rank :: a -> b -> Maybe Integer -- Nothing means b is out of range 
or badly constructed
>   unrank :: a -> Integer -> Maybe b -- Nothing means rank is out of range
>   count :: a -> Maybe Integer -- Nothing means infinity

with possible instances like
> data DPrime = Prime deriving (Show)
>
> instance CRank DPrime Integer where
>   rank Prime x = Nothing -- to be implemented: (rank Prime 11) should 
give (Just 4)
>   unrank Prime r = Nothing -- to be implemented: (unrank Prime 4) 
should give (Just 11)
>   count _ = Nothing -- Nothing means infinity

and
> data DFibonacci = Fibonacci deriving (Show)
>
> instance CRank DFibonacci Integer where
>   rank Fibonacci x = Nothing -- to be implemented
>   unrank Fibonacci r = Nothing -- to be implemented
>   count _ = Nothing -- Nothing means infinity
but all i get is
ERROR "./Cafe.lhs":8 - Ambiguous type signature in class declaration
*** ambiguous type : CRank a b => a -> Maybe Integer
*** assigned to: count
Any suggestions anyone?
Thanks in advance
/Bo
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Function composition confusion

2005-04-27 Thread Benjamin Franksen
On Wednesday 27 April 2005 15:46, Anuj Seth wrote:
> Thanks, that clears it up
> I was thinking that the output of (splitAt blockSize) would get piped to
> (splitAt blockSize . snd). Did not realize it goes to the whole iterate
> part.

It is useful to keep in mind that function application ('f x') is always of 
the highest precedence; it binds more tightly than any operator.

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


RE: [Haskell-cafe] Function composition confusion

2005-04-27 Thread Anuj Seth

Thanks, that clears it up
I was thinking that the output of (splitAt blockSize) would get piped to 
(splitAt blockSize . snd).
Did not realize it goes to the whole iterate part.

-Original Message-
From: Henning Thielemann [mailto:[EMAIL PROTECTED]
Sent: Wednesday, April 27, 2005 4:37 PM
To: Anuj Seth
Cc: haskell-cafe@haskell.org
Subject: Re: [Haskell-cafe] Function composition confusion



On Wed, 27 Apr 2005, Anuj Seth wrote:

> Excuse the newbie'ness of my question.
> Saw an example in Two Dozen Questions by Rexx Page.
>
> blocks blockSize =
>takeWhile ( not . null ) . map fst .
>  iterate (splitAt blockSize . snd) . splitAt blockSize
>
> What is the meaning of the . operators outside the parentheses ?

The same as inside. :-)
  (splitAt blockSize) transforms a list to a pair of lists. So imagine a
list input at the right of (splitAt blockSize) and a pair output at the
left. This pair is piped into the 'iterate' part which transforms a list
of pairs into a list of pairs of lists. This in turn is piped to (map fst)
and so on.

The information contained in this message is proprietary of Amdocs,
protected from disclosure, and may be privileged.
The information is intended to be conveyed only to the designated recipient(s)
of the message. If the reader of this message is not the intended recipient,
you are hereby notified that any dissemination, use, distribution or copying of
this communication is strictly prohibited and may be unlawful.
If you have received this communication in error, please notify us immediately
by replying to the message and deleting it from your computer.
Thank you.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Function composition confusion

2005-04-27 Thread Henning Thielemann
On Wed, 27 Apr 2005, Anuj Seth wrote:
Excuse the newbie'ness of my question.
Saw an example in Two Dozen Questions by Rexx Page.
blocks blockSize =
   takeWhile ( not . null ) . map fst .
 iterate (splitAt blockSize . snd) . splitAt blockSize
What is the meaning of the . operators outside the parentheses ?
The same as inside. :-)
 (splitAt blockSize) transforms a list to a pair of lists. So imagine a 
list input at the right of (splitAt blockSize) and a pair output at the 
left. This pair is piped into the 'iterate' part which transforms a list 
of pairs into a list of pairs of lists. This in turn is piped to (map fst) 
and so on.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Function composition confusion

2005-04-27 Thread Anuj Seth

Hi,
Excuse the newbie'ness of my question.
Saw an example in Two Dozen Questions by Rexx Page.

blocks blockSize =
takeWhile ( not . null ) . map fst .
  iterate (splitAt blockSize . snd) . splitAt blockSize

What is the meaning of the . operators outside the parentheses ?
Thsi does not look like function composition to me.

Thanks,
Anuj.

The information contained in this message is proprietary of Amdocs,
protected from disclosure, and may be privileged.
The information is intended to be conveyed only to the designated recipient(s)
of the message. If the reader of this message is not the intended recipient,
you are hereby notified that any dissemination, use, distribution or copying of
this communication is strictly prohibited and may be unlawful.
If you have received this communication in error, please notify us immediately
by replying to the message and deleting it from your computer.
Thank you.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] How to debug GHC

2005-04-27 Thread Bernard Pope
On Wed, 2005-04-27 at 07:45 +0200, Ketil Malde wrote:
> > [I want to know] who called who all the way from "main" to "head",
> > because the key function is going to be one somewhere in the middle.
> 
> Perhaps.  I am told stack backtraces are difficult with non-strict
> semantics.

This is true, at least for _lazy_ implementations of non-strict
semantics.

The reason is that the (graph) context in which a function application
is constructed can be very different to the context in which it is
reduced. 

Partial application of functions introduces a similar problem.

This is not a problem in first-order eager languages because the
construction of a (saturated) function application is followed
immediately by its reduction. Thus the contexts of construction and
reduction are the same.

Debugging tools like Hat, Freya and Buddha, "remember" the
construction context of an application, so you can get call graphs that
reflect the dependencies between symbols in the source code. Thus you
can construct a meaningful backtrace etc. Actually, Hat remembers quite
a bit more context than Freya and Buddha, but that's another story.

Another way around the problem is to opt for a non-lazy, but still
non-strict, evaluation order, such as optimistic evaluation. Think:
mostly eager, with the occasional suspension. HsDebug is based on this
idea. (Though it doesn't solve the problem with partial applications.)

Cheers,
Bernie. 

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