[project @ 2005-01-27 10:44:00 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index 3ce9eb9..97df435 100644 (file)
@@ -11,7 +11,13 @@ 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,
@@ -21,7 +27,7 @@ module HscTypes (
        icPrintUnqual, unQualInScope,
 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
-       IfacePackage(..), emptyIfaceDepCache, 
+       emptyIfaceDepCache, 
 
        Deprecs(..), IfaceDeprecs,
 
@@ -78,9 +84,9 @@ import Type           ( TyThing(..) )
 import Class           ( Class, classSelIds, classTyCon )
 import TyCon           ( TyCon, tyConSelIds, tyConDataCons )
 import DataCon         ( dataConImplicitIds )
-import Packages                ( PackageId )
+import Packages                ( PackageIdH, PackageId )
 import CmdLineOpts     ( DynFlags )
-
+import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString )
 import BasicTypes      ( Version, initialVersion, IPName, 
                          Fixity, defaultFixity, DeprecTxt )
 
@@ -88,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}
 
@@ -126,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
@@ -183,6 +193,54 @@ lookupIfaceByModule hpt pit mod
        Nothing       -> lookupModuleEnv pit mod
 \end{code}
 
+
+\begin{code}
+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}
+
+
 %************************************************************************
 %*                                                                     *
 \subsection{Symbol tables and Module details}
@@ -201,7 +259,7 @@ the declarations into a single indexed map in the @PersistentRenamerState@.
 \begin{code}
 data ModIface 
    = ModIface {
-       mi_package  :: !IfacePackage,       -- 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
 
@@ -255,8 +313,6 @@ 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 {
@@ -274,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
@@ -339,7 +396,7 @@ data ForeignStubs = NoStubs
 \end{code}
 
 \begin{code}
-emptyModIface :: IfacePackage -> Module -> ModIface
+emptyModIface :: PackageIdH -> Module -> ModIface
 emptyModIface pkg mod
   = ModIface { mi_package  = pkg,
               mi_module   = mod,
@@ -776,9 +833,10 @@ type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
 \end{code}
 
 \begin{code}
-type Gated d = ([Name], (Module, d))   -- The [Name] 'gate' the declaration; always non-empty
-                                               -- Module 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]
 
@@ -819,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}
 %*                                                                     *
 %************************************************************************