From beea3d146a69be0986d8783c3de2864f62a88c79 Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Tue, 22 Jul 2008 23:55:50 +0000
Subject: [PATCH] Warn about unrecognised pragmas; these often mean we've
 typoed

---
 compiler/main/DynFlags.hs |    4 ++++
 compiler/parser/Lexer.x   |   20 +++++++++++++++++---
 2 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 11fd02b..3bb7c1c 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -174,6 +174,7 @@ data DynFlag
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs
+   | Opt_WarnUnrecognisedPragmas
    | Opt_WarnDodgyForeignImports
 
    -- language opts
@@ -793,6 +794,7 @@ standardWarnings :: [DynFlag]
 standardWarnings
     = [ Opt_WarnWarningsDeprecations,
         Opt_WarnDeprecatedFlags,
+        Opt_WarnUnrecognisedPragmas,
         Opt_WarnOverlappingPatterns,
         Opt_WarnMissingFields,
         Opt_WarnMissingMethods,
@@ -828,6 +830,7 @@ minuswRemovesOpts
        Opt_WarnIncompletePatternsRecUpd,
        Opt_WarnSimplePatterns,
        Opt_WarnMonomorphism,
+       Opt_WarnUnrecognisedPragmas,
        Opt_WarnTabs
       ]
 
@@ -1465,6 +1468,7 @@ fFlags = [
   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, const Supported ),
   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),
+  ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, const Supported ),
   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, const Supported ),
   ( "strictness",                       Opt_Strictness, const Supported ),
   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, const Supported ),
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index b74a732..2f22106 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -258,7 +258,10 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
   "{-#" $whitechar* (CORE|core)		{ token ITcore_prag }
   "{-#" $whitechar* (UNPACK|unpack)	{ token ITunpack_prag }
 
- "{-#"                                 { nested_comment lexToken }
+  -- We ignore all these pragmas, but don't generate a warning for them
+  -- CFILES is a hugs-only thing.
+  "{-#" $whitechar* (OPTIONS_HUGS|options_hugs|OPTIONS_NHC98|options_nhc98|OPTIONS_JHC|options_jhc|CFILES|cfiles)
+                    { nested_comment lexToken }
 
   -- ToDo: should only be valid inside a pragma:
   "#-}" 				{ token ITclose_prag}
@@ -276,12 +279,18 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
 }
 
 <0> {
+  -- In the "0" mode we ignore these pragmas
+  "{-#"  $whitechar* (OPTIONS|options|OPTIONS_GHC|options_ghc|OPTIONS_HADDOCK|options_haddock|LANGUAGE|language|INCLUDE|include)
+                     { nested_comment lexToken }
+}
+
+<0> {
   "-- #" .* ;
 }
 
 <0,option_prags> {
-	-- This is to catch things like {-# OPTIONS OPTIONS_HUGS ... 
-  "{-#" $whitechar* $idchar+		{ nested_comment lexToken }
+  "{-#"  { warnThen Opt_WarnUnrecognisedPragmas (text "Unrecognised pragma")
+                    (nested_comment lexToken) }
 }
 
 -- '0' state: ordinary lexemes
@@ -1378,6 +1387,11 @@ warn option warning srcspan _buf _len = do
     addWarning option srcspan warning
     lexToken
 
+warnThen :: DynFlag -> SDoc -> Action -> Action
+warnThen option warning action srcspan buf len = do
+    addWarning option srcspan warning
+    action srcspan buf len
+
 -- -----------------------------------------------------------------------------
 -- The Parse Monad
 
-- 
1.7.10.4