Re: SIGALRM, SIGVTALRM, and third party libraries

2010-09-08 Thread Simon Marlow

On 06/09/10 19:16, Edward Z. Yang wrote:

Excerpts from Simon Marlow's message of Mon Sep 06 05:57:59 -0400 2010:

What did you have in mind with respect to portable equivalents of
pthread functions?  I'm not sure we need to do anything along these
lines at all, and I'd much rather we didn't enforce any threading
abstraction on foreign clients.


My thought here is that we want interruptible FFI code to be able
to say when it’s entering critical sections in a platform independent
way, and if it uses pthread functions to this effect, it is then tied
to POSIX.  Something more portable would be for the program to tie
itself to our OS threading library OSThreads.c


Maybe.  As a first step I think we could just document what happens when 
a call is interrupted (pthread_cancel() on POSIX, ??? on Windows) and 
let the user handle it.  Is there even a good lowest-common-denominator 
that we can build an API on top of?


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


RE: Type Families and defaults

2010-09-08 Thread Simon Peyton-Jones
Mitar

I'm afraid I didn't understand your questions well enough to answer them.  But 
it'd be worth reading 
http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/other-type-extensions.html#scoped-type-variables

|  It's not trivial to add, but not really hard either.  Has anyone else been
| bitten by this?
| 
| It would be great if it would be added. Obviously I am for it. ;-)
| 
| I think n should be scoped for the whole the class definition,
| everywhere, not just parameter and return values types. If somebody
| would define the same name for it for some local definition, GHC
| should make a shadowing a variable warning.

I do rather agree. Let's see if others do.

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


Re: Type Families and defaults

2010-09-08 Thread Mitar
Hi!

 I'm afraid I didn't understand your questions well enough to answer them.

My question is, why does this type check:

instance Neuron TestNeuron where
  data LiveNeuron TestNeuron = LiveTestNeuron NeuronId

  mkLiveNeuron nid = LiveTestNeuron nid
  getNeuronId (LiveTestNeuron nid) = nid

  live _ _ = return ()

  attach nerve = ((liftM mkLiveNeuron) . forkIO $ bracket (grow :: IO
FooNeuron) dissolve (live nerve)) :: IO (LiveNeuron TestNeuron)

FooNeuron is obviously different to TestNeuron (but both are instances
of Neuron class).

Type signature is:

attach nerve = ((liftM mkLiveNeuron) . forkIO $ bracket (grow :: IO n)
dissolve (live nerve)) :: IO (LiveNeuron n)

This seems different to:

attach nerve = ((liftM mkLiveNeuron) . forkIO $ bracket (grow ::
forall n. IO n) dissolve (live nerve)) :: IO (LiveNeuron n)

which does not type check.

Maybe I am missing some basic understanding.

 But it'd be worth reading 
 http://www.haskell.org/ghc/docs/6.12.2/html/users_guide/other-type-extensions.html#scoped-type-variables

I had. Thanks.


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


Re: SIGALRM, SIGVTALRM, and third party libraries

2010-09-08 Thread Edward Z. Yang
Excerpts from Simon Marlow's message of Wed Sep 08 03:40:42 -0400 2010:
 Maybe.  As a first step I think we could just document what happens when 
 a call is interrupted (pthread_cancel() on POSIX, ??? on Windows) and 
 let the user handle it.  Is there even a good lowest-common-denominator 
 that we can build an API on top of?

I've been thinking carefully about this, and I kind of suspect one-size
fits all won't work here.  I've done a writeup here; one of the problems
with moving pthread_cancel to Windows is that its semantics are so complicated.

http://blog.ezyang.com/2010/09/pthread-cancel-on-window/

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


HEAD: Deterioration in ByteString I/O

2010-09-08 Thread Daniel Fischer
Trying out HEAD (specifically, ghc-6.13.20100831-src.tar.bz2 built with 
6.12.3) investigating an issue with the text package, I found that I/O of 
ByteStrings has become significantly slower (on my machine at least:

$ uname -a
Linux linux-mkk1 2.6.27.48-0.2-pae #1 SMP 2010-07-29 20:06:52 +0200 i686 
i686 i386 GNU/Linux

Pentium 4, 3.06GHz).

Timings for reading and outputting a 74.3MB file:

cat:
$ time cat bigfile  /dev/null
0.00user 0.04system 0:00.06elapsed 83%CPU

