Re: Current GHC core documentation.

2009-08-04 Thread Simon Marlow

On 03/08/2009 15:54, Richard Kelsall wrote:

This page

http://www.haskell.org/ghc/documentation.html

has a link to the September 2001 (Draft for GHC 5.02) document
describing GHC Core (in what is for me user-hostile .ps.gz format.)

And this page

http://www.haskell.org/ghc/docs/latest/html/users_guide/ext-core.html

promises an easier format PDF document, but the link is broken.


I did eventually find the 1st April 2009 GHC 6.10 document here

http://www.haskell.org/ghc/docs/6.10.2/html/ext-core/core.pdf

and a bit on this page

http://www.haskell.org/ghc/docs/latest/html/users_guide/options-debugging.html#id468571

about GHC core. I haven't read these yet, but could I ask whether they
constitute the complete current documentation for GHC core? (I'm just
curious to get a flavour of what core does.)


There's also the commentary page:

http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/CoreSynType

which is supposed to be the canonical place for documentation about 
GHC's internal Core datatype.


External Core is slightly different: it refers to the external 
representation of Core that you get from the -fext-core flag. 
Round-tripping via External Core is supposed to be non-lossy, though, so 
External Core retains everything in the original Core.


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


Re: Compiling large source files

2009-08-04 Thread Simon Marlow
I suggest not using Haskell for your list.  Put the data in a file and 
read it at runtime, or put it in a static C array and link it in.


Cheers,
Simon

On 03/08/2009 22:09, Günther Schmidt wrote:

Hi Thomas,

yes, a source file with a single literal list with 85k elements.


Günther


Am 03.08.2009, 22:20 Uhr, schrieb Thomas DuBuisson
thomas.dubuis...@gmail.com:


Can you define very large and compiler? I know an old version of
GHC (6.6?) would eat lots of memory when there were absurd numbers of
let statements.

Thomas

2009/8/3 Günther Schmidt red...@fedoms.com:

Hi all,

I'm having trouble compiling very large source files, the compiler
eats 2GB
and then dies. Is there a way around it?

Günther
___
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


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


use gtar and not tar under solaris

2009-08-04 Thread Christian Maeder
Hi,

I've just been informed that unpacking the binary (i386) solaris
distribution using bunzip2 and tar:

 bunzip2 -c ghc-6.10.4-i386-unknown-solaris2.tar.bz2 | tar xvf -

does not work properly! Use instead:

 gtar jxvf ghc-6.10.4-i386-unknown-solaris2.tar.bz2

File names longer than a hundred characters are cut off, i.e.

ghc-6.10.4/libraries/dph/dph-prim-seq/dist/build/Data/Array/Parallel/Unlifted/Sequential/Flat/UArr.hi
is wrongly extracted as:
ghc-6.10.4/libraries/dph/dph-prim-seq/dist/build/Data/Array/Parallel/Unlifted/Sequential/Flat/UArr.h

leading to an installation failure:

installPackage: Error: Could not find module:
Data.Array.Parallel.Unlifted.Sequential.Flat.UArr with any suffix: [hi]
gmake[1]: *** [install.library.dph/dph-prim-seq] Error 1

Ian, could you place a note about using gtar for unpacking solaris
binary-dists?

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


Re: Compiling large source files

2009-08-04 Thread Serge D. Mechveliani
On Tue, Aug 04, 2009 at 09:12:37AM +0100, Simon Marlow wrote:
 I suggest not using Haskell for your list.  Put the data in a file and 
 read it at runtime, or put it in a static C array and link it in.
 
 On 03/08/2009 22:09, G?nther Schmidt wrote:
 Hi Thomas,
 yes, a source file with a single literal list with 85k elements.


People,
when a program only defines and returns a String constant of  n  
literals, how much memory needs ghc-6.10.4 to compile it ?
O(n), or may be O(n^2), or ...

Regards, 

-
Serge Mechveliani
mech...@botik.ru

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


Re: Data.List permutations

2009-08-04 Thread Krasimir Angelov
Your function is not equivalent:

perm _|_ = _|_

permutations _|_ = _|_ : _|_


On 8/4/09, Slavomir Kaslev slavomir.kas...@gmail.com wrote:
 A friend mine, new to functional programming, was entertaining himself by
 writing different combinatorial algorithms in Haskell. He asked me for some
 help so I sent him my quick and dirty solutions for generating variations and
 permutations:

  inter x [] = [[x]]
  inter x yys@(y:ys) = [x:yys] ++ map (y:) (inter x ys)

  perm [] = [[]]
  perm (x:xs) = concatMap (inter x) (perm xs)

  vari 0 _ = [[]]
  vari _ [] = []
  vari k (x:xs) = concatMap (inter x) (vari (k-1) xs) ++ vari k xs

 After that I found out that nowadays there is a permutation function in the
 Data.List module:

  permutations:: [a] - [[a]]
  permutations xs0=  xs0 : perms xs0 []
where
  perms [] _  = []
  perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
