[project @ 2004-11-26 16:19:45 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index b35e096..3ce9eb9 100644 (file)
@@ -6,23 +6,22 @@
 \begin{code}
 module HscTypes ( 
        HscEnv(..), hscEPS,
-       GhciMode(..),
+       GhciMode(..), isOneShot,
 
        ModDetails(..), 
        ModGuts(..), ModImports(..), ForeignStubs(..),
 
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
 
-       ExternalPackageState(..),  
+       ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
-       lookupIface, lookupIfaceByModName, moduleNameToModule,
-       emptyModIface,
+       lookupIface, lookupIfaceByModule, emptyModIface,
 
        InteractiveContext(..), emptyInteractiveContext, 
        icPrintUnqual, unQualInScope,
 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
-                     emptyIfaceDepCache, 
+       IfacePackage(..), emptyIfaceDepCache, 
 
        Deprecs(..), IfaceDeprecs,
 
@@ -32,14 +31,13 @@ module HscTypes (
 
        TyThing(..), tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
        TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
-       extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
+       extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
        typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
 
        WhetherHasOrphans, IsBootInterface, Usage(..), 
        Dependencies(..), noDependencies,
-       Pool(..), emptyPool, DeclPool, InstPool, 
-       Gated,
-       RulePool, RulePoolContents, addRuleToPool, 
+       InstPool, Gated, addInstsToPool, 
+       RulePool, addRulesToPool, 
        NameCache(..), OrigNameCache, OrigIParamCache,
        Avails, availsToNameSet, availName, availNames,
        GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
@@ -64,12 +62,12 @@ import ByteCodeAsm  ( CompiledByteCode )
 
 import RdrName         ( GlobalRdrEnv, emptyGlobalRdrEnv,
                          LocalRdrEnv, emptyLocalRdrEnv,
-                         GlobalRdrElt(..), unQualOK )
+                         GlobalRdrElt(..), mkRdrUnqual, lookupGRE_RdrName )
 import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
 import NameEnv
 import NameSet 
 import OccName         ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, 
-                         extendOccEnv, foldOccEnv )
+                         extendOccEnv )
 import Module
 import InstEnv         ( InstEnv, DFunId )
 import Rules           ( RuleBase )
@@ -78,9 +76,9 @@ import Id             ( Id )
 import Type            ( TyThing(..) )
 
 import Class           ( Class, classSelIds, classTyCon )
-import TyCon           ( TyCon, isClassTyCon, tyConSelIds, tyConDataCons )
+import TyCon           ( TyCon, tyConSelIds, tyConDataCons )
 import DataCon         ( dataConImplicitIds )
-import Packages                ( PackageName )
+import Packages                ( PackageId )
 import CmdLineOpts     ( DynFlags )
 
 import BasicTypes      ( Version, initialVersion, IPName, 
@@ -90,7 +88,6 @@ import IfaceSyn               ( IfaceInst, IfaceRule, IfaceDecl(ifName) )
 
 import FiniteMap       ( FiniteMap )
 import CoreSyn         ( IdCoreRule )
-import PrelNames       ( isBuiltInSyntaxName )
 import Maybes          ( orElse )
 import Outputable
 import SrcLoc          ( SrcSpan )
@@ -122,10 +119,13 @@ data HscEnv
                -- are compiling right now.
                -- (In one-shot mode the current module is the only
                --  home-package module, so hsc_HPT is empty.  All other
-               --  modules count as "external-package" modules.)
+               --  modules count as "external-package" modules.
+               --  However, even in GHCi mode, hi-boot interfaces are
+               --  demand-loadeded into the external-package table.)
+               --
                -- hsc_HPT is not mutable because we only demand-load 
                -- external packages; the home package is eagerly 
-               -- loaded by the compilation manager.
+               -- loaded, module by module, by the compilation manager.
        
                -- The next two are side-effected by compiling
                -- to reflect sucking in interface files
