[project @ 2002-03-29 21:39:36 by sof]

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

diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 5e63dde..9a07a2f 100644 (file)
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -39,10 +39,10 @@ import IdInfo               ( GlobalIdDetails(..) )
 import TcType          ( namesOfType )
 import FieldLabel      ( fieldLabelTyCon )
 import DataCon         ( dataConTyCon )
-import TyCon           ( isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
+import TyCon           ( visibleDataCons, isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
 import Class           ( className )
 import Name            ( Name {-instance NamedThing-}, nameOccName,
-                         nameModule, isLocalName, NamedThing(..)
+                         nameModule, isInternalName, NamedThing(..)
                         )
 import NameEnv                 ( elemNameEnv, delFromNameEnv, lookupNameEnv )
 import NameSet
@@ -55,7 +55,7 @@ import Module         ( Module, ModuleEnv,
                        )
 import PrelInfo                ( wiredInThingEnv, hasKey, fractionalClassKey, numClassKey, 
                          integerTyConName, doubleTyConName )
-import Maybes          ( maybeToBool )
+import Maybe           ( isJust )
 import FiniteMap
 import Outputable
 import Bag
@@ -380,7 +380,7 @@ recordDeclSlurp ifaces@(Ifaces { iDecls  = (decls_map, n_slurped),
                                 iSlurp  = slurped_names, 
                                 iVSlurp = vslurp })
            avail
-  = ASSERT2( not (isLocalName (availName avail)), ppr avail )
+  = ASSERT2( not (isInternalName (availName avail)), ppr avail )
     ifaces { iDecls = (new_decls_map, n_slurped+1),
             iSlurp  = new_slurped_names, 
             iVSlurp = updateVSlurp vslurp (availName avail) }
@@ -456,7 +456,7 @@ that are mentioned in:
 We slurp in an instance decl from the gated instance pool iff
        
        all its gates are either in the gates of the module, 
-       or are a previously-loaded class.  
+       or are a previously-loaded tycon or class.  
 
 The latter constraint is because there might have been an instance
 decl slurped in during an earlier compilation, like this:
@@ -465,9 +465,19 @@ decl slurped in during an earlier compilation, like this:
 
 In the module being compiled we might need (Baz (Maybe T)), where T
 is defined in this module, and hence we need (Foo T).  So @Foo@ becomes
-a gate.  But there's no way to 'see' that, so 
+a gate.  But there's no way to 'see' that.  More generally, types
+might be involved as well:
+
+       instance Foo2 T a => Baz2 a where ...
+
+Now we must treat T as a gate too, as well as Foo.  So the solution
+we adopt is:
+
+       we simply treat all previously-loaded 
+       tycons and classes as gates.
+
+This gloss only affects ghc --make and ghc --interactive.
 
-       we simply treat all previously-loaded classes as gates.
 
 Consructors and class operations
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -502,6 +512,7 @@ getGates source_fvs decl
 
 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
 get_gates is_used (IfaceSig    {tcdType = ty})    = extractHsTyNames ty
+get_gates is_used (CoreDecl    {tcdType = ty})    = extractHsTyNames ty
 
 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
   = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets` 
@@ -518,7 +529,8 @@ get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
        -- A type synonym type constructor isn't a "gate" for instance decls
 
 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
-  = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
+  = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) 
+                                            (visibleDataCons cons))
                       (hsTyVarNames tvs)
     `addOneToNameSet` tycon
   where
@@ -610,10 +622,8 @@ getImportedInstDecls gates
     getIfacesRn                                        `thenRn` \ ifaces ->
     getTypeEnvRn                                       `thenRn` \ lookup ->
     let
-       available n
-         | n `elemNameSet` gates = True
-         | otherwise             = case lookup n of { Just (AClass c) -> True; other -> False }
-               -- See "The gating story" above for the AClass thing
+       available n = n `elemNameSet` gates || isJust (lookup n)
+               -- See "The gating story" above for the isJust thing
 
        (decls, new_insts) = selectGated available (iInsts ifaces)
     in
@@ -642,7 +652,7 @@ getImportedRules
                -- Slurp rules for anything that is slurped, 
                -- either now or previously
        gates              = iSlurp ifaces      
-       available n        = n `elemNameSet` gates || maybeToBool (lookup n)
+       available n        = n `elemNameSet` gates || isJust (lookup n)
        (decls, new_rules) = selectGated available (iRules ifaces)
     in
     if null decls then