fix for compiling the base package with --make
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index 9fecb09..00e1b49 100644 (file)
@@ -11,8 +11,8 @@ module HscTypes (
        Target(..), TargetId(..), pprTarget, pprTargetId,
        ModuleGraph, emptyMG,
 
-       ModDetails(..), 
-       ModGuts(..), ModImports(..), ForeignStubs(..),
+       ModDetails(..), emptyModDetails,
+       ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..),
 
        ModSummary(..), showModMsg, isBootSummary,
        msHsFilePath, msHiFilePath, msObjFilePath, 
@@ -45,8 +45,6 @@ module HscTypes (
 
        WhetherHasOrphans, IsBootInterface, Usage(..), 
        Dependencies(..), noDependencies,
-       InstPool, Gated, addInstsToPool, 
-       RulePool, addRulesToPool, 
        NameCache(..), OrigNameCache, OrigIParamCache,
        Avails, availsToNameSet, availName, availNames,
        GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
@@ -54,7 +52,6 @@ module HscTypes (
 
        Deprecations, DeprecTxt, lookupDeprec, plusDeprecs,
 
-       InstEnv, DFunId,
        PackageInstEnv, PackageRuleBase,
 
        -- Linker stuff
@@ -78,7 +75,7 @@ import NameSet
 import OccName         ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, 
                          extendOccEnv )
 import Module
-import InstEnv         ( InstEnv, DFunId )
+import InstEnv         ( InstEnv, Instance )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )
 import Id              ( Id )
@@ -87,19 +84,20 @@ import Type         ( TyThing(..) )
 import Class           ( Class, classSelIds, classTyCon )
 import TyCon           ( TyCon, tyConSelIds, tyConDataCons )
 import DataCon         ( dataConImplicitIds )
-import Packages                ( PackageIdH, PackageId, PackageConfig )
+import PrelNames       ( gHC_PRIM )
+import Packages                ( PackageIdH, PackageId, PackageConfig, HomeModules )
 import DynFlags                ( DynFlags(..), isOneShot )
-import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString )
+import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString, Phase )
 import BasicTypes      ( Version, initialVersion, IPName, 
                          Fixity, defaultFixity, DeprecTxt )
 
 import IfaceSyn                ( IfaceInst, IfaceRule, IfaceDecl(ifName) )
 
 import FiniteMap       ( FiniteMap )
-import CoreSyn         ( IdCoreRule )
-import Maybes          ( orElse, fromJust, expectJust )
+import CoreSyn         ( CoreRule )
+import Maybes          ( orElse, expectJust, expectJust )
 import Outputable
-import SrcLoc          ( SrcSpan )
+import SrcLoc          ( SrcSpan, Located )
 import UniqSupply      ( UniqSupply )
 import FastString      ( FastString )
 
@@ -188,18 +186,23 @@ hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
 -- module.  If so, use this instead of the file contents (this
 -- is for use in an IDE where the file hasn't been saved by
 -- the user yet).
-data Target = Target TargetId (Maybe StringBuffer)
+data Target = Target TargetId (Maybe (StringBuffer,ClockTime))
 
 data TargetId
-  = TargetModule Module           -- | A module name: search for the file
-  | TargetFile   FilePath  -- | A filename: parse it to find the module name.
-
+  = TargetModule Module
+       -- ^ A module name: search for the file
+  | TargetFile FilePath (Maybe Phase)
+       -- ^ A filename: preprocess & parse it to find the module name.
+       -- If specified, the Phase indicates how to compile this file
+       -- (which phase to start from).  Nothing indicates the starting phase
+       -- should be determined from the suffix of the filename.
+  deriving Eq
 
 pprTarget :: Target -> SDoc
 pprTarget (Target id _) = pprTargetId id
 
 pprTargetId (TargetModule m) = ppr m
-pprTargetId (TargetFile f)   = text f
+pprTargetId (TargetFile f _) = text f
 
 type FinderCache = ModuleEnv FinderCacheEntry
 type FinderCacheEntry = (ModLocation, Maybe (PackageConfig,Bool))