@@ -139,8 +139,15 @@ hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
 The GhciMode is self-explanatory:
 
 \begin{code}
-data GhciMode = Batch | Interactive | OneShot 
+data GhciMode = Batch          -- ghc --make Main
+             | Interactive     -- ghc --interactive
+             | OneShot         -- ghc Foo.hs
+             | IDE             -- Visual Studio etc
              deriving Eq
+
+isOneShot :: GhciMode -> Bool
+isOneShot OneShot = True
+isOneShot _other  = False
 \end{code}
 
 \begin{code}
@@ -168,24 +175,14 @@ lookupIface hpt pit mod
        Just mod_info -> Just (hm_iface mod_info)
        Nothing       -> lookupModuleEnv pit mod
 
-lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
+lookupIfaceByModule :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
 -- We often have two IfaceTables, and want to do a lookup
-lookupIfaceByModName hpt pit mod
-  = case lookupModuleEnvByName hpt mod of
+lookupIfaceByModule hpt pit mod
+  = case lookupModuleEnv hpt mod of
        Just mod_info -> Just (hm_iface mod_info)
-       Nothing       -> lookupModuleEnvByName pit mod
-\end{code}
-
-\begin{code}
--- Use instead of Finder.findModule if possible: this way doesn't
--- require filesystem operations, and it is guaranteed not to fail
--- when the IfaceTables are properly populated (i.e. after the renamer).
-moduleNameToModule :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Module
-moduleNameToModule hpt pit mod 
-   = mi_module (fromJust (lookupIfaceByModName hpt pit mod))
+       Nothing       -> lookupModuleEnv pit mod
 \end{code}
 
-
 %************************************************************************
 %*                                                                     *
 \subsection{Symbol tables and Module details}
@@ -204,7 +201,7 @@ the declarations into a single indexed map in the @PersistentRenamerState@.
 \begin{code}
 data ModIface 
    = ModIface {
-       mi_package  :: !PackageName,        -- Which package the module comes from
+       mi_package  :: !IfacePackage,       -- Which package the module comes from
         mi_module   :: !Module,
         mi_mod_vers :: !Version,           -- Module version: changes when anything changes
 
@@ -232,7 +229,7 @@ data ModIface
                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Deprecations
-       mi_deprecs  :: Deprecs [(OccName,DeprecTxt)],
+       mi_deprecs  :: IfaceDeprecs,
                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Type, class and variable declarations
@@ -258,6 +255,8 @@ data ModIface
                        -- seeing if we are up to date wrt the old interface
      }
 
