Re: GHC ARM builds?

2012-07-11 Thread Jens Petersen
ghc-7.4.2 should also build fine on Fedora 17 ARM.
Just "yum install ghc llvm" first.

I can provide a src rpm if it helps.

Jens

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


Re: Call to arms: lambda-case is stuck and needs your help

2012-07-11 Thread Iavor Diatchki
Hello,
I am late to the discussion and this is not entirely on topic, for which I
apologize, but I like the multi-branch case syntax someone mentioned
earlier:

Writing:

> case
>   | p1 -> e1
>   | p2 -> e2
>   | ...

desugars to:

> case () of
>   _ | p1 -> e2
> | p2 -> e2
> | ...

-Iavor
PS:  I think it also makes sense to use "if" instead of "case" for this.
 Either way,  I find myself writing these kind of cases quite often, so
having the sugar would be nice.


On Tue, Jul 10, 2012 at 8:55 AM, Chris Smith  wrote:

> On Tue, Jul 10, 2012 at 5:53 AM, Wolfgang Jeltsch
>  wrote:
> > If we use \case for functions, we should use proc case for arrows;
> > if we use \of for functions, we should use proc of for arrows.
> >
> > By the way, is proc a layout herald already?
>
> No, proc is not a layout herald.  The normal pattern is to use a do in
> the command part of the proc syntax, so it's do that introduces the
> layout.  So "proc of" would fit in cleanly as a way to do proc with
> multiple patterns.  Or "proc case", but again that's just a really
> ugly language wart, IMO uglier than just writing out the longhand
> version of "proc x -> case x of".
>
> --
> Chris Smith
>
> ___
> 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


Re: How to describe this bug?

2012-07-11 Thread Aleksey Khudyakov

On 11.07.2012 20:05, Tyson Whitehead wrote:

On July 11, 2012 04:51:50 Christian Maeder wrote:

Is it not enough to store floats into memory just before equality tests
(or add rounding in the instance definitions of Float and Double in Eq
and Ord)?


You have to be 100% consistent in how you do every operations in all cases
otherwise different levels of rounding errors will creep into the results.

It isn't too hard to imagine a floating point expression getting inlined
somewhere, and the compiler generating code to evalulate it all in registers.
Intermediate operations will then be done to 80 bit precision.

Elsewhere, it doesn't get inlined and the compiler generates code to store
intermediate results in memory.  Intermediate operations will then be done to
32 bit precision.  Different results will occur on the rounding boundaires.

Always storing and reloading after every operations will give you consistent
results.  I guess the other option is to disable inlining etc. or somehow
ensure they are applied consistently in all use cases of an expression.

There are more possibilities. With optimizations turned on compiler may 
be able to squeeze everything into registers and do store/load 
operations otherwise. However I don't consider it a problem. If your 
result depends on rounding you are in deep trouble and it's quite likely 
result is garbage.


Equality is a bit more complicated. It's rarely meaningful and if you do 
need exact equality you'd better to ensure that number is stored because 
exact behaviour depends on hardware, compiler and compiler flags.


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


Re: How to describe this bug?

2012-07-11 Thread Tyson Whitehead
On July 11, 2012 04:51:50 Christian Maeder wrote:
> Is it not enough to store floats into memory just before equality tests
> (or add rounding in the instance definitions of Float and Double in Eq
> and Ord)?

You have to be 100% consistent in how you do every operations in all cases 
otherwise different levels of rounding errors will creep into the results.

It isn't too hard to imagine a floating point expression getting inlined 
somewhere, and the compiler generating code to evalulate it all in registers.  
Intermediate operations will then be done to 80 bit precision.

Elsewhere, it doesn't get inlined and the compiler generates code to store 
intermediate results in memory.  Intermediate operations will then be done to 
32 bit precision.  Different results will occur on the rounding boundaires.

