[commit: ghc] master: Fix the handling of Opt_Static (ecc1882)

[Ian Lynagh]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/ecc1882ed458210c322d30b78801e7bc0a5c2d4d

>---------------------------------------------------------------

commit ecc1882ed458210c322d30b78801e7bc0a5c2d4d
Author: Ian Lynagh <ian at well-typed.com>
Date:   Sat Mar 16 21:35:29 2013 +0000

    Fix the handling of Opt_Static
    
    There were some cases where we weren't unsetting it when turning the
    Dyn way on.

>---------------------------------------------------------------

 compiler/main/DynFlags.hs | 41 ++++++++++++++++++++++++++---------------
 ghc/Main.hs               | 13 +++++++++----
 2 files changed, 35 insertions(+), 19 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 80c5f34..c021355 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -51,7 +51,7 @@ module DynFlags (
         printOutputForUser, printInfoForUser,
 
         Way(..), mkBuildTag, wayRTSOnly, updateWays,
-        wayGeneralFlags,
+        wayGeneralFlags, wayUnsetGeneralFlags,
 
         -- ** Safe Haskell
         SafeHaskellMode(..),
@@ -1075,6 +1075,16 @@ wayGeneralFlags _ WayPar      = [Opt_Parallel]
 wayGeneralFlags _ WayGran     = [Opt_GranMacros]
 wayGeneralFlags _ WayNDP      = []
 
+wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag]
+wayUnsetGeneralFlags _ WayThreaded = []
+wayUnsetGeneralFlags _ WayDebug    = []
+wayUnsetGeneralFlags _ WayDyn      = [Opt_Static]
+wayUnsetGeneralFlags _ WayProf     = []
+wayUnsetGeneralFlags _ WayEventLog = []
+wayUnsetGeneralFlags _ WayPar      = []
+wayUnsetGeneralFlags _ WayGran     = []
+wayUnsetGeneralFlags _ WayNDP      = []
+
 wayExtras :: Platform -> Way -> DynFlags -> DynFlags
 wayExtras _ WayThreaded dflags = dflags
 wayExtras _ WayDebug    dflags = dflags
@@ -1163,15 +1173,14 @@ generateDynamicTooConditional dflags canGen cannotGen notTryingToGen
       else notTryingToGen
 
 doDynamicToo :: DynFlags -> DynFlags
-doDynamicToo dflags0 = let dflags1 = unSetGeneralFlag' Opt_Static dflags0
-                           dflags2 = addWay' WayDyn dflags1
-                           dflags3 = dflags2 {
-                                         outputFile = dynOutputFile dflags2,
-                                         hiSuf = dynHiSuf dflags2,
-                                         objectSuf = dynObjectSuf dflags2
+doDynamicToo dflags0 = let dflags1 = addWay' WayDyn dflags0
+                           dflags2 = dflags1 {
+                                         outputFile = dynOutputFile dflags1,
+                                         hiSuf = dynHiSuf dflags1,
+                                         objectSuf = dynObjectSuf dflags1
                                      }
-                           dflags4 = updateWays dflags3
-                       in dflags4
+                           dflags3 = updateWays dflags2
+                       in dflags3
 
 -----------------------------------------------------------------------------
 
@@ -1969,10 +1978,8 @@ dynamic_flags = [
     -- is required to get the RTS ticky support.
 
         ----- Linker --------------------------------------------------------
-  , Flag "static"         (NoArg (do setGeneralFlag Opt_Static
-                                     removeWay WayDyn))
-  , Flag "dynamic"        (NoArg (do unSetGeneralFlag Opt_Static
-                                     addWay WayDyn))
+  , Flag "static"         (NoArg (removeWay WayDyn))
+  , Flag "dynamic"        (NoArg (addWay WayDyn))
     -- ignored for compat w/ gcc:
   , Flag "rdynamic"       (NoArg (return ()))
   , Flag "relative-dynlib-paths"  (NoArg (setGeneralFlag Opt_RelativeDynlibPaths))
@@ -2981,8 +2988,11 @@ addWay' :: Way -> DynFlags -> DynFlags
 addWay' w dflags0 = let platform = targetPlatform dflags0
                         dflags1 = dflags0 { ways = w : ways dflags0 }
                         dflags2 = wayExtras platform w dflags1
-                        dflags3 = foldr setGeneralFlag' dflags2 (wayGeneralFlags platform w)
-                    in dflags3
+                        dflags3 = foldr setGeneralFlag' dflags2
+                                        (wayGeneralFlags platform w)
+                        dflags4 = foldr unSetGeneralFlag' dflags3
+                                        (wayUnsetGeneralFlags platform w)
+                    in dflags4
 
 removeWay :: Way -> DynP ()
 removeWay w = do
@@ -2991,6 +3001,7 @@ removeWay w = do
   let platform = targetPlatform dfs
   -- XXX: wayExtras?
   mapM_ unSetGeneralFlag $ wayGeneralFlags platform w
+  mapM_ setGeneralFlag $ wayUnsetGeneralFlags platform w
   -- turn Opt_PIC back on if necessary for this platform:
   mapM_ setGeneralFlag $ default_PIC platform
 
diff --git a/ghc/Main.hs b/ghc/Main.hs
index f17f403..35dbf5b 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -145,10 +145,15 @@ main' postLoadMode dflags0 args flagWarnings = do
 
   let dflags1 = case lang of
                 HscInterpreted ->
-                    let interpWayGeneralFlags = concatMap (wayGeneralFlags (targetPlatform dflags0)) interpWays
-                    in foldl gopt_set
-                             (updateWays $ dflags0 { ways = interpWays })
-                             interpWayGeneralFlags
+                    let platform = targetPlatform dflags0
+                        dflags0a = updateWays $ dflags0 { ways = interpWays }
+                        dflags0b = foldl gopt_set dflags0a
+                                 $ concatMap (wayGeneralFlags platform)
+                                             interpWays
+                        dflags0c = foldl gopt_unset dflags0b
+                                 $ concatMap (wayUnsetGeneralFlags platform)
+                                             interpWays
+                    in dflags0c
                 _ ->
                     dflags0
       dflags2 = dflags1{ ghcMode   = mode,