@@ -214,9 +217,19 @@ emptyHomePackageTable  = emptyModuleEnv
 emptyPackageIfaceTable = emptyModuleEnv
 
 data HomeModInfo 
-  = HomeModInfo { hm_iface    :: ModIface,
-                 hm_details  :: ModDetails,
-                 hm_linkable :: Linkable }
+  = HomeModInfo { hm_iface    :: !ModIface,
+                 hm_details  :: !ModDetails,
+                 hm_linkable :: !(Maybe Linkable) }
+               -- hm_linkable might be Nothing if:
+               --   a) this is an .hs-boot module
+               --   b) temporarily during compilation if we pruned away
+               --      the old linkable because it was out of date.
+               -- after a complete compilation (GHC.load), all hm_linkable
+               -- fields in the HPT will be Just.
+               --
+               -- When re-linking a module (hscNoRecomp), we construct
+               -- the HomModInfo by building a new ModDetails from the
+               -- old ModIface (only).
 \end{code}
 
 Simple lookups in the symbol table.
@@ -239,18 +252,18 @@ lookupIfaceByModule hpt pit mod
 
 
 \begin{code}
-hptInstances :: HscEnv -> (Module -> Bool) -> [DFunId]
+hptInstances :: HscEnv -> (Module -> Bool) -> [Instance]
 -- 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 want_this_module
-  = [ dfun 
+  = [ ispec 
     | mod_info <- moduleEnvElts (hsc_HPT hsc_env)
     , want_this_module (mi_module (hm_iface mod_info))
-    , dfun <- md_insts (hm_details mod_info) ]
+    , ispec <- md_insts (hm_details mod_info) ]
 
-hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [IdCoreRule]
+hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [CoreRule]
 -- Get rules from modules "below" this one (in the dependency sense)
 -- C.f Inst.hptInstances
 hptRules hsc_env deps
@@ -263,9 +276,17 @@ hptRules hsc_env deps
     |  -- Find each non-hi-boot module below me
       (mod, False) <- deps
 
+       -- unsavoury: when compiling the base package with --make, we
+       -- sometimes try to look up RULES for GHC.Prim.  GHC.Prim won't
+       -- be in the HPT, because we never compile it; it's in the EPT
+       -- instead.  ToDo: clean up, and remove this slightly bogus
+       -- filter:
+    , mod /= gHC_PRIM
+
        -- Look it up in the HPT
-    , let mod_info = ASSERT( mod `elemModuleEnv` hpt )
-                    fromJust (lookupModuleEnv hpt mod)
+    , let mod_info = case lookupModuleEnv hpt mod of
+                       Nothing -> pprPanic "hptRules" (ppr mod <+> ppr deps)
+                       Just x  -> x
 
        -- And get its dfuns
     , rule <- md_rules (hm_details mod_info) ]
@@ -329,9 +350,19 @@ data ModIface
        mi_decls :: [(Version,IfaceDecl)],      -- Sorted
 
         mi_globals  :: !(Maybe GlobalRdrEnv),
-               -- Its top level environment or Nothing if we read this
-               -- interface from an interface file.  (We need the source
-               -- file to figure out the top-level environment.)
+               -- Binds all the things defined at the top level in
+               -- the *original source* code for this module. which
+               -- is NOT the same as mi_exports, nor mi_decls (which
+               -- may contains declarations for things not actually
+               -- defined by the user).  Used for GHCi and for inspecting
+               -- the contents of modules via the GHC API only.
+               --
+               -- (We need the source file to figure out the
+               -- top-level environment, if we didn't compile this module
+               -- from source then this field contains Nothing).
+               --
+               -- Strictly speaking this field should live in the
+               -- HomeModInfo, but that leads to more plumbing.
 
                -- Instance declarations and rules
        mi_insts     :: [IfaceInst],    -- Sorted
