summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2015-11-16 19:43:34 +0200
committerAlan Zimmerman <alan.zimm@gmail.com>2015-11-16 19:43:34 +0200
commitfe95463bdf42651d53d1edc7723491664257cc5a (patch)
treef43452b6cbe66b0d83e0a9fa65b83a5f05989833
parent46a03fbec6a02761db079d1746532565f34c340f (diff)
downloadhaskell-fe95463bdf42651d53d1edc7723491664257cc5a.tar.gz
ApiAnnotations: Add SourceText for unicode tokens
Summary: At the moment there is no way to tell if a given token used its unicode variant or its normal one, except to look at the length of the token. This fails for the unicode '*'. Expose the original source text for unicode variants so that API Annotations can capture them specifically. Test Plan: ./validate Reviewers: mpickering, austin, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1473 GHC Trac Issues: #11018
Diffstat
-rw-r--r--compiler/parser/ApiAnnotation.hs40
-rw-r--r--compiler/parser/Lexer.x100
-rw-r--r--compiler/parser/Parser.y161
-rw-r--r--testsuite/tests/ghc-api/annotations-literals/literals.stdout8
-rw-r--r--testsuite/tests/ghc-api/annotations/Makefile4
-rw-r--r--testsuite/tests/ghc-api/annotations/T10307.stdout1
-rw-r--r--testsuite/tests/ghc-api/annotations/T10312.stdout2
-rw-r--r--testsuite/tests/ghc-api/annotations/T10357.stdout1
-rw-r--r--testsuite/tests/ghc-api/annotations/T10358.stdout5
-rw-r--r--testsuite/tests/ghc-api/annotations/T11018.stderr40
-rw-r--r--testsuite/tests/ghc-api/annotations/T11018.stdout203
-rw-r--r--testsuite/tests/ghc-api/annotations/Test11018.hs52
-rw-r--r--testsuite/tests/ghc-api/annotations/all.T1
-rw-r--r--testsuite/tests/ghc-api/annotations/exampleTest.stdout2
-rw-r--r--testsuite/tests/ghc-api/annotations/listcomps.stdout2
-rw-r--r--testsuite/tests/ghc-api/annotations/parseTree.stdout4
16 files changed, 505 insertions, 121 deletions
diff --git a/compiler/parser/ApiAnnotation.hs b/compiler/parser/ApiAnnotation.hs
index 7376e305ea..c5ba4535b7 100644
--- a/compiler/parser/ApiAnnotation.hs
+++ b/compiler/parser/ApiAnnotation.hs
@@ -7,6 +7,8 @@ module ApiAnnotation (
ApiAnnKey,
AnnKeywordId(..),
AnnotationComment(..),
+ IsUnicodeSyntax(..),
+ unicodeAnn,
LRdrName -- Exists for haddocks only
) where
@@ -198,8 +200,10 @@ data AnnKeywordId
| AnnComma -- ^ as a list separator
| AnnCommaTuple -- ^ in a RdrName for a tuple
| AnnDarrow -- ^ '=>'
+ | AnnDarrowU -- ^ '=>', unicode variant
| AnnData
| AnnDcolon -- ^ '::'
+ | AnnDcolonU -- ^ '::', unicode variant
| AnnDefault
| AnnDeriving
| AnnDo
@@ -210,6 +214,7 @@ data AnnKeywordId
| AnnExport
| AnnFamily
| AnnForall
+ | AnnForallU -- ^ Unicode variant
| AnnForeign
| AnnFunId -- ^ for function name in matches where there are
-- multiple equations for the function.
@@ -223,6 +228,7 @@ data AnnKeywordId
| AnnInstance
| AnnLam
| AnnLarrow -- ^ '<-'
+ | AnnLarrowU -- ^ '<-', unicode variant
| AnnLet
| AnnMdo
| AnnMinus -- ^ '-'
@@ -241,9 +247,12 @@ data AnnKeywordId
| AnnProc
| AnnQualified
| AnnRarrow -- ^ '->'
+ | AnnRarrowU -- ^ '->', unicode variant
| AnnRec
| AnnRole
| AnnSafe
+ | AnnStar -- ^ '*'
+ | AnnStarU -- ^ '*', unicode variant.
| AnnSemi -- ^ ';'
| AnnSimpleQuote -- ^ '''
| AnnStatic -- ^ 'static'
@@ -261,11 +270,15 @@ data AnnKeywordId
| AnnVbar -- ^ '|'
| AnnWhere
| Annlarrowtail -- ^ '-<'
+ | AnnlarrowtailU -- ^ '-<', unicode variant
| Annrarrowtail -- ^ '->'
+ | AnnrarrowtailU -- ^ '->', unicode variant
| AnnLarrowtail -- ^ '-<<'
+ | AnnLarrowtailU -- ^ '-<<', unicode variant
| AnnRarrowtail -- ^ '>>-'
+ | AnnRarrowtailU -- ^ '>>-', unicode variant
| AnnEofPos
- deriving (Eq,Ord,Data,Typeable,Show)
+ deriving (Eq, Ord, Data, Typeable, Show)
instance Outputable AnnKeywordId where
ppr x = text (show x)
@@ -282,7 +295,7 @@ data AnnotationComment =
| AnnDocOptionsOld String -- ^ doc options declared "-- # ..."-style
| AnnLineComment String -- ^ comment starting by "--"
| AnnBlockComment String -- ^ comment in {- -}
- deriving (Eq,Ord,Data,Typeable,Show)
+ deriving (Eq, Ord, Data, Typeable, Show)
-- Note: these are based on the Token versions, but the Token type is
-- defined in Lexer.x and bringing it in here would create a loop
@@ -295,3 +308,26 @@ instance Outputable AnnotationComment where
-- 'ApiAnnotation.AnnTilde'
-- - May have 'ApiAnnotation.AnnComma' when in a list
type LRdrName = Located RdrName
+
+
+-- | Certain tokens can have alternate representations when unicode syntax is
+-- enabled. This flag is attached to those tokens in the lexer so that the
+-- original source representation can be reproduced in the corresponding
+-- 'ApiAnnotation'
+data IsUnicodeSyntax = UnicodeSyntax | NormalSyntax
+ deriving (Eq, Ord, Data, Typeable, Show)
+
+-- | Convert a normal annotation into its unicode equivalent one
+unicodeAnn :: AnnKeywordId -> AnnKeywordId
+unicodeAnn AnnForall = AnnForallU
+unicodeAnn AnnDcolon = AnnDcolonU
+unicodeAnn AnnLarrow = AnnLarrowU
+unicodeAnn AnnRarrow = AnnRarrowU
+unicodeAnn AnnDarrow = AnnDarrowU
+unicodeAnn Annlarrowtail = AnnLarrowtailU
+unicodeAnn Annrarrowtail = AnnrarrowtailU
+unicodeAnn AnnLarrowtail = AnnLarrowtailU
+unicodeAnn AnnRarrowtail = AnnRarrowtailU
+unicodeAnn AnnStar = AnnStarU
+unicodeAnn ann = ann
+-- What about '*'?
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index acb6893b66..0bf26ce8de 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -535,7 +535,7 @@ data Token
| ITtype
| ITwhere
- | ITforall -- GHC extension keywords
+ | ITforall IsUnicodeSyntax -- GHC extension keywords
| ITexport
| ITlabel
| ITdynamic
@@ -587,20 +587,20 @@ data Token
| ITdotdot -- reserved symbols
| ITcolon
- | ITdcolon
+ | ITdcolon IsUnicodeSyntax
| ITequal
| ITlam
| ITlcase
| ITvbar
- | ITlarrow
- | ITrarrow
+ | ITlarrow IsUnicodeSyntax
+ | ITrarrow IsUnicodeSyntax
| ITat
| ITtilde
| ITtildehsh
- | ITdarrow
+ | ITdarrow IsUnicodeSyntax
| ITminus
| ITbang
- | ITstar
+ | ITstar IsUnicodeSyntax
| ITdot
| ITbiglam -- GHC-extension symbols
@@ -671,15 +671,15 @@ data Token
-- Arrow notation extension
| ITproc
| ITrec
- | IToparenbar -- (|
- | ITcparenbar -- |)
- | ITlarrowtail -- -<
- | ITrarrowtail -- >-
- | ITLarrowtail -- -<<
- | ITRarrowtail -- >>-
+ | IToparenbar -- (|
+ | ITcparenbar -- |)
+ | ITlarrowtail IsUnicodeSyntax -- -<
+ | ITrarrowtail IsUnicodeSyntax -- >-
+ | ITLarrowtail IsUnicodeSyntax -- -<<
+ | ITRarrowtail IsUnicodeSyntax -- >>-
- | ITunknown String -- Used when the lexer can't make sense of it
- | ITeof -- end of file token
+ | ITunknown String -- Used when the lexer can't make sense of it
+ | ITeof -- end of file token
-- Documentation annotations
| ITdocCommentNext String -- something beginning '-- |'
@@ -733,7 +733,8 @@ reservedWordsFM = listToUFM $
( "type", ITtype, 0 ),
( "where", ITwhere, 0 ),
- ( "forall", ITforall, xbit ExplicitForallBit .|.
+ ( "forall", ITforall NormalSyntax,
+ xbit ExplicitForallBit .|.
xbit InRulePragBit),
( "mdo", ITmdo, xbit RecursiveDoBit),
-- See Note [Lexing type pseudo-keywords]
@@ -784,44 +785,49 @@ a key detail to make all this work.
reservedSymsFM :: UniqFM (Token, ExtsBitmap -> Bool)
reservedSymsFM = listToUFM $
map (\ (x,y,z) -> (mkFastString x,(y,z)))
- [ ("..", ITdotdot, always)
+ [ ("..", ITdotdot, always)
-- (:) is a reserved op, meaning only list cons
- ,(":", ITcolon, always)
- ,("::", ITdcolon, always)
- ,("=", ITequal, always)
- ,("\\", ITlam, always)
- ,("|", ITvbar, always)
- ,("<-", ITlarrow, always)
- ,("->", ITrarrow, always)
- ,("@", ITat, always)
- ,("~", ITtilde, always)
- ,("~#", ITtildehsh, magicHashEnabled)
- ,("=>", ITdarrow, always)
- ,("-", ITminus, always)
- ,("!", ITbang, always)
+ ,(":", ITcolon, always)
+ ,("::", ITdcolon NormalSyntax, always)
+ ,("=", ITequal, always)
+ ,("\\", ITlam, always)
+ ,("|", ITvbar, always)
+ ,("<-", ITlarrow NormalSyntax, always)
+ ,("->", ITrarrow NormalSyntax, always)
+ ,("@", ITat, always)
+ ,("~", ITtilde, always)
+ ,("~#", ITtildehsh, magicHashEnabled)
+ ,("=>", ITdarrow NormalSyntax, always)
+ ,("-", ITminus, always)
+ ,("!", ITbang, always)
-- For data T (a::*) = MkT
- ,("*", ITstar, always) -- \i -> kindSigsEnabled i || tyFamEnabled i)
+ ,("*", ITstar NormalSyntax, always)
+ -- \i -> kindSigsEnabled i || tyFamEnabled i)
-- For 'forall a . t'
,(".", ITdot, always) -- \i -> explicitForallEnabled i || inRulePrag i)
- ,("-<", ITlarrowtail, arrowsEnabled)
- ,(">-", ITrarrowtail, arrowsEnabled)
- ,("-<<", ITLarrowtail, arrowsEnabled)
- ,(">>-", ITRarrowtail, arrowsEnabled)
-
- ,("∷", ITdcolon, unicodeSyntaxEnabled)
- ,("⇒", ITdarrow, unicodeSyntaxEnabled)
- ,("∀", ITforall, unicodeSyntaxEnabled)
- ,("→", ITrarrow, unicodeSyntaxEnabled)
- ,("←", ITlarrow, unicodeSyntaxEnabled)
-
- ,("⤙", ITlarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
- ,("⤚", ITrarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
- ,("⤛", ITLarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
- ,("⤜", ITRarrowtail, \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
-
- ,("★", ITstar, unicodeSyntaxEnabled)
+ ,("-<", ITlarrowtail NormalSyntax, arrowsEnabled)
+ ,(">-", ITrarrowtail NormalSyntax, arrowsEnabled)
+ ,("-<<", ITLarrowtail NormalSyntax, arrowsEnabled)
+ ,(">>-", ITRarrowtail NormalSyntax, arrowsEnabled)
+
+ ,("∷", ITdcolon UnicodeSyntax, unicodeSyntaxEnabled)
+ ,("⇒", ITdarrow UnicodeSyntax, unicodeSyntaxEnabled)
+ ,("∀", ITforall UnicodeSyntax, unicodeSyntaxEnabled)
+ ,("→", ITrarrow UnicodeSyntax, unicodeSyntaxEnabled)
+ ,("←", ITlarrow UnicodeSyntax, unicodeSyntaxEnabled)
+
+ ,("⤙", ITlarrowtail UnicodeSyntax,
+ \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
+ ,("⤚", ITrarrowtail UnicodeSyntax,
+ \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
+ ,("⤛", ITLarrowtail UnicodeSyntax,
+ \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
+ ,("⤜", ITRarrowtail UnicodeSyntax,
+ \i -> unicodeSyntaxEnabled i && arrowsEnabled i)
+
+ ,("★", ITstar UnicodeSyntax, unicodeSyntaxEnabled)
-- ToDo: ideally, → and ∷ should be "specials", so that they cannot
-- form part of a large operator. This would let us have a better
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index a74d7a8b95..bf6e753d57 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -350,7 +350,7 @@ output it generates.
'type' { L _ ITtype }
'where' { L _ ITwhere }
- 'forall' { L _ ITforall } -- GHC extension keywords
+ 'forall' { L _ (ITforall _) } -- GHC extension keywords
'foreign' { L _ ITforeign }
'export' { L _ ITexport }
'label' { L _ ITlabel }
@@ -400,24 +400,24 @@ output it generates.
'..' { L _ ITdotdot } -- reserved symbols
':' { L _ ITcolon }
- '::' { L _ ITdcolon }
+ '::' { L _ (ITdcolon _) }
'=' { L _ ITequal }
'\\' { L _ ITlam }
'lcase' { L _ ITlcase }
'|' { L _ ITvbar }
- '<-' { L _ ITlarrow }
- '->' { L _ ITrarrow }
+ '<-' { L _ (ITlarrow _) }
+ '->' { L _ (ITrarrow _) }
'@' { L _ ITat }
'~' { L _ ITtilde }
'~#' { L _ ITtildehsh }
- '=>' { L _ ITdarrow }
+ '=>' { L _ (ITdarrow _) }
'-' { L _ ITminus }
'!' { L _ ITbang }
- '*' { L _ ITstar }
- '-<' { L _ ITlarrowtail } -- for arrow notation
- '>-' { L _ ITrarrowtail } -- for arrow notation
- '-<<' { L _ ITLarrowtail } -- for arrow notation
- '>>-' { L _ ITRarrowtail } -- for arrow notation
+ '*' { L _ (ITstar _) }
+ '-<' { L _ (ITlarrowtail _) } -- for arrow notation
+ '>-' { L _ (ITrarrowtail _) } -- for arrow notation
+ '-<<' { L _ (ITLarrowtail _) } -- for arrow notation
+ '>>-' { L _ (ITRarrowtail _) } -- for arrow notation
'.' { L _ ITdot }
'{' { L _ ITocurly } -- special symbols
@@ -509,7 +509,7 @@ identifier :: { Located RdrName }
| qvarop { $1 }
| qconop { $1 }
| '(' '->' ')' {% ams (sLL $1 $> $ getRdrName funTyCon)
- [mj AnnOpenP $1,mj AnnRarrow $2,mj AnnCloseP $3] }
+ [mj AnnOpenP $1,mu AnnRarrow $2,mj AnnCloseP $3] }
-----------------------------------------------------------------------------
-- Module Header
@@ -948,7 +948,7 @@ opt_injective_info :: { Located ([AddAnn], Maybe (LInjectivityAnn RdrName)) }
injectivity_cond :: { Located ([AddAnn], LInjectivityAnn RdrName) }
: tyvarid '->' inj_varids
- { sLL $1 $> ( [mj AnnRarrow $2]
+ { sLL $1 $> ( [mu AnnRarrow $2]
, (sLL $1 $> (InjectivityAnn $1 (reverse (unLoc $3))))) }
inj_varids :: { Located [Located RdrName] }
@@ -1070,21 +1070,21 @@ data_or_newtype :: { Located (AddAnn, NewOrData) }
opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind RdrName)) }
: { noLoc ([] , Nothing) }
- | '::' kind { sLL $1 $> ([mj AnnDcolon $1], Just $2) }
+ | '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) }
opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig RdrName) }
: { noLoc ([] , noLoc NoSig )}
- | '::' kind { sLL $1 $> ([mj AnnDcolon $1], sLL $1 $> (KindSig $2))}
+ | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig $2))}
opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig RdrName) }
: { noLoc ([] , noLoc NoSig )}
- | '::' kind { sLL $1 $> ([mj AnnDcolon $1], sLL $1 $> (KindSig $2))}
+ | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig $2))}
| '=' tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig $2))}
opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig RdrName
, Maybe (LInjectivityAnn RdrName)))}
: { noLoc ([], (noLoc NoSig, Nothing)) }
- | '::' kind { sLL $1 $> ( [mj AnnDcolon $1]
+ | '::' kind { sLL $1 $> ( [mu AnnDcolon $1]
, (sLL $2 $> (KindSig $2), Nothing)) }
| '=' tv_bndr '|' injectivity_cond
{ sLL $1 $> ( mj AnnEqual $1 : mj AnnVbar $3 : fst (unLoc $4)
@@ -1098,7 +1098,7 @@ opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig RdrName
-- T Int [a] -- for associated types
-- Rather a lot of inlining here, else we get reduce/reduce errors
tycl_hdr :: { Located (Maybe (LHsContext RdrName), LHsType RdrName) }
- : context '=>' type {% addAnnotation (gl $1) AnnDarrow (gl $2)
+ : context '=>' type {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
>> (return (sLL $1 $> (Just $1, $3)))
}
| type { sL1 $1 (Nothing, $1) }
@@ -1162,13 +1162,13 @@ pattern_synonym_decl :: { LHsDecl RdrName }
| 'pattern' pattern_synonym_lhs '<-' pat
{% let (name, args, as) = $2 in
ams (sLL $1 $> . ValD $ mkPatSynBind name args $4 Unidirectional)
- (as ++ [mj AnnPattern $1,mj AnnLarrow $3]) }
+ (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) }
| 'pattern' pattern_synonym_lhs '<-' pat where_decls
{% do { let (name, args, as) = $2
; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
; ams (sLL $1 $> . ValD $
mkPatSynBind name args $4 (ExplicitBidirectional mg))
- (as ++ ((mj AnnPattern $1:mj AnnLarrow $3:(fst $ unLoc $5))) )
+ (as ++ ((mj AnnPattern $1:mu AnnLarrow $3:(fst $ unLoc $5))) )
}}
pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName), [AddAnn]) }
@@ -1196,7 +1196,7 @@ pattern_synonym_sig :: { LSig RdrName }
{% do { let (flag, qtvs, req, prov, ty) = snd $ unLoc $4
; let sig = PatSynSig $2 (flag, mkHsQTvs qtvs) req prov ty
; ams (sLL $1 $> $ sig)
- (mj AnnPattern $1:mj AnnDcolon $3:(fst $ unLoc $4)) } }
+ (mj AnnPattern $1:mu AnnDcolon $3:(fst $ unLoc $4)) } }
ptype :: { Located ([AddAnn]
,( HsExplicitFlag, [LHsTyVarBndr RdrName], LHsContext RdrName
@@ -1205,13 +1205,13 @@ ptype :: { Located ([AddAnn]
{% do { hintExplicitForall (getLoc $1)
; let (_, qtvs', prov, req, ty) = snd $ unLoc $4
; return $ sLL $1 $>
- ((mj AnnForall $1:mj AnnDot $3:(fst $ unLoc $4))
+ ((mu AnnForall $1:mj AnnDot $3:(fst $ unLoc $4))
,(Explicit, $2 ++ qtvs', prov, req ,ty)) }}
| context '=>' context '=>' type
- { sLL $1 $> ([mj AnnDarrow $2,mj AnnDarrow $4]
+ { sLL $1 $> ([mu AnnDarrow $2,mu AnnDarrow $4]
,(Implicit, [], $1, $3, $5)) }
| context '=>' type
- { sLL $1 $> ([mj AnnDarrow $2],(Implicit, [], $1, noLoc [], $3)) }
+ { sLL $1 $> ([mu AnnDarrow $2],(Implicit, [], $1, noLoc [], $3)) }
| type
{ sL1 $1 ([],(Implicit, [], noLoc [], noLoc [], $1)) }
@@ -1230,7 +1230,7 @@ decl_cls : at_decl_cls { $1 }
; let err = text "in default signature" <> colon <+>
quotes (ppr ty)
; ams (sLL $1 $> $ SigD (GenericSig l ty))
- [mj AnnDefault $1,mj AnnDcolon $3] } }
+ [mj AnnDefault $1,mu AnnDcolon $3] } }
decls_cls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) } -- Reversed
: decls_cls ';' decl_cls {% if isNilOL (snd $ unLoc $1)
@@ -1388,7 +1388,7 @@ rule_explicit_activation :: { ([AddAnn]
,NeverActive) }
rule_forall :: { ([AddAnn],[LRuleBndr RdrName]) }
- : 'forall' rule_var_list '.' { ([mj AnnForall $1,mj AnnDot $3],$2) }
+ : 'forall' rule_var_list '.' { ([mu AnnForall $1,mj AnnDot $3],$2) }
| {- empty -} { ([],[]) }
rule_var_list :: { [LRuleBndr RdrName] }
@@ -1399,7 +1399,7 @@ rule_var :: { LRuleBndr RdrName }
: varid { sLL $1 $> (RuleBndr $1) }
| '(' varid '::' ctype ')' {% ams (sLL $1 $> (RuleBndrSig $2
(mkHsWithBndrs $4)))
- [mop $1,mj AnnDcolon $3,mcp $5] }
+ [mop $1,mu AnnDcolon $3,mcp $5] }
-----------------------------------------------------------------------------
-- Warnings and deprecations (c.f. rules)
@@ -1491,10 +1491,10 @@ safety :: { Located Safety }
fspec :: { Located ([AddAnn]
,(Located StringLiteral, Located RdrName, LHsType RdrName)) }
- : STRING var '::' sigtypedoc { sLL $1 $> ([mj AnnDcolon $3]
+ : STRING var '::' sigtypedoc { sLL $1 $> ([mu AnnDcolon $3]
,(L (getLoc $1)
(getStringLiteral $1), $2, $4)) }
- | var '::' sigtypedoc { sLL $1 $> ([mj AnnDcolon $2]
+ | var '::' sigtypedoc { sLL $1 $> ([mu AnnDcolon $2]
,(noLoc (StringLiteral "" nilFS), $1, $3)) }
-- if the entity string is missing, it defaults to the empty string;
-- the meaning of an empty entity string depends on the calling
@@ -1505,11 +1505,11 @@ fspec :: { Located ([AddAnn]
opt_sig :: { ([AddAnn],Maybe (LHsType RdrName)) }
: {- empty -} { ([],Nothing) }
- | '::' sigtype { ([mj AnnDcolon $1],Just $2) }
+ | '::' sigtype { ([mu AnnDcolon $1],Just $2) }
opt_asig :: { ([AddAnn],Maybe (LHsType RdrName)) }
: {- empty -} { ([],Nothing) }
- | '::' atype { ([mj AnnDcolon $1],Just $2) }
+ | '::' atype { ([mu AnnDcolon $1],Just $2) }
sigtype :: { LHsType RdrName } -- Always a HsForAllTy,
-- to tell the renamer where to generalise
@@ -1556,12 +1556,12 @@ ctype :: { LHsType RdrName }
: 'forall' tv_bndrs '.' ctype {% hintExplicitForall (getLoc $1) >>
ams (sLL $1 $> $ mkExplicitHsForAllTy $2
(noLoc []) $4)
- [mj AnnForall $1,mj AnnDot $3] }
- | context '=>' ctype {% addAnnotation (gl $1) AnnDarrow (gl $2)
+ [mu AnnForall $1,mj AnnDot $3] }
+ | context '=>' ctype {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
>> return (sLL $1 $> $
mkQualifiedHsForAllTy $1 $3) }
| ipvar '::' type {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
- [mj AnnVal $1,mj AnnDcolon $2] }
+ [mj AnnVal $1,mu AnnDcolon $2] }
| type { $1 }
----------------------
@@ -1579,12 +1579,12 @@ ctypedoc :: { LHsType RdrName }
: 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
ams (sLL $1 $> $ mkExplicitHsForAllTy $2
(noLoc []) $4)
- [mj AnnForall $1,mj AnnDot $3] }
- | context '=>' ctypedoc {% addAnnotation (gl $1) AnnDarrow (gl $2)
+ [mu AnnForall $1,mj AnnDot $3] }
+ | context '=>' ctypedoc {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
>> return (sLL $1 $> $
mkQualifiedHsForAllTy $1 $3) }
| ipvar '::' type {% ams (sLL $1 $> (HsIParamTy (unLoc $1) $3))
- [mj AnnVal $1,mj AnnDcolon $2] }
+ [mj AnnVal $1,mu AnnDcolon $2] }
| typedoc { $1 }
----------------------
@@ -1611,9 +1611,9 @@ type :: { LHsType RdrName }
: btype { splitTilde $1 }
| btype qtyconop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
| btype tyvarop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
- | btype '->' ctype {% ams $1 [mj AnnRarrow $2]
+ | btype '->' ctype {% ams $1 [mu AnnRarrow $2]
>> ams (sLL $1 $> $ HsFunTy (splitTilde $1) $3)
- [mj AnnRarrow $2] }
+ [mu AnnRarrow $2] }
| btype SIMPLEQUOTE qconop type {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
[mj AnnSimpleQuote $2] }
| btype SIMPLEQUOTE varop type {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
@@ -1627,10 +1627,10 @@ typedoc :: { LHsType RdrName }
| btype tyvarop type { sLL $1 $> $ mkHsOpTy $1 $2 $3 }
| btype tyvarop type docprev { sLL $1 $> $ HsDocTy (L (comb3 $1 $2 $3) (mkHsOpTy $1 $2 $3)) $4 }
| btype '->' ctypedoc {% ams (sLL $1 $> $ HsFunTy (splitTilde $1) $3)
- [mj AnnRarrow $2] }
+ [mu AnnRarrow $2] }
| btype docprev '->' ctypedoc {% ams (sLL $1 $> $ HsFunTy (L (comb2 (splitTilde $1) $2)
(HsDocTy $1 $2)) $4)
- [mj AnnRarrow $3] }
+ [mu AnnRarrow $3] }
| btype SIMPLEQUOTE qconop type {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
[mj AnnSimpleQuote $2] }
| btype SIMPLEQUOTE varop type {% ams (sLL $1 $> $ mkHsOpTy $1 $3 $4)
@@ -1670,7 +1670,7 @@ atype :: { LHsType RdrName }
| '[:' ctype ':]' {% ams (sLL $1 $> $ HsPArrTy $2) [mo $1,mc $3] }
| '(' ctype ')' {% ams (sLL $1 $> $ HsParTy $2) [mop $1,mcp $3] }
| '(' ctype '::' kind ')' {% ams (sLL $1 $> $ HsKindSig $2 $4)
- [mop $1,mj AnnDcolon $3,mcp $5] }
+ [mop $1,mu AnnDcolon $3,mcp $5] }
| quasiquote { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
| '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTy $2)
[mj AnnOpenPE $1,mj AnnCloseP $3] }
@@ -1733,7 +1733,7 @@ tv_bndrs :: { [LHsTyVarBndr RdrName] }
tv_bndr :: { LHsTyVarBndr RdrName }
: tyvar { sL1 $1 (UserTyVar (unLoc $1)) }
| '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar $2 $4))
- [mop $1,mj AnnDcolon $3
+ [mop $1,mu AnnDcolon $3
,mcp $5] }
fds :: { Located ([AddAnn],[Located (FunDep (Located RdrName))]) }
@@ -1749,7 +1749,7 @@ fds1 :: { Located [Located (FunDep (Located RdrName))] }
fd :: { Located (FunDep (Located RdrName)) }
: varids0 '->' varids0 {% ams (L (comb3 $1 $2 $3)
(reverse (unLoc $1), reverse (unLoc $3)))
- [mj AnnRarrow $2] }
+ [mu AnnRarrow $2] }
varids0 :: { Located [Located RdrName] }
: {- empty -} { noLoc [] }
@@ -1778,14 +1778,15 @@ turn them into HsEqTy's.
kind :: { LHsKind RdrName }
: bkind { $1 }
| bkind '->' kind {% ams (sLL $1 $> $ HsFunTy $1 $3)
- [mj AnnRarrow $2] }
+ [mu AnnRarrow $2] }
bkind :: { LHsKind RdrName }
: akind { $1 }
| bkind akind { sLL $1 $> $ HsAppTy $1 $2 }
akind :: { LHsKind RdrName }
- : '*' { sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName) }
+ : '*' {% ams (sL1 $1 $ HsTyVar (nameRdrName liftedTypeKindTyConName))
+ [mu AnnStar $1] }
| '(' kind ')' {% ams (sLL $1 $> $ HsParTy $2)
[mop $1,mcp $3] }
| pkind { $1 }
@@ -1876,7 +1877,7 @@ gadt_constr :: { LConDecl RdrName }
: con_list '::' sigtype
{% do { let { (anns, gadtDecl) = mkGadtDecl (unLoc $1) $3 }
; ams (sLL $1 $> gadtDecl)
- (mj AnnDcolon $2:anns) } }
+ (mu AnnDcolon $2:anns) } }
{- Note [Difference in parsing GADT and data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1906,7 +1907,7 @@ constr :: { LConDecl RdrName }
addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con
(snd $ unLoc $2) $3 details))
($1 `mplus` $6))
- (mj AnnDarrow $4:(fst $ unLoc $2)) }
+ (mu AnnDarrow $4:(fst $ unLoc $2)) }
| maybe_docnext forall constr_stuff maybe_docprev
{% ams ( let (con,details) = unLoc $3 in
addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con
@@ -1915,7 +1916,7 @@ constr :: { LConDecl RdrName }
(fst $ unLoc $2) }
forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) }
- : 'forall' tv_bndrs '.' { sLL $1 $> ([mj AnnForall $1,mj AnnDot $3],$2) }
+ : 'forall' tv_bndrs '.' { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3],$2) }
| {- empty -} { noLoc ([],[]) }
constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
@@ -1949,7 +1950,7 @@ fielddecl :: { LConDeclField RdrName }
: maybe_docnext sig_vars '::' ctype maybe_docprev
{% ams (L (comb2 $2 $4)
(ConDeclField (reverse (map (fmap (flip FieldOcc PlaceHolder)) (unLoc $2))) $4 ($1 `mplus` $5)))
- [mj AnnDcolon $3] }
+ [mu AnnDcolon $3] }
-- We allow the odd-looking 'inst_type' in a deriving clause, so that
-- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
@@ -2060,14 +2061,14 @@ sigdecl :: { LHsDecl RdrName }
-- See Note [Declaration/signature overlap] for why we need infixexp here
infixexp '::' sigtypedoc
{% do s <- checkValSig $1 $3
- ; _ <- ams (sLL $1 $> ()) [mj AnnDcolon $2]
+ ; _ <- ams (sLL $1 $> ()) [mu AnnDcolon $2]
; return (sLL $1 $> $ SigD s) }
| var ',' sig_vars '::' sigtypedoc
{% do { let sig = TypeSig ($1 : reverse (unLoc $3)) $5 PlaceHolder
; addAnnotation (gl $1) AnnComma (gl $2)
; ams ( sLL $1 $> $ SigD sig )
- [mj AnnDcolon $4] } }
+ [mu AnnDcolon $4] } }
| infix prec ops
{% ams (sLL $1 $> $ SigD
@@ -2088,13 +2089,13 @@ sigdecl :: { LHsDecl RdrName }
let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
(EmptyInlineSpec, FunLike) (snd $2)
in sLL $1 $> $ SigD (SpecSig $3 (fromOL $5) inl_prag))
- (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
+ (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
{% ams (sLL $1 $> $ SigD (SpecSig $3 (fromOL $5)
(mkInlinePragma (getSPEC_INLINE_PRAGs $1)
(getSPEC_INLINE $1) (snd $2))))
- (mo $1:mj AnnDcolon $4:mc $6:(fst $2)) }
+ (mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
| '{-# SPECIALISE' 'instance' inst_type '#-}'
{% ams (sLL $1 $>
@@ -2132,19 +2133,19 @@ quasiquote :: { Located (HsSplice RdrName) }
exp :: { LHsExpr RdrName }
: infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 $3 PlaceHolder)
- [mj AnnDcolon $2] }
+ [mu AnnDcolon $2] }
| infixexp '-<' exp {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
HsFirstOrderApp True)
- [mj Annlarrowtail $2] }
+ [mu Annlarrowtail $2] }
| infixexp '>-' exp {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
HsFirstOrderApp False)
- [mj Annrarrowtail $2] }
+ [mu Annrarrowtail $2] }
| infixexp '-<<' exp {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
HsHigherOrderApp True)
- [mj AnnLarrowtail $2] }
+ [mu AnnLarrowtail $2] }
| infixexp '>>-' exp {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
HsHigherOrderApp False)
- [mj AnnRarrowtail $2] }
+ [mu AnnRarrowtail $2] }
| infixexp { $1 }
infixexp :: { LHsExpr RdrName }
@@ -2159,7 +2160,7 @@ exp10 :: { LHsExpr RdrName }
: '\\' apat apats opt_asig '->' exp
{% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
[sLL $1 $> $ Match NonFunBindMatch ($2:$3) (snd $4) (unguardedGRHSs $6)]))
- (mj AnnLam $1:mj AnnRarrow $5:(fst $4)) }
+ (mj AnnLam $1:mu AnnRarrow $5:(fst $4)) }
| 'let' binds 'in' exp {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
(mj AnnLet $1:mj AnnIn $3
:(fst $ unLoc $2)) }
@@ -2205,7 +2206,7 @@ exp10 :: { LHsExpr RdrName }
ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
placeHolderType []))
-- TODO: is LL right here?
- [mj AnnProc $1,mj AnnRarrow $3] }
+ [mj AnnProc $1,mu AnnRarrow $3] }
| '{-# CORE' STRING '#-}' exp {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4)
[mo $1,mj AnnVal $2
@@ -2372,7 +2373,7 @@ texp :: { LHsExpr RdrName }
| qopm infixexp { sLL $1 $> $ SectionR $1 $2 }
-- View patterns get parenthesized above
- | exp '->' texp {% ams (sLL $1 $> $ EViewPat $1 $3) [mj AnnRarrow $2] }
+ | exp '->' texp {% ams (sLL $1 $> $ EViewPat $1 $3) [mu AnnRarrow $2] }
-- Always at least one comma
tup_exprs :: { [LHsTupArg RdrName] }
@@ -2566,7 +2567,7 @@ alt_rhs :: { Located ([AddAnn],GRHSs RdrName (LHsExpr RdrName)) }
ralt :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
: '->' exp {% ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2))
- [mj AnnRarrow $1] }
+ [mu AnnRarrow $1] }
| gdpats { sL1 $1 (reverse (unLoc $1)) }
gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
@@ -2591,7 +2592,7 @@ ifgdpats :: { Located ([AddAnn],[LGRHS RdrName (LHsExpr RdrName)]) }
gdpat :: { LGRHS RdrName (LHsExpr RdrName) }
: '|' guardquals '->' exp
{% ams (sL (comb2 $1 $>) $ GRHS (unLoc $2) $4)
- [mj AnnVbar $1,mj AnnRarrow $3] }
+ [mj AnnVbar $1,mu AnnRarrow $3] }
-- 'pat' recognises a pattern, including one with a bang at the top
-- e.g. "!x" or "!(x,y)" or "C a b" etc
@@ -2669,7 +2670,7 @@ stmt :: { LStmt RdrName (LHsExpr RdrName) }
qual :: { LStmt RdrName (LHsExpr RdrName) }
: bindpat '<-' exp {% ams (sLL $1 $> $ mkBindStmt $1 $3)
- [mj AnnLarrow $2] }
+ [mu AnnLarrow $2] }
| exp { sL1 $1 $ mkBodyStmt $1 }
| 'let' binds {% ams (sLL $1 $>$ LetStmt (snd $ unLoc $2))
(mj AnnLet $1:(fst $ unLoc $2)) }
@@ -2827,7 +2828,7 @@ ntgtycon :: { Located RdrName } -- A "general" qualified tycon, excluding unit
(snd $2 + 1)))
(mo $1:mc $3:(mcommas (fst $2))) }
| '(' '->' ')' {% ams (sLL $1 $> $ getRdrName funTyCon)
- [mop $1,mj AnnRarrow $2,mcp $3] }
+ [mop $1,mu AnnRarrow $2,mcp $3] }
| '[' ']' {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
| '[:' ':]' {% ams (sLL $1 $> $ parrTyCon_RDR) [mo $1,mc $2] }
| '(' '~#' ')' {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
@@ -2892,7 +2893,8 @@ tyconsym :: { Located RdrName }
: CONSYM { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
| VARSYM { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
| ':' { sL1 $1 $! consDataCon_RDR }
- | '*' { sL1 $1 $! mkUnqual tcClsName (fsLit "*") }
+ | '*' {% ams (sL1 $1 $! mkUnqual tcClsName (fsLit "*"))
+ [mu AnnStar $1] }
| '-' { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
@@ -3030,7 +3032,7 @@ special_id
special_sym :: { Located FastString }
special_sym : '!' {% ams (sL1 $1 (fsLit "!")) [mj AnnBang $1] }
| '.' { sL1 $1 (fsLit ".") }
- | '*' { sL1 $1 (fsLit "*") }
+ | '*' {% ams (sL1 $1 (fsLit "*")) [mu AnnStar $1] }
-----------------------------------------------------------------------------
-- Data constructors
@@ -3192,6 +3194,20 @@ getCTYPEs (L _ (ITctype src)) = src
getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l)
+isUnicode :: Located Token -> Bool
+isUnicode (L _ (ITforall iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdarrow iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITdcolon iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrow iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrow iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrow iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITstar iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITlarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITrarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITLarrowtail iu)) = iu == UnicodeSyntax
+isUnicode (L _ (ITRarrowtail iu)) = iu == UnicodeSyntax
+isUnicode _ = False
+
getSCC :: Located Token -> P FastString
getSCC lt = do let s = getSTRING lt
err = "Spaces are not allowed in SCCs"
@@ -3324,6 +3340,16 @@ in ApiAnnotation.hs
mj :: AnnKeywordId -> Located e -> AddAnn
mj a l = (\s -> addAnnotation s a (gl l))
+-- |Construct an AddAnn from the annotation keyword and the Located Token. If
+-- the token has a unicode equivalent and this has been used, provide the
+-- unicode variant of the annotation.
+mu :: AnnKeywordId -> Located Token -> AddAnn
+mu a lt@(L l t) = (\s -> addAnnotation s (toUnicodeAnn a lt) l)
+
+-- | If the 'Token' is using its unicode variant return the unicode variant of
+-- the annotation
+toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
+toUnicodeAnn a t = if isUnicode t then unicodeAnn a else a
gl = getLoc
@@ -3402,5 +3428,4 @@ oll l =
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
-
}
diff --git a/testsuite/tests/ghc-api/annotations-literals/literals.stdout b/testsuite/tests/ghc-api/annotations-literals/literals.stdout
index ff4f63f183..12a0f4e35e 100644
--- a/testsuite/tests/ghc-api/annotations-literals/literals.stdout
+++ b/testsuite/tests/ghc-api/annotations-literals/literals.stdout
@@ -14,7 +14,7 @@
(LiteralsTest.hs:4:3,ITvarid "y",[y]),
-(LiteralsTest.hs:4:5-6,ITdcolon,[::]),
+(LiteralsTest.hs:4:5-6,ITdcolon NormalSyntax,[::]),
(LiteralsTest.hs:4:8-10,ITconid "Int",[Int]),
@@ -38,7 +38,7 @@
(LiteralsTest.hs:8:1,ITvarid "s",[s]),
-(LiteralsTest.hs:8:3-4,ITdcolon,[::]),
+(LiteralsTest.hs:8:3-4,ITdcolon NormalSyntax,[::]),
(LiteralsTest.hs:8:6-11,ITconid "String",[String]),
@@ -54,7 +54,7 @@
(LiteralsTest.hs:11:1,ITvarid "c",[c]),
-(LiteralsTest.hs:11:3-4,ITdcolon,[::]),
+(LiteralsTest.hs:11:3-4,ITdcolon NormalSyntax,[::]),
(LiteralsTest.hs:11:6-9,ITconid "Char",[Char]),
@@ -70,7 +70,7 @@
(LiteralsTest.hs:14:1,ITvarid "d",[d]),
-(LiteralsTest.hs:14:3-4,ITdcolon,[::]),
+(LiteralsTest.hs:14:3-4,ITdcolon NormalSyntax,[::]),
(LiteralsTest.hs:14:6-11,ITconid "Double",[Double]),
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
index 45a5297c32..631e7e3c1e 100644
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ b/testsuite/tests/ghc-api/annotations/Makefile
@@ -102,3 +102,7 @@ T10313:
rm -f stringSource.o stringSource.hi
'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc stringSource
./stringSource "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10313
+
+.PHONY: T11018
+T11018:
+ $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11018
diff --git a/testsuite/tests/ghc-api/annotations/T10307.stdout b/testsuite/tests/ghc-api/annotations/T10307.stdout
index 48cbca6cd0..26a255dca9 100644
--- a/testsuite/tests/ghc-api/annotations/T10307.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10307.stdout
@@ -12,6 +12,7 @@
((Test10307.hs:5:3-34,AnnDcolon), [Test10307.hs:5:31-32]),
((Test10307.hs:5:3-34,AnnSemi), [Test10307.hs:6:3]),
((Test10307.hs:5:3-34,AnnType), [Test10307.hs:5:3-6]),
+((Test10307.hs:5:34,AnnStar), [Test10307.hs:5:34]),
((Test10307.hs:6:3-34,AnnEqual), [Test10307.hs:6:31]),
((Test10307.hs:6:3-34,AnnType), [Test10307.hs:6:3-6]),
((Test10307.hs:6:8-34,AnnEqual), [Test10307.hs:6:31]),
diff --git a/testsuite/tests/ghc-api/annotations/T10312.stdout b/testsuite/tests/ghc-api/annotations/T10312.stdout
index 00f25444cc..61fea45a33 100644
--- a/testsuite/tests/ghc-api/annotations/T10312.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10312.stdout
@@ -33,6 +33,7 @@
((Test10312.hs:(16,19)-(20,19),AnnVbar), [Test10312.hs:17:19]),
((Test10312.hs:16:21-25,AnnVal), [Test10312.hs:16:23]),
((Test10312.hs:16:21-29,AnnVal), [Test10312.hs:16:27]),
+((Test10312.hs:16:27,AnnStar), [Test10312.hs:16:27]),
((Test10312.hs:17:21-32,AnnComma), [Test10312.hs:18:19]),
((Test10312.hs:17:21-32,AnnLarrow), [Test10312.hs:17:23-24]),
((Test10312.hs:17:26-32,AnnCloseS), [Test10312.hs:17:32]),
@@ -59,6 +60,7 @@
((Test10312.hs:(23,20)-(27,20),AnnVbar), [Test10312.hs:24:20]),
((Test10312.hs:23:22-26,AnnVal), [Test10312.hs:23:24]),
((Test10312.hs:23:22-30,AnnVal), [Test10312.hs:23:28]),
+((Test10312.hs:23:28,AnnStar), [Test10312.hs:23:28]),
((Test10312.hs:24:22-33,AnnLarrow), [Test10312.hs:24:24-25]),
((Test10312.hs:24:22-33,AnnVbar), [Test10312.hs:25:20]),
((Test10312.hs:24:27-33,AnnCloseS), [Test10312.hs:24:33]),
diff --git a/testsuite/tests/ghc-api/annotations/T10357.stdout b/testsuite/tests/ghc-api/annotations/T10357.stdout
index 15d5139be5..cbbb84e2ee 100644
--- a/testsuite/tests/ghc-api/annotations/T10357.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10357.stdout
@@ -31,6 +31,7 @@
((Test10357.hs:7:28,AnnComma), [Test10357.hs:7:29]),
((Test10357.hs:7:31-36,AnnVal), [Test10357.hs:7:33]),
((Test10357.hs:7:31-40,AnnVal), [Test10357.hs:7:38]),
+((Test10357.hs:7:33,AnnStar), [Test10357.hs:7:33]),
((Test10357.hs:7:43-52,AnnBackquote), [Test10357.hs:7:43, Test10357.hs:7:52]),
((Test10357.hs:7:43-52,AnnVal), [Test10357.hs:7:44-51]),
((Test10357.hs:8:18-59,AnnCloseP), [Test10357.hs:8:59]),
diff --git a/testsuite/tests/ghc-api/annotations/T10358.stdout b/testsuite/tests/ghc-api/annotations/T10358.stdout
index ae1ec8587f..2bcbf68c09 100644
--- a/testsuite/tests/ghc-api/annotations/T10358.stdout
+++ b/testsuite/tests/ghc-api/annotations/T10358.stdout
@@ -15,18 +15,23 @@
((Test10358.hs:5:7-16,AnnEqual), [Test10358.hs:5:12]),
((Test10358.hs:5:7-16,AnnSemi), [Test10358.hs:5:17]),
((Test10358.hs:5:14-16,AnnVal), [Test10358.hs:5:15]),
+((Test10358.hs:5:15,AnnStar), [Test10358.hs:5:15]),
((Test10358.hs:5:19-22,AnnBang), [Test10358.hs:5:19]),
((Test10358.hs:5:19-32,AnnEqual), [Test10358.hs:5:24]),
((Test10358.hs:5:19-32,AnnSemi), [Test10358.hs:6:7]),
((Test10358.hs:5:26-32,AnnVal), [Test10358.hs:5:29]),
+((Test10358.hs:5:29,AnnStar), [Test10358.hs:5:29]),
((Test10358.hs:6:7-16,AnnEqual), [Test10358.hs:6:10]),
((Test10358.hs:6:7-16,AnnFunId), [Test10358.hs:6:7-8]),
((Test10358.hs:6:7-16,AnnSemi), [Test10358.hs:7:7]),
((Test10358.hs:6:12-14,AnnVal), [Test10358.hs:6:13]),
((Test10358.hs:6:12-16,AnnVal), [Test10358.hs:6:15]),
+((Test10358.hs:6:13,AnnStar), [Test10358.hs:6:13]),
+((Test10358.hs:6:15,AnnStar), [Test10358.hs:6:15]),
((Test10358.hs:7:7-17,AnnEqual), [Test10358.hs:7:10]),
((Test10358.hs:7:7-17,AnnFunId), [Test10358.hs:7:7-8]),
((Test10358.hs:7:12-17,AnnVal), [Test10358.hs:7:14]),
+((Test10358.hs:7:14,AnnStar), [Test10358.hs:7:14]),
((<no location info>,AnnEofPos), [Test10358.hs:9:1])
]
diff --git a/testsuite/tests/ghc-api/annotations/T11018.stderr b/testsuite/tests/ghc-api/annotations/T11018.stderr
new file mode 100644
index 0000000000..c58942f4c7
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T11018.stderr
@@ -0,0 +1,40 @@
+
+Test11018.hs:12:26: error:
+ Illegal kind signature: ‘* -> *’
+ Perhaps you intended to use KindSignatures
+ In the data type declaration for ‘Recorder’
+
+Test11018.hs:14:23: error:
+ Not in scope: type constructor or class ‘FinalizerHandle’
+
+Test11018.hs:17:6: error:
+ Not in scope: type constructor or class ‘Arrow’
+
+Test11018.hs:20:7: error:
+ Not in scope: type constructor or class ‘Arrow’
+
+Test11018.hs:23:6: error:
+ Not in scope: type constructor or class ‘ArrowApply’
+
+Test11018.hs:26:7: error:
+ Not in scope: type constructor or class ‘ArrowApply’
+
+Test11018.hs:37:27: error:
+ Illegal kind signature: ‘* -> *’
+ Perhaps you intended to use KindSignatures
+ In the data type declaration for ‘RecorderU’
+
+Test11018.hs:39:23: error:
+ Not in scope: type constructor or class ‘FinalizerHandle’
+
+Test11018.hs:42:7: error:
+ Not in scope: type constructor or class ‘Arrow’
+
+Test11018.hs:45:8: error:
+ Not in scope: type constructor or class ‘Arrow’
+
+Test11018.hs:48:7: error:
+ Not in scope: type constructor or class ‘ArrowApply’
+
+Test11018.hs:51:8: error:
+ Not in scope: type constructor or class ‘ArrowApply’
diff --git a/testsuite/tests/ghc-api/annotations/T11018.stdout b/testsuite/tests/ghc-api/annotations/T11018.stdout
new file mode 100644
index 0000000000..d05c13f213
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/T11018.stdout
@@ -0,0 +1,203 @@
+---Problems (should be empty list)---
+[]
+---Annotations-----------------------
+-- SrcSpan the annotation is attached to, AnnKeywordId,
+-- list of locations the keyword item appears in
+[
+((Test11018.hs:1:1,AnnModule), [Test11018.hs:4:1-6]),
+((Test11018.hs:1:1,AnnWhere), [Test11018.hs:4:18-22]),
+((Test11018.hs:6:1-36,AnnDcolon), [Test11018.hs:6:12-13]),
+((Test11018.hs:6:1-36,AnnSemi), [Test11018.hs:7:1]),
+((Test11018.hs:6:15-36,AnnDot), [Test11018.hs:6:24]),
+((Test11018.hs:6:15-36,AnnForall), [Test11018.hs:6:15-20]),
+((Test11018.hs:6:26-36,AnnRarrow), [Test11018.hs:6:28-29]),
+((Test11018.hs:(7,1)-(9,10),AnnEqual), [Test11018.hs:7:14]),
+((Test11018.hs:(7,1)-(9,10),AnnFunId), [Test11018.hs:7:1-10]),
+((Test11018.hs:(7,1)-(9,10),AnnSemi), [Test11018.hs:12:1]),
+((Test11018.hs:(7,16)-(9,10),AnnDo), [Test11018.hs:7:16-17]),
+((Test11018.hs:8:3-15,AnnLarrow), [Test11018.hs:8:5-6]),
+((Test11018.hs:8:3-15,AnnSemi), [Test11018.hs:9:3]),
+((Test11018.hs:(12,1)-(15,7),AnnData), [Test11018.hs:12:1-4]),
+((Test11018.hs:(12,1)-(15,7),AnnEqual), [Test11018.hs:13:5]),
+((Test11018.hs:(12,1)-(15,7),AnnSemi), [Test11018.hs:17:1]),
+((Test11018.hs:12:21-32,AnnCloseP), [Test11018.hs:12:32]),
+((Test11018.hs:12:21-32,AnnDcolonU), [Test11018.hs:12:24]),
+((Test11018.hs:12:21-32,AnnOpenP), [Test11018.hs:12:21]),
+((Test11018.hs:12:26,AnnStar), [Test11018.hs:12:26]),
+((Test11018.hs:12:26-31,AnnRarrow), [Test11018.hs:12:28-29]),
+((Test11018.hs:12:31,AnnStar), [Test11018.hs:12:31]),
+((Test11018.hs:(13,16)-(15,7),AnnCloseC), [Test11018.hs:15:7]),
+((Test11018.hs:(13,16)-(15,7),AnnOpenC), [Test11018.hs:13:16]),
+((Test11018.hs:14:9-40,AnnDcolon), [Test11018.hs:14:18-19]),
+((Test11018.hs:14:21-40,AnnBang), [Test11018.hs:14:21]),
+((Test11018.hs:14:22-40,AnnCloseP), [Test11018.hs:14:40]),
+((Test11018.hs:14:22-40,AnnOpenP), [Test11018.hs:14:22]),
+((Test11018.hs:17:1-35,AnnDcolon), [Test11018.hs:17:3-4]),
+((Test11018.hs:17:1-35,AnnSemi), [Test11018.hs:18:1]),
+((Test11018.hs:17:6-12,AnnDarrow), [Test11018.hs:17:14-15]),
+((Test11018.hs:17:19-31,AnnCloseP), [Test11018.hs:17:31]),
+((Test11018.hs:17:19-31,AnnOpenP), [Test11018.hs:17:19]),
+((Test11018.hs:17:20-22,AnnComma), [Test11018.hs:17:23]),
+((Test11018.hs:17:24-26,AnnComma), [Test11018.hs:17:27]),
+((Test11018.hs:18:1-34,AnnEqual), [Test11018.hs:18:3]),
+((Test11018.hs:18:1-34,AnnFunId), [Test11018.hs:18:1]),
+((Test11018.hs:18:1-34,AnnSemi), [Test11018.hs:20:1]),
+((Test11018.hs:18:5-34,AnnProc), [Test11018.hs:18:5-8]),
+((Test11018.hs:18:5-34,AnnRarrow), [Test11018.hs:18:18-19]),
+((Test11018.hs:18:10-16,AnnCloseP), [Test11018.hs:18:16]),
+((Test11018.hs:18:10-16,AnnOpenP), [Test11018.hs:18:10]),
+((Test11018.hs:18:11,AnnComma), [Test11018.hs:18:12]),
+((Test11018.hs:18:13,AnnComma), [Test11018.hs:18:14]),
+((Test11018.hs:18:21-34,Annlarrowtail), [Test11018.hs:18:29-30]),
+((Test11018.hs:18:32-34,AnnVal), [Test11018.hs:18:33]),
+((Test11018.hs:20:1-36,AnnDcolon), [Test11018.hs:20:4-5]),
+((Test11018.hs:20:1-36,AnnSemi), [Test11018.hs:21:1]),
+((Test11018.hs:20:7-13,AnnDarrow), [Test11018.hs:20:15-16]),
+((Test11018.hs:20:20-32,AnnCloseP), [Test11018.hs:20:32]),
+((Test11018.hs:20:20-32,AnnOpenP), [Test11018.hs:20:20]),
+((Test11018.hs:20:21-23,AnnComma), [Test11018.hs:20:24]),
+((Test11018.hs:20:25-27,AnnComma), [Test11018.hs:20:28]),
+((Test11018.hs:21:1-35,AnnEqual), [Test11018.hs:21:4]),
+((Test11018.hs:21:1-35,AnnFunId), [Test11018.hs:21:1-2]),
+((Test11018.hs:21:1-35,AnnSemi), [Test11018.hs:23:1]),
+((Test11018.hs:21:6-35,AnnProc), [Test11018.hs:21:6-9]),
+((Test11018.hs:21:6-35,AnnRarrow), [Test11018.hs:21:19-20]),
+((Test11018.hs:21:11-17,AnnCloseP), [Test11018.hs:21:17]),
+((Test11018.hs:21:11-17,AnnOpenP), [Test11018.hs:21:11]),
+((Test11018.hs:21:12,AnnComma), [Test11018.hs:21:13]),
+((Test11018.hs:21:14,AnnComma), [Test11018.hs:21:15]),
+((Test11018.hs:21:22-35,Annrarrowtail), [Test11018.hs:21:30-31]),
+((Test11018.hs:21:33-35,AnnVal), [Test11018.hs:21:34]),
+((Test11018.hs:23:1-49,AnnDcolon), [Test11018.hs:23:3-4]),
+((Test11018.hs:23:1-49,AnnSemi), [Test11018.hs:24:1]),
+((Test11018.hs:23:6-17,AnnDarrow), [Test11018.hs:23:19-20]),
+((Test11018.hs:23:22-49,AnnRarrow), [Test11018.hs:23:26-27]),
+((Test11018.hs:23:31-45,AnnCloseP), [Test11018.hs:23:45]),
+((Test11018.hs:23:31-45,AnnOpenP), [Test11018.hs:23:31]),
+((Test11018.hs:23:32-40,AnnComma), [Test11018.hs:23:41]),
+((Test11018.hs:24:1-29,AnnEqual), [Test11018.hs:24:5]),
+((Test11018.hs:24:1-29,AnnFunId), [Test11018.hs:24:1]),
+((Test11018.hs:24:1-29,AnnSemi), [Test11018.hs:26:1]),
+((Test11018.hs:24:7-29,AnnProc), [Test11018.hs:24:7-10]),
+((Test11018.hs:24:7-29,AnnRarrow), [Test11018.hs:24:18-19]),
+((Test11018.hs:24:12-16,AnnCloseP), [Test11018.hs:24:16]),
+((Test11018.hs:24:12-16,AnnOpenP), [Test11018.hs:24:12]),
+((Test11018.hs:24:13,AnnComma), [Test11018.hs:24:14]),
+((Test11018.hs:24:21-29,AnnLarrowtail), [Test11018.hs:24:23-25]),
+((Test11018.hs:24:27-29,AnnVal), [Test11018.hs:24:28]),
+((Test11018.hs:26:1-50,AnnDcolon), [Test11018.hs:26:4-5]),
+((Test11018.hs:26:1-50,AnnSemi), [Test11018.hs:27:1]),
+((Test11018.hs:26:7-18,AnnDarrow), [Test11018.hs:26:20-21]),
+((Test11018.hs:26:23-50,AnnRarrow), [Test11018.hs:26:27-28]),
+((Test11018.hs:26:32-46,AnnCloseP), [Test11018.hs:26:46]),
+((Test11018.hs:26:32-46,AnnOpenP), [Test11018.hs:26:32]),
+((Test11018.hs:26:33-41,AnnComma), [Test11018.hs:26:42]),
+((Test11018.hs:27:1-30,AnnEqual), [Test11018.hs:27:6]),
+((Test11018.hs:27:1-30,AnnFunId), [Test11018.hs:27:1-2]),
+((Test11018.hs:27:1-30,AnnSemi), [Test11018.hs:31:1]),
+((Test11018.hs:27:8-30,AnnProc), [Test11018.hs:27:8-11]),
+((Test11018.hs:27:8-30,AnnRarrow), [Test11018.hs:27:19-20]),
+((Test11018.hs:27:13-17,AnnCloseP), [Test11018.hs:27:17]),
+((Test11018.hs:27:13-17,AnnOpenP), [Test11018.hs:27:13]),
+((Test11018.hs:27:14,AnnComma), [Test11018.hs:27:15]),
+((Test11018.hs:27:22-30,AnnRarrowtail), [Test11018.hs:27:24-26]),
+((Test11018.hs:27:28-30,AnnVal), [Test11018.hs:27:29]),
+((Test11018.hs:31:1-26,AnnDcolonU), [Test11018.hs:31:9]),
+((Test11018.hs:31:1-26,AnnSemi), [Test11018.hs:32:1]),
+((Test11018.hs:31:11-26,AnnDot), [Test11018.hs:31:15]),
+((Test11018.hs:31:11-26,AnnForallU), [Test11018.hs:31:11]),
+((Test11018.hs:31:17-26,AnnRarrowU), [Test11018.hs:31:19]),
+((Test11018.hs:(32,1)-(34,10),AnnEqual), [Test11018.hs:32:11]),
+((Test11018.hs:(32,1)-(34,10),AnnFunId), [Test11018.hs:32:1-7]),
+((Test11018.hs:(32,1)-(34,10),AnnSemi), [Test11018.hs:37:1]),
+((Test11018.hs:(32,13)-(34,10),AnnDo), [Test11018.hs:32:13-14]),
+((Test11018.hs:33:3-14,AnnLarrowU), [Test11018.hs:33:5]),
+((Test11018.hs:33:3-14,AnnSemi), [Test11018.hs:34:3]),
+((Test11018.hs:(37,1)-(40,7),AnnData), [Test11018.hs:37:1-4]),
+((Test11018.hs:(37,1)-(40,7),AnnEqual), [Test11018.hs:38:5]),
+((Test11018.hs:(37,1)-(40,7),AnnSemi), [Test11018.hs:42:1]),
+((Test11018.hs:37:22-32,AnnCloseP), [Test11018.hs:37:32]),
+((Test11018.hs:37:22-32,AnnDcolonU), [Test11018.hs:37:25]),
+((Test11018.hs:37:22-32,AnnOpenP), [Test11018.hs:37:22]),
+((Test11018.hs:37:27,AnnStarU), [Test11018.hs:37:27]),
+((Test11018.hs:37:27-31,AnnRarrowU), [Test11018.hs:37:29]),
+((Test11018.hs:37:31,AnnStarU), [Test11018.hs:37:31]),
+((Test11018.hs:(38,17)-(40,7),AnnCloseC), [Test11018.hs:40:7]),
+((Test11018.hs:(38,17)-(40,7),AnnOpenC), [Test11018.hs:38:17]),
+((Test11018.hs:39:9-40,AnnDcolonU), [Test11018.hs:39:19]),
+((Test11018.hs:39:21-40,AnnBang), [Test11018.hs:39:21]),
+((Test11018.hs:39:22-40,AnnCloseP), [Test11018.hs:39:40]),
+((Test11018.hs:39:22-40,AnnOpenP), [Test11018.hs:39:22]),
+((Test11018.hs:42:1-36,AnnDcolon), [Test11018.hs:42:4-5]),
+((Test11018.hs:42:1-36,AnnSemi), [Test11018.hs:43:1]),
+((Test11018.hs:42:7-13,AnnDarrowU), [Test11018.hs:42:16]),
+((Test11018.hs:42:20-32,AnnCloseP), [Test11018.hs:42:32]),
+((Test11018.hs:42:20-32,AnnOpenP), [Test11018.hs:42:20]),
+((Test11018.hs:42:21-23,AnnComma), [Test11018.hs:42:24]),
+((Test11018.hs:42:25-27,AnnComma), [Test11018.hs:42:28]),
+((Test11018.hs:43:1-34,AnnEqual), [Test11018.hs:43:4]),
+((Test11018.hs:43:1-34,AnnFunId), [Test11018.hs:43:1-2]),
+((Test11018.hs:43:1-34,AnnSemi), [Test11018.hs:45:1]),
+((Test11018.hs:43:6-34,AnnProc), [Test11018.hs:43:6-9]),
+((Test11018.hs:43:6-34,AnnRarrow), [Test11018.hs:43:19-20]),
+((Test11018.hs:43:11-17,AnnCloseP), [Test11018.hs:43:17]),
+((Test11018.hs:43:11-17,AnnOpenP), [Test11018.hs:43:11]),
+((Test11018.hs:43:12,AnnComma), [Test11018.hs:43:13]),
+((Test11018.hs:43:14,AnnComma), [Test11018.hs:43:15]),
+((Test11018.hs:43:22-34,AnnLarrowtailU), [Test11018.hs:43:30]),
+((Test11018.hs:43:32-34,AnnVal), [Test11018.hs:43:33]),
+((Test11018.hs:45:1-36,AnnDcolon), [Test11018.hs:45:5-6]),
+((Test11018.hs:45:1-36,AnnSemi), [Test11018.hs:46:1]),
+((Test11018.hs:45:8-14,AnnDarrowU), [Test11018.hs:45:16]),
+((Test11018.hs:45:20-32,AnnCloseP), [Test11018.hs:45:32]),
+((Test11018.hs:45:20-32,AnnOpenP), [Test11018.hs:45:20]),
+((Test11018.hs:45:21-23,AnnComma), [Test11018.hs:45:24]),
+((Test11018.hs:45:25-27,AnnComma), [Test11018.hs:45:28]),
+((Test11018.hs:46:1-35,AnnEqual), [Test11018.hs:46:5]),
+((Test11018.hs:46:1-35,AnnFunId), [Test11018.hs:46:1-3]),
+((Test11018.hs:46:1-35,AnnSemi), [Test11018.hs:48:1]),
+((Test11018.hs:46:7-35,AnnProc), [Test11018.hs:46:7-10]),
+((Test11018.hs:46:7-35,AnnRarrow), [Test11018.hs:46:20-21]),
+((Test11018.hs:46:12-18,AnnCloseP), [Test11018.hs:46:18]),
+((Test11018.hs:46:12-18,AnnOpenP), [Test11018.hs:46:12]),
+((Test11018.hs:46:13,AnnComma), [Test11018.hs:46:14]),
+((Test11018.hs:46:15,AnnComma), [Test11018.hs:46:16]),
+((Test11018.hs:46:23-35,AnnrarrowtailU), [Test11018.hs:46:31]),
+((Test11018.hs:46:33-35,AnnVal), [Test11018.hs:46:34]),
+((Test11018.hs:48:1-49,AnnDcolon), [Test11018.hs:48:4-5]),
+((Test11018.hs:48:1-49,AnnSemi), [Test11018.hs:49:1]),
+((Test11018.hs:48:7-18,AnnDarrowU), [Test11018.hs:48:20]),
+((Test11018.hs:48:22-49,AnnRarrow), [Test11018.hs:48:26-27]),
+((Test11018.hs:48:31-45,AnnCloseP), [Test11018.hs:48:45]),
+((Test11018.hs:48:31-45,AnnOpenP), [Test11018.hs:48:31]),
+((Test11018.hs:48:32-40,AnnComma), [Test11018.hs:48:41]),
+((Test11018.hs:49:1-28,AnnEqual), [Test11018.hs:49:6]),
+((Test11018.hs:49:1-28,AnnFunId), [Test11018.hs:49:1-2]),
+((Test11018.hs:49:1-28,AnnSemi), [Test11018.hs:51:1]),
+((Test11018.hs:49:8-28,AnnProc), [Test11018.hs:49:8-11]),
+((Test11018.hs:49:8-28,AnnRarrow), [Test11018.hs:49:19-20]),
+((Test11018.hs:49:13-17,AnnCloseP), [Test11018.hs:49:17]),
+((Test11018.hs:49:13-17,AnnOpenP), [Test11018.hs:49:13]),
+((Test11018.hs:49:14,AnnComma), [Test11018.hs:49:15]),
+((Test11018.hs:49:22-28,AnnLarrowtailU), [Test11018.hs:49:24]),
+((Test11018.hs:49:26-28,AnnVal), [Test11018.hs:49:27]),
+((Test11018.hs:51:1-50,AnnDcolon), [Test11018.hs:51:5-6]),
+((Test11018.hs:51:1-50,AnnSemi), [Test11018.hs:52:1]),
+((Test11018.hs:51:8-19,AnnDarrowU), [Test11018.hs:51:21]),
+((Test11018.hs:51:23-50,AnnRarrow), [Test11018.hs:51:27-28]),
+((Test11018.hs:51:32-46,AnnCloseP), [Test11018.hs:51:46]),
+((Test11018.hs:51:32-46,AnnOpenP), [Test11018.hs:51:32]),
+((Test11018.hs:51:33-41,AnnComma), [Test11018.hs:51:42]),
+((Test11018.hs:52:1-29,AnnEqual), [Test11018.hs:52:7]),
+((Test11018.hs:52:1-29,AnnFunId), [Test11018.hs:52:1-3]),
+((Test11018.hs:52:1-29,AnnSemi), [Test11018.hs:53:1]),
+((Test11018.hs:52:9-29,AnnProc), [Test11018.hs:52:9-12]),
+((Test11018.hs:52:9-29,AnnRarrow), [Test11018.hs:52:20-21]),
+((Test11018.hs:52:14-18,AnnCloseP), [Test11018.hs:52:18]),
+((Test11018.hs:52:14-18,AnnOpenP), [Test11018.hs:52:14]),
+((Test11018.hs:52:15,AnnComma), [Test11018.hs:52:16]),
+((Test11018.hs:52:23-29,AnnRarrowtailU), [Test11018.hs:52:25]),
+((Test11018.hs:52:27-29,AnnVal), [Test11018.hs:52:28]),
+((<no location info>,AnnEofPos), [Test11018.hs:53:1])
+]
+
diff --git a/testsuite/tests/ghc-api/annotations/Test11018.hs b/testsuite/tests/ghc-api/annotations/Test11018.hs
new file mode 100644
index 0000000000..e1d020540e
--- /dev/null
+++ b/testsuite/tests/ghc-api/annotations/Test11018.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Test11018 where
+
+nonUnicode :: forall a . a -> IO Int
+nonUnicode _ = do
+ x <- readChar
+ return 4
+
+-- ^ An opaque ESD handle for recording data from the soundcard via ESD.
+data Recorder fr ch (r ∷ * -> *)
+ = Recorder {
+ reCloseH :: !(FinalizerHandle r)
+ }
+
+f :: Arrow a => a (Int,Int,Int) Int
+f = proc (x,y,z) -> returnA -< x+y
+
+f2 :: Arrow a => a (Int,Int,Int) Int
+f2 = proc (x,y,z) -> returnA >- x+y
+
+g :: ArrowApply a => Int -> a (a Int Int,Int) Int
+g y = proc (x,z) -> x -<< 2+y
+
+g2 :: ArrowApply a => Int -> a (a Int Int,Int) Int
+g2 y = proc (x,z) -> x >>- 2+y
+
+-- -------------------------------------
+
+unicode ∷ ∀ a . a → IO Int
+unicode _ = do
+ x ← readChar
+ return 4
+
+-- ^ An opaque ESD handle for recording data from the soundcard via ESD.
+data RecorderU fr ch (r ∷ ★ → ★)
+ = RecorderU {
+ reCloseHU ∷ !(FinalizerHandle r)
+ }
+
+fU :: Arrow a ⇒ a (Int,Int,Int) Int
+fU = proc (x,y,z) -> returnA ⤙ x+y
+
+f2U :: Arrow a ⇒ a (Int,Int,Int) Int
+f2U = proc (x,y,z) -> returnA ⤚ x+y
+
+gU :: ArrowApply a ⇒ Int -> a (a Int Int,Int) Int
+gU y = proc (x,z) -> x ⤛ 2+y
+
+g2U :: ArrowApply a ⇒ Int -> a (a Int Int,Int) Int
+g2U y = proc (x,z) -> x ⤜ 2+y
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
index 2d605c45f8..591f5bf2e7 100644
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ b/testsuite/tests/ghc-api/annotations/all.T
@@ -18,4 +18,5 @@ test('T10354', normal, run_command, ['$MAKE -s --no-print-directory T10354'
test('T10396', normal, run_command, ['$MAKE -s --no-print-directory T10396'])
test('T10399', normal, run_command, ['$MAKE -s --no-print-directory T10399'])
test('T10313', normal, run_command, ['$MAKE -s --no-print-directory T10313'])
+test('T11018', normal, run_command, ['$MAKE -s --no-print-directory T11018'])
test('bundle-export', normal, run_command, ['$MAKE -s --no-print-directory bundle-export'])
diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout
index c50df4848e..9ae9f2300a 100644
--- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout
+++ b/testsuite/tests/ghc-api/annotations/exampleTest.stdout
@@ -65,7 +65,9 @@
((AnnotationTuple.hs:18:1-28,AnnDcolon), [AnnotationTuple.hs:18:20-21]),
((AnnotationTuple.hs:18:1-28,AnnFamily), [AnnotationTuple.hs:18:6-11]),
((AnnotationTuple.hs:18:1-28,AnnSemi), [AnnotationTuple.hs:19:1]),
+((AnnotationTuple.hs:18:23,AnnStar), [AnnotationTuple.hs:18:23]),
((AnnotationTuple.hs:18:23-28,AnnRarrow), [AnnotationTuple.hs:18:25-26]),
+((AnnotationTuple.hs:18:28,AnnStar), [AnnotationTuple.hs:18:28]),
((AnnotationTuple.hs:(20,1)-(24,14),AnnFunId), [AnnotationTuple.hs:20:1-5]),
((AnnotationTuple.hs:(20,1)-(24,14),AnnSemi), [AnnotationTuple.hs:25:1]),
((AnnotationTuple.hs:(21,7)-(24,14),AnnEqual), [AnnotationTuple.hs:24:7]),
diff --git a/testsuite/tests/ghc-api/annotations/listcomps.stdout b/testsuite/tests/ghc-api/annotations/listcomps.stdout
index 1c0b8e5ce4..754c170f39 100644
--- a/testsuite/tests/ghc-api/annotations/listcomps.stdout
+++ b/testsuite/tests/ghc-api/annotations/listcomps.stdout
@@ -97,6 +97,8 @@
(AK ListComprehensions.hs:18:22-30 AnnVal = [ListComprehensions.hs:18:28])
+(AK ListComprehensions.hs:18:28 AnnStar = [ListComprehensions.hs:18:28])
+
(AK ListComprehensions.hs:19:22-33 AnnLarrow = [ListComprehensions.hs:19:24-25])
(AK ListComprehensions.hs:19:22-33 AnnVbar = [ListComprehensions.hs:20:20])
diff --git a/testsuite/tests/ghc-api/annotations/parseTree.stdout b/testsuite/tests/ghc-api/annotations/parseTree.stdout
index 7d651aaffb..d3e1a5a7dd 100644
--- a/testsuite/tests/ghc-api/annotations/parseTree.stdout
+++ b/testsuite/tests/ghc-api/annotations/parseTree.stdout
@@ -132,8 +132,12 @@
(AK AnnotationTuple.hs:18:1-28 AnnSemi = [AnnotationTuple.hs:19:1])
+(AK AnnotationTuple.hs:18:23 AnnStar = [AnnotationTuple.hs:18:23])
+
(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26])
+(AK AnnotationTuple.hs:18:28 AnnStar = [AnnotationTuple.hs:18:28])
+
(AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5])
(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1])
View Lorry Controller Status