RE: IS THIS A BUG ? "rename/RnEnv.lhs:238: Non-exhaustive patterns in function get_tycon_key"

2000-10-03 Thread Simon Peyton-Jones


| CODE THAT PRODUCES THE ERROR
| 
| module Foo where
| 
| import MutableArray
| import ByteArray
| import ST
| import PrelArrExtra
| 
| class Foo t where
| 
|  foo :: t -> ByteArray ix
| 
| instance Ix ix => Foo (forall s. MutableByteArray s ix) where
| 
|  foo x = runST(unsafeFreezeByteArray x)

No, it's not legal to have a for-all type in the argument of a type
constructor like that!  

Foo (forall s.  stuff)  is Not Kosher

But it's a compiler bug that it's not caught more gracefully.
-fglasgow-exts is too liberal!  Thanks for reporting it.

Simon





Re: Is this a bug?

1998-03-06 Thread Carl R. Witty

Marc van Dongen= <[EMAIL PROTECTED]> writes:

> [snip]
> 
> : > > module Main( main ) where
> : > > import List( genericLength )
> : > > main = putStr (show integral) >>
> : > >putStr "\n">>
> : > >return ()
> : > >  where integral = genericLength []
> 
> [snip]
>  
> : This is a legal Haskell program. The (ambiguous) type of `integral' is
> : (Num a => a), but Haskell disambiguates numeric expressions with the
> : help of `default' declarations. As per Haskell 1.4 (see section 4.3.4
> 
> Thanks for the pointer.
> 
> : of the report), this means resolving `integral' to be a value of type
> : Int.
> 
> I think this ``resolving'' may lead to unwanted results. It took
> me quite some time to discover that Integral was resolved to Int
> in some program I had. Is there a possibility of generating a warning
> message whenever programs like the one above have to be disambiguated?
> Maybe a compiler-switch to turn these warning messages on and off?

If you really don't like the default processing, you could use
  default ()
to disable it totally.

Carl Witty
[EMAIL PROTECTED]



Re: Is this a bug?

1998-03-01 Thread Sigbjorn Finne



Marc van Dongen= writes:
> 
> : of the report), this means resolving `integral' to be a value of type
> : Int.
> 
> I think this ``resolving'' may lead to unwanted results. It took
> me quite some time to discover that Integral was resolved to Int
> in some program I had. Is there a possibility of generating a warning
> message whenever programs like the one above have to be disambiguated?
> Maybe a compiler-switch to turn these warning messages on and off?
> 

That sounds like a good idea to me, but I guess it depends on what the
Standard Haskell committee decides to do (if anything) with the
monomorphism restriction, see

 http://www.cs.chalmers.se/~rjmh/Haskell/Messages/Display.cgi?id=69

--Sigbjorn



Re: Is this a bug?

1998-03-01 Thread Marc van Dongen=

[snip]

: > > module Main( main ) where
: > > import List( genericLength )
: > > main = putStr (show integral) >>
: > >putStr "\n">>
: > >return ()
: > >  where integral = genericLength []

[snip]
 
: This is a legal Haskell program. The (ambiguous) type of `integral' is
: (Num a => a), but Haskell disambiguates numeric expressions with the
: help of `default' declarations. As per Haskell 1.4 (see section 4.3.4

Thanks for the pointer.

: of the report), this means resolving `integral' to be a value of type
: Int.

I think this ``resolving'' may lead to unwanted results. It took
me quite some time to discover that Integral was resolved to Int
in some program I had. Is there a possibility of generating a warning
message whenever programs like the one above have to be disambiguated?
Maybe a compiler-switch to turn these warning messages on and off?

: > ghc-3.01 thinks integral is an Int (a big
: > positive integral is sometimes shown as a
: > negative number).
: 
: ghc's implementation of Ints doesn't do overflow checking, so this is

Now there is something I did know.

: not too surprising. Disambiguate your program either by using type
: annotations telling the compiler that `integral' really is an Integer
: or use a `default' declaration.


Thanks again,


Marc



Re: Is this a bug?

1998-03-01 Thread Sigbjorn Finne


Marc van Dongen= writes:
> 
> I suspect the program included below is
> incorrect. Nevertheless it compiles fine under
> ghc-3.01 patchlevel 0.
> 
> > module Main( main ) where
> > import List( genericLength )
> > main = putStr (show integral) >>
> >putStr "\n">>
> >return ()
> >  where integral = genericLength []
> 
> The reason why I am having problems with this
> program is that I cannot infer whether integral
> should be an Int or an Integer.
> 

This is a legal Haskell program. The (ambiguous) type of `integral' is
(Num a => a), but Haskell disambiguates numeric expressions with the
help of `default' declarations. As per Haskell 1.4 (see section 4.3.4
of the report), this means resolving `integral' to be a value of type
Int.