@@ -353,11 +384,17 @@ data ModIface
 data ModDetails
    = ModDetails {
        -- The next three fields are created by the typechecker
+       md_exports  :: NameSet,
         md_types    :: !TypeEnv,
-        md_insts    :: ![DFunId],      -- Dfun-ids for the instances in this module
-        md_rules    :: ![IdCoreRule]   -- Domain may include Ids from other modules
+        md_insts    :: ![Instance],    -- Dfun-ids for the instances in this module
+        md_rules    :: ![CoreRule]     -- Domain may include Ids from other modules
      }
 
+emptyModDetails = ModDetails { md_types = emptyTypeEnv,
+                              md_exports = emptyNameSet,
+                              md_insts = [],
+                              md_rules = [] }
+
 -- 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 
@@ -369,6 +406,7 @@ data ModGuts
        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_home_mods :: !HomeModules,   -- For calling isHomeModule etc.
        mg_dir_imps :: ![Module],       -- Directly-imported modules; used to
                                        --      generate initialisation code
        mg_usages   :: ![Usage],        -- Version info for what it needed
@@ -378,8 +416,8 @@ data ModGuts
        mg_deprecs  :: !Deprecations,   -- Deprecations declared in the module
 
        mg_types    :: !TypeEnv,
-       mg_insts    :: ![DFunId],       -- Instances 
-        mg_rules    :: ![IdCoreRule],  -- Rules from this module
+       mg_insts    :: ![Instance],     -- Instances 
+        mg_rules    :: ![CoreRule],    -- Rules from this module
        mg_binds    :: ![CoreBind],     -- Bindings for this module
        mg_foreign  :: !ForeignStubs
     }
@@ -389,24 +427,40 @@ data ModGuts
 -- After simplification, the following fields change slightly:
 --     mg_rules        Orphan rules only (local ones now attached to binds)
 --     mg_binds        With rules attached
---
--- After CoreTidy, the following fields change slightly:
---     mg_types        Now contains Ids as well, replete with final IdInfo
---                        The Ids are only the ones that are visible from
---                        importing modules.  Without -O that means only
---                        exported Ids, but with -O importing modules may
---                        see ids mentioned in unfoldings of exported Ids
---
---     mg_insts        Same DFunIds as before, but with final IdInfo,
---                        and the unique might have changed; remember that
---                        CoreTidy links up the uniques of old and new versions
---
---     mg_rules        All rules for exported things, substituted with final Ids
---
---     mg_binds        Tidied
 
 
+---------------------------------------------------------
+-- The Tidy pass forks the information about this module: 
+--     * one lot goes to interface file generation (ModIface)
+--       and later compilations (ModDetails)
+--     * the other lot goes to code generation (CgGuts)
+data CgGuts 
+  = CgGuts {
+       cg_module   :: !Module,
+
+       cg_tycons   :: [TyCon],
+               -- Algebraic data types (including ones that started
+               -- life as classes); generate constructors and info
+               -- tables Includes newtypes, just for the benefit of
+               -- External Core
+
+       cg_binds    :: [CoreBind],
+               -- The tidied main bindings, including
+               -- previously-implicit bindings for record and class
+               -- selectors, and data construtor wrappers.  But *not*
+               -- data constructor workers; reason: we we regard them
+               -- as part of the code-gen of tycons
+
+       cg_dir_imps :: ![Module],
+               -- Directly-imported modules; used to generate
+               -- initialisation code
+
+       cg_foreign  :: !ForeignStubs,   
+       cg_home_mods :: !HomeModules,   -- for calling isHomeModule etc.
+       cg_dep_pkgs :: ![PackageId]     -- Used to generate #includes for C code gen
+    }
 
+-----------------------------------
 data ModImports
   = ModImports {
        imp_direct     :: ![(Module,Bool)],     -- Explicitly-imported modules
@@ -418,6 +472,7 @@ data ModImports
                                                --      directly or indirectly
     }
 
+-----------------------------------
 data ForeignStubs = NoStubs
                  | ForeignStubs
                        SDoc            -- Header file prototypes for
@@ -631,6 +686,11 @@ data Deprecs a
 
 type IfaceDeprecs = Deprecs [(OccName,DeprecTxt)]
 type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt))