+data IfacePackage = ThisPackage | ExternalPackage PackageId
+
 -- Should be able to construct ModDetails from mi_decls in ModIface
 data ModDetails
    = ModDetails {
@@ -340,10 +339,10 @@ data ForeignStubs = NoStubs
 \end{code}
 
 \begin{code}
-emptyModIface :: PackageName -> ModuleName -> ModIface
+emptyModIface :: IfacePackage -> Module -> ModIface
 emptyModIface pkg mod
   = ModIface { mi_package  = pkg,
-              mi_module   = mkModule pkg mod,
+              mi_module   = mod,
               mi_mod_vers = initialVersion,
               mi_orphan   = False,
               mi_boot     = False,
@@ -405,22 +404,16 @@ the @Name@'s provenance to guide whether or not to print the name qualified
 in error messages.
 
 \begin{code}
-unQualInScope :: GlobalRdrEnv -> Name -> Bool
+unQualInScope :: GlobalRdrEnv -> PrintUnqualified
 -- 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')
 --
--- Also checks for built-in syntax, which is always 'in scope'
---
--- This fn is only efficient if the shared 
--- partial application is used a lot.
-unQualInScope env
-  = \n -> n `elemNameSet` unqual_names || isBuiltInSyntaxName n
-  where
-    unqual_names :: NameSet
-    unqual_names = foldOccEnv add emptyNameSet env
-    add [gre] unquals | unQualOK gre = addOneToNameSet unquals (gre_name gre)
-    add _     unquals               = unquals
+-- [Out of date] Also checks for built-in syntax, which is always 'in scope'
+unQualInScope env mod occ
+  = case lookupGRE_RdrName (mkRdrUnqual occ) env of
+       [gre] -> nameModule (gre_name gre) == mod
+       other -> False
 \end{code}
 
 
@@ -484,12 +477,12 @@ mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
                
 lookupTypeEnv = lookupNameEnv
 
-extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
 -- Extend the type environment
-extendTypeEnvList env things
-  = foldl extend env things
-  where
-    extend env thing = extendNameEnv env (getName thing) thing
+extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
+extendTypeEnv env thing = extendNameEnv env (getName thing) thing 
+
+extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
+extendTypeEnvList env things = foldl extendTypeEnv env things
 \end{code}
 
 \begin{code}
@@ -583,7 +576,7 @@ data GenAvailInfo name      = Avail name     -- An ordinary identifier
                        deriving( Eq )
                        -- Equality used when deciding if the interface has changed
 
-type IfaceExport = (ModuleName, [GenAvailInfo OccName])
+type IfaceExport = (Module, [GenAvailInfo OccName])
 
 availsToNameSet :: [AvailInfo] -> NameSet
 availsToNameSet avails = foldl add emptyNameSet avails
@@ -658,16 +651,19 @@ type IsBootInterface = Bool
 -- in the import hierarchy.  See TcRnTypes.ImportAvails for details.
 --
 -- Invariant: the dependencies of a module M never includes M
+-- Invariant: the lists are unordered, with no duplicates
 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)
+  = Deps { dep_mods  :: [(Module,IsBootInterface)],    -- Home-package module dependencies
+          dep_pkgs  :: [PackageId],                    -- External package dependencies
+          dep_orphs :: [Module] }                      -- Orphan modules (whether home or external pkg)
+  deriving( Eq )
+       -- Equality used only for old/new comparison in MkIface.addVersionInfo
 
 noDependencies :: Dependencies
 noDependencies = Deps [] [] []
          
 data Usage
-  = Usage { usg_name     :: ModuleName,                        -- Name of the module
+  = Usage { usg_name     :: Module,                    -- Name of the module
            usg_mod      :: Version,                    -- Module version
            usg_entities :: [(OccName,Version)],        -- Sorted by occurrence name
            usg_exports  :: Maybe Version,              -- Export-list version, if we depend on it
@@ -700,6 +696,17 @@ type PackageInstEnv  = InstEnv
 
 data ExternalPackageState
   = EPS {
+       eps_is_boot :: !(ModuleEnv (Module, IsBootInterface)),
+               -- In OneShot mode (only), home-package modules accumulate in the
+               -- external package state, and are sucked in lazily.
+               -- For these home-pkg modules (only) we need to record which are
+               -- boot modules.  We set this field after loading all the 
+               -- explicitly-imported interfaces, but before doing anything else
+               --
+               -- The Module part is not necessary, but it's useful for
+               -- debug prints, and it's convenient because this field comes
+               -- direct from TcRnTypes.ImportAvails.imp_dep_mods
+
        eps_PIT :: !PackageIfaceTable,
                -- The ModuleIFaces for modules in external packages
                -- whose interfaces we have opened
@@ -722,19 +729,24 @@ data ExternalPackageState
 
        -- Holding pens for stuff that has been read in from file,
        -- but not yet slurped into the renamer
-       eps_decls :: !DeclPool,
-               -- A single, global map of Names to unslurped decls
-               -- Decls move from here to eps_PTE
-
        eps_insts :: !InstPool,
                -- The as-yet un-slurped instance decls
                -- Decls move from here to eps_inst_env
                -- Each instance is 'gated' by the names that must be 
                -- available before this instance decl is needed.
 
-       eps_rules :: !RulePool
+       eps_rules :: !RulePool,
                -- The as-yet un-slurped rules
+
+       eps_stats :: !EpsStats
   }
+
+-- "In" means read from iface files
+-- "Out" means actually sucked in and type-checked
+data EpsStats = EpsStats { n_ifaces_in
+                        , n_decls_in, n_decls_out 
+                        , n_rules_in, n_rules_out
+                        , n_insts_in, n_insts_out :: !Int }
 \end{code}
 
 The NameCache makes sure that there is just one Unique assigned for
@@ -764,41 +776,44 @@ type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
 \end{code}
 
 \begin{code}
-data Pool p = Pool p           -- The pool itself
-                  Int          -- Number of decls slurped into the map
-                  Int          -- Number of decls slurped out of the map
+type Gated d = ([Name], (Module, d))   -- The [Name] 'gate' the declaration; always non-empty
+                                               -- Module records which iface file this
+                                               -- decl came from
 
-emptyPool p = Pool p 0 0
+type RulePool = [Gated IfaceRule]
 
-instance Outputable p => Outputable (Pool p) where
-  ppr (Pool p n_in n_out)      -- Debug printing only
-       = vcat [ptext SLIT("Pool") <+> int n_in <+> int n_out,
-               nest 2 (ppr p)]
-  
-type DeclPool = Pool (NameEnv IfaceDecl)       -- Keyed by the "main thing" of the decl
+addRulesToPool :: RulePool
+             -> [Gated IfaceRule]
+             -> RulePool
+addRulesToPool rules new_rules = new_rules ++ rules
 
 -------------------------
-type Gated d = ([Name], (ModuleName, d))       -- The [Name] 'gate' the declaration
-                                               -- ModuleName records which iface file this
-                                               -- decl came from
-
-type RulePool = Pool RulePoolContents
-type RulePoolContents = [Gated IfaceRule]
-
-addRuleToPool :: RulePoolContents
-             -> (ModuleName, IfaceRule)
-             -> [Name]         -- Free vars of rule; always non-empty
-             -> RulePoolContents
-addRuleToPool rules rule fvs = (fvs,rule) : rules
+addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
+-- Add stats for one newly-read interface
+addEpsInStats stats n_decls n_insts n_rules
+  = stats { n_ifaces_in = n_ifaces_in stats + 1
+         , n_decls_in  = n_decls_in stats + n_decls
+         , n_insts_in  = n_insts_in stats + n_insts
+         , n_rules_in  = n_rules_in stats + n_rules }
 
 -------------------------
-type InstPool = Pool (NameEnv [Gated IfaceInst])
+type InstPool = NameEnv [Gated IfaceInst]
        -- The key of the Pool is the Class
        -- The Names are the TyCons in the instance head
        -- For example, suppose this is in an interface file
        --      instance C T where ...
        -- We want to slurp this decl if both C and T are "visible" in 
        -- the importing module.  See "The gating story" in RnIfaces for details.
+
+
+addInstsToPool :: InstPool -> [(Name, Gated IfaceInst)] -> InstPool
+addInstsToPool insts new_insts
+  = foldr add insts new_insts
+  where
+    add :: (Name, Gated IfaceInst) -> NameEnv [Gated IfaceInst] -> NameEnv [Gated IfaceInst]
+    add (cls,new_inst) insts = extendNameEnv_C combine insts cls [new_inst]
+       where
+         combine old_insts _ = new_inst : old_insts
 \end{code}
 
 
@@ -816,7 +831,7 @@ data Linkable = LM {
   linkableTime     :: ClockTime,       -- Time at which this linkable was built
                                        -- (i.e. when the bytecodes were produced,
                                        --       or the mod date on the files)
-  linkableModName  :: ModuleName,      -- Should be Module, but see below
+  linkableModule   :: Module,          -- Should be Module, but see below
   linkableUnlinked :: [Unlinked]
  }