X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=c7926e3c236362a76cad8a31b08d86764e6a2c48;hp=e6e8e4cba47fb4ba25837f3f5e8ad412f3c0c871;hb=cdce647711c0f46f5799b24de087622cb77e647f;hpb=78bfe2ad25ff34cefa14e7f11093923f5d1e940f

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index e6e8e4c..c7926e3 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -59,7 +59,10 @@ module HscTypes (
 	Linkable(..), isObjectLinkable,
 	Unlinked(..), CompiledByteCode,
 	isObject, nameOfObject, isInterpretable, byteCodeOfObject,
-        HpcInfo, noHpcInfo
+        HpcInfo, noHpcInfo,
+
+        -- Breakpoints
+        ModBreaks (..), emptyModBreaks
     ) where
 
 #include "HsVersions.h"
@@ -90,7 +93,7 @@ import TyCon
 import DataCon		( DataCon, dataConImplicitIds )
 import PrelNames	( gHC_PRIM )
 import Packages		( PackageId )
-import DynFlags		( DynFlags(..), isOneShot, HscTarget (..) )
+import DynFlags		( DynFlags(..), DynFlag(..), isOneShot, HscTarget (..) )
 import DriverPhases	( HscSource(..), isHsBoot, hscSourceString, Phase )
 import BasicTypes	( Version, initialVersion, IPName, 
 			  Fixity, defaultFixity, DeprecTxt )
@@ -99,6 +102,7 @@ import FiniteMap	( FiniteMap )
 import CoreSyn		( CoreRule )
 import Maybes		( orElse, expectJust, catMaybes, seqMaybe )
 import Outputable
+import BreakArray
 import SrcLoc		( SrcSpan, Located )
 import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply	( UniqSupply )
@@ -108,6 +112,7 @@ import StringBuffer	( StringBuffer )
 
 import System.Time	( ClockTime )
 import Data.IORef	( IORef, readIORef )
+import Data.Array       ( Array, array )
 \end{code}
 
 
@@ -209,9 +214,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
@@ -448,14 +459,16 @@ data ModDetails
         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_rules     :: ![CoreRule],	-- Domain may include Ids from other modules
+        md_modBreaks :: !ModBreaks  -- breakpoint information for this module 
      }
 
 emptyModDetails = ModDetails { md_types = emptyTypeEnv,
 			       md_exports = [],
 			       md_insts     = [],
 			       md_rules     = [],
-			       md_fam_insts = [] }
+			       md_fam_insts = [],
+                               md_modBreaks = emptyModBreaks } 
 
 -- 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
@@ -476,7 +489,10 @@ data ModGuts
         mg_rdr_env   :: !GlobalRdrEnv,	 -- Top-level lexical environment
 	mg_fix_env   :: !FixityEnv,	 -- Fixity env, for things declared in
 					 --   this module 
-	mg_deprecs   :: !Deprecations,	 -- Deprecations declared in the module
+
+	mg_fam_inst_env :: FamInstEnv,	 -- Type-family instance enviroment
+					 -- for *home-package* modules (including
+					 -- this one).  c.f. tcg_fam_inst_env
 
 	mg_types     :: !TypeEnv,
 	mg_insts     :: ![Instance],	 -- Instances 
@@ -484,7 +500,9 @@ data ModGuts
         mg_rules     :: ![CoreRule],	 -- Rules from this module
 	mg_binds     :: ![CoreBind],	 -- Bindings for this module
 	mg_foreign   :: !ForeignStubs,
-	mg_hpc_info  :: !HpcInfo         -- info about coverage tick boxes
+	mg_deprecs   :: !Deprecations,	 -- Deprecations declared in the module
+	mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
+        mg_modBreaks :: !ModBreaks
     }
 
 -- The ModGuts takes on several slightly different forms:
@@ -660,12 +678,14 @@ implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
 			       concatMap (extras_plus . ADataCon) 
 					 (tyConDataCons tc)
 		     
-	-- For classes, add the class TyCon too (and its extras)
-	-- and the class selector Ids and the associated types (they don't
-	-- have extras as these are only the family decls)
-implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++
-			       map ATyCon (classATs cl) ++
-			       extras_plus (ATyCon (classTyCon cl))
+	-- For classes, add the class selector Ids, and assoicated TyCons
+	-- and the class TyCon too (and its extras)
+implicitTyThings (AClass cl) 
+  = map AnId (classSelIds cl) ++
+    map ATyCon (classATs cl) ++
+	-- No extras_plus for the classATs, because they
+	-- are only the family decls; they have no implicit things
+    extras_plus (ATyCon (classTyCon cl))
 
 	-- For data cons add the worker and wrapper (if any)
 implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
@@ -1124,7 +1144,7 @@ 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
+                      HscInterpreted | recomp 
                                  -> text "interpreted"
                       HscNothing -> text "nothing"
                       _other     -> text (msObjFilePath mod_summary),
@@ -1216,5 +1236,25 @@ byteCodeOfObject (BCOs bc) = bc
 byteCodeOfObject other     = pprPanic "byteCodeOfObject" (ppr other)
 \end{code}
 
+%************************************************************************
+%*                                                                      *
+\subsection{Breakpoint Support}
+%*                                                                      *
+%************************************************************************
 
+\begin{code}
+-- all the information about the breakpoints for a given module
+data ModBreaks
+   = ModBreaks
+   { modBreaks_array :: BreakArray
+            -- the array of breakpoint flags indexed by tick number
+   , modBreaks_ticks :: !(Array Int SrcSpan)
+   }
 
+emptyModBreaks :: ModBreaks
+emptyModBreaks = ModBreaks
+   { modBreaks_array = error "ModBreaks.modBreaks_array not initialised"
+         -- Todo: can we avoid this? 
+   , modBreaks_ticks = array (0,-1) []
+   }
+\end{code}