Re: [Haskell] GHC Error question

2006-12-13 Thread Lennart Augustsson
Sure, inferring and comparing for alpha-equal is not the best thing  
pragmatically.  But you asked for an algorithm that would work. :)


So the band-aid solution would be to first try with the signature, if  
that fails, try without and then then use the sig.


-- Lennart

On Dec 13, 2006, at 12:19 , Simon Peyton-Jones wrote:

Hmm.  GHC currently uses the signature to drive typechecking the  
expression; it does not infer a type and compare. (Much better  
error messages that way.)


So (a) it's very undesirable that using the inferred type as a  
signature can ever not work, but (b) it affects only very few  
programs and ones that are almost certainly ambiguous anyway, and  
(c) I can't see an easy way to fix it.  So my current plan is: let  
it lie.


I'll open a low-priority bug report for it though.

Simon

| -Original Message-
| From: Lennart Augustsson [mailto:[EMAIL PROTECTED]
| Sent: 13 December 2006 13:42
| To: Simon Peyton-Jones
| Cc: GHC users
| Subject: Re: [Haskell] GHC Error question
|
| If the type checker really deduces the type 'forall a b . C a b  
=> a -

|  > a' then an inference algorithm that works seems easy.  Do type
| inference for f, then check that the signature the user has given is
| alpha-convertible with the deduced type (well, in general it's more
| complicated than that, of course).
| If the type checker doesn't really deduce 'forall a b . C a b =>  
a ->

| a' then it shouldn't print what it does.
| So I'm curious, what is the exact deduced type?
|
| -- Lennart
|
| On Dec 11, 2006, at 07:16 , Simon Peyton-Jones wrote:
|
| > | Tell me how this make sense:
| > | 1. I enter the definition for f.
| > | 2. I ask ghc for the type of f and get an answer.
| > | 3. I take the answer and tell ghc this is the type of f, and
| ghc
| > | tells me I'm wrong.
| > | Somewhere in this sequence something is going wrong.
| >
| > I agree!  Indeed I wrote:
| >
| > | It doesn't get much simpler than that!  With the type sig, GHC
| > can't see that the (C a b) provided can
| > | satisfy the (C a b1) which arises from the call to op.
However,

| > without the constraint, GHC simply
| > | abstracts over the constrains arising in the RHS, namely (C a
| > b1), and hence infers the type
| > | f :: C a b1 => a -> a
| > | It is extremely undesirable that the inferred type does not work
| > as a type signature, but I don't see
| > | how to fix it
| >
| > If you have an idea for an inference algorithm that would  
typecheck

| > this program, I'd be glad to hear it.  Just to summarise, the
| > difficulty is this:
| > I have a dictionary of type (C a b1)
| > I need a dictionary of type (C a b2)
| > There is no functional dependency between C's parameters
| >
| > Simon
| >
| > PS: the complete program is this:
| > class C a b where
| > op :: a -> a
| >
| > f :: C a b => a -> a
| > f x = op x
| >



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


Re: [Haskell] GHC Error question

2006-12-13 Thread Lennart Augustsson

What Claus says.  What is the real type that ghc infers?
If it's really what it claims it to be, then this is definitely a bug.
And it might not be common to you, but I have several places in my  
code base where I have to leave off type signatures, because the  
inferred signature is not accepted.  And I turn on the warning for a  
missing type sig.  And if it were feasible to make this an error I  
would.


-- Lennart

On Dec 13, 2006, at 13:42 , Claus Reinke wrote:

call me a stickler for details, if you must, but I am still worried  
that this is
not an undesirable inability to use the type signature, but rather  
a real bug

in how the result of type inference is presented.

note that Lennart considers both options, and asks which option is the
one relevant for this example (or: what is the internal  
representation of

the type inferred by GHCi?).

without further constraints, there is nothing linking the b1 needed  
for

op :: C a b1 => a -> a to the b2 provided by f :: C a b2 => a -> a
(and the original example had several uses of class method, with no
indication that they were all linked to the same dictionary).

so I think that GHC is perfectly right in not using the signature to
discharge the constraint for op. imho, there is a real error in the
way GHCi presents the type of f:

   *Main> :t f
   f :: forall t b. (C t b) => t -> t

in spite of this presentation, we can not use any old b here!
the body of f requires a specific b' for op, we just happen to
have not a single clue about which b' that might be.

which is why I suggested that the type should be represented
differently, by marking b as not free, or by using existential
quantification:

http://www.haskell.org/pipermail/glasgow-haskell-users/2006- 
December/011758.html


with such a change, GHC would still not be able to use the
signature inferred by GHCi, but it would now be clear why
that is the case (and why the signature above does not work).

Claus

- Original Message - From: "Simon Peyton-Jones"  
<[EMAIL PROTECTED]>

To: "Lennart Augustsson" <[EMAIL PROTECTED]>
Cc: "GHC users" 
Sent: Wednesday, December 13, 2006 5:19 PM
Subject: RE: [Haskell] GHC Error question


Hmm.  GHC currently uses the signature to drive typechecking the  
expression; it does not infer a type and compare. (Much better  
error messages that way.)


So (a) it's very undesirable that using the inferred type as a  
signature can ever not work, but (b) it affects only very few  
programs and ones that are almost certainly ambiguous anyway, and  
(c) I can't see an easy way to fix it.  So my current plan is: let  
it lie.


I'll open a low-priority bug report for it though.

Simon

| -Original Message-
| From: Lennart Augustsson [mailto:[EMAIL PROTECTED]
| Sent: 13 December 2006 13:42
| To: Simon Peyton-Jones
| Cc: GHC users
| Subject: Re: [Haskell] GHC Error question
|
| If the type checker really deduces the type 'forall a b . C a b  
=> a -

|  > a' then an inference algorithm that works seems easy.  Do type
| inference for f, then check that the signature the user has given is
| alpha-convertible with the deduced type (well, in general it's more
| complicated than that, of course).
| If the type checker doesn't really deduce 'forall a b . C a b =>  
a ->

| a' then it shouldn't print what it does.
| So I'm curious, what is the exact deduced type?
|
| -- Lennart
|
| On Dec 11, 2006, at 07:16 , Simon Peyton-Jones wrote:
|
| > | Tell me how this make sense:
| > | 1. I enter the definition for f.
| > | 2. I ask ghc for the type of f and get an answer.
| > | 3. I take the answer and tell ghc this is the type of f, and
| ghc
| > | tells me I'm wrong.
| > | Somewhere in this sequence something is going wrong.
| >
| > I agree!  Indeed I wrote:
| >
| > | It doesn't get much simpler than that!  With the type sig, GHC
| > can't see that the (C a b) provided can
| > | satisfy the (C a b1) which arises from the call to op.
However,

| > without the constraint, GHC simply
| > | abstracts over the constrains arising in the RHS, namely (C a
| > b1), and hence infers the type
| > | f :: C a b1 => a -> a
| > | It is extremely undesirable that the inferred type does not work
| > as a type signature, but I don't see
| > | how to fix it
| >
| > If you have an idea for an inference algorithm that would  
typecheck

| > this program, I'd be glad to hear it.  Just to summarise, the
| > difficulty is this:
| > I have a dictionary of type (C a b1)
| > I need a dictionary of type (C a b2)
| > There is no functional dependency between C's parameters
| >
| > Simon
| >
| > PS: the complete program is this:
| > class C a b where
| > op :: a -> a
| >
| > f :: C a b => a -> a
| > f x = op x
| >

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

Re: difficult profiling example

2006-12-13 Thread Ian Lynagh

Hi Serge,

On Sat, Dec 09, 2006 at 04:19:26PM +0300, Serge D. Mechveliani wrote:
> This is again on the  time profiling in ghc-6.6.
> Who could, please, guess what is happening?

Is it possible for you to make available a complete, small example
showing the confusing behaviour please?


Thanks
Ian

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


Re: Network.Socket endian problem?

2006-12-13 Thread Sigbjorn Finne

Hi,

as you've time-consumingly discovered, Network.Socket.HostAddress
is represented in network byte order (something that's not well
documented, and a potential trap.)

You may want to consider using Network.Socket.inet_addr as
a constructor.

--sigbjorn

Rich Neswold wrote:

Hello,

I've written a program that uses UDP as its communication with other
processes. It was built with GHC 6.4.1 on MacOS 10.4 (PowerPC) and
works fine. When I moved the code to a Linux box (i386) and built it
with GHC 6.6, it didn't work. The problems turns out to be,
apparently, an endian problem. The socket is created with the
following snippet:

allocSocket :: IO Socket
allocSocket =
   do { s <- socket AF_INET Datagram 0
; handle (\e -> sClose s >> throwIO e) $
  do { connect s (SockAddrInet 6802 0x7f01)
   ; return s
   }
}

On the Macintosh, the socket only receives packets from
127.0.0.1:6802, which is correct (and works). On the Linux machine,
the socket only accepts packets from 1.0.0.127:6802. The data
constructor SockAddrInet doesn't swap the bytes of the address
(although it correctly swaps the bytes of the port number!)

Changing the data constructor call to (SockAddrInet 6802 0x017f)
makes it work on Linux, but not on MacOS 10.4. (You can see what the
socket is bound to, on Linux, with "netstat -aun".)

I don't have access to GHC 6.4.1 on a Linux box to determine whether
this is a regression in 6.6 or simply an overlooked detail. Should I
file a PR? Am I doing something wrong?



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


Re: Network.Socket endian problem?

2006-12-13 Thread Thorkil Naur
Hello,

It appears that you already got an answer to your question that I hope you can 
use. So just for completeness: On my PPC Mac OS X 10.4, both ghc-6.4.1 and 
ghc-6.6 produce results similar to the one you report for OSX. And on my Suse 
Linux, both ghc-6.4.1 and ghc-6.6 produce results ("wrong") similar to the 
one you report for your Linux/i386. So nothing indicates that this is a 
problem caused by differences between ghc versions.

Best regards
Thorkil
On Wednesday 13 December 2006 22:04, Rich Neswold wrote:
> ...
> If you run the program on OSX, you can check the bound address while
> it's waiting for a keystroke. Type "netstat -an -f inet | grep 6802"
> to see. I get:
> 
> udp4   0  0  127.0.0.1.61704127.0.0.1.6802
> 
> which is correct. When I run this program on Linux/i386, I get:
> 
> udp0  0 (anonymized):334121.0.0.127:6802
> ESTABLISHED
...
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Network.Socket endian problem?

2006-12-13 Thread Tomasz Zielonka
On Wed, Dec 13, 2006 at 03:54:59PM -0600, Mark Hills wrote:
> It does expect the address to be in network byte order instead of host
> byte order, which is usually done using htons and htonl. This seems to
> do what you want (running SUSE 10.1 on an Intel box):

Who agrees with me that it would be nice if network libraries used host
byte order in their interface? Or at least they could use an abstract
data type, whose byte order would be unobservable.

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


Re: Network.Socket endian problem?

2006-12-13 Thread Mark Hills
Rich Neswold wrote:
> On 12/13/06, Thorkil Naur <[EMAIL PROTECTED]> wrote:
>> I am not an expert on sockets, but I have both a Linux installation
>> and a PPC
>> Mac OS X 10.4 with both ghc-6.4.1 and ghc-6.6. So if you allow me some
>> additional details (such as complete program texts), perhaps I can
>> perform
>> some useful experiments under your conductance.
>
> I can reproduce it with the following:
>
>> module Main
>>where
>>
>> import Control.Exception
>> import Network.Socket
>> import System.IO
>>
>> allocSocket :: IO Socket
>> allocSocket =
>> do { s <- socket AF_INET Datagram 0
>>; handle (\e -> sClose s >> throwIO e) $
>> do { connect s (SockAddrInet 6802 0x7f01)
>>; return s
>>}
>>}
>>
>> main :: IO ()
>> main = withSocketsDo $ do { s <- allocSocket
>>   ; getChar
>>   ; sClose s
>>   }
>
> If you run the program on OSX, you can check the bound address while
> it's waiting for a keystroke. Type "netstat -an -f inet | grep 6802"
> to see. I get:
>
>udp4   0  0  127.0.0.1.61704127.0.0.1.6802
>
> which is correct. When I run this program on Linux/i386, I get:
>
>udp0  0 (anonymized):334121.0.0.127:6802
> ESTABLISHED
>
> (I removed my IP address.) The second bound address, however, is
> wrong: the octets are in the wrong order. Notice, though, that the
> port number is correct!
>
> Thanks for looking into this!
>

It does expect the address to be in network byte order instead of host
byte order, which is usually done using htons and htonl. This seems to
do what you want (running SUSE 10.1 on an Intel box):

{-# OPTIONS -fglasgow-exts #-}

module Main
   where

import Control.Exception
import Network.Socket
import System.IO
import Data.Word(Word32)

foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32

allocSocket :: IO Socket
allocSocket =
do { s <- socket AF_INET Datagram 0
   ; handle (\e -> sClose s >> throwIO e) $
do { connect s (SockAddrInet 6802 (htonl 0x7f01))
   ; return s
   }
   }

main :: IO ()
main = withSocketsDo $ do { s <- allocSocket
  ; getChar
  ; sClose s
  }

The main change is with importing "htonl" to convert to the right byte
ordering (the other is adding the OPTIONS comment). I'm not that
familiar with GHC yet, so maybe there is something that does this that
is also available outside this module that I'm unaware of. It seems that
iNADDR_ANY uses this internally to get the proper address format. It
also looks like 6802 is converted into a PortNumber behind the scenes,
which involves using htons, making it correct on both machines.

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


Re: Network.Socket endian problem?

2006-12-13 Thread Rich Neswold

On 12/13/06, Thorkil Naur <[EMAIL PROTECTED]> wrote:

I am not an expert on sockets, but I have both a Linux installation and a PPC
Mac OS X 10.4 with both ghc-6.4.1 and ghc-6.6. So if you allow me some
additional details (such as complete program texts), perhaps I can perform
some useful experiments under your conductance.


I can reproduce it with the following:


module Main
   where

import Control.Exception
import Network.Socket
import System.IO

allocSocket :: IO Socket
allocSocket =
do { s <- socket AF_INET Datagram 0
   ; handle (\e -> sClose s >> throwIO e) $
do { connect s (SockAddrInet 6802 0x7f01)
   ; return s
   }
   }

main :: IO ()
main = withSocketsDo $ do { s <- allocSocket
  ; getChar
  ; sClose s
  }


If you run the program on OSX, you can check the bound address while
it's waiting for a keystroke. Type "netstat -an -f inet | grep 6802"
to see. I get:

   udp4   0  0  127.0.0.1.61704127.0.0.1.6802

which is correct. When I run this program on Linux/i386, I get:

   udp0  0 (anonymized):334121.0.0.127:6802
ESTABLISHED

(I removed my IP address.) The second bound address, however, is
wrong: the octets are in the wrong order. Notice, though, that the
port number is correct!

Thanks for looking into this!

--
Rich

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


Re: Network.Socket endian problem?

2006-12-13 Thread Thorkil Naur
Hello,

I am not an expert on sockets, but I have both a Linux installation and a PPC 
Mac OS X 10.4 with both ghc-6.4.1 and ghc-6.6. So if you allow me some 
additional details (such as complete program texts), perhaps I can perform 
some useful experiments under your conductance.

Best regards
Thorkil
On Wednesday 13 December 2006 19:29, Rich Neswold wrote:
> ...
> I've written a program that uses UDP as its communication with other
> processes. It was built with GHC 6.4.1 on MacOS 10.4 (PowerPC) and
> works fine. When I moved the code to a Linux box (i386) and built it
> with GHC 6.6, it didn't work.
> ... 
> I don't have access to GHC 6.4.1 on a Linux box to determine whether 
> this is a regression in 6.6 or simply an overlooked detail. Should I
> file a PR? Am I doing something wrong?
> ...
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: [Haskell] GHC Error question

2006-12-13 Thread Claus Reinke

call me a stickler for details, if you must, but I am still worried that this is
not an undesirable inability to use the type signature, but rather a real bug
in how the result of type inference is presented.

note that Lennart considers both options, and asks which option is the
one relevant for this example (or: what is the internal representation of
the type inferred by GHCi?).

without further constraints, there is nothing linking the b1 needed for
op :: C a b1 => a -> a to the b2 provided by f :: C a b2 => a -> a
(and the original example had several uses of class method, with no
indication that they were all linked to the same dictionary).

so I think that GHC is perfectly right in not using the signature to
discharge the constraint for op. imho, there is a real error in the
way GHCi presents the type of f:

   *Main> :t f
   f :: forall t b. (C t b) => t -> t

in spite of this presentation, we can not use any old b here!
the body of f requires a specific b' for op, we just happen to
have not a single clue about which b' that might be.

which is why I suggested that the type should be represented
differently, by marking b as not free, or by using existential
quantification:

http://www.haskell.org/pipermail/glasgow-haskell-users/2006-December/011758.html

with such a change, GHC would still not be able to use the
signature inferred by GHCi, but it would now be clear why
that is the case (and why the signature above does not work).

Claus

- Original Message - 
From: "Simon Peyton-Jones" <[EMAIL PROTECTED]>

To: "Lennart Augustsson" <[EMAIL PROTECTED]>
Cc: "GHC users" 
Sent: Wednesday, December 13, 2006 5:19 PM
Subject: RE: [Haskell] GHC Error question


Hmm.  GHC currently uses the signature to drive typechecking the expression; it does not infer a 
type and compare. (Much better error messages that way.)


So (a) it's very undesirable that using the inferred type as a signature can ever not work, but (b) 
it affects only very few programs and ones that are almost certainly ambiguous anyway, and (c) I 
can't see an easy way to fix it.  So my current plan is: let it lie.


I'll open a low-priority bug report for it though.

Simon

| -Original Message-
| From: Lennart Augustsson [mailto:[EMAIL PROTECTED]
| Sent: 13 December 2006 13:42
| To: Simon Peyton-Jones
| Cc: GHC users
| Subject: Re: [Haskell] GHC Error question
|
| If the type checker really deduces the type 'forall a b . C a b => a -
|  > a' then an inference algorithm that works seems easy.  Do type
| inference for f, then check that the signature the user has given is
| alpha-convertible with the deduced type (well, in general it's more
| complicated than that, of course).
| If the type checker doesn't really deduce 'forall a b . C a b => a ->
| a' then it shouldn't print what it does.
| So I'm curious, what is the exact deduced type?
|
| -- Lennart
|
| On Dec 11, 2006, at 07:16 , Simon Peyton-Jones wrote:
|
| > | Tell me how this make sense:
| > | 1. I enter the definition for f.
| > | 2. I ask ghc for the type of f and get an answer.
| > | 3. I take the answer and tell ghc this is the type of f, and
| ghc
| > | tells me I'm wrong.
| > | Somewhere in this sequence something is going wrong.
| >
| > I agree!  Indeed I wrote:
| >
| > | It doesn't get much simpler than that!  With the type sig, GHC
| > can't see that the (C a b) provided can
| > | satisfy the (C a b1) which arises from the call to op.   However,
| > without the constraint, GHC simply
| > | abstracts over the constrains arising in the RHS, namely (C a
| > b1), and hence infers the type
| > | f :: C a b1 => a -> a
| > | It is extremely undesirable that the inferred type does not work
| > as a type signature, but I don't see
| > | how to fix it
| >
| > If you have an idea for an inference algorithm that would typecheck
| > this program, I'd be glad to hear it.  Just to summarise, the
| > difficulty is this:
| > I have a dictionary of type (C a b1)
| > I need a dictionary of type (C a b2)
| > There is no functional dependency between C's parameters
| >
| > Simon
| >
| > PS: the complete program is this:
| > class C a b where
| > op :: a -> a
| >
| > f :: C a b => a -> a
| > f x = op x
| >

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


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


Network.Socket endian problem?

2006-12-13 Thread Rich Neswold

Hello,

I've written a program that uses UDP as its communication with other
processes. It was built with GHC 6.4.1 on MacOS 10.4 (PowerPC) and
works fine. When I moved the code to a Linux box (i386) and built it
with GHC 6.6, it didn't work. The problems turns out to be,
apparently, an endian problem. The socket is created with the
following snippet:

allocSocket :: IO Socket
allocSocket =
   do { s <- socket AF_INET Datagram 0
; handle (\e -> sClose s >> throwIO e) $
  do { connect s (SockAddrInet 6802 0x7f01)
   ; return s
   }
}

On the Macintosh, the socket only receives packets from
127.0.0.1:6802, which is correct (and works). On the Linux machine,
the socket only accepts packets from 1.0.0.127:6802. The data
constructor SockAddrInet doesn't swap the bytes of the address
(although it correctly swaps the bytes of the port number!)

Changing the data constructor call to (SockAddrInet 6802 0x017f)
makes it work on Linux, but not on MacOS 10.4. (You can see what the
socket is bound to, on Linux, with "netstat -aun".)

I don't have access to GHC 6.4.1 on a Linux box to determine whether
this is a regression in 6.6 or simply an overlooked detail. Should I
file a PR? Am I doing something wrong?

--
Rich

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


RE: [Haskell] GHC Error question

2006-12-13 Thread Simon Peyton-Jones
Hmm.  GHC currently uses the signature to drive typechecking the expression; it 
does not infer a type and compare. (Much better error messages that way.)

So (a) it's very undesirable that using the inferred type as a signature can 
ever not work, but (b) it affects only very few programs and ones that are 
almost certainly ambiguous anyway, and (c) I can't see an easy way to fix it.  
So my current plan is: let it lie.

I'll open a low-priority bug report for it though.

Simon

| -Original Message-
| From: Lennart Augustsson [mailto:[EMAIL PROTECTED]
| Sent: 13 December 2006 13:42
| To: Simon Peyton-Jones
| Cc: GHC users
| Subject: Re: [Haskell] GHC Error question
|
| If the type checker really deduces the type 'forall a b . C a b => a -
|  > a' then an inference algorithm that works seems easy.  Do type
| inference for f, then check that the signature the user has given is
| alpha-convertible with the deduced type (well, in general it's more
| complicated than that, of course).
| If the type checker doesn't really deduce 'forall a b . C a b => a ->
| a' then it shouldn't print what it does.
| So I'm curious, what is the exact deduced type?
|
| -- Lennart
|
| On Dec 11, 2006, at 07:16 , Simon Peyton-Jones wrote:
|
| > | Tell me how this make sense:
| > | 1. I enter the definition for f.
| > | 2. I ask ghc for the type of f and get an answer.
| > | 3. I take the answer and tell ghc this is the type of f, and
| ghc
| > | tells me I'm wrong.
| > | Somewhere in this sequence something is going wrong.
| >
| > I agree!  Indeed I wrote:
| >
| > | It doesn't get much simpler than that!  With the type sig, GHC
| > can't see that the (C a b) provided can
| > | satisfy the (C a b1) which arises from the call to op.   However,
| > without the constraint, GHC simply
| > | abstracts over the constrains arising in the RHS, namely (C a
| > b1), and hence infers the type
| > | f :: C a b1 => a -> a
| > | It is extremely undesirable that the inferred type does not work
| > as a type signature, but I don't see
| > | how to fix it
| >
| > If you have an idea for an inference algorithm that would typecheck
| > this program, I'd be glad to hear it.  Just to summarise, the
| > difficulty is this:
| > I have a dictionary of type (C a b1)
| > I need a dictionary of type (C a b2)
| > There is no functional dependency between C's parameters
| >
| > Simon
| >
| > PS: the complete program is this:
| > class C a b where
| > op :: a -> a
| >
| > f :: C a b => a -> a
| > f x = op x
| >

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


Re: [Haskell] GHC Error question

2006-12-13 Thread Lennart Augustsson
If the type checker really deduces the type 'forall a b . C a b => a - 
> a' then an inference algorithm that works seems easy.  Do type  
inference for f, then check that the signature the user has given is  
alpha-convertible with the deduced type (well, in general it's more  
complicated than that, of course).
If the type checker doesn't really deduce 'forall a b . C a b => a ->  
a' then it shouldn't print what it does.

So I'm curious, what is the exact deduced type?

-- Lennart

On Dec 11, 2006, at 07:16 , Simon Peyton-Jones wrote:


| Tell me how this make sense:
| 1. I enter the definition for f.
| 2. I ask ghc for the type of f and get an answer.
| 3. I take the answer and tell ghc this is the type of f, and ghc
| tells me I'm wrong.
| Somewhere in this sequence something is going wrong.

I agree!  Indeed I wrote:

| It doesn't get much simpler than that!  With the type sig, GHC  
can't see that the (C a b) provided can
| satisfy the (C a b1) which arises from the call to op.   However,  
without the constraint, GHC simply
| abstracts over the constrains arising in the RHS, namely (C a  
b1), and hence infers the type

| f :: C a b1 => a -> a
| It is extremely undesirable that the inferred type does not work  
as a type signature, but I don't see

| how to fix it

If you have an idea for an inference algorithm that would typecheck  
this program, I'd be glad to hear it.  Just to summarise, the  
difficulty is this:

I have a dictionary of type (C a b1)
I need a dictionary of type (C a b2)
There is no functional dependency between C's parameters

Simon

PS: the complete program is this:
class C a b where
op :: a -> a

f :: C a b => a -> a
f x = op x



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