[project @ 2003-11-06 17:09:50 by simonpj]

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

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 708f509..d69d5c0 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -42,7 +42,7 @@ import RdrName                ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
 import HsTypes         ( hsTyVarName, replaceTyVarName )
 import HscTypes                ( availNames, ModIface(..), FixItem(..), lookupFixity )
 import TcRnMonad
-import Name            ( Name, nameIsLocalOrFrom, mkInternalName, 
+import Name            ( Name, nameIsLocalOrFrom, mkInternalName, isInternalName,
                          nameSrcLoc, nameOccName, nameModuleName, nameParent )
 import NameSet
 import OccName         ( tcName, isDataOcc, occNameFlavour, reportIfUnused )
@@ -124,10 +124,10 @@ lookupTopBndrRn :: RdrName -> RnM Name
 
 lookupTopBndrRn rdr_name
   | Just name <- isExact_maybe rdr_name
-       -- This is here just to catch the PrelBase defn of (say) [] and similar
-       -- The parser reads the special syntax and returns an Exact RdrName
-       -- But the global_env contains only Qual RdrNames, so we won't
-       -- find it there; instead just get the name via the Orig route
+       -- This is here to catch 
+       --   (a) Exact-name binders created by Template Haskell
+       --   (b) The PrelBase defn of (say) [] and similar, for which
+       --       the parser reads the special syntax and returns an Exact RdrName
        --
        -- We are at a binding site for the name, so check first that it 
        -- the current module is the correct one; otherwise GHC can get
@@ -135,7 +135,7 @@ lookupTopBndrRn rdr_name
        --      data T = (,) Int Int
        -- unless we are in GHC.Tup
   = getModule                          `thenM` \ mod -> 
-    checkErr (moduleName mod == nameModuleName name)
+    checkErr (isInternalName name || moduleName mod == nameModuleName name)
             (badOrigBinding rdr_name)  `thenM_`
     returnM name
 
@@ -492,29 +492,25 @@ lookupSyntaxNames std_names
 %*********************************************************
 
 \begin{code}
-newLocalsRn :: [(RdrName,SrcLoc)]
-           -> RnM [Name]
+newLocalsRn :: [(RdrName,SrcLoc)] -> RnM [Name]
 newLocalsRn rdr_names_w_loc
- =  newUniqueSupply            `thenM` \ us ->
-    let
-       uniqs      = uniqsFromSupply us
-       names      = [ mkInternalName uniq (rdrNameOcc rdr_name) loc
-                    | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
-                    ]
-    in
-    returnM names
-
+  = newUniqueSupply            `thenM` \ us ->
+    returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
+  where
+    mk (rdr_name, loc) uniq
+       | Just name <- isExact_maybe rdr_name = name
+               -- This happens in code generated by Template Haskell 
+       | otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
+                       -- We only bind unqualified names here
+                       -- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
+                     mkInternalName uniq (rdrNameOcc rdr_name) loc
 
 bindLocatedLocalsRn :: SDoc    -- Documentation string for error message
                    -> [(RdrName,SrcLoc)]
                    -> ([Name] -> RnM a)
                    -> RnM a
 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
-  = ASSERT2( all (isUnqual . fst) rdr_names_w_loc, ppr rdr_names_w_loc )
-       -- We only bind unqualified names here
-       -- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
-
-       -- Check for duplicate names
+  =    -- Check for duplicate names
     checkDupNames doc_str rdr_names_w_loc      `thenM_`
 
        -- Warn about shadowing, but only in source modules