[commit: ghc] master: Set the way to 'dynamic' when running GHCi if GHCi is dynamically linked (f5e2cca)

[Ian Lynagh]

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

On branch  : master

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

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

commit f5e2ccab3677b80439c5220bcfbd9153ae367795
Author: Ian Lynagh <ian at well-typed.com>
Date:   Thu Mar 14 20:05:42 2013 +0000

    Set the way to 'dynamic' when running GHCi if GHCi is dynamically linked

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

 compiler/main/DynFlags.hs      |  8 +++----
 compiler/utils/Fingerprint.hsc |  1 +
 ghc/Main.hs                    | 51 ++++++++++++++++++++++++++----------------
 3 files changed, 37 insertions(+), 23 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 876d2ea..74546e3 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -50,7 +50,8 @@ module DynFlags (
 
         printOutputForUser, printInfoForUser,
 
-        Way(..), mkBuildTag, wayRTSOnly,
+        Way(..), mkBuildTag, wayRTSOnly, updateWays,
+        wayGeneralFlags,
 
         -- ** Safe Haskell
         SafeHaskellMode(..),
@@ -1847,11 +1848,10 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
 updateWays :: DynFlags -> DynFlags
 updateWays dflags
     = let theWays = sort $ nub $ ways dflags
-          theBuildTag = mkBuildTag (filter (not . wayRTSOnly) theWays)
       in dflags {
              ways        = theWays,
-             buildTag    = theBuildTag,
-             rtsBuildTag = mkBuildTag theWays
+             buildTag    = mkBuildTag (filter (not . wayRTSOnly) theWays),
+             rtsBuildTag = mkBuildTag                            theWays
          }
 
 -- | Check (and potentially disable) any extensions that aren't allowed
diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
index e006598..95f31c0 100644
--- a/compiler/utils/Fingerprint.hsc
+++ b/compiler/utils/Fingerprint.hsc
@@ -8,6 +8,7 @@
 --
 -- ----------------------------------------------------------------------------
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 module Fingerprint (
         Fingerprint(..), fingerprint0,
         readHexFingerprint,
diff --git a/ghc/Main.hs b/ghc/Main.hs
index bcc60c0..cd7f5c4 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -143,7 +143,15 @@ main' postLoadMode dflags0 args flagWarnings = do
                DoAbiHash       -> (OneShot,     dflt_target,    LinkBinary)
                _               -> (OneShot,     dflt_target,    LinkBinary)
 
-  let dflags1 = dflags0{ ghcMode   = mode,
+  let dflags1 = case lang of
+                HscInterpreted ->
+                    let interpWayGeneralFlags = concatMap (wayGeneralFlags (targetPlatform dflags0)) interpWays
+                    in foldl gopt_set
+                             (updateWays $ dflags0 { ways = interpWays })
+                             interpWayGeneralFlags
+                _ ->
+                    dflags0
+      dflags2 = dflags1{ ghcMode   = mode,
                          hscTarget = lang,
                          ghcLink   = link,
                          -- leave out hscOutName for now
@@ -157,28 +165,28 @@ main' postLoadMode dflags0 args flagWarnings = do
       -- can be overriden from the command-line
       -- XXX: this should really be in the interactive DynFlags, but
       -- we don't set that until later in interactiveUI
-      dflags1a | DoInteractive <- postLoadMode = imp_qual_enabled
+      dflags3  | DoInteractive <- postLoadMode = imp_qual_enabled
                | DoEval _      <- postLoadMode = imp_qual_enabled
-               | otherwise                 = dflags1
-        where imp_qual_enabled = dflags1 `gopt_set` Opt_ImplicitImportQualified
+               | otherwise                     = dflags2
+        where imp_qual_enabled = dflags2 `gopt_set` Opt_ImplicitImportQualified
 
         -- The rest of the arguments are "dynamic"
         -- Leftover ones are presumably files
-  (dflags2, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags1a args
+  (dflags4, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags3 args
 
-  GHC.prettyPrintGhcErrors dflags2 $ do
+  GHC.prettyPrintGhcErrors dflags4 $ do
 
   let flagWarnings' = flagWarnings ++ dynamicFlagWarnings
 
   handleSourceError (\e -> do
        GHC.printException e
        liftIO $ exitWith (ExitFailure 1)) $ do
-         liftIO $ handleFlagWarnings dflags2 flagWarnings'
+         liftIO $ handleFlagWarnings dflags4 flagWarnings'
 
         -- make sure we clean up after ourselves
-  GHC.defaultCleanupHandler dflags2 $ do
+  GHC.defaultCleanupHandler dflags4 $ do
 
-  liftIO $ showBanner postLoadMode dflags2
+  liftIO $ showBanner postLoadMode dflags4
 
   let
      -- To simplify the handling of filepaths, we normalise all filepaths right
@@ -187,29 +195,29 @@ main' postLoadMode dflags0 args flagWarnings = do
     normal_fileish_paths = map (normalise . unLoc) fileish_args
     (srcs, objs)         = partition_args normal_fileish_paths [] []
 
-    dflags2a = dflags2 { ldInputs = objs ++ ldInputs dflags2 }
+    dflags5 = dflags4 { ldInputs = objs ++ ldInputs dflags4 }
 
   -- we've finished manipulating the DynFlags, update the session
-  _ <- GHC.setSessionDynFlags dflags2a
-  dflags3 <- GHC.getSessionDynFlags
+  _ <- GHC.setSessionDynFlags dflags5
+  dflags6 <- GHC.getSessionDynFlags
   hsc_env <- GHC.getSession
 
         ---------------- Display configuration -----------
-  when (verbosity dflags3 >= 4) $
-        liftIO $ dumpPackages dflags3
+  when (verbosity dflags6 >= 4) $
+        liftIO $ dumpPackages dflags6
 
-  when (verbosity dflags3 >= 3) $ do
+  when (verbosity dflags6 >= 3) $ do
         liftIO $ hPutStrLn stderr ("Hsc static flags: " ++ unwords staticFlags)
 
         ---------------- Final sanity checking -----------
-  liftIO $ checkOptions postLoadMode dflags3 srcs objs
+  liftIO $ checkOptions postLoadMode dflags6 srcs objs
 
   ---------------- Do the business -----------
   handleSourceError (\e -> do
        GHC.printException e
        liftIO $ exitWith (ExitFailure 1)) $ do
     case postLoadMode of
-       ShowInterface f        -> liftIO $ doShowIface dflags3 f
+       ShowInterface f        -> liftIO $ doShowIface dflags6 f
        DoMake                 -> doMake srcs
        DoMkDependHS           -> doMkDependHS (map fst srcs)
        StopBefore p           -> liftIO (oneShot hsc_env p srcs)
@@ -217,7 +225,7 @@ main' postLoadMode dflags0 args flagWarnings = do
        DoEval exprs           -> ghciUI srcs $ Just $ reverse exprs
        DoAbiHash              -> abiHash srcs
 
-  liftIO $ dumpFinalStats dflags3
+  liftIO $ dumpFinalStats dflags6
 
 ghciUI :: [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
 #ifndef GHCI
@@ -226,6 +234,11 @@ ghciUI _ _ = throwGhcException (CmdLineError "not built for interactive use")
 ghciUI     = interactiveUI defaultGhciSettings
 #endif
 
+interpWays :: [Way]
+interpWays = if cDYNAMIC_GHC_PROGRAMS
+             then [WayDyn]
+             else []
+
 -- -----------------------------------------------------------------------------
 -- Splitting arguments into source files and object files.  This is where we
 -- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source
@@ -290,7 +303,7 @@ checkOptions mode dflags srcs objs = do
         hPutStrLn stderr ("Warning: -debug, -threaded and -ticky are ignored by GHCi")
 
         -- -prof and --interactive are not a good combination
-   when ((filter (not . wayRTSOnly) (ways dflags) /= defaultWays (settings dflags))
+   when ((filter (not . wayRTSOnly) (ways dflags) /= interpWays)
          && isInterpretiveMode mode) $
       do throwGhcException (UsageError
                    "--interactive can't be used with -prof or -unreg.")