ghc-6.12.3:
$ time ./nbench lazyBSNull bigfile a b  /dev/null
0.01user 0.09system 0:00.10elapsed 100%CPU

ghc-6.13.20100831:
$ time ./hdbench lazyBSNull bigfile a b  /dev/null
0.07user 0.10system 0:00.18elapsed 96%CPU

In addition to the slowdown, the allocation behaviour has become quite bad:

ghc-6.12.3:
  89,330,672 bytes allocated in the heap
  15,092 bytes copied during GC
  35,980 bytes maximum residency (1 sample(s))
  29,556 bytes maximum slop
   2 MB total memory in use (0 MB lost due to fragmentation)

ghc-6.13.20100831:
 475,305,720 bytes allocated in the heap
  89,272 bytes copied during GC
  68,860 bytes maximum residency (1 sample(s))
  29,444 bytes maximum slop
   2 MB total memory in use (0 MB lost due to fragmentation)
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: HEAD: Deterioration in ByteString I/O

2010-09-08 Thread Don Stewart
daniel.is.fischer:
 Trying out HEAD (specifically, ghc-6.13.20100831-src.tar.bz2 built with 
 6.12.3) investigating an issue with the text package, I found that I/O of 
 ByteStrings has become significantly slower (on my machine at least:
 
 $ uname -a
 Linux linux-mkk1 2.6.27.48-0.2-pae #1 SMP 2010-07-29 20:06:52 +0200 i686 
 i686 i386 GNU/Linux
 
 Pentium 4, 3.06GHz).
 
 Timings for reading and outputting a 74.3MB file:
 
 cat:
 $ time cat bigfile  /dev/null
 0.00user 0.04system 0:00.06elapsed 83%CPU
 
 ghc-6.12.3:
 $ time ./nbench lazyBSNull bigfile a b  /dev/null
 0.01user 0.09system 0:00.10elapsed 100%CPU
 
 ghc-6.13.20100831:
 $ time ./hdbench lazyBSNull bigfile a b  /dev/null
 0.07user 0.10system 0:00.18elapsed 96%CPU
 
 In addition to the slowdown, the allocation behaviour has become quite bad:
 
 ghc-6.12.3:
   89,330,672 bytes allocated in the heap
   15,092 bytes copied during GC
   35,980 bytes maximum residency (1 sample(s))
   29,556 bytes maximum slop
2 MB total memory in use (0 MB lost due to fragmentation)
 
 ghc-6.13.20100831:
  475,305,720 bytes allocated in the heap
   89,272 bytes copied during GC
   68,860 bytes maximum residency (1 sample(s))
   29,444 bytes maximum slop
2 MB total memory in use (0 MB lost due to fragmentation)

Can you put your benchmark code somewhere?  Likely a GHC regression.

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


Re: HEAD: Deterioration in ByteString I/O

2010-09-08 Thread Daniel Fischer
On Wednesday 08 September 2010 18:10:26, Don Stewart wrote:
 Can you put your benchmark code somewhere?

Boiled down to the bare minimum,

module Main (main) where

import System.Environment (getArgs)
import qualified Data.ByteString.Lazy as L

main :: IO ()
main = do
(file : _) - getArgs
L.readFile file = L.putStr


Then all you need is a file of nontrivial size (a few 10KB is enough to 
show it).

   Likely a GHC regression.

That's what I think.
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


RE: HEAD: Deterioration in ByteString I/O

2010-09-08 Thread Simon Peyton-Jones
|   ghc-6.12.3:
| 89,330,672 bytes allocated in the heap
| 15,092 bytes copied during GC
| 35,980 bytes maximum residency (1 sample(s))
| 29,556 bytes maximum slop
|  2 MB total memory in use (0 MB lost due to fragmentation)
|  
|   ghc-6.13.20100831:
|475,305,720 bytes allocated in the heap
| 89,272 bytes copied during GC
| 68,860 bytes maximum residency (1 sample(s))
| 29,444 bytes maximum slop
|  2 MB total memory in use (0 MB lost due to fragmentation)
|  
|  Can you put your benchmark code somewhere?  Likely a GHC regression.

