[project @ 2001-06-27 16:38:17 by simonmar]

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

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 3c25da0..d7167ad 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -38,11 +38,10 @@ import Module               ( ModuleName, moduleName, mkVanillaModule,
 import PrelNames       ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap,
                          derivingOccurrences,
                          mAIN_Name, pREL_MAIN_Name, 
-                         ioTyConName, integerTyConName, doubleTyConName, intTyConName, 
+                         ioTyConName, intTyConName, 
                          boolTyConName, funTyConName,
                          unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
                          eqStringName, printName, 
-                         hasKey, fractionalClassKey, numClassKey,
                          bindIOName, returnIOName, failIOName
                        )
 import TysWiredIn      ( unitTyCon )   -- A little odd
@@ -288,7 +287,7 @@ lookupQualifiedName rdr_name
        mod = rdrNameModule rdr_name
        occ = rdrNameOcc rdr_name
    in
-   loadInterface (ppr rdr_name) mod ImportBySystem `thenRn` \ iface ->
+   loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface ->
    case  [ name | (_,avails) <- mi_exports iface,
           avail             <- avails,
           name              <- availNames avail,
@@ -411,21 +410,6 @@ ubiquitousNames
 \end{code}
 
 \begin{code}
-implicitGates :: Name -> FreeVars      
--- If we load class Num, add Integer to the gates
--- This takes account of the fact that Integer might be needed for
--- defaulting, but we don't want to load Integer (and all its baggage)
--- if there's no numeric stuff needed.
--- Similarly for class Fractional and Double
---
--- NB: If we load (say) Floating, we'll end up loading Fractional too,
---     since Fractional is a superclass of Floating
-implicitGates cls | cls `hasKey` numClassKey       = unitFV integerTyConName
-                 | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
-                 | otherwise                       = emptyFVs
-\end{code}
-
-\begin{code}
 rnSyntaxNames :: GlobalRdrEnv -> FreeVars -> RnMG (FreeVars, SyntaxMap)
 -- Look up the re-bindable syntactic sugar names
 -- Any errors arising from these lookups may surprise the
@@ -472,9 +456,8 @@ newLocalsRn :: [(RdrName,SrcLoc)]
 newLocalsRn rdr_names_w_loc
  =  getNameSupplyRn            `thenRn` \ name_supply ->
     let
-       n          = length rdr_names_w_loc
        (us', us1) = splitUniqSupply (nsUniqs name_supply)
-       uniqs      = uniqsFromSupply n us1
+       uniqs      = uniqsFromSupply us1
        names      = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
                     | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
                     ]
@@ -494,12 +477,11 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
        -- Check for duplicate names
     checkDupOrQualNames doc_str rdr_names_w_loc        `thenRn_`
 
-    doptRn Opt_WarnNameShadowing               `thenRn` \ warn_shadow ->
-
        -- Warn about shadowing, but only in source modules
     (case mode of
-       SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
-       other                              -> returnRn ()
+       SourceMode -> ifOptRn Opt_WarnNameShadowing     $
+                     mapRn_ (check_shadow name_env) rdr_names_w_loc
+       other      -> returnRn ()
     )                                  `thenRn_`
        
     newLocalsRn rdr_names_w_loc                `thenRn` \ names ->
@@ -915,9 +897,7 @@ mapFvRn f xs = mapRn f xs   `thenRn` \ stuff ->
 \begin{code}
 warnUnusedModules :: [ModuleName] -> RnM d ()
 warnUnusedModules mods
-  = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
-    if warn then mapRn_ (addWarnRn . unused_mod) mods
-           else returnRn ()
+  = ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods)
   where
     unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> 
                           text "is imported, but nothing from it is used",
@@ -926,19 +906,14 @@ warnUnusedModules mods
 
 warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
 warnUnusedImports names
-  = doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
-    if warn then warnUnusedBinds names else returnRn ()
+  = ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names)
 
 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
 warnUnusedLocalBinds names
-  = doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
-    if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
-           else returnRn ()
+  = ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names])
 
 warnUnusedMatches names
-  = doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
-    if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
-           else returnRn ()
+  = ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names])
 
 -------------------------
 
@@ -1008,13 +983,13 @@ dupNamesErr descriptor ((name,loc) : dup_things)
   = pushSrcLocRn loc $
     addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
              $$ 
-             (ptext SLIT("in") <+> descriptor))
+             descriptor)
 
 warnDeprec :: Name -> DeprecTxt -> RnM d ()
 warnDeprec name txt
-  = doptRn Opt_WarnDeprecations                                `thenRn` \ warn_drs ->
-    if not warn_drs then returnRn () else
+  = ifOptRn Opt_WarnDeprecations       $
     addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+> 
                     quotes (ppr name) <+> text "is deprecated:", 
                     nest 4 (ppr txt) ])
 \end{code}
+