where interleavexs r = let (_,zs) = interleave' id xs r in zs
  interleave' _ [] r = (ts, r)
  interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) 
  ys r
   in  (y:us, f (t:y:us) : zs)

 I was surprised to find that not only my version is much simpler from the one
 in Data.List but it also performs better. Here are some numbers from my rather
 old ghc 6.8.1 running ubuntu on my box:

 *Main length $ permutations [1..10]
 3628800
 (10.80 secs, 2391647384 bytes)
 *Main length $ perm [1..10]
 3628800
 (8.58 secs, 3156902672 bytes)

 I would like to suggest to change the current implementation in Data.List with
 the simpler one. Also, it would be nice to add variations and combinations in
 the Data.List module.

 Cheers.

 --
 Slavomir Kaslev
 ___
 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: Data.List permutations

2009-08-04 Thread Slavomir Kaslev
On Tue, Aug 4, 2009 at 8:53 PM, Krasimir Angelovkr.ange...@gmail.com wrote:
 Your function is not equivalent:

 perm _|_ = _|_

 permutations _|_ = _|_ : _|_

Nice catch. One can use the same trick as in permutations:

 perm2 [] = [[]]
 perm2 xxs@(x:xs) = xxs : tail (concatMap (inter x) (perm2 xs))

I've just noticed that permutations and perm enumerate the
permutations in different order.

 On 8/4/09, Slavomir Kaslev slavomir.kas...@gmail.com wrote:
 A friend mine, new to functional programming, was entertaining himself by
 writing different combinatorial algorithms in Haskell. He asked me for some
 help so I sent him my quick and dirty solutions for generating variations and
 permutations:

  inter x [] = [[x]]
  inter x yys@(y:ys) = [x:yys] ++ map (y:) (inter x ys)

  perm [] = [[]]
  perm (x:xs) = concatMap (inter x) (perm xs)

  vari 0 _ = [[]]
  vari _ [] = []
  vari k (x:xs) = concatMap (inter x) (vari (k-1) xs) ++ vari k xs

 After that I found out that nowadays there is a permutation function in the
 Data.List module:

  permutations            :: [a] - [[a]]
  permutations xs0        =  xs0 : perms xs0 []
    where
      perms []     _  = []
      perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
        where interleave    xs     r = let (_,zs) = interleave' id xs r in zs
              interleave' _ []     r = (ts, r)
              interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) 
  ys r
                                       in  (y:us, f (t:y:us) : zs)

 I was surprised to find that not only my version is much simpler from the one
 in Data.List but it also performs better. Here are some numbers from my 
 rather
 old ghc 6.8.1 running ubuntu on my box:

 *Main length $ permutations [1..10]
 3628800
 (10.80 secs, 2391647384 bytes)
 *Main length $ perm [1..10]
 3628800
 (8.58 secs, 3156902672 bytes)

 I would like to suggest to change the current implementation in Data.List 
 with
 the simpler one. Also, it would be nice to add variations and combinations in
 the Data.List module.

 Cheers.

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





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


Re: Data.List permutations

2009-08-04 Thread Daniel Fischer
Am Dienstag 04 August 2009 19:48:25 schrieb Slavomir Kaslev:
 A friend mine, new to functional programming, was entertaining himself by
 writing different combinatorial algorithms in Haskell. He asked me for some
 help so I sent him my quick and dirty solutions for generating variations
 and

 permutations:
  inter x [] = [[x]]
  inter x yys@(y:ys) = [x:yys] ++ map (y:) (inter x ys)
 
  perm [] = [[]]
  perm (x:xs) = concatMap (inter x) (perm xs)
 
  vari 0 _ = [[]]
  vari _ [] = []
  vari k (x:xs) = concatMap (inter x) (vari (k-1) xs) ++ vari k xs

 After that I found out that nowadays there is a permutation function in the

 Data.List module:
  permutations:: [a] - [[a]]
  permutations xs0=  xs0 : perms xs0 []
where
  perms [] _  = []
  perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations
  is) where interleavexs r = let (_,zs) = interleave' id xs r in zs
  interleave' _ [] r = (ts, r)
  interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:))
  ys r in  (y:us, f (t:y:us) : zs)

 I was surprised to find that not only my version is much simpler from the
 one in Data.List but it also performs better. Here are some numbers from my
 rather old ghc 6.8.1 running ubuntu on my box:

 *Main length $ permutations [1..10]
 3628800
 (10.80 secs, 2391647384 bytes)
 *Main length $ perm [1..10]
 3628800
 (8.58 secs, 3156902672 bytes)

But you compare *interpreted* code here, that's not what counts.

Prelude Perms length $ perm [1 .. 10]
3628800
(1.20 secs, 1259105892 bytes)
Prelude Perms length $ permutations [1 .. 10]
3628800
(0.56 secs, 551532668 bytes)
Prelude Perms length $ perm [1 .. 11]
39916800
(13.18 secs, 14651808004 bytes)
Prelude Perms length $ permutations [1 .. 11]
39916800
(4.30 secs, 5953485728 bytes)

