This patch teaches ghci to announce that a module has beeen loaded in debugging mode

[ghc-hetmet.git] / compiler / main / HscTypes.lhs

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index a0e4857..92b7228 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -64,6 +64,7 @@ module HscTypes (
 
 #include "HsVersions.h"
 
+import Breakpoints      ( SiteNumber, Coord, noDbgSites )
 #ifdef GHCI
 import ByteCodeAsm     ( CompiledByteCode )
 #endif
@@ -90,7 +91,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 )
@@ -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}
 
 %************************************************************************
@@ -445,14 +455,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_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
@@ -473,7 +485,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 
@@ -481,7 +496,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_dbg_sites :: ![(SiteNumber, Coord)]     -- Bkpts inserted by the renamer
     }
 
 -- The ModGuts takes on several slightly different forms:
@@ -657,12 +674,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)
@@ -1121,7 +1140,12 @@ 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
+#if defined(GHCI) && defined(DEBUGGER)
+                      HscInterpreted | recomp && 
+                                       Opt_Debugging `elem` modflags
+                                 -> text "interpreted(debugging)"
+#endif
+                      HscInterpreted | recomp 
                                  -> text "interpreted"
                       HscNothing -> text "nothing"
                       _other     -> text (msObjFilePath mod_summary),
@@ -1129,6 +1153,7 @@ showModMsg target recomp mod_summary
  where 
     mod     = moduleName (ms_mod mod_summary)
     mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
+    modflags= flags(ms_hspp_opts mod_summary)
 \end{code}