Fix build on Mac OS 10.6 (Snow Leopard)

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

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index fce8eac..46c9d20 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -21,6 +21,7 @@ module DynFlags (
         DynLibLoader(..),
         fFlags, xFlags,
         dphPackage,
         DynLibLoader(..),
         fFlags, xFlags,
         dphPackage,

+        wayNames,

 
         -- ** Manipulating DynFlags
         defaultDynFlags,                -- DynFlags
 
         -- ** Manipulating DynFlags
         defaultDynFlags,                -- DynFlags

@@ -69,18 +70,13 @@ import Platform
 import Module
 import PackageConfig
 import PrelNames        ( mAIN )
 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
 import CmdLineParser
 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
 import Panic
 import {-# SOURCE #-} Packages (PackageState)
 import DriverPhases     ( Phase(..), phaseInputExt )
 import Config
 import CmdLineParser
 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
 import Panic

-import UniqFM           ( UniqFM )

 import Util
 import Maybes           ( orElse )
 import SrcLoc
 import Util
 import Maybes           ( orElse )
 import SrcLoc

@@ -186,6 +182,7 @@ data DynFlag
    | Opt_WarnUnusedMatches
    | Opt_WarnWarningsDeprecations
    | Opt_WarnDeprecatedFlags
    | Opt_WarnUnusedMatches
    | Opt_WarnWarningsDeprecations
    | Opt_WarnDeprecatedFlags

+   | Opt_WarnDodgyExports

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

@@ -225,6 +222,7 @@ data DynFlag
    | Opt_ViewPatterns
    | Opt_GADTs
    | Opt_RelaxedPolyRec
    | Opt_ViewPatterns
    | Opt_GADTs
    | Opt_RelaxedPolyRec

+   | Opt_NPlusKPatterns

 
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
 
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable

@@ -249,6 +247,7 @@ data DynFlag
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
    | Opt_PostfixOperators
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
    | Opt_PostfixOperators

+   | Opt_TupleSections

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

@@ -312,6 +311,7 @@ data DynFlag
    | Opt_EmbedManifest
    | Opt_EmitExternalCore
    | Opt_SharedImplib
    | Opt_EmbedManifest
    | Opt_EmitExternalCore
    | Opt_SharedImplib

+   | Opt_BuildingCabalPackage

 
        -- temporary flags
    | Opt_RunCPS
 
        -- temporary flags
    | Opt_RunCPS

@@ -367,7 +367,7 @@ data DynFlags = DynFlags {
   thisPackage           :: PackageId,   -- ^ name of package currently being compiled
 
   -- ways
   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\"
 
   buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
   rtsBuildTag           :: String,      -- ^ The RTS \"way\"
 

@@ -449,7 +449,7 @@ data DynFlags = DynFlags {
   -- Package state
   -- NB. do not modify this field, it is calculated by
   -- Packages.initPackages and Packages.updatePackages.
   -- Package state
   -- NB. do not modify this field, it is calculated by
   -- Packages.initPackages and Packages.updatePackages.

-  pkgDatabase           :: Maybe (UniqFM PackageConfig),
+  pkgDatabase           :: Maybe [PackageConfig],

   pkgState              :: PackageState,
 
   -- Temporary files
   pkgState              :: PackageState,
 
   -- Temporary files

@@ -467,6 +467,9 @@ data DynFlags = DynFlags {
   haddockOptions :: Maybe String
  }
 
   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
 -- | The target code type of the compilation (if any).
 --
 -- Whenever you change the target, also make sure to set 'ghcLink' to

@@ -542,6 +545,7 @@ doingTickyProfiling dflags = WayTicky `elem` wayNames dflags
 
 data PackageFlag
   = ExposePackage  String
 
 data PackageFlag
   = ExposePackage  String

+  | ExposePackageId String

   | HidePackage    String
   | IgnorePackage  String
   deriving Eq
   | HidePackage    String
   | IgnorePackage  String
   deriving Eq

@@ -567,14 +571,12 @@ initDynFlags :: DynFlags -> IO DynFlags
 initDynFlags dflags = do
  -- someday these will be dynamic flags
  ways <- readIORef v_Ways
 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{
  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
         }
         filesToClean    = refFilesToClean,
         dirsToClean     = refDirsToClean
         }

@@ -650,7 +652,7 @@ defaultDynFlags =
         packageFlags            = [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
         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,
         buildTag                = panic "defaultDynFlags: No buildTag",
         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
         splitInfo               = Nothing,

@@ -691,6 +693,7 @@ defaultDynFlags =
 
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,
 
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,

+            Opt_NPlusKPatterns,

 
             Opt_MethodSharing,
 
 
             Opt_MethodSharing,
 

@@ -931,6 +934,7 @@ minusWOpts
         Opt_WarnUnusedMatches,
         Opt_WarnUnusedImports,
         Opt_WarnIncompletePatterns,
         Opt_WarnUnusedMatches,
         Opt_WarnUnusedImports,
         Opt_WarnIncompletePatterns,

+        Opt_WarnDodgyExports,

         Opt_WarnDodgyImports
       ]
 
         Opt_WarnDodgyImports
       ]
 

@@ -1235,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 "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  --------------------------------------------
   , Flag "v"              (OptIntSuffix setVerbosity) Supported
 
         ------- Specific phases  --------------------------------------------

@@ -1617,6 +1622,7 @@ package_flags = [
   , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
          Supported
   , Flag "package-name"   (HasArg (upd . setPackageName)) Supported
   , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
          Supported
   , Flag "package-name"   (HasArg (upd . setPackageName)) Supported

+  , Flag "package-id"     (HasArg exposePackageId) Supported

   , Flag "package"        (HasArg exposePackage) Supported
   , Flag "hide-package"   (HasArg hidePackage) Supported
   , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
   , Flag "package"        (HasArg exposePackage) Supported
   , Flag "hide-package"   (HasArg hidePackage) Supported
   , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))

@@ -1652,6 +1658,7 @@ useInstead flag turn_on
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
   ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
   ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),

