Use MD5 checksums for recompilation checking (fixes #1372, #1959)
[ghc-hetmet.git] / compiler / main / HscTypes.lhs
index abebd14..bba10e4 100644 (file)
@@ -13,7 +13,8 @@ module HscTypes (
        ModuleGraph, emptyMG,
 
        ModDetails(..), emptyModDetails,
-       ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..),
+       ModGuts(..), CoreModule(..), CgGuts(..), ModImports(..), ForeignStubs(..),
+        ImportedMods,
 
        ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
        msHsFilePath, msHiFilePath, msObjFilePath, 
@@ -31,7 +32,7 @@ module HscTypes (
        icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
         substInteractiveContext,
 
-       ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
+       ModIface(..), mkIfaceDepCache, mkIfaceHashCache, mkIfaceFixCache,
        emptyIfaceDepCache,
 
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
@@ -95,29 +96,31 @@ import Type
 
 import Class           ( Class, classSelIds, classATs, classTyCon )
 import TyCon
-import DataCon         ( DataCon, dataConImplicitIds )
+import DataCon         ( DataCon, dataConImplicitIds, dataConWrapId )
 import PrelNames       ( gHC_PRIM )
 import Packages hiding ( Version(..) )
 import DynFlags                ( DynFlags(..), isOneShot, HscTarget (..) )
 import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString, Phase )
-import BasicTypes      ( Version, initialVersion, IPName, 
-                         Fixity, defaultFixity, DeprecTxt )
+import BasicTypes      ( IPName, Fixity, defaultFixity, DeprecTxt )
 import IfaceSyn
 import FiniteMap       ( FiniteMap )
 import CoreSyn         ( CoreRule )
-import Maybes          ( orElse, expectJust, catMaybes, seqMaybe )
+import Maybes          ( orElse, expectJust, catMaybes )
 import Outputable
 import BreakArray
 import SrcLoc          ( SrcSpan, Located )
-import UniqFM          ( lookupUFM, eltsUFM, emptyUFM )
+import LazyUniqFM              ( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply      ( UniqSupply )
-import FastString      ( FastString )
+import FastString
 import StringBuffer    ( StringBuffer )
+import Fingerprint
 
+import System.FilePath
 import System.Time     ( ClockTime )
 import Data.IORef
 import Data.Array       ( Array, array )
 import Data.List
+import Control.Monad    ( mplus )
 \end{code}
 
 
@@ -275,7 +278,7 @@ lookupIfaceByModule dflags hpt pit mod
        -- in the HPT.  If it's not from the home package it's wrong to look
        -- in the HPT, because the HPT is indexed by *ModuleName* not Module
     fmap hm_iface (lookupUFM hpt (moduleName mod)) 
-    `seqMaybe` lookupModuleEnv pit mod
+    `mplus` lookupModuleEnv pit mod
 
   | otherwise = lookupModuleEnv pit mod                -- Look in PIT only 
 
@@ -283,7 +286,7 @@ lookupIfaceByModule dflags hpt pit mod
 -- (a) In OneShot mode, even home-package modules accumulate in the PIT
 -- (b) Even in Batch (--make) mode, there is *one* case where a home-package
 --     module is in the PIT, namely GHC.Prim when compiling the base package.
--- We could eliminate (b) if we wanted, by making GHC.Prim belong to a packake
+-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
 -- of its own, but it doesn't seem worth the bother.
 \end{code}
 
@@ -327,8 +330,8 @@ hptRules hsc_env deps
     , let rules = case lookupUFM hpt mod of
                    Just info -> md_rules (hm_details info)
                    Nothing -> pprTrace "WARNING in hptRules" msg [] 
-         msg = vcat [ptext SLIT("missing module") <+> ppr mod,
-                     ptext SLIT("Probable cause: out-of-date interface files")]
+         msg = vcat [ptext (sLit "missing module") <+> ppr mod,
+                     ptext (sLit "Probable cause: out-of-date interface files")]
                        -- This really shouldn't happen, but see Trac #962
 
        -- And get its dfuns
@@ -405,7 +408,8 @@ the declarations into a single indexed map in the @PersistentRenamerState@.
 data ModIface 
    = ModIface {
         mi_module   :: !Module,
-        mi_mod_vers :: !Version,           -- Module version: changes when anything changes
+        mi_iface_hash :: !Fingerprint,      -- Hash of the whole interface
+        mi_mod_hash :: !Fingerprint,       -- Hash of the ABI only
 
         mi_orphan   :: !WhetherHasOrphans,  -- Whether this module has orphans
         mi_finsts   :: !WhetherHasFamInst,  -- Whether module has family insts
@@ -417,7 +421,7 @@ data ModIface
 
                -- 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)
+               -- doesn't affect the hash of this module)
         mi_usages   :: [Usage],
                -- NOT STRICT!  we read this field lazily from the interface file
                -- It is *only* consulted by the recompilation checker
@@ -425,7 +429,7 @@ data ModIface
                -- Exports
                -- Kept sorted by (mod,occ), to make version comparisons easier
         mi_exports  :: ![IfaceExport],
-        mi_exp_vers :: !Version,       -- Version number of export list
+        mi_exp_hash :: !Fingerprint,   -- Hash of export list
 
                -- Fixities
         mi_fixities :: [(OccName,Fixity)],
@@ -436,11 +440,11 @@ data ModIface
                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Type, class and variable declarations
-               -- The version of an Id changes if its fixity or deprecations change
+               -- The hash of an Id changes if its fixity or deprecations change
                --      (as well as its type of course)
                -- Ditto data constructors, class operations, except that 
-               -- the version of the parent class/tycon changes
-       mi_decls :: [(Version,IfaceDecl)],      -- Sorted
+               -- the hash of the parent class/tycon changes
+       mi_decls :: [(Fingerprint,IfaceDecl)],  -- Sorted
 
         mi_globals  :: !(Maybe GlobalRdrEnv),
                -- Binds all the things defined at the top level in
@@ -461,7 +465,7 @@ data ModIface
        mi_insts     :: [IfaceInst],                    -- Sorted
        mi_fam_insts :: [IfaceFamInst],                 -- Sorted
        mi_rules     :: [IfaceRule],                    -- Sorted
-       mi_rule_vers :: !Version,       -- Version number for rules and 
+       mi_orphan_hash :: !Fingerprint, -- Hash for orphan rules and 
                                        -- instances (for classes and families)
                                        -- combined
 
@@ -473,9 +477,9 @@ data ModIface
                -- and are not put into the interface file
        mi_dep_fn  :: Name -> Maybe DeprecTxt,  -- Cached lookup for mi_deprecs
        mi_fix_fn  :: OccName -> Fixity,        -- Cached lookup for mi_fixities
-       mi_ver_fn  :: OccName -> Maybe (OccName, Version),
+       mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
                         -- Cached lookup for mi_decls
-                       -- The Nothing in mi_ver_fn means that the thing
+                       -- The Nothing in mi_hash_fn means that the thing
                        -- isn't in decls. It's useful to know that when
                        -- seeing if we are up to date wrt the old interface
                         -- The 'OccName' is the parent of the name, if it has one.
@@ -509,6 +513,8 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
 -- being compiled right now.  Once it is compiled, a ModIface and 
 -- ModDetails are extracted and the ModGuts is dicarded.
 
+type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan)]
+
 data ModGuts
   = ModGuts {
         mg_module    :: !Module,
@@ -516,9 +522,9 @@ data ModGuts
        mg_exports   :: ![AvailInfo],    -- What it exports
        mg_deps      :: !Dependencies,   -- What is below it, directly or
                                         --   otherwise 
-       mg_dir_imps  :: ![Module],       -- Directly-imported modules; used to
+       mg_dir_imps  :: !ImportedMods,   -- Directly-imported modules; used to
                                         --     generate initialisation code
-       mg_usages    :: ![Usage],        -- Version info for what it needed
+       mg_used_names:: !NameSet,        -- What it needed (used in mkIface)
 
         mg_rdr_env   :: !GlobalRdrEnv,  -- Top-level lexical environment
 
@@ -548,6 +554,24 @@ data ModGuts
                                         -- this one); c.f. tcg_fam_inst_env
     }
 
+-- A CoreModule consists of just the fields of a ModGuts that are needed for
+-- the compileToCoreModule interface.
+data CoreModule
+  = CoreModule {
+      -- Module name
+      cm_module   :: !Module,
+      -- Type environment for types declared in this module
+      cm_types    :: !TypeEnv,
+      -- Declarations
+      cm_binds    :: [CoreBind],
+      -- Imports
+      cm_imports  :: ![Module]
+    }
+
+instance Outputable CoreModule where
+   ppr (CoreModule {cm_module = mn, cm_types = te, cm_binds = cb}) =
+      text "%module" <+> ppr mn <+> ppr te $$ vcat (map ppr cb)
+
 -- The ModGuts takes on several slightly different forms:
 --
 -- After simplification, the following fields change slightly:
@@ -606,23 +630,21 @@ data ForeignStubs = NoStubs
                                        --      "foreign exported" functions
                        SDoc            -- C stubs to use when calling
                                         --     "foreign exported" functions
-                       [FastString]    -- Headers that need to be included
-                                       --      into C code generated for this module
-
 \end{code}
 
 \begin{code}
 emptyModIface :: Module -> ModIface
 emptyModIface mod
   = ModIface { mi_module   = mod,
-              mi_mod_vers = initialVersion,
+              mi_iface_hash = fingerprint0,
+              mi_mod_hash = fingerprint0,
               mi_orphan   = False,
               mi_finsts   = False,
               mi_boot     = False,
               mi_deps     = noDependencies,
               mi_usages   = [],
               mi_exports  = [],
-              mi_exp_vers = initialVersion,
+              mi_exp_hash = fingerprint0,
               mi_fixities = [],
               mi_deprecs  = NoDeprecs,
               mi_insts     = [],
@@ -630,12 +652,12 @@ emptyModIface mod
               mi_rules     = [],
               mi_decls     = [],
               mi_globals   = Nothing,
-              mi_rule_vers = initialVersion,
+              mi_orphan_hash = fingerprint0,
                mi_vect_info = noIfaceVectInfo,
-              mi_dep_fn = emptyIfaceDepCache,
-              mi_fix_fn = emptyIfaceFixCache,
-              mi_ver_fn = emptyIfaceVerCache,
-              mi_hpc    = False
+              mi_dep_fn    = emptyIfaceDepCache,
+              mi_fix_fn    = emptyIfaceFixCache,
+              mi_hash_fn   = emptyIfaceHashCache,
+              mi_hpc       = False
     }          
 \end{code}
 
