[project @ 2003-02-12 15:01:31 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index 10b390d..88248a0 100644 (file)
@@ -26,14 +26,14 @@ module HscTypes (
        VersionInfo(..), initialVersionInfo, lookupVersion,
        FixityEnv, lookupFixity, collectFixities, emptyFixityEnv,
 
-       TyThing(..), isTyClThing, implicitTyThingIds,
+       TyThing(..), implicitTyThings,
 
        TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
        extendTypeEnvList, extendTypeEnvWithIds,
        typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
 
-       ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
-       IsBootInterface, DeclsMap,
+       WhetherHasOrphans, IsBootInterface, DeclsMap, Usage(..), 
+       Dependencies(..), noDependencies,
        IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, 
        NameCache(..), OrigNameCache, OrigIParamCache,
        Avails, availsToNameSet, availName, availNames,
@@ -78,19 +78,20 @@ import Module
 import InstEnv         ( InstEnv, ClsInstEnv, DFunId )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )
-import Id              ( Id )
-import Class           ( Class, classSelIds )
-import TyCon           ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
-import Type            ( TyThing(..), isTyClThing )
-import DataCon         ( dataConWorkId, dataConWrapId )
-import Packages                ( PackageName, preludePackage )
+import Id              ( Id, idName )
+import Class           ( Class, classSelIds, classTyCon )
+import TyCon           ( TyCon, tyConName, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons )
+import TcType          ( TyThing(..) )
+import DataCon         ( dataConWorkId, dataConWrapId, dataConWrapId_maybe )
+import Packages                ( PackageName, basePackage )
 import CmdLineOpts     ( DynFlags )
 
 import BasicTypes      ( Version, initialVersion, IPName,
                          Fixity, FixitySig(..), defaultFixity )
 
-import HsSyn           ( DeprecTxt, TyClDecl, InstDecl, RuleDecl, 
-                         tyClDeclName, ifaceRuleDeclName, tyClDeclNames )
+import HsSyn           ( DeprecTxt, TyClDecl, InstDecl, RuleDecl,
+                         tyClDeclName, ifaceRuleDeclName, tyClDeclNames,
+                         instDeclDFun )
 import RnHsSyn         ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
 
 import CoreSyn         ( IdCoreRule )
@@ -146,14 +147,12 @@ data HomeModInfo = HomeModInfo { hm_iface    :: ModIface,
 Simple lookups in the symbol table.
 
 \begin{code}
-lookupIface :: HomePackageTable -> PackageIfaceTable -> Name -> Maybe ModIface
+lookupIface :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
 -- We often have two IfaceTables, and want to do a lookup
-lookupIface hpt pit name
+lookupIface hpt pit mod
   = case lookupModuleEnv hpt mod of
        Just mod_info -> Just (hm_iface mod_info)
        Nothing       -> lookupModuleEnv pit mod
-  where
-    mod = nameModule name
 
 lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
 -- We often have two IfaceTables, and want to do a lookup
@@ -193,15 +192,20 @@ data ModIface
    = ModIface {
         mi_module   :: !Module,
        mi_package  :: !PackageName,        -- Which package the module comes from
-        mi_version  :: !VersionInfo,       -- Module version number
+        mi_version  :: !VersionInfo,       -- Version info for everything in this module
         mi_orphan   :: !WhetherHasOrphans,  -- Whether this module has orphans
        mi_boot     :: !IsBootInterface,    -- Read from an hi-boot file?
 
-        mi_usages   :: [ImportVersion Name],
+       mi_deps     :: Dependencies,
+               -- This is consulted for directly-imported modules, but
+               -- not for anything else
+
+        mi_usages   :: [Usage Name],
                -- Usages; kept sorted so that it's easy to decide
                -- whether to write a new iface file (changing usages
                -- doesn't affect the version of this module)
                -- NOT STRICT!  we read this field lazily from the interface file
+               -- It is *only* consulted by the recompilation checker
 
         mi_exports  :: ![ExportItem],
                -- What it exports Kept sorted by (mod,occ), to make
@@ -229,8 +233,6 @@ data ModDetails
         md_rules    :: ![IdCoreRule]   -- Domain may include Ids from other modules
      }
 
-
-
 -- A ModGuts is carried through the compiler, accumulating stuff as it goes
 -- There is only one ModGuts at any time, the one for the module
 -- being compiled right now.  Once it is compiled, a ModIface and 
@@ -239,10 +241,11 @@ data ModDetails
 data ModGuts
   = ModGuts {
         mg_module   :: !Module,
-       mg_exports  :: !Avails,                 -- What it exports
-       mg_usages   :: ![ImportVersion Name],   -- What it imports, directly or otherwise
-                                               -- ...exactly as in ModIface
-       mg_dir_imps :: ![Module],               -- Directly imported modules
+       mg_exports  :: !Avails,         -- What it exports
+       mg_deps     :: !Dependencies,   -- What is below it, directly or otherwise
+       mg_dir_imps :: ![Module],       -- Directly-imported modules; used to
+                                       --      generate initialisation code
+       mg_usages   :: ![Usage Name],   -- Version info for what it needed
 
         mg_rdr_env  :: !GlobalRdrEnv,  -- Top-level lexical environment
        mg_fix_env  :: !FixityEnv,      -- Fixity env, for things declared in this module
@@ -306,22 +309,25 @@ data IfaceDecls = IfaceDecls { dcl_tycl  :: [RenamedTyClDecl],    -- Sorted
                               dcl_insts :: [RenamedInstDecl] } -- Unsorted
 
 mkIfaceDecls :: [RenamedTyClDecl] -> [RenamedRuleDecl] -> [RenamedInstDecl] -> IfaceDecls
+-- Sort to put them in canonical order for version comparison
 mkIfaceDecls tycls rules insts
   = IfaceDecls { dcl_tycl  = sortLt lt_tycl tycls,
                 dcl_rules = sortLt lt_rule rules,
-                dcl_insts = insts }
+                dcl_insts = sortLt lt_inst insts }
   where
     d1 `lt_tycl` d2 = tyClDeclName      d1 < tyClDeclName      d2
     r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2
+    i1 `lt_inst` i2 = instDeclDFun      i1 < instDeclDFun      i2
 \end{code}
 
 \begin{code}
 emptyModIface :: Module -> ModIface
 emptyModIface mod
   = ModIface { mi_module   = mod,
-              mi_package  = preludePackage, -- XXX fully bogus
+              mi_package  = basePackage, -- XXX fully bogus
               mi_version  = initialVersionInfo,
               mi_usages   = [],
+              mi_deps     = noDependencies,
               mi_orphan   = False,
               mi_boot     = False,
               mi_exports  = [],
@@ -353,7 +359,8 @@ data ParsedIface
       pi_pkg       :: PackageName,
       pi_vers     :: Version,                          -- Module version number
       pi_orphan    :: WhetherHasOrphans,               -- Whether this module has orphans
-      pi_usages           :: [ImportVersion OccName],          -- Usages
+      pi_deps      :: Dependencies,                    -- What it depends on
+      pi_usages           :: [Usage OccName],                  -- Usages
       pi_exports   :: (Version, [RdrExportItem]),      -- Exports
       pi_decls    :: [(Version, TyClDecl RdrName)],    -- Local definitions
       pi_fixity           :: [FixitySig RdrName],              -- Local fixity declarations,
@@ -416,24 +423,6 @@ typeEnvElts    env = nameEnvElts env
 typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
 typeEnvTyCons  env = [tc | ATyCon tc <- typeEnvElts env] 
 typeEnvIds     env = [id | AnId id   <- typeEnvElts env] 
-
-implicitTyThingIds :: [TyThing] -> [Id]
--- Add the implicit data cons and selectors etc 
-implicitTyThingIds things
-  = concat (map go things)
-  where
-    go (AnId f)    = []
-    go (AClass cl) = classSelIds cl
-    go (ATyCon tc) = tyConGenIds tc ++
-                    tyConSelIds tc ++
-                    [ n | dc <- tyConDataCons_maybe tc `orElse` [],
-                          n  <- implicitConIds tc dc]
-               -- Synonyms return empty list of constructors and selectors
-
-    implicitConIds tc dc       -- Newtypes have a constructor wrapper,
-                               -- but no worker
-       | isNewTyCon tc = [dataConWrapId dc]
-       | otherwise     = [dataConWorkId dc, dataConWrapId dc]
 \end{code}
 
 
@@ -446,8 +435,45 @@ mkTypeEnv :: [TyThing] -> TypeEnv
 mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
                
 extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
+-- Extend the type environment
 extendTypeEnvList env things
-  = extendNameEnvList env [(getName thing, thing) | thing <- things]
+  = foldl extend env things
+  where
+    extend env thing = extendNameEnv env (getName thing) thing
+
+implicitTyThings :: [TyThing] -> [TyThing]
+implicitTyThings things
+  = concatMap extras things
+  where
+    extras_plus thing = thing : extras thing
+
+    extras (AnId id)   = []
+
+       -- For type constructors, add the data cons (and their extras),
+       -- and the selectors and generic-programming Ids too
+       --
+       -- Newtypes don't have a worker Id, so don't generate that
+    extras (ATyCon tc) = map AnId (tyConGenIds tc ++ tyConSelIds tc) ++ data_con_stuff
+       where
+       data_con_stuff | isNewTyCon tc = [ADataCon dc1, AnId (dataConWrapId dc1)]
+                      | otherwise     = concatMap (extras_plus . ADataCon) dcs
+       dcs = tyConDataCons tc
+       dc1 = head dcs
+                    
+       -- For classes, add the class TyCon too (and its extras)
+       -- and the class selector Ids
+    extras (AClass cl) = map AnId (classSelIds cl) ++
+                        extras_plus (ATyCon (classTyCon cl))
+                        
+
+       -- For data cons add the worker and wrapper (if any)
+    extras (ADataCon dc) 
+       = AnId (dataConWorkId dc) : wrap_id_stuff
+       where
+               -- May or may not have a wrapper
+         wrap_id_stuff = case dataConWrapId_maybe dc of 
+                               Just id -> [AnId id]
+                               Nothing -> []
 
 extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
 extendTypeEnvWithIds env ids
@@ -604,33 +630,35 @@ type WhetherHasOrphans   = Bool
        --      * a transformation rule in a module other than the one defining
        --              the function in the head of the rule.
 
-type IsBootInterface     = Bool
-
-type ImportVersion name  = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
-
-data WhatsImported name  = NothingAtAll                        -- The module is below us in the
-                                                       -- hierarchy, but we import nothing
-                                                       -- Used for orphan modules, so they appear
-                                                       -- in the usage list
+type IsBootInterface = Bool
 
-                        | Everything Version           -- Used for modules from other packages;
-                                                       -- we record only the module's version number
-
-                        | Specifically 
-                               Version                 -- Module version
-                               (Maybe Version)         -- Export-list version, if we depend on it
-                               [(name,Version)]        -- List guaranteed non-empty
-                               Version                 -- Rules version
-
-                        deriving( Eq )
-       -- 'Specifically' doesn't let you say "I imported f but none of the rules in
+-- Dependency info about modules and packages below this one
+-- in the import hierarchy.  See TcRnTypes.ImportAvails for details.
+--
+-- Invariant: the dependencies of a module M never includes M
+data Dependencies
+  = Deps { dep_mods  :: [(ModuleName,IsBootInterface)],        -- Home-package module dependencies
+          dep_pkgs  :: [PackageName],                  -- External package dependencies
+          dep_orphs :: [ModuleName] }                  -- Orphan modules (whether home or external pkg)
+
+noDependencies :: Dependencies
+noDependencies = Deps [] [] []
+         
+data Usage name 
+  = Usage { usg_name     :: ModuleName,                -- Name of the module
+           usg_mod      :: Version,            -- Module version
+           usg_exports  :: Maybe Version,      -- Export-list version, if we depend on it
+           usg_entities :: [(name,Version)],   -- Sorted by occurrence name
+           usg_rules    :: Version             -- Rules version
+    }      deriving( Eq )
+       -- This type doesn't let you say "I imported f but none of the rules in
        -- the module". If you use anything in the module you get its rule version
        -- So if the rules change, you'll recompile, even if you don't use them.
        -- This is easy to implement, and it's safer: you might not have used the rules last
        -- time round, but if someone has added a new rule you might need it this time
 
        -- The export list field is (Just v) if we depend on the export list:
-       --      we imported the module without saying exactly what we imported
+       --      i.e. we imported the module without saying exactly what we imported
        -- We need to recompile if the module exports changes, because we might
        -- now have a name clash in the importing module.
 \end{code}
@@ -674,11 +702,6 @@ data ExternalPackageState
                --      * Fixities
                --      * Deprecations
 
-       eps_imp_mods :: !ImportedModuleInfo,
-               -- Modules that we know something about, because they are mentioned
-               -- in interface files, BUT which we have not loaded yet.  
-               -- No module is both in here and in the PIT
-
        eps_PTE :: !PackageTypeEnv,             -- Domain = external-package modules
 
        eps_inst_env :: !PackageInstEnv,        -- The total InstEnv accumulated from
@@ -730,20 +753,14 @@ data NameCache
                -- Ensures that one implicit parameter name gets one unique
    }
 
-type OrigNameCache   = FiniteMap (ModuleName,OccName) Name
-type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name)
-\end{code}
-
-@ImportedModuleInfo@ contains info ONLY about modules that have not yet 
-been loaded into the iPIT.  These modules are mentioned in interfaces we've
-already read, so we know a tiny bit about them, but we havn't yet looked
-at the interface file for the module itself.  It needs to persist across 
-invocations of the renamer, at least from Rename.checkOldIface to Rename.renameSource.
-And there's no harm in it persisting across multiple compilations.
+type OrigNameCache = ModuleEnv (Module, OccNameCache)
+       -- Maps a module *name* to a Module, 
+       -- plus the OccNameEnv fot that module
+type OccNameCache = FiniteMap OccName Name
+       -- Maps the OccName to a Name
+       -- A FiniteMap because OccNames have a Namespace/Faststring pair
 
-\begin{code}
-type ImportedModuleInfo 
-    = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface)
+type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name)
 \end{code}
 
 A DeclsMap contains a binding for each Name in the declaration
