Commit ed85d7e1 authored by Alan Zimmerman's avatar Alan Zimmerman Committed by Austin Seipp

More Tweaks for API Anotations

Summary: Attaching semis to preceding AST element, not following

Test Plan: sh ./validate

Reviewers: hvr, austin

Reviewed By: austin

Subscribers: cactus, thomie, carter

Differential Revision: https://phabricator.haskell.org/D529
parent 6d47ab3a
......@@ -585,7 +585,9 @@ type LSig name = Located (Sig name)
-- | Signatures and pragmas
data Sig name
= -- | An ordinary type signature
-- @f :: Num a => a -> a@
--
-- > f :: Num a => a -> a
--
-- After renaming, this list of Names contains the named and unnamed
-- wildcards brought into scope by this signature. For a signature
-- @_ -> _a -> Bool@, the renamer will give the unnamed wildcard @_@
......@@ -599,7 +601,12 @@ data Sig name
TypeSig [Located name] (LHsType name) (PostRn name [Name])
-- | A pattern synonym type signature
-- @pattern type forall b. (Eq b) => P a b :: forall a. (Num a) => T a
--
-- > pattern Single :: () => (Show a) => a -> [a]
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
-- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'
-- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
| PatSynSig (Located name)
(HsExplicitFlag, LHsTyVarBndrs name)
(LHsContext name) -- Provided context
......@@ -610,6 +617,8 @@ data Sig name
--
-- > default eq :: (Representable0 a, GEq (Rep0 a)) => a -> a -> Bool
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',
-- 'ApiAnnotation.AnnDcolon'
| GenericSig [Located name] (LHsType name)
-- | A type signature in generated code, notably the code
......@@ -617,16 +626,15 @@ data Sig name
-- the desired Id itself, replete with its name, type
-- and IdDetails. Otherwise it's just like a type
-- signature: there should be an accompanying binding
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',
-- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnDotdot'
| IdSig Id
-- | An ordinary fixity declaration
--
-- > infixl 8 ***
--
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix',
-- 'ApiAnnotation.AnnVal'
| FixSig (FixitySig name)
-- | An inline pragma
......
......@@ -17,6 +17,7 @@ HsTypes: Abstract syntax: user-defined types
module HsTypes (
HsType(..), LHsType, HsKind, LHsKind,
HsTyOp,LHsTyOp,
HsTyVarBndr(..), LHsTyVarBndr,
LHsTyVarBndrs(..),
HsWithBndrs(..),
......@@ -247,6 +248,7 @@ data HsType name
| HsFunTy (LHsType name) -- function type
(LHsType name)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow',
| HsListTy (LHsType name) -- Element type
......
......@@ -176,6 +176,7 @@ data AnnKeywordId
| AnnIf
| AnnImport
| AnnIn
| AnnInfix -- ^ 'infix' or 'infixl' or 'infixr'
| AnnInstance
| AnnLam
| AnnLarrow -- ^ '<-'
......
......@@ -234,6 +234,21 @@ Be careful: there's no checking that you actually got this right, the
only symptom will be that the SrcSpans of your syntax will be
incorrect.
-- -----------------------------------------------------------------------------
-- API Annotations
A lot of the productions are now cluttered with calls to
aa,am,ams,amms etc.
These are helper functions to make sure that the locations of the
various keywords such as do / let / in are captured for use by tools
that want to do source to source conversions, such as refactorers or
structured editors.
The helper functions are defined at the bottom of this file.
See https://ghc.haskell.org/trac/ghc/wiki/GhcAstAnnotations for some background.
-- -----------------------------------------------------------------------------
-}
......@@ -581,7 +596,7 @@ qcname :: { Located RdrName } -- Variable or data constructor
-- whereas topdecls must contain at least one topdecl.
importdecls :: { [LImportDecl RdrName] }
: importdecls ';' importdecl {% (aa $3 (AnnSemi, $2)) >>
: importdecls ';' importdecl {% (asl $1 $2 $3) >>
return ($3 : $1) }
| importdecls ';' {% addAnnotation (gl $ head $1) AnnSemi (gl $2)
-- AZ: can $1 above ever be [] due to the {- empty -} production?
......@@ -637,9 +652,10 @@ impspec :: { Located (Bool, Located [LIE RdrName]) }
-----------------------------------------------------------------------------
-- Fixity Declarations
prec :: { Int }
: {- empty -} { 9 }
| INTEGER {% checkPrecP (sL1 $1 (fromInteger (getINTEGER $1))) }
prec :: { Located Int }
: {- empty -} { noLoc 9 }
| INTEGER
{% checkPrecP (sL1 $1 (fromInteger (getINTEGER $1))) }
infix :: { Located FixityDirection }
: 'infix' { sL1 $1 InfixN }
......@@ -655,7 +671,7 @@ ops :: { Located (OrdList (Located RdrName)) }
-- Top-Level Declarations
topdecls :: { OrdList (LHsDecl RdrName) }
: topdecls ';' topdecl {% addAnnotation (oll $3) AnnSemi (gl $2)
: topdecls ';' topdecl {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return ($1 `appOL` $3) }
| topdecls ';' {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return $1 }
......@@ -831,7 +847,7 @@ ty_fam_inst_eqn_list :: { Located ([AddAnn],[LTyFamInstEqn RdrName]) }
ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] }
: ty_fam_inst_eqns ';' ty_fam_inst_eqn
{% addAnnotation (gl $3) AnnSemi (gl $2)
{% asl (unLoc $1) $2 $3
>> return (sLL $1 $> ($3 : unLoc $1)) }
| ty_fam_inst_eqns ';' {% addAnnotation (gl $1) AnnSemi (gl $2)
>> return (sLL $1 $> (unLoc $1)) }
......@@ -1012,22 +1028,28 @@ where_decls :: { Located ([AddAnn]
,$3) }
pattern_synonym_sig :: { LSig RdrName }
: 'pattern' con '::' ptype
{% do { let (flag, qtvs, prov, req, ty) = unLoc $4
{% do { let (flag, qtvs, prov, req, ty) = snd $ unLoc $4
; let sig = PatSynSig $2 (flag, mkHsQTvs qtvs) prov req ty
; checkValidPatSynSig sig
; return $ sLL $1 $> $ sig } }
; ams (sLL $1 $> $ sig)
(mj AnnPattern $1:mj AnnDcolon $3:(fst $ unLoc $4)) } }
ptype :: { Located (HsExplicitFlag, [LHsTyVarBndr RdrName], LHsContext RdrName, LHsContext RdrName, LHsType RdrName) }
ptype :: { Located ([AddAnn]
,( HsExplicitFlag, [LHsTyVarBndr RdrName], LHsContext RdrName
, LHsContext RdrName, LHsType RdrName)) }
: 'forall' tv_bndrs '.' ptype
{% do { hintExplicitForall (getLoc $1)
; let (_, qtvs', prov, req, ty) = unLoc $4
; return $ sLL $1 $> (Explicit, $2 ++ qtvs', prov, req ,ty) }}
; let (_, qtvs', prov, req, ty) = snd $ unLoc $4
; return $ sLL $1 $>
((mj AnnForall $1:mj AnnDot $3:(fst $ unLoc $4))
,(Explicit, $2 ++ qtvs', prov, req ,ty)) }}
| context '=>' context '=>' type
{ sLL $1 $> (Implicit, [], $1, $3, $5) }
{ sLL $1 $> ([mj AnnDarrow $2,mj AnnDarrow $4]
,(Implicit, [], $1, $3, $5)) }
| context '=>' type
{ sLL $1 $> (Implicit, [], $1, noLoc [], $3) }
{ sLL $1 $> ([mj AnnDarrow $2],(Implicit, [], $1, noLoc [], $3)) }
| type
{ sL1 $1 (Implicit, [], noLoc [], noLoc [], $1) }
{ sL1 $1 ([],(Implicit, [], noLoc [], noLoc [], $1)) }
-----------------------------------------------------------------------------
-- Nested declarations
......@@ -1051,10 +1073,10 @@ decl_cls : at_decl_cls { sLL $1 $> (unitOL $1) }
[mj AnnDefault $1,mj AnnDcolon $3] } }
decls_cls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
: decls_cls ';' decl_cls {% addAnnotation (gl $3) AnnSemi (gl $2)
: decls_cls ';' decl_cls {% addAnnotation (oll (unLoc $1)) AnnSemi (gl $2)
>> return (sLL $1 $> ((unLoc $1) `appOL`
unLoc $3)) }
| decls_cls ';' {% addAnnotation (gl $1) AnnSemi (gl $2)
| decls_cls ';' {% addAnnotation (oll (unLoc $1)) AnnSemi (gl $2)
>> return (sLL $1 $> (unLoc $1)) }
| decl_cls { $1 }
| {- empty -} { noLoc nilOL }
......@@ -1083,10 +1105,10 @@ decl_inst : at_decl_inst { sLL $1 $> (unitOL (sL1 $1 (InstD (unLo
| decl { $1 }
decls_inst :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
: decls_inst ';' decl_inst {% addAnnotation (gl $3) AnnSemi (gl $2)
: decls_inst ';' decl_inst {% addAnnotation (oll $ unLoc $1) AnnSemi (gl $2)
>> return
(sLL $1 $> ((unLoc $1) `appOL` unLoc $3)) }
| decls_inst ';' {% addAnnotation (gl $1) AnnSemi (gl $2)
| decls_inst ';' {% addAnnotation (oll $ unLoc $1) AnnSemi (gl $2)
>> return (sLL $1 $> (unLoc $1)) }
| decl_inst { $1 }
| {- empty -} { noLoc nilOL }
......@@ -1110,14 +1132,14 @@ where_inst :: { Located ([AddAnn]
-- Declarations in binding groups other than classes and instances
--
decls :: { Located (OrdList (LHsDecl RdrName)) }
: decls ';' decl {% addAnnotation (gl $3) AnnSemi (gl $2)
: decls ';' decl {% addAnnotation (oll $ unLoc $1) AnnSemi (gl $2)
>> return (
let { this = unLoc $3;
rest = unLoc $1;
these = rest `appOL` this }
in rest `seq` this `seq` these `seq`
sLL $1 $> these) }
| decls ';' {% addAnnotation (gl $1) AnnSemi (gl $2)
| decls ';' {% addAnnotation (oll $ unLoc $1) AnnSemi (gl $2)
>> return (sLL $1 $> (unLoc $1)) }
| decl { $1 }
| {- empty -} { noLoc nilOL }
......@@ -1156,7 +1178,7 @@ wherebinds :: { Located ([AddAnn],HsLocalBinds RdrName) }
-- Transformation Rules
rules :: { OrdList (LHsDecl RdrName) }
: rules ';' rule {% addAnnotation (gl $3) AnnSemi (gl $2)
: rules ';' rule {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return ($1 `snocOL` $3) }
| rules ';' {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return $1 }
......@@ -1203,7 +1225,7 @@ rule_var :: { LRuleBndr RdrName }
-- Warnings and deprecations (c.f. rules)
warnings :: { OrdList (LHsDecl RdrName) }
: warnings ';' warning {% addAnnotation (oll $3) AnnSemi (gl $2)
: warnings ';' warning {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return ($1 `appOL` $3) }
| warnings ';' {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return $1 }
......@@ -1218,7 +1240,7 @@ warning :: { OrdList (LHsDecl RdrName) }
deprecations :: { OrdList (LHsDecl RdrName) }
: deprecations ';' deprecation
{% addAnnotation (oll $3) AnnSemi (gl $2)
{% addAnnotation (oll $1) AnnSemi (gl $2)
>> return ($1 `appOL` $3) }
| deprecations ';' {% addAnnotation (oll $1) AnnSemi (gl $2)
>> return $1 }
......@@ -1346,7 +1368,7 @@ ctype :: { LHsType RdrName }
$1 $3)
[mj AnnDarrow $2] }
| ipvar '::' type {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
[mj AnnDcolon $2] }
[mj AnnVal $1,mj AnnDcolon $2] }
| type { $1 }
----------------------
......@@ -1803,8 +1825,10 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
[mj AnnComma $2,mj AnnDcolon $4] } }
| infix prec ops
{ sLL $1 $> $ toOL [ sLL $1 $> $ SigD
(FixSig (FixitySig (fromOL $ unLoc $3) (Fixity $2 (unLoc $1)))) ] }
{% ams (sLL $1 $> $ toOL [ sLL $1 $> $ SigD
(FixSig (FixitySig (fromOL $ unLoc $3)
(Fixity (unLoc $2) (unLoc $1)))) ])
[mj AnnInfix $1,mj AnnVal $2] }
| pattern_synonym_sig { sLL $1 $> $ unitOL $ sLL $1 $> . SigD . unLoc $ $1 }
......@@ -1813,8 +1837,6 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
(mkInlinePragma (getINLINE $1) (snd $2)))))
(mo $1:mc $4:fst $2) }
-- AZ TODO: adjust hsSyn so all the SpecSig from a single SPECIALISE
-- pragma is kept together
| '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
{% ams (
let inl_prag = mkInlinePragma (EmptyInlineSpec, FunLike) (snd $2)
......@@ -2961,6 +2983,7 @@ aa :: Located a -> (AnnKeywordId,Located c) -> P (Located a)
aa a@(L l _) (b,s) = addAnnotation l b (gl s) >> return a
-- |Add an annotation to a located element resulting from a monadic action
am :: P (Located a) -> (AnnKeywordId, Located b) -> P (Located a)
am a (b,s) = do
av@(L l _) <- a
addAnnotation l b (gl s)
......@@ -2984,6 +3007,7 @@ amsu :: Located a -> [AddAnn] -> P (OrdList (Located a))
amsu a@(L l _) bs = (mapM_ (\a -> a l) bs) >> return (unitOL a)
-- |Synonyms for AddAnn versions of AnnOpen and AnnClose
mo,mc :: Located Token -> SrcSpan -> P ()
mo ll = mj AnnOpen ll
mc ll = mj AnnClose ll
......@@ -2993,9 +3017,13 @@ mcommas :: [SrcSpan] -> [AddAnn]
mcommas ss = map (\s -> mj AnnComma (L s ())) ss
-- |Add the annotation to an AST element wrapped in a Just
ajl :: Located (Maybe (Located a)) -> AnnKeywordId -> SrcSpan
-> P (Located (Maybe (Located a)))
ajl a@(L _ (Just (L l _))) b s = addAnnotation l b s >> return a
-- |Add all [AddAnn] to an AST element wrapped in a Just
aljs :: Located (Maybe (Located a)) -> [AddAnn]
-> P (Located (Maybe (Located a)))
aljs a@(L _ (Just (L l _))) bs = (mapM_ (\a -> a l) bs) >> return a
-- |Add all [AddAnn] to an AST element wrapped in a Just
......@@ -3006,4 +3034,11 @@ oll :: OrdList (Located a) -> SrcSpan
oll l = case fromOL l of
[] -> noSrcSpan
xs -> getLoc (last xs)
-- |Add a semicolon annotation in the right place in a list. If the
-- leading list is empty, add it to the tail
asl :: [Located a] -> Located b -> Located a -> P()
asl [] (L ls _) (L l _) = addAnnotation l AnnSemi ls
asl (x:_xs) (L ls _) _x = addAnnotation (getLoc x) AnnSemi ls
}
......@@ -1296,9 +1296,9 @@ cmdStmtFail loc e = parseErrorSDoc loc
---------------------------------------------------------------------------
-- Miscellaneous utilities
checkPrecP :: Located Int -> P Int
checkPrecP :: Located Int -> P (Located Int)
checkPrecP (L l i)
| 0 <= i && i <= maxPrecedence = return i
| 0 <= i && i <= maxPrecedence = return (L l i)
| otherwise
= parseErrorSDoc l (text ("Precedence out of range: " ++ show i))
......
......@@ -35,18 +35,18 @@
(AK AnnotationLet.hs:7:9-15 AnnFunId = [AnnotationLet.hs:7:9])
(AK AnnotationLet.hs:7:9-15 AnnSemi = [AnnotationLet.hs:8:9])
(AK AnnotationLet.hs:8:9-15 AnnEqual = [AnnotationLet.hs:8:13])
(AK AnnotationLet.hs:8:9-15 AnnFunId = [AnnotationLet.hs:8:9])
(AK AnnotationLet.hs:8:9-15 AnnSemi = [AnnotationLet.hs:8:9])
(AK AnnotationLet.hs:8:9-15 AnnSemi = [AnnotationLet.hs:9:9])
(AK AnnotationLet.hs:9:9-13 AnnEqual = [AnnotationLet.hs:9:11])
(AK AnnotationLet.hs:9:9-13 AnnFunId = [AnnotationLet.hs:9:9])
(AK AnnotationLet.hs:9:9-13 AnnSemi = [AnnotationLet.hs:9:9])
(AK <no location info> AnnEofPos = [AnnotationLet.hs:13:1])
]
......
[
( CommentsTest.hs:9:1-33 =
[(CommentsTest.hs:9:1-33,AnnDocCommentNext " The function @foo@ does blah")])
( CommentsTest.hs:(10,7)-(13,14) =
[(CommentsTest.hs:12:15-24,AnnLineComment "-- value 2")])
( <no location info> =
[(CommentsTest.hs:9:1-33,AnnDocCommentNext " The function @foo@ does blah"),
(CommentsTest.hs:(3,1)-(5,2),AnnBlockComment "\nAn opening comment\n"),
[(CommentsTest.hs:(3,1)-(5,2),AnnBlockComment "\nAn opening comment\n"),
(CommentsTest.hs:1:1-31,AnnBlockComment "# LANGUAGE DeriveFoldable #")])
]
......
......@@ -39,6 +39,8 @@
(AK AnnotationTuple.hs:(7,1)-(10,14) AnnFunId = [AnnotationTuple.hs:7:1-3])
(AK AnnotationTuple.hs:(7,1)-(10,14) AnnSemi = [AnnotationTuple.hs:12:1])
(AK AnnotationTuple.hs:(7,7)-(10,14) AnnIn = [AnnotationTuple.hs:10:7-8])
(AK AnnotationTuple.hs:(7,7)-(10,14) AnnLet = [AnnotationTuple.hs:7:7-9])
......@@ -47,17 +49,17 @@
(AK AnnotationTuple.hs:8:9-13 AnnFunId = [AnnotationTuple.hs:8:9])
(AK AnnotationTuple.hs:8:9-13 AnnSemi = [AnnotationTuple.hs:9:9])
(AK AnnotationTuple.hs:9:9-13 AnnEqual = [AnnotationTuple.hs:9:11])
(AK AnnotationTuple.hs:9:9-13 AnnFunId = [AnnotationTuple.hs:9:9])
(AK AnnotationTuple.hs:9:9-13 AnnSemi = [AnnotationTuple.hs:9:9])
(AK AnnotationTuple.hs:13:1-72 AnnEqual = [AnnotationTuple.hs:13:5])
(AK AnnotationTuple.hs:13:1-72 AnnFunId = [AnnotationTuple.hs:13:1-3])
(AK AnnotationTuple.hs:13:1-72 AnnSemi = [AnnotationTuple.hs:12:1])
(AK AnnotationTuple.hs:13:1-72 AnnSemi = [AnnotationTuple.hs:14:1])
(AK AnnotationTuple.hs:13:19-53 AnnClose = [AnnotationTuple.hs:13:53])
......@@ -95,8 +97,6 @@
(AK AnnotationTuple.hs:15:1-41 AnnFunId = [AnnotationTuple.hs:15:1-3])
(AK AnnotationTuple.hs:15:1-41 AnnSemi = [AnnotationTuple.hs:14:1])
(AK AnnotationTuple.hs:15:7-27 AnnClose = [AnnotationTuple.hs:15:27])
(AK AnnotationTuple.hs:15:7-27 AnnOpen = [AnnotationTuple.hs:15:7])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment