Add a deprecated warning for _scc_

2 files changed, 11 insertions, 7 deletions

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 8ae3cd9435..1be9aa3443 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -28,7 +28,8 @@ module Lexer (
    getMessages,
    popContext, pushCurrentContext, setLastToken, setSrcLoc,
    getLexState, popLexState, pushLexState,
-   extension, standaloneDerivingEnabled, bangPatEnabled
+   extension, standaloneDerivingEnabled, bangPatEnabled,
+   addWarning
   ) where
 
 #include "HsVersions.h"
@@ -1298,8 +1299,8 @@ getCharOrFail =  do
 -- Warnings
 
 warn :: DynFlag -> SDoc -> Action
-warn option warning span _buf _len = do
-    addWarning option (mkWarnMsg span alwaysQualify warning)
+warn option warning srcspan _buf _len = do
+    addWarning option srcspan warning
     lexToken
 
 -- -----------------------------------------------------------------------------
@@ -1581,10 +1582,11 @@ mkPState buf loc flags  =
       b `setBitIf` cond | cond      = bit b
 			| otherwise = 0
 
-addWarning :: DynFlag -> WarnMsg -> P ()
-addWarning option w
+addWarning :: DynFlag -> SrcSpan -> SDoc -> P ()
+addWarning option srcspan warning
  = P $ \s@PState{messages=(ws,es), dflags=d} ->
-       let ws' = if dopt option d then ws `snocBag` w else ws
+       let warning' = mkWarnMsg srcspan alwaysQualify warning
+           ws' = if dopt option d then ws `snocBag` warning' else ws
        in POk s{messages=(ws', es)} ()
 
 getMessages :: PState -> Messages
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 4567e072b3..b624455d3f 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -35,6 +35,7 @@ import StaticFlags	( opt_SccProfilingOn, opt_Hpc )
 import Type		( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
 import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
 			  Activation(..), defaultInlineSpec )
+import DynFlags
 import OrdList
 import HaddockParse
 import {-# SOURCE #-} HaddockLex hiding ( Token )
@@ -1295,7 +1296,8 @@ exp10 :: { LHsExpr RdrName }
 	| fexp					{ $1 }
 
 scc_annot :: { Located FastString }
-	: '_scc_' STRING			{ LL $ getSTRING $2 }
+	: '_scc_' STRING			{% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ ->
+                                   (return $ LL $ getSTRING $2) }
 	| '{-# SCC' STRING '#-}'		{ LL $ getSTRING $2 }
 
 hpc_annot :: { Located (FastString,(Int,Int),(Int,Int)) }