X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=41558079740a77ae315ba1dd6b0f132eecc26d51;hb=1df34b328128f4949ef812c8be952ab1f85df7ac;hp=8e064bc57e24830a924a40fe6e42af192601d641;hpb=5ad61e1470db6dbc8279569c5ad1cc093f753ac0;p=ghc-hetmet.git

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 8e064bc..4155807 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -51,18 +51,20 @@ module HscTypes (
 	GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
 	IfaceExport,
 
-	Deprecations, DeprecTxt, lookupDeprec, plusDeprecs,
+	Deprecations, DeprecTxt, plusDeprecs,
 
 	PackageInstEnv, PackageRuleBase,
 
 	-- Linker stuff
 	Linkable(..), isObjectLinkable,
 	Unlinked(..), CompiledByteCode,
-	isObject, nameOfObject, isInterpretable, byteCodeOfObject
+	isObject, nameOfObject, isInterpretable, byteCodeOfObject,
+        HpcInfo, noHpcInfo
     ) where
 
 #include "HsVersions.h"
 
+import Breakpoints      ( SiteNumber, Coord, noDbgSites )
 #ifdef GHCI
 import ByteCodeAsm	( CompiledByteCode )
 #endif
@@ -96,7 +98,7 @@ import BasicTypes	( Version, initialVersion, IPName,
 import IfaceSyn
 import FiniteMap	( FiniteMap )
 import CoreSyn		( CoreRule )
-import Maybes		( orElse, expectJust )
+import Maybes		( orElse, expectJust, catMaybes, seqMaybe )
 import Outputable
 import SrcLoc		( SrcSpan, Located )
 import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
@@ -104,7 +106,6 @@ import UniqSupply	( UniqSupply )
 import FastString	( FastString )
 
 import StringBuffer	( StringBuffer )
-import Maybes           ( catMaybes, seqMaybe )
 
 import System.Time	( ClockTime )
 import Data.IORef	( IORef, readIORef )
@@ -209,9 +210,15 @@ data TargetId
 pprTarget :: Target -> SDoc
 pprTarget (Target id _) = pprTargetId id
 
+instance Outputable Target where
+    ppr = pprTarget
+
 pprTargetId (TargetModule m) = ppr m
 pprTargetId (TargetFile f _) = text f
 
+instance Outputable TargetId where
+    ppr = pprTargetId
+
 type HomePackageTable  = ModuleNameEnv HomeModInfo
 	-- Domain = modules in the home package
 	-- "home" package name cached here for convenience
@@ -295,12 +302,15 @@ hptRules hsc_env deps
     , mod /= moduleName gHC_PRIM
 
 	-- Look it up in the HPT
-    , let mod_info = case lookupUFM hpt mod of
-		  	Nothing -> pprPanic "hptRules" (ppr mod <+> ppr deps)
-		  	Just x  -> x
+    , 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")]
+			-- This really shouldn't happen, but see Trac #962
 
 	-- And get its dfuns
-    , rule <- md_rules (hm_details mod_info) ]
+    , rule <- rules ]
 \end{code}
 
 %************************************************************************
@@ -440,19 +450,21 @@ data ModIface
 -- Should be able to construct ModDetails from mi_decls in ModIface
 data ModDetails
    = ModDetails {
-	-- The next three fields are created by the typechecker
-	md_exports  :: [AvailInfo],
-        md_types    :: !TypeEnv,
-        md_fam_insts :: ![FamInst],	-- Cached value extracted from md_types
-        md_insts    :: ![Instance],	-- Dfun-ids for the instances in this module
-        md_rules    :: ![CoreRule]	-- Domain may include Ids from other modules
+	-- The next two fields are created by the typechecker
+	md_exports   :: [AvailInfo],
+        md_types     :: !TypeEnv,
+        md_insts     :: ![Instance],	-- Dfun-ids for the instances in this module
+        md_fam_insts :: ![FamInst],
+        md_rules     :: ![CoreRule],	-- Domain may include Ids from other modules
+        md_dbg_sites     :: ![(SiteNumber, Coord)]     -- Breakpoint sites inserted by the renamer
      }
 
 emptyModDetails = ModDetails { md_types = emptyTypeEnv,
 			       md_exports = [],
 			       md_insts     = [],
 			       md_rules     = [],
-			       md_fam_insts = [] }
+			       md_fam_insts = [],
+                               md_dbg_sites = noDbgSites}
 
 -- 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
@@ -480,7 +492,9 @@ data ModGuts
 	mg_fam_insts :: ![FamInst],	 -- Instances 
         mg_rules     :: ![CoreRule],	 -- Rules from this module
 	mg_binds     :: ![CoreBind],	 -- Bindings for this module
-	mg_foreign   :: !ForeignStubs
+	mg_foreign   :: !ForeignStubs,
+	mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
+        mg_dbg_sites :: ![(SiteNumber, Coord)]     -- Bkpts inserted by the renamer
     }
 
 -- The ModGuts takes on several slightly different forms:
@@ -517,7 +531,8 @@ data CgGuts
 		-- initialisation code
 
 	cg_foreign  :: !ForeignStubs,	
-	cg_dep_pkgs :: ![PackageId]	-- Used to generate #includes for C code gen
+	cg_dep_pkgs :: ![PackageId],	-- Used to generate #includes for C code gen
+        cg_hpc_info :: !HpcInfo         -- info about coverage tick boxes
     }
 
 -----------------------------------
@@ -804,13 +819,6 @@ mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
 emptyIfaceDepCache :: Name -> Maybe DeprecTxt
 emptyIfaceDepCache n = Nothing
 
-lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt
-lookupDeprec NoDeprecs        name = Nothing
-lookupDeprec (DeprecAll  txt) name = Just txt
-lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of
-					    Just (_, txt) -> Just txt
-					    Nothing	  -> Nothing
-
 plusDeprecs :: Deprecations -> Deprecations -> Deprecations
 plusDeprecs d NoDeprecs = d
 plusDeprecs NoDeprecs d = d
@@ -1008,6 +1016,9 @@ data ExternalPackageState
 	eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv
 	eps_rule_base    :: !PackageRuleBase,  -- Ditto RuleEnv
 
+        eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family
+						       -- instances of each mod
+
 	eps_stats :: !EpsStats
   }
 
@@ -1136,6 +1147,19 @@ showModMsg target recomp mod_summary
 
 %************************************************************************
 %*									*
+\subsection{Hpc Support}
+%*									*
+%************************************************************************
+
+\begin{code}
+type HpcInfo = Int             -- just the number of ticks in a module
+
+noHpcInfo :: HpcInfo
+noHpcInfo = 0                  -- default = 0
+\end{code}
+
+%************************************************************************
+%*									*
 \subsection{Linkable stuff}
 %*									*
 %************************************************************************