API for looking-up/retrieving Haddock comments?

2012-08-03 Thread Herbert Valerio Riedel
Hello,

I've been wondering if there have been attempts to provide some
library/API or similiar facility (other than pointing your web-browser
to the static Haddock HTML report) for looking up Haddock comments
associated with Haskell symbols?

As an obvious application: When coding in dynamic languages
(e.g. Python, Elisp, or GNU R to name a few), I've learned to appreciate
the ability to lookup up documentation interactively from the
tab-completing REPL w/o having to "switch context/focus" to different
application (as I currently do: I have to switch from GHCi to a
web-browser and first locate the appropriate package/module and then
find the symbol I'm interested in).

cheers,
  hvr

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


Re: Non-updateable thunks

2012-08-03 Thread Simon Marlow

On 01/08/2012 11:38, Joachim Breitner wrote:

Hello,

I’m still working on issues of performance vs. sharing; I must assume
some of the people here on the list must have seen my "dup"-paper¹ as
referees.

I’m now wondering about a approach where the compiler (either
automatically or by user annotation; I’ll leave that question for later)
would mark some thunks as reentrant, i.e. simply skip the blackholing
and update frame pushing. A quick test showed that this should work
quite well, take the usual example:

 import System.Environment
 main = do
 a <- getArgs
 let n = length a
 print n
 let l = [n..3000]
 print $ last l + last l

This obviously leaks memory:

 $ ./Test +RTS -t
 0
 6000
 <>


I then modified the the assembly (a crude but effective way of testing
this ;-)) to not push a stack frame:

$ diff -u Test.s Test-modified.s
--- Test.s  2012-08-01 11:30:00.0 +0200
+++ Test-modified.s 2012-08-01 11:29:40.0 +0200
@@ -56,20 +56,20 @@
leaq -40(%rbp),%rax
cmpq %r15,%rax
jb .LcpZ
-   addq $16,%r12
-   cmpq 144(%r13),%r12
-   ja .Lcq1
-   movq $stg_upd_frame_info,-16(%rbp)
-   movq %rbx,-8(%rbp)
+   //addq $16,%r12
+   //cmpq 144(%r13),%r12
+   //ja .Lcq1
+   //movq $stg_upd_frame_info,-16(%rbp)
+   //movq %rbx,-8(%rbp)
movq $ghczmprim_GHCziTypes_Izh_con_info,-8(%r12)
movq $3000,0(%r12)
leaq -7(%r12),%rax
-   movq %rax,-24(%rbp)
+   movq %rax,-8(%rbp)
movq 16(%rbx),%rax
-   movq %rax,-32(%rbp)
-   movq $stg_ap_pp_info,-40(%rbp)
+   movq %rax,-16(%rbp)
+   movq $stg_ap_pp_info,-24(%rbp)
movl $base_GHCziEnum_zdfEnumInt_closure,%r14d
-   addq $-40,%rbp
+   addq $-24,%rbp
jmp base_GHCziEnum_enumFromTo_info
  .Lcq1:
movq $16,192(%r13)

Now it runs fast and slim (and did not crash on the first try, which I
find surprising after hand-modifying the assembly code):

 $ ./Test +RTS -t
 0
 6000
 <>


My question is: Has anybody worked in that direction? And are there any
fundamental problems with the current RTS implementation and such
closures?


Long ago GHC used to have an "update analyser" which would detect some 
thunks that would never be re-entered and omit the update frame on them. 
 I wrote a paper about this many years ago, and there were other people 
working on similar ideas, some using types (e.g. linear types) - google 
for "update avoidance".  As I understand it you want to omit doing some 
updates in order to avoid space leaks, which is slightly different.


The StgSyn abstract syntax has an UpdateFlag on each StgRhs which lets 
you turn off the update, and I believe the code generator will respect 
it although it isn't actually ever turned off at the moment.


Cheers,
Simon

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


Re: API for looking-up/retrieving Haddock comments?

