X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=841125a0c5ef927fb7e5aa5d96657a1079d94e08;hb=d4d383b880ac76d803cdd37fb031ab0c50eb9170;hp=47bde9659d42f7c5cd0b1801b3e87aea24f5c5d3;hpb=eccb2d89eb4b34f31e8ea337d5f8673605f71665;p=ghc-hetmet.git

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 47bde96..841125a 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -58,8 +58,8 @@ module HscMain
     , hscParseIdentifier
     , hscTcRcLookupName
     , hscTcRnGetInfo
-    , hscRnImportDecls
 #ifdef GHCI
+    , hscRnImportDecls
     , hscGetModuleExports
     , hscTcRnLookupRdrName
     , hscStmt, hscStmtWithLocation
@@ -97,7 +97,6 @@ import SrcLoc
 import TcRnDriver
 import TcIface		( typecheckIface )
 import TcRnMonad
-import RnNames          ( rnImports )
 import IfaceEnv		( initNameCache )
 import LoadIface	( ifaceStats, initExternalPackageState )
 import PrelInfo		( wiredInThings, basicKnownKeyNames )
@@ -295,7 +294,6 @@ hscTcRnGetInfo hsc_env name =
 hscGetModuleExports :: HscEnv -> Module -> IO (Maybe [AvailInfo])
 hscGetModuleExports hsc_env mdl =
   runHsc hsc_env $ ioMsgMaybe' $ getModuleExports hsc_env mdl
-#endif
 
 -- -----------------------------------------------------------------------------
 -- | Rename some import declarations
@@ -306,11 +304,14 @@ hscRnImportDecls
         -> [LImportDecl RdrName]
         -> IO GlobalRdrEnv
 
-hscRnImportDecls hsc_env this_mod import_decls = runHsc hsc_env $ do
-  (_, r, _, _) <- 
-       ioMsgMaybe $ initTc hsc_env HsSrcFile False this_mod $
-          rnImports import_decls
-  return r
+-- It is important that we use tcRnImports instead of calling rnImports directly
+-- because tcRnImports will force-load any orphan modules necessary, making extra
+-- instances/family instances visible (GHC #4832)
+hscRnImportDecls hsc_env this_mod import_decls
+  = runHsc hsc_env $ ioMsgMaybe $ initTc hsc_env HsSrcFile False this_mod $
+          fmap tcg_rdr_env $ tcRnImports hsc_env this_mod import_decls
+
+#endif
 
 -- -----------------------------------------------------------------------------
 -- | parse a file, returning the abstract syntax
@@ -459,7 +460,8 @@ error. This is the only thing that isn't caught by the type-system.
 data HscStatus' a
     = HscNoRecomp
     | HscRecomp
-       Bool -- Has stub files.  This is a hack. We can't compile C files here
+       (Maybe FilePath)
+            -- Has stub files.  This is a hack. We can't compile C files here
             -- since it's done in DriverPipeline. For now we just return True
             -- if we want the caller to compile them for us.
        a
@@ -595,14 +597,14 @@ hscOneShotCompiler =
   , hscBackend = \ tc_result mod_summary mb_old_hash -> do
        dflags <- getDynFlags
        case hscTarget dflags of
-         HscNothing -> return (HscRecomp False ())
+         HscNothing -> return (HscRecomp Nothing ())
          _otherw    -> genericHscBackend hscOneShotCompiler
                                          tc_result mod_summary mb_old_hash
 
   , hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
        (iface, changed, _) <- hscSimpleIface tc_result mb_old_iface
        hscWriteIface iface changed mod_summary
-       return (HscRecomp False ())
+       return (HscRecomp Nothing ())
 
   , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
        guts <- hscSimplify' guts0
@@ -648,7 +650,7 @@ hscBatchCompiler =
   , hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
        (iface, changed, details) <- hscSimpleIface tc_result mb_old_iface
        hscWriteIface iface changed mod_summary
-       return (HscRecomp False (), iface, details)
+       return (HscRecomp Nothing (), iface, details)
 
   , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
        guts <- hscSimplify' guts0
@@ -680,7 +682,7 @@ hscInteractiveCompiler =
 
   , hscGenBootOutput = \tc_result _mod_summary mb_old_iface -> do
        (iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
-       return (HscRecomp False Nothing, iface, details)
+       return (HscRecomp Nothing Nothing, iface, details)
 
   , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
        guts <- hscSimplify' guts0
@@ -709,7 +711,7 @@ hscNothingCompiler =
   , hscBackend = \tc_result _mod_summary mb_old_iface -> do
        handleWarnings
        (iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
-       return (HscRecomp False (), iface, details)
+       return (HscRecomp Nothing (), iface, details)
 
   , hscGenBootOutput = \_ _ _ ->
         panic "hscCompileNothing: hscGenBootOutput should not be called"
@@ -851,7 +853,7 @@ hscWriteIface iface no_change mod_summary
 
 -- | Compile to hard-code.
 hscGenHardCode :: CgGuts -> ModSummary
-               -> Hsc Bool -- ^ @True@ <=> stub.c exists
+               -> Hsc (Maybe FilePath) -- ^ @Just f@ <=> _stub.c is f
 hscGenHardCode cgguts mod_summary
   = do
     hsc_env <- getHscEnv
@@ -898,7 +900,7 @@ hscGenHardCode cgguts mod_summary
                  -- unless certain dflags are on, the identity function
          ------------------  Code output -----------------------
          rawcmms <- cmmToRawCmm cmms
-         dumpIfSet_dyn dflags Opt_D_dump_cmmz "Raw Cmm" (ppr rawcmms)
+         dumpIfSet_dyn dflags Opt_D_dump_raw_cmm "Raw Cmm" (ppr rawcmms)
          (_stub_h_exists, stub_c_exists)
              <- codeOutput dflags this_mod location foreign_stubs 
                 dependencies rawcmms