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 9c9c71f..6c4a35f 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -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