[project @ 1999-12-06 11:54:56 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / Rename.lhs

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index baf7b30..730f02d 100644 (file)
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -44,9 +44,7 @@ import PrelMods               ( mAIN_Name, pREL_MAIN_Name )
 import TysWiredIn      ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
 import PrelInfo                ( ioTyCon_NAME, numClass_RDR, thinAirIdNames, derivingOccurrences )
 import Type            ( namesOfType, funTyCon )
-import ErrUtils                ( pprBagOfErrors, pprBagOfWarnings,
-                         doIfSet, dumpIfSet, ghcExit
-                       )
+import ErrUtils                ( printErrorsAndWarnings, dumpIfSet, ghcExit )
 import BasicTypes      ( NewOrData(..) )
 import Bag             ( isEmptyBag, bagToList )
 import FiniteMap       ( fmToList, delListFromFM, addToFM, sizeFM, eltsFM )
@@ -74,28 +72,19 @@ renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc
   =    -- Initialise the renamer monad
     initRn mod_name us (mkSearchPath opt_HiMap) loc
           (rename this_mod)                            >>=
-       \ (maybe_rn_stuff, rn_errs_bag, rn_warns_bag) ->
+       \ ((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag) ->
 
        -- Check for warnings
-    doIfSet (not (isEmptyBag rn_warns_bag))
-           (printErrs (pprBagOfWarnings rn_warns_bag)) >>
-
-       -- Check for errors; exit if so
-    doIfSet (not (isEmptyBag rn_errs_bag))
-           (printErrs (pprBagOfErrors rn_errs_bag)      >>
-            ghcExit 1
-           )                                            >>
-
-       -- Dump output, if any
-    (case maybe_rn_stuff of
-       Nothing  -> return ()
-       Just results@(_, rn_mod, _, _, _)
-                -> dumpIfSet opt_D_dump_rn "Renamer:"
-                             (ppr rn_mod)
-    )                                                  >>
+    printErrorsAndWarnings rn_errs_bag rn_warns_bag    >>
+
+       -- Dump any debugging output
+    dump_action                                        >>
 
        -- Return results
-    return maybe_rn_stuff
+    if not (isEmptyBag rn_errs_bag) then
+           ghcExit 1 >> return Nothing
+    else
+           return maybe_rn_stuff
 \end{code}
 
 
@@ -107,8 +96,8 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
        -- CHECK FOR EARLY EXIT
     if not (maybeToBool maybe_stuff) then
        -- Everything is up to date; no need to recompile further
-       rnStats []              `thenRn_`
-       returnRn Nothing
+       rnDump [] []            `thenRn` \ dump_action ->
+       returnRn (Nothing, dump_action)
     else
     let
        Just (export_env, gbl_env, fixity_env, global_avail_env) = maybe_stuff
@@ -128,13 +117,16 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
                -- override the implicit ones. 
     in
     slurpImpDecls real_source_fvs      `thenRn` \ rn_imp_decls ->
+    let
+       rn_all_decls       = rn_imp_decls ++ rn_local_decls 
+    in
 
        -- EXIT IF ERRORS FOUND
-    checkErrsRn                                `thenRn` \ no_errs_so_far ->
+    checkErrsRn                                        `thenRn` \ no_errs_so_far ->
     if not no_errs_so_far then
        -- Found errors already, so exit now
-       rnStats []              `thenRn_`
-       returnRn Nothing
+       rnDump rn_imp_decls rn_all_decls        `thenRn` \ dump_action ->
+       returnRn (Nothing, dump_action)
     else
 
        -- GENERATE THE VERSION/USAGE INFO
@@ -150,18 +142,17 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
     let
        has_orphans        = any isOrphanDecl rn_local_decls
        direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
-       rn_all_decls       = rn_imp_decls ++ rn_local_decls 
        renamed_module = HsModule mod_name vers 
                                  trashed_exports trashed_imports
                                  rn_all_decls
                                  loc
     in
-    rnStats rn_imp_decls       `thenRn_`
+    rnDump rn_imp_decls        rn_all_decls            `thenRn` \ dump_action ->
     returnRn (Just (mkThisModule mod_name,
                    renamed_module, 
                    (has_orphans, my_usages, export_env),
                    name_supply,
-                   direct_import_mods))
+                   direct_import_mods), dump_action)
   where
     trashed_exports  = {-trace "rnSource:trashed_exports"-} Nothing
     trashed_imports  = {-trace "rnSource:trashed_imports"-} []
@@ -405,12 +396,12 @@ vars of the source program, and extracts from the decl the gate names.
 getGates source_fvs (SigD (IfaceSig _ ty _ _))
   = extractHsTyNames ty
 
-getGates source_fvs (TyClD (ClassDecl ctxt cls tvs sigs _ _ _ _ _ _))
+getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _))
   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
                       (map getTyVarName tvs)
     `addOneToNameSet` cls
   where
-    get (ClassOpSig n _ ty _) 
+    get (ClassOpSig n _ _ ty _) 
        | n `elemNameSet` source_fvs = extractHsTyNames ty
        | otherwise                  = emptyFVs
 
@@ -523,18 +514,20 @@ reportableUnusedName name
     explicitlyImported other                                = False
        -- Don't report others
 
-rnStats :: [RenamedHsDecl] -> RnMG ()
-rnStats imp_decls
+rnDump  :: [RenamedHsDecl]     -- Renamed imported decls
+       -> [RenamedHsDecl]      -- Renamed local decls
+       -> RnMG (IO ())
+rnDump imp_decls decls
         | opt_D_dump_rn_trace || 
          opt_D_dump_rn_stats ||
          opt_D_dump_rn 
-       = getRnStats imp_decls          `thenRn` \ msg ->
-         ioToRnM (printErrs msg)       `thenRn_`
-         returnRn ()
+       = getRnStats imp_decls          `thenRn` \ stats_msg ->
 
-       | otherwise = returnRn ()
-\end{code}
+         returnRn (printErrs stats_msg >> 
+                   dumpIfSet opt_D_dump_rn "Renamer:" (vcat (map ppr decls)))
 
+       | otherwise = returnRn (return ())
+\end{code}
 
 
 %*********************************************************