Re: [Haskell-cafe] Haskell (GHC 7) on ARM

2012-06-11 Thread Karel Gardas

On 06/10/12 03:06 PM, Ben Gamari wrote:

Let the list know if you encounter any issues. I'll try to dust off my
own development environment once I get back to the states next week to
ensure that everything still works. I've been meaning to setup the
PandaBoard as a build slave as Karel's has been failing for some time
now (perhaps you could look into this, Karel?).


Hi Ben,

my builder machine is i.MX53 Quick Start Board and it's not failing due 
to software or hardware issue, but simply GHC HEAD is broken on ARM 
since February this year. Over the weekend I've tried to git bisect to 
get the culprit patch, but so far no results. I'll continue or better 
both ARM machines I do have available here will continue working on this.


Cheers,
Karel

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] converting functional dependencies to type families

2012-06-11 Thread Simon Peyton-Jones
Thanks.  I've linked to it from 
http://www.haskell.org/haskellwiki/GHC/Type_families#Frequently_asked_questions

| -Original Message-
| From: Henning Thielemann [mailto:lemm...@henning-thielemann.de]
| Sent: 10 June 2012 15:14
| To: Simon Peyton-Jones
| Cc: Haskell Cafe
| Subject: RE: converting functional dependencies to type families
| 
| 
| On Thu, 7 Jun 2012, Simon Peyton-Jones wrote:
| 
|  Very useful!  Maybe worth turning into a page on the Haskell wiki?
| 
| I created one:
| 
| http://www.haskell.org/haskellwiki/Functional_dependencies_vs._type_fami
| lies



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] converting functional dependencies to type families

2012-06-11 Thread Henning Thielemann


On Mon, 11 Jun 2012, Simon Peyton-Jones wrote:


Thanks.  I've linked to it from
http://www.haskell.org/haskellwiki/GHC/Type_families#Frequently_asked_questions


Thank you! I already added this and another link to a new See also 
section below. Which one shall we maintain?


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] How to select n random words from a file ...

2012-06-11 Thread Aditya Manthramurthy
Pick the i-th word (replacing the previously chosen word, if any) with
probability 1/i? (numbering of words starts from 1 instead of 0).

On 11 June 2012 11:13, KC kc1...@gmail.com wrote:

 An interesting related problem is if you are only allowed one pass through
 the data how would you randomly choose one word.





 --
 --
 Regards,
 KC

 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] How to select n random words from a file ...

2012-06-11 Thread Jerzy Karczmarczuk

KC:
An interesting related problem is if you are only allowed one pass 
through the data how would you randomly choose one word.


Let's choose  n items.

You must know the length of the sequence, of course, otherwise the 
'probability' loses its sense. So, for lists it might not be just one 
pass...


Suppose the length of the sequence be m.

Suppose you have a random generator  called rg, just a simple function 
which transforms: seed - seed' , between 0 and 1


Make n and m real to make the typechecker happy.
Then the most straightforward solution for lists is:

nran l n = nr l m n seed where
  m = fromIntegral(length(l))
  nr [] _ _ _ = []
  nr (x:q) m n seed =
let seed'=rg seed
in  ifseed'  n/m then x:nr q (m-1) (n-1) seed'
else  nr q (m-1) n seed'

-- =

Now, you may make it tail-recursive, use a different random generation 
protocol, or whatever. I believe that this solution is known for years...


Jerzy Karczmarczuk


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Performance with do notation, mwc-random and unboxed vector

2012-06-11 Thread Dmitry Dzhus
Hello everyone.

I wonder why using do notation with `-` can ruin the performance.

In essence the problem is that, for some action `f :: m Double`,
running the code (in my case, `standard` from mwc-random).

f

for million times is fast but the code

do
  v - f
  return v

is slower about a hundred times.

Consider this simple source where we generate an unboxed vector with million
pseudo-random numbers:

 8 -
import qualified Data.Vector.Unboxed as VU

import System.Random.MWC
import System.Random.MWC.Distributions (standard)

count = 100

main = do
  g - create
  e' - VU.replicateM count $ standard g
  return ()
 8 -

Being compiled with -O2, this runs for 0.052 s on my machine.

Changing the replicateM line to use do notation brings the runtime down to 
11.257 s!
See below:

 8 -
import qualified Data.Vector.Unboxed as VU

import System.Random.MWC
import System.Random.MWC.Distributions (standard)

