X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FRdrName.lhs;h=c8a510f90ad0bb0396dc4c093c001c9903b38222;hb=ea94a66d93047a9b0cd4532645eb1e9be04888e1;hp=69b791f6a92529c6a05bf2ca1c9fcf8c6db22418;hpb=f278f0676579f67075033a4f9857715909c4b71e;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index 69b791f..c8a510f 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -30,7 +30,6 @@ module RdrName (
 	mkRdrUnqual, mkRdrQual, 
 	mkUnqual, mkVarUnqual, mkQual, mkOrig,
 	nameRdrName, getRdrName, 
-	mkDerivedRdrName, 
 
 	-- ** Destruction
 	rdrNameOcc, rdrNameSpace, setRdrNameSpace,
@@ -49,7 +48,7 @@ module RdrName (
 	lookupGlobalRdrEnv, extendGlobalRdrEnv,
 	pprGlobalRdrEnv, globalRdrEnvElts,
 	lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
-        hideSomeUnquals, findLocalDupsRdrEnv, pickGREs,
+        transformGREs, findLocalDupsRdrEnv, pickGREs,
 
 	-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
 	GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
@@ -164,14 +163,6 @@ mkOrig :: Module -> OccName -> RdrName
 mkOrig mod occ = Orig mod occ
 
 ---------------
--- | Produce an original 'RdrName' whose module that of a parent 'Name' but its 'OccName'
--- is derived from that of it's parent using the supplied function
-mkDerivedRdrName :: Name -> (OccName -> OccName) -> RdrName
-mkDerivedRdrName parent mk_occ
-  = ASSERT2( isExternalName parent, ppr parent )
-    mkOrig (nameModule parent) (mk_occ (nameOccName parent))
-
----------------
 	-- These two are used when parsing source files
 	-- They do encode the module and occurrence names
 mkUnqual :: NameSpace -> FastString -> RdrName
@@ -393,18 +384,6 @@ plusParent :: Parent -> Parent -> Parent
 plusParent p1 p2 = ASSERT2( p1 == p2, parens (ppr p1) <+> parens (ppr p2) )
                    p1
 
-{- Why so complicated? -=chak
-plusParent :: Parent -> Parent -> Parent
-plusParent NoParent     rel = 
-  ASSERT2( case rel of { NoParent -> True; other -> False }, 
-	   ptext (sLit "plusParent[NoParent]: ") <+> ppr rel )    
-  NoParent
-plusParent (ParentIs n) rel = 
-  ASSERT2( case rel of { ParentIs m -> n==m;  other -> False }, 
-	   ptext (sLit "plusParent[ParentIs]:") <+> ppr n <> comma <+> ppr rel )
-  ParentIs n
- -}
-
 emptyGlobalRdrEnv :: GlobalRdrEnv
 emptyGlobalRdrEnv = emptyOccEnv
 
@@ -448,10 +427,13 @@ lookupGRE_Name env name
 	    gre_name gre == name ]
 
 getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
+-- Returns all the qualifiers by which 'x' is in scope
+-- Nothing means "the unqualified version is in scope"
 getGRE_NameQualifier_maybes env
   = map qualifier_maybe . map gre_prov . lookupGRE_Name env
-  where qualifier_maybe LocalDef       = Nothing
-        qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss 
+  where
+    qualifier_maybe LocalDef       = Nothing
+    qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
 
 pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
 -- ^ Take a list of GREs which have the right OccName
@@ -558,37 +540,17 @@ plusGRE g1 g2
 	  gre_prov = gre_prov g1 `plusProv`   gre_prov g2,
 	  gre_par  = gre_par  g1 `plusParent` gre_par  g2 }
 
-hideSomeUnquals :: GlobalRdrEnv -> [OccName] -> GlobalRdrEnv
--- ^ Hide any unqualified bindings for the specified OccNames
--- This is used in TH, when renaming a declaration bracket
---
--- > [d| foo = ... |]
---
--- We want unqualified @foo@ in "..." to mean this @foo@, not
--- the one from the enclosing module.  But the /qualified/ name
--- from the enclosing module must certainly still be available
-
--- 	Seems like 5 times as much work as it deserves!
-hideSomeUnquals rdr_env occs
-  = foldr hide rdr_env occs
+transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
+	      -> [OccName] 
+              -> GlobalRdrEnv -> GlobalRdrEnv
+-- ^ Apply a transformation function to the GREs for these OccNames
+transformGREs trans_gre occs rdr_env
+  = foldr trans rdr_env occs
   where
-    hide occ env 
-	| Just gres <- lookupOccEnv env occ = extendOccEnv env occ (map qual_gre gres)
-	| otherwise			    = env
-    qual_gre gre@(GRE { gre_name = name, gre_prov = LocalDef })
-	= gre { gre_prov = Imported [imp_spec] }
-	where	-- Local defs get transfomed to (fake) imported things
-	  mod = ASSERT2( isExternalName name, ppr name) moduleName (nameModule name)
-	  imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
-	  decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod, 
-				    is_qual = True, 
-				    is_dloc = srcLocSpan (nameSrcLoc name) }
-
-    qual_gre gre@(GRE { gre_prov = Imported specs })
-	= gre { gre_prov = Imported (map qual_spec specs) }
-
-    qual_spec spec@(ImpSpec { is_decl = decl_spec })
-  	= spec { is_decl = decl_spec { is_qual = True } }
+    trans occ env 
+      = case lookupOccEnv env occ of 
+           Just gres -> extendOccEnv env occ (map trans_gre gres)
+           Nothing   -> env
 \end{code}
 
 %************************************************************************