[project @ 2000-07-14 13:38:39 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 6bdb45b..15a46bf 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -16,7 +16,7 @@ import RnHsSyn                ( RenamedHsType )
 import RdrName         ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
                          mkRdrUnqual, qualifyRdrName
                        )
-import HsTypes         ( getTyVarName, replaceTyVarName )
+import HsTypes         ( hsTyVarName, hsTyVarNames, replaceTyVarName )
 
 import RnMonad
 import Name            ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
@@ -24,8 +24,9 @@ import Name           ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
                          mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName,
                          mkIPName, isWiredInName, hasBetterProv,
                          nameOccName, setNameModule, nameModule,
-                         pprOccName, isLocallyDefined, nameUnique, nameOccName,
-                         setNameProvenance, getNameProvenance, pprNameProvenance
+                         pprOccName, isLocallyDefined, nameUnique, 
+                         setNameProvenance, getNameProvenance, pprNameProvenance,
+                         extendNameEnv_C, plusNameEnv_C, nameEnvElts
                        )
 import NameSet
 import OccName         ( OccName,
@@ -35,9 +36,7 @@ import OccName                ( OccName,
 import TysWiredIn      ( listTyCon )
 import Type            ( funTyCon )
 import Module          ( ModuleName, mkThisModule, moduleName, mkVanillaModule, pprModuleName )
-import TyCon           ( TyCon )
 import FiniteMap
-import Unique          ( Unique, Uniquable(..) )
 import UniqSupply
 import SrcLoc          ( SrcLoc, noSrcLoc )
 import Outputable
@@ -323,6 +322,13 @@ bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b       $ \ name' ->
                                         bindCoreLocalsFVRn bs  $ \ names' ->
                                         thing_inside (name':names')
 
+bindLocalNames names enclosed_scope
+  = getLocalNameEnv            `thenRn` \ name_env ->
+    setLocalNameEnv (addListToRdrEnv name_env pairs)
+                   enclosed_scope
+  where
+    pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names]
+
 -------------------------------------
 bindLocalRn doc rdr_name enclosed_scope
   = getSrcLocRn                                `thenRn` \ loc ->
@@ -351,15 +357,10 @@ bindUVarRn = bindLocalRn
 extendTyVarEnvFVRn :: [HsTyVarBndr Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
        -- This tiresome function is used only in rnDecl on InstDecl
 extendTyVarEnvFVRn tyvars enclosed_scope
-  = getLocalNameEnv            `thenRn` \ env ->
-    let
-       tyvar_names = map getTyVarName tyvars
-       new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name) 
-                                     | name <- tyvar_names
-                                     ]
-    in
-    setLocalNameEnv new_env enclosed_scope     `thenRn` \ (thing, fvs) -> 
+  = bindLocalNames tyvar_names enclosed_scope  `thenRn` \ (thing, fvs) -> 
     returnRn (thing, delListFromNameSet fvs tyvar_names)
+  where
+    tyvar_names = hsTyVarNames tyvars
 
 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
              -> ([HsTyVarBndr Name] -> RnMS a)
@@ -375,7 +376,7 @@ bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
 bindTyVars2Rn doc_str tyvar_names enclosed_scope
   = getSrcLocRn                                        `thenRn` \ loc ->
     let
-       located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names] 
+       located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names] 
     in
     bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
     enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
@@ -475,38 +476,13 @@ lookupGlobalOccRn rdr_name
 --     import M( f )
 --     f :: Int -> Int
 --     f x = x
--- In a sense, it's clear that the 'f' in the signature must refer
--- to A.f, but the Haskell98 report does not stipulate this, so
--- I treat the 'f' in the signature as a reference to an unqualified
--- 'f' and hence fail with an ambiguous reference.
+-- It's clear that the 'f' in the signature must refer to A.f
+-- The Haskell98 report does not stipulate this, but it will!
+-- So we must treat the 'f' in the signature in the same way
+-- as the binding occurrence of 'f', using lookupBndrRn
 lookupSigOccRn :: RdrName -> RnMS Name
-lookupSigOccRn = lookupOccRn
-
-{-     OLD VERSION
--- This code tries to be cleverer than the above.
--- The variable in a signature must refer to a locally-defined thing,
--- even if there's an imported thing of the same name.
--- 
--- But this doesn't work for instance decls:
---     instance Enum Int where
---       {-# INLINE enumFrom #-}
---       ...
--- Here the enumFrom is an imported reference!
-lookupSigOccRn rdr_name
-  = getNameEnvs                                `thenRn` \ (global_env, local_env) ->
-    case (lookupRdrEnv local_env rdr_name, lookupRdrEnv global_env rdr_name) of
-       (Just name, _) -> returnRn name
-
-       (Nothing, Just names) -> case filter isLocallyDefined names of
-                                  [n] -> returnRn n
-                                  ns  -> pprPanic "lookupSigOccRn" (ppr rdr_name <+> ppr names <+> ppr ns)
-                                       -- There can't be a local top-level name-clash
-                                       -- (That's dealt with elsewhere.)
+lookupSigOccRn = lookupBndrRn
 
-       (Nothing, Nothing) -> failWithRn (mkUnboundName rdr_name)
-                                        (unknownNameErr rdr_name)
--}
-  
 
 -- Look in both local and global env
 lookup_occ global_env local_env rdr_name
@@ -635,7 +611,7 @@ plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2])
 #endif
 
 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
-addAvail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
+addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
 
 emptyAvailEnv = emptyNameEnv
 unitAvailEnv :: AvailInfo -> AvailEnv