Warn about unrecognised pragmas; these often mean we've typoed

[ghc-hetmet.git] / compiler / main / DynFlags.hs

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f40ac43..3bb7c1c 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -83,7 +83,7 @@ import Control.Monad    ( when )
 
 import Data.Char
 import System.FilePath
 
 import Data.Char
 import System.FilePath

-import System.IO        ( hPutStrLn, stderr )
+import System.IO        ( stderr, hPutChar )

 
 -- -----------------------------------------------------------------------------
 -- DynFlags
 
 -- -----------------------------------------------------------------------------
 -- DynFlags

@@ -169,11 +169,13 @@ data DynFlag
    | Opt_WarnUnusedBinds
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches
    | Opt_WarnUnusedBinds
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches

-   | Opt_WarnDeprecations
+   | Opt_WarnWarningsDeprecations

    | Opt_WarnDeprecatedFlags
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs
    | Opt_WarnDeprecatedFlags
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs

+   | Opt_WarnUnrecognisedPragmas
+   | Opt_WarnDodgyForeignImports

 
    -- language opts
    | Opt_OverlappingInstances
 
    -- language opts
    | Opt_OverlappingInstances

@@ -221,6 +223,7 @@ data DynFlag
    | Opt_TransformListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
    | Opt_TransformListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo

+   | Opt_PostfixOperators

    | Opt_PatternGuards
    | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types
    | Opt_PatternGuards
    | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types