count = 100

main = do
  g - create
  e' - VU.replicateM count $ do
   v - standard g
   return v
  return ()
 8 -

I don't quite understand why this happens. I'm using GHC 7.4.1 on Linux x86_64 
system.

Compiling *both* versions with profiling enabled changes runtime to 5.673 sec,
which is exactly half the runtime of slow version without profiling, and this 
is awkward
(double calculations occuring in do block?).

Does anybody have an idea if this is a problem with my do, or with mwc-random, 
or with vector
(my notation disallowing efficient unboxing?).

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Performance with do notation, mwc-random and unboxed vector

2012-06-11 Thread MigMit
Well, it's not do notation, since replacing standard g with standard g = 
return gives the same poor performance. I wonder if it has something to do 
with error checking.

On 11 Jun 2012, at 13:38, Dmitry Dzhus wrote:

 Hello everyone.
 
 I wonder why using do notation with `-` can ruin the performance.
 
 In essence the problem is that, for some action `f :: m Double`,
 running the code (in my case, `standard` from mwc-random).
 
f
 
 for million times is fast but the code
 
do
  v - f
  return v
 
 is slower about a hundred times.
 
 Consider this simple source where we generate an unboxed vector with million
 pseudo-random numbers:
 
  8 -
 import qualified Data.Vector.Unboxed as VU
 
 import System.Random.MWC
 import System.Random.MWC.Distributions (standard)
 
 count = 100
 
 main = do
  g - create
  e' - VU.replicateM count $ standard g
  return ()
  8 -
 
 Being compiled with -O2, this runs for 0.052 s on my machine.
 
 Changing the replicateM line to use do notation brings the runtime down to 
 11.257 s!
 See below:
 
  8 -
 import qualified Data.Vector.Unboxed as VU
 
 import System.Random.MWC
 import System.Random.MWC.Distributions (standard)
 
 count = 100
 
 main = do
  g - create
  e' - VU.replicateM count $ do
   v - standard g
   return v
  return ()
  8 -
 
 I don't quite understand why this happens. I'm using GHC 7.4.1 on Linux 
 x86_64 system.
 
 Compiling *both* versions with profiling enabled changes runtime to 5.673 sec,
 which is exactly half the runtime of slow version without profiling, and this 
 is awkward
 (double calculations occuring in do block?).
 
 Does anybody have an idea if this is a problem with my do, or with 
 mwc-random, or with vector
 (my notation disallowing efficient unboxing?).
 
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Performance with do notation, mwc-random and unboxed vector

2012-06-11 Thread Malcolm Wallace

On 11 Jun 2012, at 10:38, Dmitry Dzhus wrote:

 main = do
  g - create
  e' - VU.replicateM count $ standard g
  return ()

In all likelhood, ghc is spotting that the value e' is not used, and that there 
are no side-effects, so it does not do anything at runtime.  If you expand the 
action argument to replicateM, such that it uses do-notation instead, perhaps 
ghc can no longer prove the lack of side-effects, and so actually runs the 
computation before throwing away its result.

When writing toy benchmarks in a lazy language, it is always important to 
understand to what extent your program _uses_ the data from a generator, or you 
are bound to get misleading performance measurements.

Regards,
Malcolm


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Performance with do notation, mwc-random and unboxed vector

2012-06-11 Thread Dmitry Dzhus
11.06.2012, 14:17, Malcolm Wallace malcolm.wall...@me.com:
 that there are no side-effects

There are — PRNG state is updated for RealWorld, that's why monadic replicateM 
is used.

You can add something like

  print $ (VU.!) e 50

after e is bound and still get 0.057 sec with do-less version.
This quite matches the performance claimed by mwc-random package
and seems reasonable since modern hardware shouldn't have any problem
with generating  twenty million random variates in a second with one execution 
thread.

Your note on laziness would be correct in case like
-- 8 --
import qualified Data.Vector.Unboxed as VU
import Data.Functor

import System.Random.MWC
import System.Random.MWC.Distributions (standard)

count = 1

main = do
  g - create
  e - return $ VU.replicate count (212.8506 :: Double)
  return ()
-- 8 ---
Where unused `e` is truly left unevaluated (you could force it
by matching with `!e` for example).

Profiling indicates that random number sampling really occurs for
both of original versions with `replicateM`, expectedly taking most of time:

Mon Jun 11 14:24 2012 Time and Allocation Profiling Report  (Final)

   slow-mwc-vector +RTS -p -RTS

total time  =5.45 secs   (5453 ticks @ 1000 us, 1 processor)
total alloc = 3,568,827,856 bytes  (excludes profiling overheads)

COST CENTRE   MODULE  %time %alloc

uniform2  System.Random.MWC45.0   53.7
uniformWord32 System.Random.MWC31.3   31.5
standard.loop System.Random.MWC.Distributions   4.11.1
uniform1  System.Random.MWC 3.94.5
nextIndex System.Random.MWC 3.61.4
uniform   System.Random.MWC 2.83.3
uniform   System.Random.MWC 2.51.4
wordsToDouble System.Random.MWC 2.10.5

I could drop do notation and go with the simpler version if I wanted just 
a vector of variates. But in reality I want a vector of tuples with random
components:
-- 8 --
import qualified Data.Vector.Unboxed as VU
import Control.Monad

import System.Random.MWC
import System.Random.MWC.Distributions (standard)

count = 100

main = do
  g - create
  e - VU.replicateM count $ do
 v1 - standard g
 v2 - standard g
 v3 - standard g
 return (v1, v2, v3)
  return ()
-- 8 ---
which runs for the same 11.412 seconds.
Since three times more variates are generated and run time stays the same,
this implies that perhaps some optimizations of vector package interfere
with mwc-random — can this be the case?
This becomes quite a bottleneck in my application.

On the other hand, mwc-random has `normal` function implemented as follows:

-- 8 --
normal m s gen = do
  x - standard gen
  return $! m + s * x
-- 8 ---
which again uses explicit `do`. Both standard and normal are marked with INLINE.

Now if I try to write
-- 8 --
  e - VU.replicateM count $ normal 0 1 g
-- 8 ---
in my test case, quite expectedly I get horrible performance of 11 seconds,
even though I'm not using do myself.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ByteString.getContents fails for files 2GB on OS X

2012-06-11 Thread Gracjan Polak
Gregory Collins greg at gregorycollins.net writes:

 
 
 Try http://hackage.haskell.org/package/bytestring-mmap ?

Or:

http://hackage.haskell.org/package/mmap

-- 
Gracjan



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] High memory usage with 1.4 Million records?

2012-06-11 Thread Johan Tibell
On Fri, Jun 8, 2012 at 1:40 PM, Johan Tibell johan.tib...@gmail.com wrote:
 GHC used to complain when you use UNPACK with something that can't be
 unpacked, but that warning seems to have been (accidentally) removed
 in 7.4.1.

Turns out the warning is only on if you compile with -O or higher.

-- Johan

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] attoparsec double precision, quickCheck and aeson

2012-06-11 Thread Thomas Schilling
Bryan, do you remember what the issue is with C++ in this case?  I
thought, adding a wrapper with extern C definitions should do the
trick for simpler libraries (as this one seems to be).  Is the
interaction with the memory allocator the issue?  Linker flags?