+       -- Keep the OccName so we can flatten the NameEnv to
+       -- get an IfaceDeprecs from a Deprecations
+       -- Only an OccName is needed, because a deprecation always
+       -- applies to things defined in the module in which the
+       -- deprecation appears.
 
 mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
 mkIfaceDepCache NoDeprecs        = \n -> Nothing
@@ -771,9 +831,16 @@ data Usage
        -- 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:
-       --      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.
+       --      i.e. we imported the module directly, whether or not we
+       --           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(x)     M might no longer export x
+       -- The only way we don't depend on the export list is if we have
+       --                      import M()
+       -- And of course, for modules that aren't imported directly we don't
+       -- depend on their export lists
 \end{code}
 
 
@@ -805,7 +872,7 @@ data ExternalPackageState
                -- The ModuleIFaces for modules in external packages
                -- whose interfaces we have opened
                -- The declarations in these interface files are held in
-               -- eps_decls, eps_insts, eps_rules (below), not in the 
+               -- eps_decls, eps_inst_env, eps_rules (below), not in the 
                -- mi_decls fields of the iPIT.  
                -- What _is_ in the iPIT is:
                --      * The Module 
@@ -820,18 +887,6 @@ data ExternalPackageState
                                                --   all the external-package modules
        eps_rule_base :: !PackageRuleBase,      -- Ditto RuleEnv
 
-
-       -- Holding pens for stuff that has been read in from file,
-       -- but not yet slurped into the renamer
-       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,
-               -- The as-yet un-slurped rules
-
        eps_stats :: !EpsStats
   }
 
@@ -841,6 +896,14 @@ 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 }
+
+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 }
 \end{code}
 
 The NameCache makes sure that there is just one Unique assigned for
@@ -851,10 +914,6 @@ name, we might not be at its binding site (e.g. we are reading an
 interface file); so we give it 'noSrcLoc' then.  Later, when we find
 its binding site, we fix it up.
 
-Exactly the same is true of the Module stored in the Name.  When we first
-encounter the occurrence, we may not know the details of the module, so
-we just store junk.  Then when we find the binding site, we fix it up.
-
 \begin{code}
 data NameCache
  = NameCache {  nsUniqs :: UniqSupply,
@@ -869,47 +928,6 @@ type OrigNameCache   = ModuleEnv (OccEnv Name)
 type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
 \end{code}
 
-\begin{code}
-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]
-
-addRulesToPool :: RulePool
-             -> [Gated IfaceRule]
-             -> RulePool
-addRulesToPool rules new_rules = new_rules ++ 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 = 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}
 
 
 %************************************************************************
@@ -940,9 +958,10 @@ data 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_hs_date   :: ClockTime,             -- Timestamp of source file
+       ms_obj_date  :: Maybe ClockTime,        -- Timestamp of object, maybe
+        ms_srcimps   :: [Located Module],      -- Source imports
+        ms_imps      :: [Located 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.
@@ -986,7 +1005,7 @@ showModMsg use_object mod_summary
                    char ')'])
  where 
     mod     = ms_mod mod_summary 
-    mod_str = moduleUserString mod ++ hscSourceString (ms_hsc_src mod_summary)
+    mod_str = moduleString mod ++ hscSourceString (ms_hsc_src mod_summary)
 \end{code}
 
 
@@ -1009,7 +1028,12 @@ data Linkable = LM {
  }
 
 isObjectLinkable :: Linkable -> Bool
-isObjectLinkable l = all isObject (linkableUnlinked l)
+isObjectLinkable l = not (null unlinked) && all isObject unlinked
+  where unlinked = linkableUnlinked l
+       -- A linkable with no Unlinked's is treated as a BCO.  We can
+       -- generate a linkable with no Unlinked's as a result of
+       -- compiling a module in HscNothing mode, and this choice
+       -- happens to work well with checkStability in module GHC.
 
 instance Outputable Linkable where
    ppr (LM when_made mod unlinkeds)