Apparently the library code is more amenable to the optimiser (note that the 
actual 
library is faster still:

Prelude Data.List length $ permutations [1 .. 10]
3628800
(0.49 secs, 551532812 bytes)
Prelude Data.List length $ permutations [1 .. 11]
39916800
(3.73 secs, 5953485816 bytes)

I have no idea why).


 I would like to suggest to change the current implementation in Data.List
 with the simpler one. Also, it would be nice to add variations and
 combinations in the Data.List module.

 Cheers.

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


Re: Data.List permutations

2009-08-04 Thread Slavomir Kaslev
On Tue, Aug 4, 2009 at 9:23 PM, Daniel Fischerdaniel.is.fisc...@web.de wrote:
 Am Dienstag 04 August 2009 19:48:25 schrieb Slavomir Kaslev:
 A friend mine, new to functional programming, was entertaining himself by
 writing different combinatorial algorithms in Haskell. He asked me for some
 help so I sent him my quick and dirty solutions for generating variations
 and

 permutations:
  inter x [] = [[x]]
  inter x yys@(y:ys) = [x:yys] ++ map (y:) (inter x ys)
 
  perm [] = [[]]
  perm (x:xs) = concatMap (inter x) (perm xs)
 
  vari 0 _ = [[]]
  vari _ [] = []
  vari k (x:xs) = concatMap (inter x) (vari (k-1) xs) ++ vari k xs

 After that I found out that nowadays there is a permutation function in the

 Data.List module:
  permutations            :: [a] - [[a]]
  permutations xs0        =  xs0 : perms xs0 []
    where
      perms []     _  = []
      perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations
  is) where interleave    xs     r = let (_,zs) = interleave' id xs r in zs
  interleave' _ []     r = (ts, r)
              interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:))
  ys r in  (y:us, f (t:y:us) : zs)

 I was surprised to find that not only my version is much simpler from the
 one in Data.List but it also performs better. Here are some numbers from my
 rather old ghc 6.8.1 running ubuntu on my box:

 *Main length $ permutations [1..10]
 3628800
 (10.80 secs, 2391647384 bytes)
 *Main length $ perm [1..10]
 3628800
 (8.58 secs, 3156902672 bytes)

 But you compare *interpreted* code here, that's not what counts.

 Prelude Perms length $ perm [1 .. 10]
 3628800
 (1.20 secs, 1259105892 bytes)
 Prelude Perms length $ permutations [1 .. 10]
 3628800
 (0.56 secs, 551532668 bytes)
 Prelude Perms length $ perm [1 .. 11]
 39916800
 (13.18 secs, 14651808004 bytes)
 Prelude Perms length $ permutations [1 .. 11]
 39916800
 (4.30 secs, 5953485728 bytes)

Which version of ghc are you testing on? I guess, it's more recent than mine.

 Apparently the library code is more amenable to the optimiser (note that the 
 actual
 library is faster still:

 Prelude Data.List length $ permutations [1 .. 10]
 3628800
 (0.49 secs, 551532812 bytes)
 Prelude Data.List length $ permutations [1 .. 11]
 39916800
 (3.73 secs, 5953485816 bytes)

 I have no idea why).

Probably because it's compiled (and not interpreted) in this case.

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


Re: Data.List permutations

2009-08-04 Thread Daniel Fischer
Am Dienstag 04 August 2009 20:30:58 schrieb Slavomir Kaslev:
 On Tue, Aug 4, 2009 at 9:23 PM, Daniel Fischerdaniel.is.fisc...@web.de 
 wrote:


 Which version of ghc are you testing on? I guess, it's more recent than
 mine.

6.10.3. But I think if you compiled it with 6.8.*, the library code would still 
be faster, 
perhaps by a smaller margin.


  Apparently the library code is more amenable to the optimiser (note that
  the actual library is faster still:
 
  Prelude Data.List length $ permutations [1 .. 10]
  3628800
  (0.49 secs, 551532812 bytes)
  Prelude Data.List length $ permutations [1 .. 11]
  39916800
  (3.73 secs, 5953485816 bytes)
 
  I have no idea why).

 Probably because it's compiled (and not interpreted) in this case.

All my times were from compiled (with -O2) code. The question is, why does the 
same source 
code produce slower object code in module Perms than in Data.List?
I suppose it's because Data.List was compiled with different command line 
options, but 
I've no idea which.
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


Re: Working with GHC HEAD

2009-08-04 Thread Johan Tibell
On Sun, Aug 2, 2009 at 8:32 PM, Bertram Felgenhauer 
bertram.felgenha...@googlemail.com wrote:

 Antoine Latter wrote:
  - Does anyone have a version of 'network' which builds against GHC
  head? I could bludgeon in the new GHC.IO.FD.FD type myself, but I'd
  thought I'd ask around first.

 http://int-e.home.tlink.de/haskell/network-ghc-6.11.dpatch

 works for me.


I've applied this to the network HEAD. Thanks for the patch.

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


Re: Data.List permutations

2009-08-04 Thread Malcolm Wallace

Your function is not equivalent:

perm _|_ = _|_

permutations _|_ = _|_ : _|_


I have a vague memory that the library version diagonalises properly,  
so that if you give it a lazy infinite input, it still generates  
sensible output lazily.  If so, this important property should be  
noted in the haddocks.


Regards,
Malcolm

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