Squash a space leak

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

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 94c90ac..a0d323d 100644 (file)
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -30,7 +30,7 @@ module RnEnv (
        mapFvRn, mapFvRnCPS,
        warnUnusedMatches, warnUnusedModules, warnUnusedImports, 
        warnUnusedTopBinds, warnUnusedLocalBinds,
-       dataTcOccs, unknownNameErr
+       dataTcOccs, unknownNameErr, perhapsForallMsg
     ) where
 
 #include "HsVersions.h"
@@ -359,23 +359,27 @@ lookupGlobalOccRn rdr_name
   = lookupImportedName rdr_name        
 
   | otherwise
-  =    -- First look up the name in the normal environment.
-   lookupGreRn_maybe rdr_name          `thenM` \ mb_gre ->
+  = do
+       -- First look up the name in the normal environment.
+   mb_gre <- lookupGreRn_maybe rdr_name
    case mb_gre of {
        Just gre -> returnM (gre_name gre) ;
-       Nothing   -> 
+       Nothing   -> do
 
        -- We allow qualified names on the command line to refer to 
        --  *any* name exported by any module in scope, just as if 
        -- there was an "import qualified M" declaration for every 
        -- module.
-   getModule           `thenM` \ mod ->
-   if isQual rdr_name && mod == iNTERACTIVE then       
-                                       -- This test is not expensive,
-       lookupQualifiedName rdr_name    -- and only happens for failed lookups
-   else        do
+   allow_qual <- doptM Opt_ImplicitImportQualified
+   mod <- getModule
+               -- This test is not expensive,
+               -- and only happens for failed lookups
+   if isQual rdr_name && allow_qual && mod == iNTERACTIVE
+      then lookupQualifiedName rdr_name
+      else do 
         traceRn $ text "lookupGlobalOccRn"
-       unboundName rdr_name }
+        unboundName rdr_name
+  }
 
 lookupImportedName :: RdrName -> TcRnIf m n Name
 -- Lookup the occurrence of an imported name
@@ -466,7 +470,7 @@ lookupQualifiedName rdr_name
   | Just (mod,occ) <- isQual_maybe rdr_name
    -- Note: we want to behave as we would for a source file import here,
    -- and respect hiddenness of modules/packages, hence loadSrcInterface.
-   = loadSrcInterface doc mod False    `thenM` \ iface ->
+   = loadSrcInterface doc mod False Nothing    `thenM` \ iface ->
 
    case  [ (mod,occ) | 
           (mod,avails) <- mi_exports iface,
@@ -864,11 +868,9 @@ checkShadowedNames doc_str (global_env,local_env) loc_rdr_names
 \begin{code}
 -- A useful utility
 mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
-mapFvRn f xs = mappM f xs      `thenM` \ stuff ->
-              let
-                 (ys, fvs_s) = unzip stuff
-              in
-              returnM (ys, plusFVs fvs_s)
+mapFvRn f xs = do stuff <- mappM f xs
+                  case unzip stuff of
+                      (ys, fvs_s) -> returnM (ys, plusFVs fvs_s)
 
 -- because some of the rename functions are CPSed:
 -- maps the function across the list from left to right; 
@@ -982,9 +984,13 @@ unknownNameErr rdr_name
                          <+> quotes (ppr rdr_name))
         , extra ]
   where
-    extra | rdr_name == forall_tv_RDR 
-         = ptext (sLit "Perhaps you intended to use -XRankNTypes or similar flag")
-         | otherwise = empty
+    extra | rdr_name == forall_tv_RDR = perhapsForallMsg
+         | otherwise                 = empty
+
+perhapsForallMsg :: SDoc
+perhapsForallMsg 
+  = vcat [ ptext (sLit "Perhaps you intended to use -XRankNTypes or similar flag")
+        , ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")]
 
 unknownSubordinateErr :: SDoc -> RdrName -> SDoc
 unknownSubordinateErr doc op   -- Doc is "method of class" or