Make the LiberateCase transformation understand associated types
[ghc-hetmet.git] / compiler / main / HscTypes.lhs
index d3c5f7f..2b8f8f7 100644 (file)
@@ -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,17 +98,17 @@ 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 )
 import UniqSupply      ( UniqSupply )
 import FastString      ( FastString )
 
-import DATA_IOREF      ( IORef, readIORef )
 import StringBuffer    ( StringBuffer )
-import Maybes           ( catMaybes, seqMaybe )
-import Time            ( ClockTime )
+
+import System.Time     ( ClockTime )
+import Data.IORef      ( IORef, readIORef )
 \end{code}
 
 
@@ -208,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
@@ -294,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}
 
 %************************************************************************
@@ -366,6 +377,7 @@ data ModIface
         mi_mod_vers :: !Version,           -- Module version: changes when anything changes
 
         mi_orphan   :: !WhetherHasOrphans,  -- Whether this module has orphans
+        mi_finsts   :: !WhetherHasFamInst,  -- Whether module has family insts
        mi_boot     :: !IsBootInterface,    -- Read from an hi-boot file?
 
        mi_deps     :: Dependencies,
@@ -419,7 +431,8 @@ data ModIface
        mi_fam_insts :: [IfaceFamInst],                 -- Sorted
        mi_rules     :: [IfaceRule],                    -- Sorted
        mi_rule_vers :: !Version,       -- Version number for rules and 
-                                       -- instances combined
+                                       -- instances (for classes and families)
+                                       -- combined
 
                -- Cached environments for easy lookup
                -- These are computed (lazily) from other fields
@@ -437,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
@@ -470,14 +485,20 @@ 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 
        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_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:
@@ -514,7 +535,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
     }
 
 -----------------------------------
@@ -549,6 +571,7 @@ emptyModIface mod
   = ModIface { mi_module   = mod,
               mi_mod_vers = initialVersion,
               mi_orphan   = False,
+              mi_finsts   = False,
               mi_boot     = False,
               mi_deps     = noDependencies,
               mi_usages   = [],
@@ -800,13 +823,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
@@ -853,11 +869,8 @@ instance Outputable n => Outputable (GenAvailInfo n) where
    ppr = pprAvail
 
 pprAvail :: Outputable n => GenAvailInfo n -> SDoc
-pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of
-                                       []  -> empty
-                                       ns' -> braces (hsep (punctuate comma (map ppr ns')))
-
-pprAvail (Avail n) = ppr n
+pprAvail (Avail n)      = ppr n
+pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
 \end{code}
 
 \begin{code}
@@ -903,22 +916,32 @@ type WhetherHasOrphans   = Bool
        --      * a transformation rule in a module other than the one defining
        --              the function in the head of the rule.
 
+type WhetherHasFamInst = Bool       -- This module defines family instances?
+
 type IsBootInterface = Bool
 
 -- Dependency info about modules and packages below this one
 -- in the import hierarchy.  See TcRnTypes.ImportAvails for details.
+-- The orphan modules in `dep_orphs' do *not* include family instance orphans,
+-- as they are anyway included in `dep_finsts'.
 --
 -- Invariant: the dependencies of a module M never includes M
 -- Invariant: the lists are unordered, with no duplicates
 data Dependencies
-  = Deps { dep_mods  :: [(ModuleName,IsBootInterface)],        -- Home-package module dependencies
-          dep_pkgs  :: [PackageId],                    -- External package dependencies
-          dep_orphs :: [Module] }                      -- Orphan modules (whether home or external pkg)
+  = Deps { dep_mods   :: [(ModuleName,      -- Home-package module dependencies
+                          IsBootInterface)]
+        , dep_pkgs   :: [PackageId]        -- External package dependencies
+        , dep_orphs  :: [Module]           -- Orphan modules (whether home or
+                                           -- external pkg)
+         , dep_finsts :: [Module]          -- Modules that contain family
+                                           -- instances (whether home or
+                                           -- external pkg)
+         }
   deriving( Eq )
        -- Equality used only for old/new comparison in MkIface.addVersionInfo
 
 noDependencies :: Dependencies
-noDependencies = Deps [] [] []
+noDependencies = Deps [] [] [] []
          
 data Usage
   = Usage { usg_name     :: ModuleName,                        -- Name of the module
@@ -997,6 +1020,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
   }
 
@@ -1125,6 +1151,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}
 %*                                                                     *
 %************************************************************************