@@ -361,7 +364,6 @@ data DynFlags = DynFlags {
   opt_m                 :: [String],
   opt_a                 :: [String],
   opt_l                 :: [String],
   opt_m                 :: [String],
   opt_a                 :: [String],
   opt_l                 :: [String],

-  opt_dep               :: [String],

   opt_windres           :: [String],
 
   -- commands for particular phases
   opt_windres           :: [String],
 
   -- commands for particular phases

@@ -378,6 +380,13 @@ data DynFlags = DynFlags {
   pgm_sysman            :: String,
   pgm_windres           :: String,
 
   pgm_sysman            :: String,
   pgm_windres           :: String,
 

+  --  For ghc -M
+  depMakefile           :: FilePath,
+  depIncludePkgDeps     :: Bool,
+  depExcludeMods        :: [ModuleName],
+  depSuffixes           :: [String],
+  depWarnings           :: Bool,
+

   --  Package flags
   extraPkgConfs         :: [FilePath],
   topDir                :: FilePath,    -- filled in by SysTools
   --  Package flags
   extraPkgConfs         :: [FilePath],
   topDir                :: FilePath,    -- filled in by SysTools

@@ -539,7 +548,6 @@ defaultDynFlags =
         opt_a                   = [],
         opt_m                   = [],
         opt_l                   = [],
         opt_a                   = [],
         opt_m                   = [],
         opt_l                   = [],

-        opt_dep                 = [],

         opt_windres             = [],
 
         extraPkgConfs           = [],
         opt_windres             = [],
 
         extraPkgConfs           = [],

@@ -567,6 +575,13 @@ defaultDynFlags =
         pgm_sysman              = panic "defaultDynFlags: No pgm_sysman",
         pgm_windres             = panic "defaultDynFlags: No pgm_windres",
         -- end of initSysTools values
         pgm_sysman              = panic "defaultDynFlags: No pgm_sysman",
         pgm_windres             = panic "defaultDynFlags: No pgm_windres",
         -- end of initSysTools values

+        -- ghc -M values
+        depMakefile       = "Makefile",
+        depIncludePkgDeps = False,
+        depExcludeMods    = [],
+        depSuffixes       = [],
+        depWarnings       = True,
+        -- end of ghc -M values

         haddockOptions = Nothing,
         flags = [
             Opt_AutoLinkPackages,
         haddockOptions = Nothing,
         flags = [
             Opt_AutoLinkPackages,

@@ -593,9 +608,14 @@ defaultDynFlags =
 
         log_action = \severity srcSpan style msg ->
                         case severity of
 
         log_action = \severity srcSpan style msg ->
                         case severity of

-                          SevInfo  -> hPutStrLn stderr (show (msg style))
-                          SevFatal -> hPutStrLn stderr (show (msg style))
-                          _        -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style))
+                          SevInfo  -> printErrs (msg style)
+                          SevFatal -> printErrs (msg style)
+                          _        -> do 
+                                hPutChar stderr '\n'
+                                printErrs ((mkLocMessage srcSpan msg) style)
+                     -- careful (#2302): printErrs prints in UTF-8, whereas
+                     -- converting to string first and using hPutStr would
+                     -- just emit the low 8 bits of each unicode char.

       }
 
 {-
       }
 
 {-

@@ -629,7 +649,7 @@ getVerbFlag dflags
 
 setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
          setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
 
 setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
          setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,

-         addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptdep, addOptwindres,
+         addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,

          addCmdlineFramework, addHaddockOpts
    :: String -> DynFlags -> DynFlags
 setOutputFile, setOutputHi, setDumpPrefixForce
          addCmdlineFramework, addHaddockOpts
    :: String -> DynFlags -> DynFlags
 setOutputFile, setOutputHi, setDumpPrefixForce

@@ -639,7 +659,7 @@ setObjectDir  f d = d{ objectDir  = Just f}
 setHiDir      f d = d{ hiDir      = Just f}
 setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
 setHiDir      f d = d{ hiDir      = Just f}
 setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file

-  -- #included from the .hc file when compiling with -fvia-C.
+  -- \#included from the .hc file when compiling with -fvia-C.

 
 setObjectSuf  f d = d{ objectSuf  = f}
 setHiSuf      f d = d{ hiSuf      = f}
 
 setObjectSuf  f d = d{ objectSuf  = f}
 setHiSuf      f d = d{ hiSuf      = f}

@@ -680,9 +700,32 @@ addOptc   f d = d{ opt_c   = f : opt_c d}
 addOptm   f d = d{ opt_m   = f : opt_m d}
 addOpta   f d = d{ opt_a   = f : opt_a d}
 addOptl   f d = d{ opt_l   = f : opt_l d}
 addOptm   f d = d{ opt_m   = f : opt_m d}
 addOpta   f d = d{ opt_a   = f : opt_a d}
 addOptl   f d = d{ opt_l   = f : opt_l d}

-addOptdep f d = d{ opt_dep = f : opt_dep d}

 addOptwindres f d = d{ opt_windres = f : opt_windres d}
 
 addOptwindres f d = d{ opt_windres = f : opt_windres d}
 

+setDepMakefile :: FilePath -> DynFlags -> DynFlags
+setDepMakefile f d = d { depMakefile = deOptDep f }
+
+setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
+setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
+
+addDepExcludeMod :: String -> DynFlags -> DynFlags
+addDepExcludeMod m d
+    = d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }
+
+addDepSuffix :: FilePath -> DynFlags -> DynFlags
+addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
+
+setDepWarnings :: Bool -> DynFlags -> DynFlags
+setDepWarnings b d = d { depWarnings = b }
+
+-- XXX Legacy code:
+-- We used to use "-optdep-flag -optdeparg", so for legacy applications
+-- we need to strip the "-optdep" off of the arg
+deOptDep :: String -> String
+deOptDep x = case maybePrefixMatch "-optdep" x of
+             Just rest -> rest
+             Nothing -> x
+

 addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
 
 addHaddockOpts f d = d{ haddockOptions = Just f}
 addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
 
 addHaddockOpts f d = d{ haddockOptions = Just f}

@@ -749,12 +792,14 @@ optLevelFlags
 
 standardWarnings :: [DynFlag]
 standardWarnings
 
 standardWarnings :: [DynFlag]
 standardWarnings

-    = [ Opt_WarnDeprecations,
+    = [ Opt_WarnWarningsDeprecations,

         Opt_WarnDeprecatedFlags,
         Opt_WarnDeprecatedFlags,

+        Opt_WarnUnrecognisedPragmas,

         Opt_WarnOverlappingPatterns,
         Opt_WarnMissingFields,
         Opt_WarnMissingMethods,
         Opt_WarnOverlappingPatterns,
         Opt_WarnMissingFields,
         Opt_WarnMissingMethods,

-        Opt_WarnDuplicateExports
+        Opt_WarnDuplicateExports,
+        Opt_WarnDodgyForeignImports

       ]
 
 minusWOpts :: [DynFlag]
       ]
 
 minusWOpts :: [DynFlag]

@@ -785,6 +830,7 @@ minuswRemovesOpts
        Opt_WarnIncompletePatternsRecUpd,
        Opt_WarnSimplePatterns,
        Opt_WarnMonomorphism,
        Opt_WarnIncompletePatternsRecUpd,
        Opt_WarnSimplePatterns,
        Opt_WarnMonomorphism,

+       Opt_WarnUnrecognisedPragmas,

        Opt_WarnTabs
       ]
 
        Opt_WarnTabs
       ]
 