On 11 June 2012 06:38, Bryan O'Sullivan b...@serpentine.com wrote:
   On Wed, Jun 6, 2012 at 6:20 AM, Doug McIlroy d...@cs.dartmouth.edu
 wrote:

 Last I looked (admittedly quite a while ago), the state of
 the art was strtod in http://www.netlib.org/fp/dtoa.c.
 (Alas, dtoa.c achieves calculational perfection via a
 murmuration of #ifdefs.)


 That was indeed the state of the art for about three decades, until Florian
 Loitsch showed up in 2010 with an algorithm that is usually far
 faster: http://www.serpentine.com/blog/2011/06/29/here-be-dragons-advances-in-problems-you-didnt-even-know-you-had/

 Unfortunately, although I've written Haskell bindings to his library, said
 library is written in C++, and our FFI support for C++ libraries is
 negligible and buggy. As a result, that code is disabled by default.

 It's disheartening to hear that important Haskell code has
 needlessly fallen from perfection--perhaps even deliberately.


 Indeed (and yes, it's deliberate). If I had the time to spare, I'd attempt
 to fix the situation by porting Loitsch's algorithm to Haskell or C, but
 either one would be a lot of work - the library is 5,600 lines of tricky
 code.

 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe




-- 
Push the envelope. Watch it bend.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] vector operations

2012-06-11 Thread Evan Laforge
On Tue, May 29, 2012 at 12:52 PM, Roman Leshchinskiy r...@cse.unsw.edu.au 
wrote:
 On 29/05/2012, at 19:49, Evan Laforge wrote:

 Good question.. I copied both to a file and tried ghc-core, but it
 inlines big chunks of Data.Vector and I can't read it very well, but
 it looks like the answer is no, it still builds the the list of sums.
 I guess the next step is to benchmark and see how busy the gc is on
 each version.

 Vector should definitely fuse this, if it doesn't it's a bug. Please report 
 if it doesn't for you. To verify, just count the number of letrecs in the 
 optimised Core. You'll see one letrec if it has been fused and two if it 
 hasn't.

I see two letrecs in find_before2, but both of them are on findIndex.
I only have one findIndex so I'm not sure what's going on.  The first
one calls the second, but there's an boxed Either argument in there,
which must be coming out of vector internals.

I had to stick NOINLINE on the functions so I could find them in the
core.  I don't think this should affect the optimization of the
contents, though.

The fold_abort version is shorter and simpler, only has one letrec
that takes all unboxed arguments, and I think I can more or less
follow what it's doing.

Of course that doesn't mean it's any faster, I could be just
misreading the core.  I could do a bug report, but maybe someone else
should look at the core first to make sure I'm not just confused?  I
appended the file below, just run ghc-core and search for find_before.

On Tue, May 29, 2012 at 12:54 PM, Duncan Coutts
duncan.cou...@googlemail.com wrote:
 Note that foldr allows early abort so that's fine. Also, there's no
 fundamental restriction due to stream fusion. Stream fusion can be
 used for lazy lists afterall and can implement Data.List.foldr just
 fine.

But can foldr do a sum running from left to right?  I thought you had
to be left-biased for that.

And as for early abort with foldr, I can think of how to do so if I'm
generating lazy data with a right-biased constructor like (:), but how
could you do that for, say, a sum?  The obvious version, 'foldr (\x v
- if v  10 then v else v + x) 0' will still run the function on
every element.

I suppose if fusion works its magic then early abort with foldl or
scanl should happen.  If the generating loop gets fused with the
consuming loop, and the consuming loop only consumes part of the
input, as it would with findIndex.



import qualified Data.Vector.Unboxed as Unboxed

-- | Find the index of the last value whose running sum is still below the
-- given number.
{-# NOINLINE find_before #-}
find_before :: Int - Unboxed.Vector Int - Int
find_before n = fst . fold_abort go (0, 0)
where
go (i, total) a
| total + a = n = Just (i+1, total+a)
| otherwise = Nothing

fold_abort :: (Unboxed.Unbox a) =
(accum - a - Maybe accum) - accum - Unboxed.Vector a - accum
fold_abort f accum vec = go 0 accum
where go i accum = maybe accum (go (i+1)) $ f accum = vec Unboxed.!? i

{-# NOINLINE find_before2 #-}
find_before2 :: Int - Unboxed.Vector Int - Int
find_before2 n vec = case Unboxed.findIndex (n) sums of
Just i - max 0 (i-1)
Nothing - 0
where sums = Unboxed.scanl' (+) 0 vec

main :: IO ()
main = do
print (t0 find_before)
print (t0 find_before2)

t0 :: (Int - Unboxed.Vector Int - Int) - [Int]
t0 f = [f n (Unboxed.fromList [2, 2, 2, 2]) | n - [0..6]]

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] attoparsec double precision, quickCheck and aeson

2012-06-11 Thread Bryan O'Sullivan
On Mon, Jun 11, 2012 at 10:50 AM, Thomas Schilling
nomin...@googlemail.comwrote:

 Bryan, do you remember what the issue is with C++ in this case?  I
 thought, adding a wrapper with extern C definitions should do the
 trick for simpler libraries (as this one seems to be).  Is the
 interaction with the memory allocator the issue?  Linker flags?


It's specific to ghci, whose object file loader fails to call C++ static
initializers. In the case of the double-conversion library, this means that
static read-only arrays that it assumes to contain valid data are full of
junk.

You can join in the fun over at
http://hackage.haskell.org/trac/ghc/ticket/5289
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] attoparsec double precision, quickCheck and aeson

2012-06-11 Thread Bryan O'Sullivan
On Mon, Jun 11, 2012 at 10:57 AM, Bryan O'Sullivan b...@serpentine.comwrote:



In the case of the double-conversion library, this means that static
 read-only arrays that it assumes to contain valid data are full of junk.
 You can join in the fun over at
 http://hackage.haskell.org/trac/ghc/ticket/5289


Oops, that bug is not actually relevant to this case.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] vector operations

2012-06-11 Thread Roman Leshchinskiy
On 11/06/2012, at 18:52, Evan Laforge wrote:

 On Tue, May 29, 2012 at 12:52 PM, Roman Leshchinskiy r...@cse.unsw.edu.au 
 wrote:
 
 Vector should definitely fuse this, if it doesn't it's a bug. Please report 
 if it doesn't for you. To verify, just count the number of letrecs in the 
 optimised Core. You'll see one letrec if it has been fused and two if it 
 hasn't.
 
 I see two letrecs in find_before2, but both of them are on findIndex.
 I only have one findIndex so I'm not sure what's going on.  The first
 one calls the second, but there's an boxed Either argument in there,
 which must be coming out of vector internals.

Hmm, which version of GHC and what compiler flags are you using? I'm not 
familiar with ghc-core, maybe that's doing something wrong. Just run ghc -O2 
-ddump-simpl and look at the output. Below is the code I'm getting for 
find_before2 with 7.4.2. As you can see, everything has been fused (although I 
notice that GHC isn't pushing x_a11p and y1_a124 into the branches for some 
reason, looks like a new regression but not a particularly bad one and nothing 
to do with fusion).

find_before2_rkk :: Int - Vector Int - Int
[GblId, Arity=2, Caf=NoCafRefs, Str=DmdType LU(LLL)m]
find_before2_rkk =
  \ (n_arE :: Int) (vec_arF :: Vector Int) -
case vec_arF `cast` ...
of _ { Vector ipv_s2Jf ipv1_s2Jg ipv2_s2Jh -
case n_arE of _ { I# y_a11t -
case # 0 y_a11t of _ {
  False -
letrec {
  $sfindIndex_loop_s2Qz [Occ=LoopBreaker]
:: Int# - Int# - Int# - Id (Maybe Int)
  [LclId, Arity=3, Str=DmdType LLL]
  $sfindIndex_loop_s2Qz =
\ (sc_s2Q8 :: Int#) (sc1_s2Q9 :: Int#) (sc2_s2Qa :: Int#) -
  case =# sc_s2Q8 ipv1_s2Jg of _ {
False -
  case indexIntArray# ipv2_s2Jh (+# ipv_s2Jf sc_s2Q8)
  of wild_a2JM { __DEFAULT -
  let {
x_a11p [Dmd=Just L] :: Int#
[LclId, Str=DmdType]
x_a11p = +# sc1_s2Q9 wild_a2JM } in
  case # x_a11p y_a11t of _ {
False -
  $sfindIndex_loop_s2Qz (+# sc_s2Q8 1) x_a11p (+# sc2_s2Qa 
1);
True - (Just @ Int (I# sc2_s2Qa)) `cast` ...
  }
  };
True - (Nothing @ Int) `cast` ...
  }; } in
case ($sfindIndex_loop_s2Qz 0 0 1) `cast` ... of _ {
  Nothing - lvl_r2QO;
  Just i_arH -
case i_arH of _ { I# x_a11Q -
let {
  y1_a124 [Dmd=Just L] :: Int#
  [LclId, Str=DmdType]
  y1_a124 = -# x_a11Q 1 } in
case =# 0 y1_a124 of _ {
  False - lvl_r2QO;
  True - I# y1_a124
}
}
};
  True - lvl_r2QO
}
}
}

Roman


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] GHCi Loop Detection

2012-06-11 Thread John Van Enk
Thanks.

On Sat, Jun 2, 2012 at 12:57 PM, Michal Terepeta
michal.terep...@gmail.comwrote:

 On 01.06 11:06, John Van Enk wrote:
  Hi Cafe,
 
  Is there a reason that the GHCi interpreter doesn't detect and report
  infinite loops in statements like this (like compiled programs do) even
  though no CPU time appears to be used? My (admittedly weak) searching for
  an answer didn't turn much up.
 
  let s | not $ null s = [] in s
 
  GHCi v7.0.4 on OSX
 
  Thanks,
  John

 Hi John,

 I think this is a known problem in GHCi:
 http://hackage.haskell.org/trac/ghc/ticket/2786

 Regards,
 Michal

 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Performance with do notation, mwc-random and unboxed vector

