Warning fix for unused and redundant imports
[ghc-hetmet.git] / compiler / typecheck / TcRnDriver.lhs
index 08ea437..ef7e929 100644 (file)
@@ -88,6 +88,7 @@ import TysWiredIn
 import IdInfo
 import {- Kind parts of -} Type
 import BasicTypes
+import Foreign.Ptr( Ptr )
 #endif
 
 import FastString
@@ -97,7 +98,6 @@ import Bag
 
 import Control.Monad    ( unless )
 import Data.Maybe      ( isJust )
-import Foreign.Ptr      ( Ptr )
 
 \end{code}
 
@@ -210,7 +210,8 @@ tcRnImports hsc_env this_mod import_decls
              ; want_instances :: ModuleName -> Bool
              ; want_instances mod = mod `elemUFM` dep_mods
                                   && mod /= moduleName this_mod
-             ; home_insts = hptInstances hsc_env want_instances
+             ; (home_insts, home_fam_insts) = hptInstances hsc_env 
+                                                            want_instances
              } ;
 
                -- Record boot-file info in the EPS, so that it's 
@@ -220,11 +221,14 @@ tcRnImports hsc_env this_mod import_decls
 
                -- Update the gbl env
        ; updGblEnv ( \ gbl -> 
-               gbl { tcg_rdr_env    = plusOccEnv (tcg_rdr_env gbl) rdr_env,
-                     tcg_imports    = tcg_imports gbl `plusImportAvails` imports,
-                      tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl),
-                     tcg_inst_env   = extendInstEnvList (tcg_inst_env gbl) home_insts
-               }) $ do {
+           gbl { 
+              tcg_rdr_env      = plusOccEnv (tcg_rdr_env gbl) rdr_env,
+             tcg_imports      = tcg_imports gbl `plusImportAvails` imports,
+              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
+           }) $ do {
 
        ; traceRn (text "rn1" <+> ppr (imp_dep_mods imports))
                -- Fail if there are any errors so far
@@ -320,7 +324,8 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
                                mg_deprecs   = NoDeprecs,
                                mg_foreign   = NoStubs,
                                mg_hpc_info  = noHpcInfo,
-                                mg_modBreaks = emptyModBreaks  
+                                mg_modBreaks = emptyModBreaks,
+                                mg_vect_info = noVectInfo
                    } } ;
 
    tcCoreDump mod_guts ;
@@ -687,12 +692,17 @@ tcTopSrcDecls boot_details
                -- We also typecheck any extra binds that came out 
                -- of the "deriving" process (deriv_binds)
         traceTc (text "Tc5") ;
-       (tc_val_binds, tcl_env) <- tcTopBinds (val_binds `plusHsValBinds` deriv_binds) ;
+       (tc_val_binds,   tcl_env) <- tcTopBinds val_binds ;
        setLclTypeEnv tcl_env   $ do {
 
+               -- Now GHC-generated derived bindings and generics
+               -- Do not generate warnings from compiler-generated code
+       (tc_deriv_binds, tcl_env) <- discardWarnings $ setOptM Opt_GlasgowExts $ 
+                                    tcTopBinds deriv_binds ;
+
                -- Second pass over class and instance declarations, 
         traceTc (text "Tc6") ;
-       (inst_binds, tcl_env) <- tcInstDecls2 tycl_decls inst_infos ;
+       (inst_binds, tcl_env)     <- setLclTypeEnv tcl_env $ tcInstDecls2 tycl_decls inst_infos ;
        showLIE (text "after instDecls2") ;
 
                -- Foreign exports
@@ -707,6 +717,7 @@ tcTopSrcDecls boot_details
         traceTc (text "Tc7a") ;
        tcg_env <- getGblEnv ;
        let { all_binds = tc_val_binds   `unionBags`
+                         tc_deriv_binds `unionBags`
                          inst_binds     `unionBags`
                          foe_binds  ;
 
@@ -819,14 +830,14 @@ setInteractiveContext hsc_env icxt thing_inside
        -- Initialise the tcg_inst_env with instances 
        -- from all home modules.  This mimics the more selective
        -- call to hptInstances in tcRnModule
-       dfuns = hptInstances hsc_env (\mod -> True)
+       dfuns = fst (hptInstances hsc_env (\mod -> True))
     in
     updGblEnv (\env -> env { 
        tcg_rdr_env  = ic_rn_gbl_env icxt,
        tcg_inst_env = extendInstEnvList (tcg_inst_env env) dfuns }) $
 
 
-    tcExtendIdEnv (typeEnvIds (ic_type_env icxt)) $
+    tcExtendIdEnv (ic_tmp_ids icxt) $
         -- tcExtendIdEnv does lots: 
         --   - it extends the local type env (tcl_env) with the given Ids,
         --   - it extends the local rdr env (tcl_rdr) with the Names from 
@@ -834,11 +845,10 @@ setInteractiveContext hsc_env icxt thing_inside
         --   - it adds the free tyvars of the Ids to the tcl_tyvars
         --     set.
         --
-        -- We should have no Ids with the same name in the
-        -- ic_type_env, otherwise we'll end up with shadowing in the
-        -- tcl_rdr, and it's random which one will be in scope.
+        -- later ids in ic_tmp_ids must shadow earlier ones with the same
+        -- OccName, and tcExtendIdEnv implements this behaviour.
 
-    do { traceTc (text "setIC" <+> ppr (ic_type_env icxt))
+    do { traceTc (text "setIC" <+> ppr (ic_tmp_ids icxt))
        ; thing_inside }
 \end{code}
 
@@ -847,9 +857,10 @@ setInteractiveContext hsc_env icxt thing_inside
 tcRnStmt :: HscEnv
         -> InteractiveContext
         -> LStmt RdrName
-        -> IO (Maybe (InteractiveContext, [Name], LHsExpr Id))
-               -- The returned [Name] is the same as the input except for
-               -- ExprStmt, in which case the returned [Name] is [itName]
+        -> IO (Maybe ([Id], LHsExpr Id))
+               -- The returned [Id] is the list of new Ids bound by
+                -- this statement.  It can be used to extend the
+                -- InteractiveContext via extendInteractiveContext.
                --
                -- The returned TypecheckedHsExpr is of type IO [ () ],
                -- a list of the bound values, coerced to ().
@@ -884,11 +895,6 @@ tcRnStmt hsc_env ictxt rdr_stmt
                --     up to have tidy types
        global_ids = map globaliseAndTidy zonked_ids ;
     
-               -- Update the interactive context
-       type_env = ic_type_env ictxt ;
-
-       bound_names = map idName global_ids ;
-
 {- ---------------------------------------------
    At one stage I removed any shadowed bindings from the type_env;
    they are inaccessible but might, I suppose, cause a space leak if we leave them there.
@@ -907,23 +913,13 @@ tcRnStmt hsc_env ictxt rdr_stmt
    Hence this code is commented out
 
 -------------------------------------------------- -}
-
-        old_bound_names = map idName (typeEnvIds (ic_type_env ictxt)) ;
-       shadowed = [ n | name <- bound_names,
-                         n <- old_bound_names,
-                         nameOccName name == nameOccName n ] ;
-
-       filtered_type_env = delListFromNameEnv type_env shadowed ;
-
-       new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
-       new_ic = ictxt { ic_type_env = new_type_env }
     } ;
 
     dumpOptTcRn Opt_D_dump_tc 
        (vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
               text "Typechecked expr" <+> ppr zonked_expr]) ;
 
-    returnM (new_ic, bound_names, zonked_expr)
+    returnM (global_ids, zonked_expr)
     }
   where
     bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),