@@ -940,23 +962,15 @@ tyThingDataCon (ADataCon dc) = dc
 tyThingDataCon other        = pprPanic "tyThingDataCon" (pprTyThing other)
 
 tyThingId :: TyThing -> Id
-tyThingId (AnId id) = id
-tyThingId other     = pprPanic "tyThingId" (pprTyThing other)
+tyThingId (AnId id)     = id
+tyThingId (ADataCon dc) = dataConWrapId dc
+tyThingId other         = pprPanic "tyThingId" (pprTyThing other)
 \end{code}
 
-%************************************************************************
-%*                                                                     *
-\subsection{Auxiliary types}
-%*                                                                     *
-%************************************************************************
-
-These types are defined here because they are mentioned in ModDetails,
-but they are mostly elaborated elsewhere
-
 \begin{code}
-mkIfaceVerCache :: [(Version,IfaceDecl)]
-                -> (OccName -> Maybe (OccName, Version))
-mkIfaceVerCache pairs 
+mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
+                 -> (OccName -> Maybe (OccName, Fingerprint))
+mkIfaceHashCache pairs 
   = \occ -> lookupOccEnv env occ
   where
     env = foldr add_decl emptyOccEnv pairs
@@ -966,9 +980,20 @@ mkIfaceVerCache pairs
           env1 = extendOccEnv env0 decl_name (decl_name, v)
           add_imp bndr env = extendOccEnv env bndr (decl_name, v)
 
-emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)
-emptyIfaceVerCache _occ = Nothing
+emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
+emptyIfaceHashCache _occ = Nothing
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Auxiliary types}
+%*                                                                     *
+%************************************************************************
 
+These types are defined here because they are mentioned in ModDetails,
+but they are mostly elaborated elsewhere
+
+\begin{code}
 ------------------ Deprecations -------------------------
 data Deprecations
   = NoDeprecs
@@ -1125,26 +1150,29 @@ noDependencies :: Dependencies
 noDependencies = Deps [] [] [] []
          
 data Usage
-  = Usage { usg_name     :: ModuleName,                        -- Name of the module
-           usg_mod      :: Version,                    -- Module version
-           usg_entities :: [(OccName,Version)],        -- Sorted by occurrence name
-                -- NB. usages are for parent names only, eg. tycon but not constructors.
-           usg_exports  :: Maybe Version,              -- Export-list version, if we depend on it
-           usg_rules    :: Version                     -- Orphan-rules version (for non-orphan
-                                                       -- modules this will always be initialVersion)
-    }      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
-
+  = UsagePackageModule {
+        usg_mod      :: Module,
+        usg_mod_hash :: Fingerprint
+    }
+  | UsageHomeModule {
+        usg_mod_name :: ModuleName,            -- Name of the module
+       usg_mod_hash :: Fingerprint,            -- Module fingerprint
+                                                -- (optimisation only)
+       usg_entities :: [(OccName,Fingerprint)],
+               -- Sorted by occurrence name.
+            -- NB. usages are for parent names only, 
+            -- eg. tycon but not constructors.
+       usg_exports  :: Maybe Fingerprint
+            -- Export-list fingerprint, if we depend on it
+    }
+    deriving( Eq )
        -- The export list field is (Just v) if we depend on the export list:
        --      i.e. we imported the module directly, whether or not we
-       --           enumerated the things we imported, or just imported everything
+       --           enumerated the things we imported, or just imported 
+        --           everything
        -- We need to recompile if M's exports change, because 
-       -- if the import was    import M,       we might now have a name clash in the 
-       --                                      importing module.
+       -- if the import was    import M,       we might now have a name clash
+        --                                      in the importing module.
        -- if the import was    import M(x)     M might no longer export x
        -- The only way we don't depend on the export list is if we have
        --                      import M()
@@ -1189,7 +1217,7 @@ data ExternalPackageState
                -- (below), not in the mi_decls fields of the iPIT.  
                -- What _is_ in the iPIT is:
                --      * The Module 
-               --      * Version info
+               --      * Fingerprint info
                --      * Its exports
                --      * Fixities
                --      * Deprecations
@@ -1320,14 +1348,15 @@ instance Outputable ModSummary where
 
 showModMsg :: HscTarget -> Bool -> ModSummary -> String
 showModMsg target recomp mod_summary
-  = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
-                   char '(', text (msHsFilePath mod_summary) <> comma,
-                   case target of
-                      HscInterpreted | recomp 
-                                 -> text "interpreted"
-                      HscNothing -> text "nothing"
-                      _other     -> text (msObjFilePath mod_summary),
-                   char ')'])
+  = showSDoc $
+        hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
+              char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
+              case target of
+                  HscInterpreted | recomp 
+                             -> text "interpreted"
+                  HscNothing -> text "nothing"
+                  _          -> text (normalise $ msObjFilePath mod_summary),
+              char ')']
  where 
     mod     = moduleName (ms_mod mod_summary)
     mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
@@ -1462,7 +1491,9 @@ data Unlinked
    | BCOs CompiledByteCode ModBreaks
 
 #ifndef GHCI
-data CompiledByteCode
+data CompiledByteCode = CompiledByteCodeUndefined
+_unused :: CompiledByteCode
+_unused = CompiledByteCodeUndefined
 #endif
 
 instance Outputable Unlinked where