+  ( "warn-dodgy-exports",               Opt_WarnDodgyExports, 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 ),

@@ -1751,6 +1758,7 @@ fFlags = [
   ( "embed-manifest",                   Opt_EmbedManifest, const Supported ),
   ( "ext-core",                         Opt_EmitExternalCore, const Supported ),
   ( "shared-implib",                    Opt_SharedImplib, const Supported ),
   ( "embed-manifest",                   Opt_EmbedManifest, const Supported ),
   ( "ext-core",                         Opt_EmitExternalCore, const Supported ),
   ( "shared-implib",                    Opt_SharedImplib, const Supported ),

+  ( "building-cabal-package",           Opt_BuildingCabalPackage, const Supported ),

   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, const Supported )
   ]
 
   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, const Supported )
   ]
 

@@ -1766,6 +1774,7 @@ xFlags :: [(String, DynFlag, Bool -> Deprecated)]
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
   ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
   ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),

+  ( "TupleSections",                    Opt_TupleSections, 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 ),

@@ -1803,6 +1812,8 @@ xFlags = [
   ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
   -- On by default:
   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
   ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
   -- On by default:
   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),

+  -- On by default:
+  ( "NPlusKPatterns",                   Opt_NPlusKPatterns, const Supported ),

   -- On by default (which is not strictly H98):
   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, const Supported ),
   -- On by default (which is not strictly H98):
   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, const Supported ),

@@ -1846,6 +1857,12 @@ impliedFlags
     , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
                                                      --      Note [Scoped tyvars] in TcBinds
     , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
     , (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]
   ]
 
 glasgowExtsFlags :: [DynFlag]

@@ -1910,7 +1927,7 @@ parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
 parseDynamicFlags_ :: Monad m =>
                       DynFlags -> [Located String] -> Bool
                   -> m (DynFlags, [Located String], [Located String])
 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
   -- XXX Legacy support code
   -- We used to accept things like
   --     optdep-f  -optdepdepend

@@ -1927,10 +1944,23 @@ parseDynamicFlags_ dflags args pkg_flags = do
       flag_spec | pkg_flags = package_flags ++ dynamic_flags
                 | otherwise = dynamic_flags
 
       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
   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
 
 
 type DynP = CmdLineP DynFlags
 

@@ -2020,22 +2050,18 @@ addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes
 extraPkgConf_ :: FilePath -> DynP ()
 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
 
 extraPkgConf_ :: FilePath -> DynP ()
 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
 

-exposePackage, hidePackage, ignorePackage :: String -> DynP ()
+exposePackage, exposePackageId, hidePackage, ignorePackage :: String -> DynP ()

 exposePackage p =
   upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
 exposePackage p =
   upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })

+exposePackageId p =
+  upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })

 hidePackage p =
   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
 ignorePackage p =
   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
 
 setPackageName :: String -> DynFlags -> DynFlags
 hidePackage p =
   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
 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).
 
 -- If we're linking a binary, then only targets that produce object
 -- code are allowed (requests for other target types are ignored).

@@ -2267,10 +2293,20 @@ machdepCCOpts _dflags
       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
       --   the fp (%ebp) for our register maps.
         =  let n_regs = stolen_x86_regs _dflags
       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
       --   the fp (%ebp) for our register maps.
         =  let n_regs = stolen_x86_regs _dflags

-               sta = opt_Static

            in
            in

-                    ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
+                    ( 
+#if darwin_TARGET_OS
+                      -- By default, gcc on OS X will generate SSE
+                      -- instructions, which need things 16-byte aligned,
+                      -- but we don't 16-byte align things. Thus drop
+                      -- back to generic i686 compatibility. Trac #2983.
+                      --
+                      -- Since Snow Leopard (10.6), gcc defaults to x86_64.
+                      ["-march=i686", "-m32"],
+#else
+                      [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""

                       ],
                       ],

+#endif

                       [ "-fno-defer-pop",
                         "-fomit-frame-pointer",
                         -- we want -fno-builtin, because when gcc inlines
                       [ "-fno-defer-pop",
                         "-fomit-frame-pointer",
                         -- we want -fno-builtin, because when gcc inlines

@@ -2363,7 +2399,6 @@ compilerInfo = [("Project name",                String cProjectName),
                 ("Project version",             String cProjectVersion),
                 ("Booter version",              String cBooterVersion),
                 ("Stage",                       String cStage),
                 ("Project version",             String cProjectVersion),
                 ("Booter version",              String cBooterVersion),
                 ("Stage",                       String cStage),

-                ("Interface file version",      String cHscIfaceFileVersion),

                 ("Have interpreter",            String cGhcWithInterpreter),
                 ("Object splitting",            String cSplitObjs),
                 ("Have native code generator",  String cGhcWithNativeCodeGen),
                 ("Have interpreter",            String cGhcWithInterpreter),
                 ("Object splitting",            String cSplitObjs),
                 ("Have native code generator",  String cGhcWithNativeCodeGen),