> ghc-3.01 thinks integral is an Int (a big
> positive integral is sometimes shown as a
> negative number).

ghc's implementation of Ints doesn't do overflow checking, so this is
not too surprising. Disambiguate your program either by using type
annotations telling the compiler that `integral' really is an Integer
or use a `default' declaration.

--Sigbjorn



Re: is this a bug?

1998-02-26 Thread Simon Marlow

Marko Schuetz <[EMAIL PROTECTED]> writes:

> ghc-3.01 complains about a syntax error in the following cut down
> program:
> 
> > module Fehler where
> >
> > data Constr 
> >  = (:<-:) { expr :: LambdaCExpr, context :: ContextTerm }
> 
> kinetic% ghc Fehler.hs
> Fehler.hs:4:12: parse error on input: "{"

Yes, it looks like a bug.  The following patch should fix it:

*** hsparser.y  1998/01/21 17:37:09 1.16
--- hsparser.y  1998/02/26 10:47:34
***
*** 755,761 
|  OPAREN qconsym CPAREN batypes{ $$ = mkconstrpre($2,$4,hsplineno); }
  
  /* Con { op1 :: Int } */
!   |  gtycon OCURLY fields CCURLY  { $$ = mkconstrrec($1,$3,hsplineno); }
;
/* 1 S/R conflict on OCURLY -> shift */
  
--- 755,762 
|  OPAREN qconsym CPAREN batypes{ $$ = mkconstrpre($2,$4,hsplineno); }
  
  /* Con { op1 :: Int } */
!   | qtycon OCURLY fields CCURLY   { $$ = mkconstrrec($1,$3,hsplineno); }
!   | OPAREN qconsym CPAREN OCURLY fields CCURLY { $$ = 
mkconstrrec($2,$5,hsplineno); }
;
/* 1 S/R conflict on OCURLY -> shift */
  

Cheers,
Simon

-- 
Simon Marlow [EMAIL PROTECTED]
University of Glasgow   http://www.dcs.gla.ac.uk/~simonm/
finger for PGP public key



Re: Is this a bug???

1998-02-09 Thread Simon L Peyton Jones


> Test.hs:13:
> Too many parameters for class `ParentWidget'
>   In the class declaration for `ParentWidget'

I think you must have omitted -fglasow-exts as Sigbjorn says.
The code that generates the error is this

checkTc (opt_GlasgowExts || length tyvar_names == 1)
(classArityErr class_name)  `thenTc_`


Simon




Re: Is this a bug???

1998-02-07 Thread Sigbjorn Finne


Einar Wolfgang Karlsen writes:
> 
> While experimenting with multiple parameter type classes for
> modelling GUI operations of relevance to the packer, I
> got the following:
> 
> Test.hs:13:
> Too many parameters for class `ParentWidget'
>   In the class declaration for `ParentWidget'
> 
> 
> As far as I can see (it's been a long day), nothing should be wrong

Are you compiling with -fglasgow-exts on?

--Sigbjorn



Re: is this a bug? (fwd)

1998-01-30 Thread Marc van Dongen=

: Hi there,
: 
: 
: 
: While using mkdependHS, I am getting errors because the
: tool can not find .hi files for modules which are imported
: from a library in some other directory than the one I'm
: making in.
: 
: Is this an error, and if not, how do I solve this?
: 

This is embarrassing. As soon as I had submitted the message
I knew the answer to it. Sorry.

Marc