[project @ 2005-01-27 10:44:00 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index 41d38de..97df435 100644 (file)
@@ -11,18 +11,23 @@ module HscTypes (
        ModDetails(..), 
        ModGuts(..), ModImports(..), ForeignStubs(..),
 
+       ModSummary(..), showModMsg,
+       msHsFilePath, msHiFilePath, msObjFilePath, 
+
+       HscSource(..), isHsBoot, hscSourceString,       -- Re-exported from DriverPhases
+       
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
+       hptInstances, hptRules,
 
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
-       lookupIface, lookupIfaceByModName, moduleNameToModule,
-       emptyModIface,
+       lookupIface, lookupIfaceByModule, emptyModIface,
 
        InteractiveContext(..), emptyInteractiveContext, 
        icPrintUnqual, unQualInScope,
 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
-                     emptyIfaceDepCache, 
+       emptyIfaceDepCache, 
 
        Deprecs(..), IfaceDeprecs,
 
@@ -64,7 +69,7 @@ import ByteCodeAsm    ( CompiledByteCode )
 import RdrName         ( GlobalRdrEnv, emptyGlobalRdrEnv,
                          LocalRdrEnv, emptyLocalRdrEnv,
                          GlobalRdrElt(..), mkRdrUnqual, lookupGRE_RdrName )
-import Name            ( Name, NamedThing, getName, nameOccName, nameModule, nameModuleName )
+import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
 import NameEnv
 import NameSet 
 import OccName         ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, 
@@ -79,9 +84,9 @@ import Type           ( TyThing(..) )
 import Class           ( Class, classSelIds, classTyCon )
 import TyCon           ( TyCon, tyConSelIds, tyConDataCons )
 import DataCon         ( dataConImplicitIds )
-import Packages                ( PackageName )
+import Packages                ( PackageIdH, PackageId )
 import CmdLineOpts     ( DynFlags )
-
+import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString )
 import BasicTypes      ( Version, initialVersion, IPName, 
                          Fixity, defaultFixity, DeprecTxt )
 
@@ -89,14 +94,14 @@ import IfaceSyn             ( IfaceInst, IfaceRule, IfaceDecl(ifName) )
 
 import FiniteMap       ( FiniteMap )
 import CoreSyn         ( IdCoreRule )
-import Maybes          ( orElse )
+import Maybes          ( orElse, fromJust, expectJust )
 import Outputable
 import SrcLoc          ( SrcSpan )
 import UniqSupply      ( UniqSupply )
-import Maybe           ( fromJust )
 import FastString      ( FastString )
 
 import DATA_IOREF      ( IORef, readIORef )
+import StringBuffer    ( StringBuffer )
 import Time            ( ClockTime )
 \end{code}
 
@@ -127,6 +132,10 @@ data HscEnv
                -- hsc_HPT is not mutable because we only demand-load 
                -- external packages; the home package is eagerly 
                -- loaded, module by module, by the compilation manager.
+               --      
+               -- The HPT may contain modules compiled earlier by --make
+               -- but not actually below the current module in the dependency
+               -- graph.  (This changes a previous invariant: changed Jan 05.)
        
                -- The next two are side-effected by compiling
                -- to reflect sucking in interface files
@@ -176,21 +185,59 @@ 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
+       Nothing       -> lookupModuleEnv 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))
+hptInstances :: HscEnv -> [(Module, IsBootInterface)] -> [DFunId]
+-- Find all the instance declarations that are in modules imported 
+-- by this one, directly or indirectly, and are in the Home Package Table
+-- This ensures that we don't see instances from modules --make compiled 
+-- before this one, but which are not below this one
+hptInstances hsc_env deps
+  | isOneShot (hsc_mode hsc_env) = []  -- In one-shot mode, the HPT is empty
+  | otherwise
+  = let 
+       hpt = hsc_HPT hsc_env
+    in
+    [ dfun 
+    |  -- Find each non-hi-boot module below me
+      (mod, False) <- deps
+
+       -- Look it up in the HPT
+    , let mod_info = ASSERT2( mod `elemModuleEnv` hpt, ppr mod $$ vcat (map ppr_hm (moduleEnvElts hpt)))
+                    fromJust (lookupModuleEnv hpt mod)
+
+       -- And get its dfuns
+    , dfun <- md_insts (hm_details mod_info) ]
+  where
+   ppr_hm hm = ppr (mi_module (hm_iface hm))
+
+hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [IdCoreRule]
+-- Get rules from modules "below" this one (in the dependency sense)
+-- C.f Inst.hptInstances
+hptRules hsc_env deps
+  | isOneShot (hsc_mode hsc_env) = []
+  | otherwise
+  = let 
+       hpt = hsc_HPT hsc_env
+    in
+    [ rule
+    |  -- Find each non-hi-boot module below me
+      (mod, False) <- deps
+
+       -- Look it up in the HPT
+    , let mod_info = ASSERT( mod `elemModuleEnv` hpt )
+                    fromJust (lookupModuleEnv hpt mod)
+
+       -- And get its dfuns
+    , rule <- md_rules (hm_details mod_info) ]
 \end{code}
 
 
