Commit 8aefc9b7 authored by Alan Zimmerman's avatar Alan Zimmerman Committed by Austin Seipp

parser: opt_kind_sig has incorrect SrcSpan

The production for opt_kind_sig is

  opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) }
          :                             { noLoc Nothing }
          | '::' kind                   {% ajl (sLL $1 $> (Just $2)) AnnDcolon (gl $1) }

The outer Location is used only to get the full span for the enclosing
declration, and is then stripped. The inner LHsKind then has a SrcSpan that does
not include the '::'

Extend the SrcSpan on $2 to include $1

Reviewed By: austin

Differential Revision: https://phabricator.haskell.org/D813

GHC Trac Issues: #10209
parent 6109b312
......@@ -464,7 +464,8 @@ data TyClDecl name
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
-- 'ApiAnnotation.AnnData',
-- 'ApiAnnotation.AnnFamily','ApiAnnotation.AnnWhere',
-- 'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',
-- 'ApiAnnotation.AnnWhere',
-- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnDcolon',
-- 'ApiAnnotation.AnnClose'
......@@ -488,7 +489,8 @@ data TyClDecl name
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
-- 'ApiAnnotation.AnnFamily',
-- 'ApiAnnotation.AnnNewType',
-- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnWhere'
-- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
-- 'ApiAnnotation.AnnWhere',
-- For details on above see note [Api annotations] in ApiAnnotation
DataDecl { tcdLName :: Located name -- ^ Type constructor
......@@ -1091,6 +1093,7 @@ data DataFamInstDecl name
-- ^
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
-- 'ApiAnnotation.AnnNewType','ApiAnnotation.AnnInstance',
-- 'ApiAnnotation.AnnDcolon'
-- 'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
-- 'ApiAnnotation.AnnClose'
......
......@@ -122,6 +122,9 @@ type LHsType name = Located (HsType name)
-- For details on above see note [Api annotations] in ApiAnnotation
type HsKind name = HsType name
type LHsKind name = Located (HsKind name)
-- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
-- For details on above see note [Api annotations] in ApiAnnotation
--------------------------------------------------
-- LHsTyVarBndrs
......
......@@ -927,8 +927,8 @@ ty_decl :: { LTyClDecl RdrName }
-- Note the use of type for the head; this allows
-- infix type constructors to be declared
{% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $5) $3
(unLoc $4))
(mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $5)) }
(snd $ unLoc $4))
(mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)++(fst $ unLoc $5)) }
-- ordinary data type or newtype declaration
| data_or_newtype capi_ctype tycl_hdr constrs deriving
......@@ -944,15 +944,15 @@ ty_decl :: { LTyClDecl RdrName }
gadt_constrlist
deriving
{% amms (mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
(unLoc $4) (snd $ unLoc $5) (unLoc $6) )
(snd $ unLoc $4) (snd $ unLoc $5) (unLoc $6) )
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
((fst $ unLoc $1):(fst $ unLoc $5)) }
((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
-- data/newtype family
| 'data' 'family' type opt_kind_sig
{% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (unLoc $4))
[mj AnnData $1,mj AnnFamily $2] }
{% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (snd $ unLoc $4))
(mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
inst_decl :: { LInstDecl RdrName }
: 'instance' overlap_pragma inst_type where_inst
......@@ -987,9 +987,9 @@ inst_decl :: { LInstDecl RdrName }
gadt_constrlist
deriving
{% amms (mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 $4
(unLoc $5) (snd $ unLoc $6) (unLoc $7))
(snd $ unLoc $5) (snd $ unLoc $6) (unLoc $7))
((fst $ unLoc $1):mj AnnInstance $2
:(fst $ unLoc $6)) }
:(fst $ unLoc $5)++(fst $ unLoc $6)) }
overlap_pragma :: { Maybe (Located OverlapMode) }
: '{-# OVERLAPPABLE' '#-}' {% ajs (Just (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1))))
......@@ -1049,19 +1049,19 @@ at_decl_cls :: { LHsDecl RdrName }
: -- data family declarations, with optional 'family' keyword
'data' opt_family type opt_kind_sig
{% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily $3
(unLoc $4)))
(mj AnnData $1:$2) }
(snd $ unLoc $4)))
(mj AnnData $1:$2++(fst $ unLoc $4)) }
-- type family declarations, with optional 'family' keyword
-- (can't use opt_instance because you get shift/reduce errors
| 'type' type opt_kind_sig
{% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $2 $3)
OpenTypeFamily $2 (unLoc $3)))
[mj AnnType $1] }
OpenTypeFamily $2 (snd $ unLoc $3)))
(mj AnnType $1:(fst $ unLoc $3)) }
| 'type' 'family' type opt_kind_sig
{% amms (liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4)
OpenTypeFamily $3 (unLoc $4)))
[mj AnnType $1,mj AnnFamily $2] }
OpenTypeFamily $3 (snd $ unLoc $4)))
(mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)) }
-- default type instances, with optional 'instance' keyword
| 'type' ty_fam_inst_eqn
......@@ -1097,16 +1097,16 @@ at_decl_inst :: { LInstDecl RdrName }
gadt_constrlist
deriving
{% amms (mkDataFamInst (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2
$3 (unLoc $4) (snd $ unLoc $5) (unLoc $6))
((fst $ unLoc $1):(fst $ unLoc $5)) }
$3 (snd $ unLoc $4) (snd $ unLoc $5) (unLoc $6))
((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }
data_or_newtype :: { Located (AddAnn,NewOrData) }
: 'data' { sL1 $1 (mj AnnData $1,DataType) }
| 'newtype' { sL1 $1 (mj AnnNewtype $1,NewType) }
opt_kind_sig :: { Located (Maybe (LHsKind RdrName)) }
: { noLoc Nothing }
| '::' kind {% ajl (sLL $1 $> (Just $2)) AnnDcolon (gl $1) }
opt_kind_sig :: { Located ([AddAnn],Maybe (LHsKind RdrName)) }
: { noLoc ([],Nothing) }
| '::' kind { sLL $1 $> ([mj AnnDcolon $1],Just ($2)) }
-- tycl_hdr parses the header of a class or data type decl,
-- which takes the form
......
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TupleSections,TypeFamilies #-}
module AnnotationTuple (foo) where
{
......@@ -13,6 +13,9 @@ foo = let
bar = print $ map (1, "hello" , 6.5,, [5, 5, 6, 7]) [Just (), Nothing]
;
baz = (1, "hello", 6.5,,,,) 'a' (Just ())
;
data family GMap k :: * -> *
}
-- Note: the trailing whitespace in this file is used to check that we
-- have an annotation for it.
......
......@@ -2,12 +2,12 @@
[
(AK AnnotationTuple.hs:13:39 AnnComma = [AnnotationTuple.hs:13:39])
(AK <no location info> AnnEofPos = [AnnotationTuple.hs:21:1])
(AK <no location info> AnnEofPos = [AnnotationTuple.hs:24:1])
]
--------------------------------
[
(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:16:1])
(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:19:1])
(AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:2:1-6])
......@@ -95,6 +95,8 @@
(AK AnnotationTuple.hs:15:1-41 AnnFunId = [AnnotationTuple.hs:15:1-3])
(AK AnnotationTuple.hs:15:1-41 AnnSemi = [AnnotationTuple.hs:16:1])
(AK AnnotationTuple.hs:15:7-27 AnnCloseP = [AnnotationTuple.hs:15:27])
(AK AnnotationTuple.hs:15:7-27 AnnOpenP = [AnnotationTuple.hs:15:7])
......@@ -119,6 +121,14 @@
(AK AnnotationTuple.hs:15:39-40 AnnOpenP = [AnnotationTuple.hs:15:39])
(AK <no location info> AnnEofPos = [AnnotationTuple.hs:21:1])
(AK AnnotationTuple.hs:18:1-28 AnnData = [AnnotationTuple.hs:18:1-4])
(AK AnnotationTuple.hs:18:1-28 AnnDcolon = [AnnotationTuple.hs:18:20-21])
(AK AnnotationTuple.hs:18:1-28 AnnFamily = [AnnotationTuple.hs:18:6-11])
(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26])
(AK <no location info> AnnEofPos = [AnnotationTuple.hs:24:1])
]
......@@ -11,7 +11,7 @@
(AnnotationTuple.hs:15:25, [m], ()),
(AnnotationTuple.hs:15:26, [m], ())]
[
(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:16:1])
(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:19:1])
(AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:2:1-6])
......@@ -99,6 +99,8 @@
(AK AnnotationTuple.hs:15:1-41 AnnFunId = [AnnotationTuple.hs:15:1-3])
(AK AnnotationTuple.hs:15:1-41 AnnSemi = [AnnotationTuple.hs:16:1])
(AK AnnotationTuple.hs:15:7-27 AnnCloseP = [AnnotationTuple.hs:15:27])
(AK AnnotationTuple.hs:15:7-27 AnnOpenP = [AnnotationTuple.hs:15:7])
......@@ -123,6 +125,14 @@
(AK AnnotationTuple.hs:15:39-40 AnnOpenP = [AnnotationTuple.hs:15:39])
(AK <no location info> AnnEofPos = [AnnotationTuple.hs:21:1])
(AK AnnotationTuple.hs:18:1-28 AnnData = [AnnotationTuple.hs:18:1-4])
(AK AnnotationTuple.hs:18:1-28 AnnDcolon = [AnnotationTuple.hs:18:20-21])
(AK AnnotationTuple.hs:18:1-28 AnnFamily = [AnnotationTuple.hs:18:6-11])
(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26])
(AK <no location info> AnnEofPos = [AnnotationTuple.hs:24:1])
]
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