[Git][ghc/ghc][wip/T18639-remove-generated-pragma] Remove GENERATED pragma, as it is not being used
Alan Zimmerman
gitlab at gitlab.haskell.org
Tue Sep 8 17:27:16 UTC 2020
Alan Zimmerman pushed to branch wip/T18639-remove-generated-pragma at Glasgow Haskell Compiler / GHC
Commits:
28c79894 by Alan Zimmerman at 2020-09-08T18:26:43+01:00
Remove GENERATED pragma, as it is not being used
@alanz pointed out on ghc-devs that the payload of this pragma does
not appear to be used anywhere.
I (@bgamari) did some digging and traced the pragma's addition back to
d386e0d2 (way back in 2006!).
It appears that it was intended to be used by code generators for use
in informing the code coveraging checker about generated code
provenance. When it was added it used the pragma's "payload" fields as
source location information to build an "ExternalBox". However, it
looks like this was dropped a year later in 55a5d8d9. At this point
it seems like the pragma serves no useful purpose.
Given that it also is not documented, I think we should remove it.
Updates haddock submodule
Closes #18639
- - - - -
18 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs
- testsuite/tests/ghc-api/annotations/T10313.stdout
- testsuite/tests/ghc-api/annotations/T11430.stdout
- testsuite/tests/ghc-api/annotations/Test10313.hs
- testsuite/tests/ghc-api/annotations/Test11430.hs
- testsuite/tests/ghc-api/annotations/stringSource.hs
- testsuite/tests/ghc-api/annotations/t11430.hs
- testsuite/tests/printer/Makefile
- − testsuite/tests/printer/Ppr047.hs
- testsuite/tests/printer/all.T
- utils/haddock
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -838,21 +838,10 @@ data HsPragE p
-- 'GHC.Parser.Annotation.AnnVal',
-- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@
- -- For details on above see note [Api annotations] in GHC.Parser.Annotation
- | HsPragTick -- A pragma introduced tick
- (XTickPragma p)
- SourceText -- Note [Pragma source text] in GHC.Types.Basic
- (StringLiteral,(Int,Int),(Int,Int))
- -- external span for this tick
- ((SourceText,SourceText),(SourceText,SourceText))
- -- Source text for the four integers used in the span.
- -- See note [Pragma source text] in GHC.Types.Basic
-
| XHsPragE !(XXPragE p)
type instance XSCC (GhcPass _) = NoExtField
type instance XCoreAnn (GhcPass _) = NoExtField
-type instance XTickPragma (GhcPass _) = NoExtField
type instance XXPragE (GhcPass _) = NoExtCon
-- | Located Haskell Tuple Argument
@@ -1402,13 +1391,6 @@ instance Outputable (HsPragE (GhcPass p)) where
-- no doublequotes if stl empty, for the case where the SCC was written
-- without quotes.
<+> pprWithSourceText stl (ftext lbl) <+> text "#-}"
- ppr (HsPragTick _ st (StringLiteral sta s, (v1,v2), (v3,v4)) ((s1,s2),(s3,s4))) =
- pprWithSourceText st (text "{-# GENERATED")
- <+> pprWithSourceText sta (doubleQuotes $ ftext s)
- <+> pprWithSourceText s1 (ppr v1) <+> char ':' <+> pprWithSourceText s2 (ppr v2)
- <+> char '-'
- <+> pprWithSourceText s3 (ppr v3) <+> char ':' <+> pprWithSourceText s4 (ppr v4)
- <+> text "#-}"
{-
************************************************************************
=====================================
compiler/GHC/HsToCore/Coverage.hs
=====================================
@@ -618,10 +618,6 @@ addTickHsExpr (HsTick x t e) =
addTickHsExpr (HsBinTick x t0 t1 e) =
liftM (HsBinTick x t0 t1) (addTickLHsExprNever e)
-addTickHsExpr (HsPragE _ HsPragTick{} (L pos e0)) = do
- e2 <- allocTickBox (ExpBox False) False False pos $
- addTickHsExpr e0
- return $ unLoc e2
addTickHsExpr (HsPragE x p e) =
liftM (HsPragE x p) (addTickLHsExpr e)
addTickHsExpr e@(HsBracket {}) = return e
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -820,11 +820,6 @@ ds_prag_expr (HsPragSCC _ _ cc) expr = do
Tick (ProfNote (mkUserCC nm mod_name (getLoc expr) flavour) count True)
<$> dsLExpr expr
else dsLExpr expr
-ds_prag_expr (HsPragTick _ _ _ _) expr = do
- dflags <- getDynFlags
- if gopt Opt_Hpc dflags
- then panic "dsExpr:HsPragTick"
- else dsLExpr expr
------------------------------
dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1572,7 +1572,6 @@ repE (HsUnboundVar _ uv) = do
repUnboundVar sname
repE (XExpr (HsExpanded _ b)) = repE b
repE e@(HsPragE _ HsPragSCC {} _) = notHandled "Cost centres" (ppr e)
-repE e@(HsPragE _ HsPragTick {} _) = notHandled "Tick Pragma" (ppr e)
repE e = notHandled "Expression form" (ppr e)
-----------------------------------------------------------------------------
=====================================
compiler/GHC/Parser.y
=====================================
@@ -514,7 +514,6 @@ are the most common patterns, rewritten as regular expressions for clarity:
'{-# SOURCE' { L _ (ITsource_prag _) }
'{-# RULES' { L _ (ITrules_prag _) }
'{-# SCC' { L _ (ITscc_prag _)}
- '{-# GENERATED' { L _ (ITgenerated_prag _) }
'{-# DEPRECATED' { L _ (ITdeprecated_prag _) }
'{-# WARNING' { L _ (ITwarning_prag _) }
'{-# UNPACK' { L _ (ITunpack_prag _) }
@@ -2525,8 +2524,7 @@ optSemi :: { ([Located Token],Bool) }
{- Note [Pragmas and operator fixity]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-'prag_e' is an expression pragma, such as {-# SCC ... #-} or
-{-# GENERATED ... #-}.
+'prag_e' is an expression pragma, such as {-# SCC ... #-}.
It must be used with care, or else #15730 happens. Consider this infix
expression:
@@ -2580,20 +2578,6 @@ prag_e :: { Located ([AddAnn], HsPragE GhcPs) }
HsPragSCC noExtField
(getSCC_PRAGs $1)
(StringLiteral NoSourceText (getVARID $2))) }
- | '{-# GENERATED' STRING INTEGER ':' INTEGER HYPHEN INTEGER ':' INTEGER '#-}'
- { let getINT = fromInteger . il_value . getINTEGER in
- sLL $1 $> $ ([mo $1,mj AnnVal $2
- ,mj AnnVal $3,mj AnnColon $4
- ,mj AnnVal $5] ++ $6 ++
- [mj AnnVal $7,mj AnnColon $8
- ,mj AnnVal $9,mc $10],
- HsPragTick noExtField
- (getGENERATED_PRAGs $1)
- (getStringLiteral $2,
- (getINT $3, getINT $5),
- (getINT $7, getINT $9))
- ((getINTEGERs $3, getINTEGERs $5),
- (getINTEGERs $7, getINTEGERs $9) )) }
fexp :: { ECP }
: fexp aexp { ECP $
superFunArg $
@@ -3700,7 +3684,6 @@ getRULES_PRAGs (L _ (ITrules_prag src)) = src
getWARNING_PRAGs (L _ (ITwarning_prag src)) = src
getDEPRECATED_PRAGs (L _ (ITdeprecated_prag src)) = src
getSCC_PRAGs (L _ (ITscc_prag src)) = src
-getGENERATED_PRAGs (L _ (ITgenerated_prag src)) = src
getUNPACK_PRAGs (L _ (ITunpack_prag src)) = src
getNOUNPACK_PRAGs (L _ (ITnounpack_prag src)) = src
getANN_PRAGs (L _ (ITann_prag src)) = src
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -743,7 +743,6 @@ data Token
| ITline_prag SourceText -- not usually produced, see 'UsePosPragsBit'
| ITcolumn_prag SourceText -- not usually produced, see 'UsePosPragsBit'
| ITscc_prag SourceText
- | ITgenerated_prag SourceText
| ITunpack_prag SourceText
| ITnounpack_prag SourceText
| ITann_prag SourceText
@@ -3289,7 +3288,6 @@ oneWordPrags = Map.fromList [
("warning", strtoken (\s -> ITwarning_prag (SourceText s))),
("deprecated", strtoken (\s -> ITdeprecated_prag (SourceText s))),
("scc", strtoken (\s -> ITscc_prag (SourceText s))),
- ("generated", strtoken (\s -> ITgenerated_prag (SourceText s))),
("unpack", strtoken (\s -> ITunpack_prag (SourceText s))),
("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))),
("ann", strtoken (\s -> ITann_prag (SourceText s))),
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -243,7 +243,6 @@ rnExpr (HsPragE x prag expr)
where
rn_prag :: HsPragE GhcPs -> HsPragE GhcRn
rn_prag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann
- rn_prag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo
rnExpr (HsLam x matches)
= do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -1082,7 +1082,6 @@ tcExpr other _ = pprPanic "tcLExpr" (ppr other)
tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc
tcExprPrag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann
-tcExprPrag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo
{- *********************************************************************
=====================================
testsuite/tests/ghc-api/annotations/T10313.stdout
=====================================
@@ -10,5 +10,4 @@
([c], [(SourceText "foo\x63", fooc), (SourceText "b\x61r", bar)]),
([r], [(SourceText "foo1\x67", foo1g)]),
([s, t], [(SourceText "a\x62", ab)]),
- ([s, c], [(SourceText "foo\x64", food)]),
- ([t, p], [(SourceText "foob\x61r", foobar)])]
+ ([s, c], [(SourceText "foo\x64", food)])]
=====================================
testsuite/tests/ghc-api/annotations/T11430.stdout
=====================================
@@ -3,4 +3,3 @@
("ia",["1"])
("ia",["0x999"])
("ia",["1"])
-("tp",["((SourceText \"0x1\",SourceText \"0x2\"),(SourceText \"0x3\",SourceText \"0x4\"))"])
=====================================
testsuite/tests/ghc-api/annotations/Test10313.hs
=====================================
@@ -33,5 +33,3 @@ strictStream (Bitstream l v)
Exact l
b = {-# SCC "foo\x64" #-} 006
-
-c = {-# GENERATED "foob\x61r" 1 : 2 - 3 : 4 #-} 0.00
=====================================
testsuite/tests/ghc-api/annotations/Test11430.hs
=====================================
@@ -21,5 +21,3 @@ x = undefined
{-# INLINABLE [1] y #-}
y :: (Num a, Integral b) => a -> b -> a
y = undefined
-
-c = {-# GENERATED "foob\x61r" 0x1 : 0x2 - 0x3 : 0x4 #-} 0.00
=====================================
testsuite/tests/ghc-api/annotations/stringSource.hs
=====================================
@@ -86,7 +86,6 @@ testOneFile libdir fileName = do
doPragE :: HsPragE GhcPs -> [(String,[Located (SourceText,FastString)])]
doPragE (HsPragSCC _ src ss) = [("sc",[conv (noLoc ss)])]
- doPragE (HsPragTick _ src (ss,_,_) _ss2) = [("tp",[conv (noLoc ss)])]
conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs)
=====================================
testsuite/tests/ghc-api/annotations/t11430.hs
=====================================
@@ -68,7 +68,6 @@ testOneFile libdir fileName = do
doRuleDecl (HsRule _ _ _ _ _ _ _) = []
doHsExpr :: HsExpr GhcPs -> [(String,[String])]
- doHsExpr (HsPragE _ (HsPragTick _ src (_,_,_) ss) _) = [("tp",[show ss])]
doHsExpr _ = []
doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _)
=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -190,10 +190,6 @@ ppr045:
ppr046:
$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr046.hs
-.PHONY: ppr047
-ppr047:
- $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr047.hs
-
.PHONY: ppr048
ppr048:
$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr048.hs
=====================================
testsuite/tests/printer/Ppr047.hs deleted
=====================================
@@ -1,3 +0,0 @@
-module ExprPragmas where
-
-c = {-# GENERATED "foobar" 1 : 2 - 3 : 4 #-} 0.00
=====================================
testsuite/tests/printer/all.T
=====================================
@@ -44,7 +44,6 @@ test('Ppr043', [ignore_stderr, req_interp], makefile_test, ['ppr043'])
test('Ppr044', ignore_stderr, makefile_test, ['ppr044'])
test('Ppr045', ignore_stderr, makefile_test, ['ppr045'])
test('Ppr046', ignore_stderr, makefile_test, ['ppr046'])
-test('Ppr047', ignore_stderr, makefile_test, ['ppr047'])
test('Ppr048', ignore_stderr, makefile_test, ['ppr048'])
test('T13199', [ignore_stderr, req_interp], makefile_test, ['T13199'])
test('T13050p', ignore_stderr, makefile_test, ['T13050p'])
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 54468d1e60cb10093120137766cfc9dd91671c98
+Subproject commit e514a52a496d1ec216568deec374872b4b5251a6
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28c79894b4e2d2616815f916f46fe26f389012da
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28c79894b4e2d2616815f916f46fe26f389012da
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200908/e80357b3/attachment-0001.html>
More information about the ghc-commits
mailing list