@@ -859,18 +876,24 @@ emptyGlobalRdrEnv = emptyRdrEnv
 
 data GlobalRdrElt 
   = GRE { gre_name   :: Name,
-         gre_parent :: Name,   -- Name of the "parent" structure
-                               --      * the tycon of a data con
-                               --      * the class of a class op
-                               -- For others it's just the same as gre_name
-         gre_prov   :: Provenance,             -- Why it's in scope
-         gre_deprec :: Maybe DeprecTxt         -- Whether this name is deprecated
+         gre_parent :: Maybe Name,     -- Name of the "parent" structure, for
+                                       --      * the tycon of a data con
+                                       --      * the class of a class op
+                                       -- For others it's Nothing
+               -- Invariant: gre_name g /= gre_parent g
+               --      when the latter is a Just
+
+         gre_prov   :: Provenance,     -- Why it's in scope
+         gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
     }
 
 instance Outputable GlobalRdrElt where
   ppr gre = ppr (gre_name gre) <+> 
-           parens (hsep [text "parent:" <+> ppr (gre_parent gre) <> comma,
-                         pprNameProvenance gre])
+           parens (pp_parent (gre_parent gre) <+> pprNameProvenance gre)
+         where
+           pp_parent (Just p) = text "parent:" <+> ppr p <> comma
+           pp_parent Nothing  = empty
+
 pprGlobalRdrEnv env
   = vcat (map pp (rdrEnvToList env))
   where
@@ -974,6 +997,6 @@ pprNameProvenance (GRE {gre_name = name, gre_prov = prov})
 ppr_reason ImplicitImport        = ptext SLIT("implicitly imported")
 ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc
 
-ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("at") <+> ppr loc)
+ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
             | otherwise        = empty
 \end{code}