Add unique package identifiers (InstalledPackageId) in the package DB

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

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0809d04..f4975f0 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -21,6 +21,7 @@ module DynFlags (
         DynLibLoader(..),
         fFlags, xFlags,
         dphPackage,
+        wayNames,
 
         -- ** Manipulating DynFlags
         defaultDynFlags,                -- DynFlags
@@ -69,11 +70,7 @@ import Platform
 import Module
 import PackageConfig
 import PrelNames        ( mAIN )
-#if defined(i386_TARGET_ARCH) || (!defined(mingw32_TARGET_OS) && !defined(darwin_TARGET_OS))
-import StaticFlags      ( opt_Static )
-#endif
-import StaticFlags      ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
-                          v_RTS_Build_tag )
+import StaticFlags
 import {-# SOURCE #-} Packages (PackageState)
 import DriverPhases     ( Phase(..), phaseInputExt )
 import Config
@@ -371,7 +368,7 @@ data DynFlags = DynFlags {
   thisPackage           :: PackageId,   -- ^ name of package currently being compiled
 
   -- ways
-  wayNames              :: [WayName],   -- ^ Way flags from the command line
+  ways                  :: [Way],       -- ^ Way flags from the command line
   buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
   rtsBuildTag           :: String,      -- ^ The RTS \"way\"
 
@@ -471,6 +468,9 @@ data DynFlags = DynFlags {
   haddockOptions :: Maybe String
  }
 
+wayNames :: DynFlags -> [WayName]
+wayNames = map wayName . ways
+
 -- | The target code type of the compilation (if any).
 --
 -- Whenever you change the target, also make sure to set 'ghcLink' to
@@ -571,14 +571,12 @@ initDynFlags :: DynFlags -> IO DynFlags
 initDynFlags dflags = do
  -- someday these will be dynamic flags
  ways <- readIORef v_Ways
- build_tag <- readIORef v_Build_tag
- rts_build_tag <- readIORef v_RTS_Build_tag
  refFilesToClean <- newIORef []
  refDirsToClean <- newIORef emptyFM
  return dflags{
-        wayNames        = ways,
-        buildTag        = build_tag,
-        rtsBuildTag     = rts_build_tag,
+        ways            = ways,
+        buildTag        = mkBuildTag (filter (not . wayRTSOnly) ways),
+        rtsBuildTag     = mkBuildTag ways,
         filesToClean    = refFilesToClean,
         dirsToClean     = refDirsToClean
         }
@@ -654,7 +652,7 @@ defaultDynFlags =
         packageFlags            = [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
-        wayNames                = panic "defaultDynFlags: No wayNames",
+        ways                    = panic "defaultDynFlags: No ways",
         buildTag                = panic "defaultDynFlags: No buildTag",
         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
         splitInfo               = Nothing,
@@ -1241,7 +1239,8 @@ dynamic_flags = [
     Flag "n"              (NoArg  (setDynFlag Opt_DryRun)) Supported
   , Flag "cpp"            (NoArg  (setDynFlag Opt_Cpp)) Supported
   , Flag "F"              (NoArg  (setDynFlag Opt_Pp)) Supported
-  , Flag "#include"       (HasArg (addCmdlineHCInclude)) Supported
+  , Flag "#include"       (HasArg (addCmdlineHCInclude))
+                             (Deprecated "No longer has any effect")
   , Flag "v"              (OptIntSuffix setVerbosity) Supported
 
         ------- Specific phases  --------------------------------------------
@@ -1857,6 +1856,12 @@ impliedFlags
     , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
                                                      --      Note [Scoped tyvars] in TcBinds
     , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
+
+       -- Record wild-cards implies field disambiguation
+       -- Otherwise if you write (C {..}) you may well get
+       -- stuff like " 'a' not in scope ", which is a bit silly
+       -- if the compiler has just filled in field 'a' of constructor 'C'
+    , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
   ]
 
 glasgowExtsFlags :: [DynFlag]
@@ -1921,7 +1926,7 @@ parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
 parseDynamicFlags_ :: Monad m =>
                       DynFlags -> [Located String] -> Bool
                   -> m (DynFlags, [Located String], [Located String])
-parseDynamicFlags_ dflags args pkg_flags = do
+parseDynamicFlags_ dflags0 args pkg_flags = do
   -- XXX Legacy support code
   -- We used to accept things like
   --     optdep-f  -optdepdepend
@@ -1938,10 +1943,23 @@ parseDynamicFlags_ dflags args pkg_flags = do
       flag_spec | pkg_flags = package_flags ++ dynamic_flags
                 | otherwise = dynamic_flags
 
-  let ((leftover, errs, warns), dflags')
-          = runCmdLine (processArgs flag_spec args') dflags
+  let ((leftover, errs, warns), dflags1)
+          = runCmdLine (processArgs flag_spec args') dflags0
   when (not (null errs)) $ ghcError $ errorsToGhcException errs
-  return (dflags', leftover, warns)
+
+  -- Cannot use -fPIC with registerised -fvia-C, because the mangler
+  -- isn't up to the job.  We know that if hscTarget == HscC, then the
+  -- user has explicitly used -fvia-C, because -fasm is the default,
+  -- unless there is no NCG on this platform.  The latter case is
+  -- checked when the -fPIC flag is parsed.
+  --
+  let (pic_warns, dflags2) =
+        if opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
+          then ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
+                dflags1{ hscTarget = HscAsm })
+          else ([], dflags1)
+
+  return (dflags2, leftover, pic_warns ++ warns)
 
 type DynP = CmdLineP DynFlags
 
@@ -2040,13 +2058,7 @@ ignorePackage p =
   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
 
 setPackageName :: String -> DynFlags -> DynFlags
-setPackageName p
-  | Nothing <- unpackPackageId pid
-  = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
-  | otherwise
-  = \s -> s{ thisPackage = pid }
-  where
-        pid = stringToPackageId p
+setPackageName p s =  s{ thisPackage = stringToPackageId p }
 
 -- If we're linking a binary, then only targets that produce object
 -- code are allowed (requests for other target types are ignored).