2012-08-03 Thread Simon Hengel
> I've been wondering if there have been attempts to provide some
> library/API or similiar facility (other than pointing your web-browser
> to the static Haddock HTML report) for looking up Haddock comments
> associated with Haskell symbols?
> 
> As an obvious application: When coding in dynamic languages
> (e.g. Python, Elisp, or GNU R to name a few), I've learned to appreciate
> the ability to lookup up documentation interactively from the
> tab-completing REPL w/o having to "switch context/focus" to different
> application (as I currently do: I have to switch from GHCi to a
> web-browser and first locate the appropriate package/module and then
> find the symbol I'm interested in).


I have the following in my .ghci:

-- hoogle integration
:def hoogle \q -> return $ ":! hoogle --color=true --count=15   \"" ++ q ++ 
"\""
:def doc\q -> return $ ":! hoogle --color=true --info   \"" ++ q ++ 
"\""

Which can be used from GHCi like so:

Prelude> :doc map
Searching for: map
Prelude map :: (a -> b) -> [a] -> [b]

map f xs is the list obtained by applying f to each element of xs, i.e.,

> map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]
> map f [x1, x2, ...] == [f x1, f x2, ...] 

From package base
map :: (a -> b) -> [a] -> [b]

Have a look at [1].

Cheers,
Simon

[1] http://www.haskell.org/haskellwiki/Hoogle#GHCi_Integration

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


Re: Non-updateable thunks

2012-08-03 Thread Joachim Breitner
Hi Simon,

Am Freitag, den 03.08.2012, 09:28 +0100 schrieb Simon Marlow:
> > My question is: Has anybody worked in that direction? And are there any
> > fundamental problems with the current RTS implementation and such
> > closures?
> 
> Long ago GHC used to have an "update analyser" which would detect some 
> thunks that would never be re-entered and omit the update frame on them. 
>   I wrote a paper about this many years ago, and there were other people 
> working on similar ideas, some using types (e.g. linear types) - google 
> for "update avoidance".  As I understand it you want to omit doing some 
> updates in order to avoid space leaks, which is slightly different.

Thanks for the pointers, I will have a look. Why was the update analyser
removed from GHC?

> The StgSyn abstract syntax has an UpdateFlag on each StgRhs which lets 
> you turn off the update, and I believe the code generator will respect 
> it although it isn't actually ever turned off at the moment.

Indeed that works: I added a stg2stg transformation phase that removes
the flag on some thunks (with hard-coded names for now :-)) and the
generated code works as expected. I’m now thinking how I can allow the
programmer to annotate thunks  as non-updateable, and how to carry that
information to the stg phase.

Greetings,
Joachim

-- 
Dipl.-Math. Dipl.-Inform. Joachim Breitner
Wissenschaftlicher Mitarbeiter
http://pp.info.uni-karlsruhe.de/~breitner


signature.asc
Description: This is a digitally signed message part
___
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


New INLINE pragma syntax idea, and some questions

2012-08-03 Thread Brandon Simmons
I've been wondering for some time about the details of how GHC uses
syntax with inlining, and how other transformations come into play in
the process (I recently asked a question on SO if anyone wants some
karma: http://stackoverflow.com/q/11690146/176841). I know this is a
big topic and there's probably a lot more out there I should read.

In particular I don't fully understand why these sorts of contortions...


http://hackage.haskell.org/packages/archive/base/latest/doc/html/src/GHC-List.html#foldl

...are required. It seems like a programmer has to throw "equational
reasoning", separation of concerns, and all the little elegant bits
about the language out the window just to indicate something boring to
the compiler.

Disclaimer: The following is less a proposal meant to be taken
seriously, and more me trying to better understand things.

Could the following be used as syntax for indicating inlining? Rather
than relying on the syntactic LHS, instead let that be specified in
the type signature...

foldl:: (a -> b -> a) -> a -> [b] -> {-# INLINE #-} a
foldl f z [] =  z
foldl f z (x:xs) = foldl f (f z x) xs

...indicating, in this case, that foldl should be inlined when
"fully-applied" means its first three arguments (I guess that's the
intent of the original version linked above?). Then (waves hands) the
compiler could do the necessary transformations that the programmer
had to do to foldl above. Maybe what I'm proposing is actually a
separate NORECURSIVE_TRANSFORM pragma or something.

An alternative if including the pragma in the type sig. isn't sound,
is to allow it in the function definition left-hand side, after the
bindings we would like applied before inlining.

Brandon

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