Refactor RnEnv to fix Trac #2901

This tidy-up fixes Trac #2901, and eliminates 20 lines of code.
Mainly this is done by making a version of lookupGlobalOccRn that
returns (Maybe Name); this replaces lookupSrcOccRn but does more.

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 2a1ae6b..fa15136 100644 (file)
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -1,4 +1,4 @@
-\%
+%
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-2006
 %
 \section[RnEnv]{Environment manipulation for the renamer monad}
@@ -8,12 +8,12 @@ module RnEnv (
        newTopSrcBinder, lookupFamInstDeclBndr,
        lookupLocatedTopBndrRn, lookupTopBndrRn,
        lookupLocatedOccRn, lookupOccRn, 
-       lookupLocatedGlobalOccRn, lookupGlobalOccRn,
-       lookupLocalDataTcNames, lookupSrcOcc_maybe,
-       lookupSigOccRn,
+       lookupLocatedGlobalOccRn, 
+       lookupGlobalOccRn, lookupGlobalOccRn_maybe,
+       lookupLocalDataTcNames, lookupSigOccRn,
        lookupFixityRn, lookupTyFixityRn, 
        lookupInstDeclBndr, lookupRecordBndr, lookupConstructorFields,
-       lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
+       lookupSyntaxName, lookupSyntaxTable, 
        lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
        getLookupOccRn,
 
@@ -300,10 +300,9 @@ lookup_sub_bndr is_good doc rdr_name
        }
 
   | otherwise  -- Occurs in derived instances, where we just
-               -- refer directly to the right method
-  = ASSERT2( not (isQual rdr_name), ppr rdr_name )
-         -- NB: qualified names are rejected by the parser
-    lookupImportedName rdr_name
+               -- refer directly to the right method with an Orig
+               -- And record fields can be Quals: C { F.f = x }
+  = lookupGlobalOccRn rdr_name
 
 newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
 newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
@@ -350,54 +349,43 @@ lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn
 
 lookupGlobalOccRn :: RdrName -> RnM Name
 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
--- environment.  It's called directly only for
---     record field names
---     class op names in class and instance decls
---     names in export lists
+-- environment.  Adds an error message if the RdrName is not in scope.
+-- Also has a special case for GHCi.
 
 lookupGlobalOccRn rdr_name
-  | not (isSrcRdrName rdr_name)
-  = lookupImportedName rdr_name        
-
-  | otherwise
-  = 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   -> 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.
-   allow_qual <- doptM Opt_ImplicitImportQualified
-   mod <- getModule
+  = do { -- First look up the name in the normal environment.
+         mb_name <- lookupGlobalOccRn_maybe rdr_name
+       ; case mb_name of {
+               Just n  -> return n ;
+               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.
+        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 unboundName rdr_name
-  }
-
-lookupImportedName :: RdrName -> TcRnIf m n Name
--- Lookup the occurrence of an imported name
--- The RdrName is *always* qualified or Exact
--- Treat it as an original name, and conjure up the Name
--- Usually it's Exact or Orig, but it can be Qual if it
---     comes from an hi-boot file.  (This minor infelicity is 
---     just to reduce duplication in the parser.)
-lookupImportedName rdr_name
-  | Just n <- isExact_maybe rdr_name 
-       -- This happens in derived code
-  = returnM n
-
-       -- Always Orig, even when reading a .hi-boot file
+       ; if isQual rdr_name && allow_qual && mod == iNTERACTIVE
+         then lookupQualifiedName rdr_name
+         else unboundName rdr_name } } }
+
+lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
+-- No filter function; does not report an error on failure
+
+lookupGlobalOccRn_maybe rdr_name
+  | Just n <- isExact_maybe rdr_name   -- This happens in derived code
+  = return (Just n)
+
   | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
-  = lookupOrig rdr_mod rdr_occ
+  = do { n <- lookupOrig rdr_mod rdr_occ; return (Just n) }
 
   | otherwise
-  = pprPanic "RnEnv.lookupImportedName" (ppr rdr_name)
+  = do { mb_gre <- lookupGreRn_maybe rdr_name
+       ; case mb_gre of
+               Nothing  -> return Nothing
+               Just gre -> return (Just (gre_name gre)) }
+
 
 unboundName :: RdrName -> RnM Name
 unboundName rdr_name 
@@ -412,15 +400,6 @@ unboundName rdr_name
 --     Lookup in the Global RdrEnv of the module
 --------------------------------------------------
 
-lookupSrcOcc_maybe :: RdrName -> RnM (Maybe Name)
--- No filter function; does not report an error on failure
-lookupSrcOcc_maybe rdr_name
-  = do { mb_gre <- lookupGreRn_maybe rdr_name
-       ; case mb_gre of
-               Nothing  -> returnM Nothing
-               Just gre -> returnM (Just (gre_name gre)) }
-       
--------------------------
 lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
 -- Just look up the RdrName in the GlobalRdrEnv
 lookupGreRn_maybe rdr_name 

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 2b3e9c0..14c96ae 100644 (file)
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -21,7 +21,7 @@ import FamInst
 import FamInstEnv
 import TcDeriv
 import TcEnv
-import RnEnv   ( lookupImportedName )
+import RnEnv   ( lookupGlobalOccRn )
 import TcHsType
 import TcUnify
 import TcSimplify
@@ -863,7 +863,7 @@ tcInstanceMethod loc clas tyvars dfun_dicts theta inst_tys
                        {   -- Build the typechecked version directly, 
                            -- without calling typecheck_method; 
                            -- see Note [Default methods in instances]
-                         dm_name <- lookupImportedName (mkDefMethRdrName sel_name)
+                         dm_name <- lookupGlobalOccRn (mkDefMethRdrName sel_name)
                                        -- Might not be imported, but will be an OrigName
                        ; dm_id   <- tcLookupId dm_name
                        ; return (wrapId dm_wrapper dm_id, emptyBag) } }

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index e0d8632..7739e0e 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -877,7 +877,7 @@ check_main dflags tcg_env
    return tcg_env
 
  | otherwise
- = do  { mb_main <- lookupSrcOcc_maybe main_fn
+ = do  { mb_main <- lookupGlobalOccRn_maybe main_fn
                -- Check that 'main' is in scope
                -- It might be imported from another module!
        ; case mb_main of {

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index f025ac2..9a03acb 100644 (file)
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -825,11 +825,7 @@ lookupThName_maybe th_name
             ; rdr_env <- getLocalRdrEnv
             ; case lookupLocalRdrEnv rdr_env rdr_name of
                 Just name -> return (Just name)
-                Nothing | not (isSrcRdrName rdr_name)  -- Exact, Orig
-                        -> do { name <- lookupImportedName rdr_name
-                              ; return (Just name) }
-                        | otherwise                    -- Unqual, Qual
-                        -> lookupSrcOcc_maybe rdr_name }
+                Nothing   -> lookupGlobalOccRn_maybe rdr_name }
 
 tcLookupTh :: Name -> TcM TcTyThing
 -- This is a specialised version of TcEnv.tcLookup; specialised mainly in that