Always storing and reloading after every operations will give you consistent 
results.  I guess the other option is to disable inlining etc. or somehow 
ensure they are applied consistently in all use cases of an expression.

Cheers!  -Tyson

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


Re: [Fwd: Memory corruption issues when using newAlignedPinnedByteArray, GC kicking in?]

2012-07-11 Thread Nicolas Trangez
On Wed, 2012-07-11 at 09:50 +0100, Simon Marlow wrote:
> On 10/07/2012 23:03, Nicolas Trangez wrote:
> > All,
> >
> > I sent this mail to Haskell Cafe earlier today, and was pointed [1] at
> > this list. As such...
> >
> > Any help/advice would be greatly appreciated!
> 
> It looks like you're making a ForeignPtr from the Addr# or Ptr that 
> points to the contents of the ByteArray#.  Since this ForeignPtr doesn't 
> keep the original ByteArray# alive, the GC will collect it.  You need to 
> keep a reference to the ByteArray# too.

Even though I suspected this and it's blatantly obvious, I failed to
recognize the ForeignPtr as returned by mallocPlainForeignPtrBytes keeps
the reference. Stupid me. Thanks.

> Basically you need a version of mallocForeignPtrBytes that has supports 
> alignment.  Unfortunately it's not possible to write one because the 
> internals of ForeignPtrContents are not exported - we had a recent 
> ticket about that (http://hackage.haskell.org/trac/ghc/ticket/7012) and 
> in 7.6.1 we will export the necessary internals.  If you want we could 
> also add mallocForeignPtrAlignedBytes - please send a patch.

http://hackage.haskell.org/trac/ghc/ticket/7067

Thanks,

Nicolas


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


Re: How to describe this bug?

2012-07-11 Thread Simon Marlow

On 11/07/2012 09:51, Christian Maeder wrote:

Am 11.07.2012 10:25, schrieb Simon Marlow:

On 11/07/2012 08:36, Christian Maeder wrote:

Hi,

I think this bug is serious and should be turned into a ticket on
http://hackage.haskell.org/trac/ghc/
Would you do so Sönke?

The abstraction of floats (Float or Double) is broken if equality
considers (random and invisible) excess bits that are not part of the
ordinary sign, exponent and fraction representation.

It should also hold: show f1 == show f2  => f1 == f2
and: read (show f) == f
(apart from NaN)

Why do you "doubt that we'll ever fix this", Simon?


Several reasons:

  - the fix hurts performance badly, because you have to store floats
into memory after every operation. (c.f. gcc's -ffloat-store option)


If we sacrifice correctness for performance then we should clearly
document this!


I will document it in the User's Guide along with the other known bugs.


What is the problem to disable -fexcess-precision or enable -msse2 (on
most machines) by default?


-fexcess-precision cannot be disabled on x86 (that is the bug).

-msse2 is not supported on all processors, so we can't enable it by
default.


Can't "configure" find this out?


Configure will detect whether the machine you're building on supports 
-msse2, but not whether the machine that you will eventually *run* the 
code on does.  For instance, when building GHC for distribution we have 
to assume that the target machine does not support SSE2, so all the 
libraries must be built without -msse2.


Cheers,
Simon




C.


Cheers,
 Simon




Cheers Christian

Am 10.07.2012 14:33, schrieb Simon Marlow:

On 10/07/2012 12:21, Aleksey Khudyakov wrote:

On Tue, Jul 10, 2012 at 3:06 PM, Sönke Hahn 
wrote:

I've attached the code. The code does not make direct use of
unsafePerformIO. It uses QuickCheck, but I don't think, this is a
QuickCheck bug. The used Eq-instance is the one for Float.

I've only managed to reproduce this bug on 32-bit-linux with
ghc-7.4.2
when compiling with -O2.


It's expected behaviour with floats. Calculations in FPU are done in
maximul precision available.  If one evaluation result is kept in
registers
and another has been moved to memory and rounded and move back to
registers
number will be not the same indeed.

In short. Never compare floating point number for equality unless you
really know
what are you doing.


I consider it a bug, because as the original poster pointed out it is a
violation of referential transparency.  What's more, it is *not* an
inherent property of floating point arithmetic, because if the compiler
is careful to do all the operations at the correct precision then you
can get determinstic results.  This is why GHC has the
-fexcess-precision flag: you have to explicitly ask to break
referential
transparency.

The bug is that the x86 native code generator behaves as if
-fexcess-precision is always on.  I seriously doubt that we'll ever fix
this "bug": you can get correct behaviour by enabling -msse2, or
using a
64-bit machine.  I don't off-hand know what the LLVM backend does here,
but I would guess that it has the same bug.

Cheers,
 Simon

___
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


Re: How to describe this bug?

2012-07-11 Thread Christian Maeder

Am 11.07.2012 10:25, schrieb Simon Marlow:

On 11/07/2012 08:36, Christian Maeder wrote:

Hi,

I think this bug is serious and should be turned into a ticket on
http://hackage.haskell.org/trac/ghc/
Would you do so Sönke?

The abstraction of floats (Float or Double) is broken if equality
considers (random and invisible) excess bits that are not part of the
ordinary sign, exponent and fraction representation.

It should also hold: show f1 == show f2  => f1 == f2
and: read (show f) == f
(apart from NaN)

Why do you "doubt that we'll ever fix this", Simon?


Several reasons:

  - the fix hurts performance badly, because you have to store floats
into memory after every operation. (c.f. gcc's -ffloat-store option)


If we sacrifice correctness for performance then we should clearly 
document this!


Is it not enough to store floats into memory just before equality tests 
(or add rounding in the instance definitions of Float and Double in Eq 
and Ord)?



  - the fix is complicated
  - good workarounds exist (-msse2)
  - it is rarely a problem


Rare cases are extremely hard to track down if they occur!


What is the problem to disable -fexcess-precision or enable -msse2 (on
most machines) by default?


-fexcess-precision cannot be disabled on x86 (that is the bug).

-msse2 is not supported on all processors, so we can't enable it by
default.


Can't "configure" find this out?

C.


Cheers,
 Simon




Cheers Christian

Am 10.07.2012 14:33, schrieb Simon Marlow:

On 10/07/2012 12:21, Aleksey Khudyakov wrote:

On Tue, Jul 10, 2012 at 3:06 PM, Sönke Hahn 
wrote:

I've attached the code. The code does not make direct use of
unsafePerformIO. It uses QuickCheck, but I don't think, this is a
QuickCheck bug. The used Eq-instance is the one for Float.

I've only managed to reproduce this bug on 32-bit-linux with ghc-7.4.2
when compiling with -O2.


It's expected behaviour with floats. Calculations in FPU are done in
maximul precision available.  If one evaluation result is kept in
registers
and another has been moved to memory and rounded and move back to
registers
number will be not the same indeed.

In short. Never compare floating point number for equality unless you
really know
what are you doing.


I consider it a bug, because as the original poster pointed out it is a
violation of referential transparency.  What's more, it is *not* an
inherent property of floating point arithmetic, because if the compiler
is careful to do all the operations at the correct precision then you
can get determinstic results.  This is why GHC has the
-fexcess-precision flag: you have to explicitly ask to break referential
transparency.

The bug is that the x86 native code generator behaves as if
-fexcess-precision is always on.  I seriously doubt that we'll ever fix
this "bug": you can get correct behaviour by enabling -msse2, or using a
64-bit machine.  I don't off-hand know what the LLVM backend does here,
but I would guess that it has the same bug.

Cheers,
 Simon

___
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


Re: [Fwd: Memory corruption issues when using newAlignedPinnedByteArray, GC kicking in?]

2012-07-11 Thread Simon Marlow

On 10/07/2012 23:03, Nicolas Trangez wrote:

All,

I sent this mail to Haskell Cafe earlier today, and was pointed [1] at
this list. As such...

Any help/advice would be greatly appreciated!


It looks like you're making a ForeignPtr from the Addr# or Ptr that 
points to the contents of the ByteArray#.  Since this ForeignPtr doesn't 
keep the original ByteArray# alive, the GC will collect it.  You need to 
keep a reference to the ByteArray# too.


Basically you need a version of mallocForeignPtrBytes that has supports 
alignment.  Unfortunately it's not possible to write one because the 
internals of ForeignPtrContents are not exported - we had a recent 
ticket about that (http://hackage.haskell.org/trac/ghc/ticket/7012) and 
in 7.6.1 we will export the necessary internals.  If you want we could 
also add mallocForeignPtrAlignedBytes - please send a patch.


Cheers,
Simon





Thanks,

Nicolas

[1] http://www.haskell.org/pipermail/haskell-cafe/2012-July/102242.html

 Forwarded Message 

From: Nicolas Trangez 
To: haskell-c...@haskell.org
Cc: Roman Leshchinskiy 
Subject: Memory corruption issues when using
newAlignedPinnedByteArray, GC kicking in?
Date: Tue, 10 Jul 2012 19:20:01 +0200

All,

While working on my vector-simd library, I noticed somehow memory I'm
using gets corrupted/overwritten. I reworked this into a test case, and
would love to get some help on how to fix this.

Previously I used some custom FFI calls to C to allocate aligned memory,
which yields correct results, but this has a significant (+- 10x)
performance impact on my benchmarks. Later on I discovered the
newAlignedPinnedByteArray# function, and wrote some code using this.

Here's what I did in the test case: I created an MVector instance, with
the exact same implementation as vector's
Data.Vector.Storable.Mutable.MVector instance, except for basicUnsafeNew
where I pass one more argument to mallocVector [1].

I also use 3 different versions of mallocVector (depending on
compile-time flags):

mallocVectorOrig [2]: This is the upstream version, discarding the
integer argument I added.

Then here's my first attempt, very similar to the implementation of
mallocPlainForeignPtrBytes [3] at [4] using GHC.* libraries.

Finally there's something similar at [5] which uses the 'primitive'
library.

The test case creates vectors of increasing size, then checks whether
they contain the expected values. For the default implementation this
works correctly. For both others it fails at some random size, and the
values stored in the vector are not exactly what they should be.

I don't understand what's going on here. I suspect I lack a reference
(or something along those lines) so GC kicks in, or maybe the buffer
gets relocated, whilst it shouldn't.

Basically I'd need something like

GHC.ForeignPtr.mallocPlainAlignedForeignPtrBytes :: Int -> Int -> IO
(ForeignPtr a)

Thanks,

Nicolas

[1] https://gist.github.com/3084806#LC37
[2] https://gist.github.com/3084806#LC119
[3]
http://hackage.haskell.org/packages/archive/base/latest/doc/html/src/GHC-ForeignPtr.html
[4] https://gist.github.com/3084806#LC100
[5] https://gist.github.com/3084806#LC81






___
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


Re: How to describe this bug?

2012-07-11 Thread Simon Marlow

On 11/07/2012 08:36, Christian Maeder wrote:

Hi,

I think this bug is serious and should be turned into a ticket on
http://hackage.haskell.org/trac/ghc/
Would you do so Sönke?

The abstraction of floats (Float or Double) is broken if equality
considers (random and invisible) excess bits that are not part of the
ordinary sign, exponent and fraction representation.

It should also hold: show f1 == show f2  => f1 == f2
and: read (show f) == f
(apart from NaN)

Why do you "doubt that we'll ever fix this", Simon?


Several reasons:

 - the fix hurts performance badly, because you have to store floats
   into memory after every operation. (c.f. gcc's -ffloat-store option)
 - the fix is complicated
 - good workarounds exist (-msse2)
 - it is rarely a problem


What is the problem to disable -fexcess-precision or enable -msse2 (on
most machines) by default?


-fexcess-precision cannot be disabled on x86 (that is the bug).

-msse2 is not supported on all processors, so we can't enable it by default.

Cheers,
Simon




Cheers Christian

Am 10.07.2012 14:33, schrieb Simon Marlow:

On 10/07/2012 12:21, Aleksey Khudyakov wrote:

On Tue, Jul 10, 2012 at 3:06 PM, Sönke Hahn 
wrote:

I've attached the code. The code does not make direct use of
unsafePerformIO. It uses QuickCheck, but I don't think, this is a
QuickCheck bug. The used Eq-instance is the one for Float.

I've only managed to reproduce this bug on 32-bit-linux with ghc-7.4.2
when compiling with -O2.


It's expected behaviour with floats. Calculations in FPU are done in
maximul precision available.  If one evaluation result is kept in
registers
and another has been moved to memory and rounded and move back to
registers
number will be not the same indeed.

In short. Never compare floating point number for equality unless you
really know
what are you doing.


I consider it a bug, because as the original poster pointed out it is a
violation of referential transparency.  What's more, it is *not* an
inherent property of floating point arithmetic, because if the compiler
is careful to do all the operations at the correct precision then you
can get determinstic results.  This is why GHC has the
-fexcess-precision flag: you have to explicitly ask to break referential
transparency.

The bug is that the x86 native code generator behaves as if
-fexcess-precision is always on.  I seriously doubt that we'll ever fix
this "bug": you can get correct behaviour by enabling -msse2, or using a
64-bit machine.  I don't off-hand know what the LLVM backend does here,
but I would guess that it has the same bug.

Cheers,
 Simon

___
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


Re: How to describe this bug?

2012-07-11 Thread Christian Maeder

Hi,

I think this bug is serious and should be turned into a ticket on 
http://hackage.haskell.org/trac/ghc/

Would you do so Sönke?

The abstraction of floats (Float or Double) is broken if equality 
considers (random and invisible) excess bits that are not part of the 
ordinary sign, exponent and fraction representation.


It should also hold: show f1 == show f2  => f1 == f2
and: read (show f) == f
(apart from NaN)

Why do you "doubt that we'll ever fix this", Simon?

What is the problem to disable -fexcess-precision or enable -msse2 (on 
most machines) by default?


Cheers Christian

Am 10.07.2012 14:33, schrieb Simon Marlow:

On 10/07/2012 12:21, Aleksey Khudyakov wrote:

On Tue, Jul 10, 2012 at 3:06 PM, Sönke Hahn 
wrote:

I've attached the code. The code does not make direct use of
unsafePerformIO. It uses QuickCheck, but I don't think, this is a
QuickCheck bug. The used Eq-instance is the one for Float.

I've only managed to reproduce this bug on 32-bit-linux with ghc-7.4.2
when compiling with -O2.


It's expected behaviour with floats. Calculations in FPU are done in
maximul precision available.  If one evaluation result is kept in
registers
and another has been moved to memory and rounded and move back to
registers
number will be not the same indeed.

In short. Never compare floating point number for equality unless you
really know
what are you doing.


I consider it a bug, because as the original poster pointed out it is a
violation of referential transparency.  What's more, it is *not* an
inherent property of floating point arithmetic, because if the compiler
is careful to do all the operations at the correct precision then you
can get determinstic results.  This is why GHC has the
-fexcess-precision flag: you have to explicitly ask to break referential
transparency.

The bug is that the x86 native code generator behaves as if
-fexcess-precision is always on.  I seriously doubt that we'll ever fix
this "bug": you can get correct behaviour by enabling -msse2, or using a
64-bit machine.  I don't off-hand know what the LLVM backend does here,
but I would guess that it has the same bug.

Cheers,
 Simon

___
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