[project @ 2001-12-07 17:33:26 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 a7fd614..25307f2 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -56,6 +56,7 @@ import Util           ( sortLt )
 import BasicTypes      ( mapIPName )
 import List            ( nub )
 import UniqFM          ( lookupWithDefaultUFM )
+import Maybe           ( mapMaybe )
 import CmdLineOpts
 import FastString      ( FastString )
 \end{code}
@@ -258,6 +259,11 @@ lookupInstDeclBndr cls_name rdr_name
   | otherwise  
   = getGlobalAvails    `thenRn` \ avail_env ->
     case lookupNameEnv avail_env cls_name of
+         -- The class itself isn't in scope, so cls_name is unboundName
+         -- e.g.   import Prelude hiding( Ord )
+         --        instance Ord T where ...
+         -- The program is wrong, but that should not cause a crash.
+       Nothing -> returnRn (mkUnboundName rdr_name)
        Just (AvailTC _ ns) -> case [n | n <- ns, nameOccName n == occ] of
                                (n:ns)-> ASSERT( null ns ) returnRn n
                                []    -> failWithRn (mkUnboundName rdr_name)
@@ -678,13 +684,11 @@ mkGlobalRdrEnv :: ModuleName              -- Imported module (after doing the "as M" name ch
               -> Bool                  -- True <=> want unqualified import
               -> (Name -> Provenance)
               -> Avails                -- Whats imported
-              -> Avails                -- What's to be hidden
-                                       -- I.e. import (imports - hides)
               -> Deprecations
               -> GlobalRdrEnv
 
-mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
-  = gbl_env3
+mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs
+  = gbl_env2
   where
        -- Make the name environment.  We're talking about a 
        -- single module here, so there must be no name clashes.
@@ -695,12 +699,9 @@ mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
        -- (Qualified names are always imported)
     gbl_env1 = foldl add_avail emptyRdrEnv avails
 
-       -- Delete (qualified names of) things that are hidden
-    gbl_env2 = foldl del_avail gbl_env1 hides
-
        -- Add unqualified names
-    gbl_env3 | unqual_imp = foldl add_unqual gbl_env2 (rdrEnvToList gbl_env2)
-            | otherwise  = gbl_env2
+    gbl_env2 | unqual_imp = foldl add_unqual gbl_env1 (rdrEnvToList gbl_env1)
+            | otherwise  = gbl_env1
 
     add_unqual env (qual_name, elts)
        = foldl add_one env elts
@@ -712,13 +713,6 @@ mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
        -- the module (multiple bindings for the same name) we may get
        -- duplicates.  So the simple thing is to do the fold.
 
-    del_avail env avail 
-       = foldl delOneFromGlobalRdrEnv env rdr_names
-       where
-         rdr_names = map (mkRdrQual this_mod . nameOccName)
-                         (availNames avail)
-
-
     add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
     add_avail env avail = foldl add_name env (availNames avail)
 
@@ -737,7 +731,7 @@ mkIfaceGlobalRdrEnv m_avails
   = foldl add emptyRdrEnv m_avails
   where
     add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True 
-                                                               (\n -> LocalDef) avails [] NoDeprecs)
+                                                               (\n -> LocalDef) avails NoDeprecs)
                -- The NoDeprecs is a bit of a hack I suppose
 \end{code}
 
@@ -790,8 +784,12 @@ in error messages.
 
 \begin{code}
 unQualInScope :: GlobalRdrEnv -> Name -> Bool
--- True if 'f' is in scope, and has only one binding
+-- True if 'f' is in scope, and has only one binding,
+-- and the thing it is bound to is the name we are looking for
 -- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
+--
+-- This fn is only efficient if the shared 
+-- partial application is used a lot.
 unQualInScope env
   = (`elemNameSet` unqual_names)
   where
@@ -916,6 +914,21 @@ sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n)
                           n1 `lt` n2 = nameOccName n1 < nameOccName n2
 \end{code}
 
+\begin{code}
+pruneAvails :: (Name -> Bool)  -- Keep if this is True
+           -> [AvailInfo]
+           -> [AvailInfo]
+pruneAvails keep avails
+  = mapMaybe del avails
+  where
+    del :: AvailInfo -> Maybe AvailInfo        -- Nothing => nothing left!
+    del (Avail n) | keep n    = Just (Avail n)
+                 | otherwise = Nothing
+    del (AvailTC n ns) | null ns'  = Nothing
+                      | otherwise = Just (AvailTC n ns')
+                      where
+                        ns' = filter keep ns
+\end{code}
 
 %************************************************************************
 %*                                                                     *