@@ -212,7 +259,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  :: !PackageIdH,         -- Which package the module comes from
         mi_module   :: !Module,
         mi_mod_vers :: !Version,           -- Module version: changes when anything changes
 
@@ -283,6 +330,7 @@ data ModDetails
 data ModGuts
   = ModGuts {
         mg_module   :: !Module,
+       mg_boot     :: IsBootInterface, -- Whether it's an hs-boot module
        mg_exports  :: !NameSet,        -- What it exports
        mg_deps     :: !Dependencies,   -- What is below it, directly or otherwise
        mg_dir_imps :: ![Module],       -- Directly-imported modules; used to
@@ -348,10 +396,10 @@ data ForeignStubs = NoStubs
 \end{code}
 
 \begin{code}
-emptyModIface :: PackageName -> ModuleName -> ModIface
+emptyModIface :: PackageIdH -> 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,
@@ -421,7 +469,7 @@ unQualInScope :: GlobalRdrEnv -> PrintUnqualified
 -- [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] -> nameModuleName (gre_name gre) == mod
+       [gre] -> nameModule (gre_name gre) == mod
        other -> False
 \end{code}
 
@@ -585,7 +633,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
@@ -662,15 +710,17 @@ type IsBootInterface = Bool
 -- 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
@@ -703,14 +753,14 @@ type PackageInstEnv  = InstEnv
 
 data ExternalPackageState
   = EPS {
-       eps_is_boot :: !(ModuleEnv (ModuleName, IsBootInterface)),
+       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 ModuleName part is not necessary, but it's useful for
+               -- 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
 
@@ -783,9 +833,10 @@ type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
 \end{code}
 
 \begin{code}
-type Gated d = ([Name], (ModuleName, d))       -- The [Name] 'gate' the declaration; always non-empty
-                                               -- ModuleName records which iface file this
-                                               -- decl came from
+type Gated d = ([Name], (Module, SDoc, d))
+       -- The [Name] 'gate' the declaration; always non-empty
+       -- Module records which module this decl belongs to
+       -- SDoc records the pathname of the file, or similar err-ctxt info
 
 type RulePool = [Gated IfaceRule]
 
@@ -826,6 +877,72 @@ addInstsToPool insts new_insts
 
 %************************************************************************
 %*                                                                     *
+               The ModSummary type
+       A ModSummary is a node in the compilation manager's
+       dependency graph, and it's also passed to hscMain
+%*                                                                     *
+%************************************************************************
+
+The nodes of the module graph are
+       EITHER a regular Haskell source module
+       OR     a hi-boot source module
+
+\begin{code}
+data ModSummary
+   = ModSummary {
+        ms_mod       :: Module,                        -- Name of the module
+       ms_hsc_src   :: HscSource,              -- Source is Haskell, hs-boot, external core
+        ms_location  :: ModLocation,           -- Location
+        ms_hs_date   :: ClockTime,             -- Timestamp of summarised file
+        ms_srcimps   :: [Module],              -- Source imports
+        ms_imps      :: [Module],              -- Non-source imports
+        ms_hspp_file :: Maybe FilePath,                -- Filename of preprocessed source,
+                                               -- once we have preprocessed it.
+       ms_hspp_buf  :: Maybe StringBuffer      -- The actual preprocessed source, maybe.
+     }
+
+-- The ModLocation contains both the original source filename and the
+-- filename of the cleaned-up source file after all preprocessing has been
+-- done.  The point is that the summariser will have to cpp/unlit/whatever
+-- all files anyway, and there's no point in doing this twice -- just 
+-- park the result in a temp file, put the name of it in the location,
+-- and let @compile@ read from that file on the way back up.
+
+-- The ModLocation is stable over successive up-sweeps in GHCi, wheres
+-- the ms_hs_date and imports can, of course, change
+
+msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
+msHsFilePath  ms = expectJust "msHsFilePath" (ml_hs_file  (ms_location ms))
+msHiFilePath  ms = ml_hi_file  (ms_location ms)
+msObjFilePath ms = ml_obj_file (ms_location ms)
+
+
+instance Outputable ModSummary where
+   ppr ms
+      = sep [text "ModSummary {",
+             nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
+                          text "ms_mod =" <+> ppr (ms_mod ms) 
+                               <> text (hscSourceString (ms_hsc_src ms)) <> comma,
+                          text "ms_imps =" <+> ppr (ms_imps ms),
+                          text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
+             char '}'
+            ]
+
+showModMsg :: Bool -> ModSummary -> String
+showModMsg use_object mod_summary
+  = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
+                   char '(', text (msHsFilePath mod_summary) <> comma,
+                   if use_object then text (msObjFilePath mod_summary)
+                             else text "interpreted",
+                   char ')'])
+ where 
+    mod     = ms_mod mod_summary 
+    mod_str = moduleUserString mod ++ hscSourceString (ms_hsc_src mod_summary)
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
 \subsection{Linkable stuff}
 %*                                                                     *
 %************************************************************************
@@ -838,7 +955,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]
  }