Indeed bad. If someone could characterise the regression more precisely (e.g. 
fusion isn't happening here) that would be jolly helpful. 

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


Re: HEAD: Deterioration in ByteString I/O

2010-09-08 Thread Don Stewart
simonpj:
 |   ghc-6.12.3:
 | 89,330,672 bytes allocated in the heap
 | 15,092 bytes copied during GC
 | 35,980 bytes maximum residency (1 sample(s))
 | 29,556 bytes maximum slop
 |  2 MB total memory in use (0 MB lost due to fragmentation)
 |  
 |   ghc-6.13.20100831:
 |475,305,720 bytes allocated in the heap
 | 89,272 bytes copied during GC
 | 68,860 bytes maximum residency (1 sample(s))
 | 29,444 bytes maximum slop
 |  2 MB total memory in use (0 MB lost due to fragmentation)
 |  
 |  Can you put your benchmark code somewhere?  Likely a GHC regression.
 
 Indeed bad. If someone could characterise the regression more
 precisely (e.g. fusion isn't happening here) that would be jolly
 helpful. 

Shouldn't be fusion. Is this a straight IO function. Something to do
with buffering/encoding? 
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


haddock and associated data families

2010-09-08 Thread Christian Höner zu Siederdissen
Hi,

haddock seems to produce an error on associated data family decls.:

http://hackage.haskell.org/packages/archive/PrimitiveArray/0.0.2.1/logs/failure/ghc-6.12

line 22, where the errors occurs is exactly this one:

class PrimArrayOps a b where
  data PrimArray  a b :: *-- ^ PrimArray data type

I'll fix it by trying other methods to put comments there. Could someone
enter this as a bug, if it is not done yet? (Assuming it is a bug ;-)

Thanks,
Christian


pgpD9QRopBprL.pgp
Description: PGP signature
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: haddock and associated data families

2010-09-08 Thread Antoine Latter
CC'ing the maintainer listed on Hackage for haddock

On Wed, Sep 8, 2010 at 5:14 PM, Christian Höner zu Siederdissen
choe...@tbi.univie.ac.at wrote:
 Hi,

 haddock seems to produce an error on associated data family decls.:

 http://hackage.haskell.org/packages/archive/PrimitiveArray/0.0.2.1/logs/failure/ghc-6.12

 line 22, where the errors occurs is exactly this one:

 class PrimArrayOps a b where
  data PrimArray  a b :: *                -- ^ PrimArray data type

 I'll fix it by trying other methods to put comments there. Could someone
 enter this as a bug, if it is not done yet? (Assuming it is a bug ;-)

 Thanks,
 Christian

 ___
 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: HEAD: Deterioration in ByteString I/O

2010-09-08 Thread Daniel Fischer
On Wednesday 08 September 2010 23:55:35, Don Stewart wrote:
 simonpj:
  |   ghc-6.12.3:
  | 89,330,672 bytes allocated in the heap
  | 15,092 bytes copied during GC
  | 35,980 bytes maximum residency (1 sample(s))
  | 29,556 bytes maximum slop
  |  2 MB total memory in use (0 MB lost due to
  |   fragmentation)
  |  
  |   ghc-6.13.20100831:
  |475,305,720 bytes allocated in the heap
  | 89,272 bytes copied during GC
  | 68,860 bytes maximum residency (1 sample(s))
  | 29,444 bytes maximum slop
  |  2 MB total memory in use (0 MB lost due to
  |   fragmentation)
  |
  |  Can you put your benchmark code somewhere?  Likely a GHC
  | regression.
 
  Indeed bad. If someone could characterise the regression more
  precisely (e.g. fusion isn't happening here) that would be jolly
  helpful.

 Shouldn't be fusion. Is this a straight IO function. Something to do
 with buffering/encoding?

Maybe the following observation helps:

ghc-6.13.20100831 reads lazy ByteStrings in chunks of 8192 bytes.

If I understand correctly, that means (since defaultChunkSize = 32760)
- bytestring allocates a 32K buffer to be filled and asks ghc for 32760 
bytes in that buffer
- ghc asks the OS for 8192 bytes (and usually gets them)
- upon receiving fewer bytes than requested, bytestring copies them to a 
new smaller buffer
- since the number of bytes received is a multiple of ghc's allocation 
block size (which I believe is 4K), there's no space for the bookkeeping 
overhead, hence the new buffer takes up 12K instead of 8, resulting in 44K 
allocation for 8K bytes

That factor of 5.5 corresponds pretty well with the allocation figures 
above, and the extra copying explains the approximate doubling of I/O time.

Trying to find out why ghc asks the OS for only 8192 bytes instead of 32760 
hasn't brought enlightenment yet.

Cheers,
Daniel

Excerpt of strace log:

read(3, %!PS-Adobe-2.0\n%%Title: nbench\n%..., 8192) = 8192
open(/usr/lib/gconv/UTF-32.so, O_RDONLY) = 4
read(4, 
\177ELF\1\1\1\0\0\0\0\0\0\0\0\0\3\0\3\0\1\0\0\0`\4\0\0004\0\0\0..., 512) 
= 512
fstat64(4, {st_mode=S_IFREG|0755, st_size=9672, ...}) = 0
mmap2(NULL, 12328, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 4, 0) = 
0xb7852000
fadvise64(4, 0, 12328, POSIX_FADV_WILLNEED) = 0
mmap2(0xb7854000, 8192, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|
MAP_DENYWRITE, 4, 0x1) = 0xb7854000
close(4)= 0
mprotect(0xb7854000, 4096, PROT_READ)   = 0
ioctl(1, SNDCTL_TMR_TIMEBASE or TCGETS, 0xbff37cb0) = -1 ENOTTY 
(Inappropriate ioctl for device)
select(2, [], [1], NULL, {0, 0})= 1 (out [1], left {0, 0})
write(1, , 0) = 0
select(2, [], [1], NULL, {0, 0})= 1 (out [1], left {0, 0})
write(1, %!PS-Adobe-2.0\n%%Title: nbench\n%..., 8192) = 8192
read(3,  20.00 lineto\n121.153524 20, 8192) = 8192
select(2, [], [1], NULL, {0, 0})= 1 (out [1], left {0, 0})
write(1, , 0) = 0
select(2, [], [1], NULL, {0, 0})= 1 (out [1], left {0, 0})
write(1,  20.00 lineto\n121.153524 20, 8192) = 8192
read(3, 30.542315 21.394403 lineto\n125.3..., 8192) = 8192
select(2, [], [1], NULL, {0, 0})= 1 (out [1], left {0, 0})
write(1, , 0) = 0
select(2, [], [1], NULL, {0, 0})= 1 (out [1], left {0, 0})
write(1, 30.542315 21.394403 lineto\n125.3..., 8192) = 8192
read(3, neto\n308.929337 21.969871 lineto..., 8192) = 8192
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: HEAD: Deterioration in ByteString I/O

2010-09-08 Thread Daniel Fischer
On Thursday 09 September 2010 01:28:04, Daniel Fischer wrote:
 Maybe the following observation helps:

 ghc-6.13.20100831 reads lazy ByteStrings in chunks of 8192 bytes.

 If I understand correctly, that means (since defaultChunkSize = 32760)
 - bytestring allocates a 32K buffer to be filled and asks ghc for 32760
 bytes in that buffer
 - ghc asks the OS for 8192 bytes (and usually gets them)
 - upon receiving fewer bytes than requested, bytestring copies them to a
 new smaller buffer
 - since the number of bytes received is a multiple of ghc's allocation
 block size (which I believe is 4K), there's no space for the bookkeeping
 overhead, hence the new buffer takes up 12K instead of 8, resulting in
 44K allocation for 8K bytes

 That factor of 5.5 corresponds pretty well with the allocation figures
 above,

That seems to be correct, but probably not the whole story.
I've played with defaultChunkSize, setting it to (64K - overhead), ghc 
still reads in 8192 byte chunks, the allocation figures are nearly double 
those for (32K - overhead). Setting it to (8K - overhead), ghc reads in 
8184 byte chunks and the allocation figures go down to approximately 1.4 
times those of 6.12.3.
Can a factor of 1.4 be explained by the smaller chunk size or is something 
else going on?

 and the extra copying explains the approximate doubling of I/O time.

Apparently not. With the small chunk size which should avoid copying, the 
I/O didn't get faster.


 Trying to find out why ghc asks the OS for only 8192 bytes instead of
 32760 hasn't brought enlightenment yet.

No progress on that front.

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


Re[2]: HEAD: Deterioration in ByteString I/O

2010-09-08 Thread Bulat Ziganshin
Hello Daniel,

Thursday, September 9, 2010, 3:28:04 AM, you wrote:

 - bytestring allocates a 32K buffer to be filled and asks ghc for 32760
 bytes in that buffer
 - ghc asks the OS for 8192 bytes (and usually gets them)

btw, we made benchmarking that shown that the most efficient
read/write chunk in Windows Vista is 32-64 kb one


-- 
Best regards,
 Bulatmailto:bulat.zigans...@gmail.com

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