@@ -1056,13 +1102,32 @@ dynamic_flags = [
   , Flag "optm"           (HasArg (upd . addOptm)) Supported
   , Flag "opta"           (HasArg (upd . addOpta)) Supported
   , Flag "optl"           (HasArg (upd . addOptl)) Supported
   , Flag "optm"           (HasArg (upd . addOptm)) Supported
   , Flag "opta"           (HasArg (upd . addOpta)) Supported
   , Flag "optl"           (HasArg (upd . addOptl)) Supported

-  , Flag "optdep"         (HasArg (upd . addOptdep)) Supported

   , Flag "optwindres"     (HasArg (upd . addOptwindres)) Supported
 
   , Flag "split-objs"
          (NoArg (if can_split then setDynFlag Opt_SplitObjs else return ()))
          Supported
 
   , Flag "optwindres"     (HasArg (upd . addOptwindres)) Supported
 
   , Flag "split-objs"
          (NoArg (if can_split then setDynFlag Opt_SplitObjs else return ()))
          Supported
 

+        -------- ghc -M -----------------------------------------------------
+  , Flag "dep-suffix"               (HasArg (upd . addDepSuffix)) Supported
+  , Flag "optdep-s"                 (HasArg (upd . addDepSuffix))
+         (Deprecated "Use -dep-suffix instead")
+  , Flag "dep-makefile"             (HasArg (upd . setDepMakefile)) Supported
+  , Flag "optdep-f"                 (HasArg (upd . setDepMakefile))
+         (Deprecated "Use -dep-makefile instead")
+  , Flag "optdep-w"                 (NoArg  (upd (setDepWarnings False)))
+         (Deprecated "-optdep-w doesn't do anything")
+  , Flag "include-pkg-deps" (NoArg  (upd (setDepIncludePkgDeps True))) Supported
+  , Flag "optdep--include-prelude"  (NoArg  (upd (setDepIncludePkgDeps True)))
+         (Deprecated "Use -include-pkg-deps instead")
+  , Flag "optdep--include-pkg-deps" (NoArg  (upd (setDepIncludePkgDeps True)))
+         (Deprecated "Use -include-pkg-deps instead")
+  , Flag "exclude-module"           (HasArg (upd . addDepExcludeMod)) Supported
+  , Flag "optdep--exclude-module"   (HasArg (upd . addDepExcludeMod))
+         (Deprecated "Use -exclude-module instead")
+  , Flag "optdep-x"                 (HasArg (upd . addDepExcludeMod))
+         (Deprecated "Use -exclude-module instead")
+

         -------- Linking ----------------------------------------------------
   , Flag "c"              (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
          Supported
         -------- Linking ----------------------------------------------------
   , Flag "c"              (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
          Supported

@@ -1381,6 +1446,7 @@ deprecatedForLanguage lang turnOn =
 
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
 
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [

+  ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),

   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),
   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),

@@ -1398,10 +1464,11 @@ fFlags = [
   ( "warn-unused-binds",                Opt_WarnUnusedBinds, const Supported ),
   ( "warn-unused-imports",              Opt_WarnUnusedImports, const Supported ),
   ( "warn-unused-matches",              Opt_WarnUnusedMatches, const Supported ),
   ( "warn-unused-binds",                Opt_WarnUnusedBinds, const Supported ),
   ( "warn-unused-imports",              Opt_WarnUnusedImports, const Supported ),
   ( "warn-unused-matches",              Opt_WarnUnusedMatches, const Supported ),

-  ( "warn-deprecations",                Opt_WarnDeprecations, const Supported ),
+  ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, const Supported ),

   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, const Supported ),
   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),
   ( "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 ),
   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, const Supported ),
   ( "strictness",                       Opt_Strictness, const Supported ),
   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, const Supported ),

@@ -1480,6 +1547,7 @@ languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
 xFlags :: [(String, DynFlag, Bool -> Deprecated)]
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
 xFlags :: [(String, DynFlag, Bool -> Deprecated)]
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),

+  ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),

   ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
   ( "MagicHash",                        Opt_MagicHash, const Supported ),
   ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
   ( "MagicHash",                        Opt_MagicHash, const Supported ),

@@ -1567,6 +1635,7 @@ glasgowExtsFlags = [
            , Opt_PolymorphicComponents
            , Opt_ExistentialQuantification
            , Opt_UnicodeSyntax
            , Opt_PolymorphicComponents
            , Opt_ExistentialQuantification
            , Opt_UnicodeSyntax

+           , Opt_PostfixOperators

            , Opt_PatternGuards
            , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
            , Opt_PatternGuards
            , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes

@@ -1585,8 +1654,19 @@ glasgowExtsFlags = [
 
 parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String])
 parseDynamicFlags dflags args = do
 
 parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String])
 parseDynamicFlags dflags args = do

+  -- XXX Legacy support code
+  -- We used to accept things like
+  --     optdep-f  -optdepdepend
+  --     optdep-f  -optdep depend
+  --     optdep -f -optdepdepend
+  --     optdep -f -optdep depend
+  -- but the spaces trip up proper argument handling. So get rid of them.
+  let f ("-optdep" : x : xs) = ("-optdep" ++ x) : f xs
+      f (x : xs) = x : f xs
+      f xs = xs
+      args' = f args

   let ((leftover, errs, warns), dflags')
   let ((leftover, errs, warns), dflags')

-          = runCmdLine (processArgs dynamic_flags args) dflags
+          = runCmdLine (processArgs dynamic_flags args') dflags

   when (not (null errs)) $ do
     throwDyn (UsageError (unlines errs))
   return (dflags', leftover, warns)
   when (not (null errs)) $ do
     throwDyn (UsageError (unlines errs))
   return (dflags', leftover, warns)

@@ -1898,7 +1978,6 @@ machdepCCOpts _dflags
                sta = opt_Static
            in
                     ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
                sta = opt_Static
            in
                     ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""

---                    , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else ""

                       ],
                       [ "-fno-defer-pop",
                         "-fomit-frame-pointer",
                       ],
                       [ "-fno-defer-pop",
                         "-fomit-frame-pointer",