X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=4a3cb5e7a01e4f18f9d5542ac84b94b034fa25bd;hb=b0d80aa3d908a6b9991920a5ac7fd1b437ecafd3;hp=5e138b317252019a9279617b944b13eb3c574c3c;hpb=876db7eda26b37f988bda8f6da8616b03aa5f810;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 5e138b3..4a3cb5e 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -197,7 +197,7 @@ tcRnModule hsc_env hsc_src save_rn_syntax
 \begin{code}
 tcRnImports :: HscEnv -> Module -> [LImportDecl RdrName] -> TcM TcGblEnv
 tcRnImports hsc_env this_mod import_decls
-  = do	{ (rn_imports, rdr_env, imports) <- rnImports import_decls ;
+  = do	{ (rn_imports, rdr_env, imports,hpc_info) <- rnImports import_decls ;
 
 	; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
 	      ; dep_mods = imp_dep_mods imports
@@ -226,7 +226,8 @@ tcRnImports hsc_env this_mod import_decls
               tcg_rn_imports   = fmap (const rn_imports) (tcg_rn_imports gbl),
 	      tcg_inst_env     = extendInstEnvList (tcg_inst_env gbl) home_insts,
 	      tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl) 
-                                                      home_fam_insts
+                                                      home_fam_insts,
+	      tcg_hpc          = hpc_info
 	    }) $ do {
 
 	; traceRn (text "rn1" <+> ppr (imp_dep_mods imports))
@@ -323,7 +324,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 				mg_fix_env   = emptyFixityEnv,
 				mg_deprecs   = NoDeprecs,
 				mg_foreign   = NoStubs,
-				mg_hpc_info  = noHpcInfo,
+				mg_hpc_info  = emptyHpcInfo False,
                                 mg_modBreaks = emptyModBreaks,
                                 mg_vect_info = noVectInfo
 		    } } ;
@@ -876,6 +877,7 @@ tcRnStmt hsc_env ictxt rdr_stmt
     (([rn_stmt], _), fvs) <- rnStmts DoExpr [rdr_stmt] (return ((), emptyFVs)) ;
     traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
     failIfErrsM ;
+    rnDump (ppr rn_stmt) ;
     
     -- The real work is done here
     (bound_ids, tc_expr) <- mkPlan rn_stmt ;
@@ -1244,21 +1246,17 @@ tcRnGetInfo hsc_env name
 	--  in the home package all relevant modules are loaded.)
     loadUnqualIfaces ictxt
 
-    thing <- tcRnLookupName' name
+    thing  <- tcRnLookupName' name
     fixity <- lookupFixityRn name
-    ispecs <- lookupInsts (icPrintUnqual ictxt) thing
+    ispecs <- lookupInsts thing
     return (thing, fixity, ispecs)
 
-lookupInsts :: PrintUnqualified -> TyThing -> TcM [Instance]
--- Filter the instances by the ones whose tycons (or clases resp) 
--- are in scope unqualified.  Otherwise we list a whole lot too many!
-lookupInsts print_unqual (AClass cls)
+lookupInsts :: TyThing -> TcM [Instance]
+lookupInsts (AClass cls)
   = do	{ inst_envs <- tcGetInstEnvs
-	; return [ ispec
-		 | ispec <- classInstances inst_envs cls
-		 , plausibleDFun print_unqual (instanceDFunId ispec) ] }
+	; return (classInstances inst_envs cls) }
 
-lookupInsts print_unqual (ATyCon tc)
+lookupInsts (ATyCon tc)
   = do 	{ eps <- getEps	-- Load all instances for all classes that are
 			-- in the type environment (which are all the ones
 			-- we've seen in any interface file so far)
@@ -1266,22 +1264,12 @@ lookupInsts print_unqual (ATyCon tc)
 	; return [ ispec
 		 | ispec <- instEnvElts home_ie ++ instEnvElts pkg_ie
 		 , let dfun = instanceDFunId ispec
-		 , relevant dfun
-		 , plausibleDFun print_unqual dfun ] }
+		 , relevant dfun ] } 
   where
     relevant df = tc_name `elemNameSet` tyClsNamesOfDFunHead (idType df)
     tc_name     = tyConName tc		  
 
-lookupInsts print_unqual other = return []
-
-plausibleDFun print_unqual dfun	-- Dfun involving only names that print unqualified
-  = all ok (nameSetToList (tyClsNamesOfType (idType dfun)))
-  where
-    ok name | isBuiltInSyntax name = True
-	    | isExternalName name  = 
-                isNothing $ fst print_unqual (nameModule name) 
-                                             (nameOccName name)
-	    | otherwise		   = True
+lookupInsts other = return []
 
 loadUnqualIfaces :: InteractiveContext -> TcM ()
 -- Load the home module for everything that is in scope unqualified