Split the Id related functions out from Var into Id, document Var and some of Id

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

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f40ac43..5031ded 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -69,7 +69,7 @@ import DriverPhases     ( Phase(..), phaseInputExt )
 import Config
 import CmdLineParser
 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
 import Config
 import CmdLineParser
 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )

-import Panic            ( panic, GhcException(..) )
+import Panic

 import UniqFM           ( UniqFM )
 import Util
 import Maybes           ( orElse )
 import UniqFM           ( UniqFM )
 import Util
 import Maybes           ( orElse )

@@ -78,12 +78,11 @@ import Outputable
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
 import Data.IORef       ( readIORef )
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
 import Data.IORef       ( readIORef )

-import Control.Exception ( throwDyn )

 import Control.Monad    ( when )
 
 import Data.Char
 import System.FilePath
 import Control.Monad    ( when )
 
 import Data.Char
 import System.FilePath

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

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

@@ -169,11 +168,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 +222,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

@@ -276,6 +278,7 @@ data DynFlag
    | Opt_RunCPSZ
    | Opt_ConvertToZipCfgAndBack
    | Opt_AutoLinkPackages
    | Opt_RunCPSZ
    | Opt_ConvertToZipCfgAndBack
    | Opt_AutoLinkPackages

+   | Opt_ImplicitImportQualified

 
    -- keeping stuff
    | Opt_KeepHiDiffs
 
    -- keeping stuff
    | Opt_KeepHiDiffs

@@ -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 ),

@@ -1466,7 +1533,8 @@ fFlags = [
   ( "allow-incoherent-instances",       Opt_IncoherentInstances,
     deprecatedForLanguage "IncoherentInstances" ),
   ( "gen-manifest",                     Opt_GenManifest, const Supported ),
   ( "allow-incoherent-instances",       Opt_IncoherentInstances,
     deprecatedForLanguage "IncoherentInstances" ),
   ( "gen-manifest",                     Opt_GenManifest, const Supported ),

-  ( "embed-manifest",                   Opt_EmbedManifest, const Supported )
+  ( "embed-manifest",                   Opt_EmbedManifest, const Supported ),
+  ( "implicit-import-qualified",        Opt_ImplicitImportQualified, const Supported )

   ]
 
 supportedLanguages :: [String]
   ]
 
 supportedLanguages :: [String]

@@ -1480,6 +1548,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 +1636,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,10 +1655,21 @@ 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
   when (not (null errs)) $ do

-    throwDyn (UsageError (unlines errs))
+    ghcError (UsageError (unlines errs))

   return (dflags', leftover, warns)
 
 type DynP = CmdLineP DynFlags
   return (dflags', leftover, warns)
 
 type DynP = CmdLineP DynFlags

@@ -1680,7 +1761,7 @@ ignorePackage p =
 setPackageName :: String -> DynFlags -> DynFlags
 setPackageName p
   | Nothing <- unpackPackageId pid
 setPackageName :: String -> DynFlags -> DynFlags
 setPackageName p
   | Nothing <- unpackPackageId pid

-  = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
+  = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))

   | otherwise
   = \s -> s{ thisPackage = pid }
   where
   | otherwise
   = \s -> s{ thisPackage = pid }
   where

@@ -1898,7 +1979,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",