[commit: ghc] master: Load the right object files in ghci (b49ad6b)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b49ad6bb4e85bc16b60c176672b448e30d333d7c

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

commit b49ad6bb4e85bc16b60c176672b448e30d333d7c
Author: Ian Lynagh <[email protected]>
Date:   Thu Oct 4 20:44:41 2012 +0100

    Load the right object files in ghci
    
    When we have a dynamic ghc, we need to load the dynamic object files

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

 compiler/ghci/Linker.lhs    |   73 ++++++++++++++++++++++++++-----------------
 ghc.mk                      |    6 +++
 rules/build-dependencies.mk |    9 +++++
 3 files changed, 59 insertions(+), 29 deletions(-)

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 0cf98fe..23e0474 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -480,7 +480,10 @@ dieWith dflags span msg = ghcError (ProgramError (showSDoc dflags (mkLocMessage
 checkNonStdWay :: DynFlags -> SrcSpan -> IO Bool
 checkNonStdWay dflags srcspan = do
   let tag = buildTag dflags
-  if null tag {-  || tag == "dyn" -} then return False else do
+      dynamicByDefault = dYNAMIC_BY_DEFAULT dflags
+  if (null tag && not dynamicByDefault) ||
+     (tag == "dyn" && dynamicByDefault)
+      then return False
     -- see #3604: object files compiled for way "dyn" need to link to the
     -- dynamic packages, so we can't load them into a statically-linked GHCi.
     -- we have to treat "dyn" in the same way as "prof".
@@ -490,9 +493,9 @@ checkNonStdWay dflags srcspan = do
     -- .o files or -dynamic .o files into GHCi (currently that's not possible
     -- because the dynamic objects contain refs to e.g. __stginit_base_Prelude_dyn
     -- whereas we have __stginit_base_Prelude_.
-  if (objectSuf dflags == normalObjectSuffix)
-     then failNonStd dflags srcspan
-     else return True
+      else if (objectSuf dflags == normalObjectSuffix) && not (null tag)
+      then failNonStd dflags srcspan
+      else return True
 
 normalObjectSuffix :: String
 normalObjectSuffix = phaseInputExt StopLn
@@ -627,14 +630,23 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
 
             adjust_ul (DotO file) = do
                 MASSERT (osuf `isSuffixOf` file)
-                let new_file = reverse (drop (length osuf + 1) (reverse file))
-                                 <.> normalObjectSuffix
-                ok <- doesFileExist new_file
-                if (not ok)
-                   then dieWith dflags span $
-                          ptext (sLit "cannot find normal object file ")
-                                <> quotes (text new_file) $$ while_linking_expr
-                   else return (DotO new_file)
+                let file_base = reverse (drop (length osuf + 1) (reverse file))
+                    dyn_file = file_base <.> "dyn_o"
+                    new_file = file_base <.> normalObjectSuffix
+                -- Note that even if dYNAMIC_BY_DEFAULT is on, we might
+                -- still have dynamic object files called .o, so we need
+                -- to try both filenames.
+                use_dyn <- if dYNAMIC_BY_DEFAULT dflags
+                           then do doesFileExist dyn_file
+                           else return False
+                if use_dyn
+                    then return (DotO dyn_file)
+                    else do ok <- doesFileExist new_file
+                            if (not ok)
+                               then dieWith dflags span $
+                                      ptext (sLit "cannot find normal object file ")
+                                            <> quotes (text new_file) $$ while_linking_expr
+                               else return (DotO new_file)
             adjust_ul _ = panic "adjust_ul"
 \end{code}
 
@@ -1145,10 +1157,13 @@ locateLib dflags is_hs dirs lib
   | otherwise
     -- When the GHC package was compiled as dynamic library (=DYNAMIC set),
     -- we search for .so libraries first.
-  = findHSDll `orElse` findObject `orElse` findArchive `orElse` assumeDll
+  = findHSDll `orElse` findDynObject `orElse` findDynArchive `orElse`
+                       findObject    `orElse` findArchive `orElse` assumeDll
    where
-     mk_obj_path dir = dir </> (lib <.> "o")
-     mk_arch_path dir = dir </> ("lib" ++ lib <.> "a")
+     mk_obj_path      dir = dir </> (lib <.> "o")
+     mk_dyn_obj_path  dir = dir </> (lib <.> "dyn_o")
+     mk_arch_path     dir = dir </> ("lib" ++ lib <.> "a")
+     mk_dyn_arch_path dir = dir </> ("lib" ++ lib <.> "dyn_a")
 
      hs_dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
      mk_hs_dyn_lib_path dir = dir </> mkSOName platform hs_dyn_lib_name
@@ -1156,11 +1171,14 @@ locateLib dflags is_hs dirs lib
      so_name = mkSOName platform lib
      mk_dyn_lib_path dir = dir </> so_name
 
-     findObject  = liftM (fmap Object)  $ findFile mk_obj_path  dirs
-     findArchive = liftM (fmap Archive) $ findFile mk_arch_path dirs
-     findHSDll   = liftM (fmap DLLPath) $ findFile mk_hs_dyn_lib_path dirs
-     findDll     = liftM (fmap DLLPath) $ findFile mk_dyn_lib_path dirs
-     tryGcc      = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags so_name dirs
+     findObject     = liftM (fmap Object)  $ findFile mk_obj_path        dirs
+     findDynObject  = do putStrLn "In findDynObject"
+                         liftM (fmap Object)  $ findFile mk_dyn_obj_path    dirs
+     findArchive    = liftM (fmap Archive) $ findFile mk_arch_path       dirs
+     findDynArchive = liftM (fmap Archive) $ findFile mk_dyn_arch_path   dirs
+     findHSDll      = liftM (fmap DLLPath) $ findFile mk_hs_dyn_lib_path dirs
+     findDll        = liftM (fmap DLLPath) $ findFile mk_dyn_lib_path    dirs
+     tryGcc         = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags so_name dirs
 
      assumeDll   = return (DLL lib)
      infixr `orElse`
@@ -1217,15 +1235,12 @@ loadFramework extraPaths rootname
 findFile :: (FilePath -> FilePath)      -- Maps a directory path to a file path
          -> [FilePath]                  -- Directories to look in
          -> IO (Maybe FilePath)         -- The first file path to match
-findFile _ []
-  = return Nothing
-findFile mk_file_path (dir:dirs)
-  = do  { let file_path = mk_file_path dir
-        ; b <- doesFileExist file_path
-        ; if b then
-             return (Just file_path)
-          else
-             findFile mk_file_path dirs }
+findFile _            [] = return Nothing
+findFile mk_file_path (dir : dirs)
+  = do let file_path = mk_file_path dir
+       b <- doesFileExist file_path
+       if b then return (Just file_path)
+            else findFile mk_file_path dirs
 \end{code}
 
 \begin{code}
diff --git a/ghc.mk b/ghc.mk
index f2ee2f9..1147452 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -184,6 +184,12 @@ include rules/way-prelims.mk
 $(foreach way,$(ALL_WAYS),\
   $(eval $(call way-prelims,$(way))))
 
+ifeq "$(DYNAMIC_BY_DEFAULT)" "YES"
+GHCI_WAY = dyn
+else
+GHCI_WAY = v
+endif
+
 # -----------------------------------------------------------------------------
 # Compilation Flags
 
diff --git a/rules/build-dependencies.mk b/rules/build-dependencies.mk
index edde237..903dc9c 100644
--- a/rules/build-dependencies.mk
+++ b/rules/build-dependencies.mk
@@ -38,6 +38,15 @@ ifneq "$$($1_$2_HS_SRCS)" ""
 	    $$(filter-out -split-objs, $$($1_$2_$$(firstword $$($1_$2_WAYS))_ALL_HC_OPTS)) \
 	    $$($1_$2_HS_SRCS)
 endif
+# We use the GHCI_WAY object files when doing TH for all ways. We
+# therefore need the GHCI_WAY object files available when compiling
+# the other ways, in case we're compiling something that uses TH.
+ifneq "$$(filter $$(GHCI_WAY),$$($1_$2_WAYS))" ""
+	$$(foreach w,$$(filter-out $$(GHCI_WAY),$$($1_$2_WAYS)),\
+	    $$(foreach o,$$($1_$2_$$w_HS_OBJS),\
+	        $$(call make-command,\
+	            echo "$$o: $$(basename $$o).$$($$(GHCI_WAY)_osuf)" >> [email protected])))
+endif
 	echo "$1_$2_depfile_haskell_EXISTS = YES" >> [email protected]
 ifneq "$$($1_$2_SLASH_MODS)" ""
 	for dir in $$(sort $$(foreach mod,$$($1_$2_SLASH_MODS),$1/$2/build/$$(dir $$(mod)))); do \