Two new warnings: arity differing from demand type, and strict IDs at top level

[ghc-hetmet.git] / compiler / typecheck / TcRnDriver.lhs

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 044b67d..6c4a35f 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -69,8 +69,8 @@ import NameSet
 import TyCon
 import SrcLoc
 import HscTypes
-import DsBreakpoint
 import Outputable
+import Breakpoints
 
 #ifdef GHCI
 import Linker
@@ -302,6 +302,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
                                mg_types     = final_type_env,
                                mg_insts     = tcg_insts tcg_env,
                                mg_fam_insts = tcg_fam_insts tcg_env,
+                               mg_fam_inst_env = tcg_fam_inst_env tcg_env,
                                mg_rules     = [],
                                mg_binds     = core_binds,
 
@@ -396,15 +397,16 @@ tc_rn_src_decls boot_details ds
 
        -- Deal with decls up to, but not including, the first splice
        (tcg_env, rn_decls) <- checkNoErrs $ rnTopSrcDecls first_group ;
-               -- checkNoErrs: don't typecheck if renaming failed
-       tc_envs <- setGblEnv tcg_env $ 
-                  tcTopSrcDecls boot_details rn_decls ;
+               -- checkNoErrs: stop if renaming fails
+
+       (tcg_env, tcl_env) <- setGblEnv tcg_env $ 
+                             tcTopSrcDecls boot_details rn_decls ;
 
        -- If there is no splice, we're nearly done
-       setEnvs tc_envs $ 
+       setEnvs (tcg_env, tcl_env) $ 
        case group_tail of {
           Nothing -> do { tcg_env <- checkMain ;       -- Check for `main'
-                          return (tcg_env, snd tc_envs) 
+                          return (tcg_env, tcl_env) 
                      } ;
 
        -- If there's a splice, we must carry on
@@ -724,18 +726,7 @@ check_main ghc_mode tcg_env main_mod main_fn
        ; (main_expr, ty) <- setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
                             tcInferRho rhs
 
-       -- The function that the RTS invokes is always :Main.main,
-       -- which we call root_main_id.  
-       -- (Because GHC allows the user to have a module not called 
-       -- Main as the main module, we can't rely on the main function
-       -- being called "Main.main".  That's why root_main_id has a fixed
-       -- module ":Main".)
-       -- We also make root_main_id an implicit Id, by making main_name
-       -- its parent (hence (Just main_name)).  That has the effect
-       -- of preventing its type and unfolding from getting out into
-       -- the interface file. Otherwise we can end up with two defns
-       -- for 'main' in the interface file!
-
+               -- See Note [Root-main Id]
        ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN 
                                   (mkVarOccFS FSLIT("main")) 
                                   (getSrcLoc main_name)
@@ -764,6 +755,19 @@ check_main ghc_mode tcg_env main_mod main_fn
                <+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
 \end{code}
 
+Note [Root-main Id]
+~~~~~~~~~~~~~~~~~~~
+The function that the RTS invokes is always :Main.main, which we call
+root_main_id.  (Because GHC allows the user to have a module not
+called Main as the main module, we can't rely on the main function
+being called "Main.main".  That's why root_main_id has a fixed module
+":Main".)  
+
+This is unusual: it's a LocalId whose Name has a Module from another
+module.  Tiresomely, we must filter it out again in MkIface, les we
+get two defns for 'main' in the interface file!
+
+
 %*********************************************************
 %*                                                      *
                GHCi stuff
@@ -1092,19 +1096,32 @@ tcRnType hsc_env ictxt rdr_type
 -- could not be found.
 getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo])
 getModuleExports hsc_env mod
-  = initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod)
-
-tcGetModuleExports :: Module -> TcM [AvailInfo]
-tcGetModuleExports mod = do
-  let doc = ptext SLIT("context for compiling statements")
-  iface <- initIfaceTcRn $ loadSysInterface doc mod
-  loadOrphanModules (dep_orphs (mi_deps iface)) False 
-               -- Load any orphan-module interfaces,
-               -- so their instances are visible
-  loadOrphanModules (dep_finsts (mi_deps iface)) True
-               -- Load any family instance-module interfaces,
-               -- so all family instances are visible
-  ifaceExportNames (mi_exports iface)
+  = let
+      ic        = hsc_IC hsc_env
+      checkMods = ic_toplev_scope ic ++ ic_exports ic
+    in
+    initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod checkMods)
+
+-- Get the export avail info and also load all orphan and family-instance
+-- modules.  Finally, check that the family instances of all modules in the
+-- interactive context are consistent (these modules are in the second
+-- argument).
+tcGetModuleExports :: Module -> [Module] -> TcM [AvailInfo]
+tcGetModuleExports mod directlyImpMods
+  = do { let doc = ptext SLIT("context for compiling statements")
+       ; iface <- initIfaceTcRn $ loadSysInterface doc mod
+
+               -- Load any orphan-module and family instance-module
+               -- interfaces, so their instances are visible.
+       ; loadOrphanModules (dep_orphs (mi_deps iface)) False 
+       ; loadOrphanModules (dep_finsts (mi_deps iface)) True
+
+                -- Check that the family instances of all directly loaded
+                -- modules are consistent.
+       ; checkFamInstConsistency (dep_finsts (mi_deps iface)) directlyImpMods
+
+       ; ifaceExportNames (mi_exports iface)
+       }
 
 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
 tcRnLookupRdrName hsc_env rdr_name