ApiAnnotations: Add SourceText for unicode tokens
authorAlan Zimmerman <alan.zimm@gmail.com>
Mon, 16 Nov 2015 17:43:34 +0000 (19:43 +0200)
committerAlan Zimmerman <alan.zimm@gmail.com>
Mon, 16 Nov 2015 17:43:34 +0000 (19:43 +0200)
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

16 files changed:
compiler/parser/ApiAnnotation.hs
compiler/parser/Lexer.x
compiler/parser/Parser.y
testsuite/tests/ghc-api/annotations-literals/literals.stdout
testsuite/tests/ghc-api/annotations/Makefile
testsuite/tests/ghc-api/annotations/T10307.stdout
testsuite/tests/ghc-api/annotations/T10312.stdout
testsuite/tests/ghc-api/annotations/T10357.stdout
testsuite/tests/ghc-api/annotations/T10358.stdout
testsuite/tests/ghc-api/annotations/T11018.stderr [new file with mode: 0644]
testsuite/tests/ghc-api/annotations/T11018.stdout [new file with mode: 0644]
testsuite/tests/ghc-api/annotations/Test11018.hs [new file with mode: 0644]
testsuite/tests/ghc-api/annotations/all.T
testsuite/tests/ghc-api/annotations/exampleTest.stdout
testsuite/tests/ghc-api/annotations/listcomps.stdout
testsuite/tests/ghc-api/annotations/parseTree.stdout

index 7376e30..c5ba453 100644 (file)
@@ -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 '*'?
index acb6893..0bf26ce 100644 (file)
@@ -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
index a74d7a8..bf6e753 100644 (file)
@@ -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
-
 }
index ff4f63f..12a0f4e 100644 (file)
@@ -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]),
 
index 45a5297..631e7e3 100644 (file)
@@ -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
index 48cbca6..26a255d 100644 (file)
@@ -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]),
index 00f2544..61fea45 100644 (file)
@@ -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]),
index 15d5139..cbbb84e 100644 (file)
@@ -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]),
index ae1ec85..2bcbf68 100644 (file)
 ((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 (file)
index 0000000..c58942f
--- /dev/null
@@ -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 (file)
index 0000000..d05c13f
--- /dev/null
@@ -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 (file)
index 0000000..e1d0205
--- /dev/null
@@ -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
index 2d605c4..591f5bf 100644 (file)
@@ -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'])
index c50df48..9ae9f23 100644 (file)
@@ -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]),
index 1c0b8e5..754c170 100644 (file)
@@ -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])
index 7d651aa..d3e1a5a 100644 (file)
 
 (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])