X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=37c65bbf0f083e5baae0f96cb339234ea575930a;hb=0ce8f5e727dfb59857a0f6e34d7617796e76baac;hp=582b80da6c51f5dbe204f97fe424287dc495b367;hpb=f2aaae9757e7532485c97f6c9a9ed5437542d1dd;p=ghc-hetmet.git

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 582b80d..37c65bb 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -58,11 +58,12 @@ module HscMain
     , hscParseIdentifier
     , hscTcRcLookupName
     , hscTcRnGetInfo
-    , hscRnImportDecls
 #ifdef GHCI
+    , hscRnImportDecls
     , hscGetModuleExports
     , hscTcRnLookupRdrName
-    , hscStmt, hscTcExpr, hscImport, hscKcType
+    , hscStmt, hscStmtWithLocation
+    , hscTcExpr, hscImport, hscKcType
     , hscCompileCoreExpr
 #endif
 
@@ -96,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 )
@@ -294,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
@@ -305,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
@@ -897,7 +899,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
@@ -1075,8 +1077,17 @@ hscStmt		-- Compile a stmt all the way to an HValue, but don't run it
   -> String			-- The statement
   -> IO (Maybe ([Id], HValue))
      -- ^ 'Nothing' <==> empty statement (or comment only), but no parse error
-hscStmt hsc_env stmt = runHsc hsc_env $ do
-    maybe_stmt <- hscParseStmt stmt
+hscStmt hsc_env stmt = hscStmtWithLocation hsc_env stmt "<interactive>" 1
+
+hscStmtWithLocation	-- Compile a stmt all the way to an HValue, but don't run it
+  :: HscEnv
+  -> String			-- The statement
+  -> String                     -- the source
+  -> Int                        -- ^ starting line
+  -> IO (Maybe ([Id], HValue))
+     -- ^ 'Nothing' <==> empty statement (or comment only), but no parse error
+hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
+    maybe_stmt <- hscParseStmtWithLocation source linenumber stmt
     case maybe_stmt of
       Nothing -> return Nothing
       Just parsed_stmt -> do  -- The real stuff
@@ -1142,6 +1153,11 @@ hscKcType hsc_env str = runHsc hsc_env $ do
 hscParseStmt :: String -> Hsc (Maybe (LStmt RdrName))
 hscParseStmt = hscParseThing parseStmt
 
+hscParseStmtWithLocation :: String -> Int 
+                         -> String -> Hsc (Maybe (LStmt RdrName))
+hscParseStmtWithLocation source linenumber stmt = 
+  hscParseThingWithLocation source linenumber parseStmt stmt
+
 hscParseType :: String -> Hsc (LHsType RdrName)
 hscParseType = hscParseThing parseType
 #endif
@@ -1150,19 +1166,24 @@ hscParseIdentifier :: HscEnv -> String -> IO (Located RdrName)
 hscParseIdentifier hsc_env str = runHsc hsc_env $ 
                                    hscParseThing parseIdentifier str
 
-
 hscParseThing :: (Outputable thing)
 	      => Lexer.P thing
 	      -> String
 	      -> Hsc thing
+hscParseThing = hscParseThingWithLocation "<interactive>" 1
 
-hscParseThing parser str
+hscParseThingWithLocation :: (Outputable thing)
+	      => String -> Int 
+              -> Lexer.P thing
+	      -> String
+	      -> Hsc thing
+hscParseThingWithLocation source linenumber parser str
  = {-# SCC "Parser" #-} do
       dflags <- getDynFlags
       liftIO $ showPass dflags "Parser"
-  
+
       let buf = stringToStringBuffer str
-          loc = mkSrcLoc (fsLit "<interactive>") 1 1
+          loc  = mkSrcLoc (fsLit source) linenumber 1
 
       case unP parser (mkPState dflags buf loc) of