Commit fe95463b authored by Alan Zimmerman's avatar Alan Zimmerman

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
parent 46a03fbe
......@@ -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 '*'?
......@@ -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
......
This diff is collapsed.
......@@ -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]),
......
......@@ -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
......@@ -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]),
......
......@@ -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]),
......
......@@ -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]),
......
......@@ -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])
]
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’
This diff is collapsed.
{-# 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
......@@ -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'])
......@@ -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]),
......
......@@ -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])
......
......@@ -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])
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment