[commit: ghc] master: Add API Annotations (803fc5d)
git at git.haskell.org
git at git.haskell.org
Fri Nov 21 17:25:57 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/803fc5db31f084b73713342cdceaed5a9c664267/ghc
>---------------------------------------------------------------
commit 803fc5db31f084b73713342cdceaed5a9c664267
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Fri Nov 21 11:20:13 2014 -0600
Add API Annotations
Summary:
The final design and discussion is captured at
https://ghc.haskell.org/trac/ghc/wiki/GhcAstAnnotations
This is a proof of concept implementation of a completely
separate annotation structure, populated in the parser,and tied to the
AST by means of a virtual "node-key" comprising the surrounding
SrcSpan and a value derived from the specific constructor used for the
node.
The key parts of the design are the following.
== The Annotations ==
In `hsSyn/ApiAnnotation.hs`
```lang=haskell
type ApiAnns = (Map.Map ApiAnnKey SrcSpan, Map.Map SrcSpan [Located Token])
type ApiAnnKey = (SrcSpan,AnnKeywordId)
-- ---------------------------------------------------------------------
-- | Retrieve an annotation based on the @SrcSpan@ of the annotated AST
-- element, and the known type of the annotation.
getAnnotation :: ApiAnns -> SrcSpan -> AnnKeywordId -> Maybe SrcSpan
getAnnotation (anns,_) span ann = Map.lookup (span,ann) anns
-- |Retrieve the comments allocated to the current @SrcSpan@
getAnnotationComments :: ApiAnns -> SrcSpan -> [Located Token]
getAnnotationComments (_,anns) span =
case Map.lookup span anns of
Just cs -> cs
Nothing -> []
-- | Note: in general the names of these are taken from the
-- corresponding token, unless otherwise noted
data AnnKeywordId
= AnnAs
| AnnBang
| AnnClass
| AnnClose -- ^ } or ] or ) or #) etc
| AnnComma
| AnnDarrow
| AnnData
| AnnDcolon
....
```
== Capturing in the lexer/parser ==
The annotations are captured in the lexer / parser by extending PState to include a field
In `parser/Lexer.x`
```lang=haskell
data PState = PState {
....
annotations :: [(ApiAnnKey,SrcSpan)]
-- Annotations giving the locations of 'noise' tokens in the
-- source, so that users of the GHC API can do source to
-- source conversions.
}
```
The lexer exposes a helper function to add an annotation
```lang=haskell
addAnnotation :: SrcSpan -> Ann -> SrcSpan -> P ()
addAnnotation l a v = P $ \s -> POk s {
annotations = ((AK l a), v) : annotations s
} ()
```
The parser also has some helper functions of the form
```lang=haskell
type MaybeAnn = Maybe (SrcSpan -> P ())
gl = getLoc
gj x = Just (gl x)
ams :: Located a -> [MaybeAnn] -> P (Located a)
ams a@(L l _) bs = (mapM_ (\a -> a l) $ catMaybes bs) >> return a
```
This allows annotations to be captured in the parser by means of
```
ctypedoc :: { LHsType RdrName }
: 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
ams (LL $ mkExplicitHsForAllTy $2 (noLoc []) $4)
[mj AnnForall $1,mj AnnDot $3] }
| context '=>' ctypedoc {% ams (LL $ mkQualifiedHsForAllTy $1 $3)
[mj AnnDarrow $2] }
| ipvar '::' type {% ams (LL (HsIParamTy (unLoc $1) $3))
[mj AnnDcolon $2] }
| typedoc { $1 }
```
== Parse result ==
```lang-haskell
data HsParsedModule = HsParsedModule {
hpm_module :: Located (HsModule RdrName),
hpm_src_files :: [FilePath],
-- ^ extra source files (e.g. from #includes). The lexer collects
-- these from '# <file> <line>' pragmas, which the C preprocessor
-- leaves behind. These files and their timestamps are stored in
-- the .hi file, so that we can force recompilation if any of
-- them change (#3589)
hpm_annotations :: ApiAnns
}
-- | The result of successful parsing.
data ParsedModule =
ParsedModule { pm_mod_summary :: ModSummary
, pm_parsed_source :: ParsedSource
, pm_extra_src_files :: [FilePath]
, pm_annotations :: ApiAnns }
```
This diff depends on D426
Test Plan: sh ./validate
Reviewers: austin, simonpj, Mikolaj
Reviewed By: simonpj, Mikolaj
Subscribers: Mikolaj, goldfire, thomie, carter
Differential Revision: https://phabricator.haskell.org/D438
GHC Trac Issues: #9628
>---------------------------------------------------------------
803fc5db31f084b73713342cdceaed5a9c664267
compiler/basicTypes/DataCon.lhs | 3 +
compiler/ghc.cabal.in | 1 +
compiler/ghc.mk | 2 +
compiler/hsSyn/HsBinds.lhs | 46 +-
compiler/hsSyn/HsDecls.lhs | 108 +-
compiler/hsSyn/HsExpr.lhs | 105 +-
compiler/hsSyn/HsImpExp.lhs | 40 +-
compiler/hsSyn/HsPat.lhs | 2 +
compiler/hsSyn/HsSyn.lhs | 23 +-
compiler/hsSyn/HsTypes.lhs | 15 +-
compiler/hsSyn/HsUtils.lhs | 8 +-
compiler/main/GHC.hs | 16 +-
compiler/main/HeaderInfo.hs | 4 +-
compiler/main/HscMain.hs | 7 +-
compiler/main/HscTypes.lhs | 5 +-
compiler/parser/ApiAnnotation.hs | 238 +++
compiler/parser/Lexer.x | 129 +-
compiler/parser/Parser.y | 1719 +++++++++++++-------
compiler/parser/RdrHsSyn.hs | 8 +-
ghc/InteractiveUI.hs | 2 +-
testsuite/tests/ghc-api/annotations/.gitignore | 7 +
.../tests/ghc-api/annotations/AnnotationLet.hs | 12 +
.../tests/ghc-api/annotations/AnnotationTuple.hs | 20 +
.../tests/ghc-api/annotations/CommentsTest.hs | 13 +
testsuite/tests/ghc-api/annotations/Makefile | 21 +
testsuite/tests/ghc-api/annotations/all.T | 4 +
testsuite/tests/ghc-api/annotations/annotations.hs | 58 +
.../tests/ghc-api/annotations/annotations.stdout | 51 +
testsuite/tests/ghc-api/annotations/comments.hs | 64 +
.../tests/ghc-api/annotations/comments.stdout | 24 +
.../landmines.hs => annotations/parseTree.hs} | 42 +-
.../tests/ghc-api/annotations/parseTree.stdout | 122 ++
32 files changed, 2248 insertions(+), 671 deletions(-)
Diff suppressed because of size. To see it, use:
git diff-tree --root --patch-with-stat --no-color --find-copies-harder --ignore-space-at-eol --cc 803fc5db31f084b73713342cdceaed5a9c664267
More information about the ghc-commits
mailing list