Re: UTF-8 decoding error

2006-09-22 Thread Christian Maeder
Duncan Coutts schrieb:
>> /tmp/ghc5667_0/ghc5667_248.hspp:299:17:
> 
> I think you can fix this by pre-pending a {-# LINE #-} pragma in your
> script. Something like:
> 
> #!/bin/sh
> ( echo "{-# LINE 1 \"$2\" #-}" ; iconv -f l1 -t utf-8 $2 ) > $3

Yes, thanks again!
C.
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: UTF-8 decoding error

2006-09-22 Thread Duncan Coutts
On Fri, 2006-09-22 at 17:19 +0200, Christian Maeder wrote:
> Christian Maeder schrieb:
> > Duncan Coutts schrieb:
> >> There is iconv. It could be used as a pre-processor with ghc's -F -pgmF
> >> -optF flags.
> > 
> > NB: -F is missing in the Flag reference
> > 
> > A simple script for the pgmF command
> > 
> > #!/bin/sh
> > iconv -f l1 -t utf-8 $2 > $3
> > 
> > worked for me, thanks!
> 
> The only disadvantage is that the filename in error and warning messages
> is quite useless:
> 
> [ 15 of 400] Compiling Data.Generics2.Instances (
> syb-generics/Data/Generics2/Instances.hs,
> syb-generics/Data/Generics2/Instances.o )
> 
> /tmp/ghc5667_0/ghc5667_248.hspp:299:17:

I think you can fix this by pre-pending a {-# LINE #-} pragma in your
script. Something like:

#!/bin/sh
( echo "{-# LINE 1 \"$2\" #-}" ; iconv -f l1 -t utf-8 $2 ) > $3

Duncan

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


PS. compiler change, was: UTF-8 decoding error

2006-09-22 Thread Christian Maeder
Christian Maeder schrieb:
> [ 15 of 400] Compiling Data.Generics2.Instances (
> syb-generics/Data/Generics2/Instances.hs,
> syb-generics/Data/Generics2/Instances.o )
> 
> /tmp/ghc5667_0/ghc5667_248.hspp:299:17:
> Couldn't match expected type `forall a1. (Data ctx a1) => c (t a1)'
>against inferred type `c1 (t1 a1)'
>   Expected type: (forall a2. (Data ctx a2) => c (t a2))
>  -> Maybe (c [a])
>   Inferred type: c1 (t1 a1) -> Maybe (c1 (t' a1))
> In the expression: gcast1
> In the definition of `dataCast1': dataCast1 _ = gcast1

This particular error is fixed by writing:

   dataCast1 _ f = gcast1 f

(for "dataCast1 _ = gcast1")

C.

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


Re: UTF-8 decoding error

2006-09-22 Thread Christian Maeder
Christian Maeder schrieb:
> Duncan Coutts schrieb:
>> There is iconv. It could be used as a pre-processor with ghc's -F -pgmF
>> -optF flags.
> 
> NB: -F is missing in the Flag reference
> 
> A simple script for the pgmF command
> 
> #!/bin/sh
> iconv -f l1 -t utf-8 $2 > $3
> 
> worked for me, thanks!

The only disadvantage is that the filename in error and warning messages
is quite useless:

[ 15 of 400] Compiling Data.Generics2.Instances (
syb-generics/Data/Generics2/Instances.hs,
syb-generics/Data/Generics2/Instances.o )

/tmp/ghc5667_0/ghc5667_248.hspp:299:17:
Couldn't match expected type `forall a1. (Data ctx a1) => c (t a1)'
   against inferred type `c1 (t1 a1)'
  Expected type: (forall a2. (Data ctx a2) => c (t a2))
 -> Maybe (c [a])
  Inferred type: c1 (t1 a1) -> Maybe (c1 (t' a1))
In the expression: gcast1
In the definition of `dataCast1': dataCast1 _ = gcast1

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


Year 2038 problem in GHC 6.4.2 runtime

2006-09-22 Thread Cyril Schmidt
As far as I can see, the current (6.4.2) GHC runtime
suffers the year 2038 problem; that is, the System.Time
module does not support dates from 2038 onwards
(the code below reproduces the problem).

Is this bug scheduled to be fixed in the near future (my
search in Trac yielded nothing) ?

Regards,

Cyril
___
The following code reproduces the problem with the Windows
distribution of GHC 6.4.2:

module Main where
import System.Time

main = putStrLn $ show $ toClockTime $
 CalendarTime 2038 January 31 12 0 0 0 Sunday 0 "GMT" 0 False

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


Re: compiler change

2006-09-22 Thread Christian Maeder
Simon Peyton-Jones schrieb:
> Aha!  You are the second real customer to discover a change I made to

"customer" sounds as if I will have to pay next time.

> GHC 6.6, namely that pattern bindings are not generalised.  It's a
> documented change (see "Monomorphic pattern bindings" in the 6.6 user
> manual), but it means that 6.6 is not, by default, exactly Haskell 98.
> To recover the previous behaviour use -fno-mono-pat-binds.

thanks for pointing this out!

> You can solve your problem in three ways
> * -fno-mono-pat-binds
> * use the fst/snd thing as you suggest
> * put the polymorphic function in the tuple as Bulat suggested (this
> makes use of GHC's new ability to impredicative polymorphism.

Last question, is using "fst/snd" really a problem as I suspected by
using the constant twice? (I actually didn't explicitly inline the
constant by two calls of unsafePerfromIO.)

Thanks again, Christian

> | -Original Message-

> | mkSimpleFallOut :: (ObjectID,IO a -> IO (Either String a))
> | mkSimpleFallOut = unsafePerformIO newFallOut
> | {-# NOINLINE mkSimpleFallOut #-}
> | 
> | newFallOut :: IO (ObjectID, IO a -> IO (Either String a))

> | simpleFallOutId = fst mkSimpleFallOut
> | addSimpleFallOut = snd mkSimpleFallOut
> | 
> | However, in this case I have inlined mkSimpleFallOut manually! Does
> this
> | matter? If so, how could I rewrite the above code?

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


RE: Re[2]: 6.6 strikes me again :)

2006-09-22 Thread Simon Peyton-Jones
| class (Monad m) =>  MRef m r | r->m, m->r
| class (Monad m) =>  Stream m h | h->m
| newtype StringReader r  =  StringReader r
| instance (Monad m, MRef m r) =>  Stream m (StringReader r)
| 
| coverage condition requires that monad type 'm' should occur in stream
| handle type 'StringReader r'. With MRef defined as bijective type
| function between m and r that is, in fact, true. may be compiler is
just not smart
| enough to figure this?

The coverage condition is certainly conservative -- there are cases
where nothing goes wrong if you drop it, and that's what
-fallow-undecidable-instances does.  The worst that can happen with
-fallow-undecidable-instances is that the type checker loops (and even
then it'll usually emit an error message); if the program typechecks
it'll run ok.

| is using -fallow-undecidable-instances safe in this situation?
| what of MRef fundeps, r->m or m->r, is really necessary in this case -
| i think it is r->m ?

I think you are right.

You could also try adding 'm' as a phantom type parameter to
StringrReader.

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