[Haskell-cafe] Free monad based EDSL for writing LLVM programs.
Matt Giles
matt.w.giles at gmail.com
Fri Aug 8 15:27:15 UTC 2014
For transforming the code, have you checked out the uniplate package? It seems like it could fit your problem pretty well.
On 8 August, 2014 at 5:00:19 AM, haskell-cafe-request at haskell.org (haskell-cafe-request at haskell.org) wrote:
Send Haskell-Cafe mailing list submissions to
haskell-cafe at haskell.org
To subscribe or unsubscribe via the World Wide Web, visit
http://www.haskell.org/mailman/listinfo/haskell-cafe
or, via email, send a message with subject or body 'help' to
haskell-cafe-request at haskell.org
You can reach the person managing the list at
haskell-cafe-owner at haskell.org
When replying, please edit your Subject line so it is more specific
than "Re: Contents of Haskell-Cafe digest..."
Today's Topics:
1. Re: Side-by-side pretty printing (J. Waldmann)
2. Free monad based EDSL for writing LLVM programs. (arrowdodger)
3. parsec: problem combining lookAhead with many1 (bug?) (silly8888)
4. Re: parsec: problem combining lookAhead with many1 (bug?)
(Andreas Reuleaux)
5. Performance of StateT and best practices for debugging
(Kyle Hanson)
6. [ANN] rtorrent-state 0.1.0.0 (Mateusz Kowalczyk)
7. Re: Performance of StateT and best practices for debugging
(John Lato)
8. How to improve the zipwith's performance (jun zhang)
9. Re: Performance of StateT and best practices for debugging
(Bardur Arantsson)
10. Visualising Haskell function execution (Jan Paul Posma)
11. Re: Performance of StateT and best practices for debugging
(John Lato)
----------------------------------------------------------------------
Message: 1
Date: Thu, 7 Aug 2014 12:33:43 +0000 (UTC)
From: J. Waldmann <waldmann at imn.htwk-leipzig.de>
To: haskell-cafe at haskell.org
Subject: Re: [Haskell-cafe] Side-by-side pretty printing
Message-ID: <loom.20140807T142947-462 at post.gmane.org>
Content-Type: text/plain; charset=us-ascii
This is what I use
http://autolat.imn.htwk-leipzig.de/gitweb/?p=autolib;a=blob;f=todoc/Autolib/ToDoc/Beside.hs;hb=HEAD
it's of the works-but-looks-ugly-and-is-terribly-inefficient variety
but since it's applied to small Docs only (like, columns of matrices),
I don't really care.
- J.W.
------------------------------
Message: 2
Date: Thu, 7 Aug 2014 18:16:57 +0400
From: arrowdodger <6yearold at gmail.com>
To: haskell-cafe at haskell.org
Subject: [Haskell-cafe] Free monad based EDSL for writing LLVM
programs.
Message-ID:
<CALH631=EbZ8aTZi=oPdfsP97J2XrRCTf=DpX+uaZ5m9=0mxXhw at mail.gmail.com>
Content-Type: text/plain; charset="utf-8"
Hello. I'm new with Haskell and FP, so i wanted someone to give comments on
the package i've made [1]. It's, actually, my first attempt to create
something more or less real, so any feedback would be welcome.
I've used Free monad to create EDSL that allows writing LLVM IR code.
Afterwards it could be converted into pure AST structure provided by
llvm-general-pure[2] package. Currently, it supports almost every
instruction, but i haven't yet come up with sensible defaults for them.
Another thing that bugs me is the ability to transform the code in syb way.
I want take a user-supplied function that would pattern-match instruction
and produce another code block and apply this function everywhere in the
code, but still can't get my head around it. I've come up with extF
function, that unlike extM, would resort to wrap instead of return, but
that's all i've managed to do.
Thanks in advance.
[1] https://bitbucket.org/arrowdodger/llvm-general-edsl
[2] http://hackage.haskell.org/package/llvm-general-pure
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140807/6d973f16/attachment-0001.html>
------------------------------
Message: 3
Date: Thu, 7 Aug 2014 15:25:23 +0100
From: silly8888 <silly8888 at gmail.com>
To: haskell-cafe at haskell.org
Subject: [Haskell-cafe] parsec: problem combining lookAhead with many1
(bug?)
Message-ID:
<CAMmzbfWA9S3YGjJ1iQaa72rKZyuV4psvEP3LsQuDGC3QED-YVw at mail.gmail.com>
Content-Type: text/plain; charset=UTF-8
Suppose that we have the following parser:
p = lookAhead (char 'a') >> char 'b'
If we use it like so
parse p "" "a"
we get the following error:
Left (line 1, column 1):
unexpected "a"
expecting "b"
What happened is that char 'a' succeeded by consuming the 'a' from the
input and then lookAhead rewinded the input stream (as it does on
success). Then, char 'b' tries to parse (again) the first character of
the input and fails. Everything works as expected.
Now let's slightly modify our parser:
p' = lookAhead (many1 $ char 'a') >> char 'b'
I've only added a many1. I was expecting this parser to give the same
error as the previous one: many1 $ char 'a' will succeed consuming one
'a' and then lookAhead will rewind the input (as it does on success).
Thus when we call char 'b' we are going to be in the beginning of the
input again. Well, that doesn't happen:
Left (line 1, column 2):
unexpected end of input
expecting "b"
As you can see, lookAhead did not rewind the input as it was supposed to.
------------------------------
Message: 4
Date: Thu, 07 Aug 2014 17:32:11 +0100
From: Andreas Reuleaux <reuleaux at web.de>
To: silly8888 <silly8888 at gmail.com>
Cc: haskell-cafe at haskell.org
Subject: Re: [Haskell-cafe] parsec: problem combining lookAhead with
many1 (bug?)
Message-ID: <87y4v0z2es.fsf at web.de>
Content-Type: text/plain
While I haven't tried out your example in parsec, I can at least confirm
that in trifecta it does work that way you expect it, ie. there is no
difference between the error messages in both of your cases:
(parsec's many1 = trifecta's some)
Prelude > :m +Text.Trifecta
Prelude Text.Trifecta > :m +Text.Parser.LookAhead
Prelude Text.Trifecta Text.Parser.LookAhead >
...
Prelude Text.Trifecta Text.Parser.LookAhead > parseTest (lookAhead (char 'a') >> char 'b') "a"
...
Loading package reducers-3.10.2.1 ... linking ... done.
Loading package trifecta-1.5.1 ... linking ... done.
(interactive):1:1: error: expected: "b"
a<EOF>
^
Prelude Text.Trifecta Text.Parser.LookAhead > parseTest (lookAhead (some $ char 'a') >> char 'b') "a"
(interactive):1:1: error: expected: "b"
a<EOF>
^
Prelude Text.Trifecta Text.Parser.LookAhead >
Hope this helps.
-Andreas
silly8888 <silly8888 at gmail.com> writes:
> Suppose that we have the following parser:
>
> p = lookAhead (char 'a') >> char 'b'
>
> If we use it like so
>
> parse p "" "a"
>
> we get the following error:
>
> Left (line 1, column 1):
> unexpected "a"
> expecting "b"
>
> What happened is that char 'a' succeeded by consuming the 'a' from the
> input and then lookAhead rewinded the input stream (as it does on
> success). Then, char 'b' tries to parse (again) the first character of
> the input and fails. Everything works as expected.
>
> Now let's slightly modify our parser:
>
> p' = lookAhead (many1 $ char 'a') >> char 'b'
>
> I've only added a many1. I was expecting this parser to give the same
> error as the previous one: many1 $ char 'a' will succeed consuming one
> 'a' and then lookAhead will rewind the input (as it does on success).
> Thus when we call char 'b' we are going to be in the beginning of the
> input again. Well, that doesn't happen:
>
> Left (line 1, column 2):
> unexpected end of input
> expecting "b"
>
> As you can see, lookAhead did not rewind the input as it was supposed to.
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
------------------------------
Message: 5
Date: Thu, 7 Aug 2014 10:57:47 -0700
From: Kyle Hanson <me at khanson.io>
To: haskell-cafe at haskell.org
Subject: [Haskell-cafe] Performance of StateT and best practices for
debugging
Message-ID:
<CAMJUouBqFbSi+ifFsbYdXpba7pPVoP8BkyZxZaUoqLNuHc7VzQ at mail.gmail.com>
Content-Type: text/plain; charset="utf-8"
Hello,
I was looking at cleaning up my refactoring a core loop of template
rendering to go from a loop with many parameters
loop :: RenderConfig -> BlockMap -> InputBucket m -> Builder -> [Pieces] ->
ExceptT StrapError m Builder
to a looped state monad transformer
loop :: [Pieces] -> RenderT m Builder
newtype RenderT m a = RenderT
{ runRenderT :: ExceptT StrapError (StateT (RenderState m) m) a
} deriving ( Functor, Applicative, Monad, MonadIO )
data RenderState m = RenderState
{ position :: SourcePos
, renderConfig :: RenderConfig
, blocks :: BlockMap
, bucket :: InputBucket m
}
however, there is a big slow down (about 6-10x) using a StateT. I think it
might have something to do with laziness but I am not exactly sure of where
to begin in tracking it down. Swapping out the Lazy State to a Strict State
helps a little (only a 5x slow down)
You can find some of the processing code here:
https://github.com/hansonkd/StrappedTemplates/blob/321a88168d54943fc217553c873f188797c0d4f5/src/Text/Strapped/Render.hs#L189
With my old loop commented out.
Its messy right now since I am just trying a number of different
approaches. I did some more work factoring out the lifts, trying different
iterations of foldlM and stuff but that didn't have that much of an effect
on performance.
After profiling I see in the StateT, the report has a lot more CAFs and
garbage collecting.
Here is the profiling report from my original version w/o StateT
http://lpaste.net/108995
Slow version with StateT
http://lpaste.net/108997
Here is the "makeBucket" function that is referenced (it is the same in
both state and nonstate):
https://github.com/hansonkd/StrappedTemplates/blob/321a88168d54943fc217553c873f188797c0d4f5/examples/big_example.hs#L24
Looking at stacked overflow and the official docs I have gotten an idea of
what is going on. The heaps generated between them tells me that a lot more
memory is being allocated to lists. These heaps were generated running my
render function against a template with nested loops and a list of elements.
http://imgur.com/a/2jOIf
I am hoping that maybe someone could give me a hint at what to look at
next. I've played around with Strictness and refactoring loops to no avail
and now am kind of stuck. Any help would be appreciated.
--
Kyle Hanson
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140807/a82b99f5/attachment-0001.html>
------------------------------
Message: 6
Date: Thu, 07 Aug 2014 21:07:02 +0200
From: Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>
To: haskell-cafe at haskell.org
Subject: [Haskell-cafe] [ANN] rtorrent-state 0.1.0.0
Message-ID: <53E3CE56.6090500 at fuuzetsu.co.uk>
Content-Type: text/plain; charset=windows-1252
Hi,
rtorrent-state is a library that allows working with rtorrent state
files (SOMEHASH.torrent.rtorrent) placed in your session directory.
If you're an rtorrent user and ever had to manually muck around with
those files, you should be able to use this library to make your life
easier.
For example, you can stop all torrents in your session directory with
just: ?overFilesIn "rtorrent/session/dir" stopTorrent?
The way it works is by parsing the session files, modifying the
resulting data type and serialising it back into the file. I did not do
optimisation but I had no problem with test sample of 100,000 files.
I need to add IOException handling and maybe extra utility functions but
otherwise I consider the library finished.
Thanks
--
Mateusz K.
------------------------------
Message: 7
Date: Thu, 7 Aug 2014 15:39:53 -0700
From: John Lato <jwlato at gmail.com>
To: Kyle Hanson <me at khanson.io>
Cc: haskell-cafe <haskell-cafe at haskell.org>
Subject: Re: [Haskell-cafe] Performance of StateT and best practices
for debugging
Message-ID:
<CAJ727GjPpMn3xMDs=4EmJGG0FpndsBwvq5Zkc97X6yQ-H21KEA at mail.gmail.com>
Content-Type: text/plain; charset="utf-8"
I haven't looked very closely, but I'm suspicious of this code from
"instance Block Piece"
ListLike l -> forM l (\obj -> ...)
>>= (return . mconcat)
The "forM" means that "l" will be traversed once and create an output list,
which will then be mconcat'd together. The list has to be created because
of the monadic structure imposed by forM, but if the result of the mconcat
isn't demanded right away it will be retained as a thunk that references
the newly-created list.
I'd suggest that you replace it with something like
ListLike l -> foldM (\(!acc) obj -> ... >>= return . mappend acc) mempty l
Here I've justed added a bang pattern to the accumulator. If whatever is
being returned has some lazy fields, you may want to change that to use
deepseq instead of a bang pattern.
Also, "foo >>= return . bar" is often regarded as a bit of a code smell, it
can be replaced with "bar <$> foo" or "bar `liftM` foo", or sometimes
something even simpler depending on circumstances (but IMHO sometimes it's
more clear to just leave it alone).
The heap profile does look like a space leak. The line
<StrappedTemplates-0.1.1.0:Text.Strapped.Render.sat_sc1z>
is a thunk (you can tell because it's in '<>' brackets), so whatever is
referencing that is not strict enough. Sometimes another heap profile
report, e.g. "-hc" or maybe "-hy" will give more useful information that
lets you identify what exactly "sat_sc1z" is. You could also try compiling
with -ddump-stg, which will dump the intermediate STG output which usually
shows those names. But then you'll probably also need to re-run the
profile, since the names change between compilations. Also IIRC some of
values aren't named until the cmm phase, but that's harder to map back to
Haskell so if you can identify the code from stg it's simpler.
If you haven't seen
http://blog.ezyang.com/2011/06/pinpointing-space-leaks-in-big-programs/,
I'd highly recommend it if you need to track down a space leak.
John L.
On Thu, Aug 7, 2014 at 10:57 AM, Kyle Hanson <me at khanson.io> wrote:
> Hello,
>
> I was looking at cleaning up my refactoring a core loop of template
> rendering to go from a loop with many parameters
>
> loop :: RenderConfig -> BlockMap -> InputBucket m -> Builder -> [Pieces]
> -> ExceptT StrapError m Builder
>
> to a looped state monad transformer
>
> loop :: [Pieces] -> RenderT m Builder
>
> newtype RenderT m a = RenderT
> { runRenderT :: ExceptT StrapError (StateT (RenderState m) m) a
> } deriving ( Functor, Applicative, Monad, MonadIO )
>
> data RenderState m = RenderState
> { position :: SourcePos
> , renderConfig :: RenderConfig
> , blocks :: BlockMap
> , bucket :: InputBucket m
> }
>
> however, there is a big slow down (about 6-10x) using a StateT. I think it
> might have something to do with laziness but I am not exactly sure of where
> to begin in tracking it down. Swapping out the Lazy State to a Strict State
> helps a little (only a 5x slow down)
>
> You can find some of the processing code here:
>
>
> https://github.com/hansonkd/StrappedTemplates/blob/321a88168d54943fc217553c873f188797c0d4f5/src/Text/Strapped/Render.hs#L189
>
> With my old loop commented out.
>
> Its messy right now since I am just trying a number of different
> approaches. I did some more work factoring out the lifts, trying different
> iterations of foldlM and stuff but that didn't have that much of an effect
> on performance.
>
> After profiling I see in the StateT, the report has a lot more CAFs and
> garbage collecting.
>
> Here is the profiling report from my original version w/o StateT
> http://lpaste.net/108995
>
> Slow version with StateT
> http://lpaste.net/108997
>
> Here is the "makeBucket" function that is referenced (it is the same in
> both state and nonstate):
>
>
> https://github.com/hansonkd/StrappedTemplates/blob/321a88168d54943fc217553c873f188797c0d4f5/examples/big_example.hs#L24
>
> Looking at stacked overflow and the official docs I have gotten an idea of
> what is going on. The heaps generated between them tells me that a lot more
> memory is being allocated to lists. These heaps were generated running my
> render function against a template with nested loops and a list of elements.
>
> http://imgur.com/a/2jOIf
>
> I am hoping that maybe someone could give me a hint at what to look at
> next. I've played around with Strictness and refactoring loops to no avail
> and now am kind of stuck. Any help would be appreciated.
>
> --
> Kyle Hanson
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140807/b4c26366/attachment-0001.html>
------------------------------
Message: 8
Date: Fri, 8 Aug 2014 11:24:29 +0800
From: jun zhang <zhangjun.julian at gmail.com>
To: haskell-cafe at haskell.org
Subject: [Haskell-cafe] How to improve the zipwith's performance
Message-ID:
<CAGjcJLcT0FAmNxFLbdaZZfMFg5aEL1rZDPEWOpRxvsKJsau3ew at mail.gmail.com>
Content-Type: text/plain; charset="utf-8"
Dear All
I write a code for Clustering with Data.Clustering.Hierarchical, but it's
slow.
I use the profiling and change some code, but I don't know why zipwith take
so many time? (even I change list to vector)
My code is as blow, Any one kindly give me some advices.
======================
main = do
....
let cluster = dendrogram SingleLinkage vectorList getVectorDistance
....
getExp2 v1 v2 = d*d
where
d = v1 - v2
getExp v1 v2
| v1 == v2 = 0
| otherwise = getExp2 v1 v2
tfoldl d = DV.foldl1' (+) d
changeDataType:: Int -> Double
changeDataType d = fromIntegral d
getVectorDistance::(a,DV.Vector Int)->(a, DV.Vector Int )->Double
getVectorDistance v1 v2 = fromIntegral $ tfoldl dat
where
l1 = snd v1
l2 = snd v2
dat = DV.zipWith getExp l1 l2
=======================================
build with ghc -prof -fprof-auto -rtsopts -O2 log_cluster.hs
run with log_cluster.exe +RTS -p
profiling result is
log_cluster.exe +RTS -p -RTS
total time = 8.43 secs (8433 ticks @ 1000 us, 1 processor)
total alloc = 1,614,252,224 bytes (excludes profiling overheads)
COST CENTRE MODULE %time %alloc
getVectorDistance.dat Main 49.4 37.8
tfoldl Main 5.7 0.0
getExp Main 4.5 0.0
getExp2 Main 0.5 1.5
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140808/d29aa298/attachment-0001.html>
------------------------------
Message: 9
Date: Fri, 08 Aug 2014 06:31:49 +0200
From: Bardur Arantsson <spam at scientician.net>
To: haskell-cafe at haskell.org
Subject: Re: [Haskell-cafe] Performance of StateT and best practices
for debugging
Message-ID: <ls1jrl$7gp$1 at ger.gmane.org>
Content-Type: text/plain; charset=utf-8
On 2014-08-07 19:57, Kyle Hanson wrote:
> Hello,
>
> Here is the "makeBucket" function that is referenced (it is the same in
> both state and nonstate):
>
> https://github.com/hansonkd/StrappedTemplates/blob/321a88168d54943fc217553c873f188797c0d4f5/examples/big_example.hs#L24
>
Just a shot in the dark, but I notice that you're using "modify" and not
"modify'" which was added in a recent version of transformers.
Strict.StateT is not always "strict enough" and you may need to use modify'.
At any rate, it's worth a shot, I think.
Regards,
------------------------------
Message: 10
Date: Thu, 7 Aug 2014 22:30:25 -0700
From: Jan Paul Posma <me at janpaulposma.nl>
To: haskell-cafe at haskell.org
Subject: [Haskell-cafe] Visualising Haskell function execution
Message-ID:
<CAPtY9n+6onYBYb=pWP4NRmLq43zY6MGXQMuhmp2HfnUzhuOiyA at mail.gmail.com>
Content-Type: text/plain; charset="utf-8"
Hey all,
Last weekend my friend Steve and I did a small project for visualising
Haskell function execution in the browser. It's meant to be used in
education, and uses a tiny custom parser. I figured it could be of interest
for anyone here learning or teaching Haskell:
https://stevekrouse.github.io/hs.js/
To see it in action, scroll a bit down to the red bordered box, and click
on "map", and then keep clicking on each new line.
I hope it can be useful to someone.
Cheers, JP
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140807/3c4dabe9/attachment-0001.html>
------------------------------
Message: 11
Date: Thu, 7 Aug 2014 23:56:43 -0700
From: John Lato <jwlato at gmail.com>
To: Bardur Arantsson <spam at scientician.net>
Cc: haskell-cafe <haskell-cafe at haskell.org>
Subject: Re: [Haskell-cafe] Performance of StateT and best practices
for debugging
Message-ID:
<CAJ727GipLL12TXfrMBeLJBX2_GdoD0W-CKJd4U1cu48CvnkrBg at mail.gmail.com>
Content-Type: text/plain; charset="utf-8"
On Thu, Aug 7, 2014 at 9:31 PM, Bardur Arantsson <spam at scientician.net>
wrote:
> On 2014-08-07 19:57, Kyle Hanson wrote:
> > Hello,
> >
> > Here is the "makeBucket" function that is referenced (it is the same in
> > both state and nonstate):
> >
> >
> https://github.com/hansonkd/StrappedTemplates/blob/321a88168d54943fc217553c873f188797c0d4f5/examples/big_example.hs#L24
> >
>
> Just a shot in the dark, but I notice that you're using "modify" and not
> "modify'" which was added in a recent version of transformers.
>
> Strict.StateT is not always "strict enough" and you may need to use
> modify'.
>
> At any rate, it's worth a shot, I think.
>
Good point. I think that even modify' will not be strict enough without
adding strictness to RenderState as well.
John L.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140807/ce617687/attachment-0001.html>
------------------------------
Subject: Digest Footer
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe at haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
------------------------------
End of Haskell-Cafe Digest, Vol 132, Issue 11
*********************************************
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140808/23dbf2aa/attachment.html>
More information about the Haskell-Cafe
mailing list