[project @ 2003-02-06 17:37:50 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index e0a07c2..58d4038 100644 (file)
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -35,7 +35,7 @@ import PrelNames      ( iNTERACTIVE, ioTyConName, printName,
                          dollarMainName, itName, mAIN_Name
                        )
 import MkId            ( unsafeCoerceId )
-import RdrName         ( RdrName, getRdrName, mkUnqual, mkRdrUnqual, 
+import RdrName         ( RdrName, getRdrName, mkRdrUnqual, 
                          lookupRdrEnv, elemRdrEnv )
 
 import RnHsSyn         ( RenamedStmt, RenamedTyClDecl, 
@@ -57,8 +57,7 @@ import Inst           ( showLIE )
 import TcBinds         ( tcTopBinds )
 import TcClassDcl      ( tcClassDecls2 )
 import TcDefaults      ( tcDefaults )
-import TcEnv           ( RecTcGblEnv, 
-                         tcExtendGlobalValEnv, 
+import TcEnv           ( tcExtendGlobalValEnv, 
                          tcExtendGlobalEnv,
                          tcExtendInstEnv, tcExtendRules,
                          tcLookupTyCon, tcLookupGlobal,
@@ -71,16 +70,15 @@ import TcInstDcls   ( tcInstDecls1, tcIfaceInstDecls, tcInstDecls2 )
 import TcSimplify      ( tcSimplifyTop, tcSimplifyInfer )
 import TcTyClsDecls    ( tcTyAndClassDecls )
 
-import RnNames         ( rnImports, exportsFromAvail, reportUnusedNames )
+import RnNames         ( importsFromLocalDecls, rnImports, exportsFromAvail, 
+                         reportUnusedNames, main_RDR_Unqual )
 import RnIfaces                ( slurpImpDecls, checkVersions, RecompileRequired, outOfDate )
 import RnHiFiles       ( readIface, loadOldIface )
 import RnEnv           ( lookupSrcName, lookupOccRn, plusGlobalRdrEnv,
                          ubiquitousNames, implicitModuleFVs, implicitStmtFVs, dataTcOccs )
 import RnExpr          ( rnStmts, rnExpr )
-import RnNames         ( importsFromLocalDecls )
 import RnSource                ( rnSrcDecls, checkModDeprec, rnStats )
 
-import OccName         ( varName )
 import CoreUnfold      ( unfoldingTemplate )
 import CoreSyn         ( IdCoreRule, Bind(..) )
 import PprCore         ( pprIdRules, pprCoreBindings )
@@ -178,8 +176,12 @@ tcRnModule hsc_env pcs
        updGblEnv (\gbl -> gbl { tcg_exports = export_avails })
                  $  do {
 
-               -- Get the supporting decls for the exports
-               -- This is important *only* to gether usage information
+               -- Get any supporting decls for the exports that have not already
+               -- been sucked in for the declarations in the body of the module.
+               -- (This can happen if something is imported only to be re-exported.)
+               --
+               -- Importing these supporting declarations is required 
+               --      *only* to gether usage information
                --      (see comments with MkIface.mkImportInfo for why)
                -- For OneShot compilation we could just throw away the decls
                -- but for Batch or Interactive we must put them in the type
@@ -744,6 +746,7 @@ tc_src_decls
                   hs_ruleds = rule_decls,
                   hs_valds  = val_binds })
  = do {                -- Type-check the type and class decls, and all imported decls
+               -- The latter come in via tycl_decls
         traceTc (text "Tc2") ;
        tcg_env <- tcTyClDecls tycl_decls ;
        setGblEnv tcg_env       $ do {
@@ -928,8 +931,8 @@ typecheckIfaceDecls :: HsGroup Name -> TcM TcGblEnv
   -- That is why the tcExtendX functions need to do partitioning.
   --
   -- If all the decls are from other modules, the returned TcGblEnv
-  -- will have an empty tc_genv, but its tc_inst_env and tc_ist 
-  -- caches may have been augmented.
+  -- will have an empty tc_genv, but its tc_inst_env
+  -- cache may have been augmented.
 typecheckIfaceDecls (HsGroup { hs_tyclds = tycl_decls,
                               hs_instds = inst_decls,
                               hs_ruleds = rule_decls })
@@ -1075,14 +1078,16 @@ check_main ghci_mode tcg_env
  | mod_name /= mAIN_Name
  = return (tcg_env, emptyFVs)
 
+       -- Check that 'main' is in scope
+       -- It might be imported from another module!
+       -- 
+       -- We use a guard for this (rather than letting lookupSrcName fail)
+       -- because it's not an error in ghci)
  | not (main_RDR_Unqual `elemRdrEnv` rdr_env)
  = do { complain_no_main; return (tcg_env, emptyFVs) }
 
  | otherwise
- = do {        -- Check that 'main' is in scope
-               -- It might be imported from another module!
-       main_name <- lookupSrcName main_RDR_Unqual ;
-       failIfErrsM ;
+ = do { main_name <- lookupSrcName main_RDR_Unqual ;
 
        tcg_env <- importSupportingDecls (unitFV runIOName) ;
        setGblEnv tcg_env $ do {
@@ -1112,15 +1117,11 @@ check_main ghci_mode tcg_env
     mod_name = moduleName (tcg_mod tcg_env) 
     rdr_env  = tcg_rdr_env tcg_env
  
-    main_RDR_Unqual :: RdrName
-    main_RDR_Unqual = mkUnqual varName FSLIT("main")
-       -- Don't get a RdrName from PrelNames.mainName, because 
-       -- nameRdrNamegets an Orig RdrName, and we want a Qual or Unqual one.  
-       -- An Unqual one will do just fine
-
     complain_no_main | ghci_mode == Interactive = return ()
-                    | otherwise                = addErr noMainMsg
+                    | otherwise                = failWithTc noMainMsg
        -- In interactive mode, don't worry about the absence of 'main'
+       -- In other modes, fail altogether, so that we don't go on
+       -- and complain a second time when processing the export list.
 
     mainCtxt  = ptext SLIT("When checking the type of 'main'")
     noMainMsg = ptext SLIT("No 'main' defined in module Main")