Extracting comments from the source code

Dear GHC devs, I'm trying to port Liquid Haskell to ghc 9.2.5. And having much difficulty using the GHC API for a specific task, so I come here to ask about it. As you may know already, Liquid Haskell needs to read special comments from Haskell source code which have the form {-@ ... @-}. For example
module Demo.Lib where
{-@ type Pos = {v:Int | 0 < v} @-}
{-@ incr :: Pos -> Pos @-} incr :: Int -> Int incr x = h x where {-@ h :: Pos -> Pos @-} h x = x - 1
Since Liquid Haskell runs as a GHC plugin, it has access to the GHC API. It used to be the case that one could find all of the comments together with their source spans in a field pm_annotations :: ParsedModule -> ApiAnns -- [1] However this field has been removed in ghc-9.2, and now the comments are all spread through the AST after parsing. I managed to collect them all again with a generic traversal:
go :: forall a. Data a => a -> [LEpaComment] go = gmapQr (++) [] go `extQ` (id @[LEpaComment])
but I'd expect this to be rather slow. So I'd like to ask here, is there a better way to collect all of the comments? The other obvious way would be to write the traversal manually, but it would be some code to write, and it would likely need attention when porting to newer GHCs onwards. Thanks! Facundo [1]: https://hackage.haskell.org/package/ghc-9.0.2/docs/GHC.html#t:ParsedModule

I’m not sure why you expect it to be so slow? When developing refactoring
tasks for HLS I have never noticed big latencies, even when performing
multiple generic traversals over a full module.
You might have some success by specializing or inking the definition, so
that GHC can optimize the traversal generated.
Best
Santi
On Friday, 27 January 2023, Facundo Domínguez
Dear GHC devs,
I'm trying to port Liquid Haskell to ghc 9.2.5. And having much difficulty using the GHC API for a specific task, so I come here to ask about it.
As you may know already, Liquid Haskell needs to read special comments from Haskell source code which have the form {-@ ... @-}.
For example
module Demo.Lib where
{-@ type Pos = {v:Int | 0 < v} @-}
{-@ incr :: Pos -> Pos @-} incr :: Int -> Int incr x = h x where {-@ h :: Pos -> Pos @-} h x = x - 1
Since Liquid Haskell runs as a GHC plugin, it has access to the GHC API. It used to be the case that one could find all of the comments together with their source spans in a field
pm_annotations :: ParsedModule -> ApiAnns -- [1]
However this field has been removed in ghc-9.2, and now the comments are all spread through the AST after parsing.
I managed to collect them all again with a generic traversal:
go :: forall a. Data a => a -> [LEpaComment] go = gmapQr (++) [] go `extQ` (id @[LEpaComment])
but I'd expect this to be rather slow. So I'd like to ask here, is there a better way to collect all of the comments?
The other obvious way would be to write the traversal manually, but it would be some code to write, and it would likely need attention when porting to newer GHCs onwards.
Thanks! Facundo
[1]: https://hackage.haskell.org/package/ghc-9.0.2/docs/GHC. html#t:ParsedModule

Facundo Domínguez
Dear GHC devs,
I'm trying to port Liquid Haskell to ghc 9.2.5. And having much difficulty using the GHC API for a specific task, so I come here to ask about it.
As you may know already, Liquid Haskell needs to read special comments from Haskell source code which have the form {-@ ... @-}.
I agree with Santiago here: Data doesn't produce fantiastic code but I would guess that the cost of the traversal to collect your signatures will be negligible relative to the cost of the work you will later do later in your pipeline. I would leave optimising this until you know that it is a significant problem. Cheers, - Ben

Thanks folks. I was concerned I might be missing some dedicated way to
achieve the same with the GHC API. I agree there's a fair chance this won't
be noticeable in benchmarks.
Cheers!
Facundo
On Fri, Jan 27, 2023 at 10:15 PM Ben Gamari
Facundo Domínguez
writes: Dear GHC devs,
I'm trying to port Liquid Haskell to ghc 9.2.5. And having much difficulty using the GHC API for a specific task, so I come here to ask about it.
As you may know already, Liquid Haskell needs to read special comments from Haskell source code which have the form {-@ ... @-}.
I agree with Santiago here: Data doesn't produce fantiastic code but I would guess that the cost of the traversal to collect your signatures will be negligible relative to the cost of the work you will later do later in your pipeline. I would leave optimising this until you know that it is a significant problem.
Cheers,
- Ben
participants (3)
-
Ben Gamari
-
Facundo Domínguez
-
Santiago Weight