2012-06-11 Thread Roman Leshchinskiy
On 11/06/2012, at 10:38, Dmitry Dzhus wrote:

 Consider this simple source where we generate an unboxed vector with million
 pseudo-random numbers:
 
  8 -
 import qualified Data.Vector.Unboxed as VU
 
 import System.Random.MWC
 import System.Random.MWC.Distributions (standard)
 
 count = 100
 
 main = do
  g - create
  e' - VU.replicateM count $ standard g
  return ()
  8 -
 
 Being compiled with -O2, this runs for 0.052 s on my machine.
 
 Changing the replicateM line to use do notation brings the runtime down to 
 11.257 s!
 See below:
 
  8 -
 import qualified Data.Vector.Unboxed as VU
 
 import System.Random.MWC
 import System.Random.MWC.Distributions (standard)
 
 count = 100
 
 main = do
  g - create
  e' - VU.replicateM count $ do
   v - standard g
   return v
  return ()
  8 -

The former essentially generates this:

  replicateM n ((letrec f = ... in f) `cast` ...)

and the latter this:

  replicateM n (\(s :: State# RealWorld) - (letrec f = ... in f s) `cast` ...)

I'd look further into this but mwc-random just inlines too much stuff. Could 
you perhaps find a smaller example that doesn't use mwc-random? In any case, it 
looks like a GHC bug, perhaps the state hack is getting in the way.

Roman



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] vector operations

2012-06-11 Thread Evan Laforge
On Mon, Jun 11, 2012 at 1:29 PM, Roman Leshchinskiy r...@cse.unsw.edu.au 
wrote:
 Hmm, which version of GHC and what compiler flags are you using? I'm not 
 familiar with ghc-core, maybe that's doing something wrong. Just run ghc -O2 
 -ddump-simpl and look at the output. Below is the code I'm getting for 
 find_before2 with 7.4.2. As you can see, everything has been fused (although 
 I notice that GHC isn't pushing x_a11p and y1_a124 into the branches for some 
 reason, looks like a new regression but not a particularly bad one and 
 nothing to do with fusion).

I'm using 7.0.3, but I tried with 7.4.2 and it looks like what you
got, with only one letrec.

So it probably has to do with new optimizations introduced since 7.0.

Thanks for the help, and I will use this count the letrecs technique
in the future if I have questions.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haskell (GHC 7) on ARM

2012-06-11 Thread gdweber
This is my first time hearing of Arch Linux ARM (http://archlinuxarm.org/)
but since it is based on Arch Linux (http://www.archlinux.org/),
it seems odd that Arch Linux ARM's ghc is still 6.12.3,
when Arch Linux's ghc has been 7.4.1 since March 3 or earlier.
As far as I could see, all the other Arch Linux ARM
packages are the same versions as those in Arch Linux.
Maybe it would be worthwhile to prod the Arch Linux ARM developers?

On 2012-Jun-10, Ben Gamari wrote:
 
 
 Joshua Poehls jos...@poehls.me writes:
 
  Hello Ben,
 
 Hello,
 
 Sorry for the latency. I'm currently on vacation in Germany so I haven't
 had terribly consistent Internet access.
 
 I've Cc'd haskell-cafe@ as I've been meaning to document my experiences
 anyways and your email seems like a good excuse to do this.
 
 
  I just got a Raspberry Pi and I'm interested in running Haskell on it. So
  far I'm running Arch Linux ARM and I noticed there is is a GHC package
  available, but it is version 6.12.3.
 
  ...
 ...


-- 
Gregory D. Weber, Ph. D.:
Associate Professor of Informatics / \
Indiana University East   0   :
Tel. (765) 973-8420; FAX (765) 973-8550  / \
http://mypage.iu.edu/~gdweber/  1  []

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Troubles understanding Parsec Error Handling

2012-06-11 Thread Antoine Latter
On Wed, May 30, 2012 at 5:47 PM, Roman Cheplyaka r...@ro-che.info wrote:

 With this patch your code prints:

    parse error at (line 1, column 7):
    unexpected Hallofb, expecting one of [Hello,Hallo,Foo,HallofFame]


Hi folks,

Roman's patch has been included in the newly-released parsec 3.1.3:

http://hackage.haskell.org/package/parsec-3.1.3

Enjoy,

Antoine

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe