X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=1be9aa3443047a383be041bbfddd8527112a72d2;hb=9c5675a3f32ba9d3e8d66c43773a24d30cd4dec8;hp=18238643999ca06645a26a039b3136f446487156;hpb=2c4b58d916b109f7285916a61dfd2755eeb7f22d;p=ghc-hetmet.git

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 1823864..1be9aa3 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"
@@ -405,7 +406,6 @@ data Token
   | ITdata
   | ITdefault
   | ITderiving
-  | ITderive
   | ITdo
   | ITelse
   | IThiding
@@ -559,7 +559,6 @@ isSpecial :: Token -> Bool
 -- not as a keyword.
 isSpecial ITas        	= True
 isSpecial IThiding    	= True
-isSpecial ITderive    	= True
 isSpecial ITqualified 	= True
 isSpecial ITforall    	= True
 isSpecial ITexport    	= True
@@ -590,7 +589,6 @@ reservedWordsFM = listToUFM $
 	( "data",	ITdata, 	0 ),     
 	( "default",	ITdefault, 	0 ),  
 	( "deriving",	ITderiving, 	0 ), 
-	( "derive",	ITderive, 	0 ), 
 	( "do",		ITdo, 		0 ),       
 	( "else",	ITelse, 	0 ),     
 	( "hiding",	IThiding, 	0 ),
@@ -774,7 +772,7 @@ multiline_doc_comment span buf _len = withLexedDocType (worker "")
 nested_comment :: P (Located Token) -> Action
 nested_comment cont span _str _len = do
   input <- getInput
-  go 1 input
+  go (1::Int) input
   where
     go 0 input = do setInput input; cont
     go n input = case alexGetChar input of
@@ -1301,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
 
 -- -----------------------------------------------------------------------------
@@ -1563,7 +1561,7 @@ mkPState buf loc flags  =
 	       .|. ffiBit       `setBitIf` dopt Opt_ForeignFunctionInterface flags
 	       .|. parrBit      `setBitIf` dopt Opt_PArr         flags
 	       .|. arrowsBit    `setBitIf` dopt Opt_Arrows       flags
-	       .|. thBit        `setBitIf` dopt Opt_TH           flags
+	       .|. thBit        `setBitIf` dopt Opt_TemplateHaskell flags
 	       .|. ipBit        `setBitIf` dopt Opt_ImplicitParams flags
 	       .|. explicitForallBit `setBitIf` dopt Opt_ScopedTypeVariables flags
 	       .|. explicitForallBit `setBitIf` dopt Opt_PolymorphicComponents flags
@@ -1584,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