View patterns, record wildcards, and record puns

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

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index eeea9d9..abebd14 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -21,7 +21,7 @@ module HscTypes (
        HscSource(..), isHsBoot, hscSourceString,       -- Re-exported from DriverPhases
        
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
        HscSource(..), isHsBoot, hscSourceString,       -- Re-exported from DriverPhases
        
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,

-       hptInstances, hptRules,
+       hptInstances, hptRules, hptVectInfo,

 
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
 
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,

@@ -29,12 +29,11 @@ module HscTypes (
 
        InteractiveContext(..), emptyInteractiveContext, 
        icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
 
        InteractiveContext(..), emptyInteractiveContext, 
        icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,

+        substInteractiveContext,

 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
        emptyIfaceDepCache,
 
 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
        emptyIfaceDepCache,
 

-       Deprecs(..), IfaceDeprecs,
-

        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
 
        implicitTyThings, isImplicitTyThing,
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
 
        implicitTyThings, isImplicitTyThing,

@@ -52,7 +51,7 @@ module HscTypes (
        GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
        IfaceExport,
 
        GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
        IfaceExport,
 

-       Deprecations, DeprecTxt, plusDeprecs,
+       Deprecations(..), DeprecTxt, plusDeprecs,

 
        PackageInstEnv, PackageRuleBase,
 
 
        PackageInstEnv, PackageRuleBase,
 

@@ -60,7 +59,7 @@ module HscTypes (
        Linkable(..), isObjectLinkable,
        Unlinked(..), CompiledByteCode,
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,
        Linkable(..), isObjectLinkable,
        Unlinked(..), CompiledByteCode,
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,

-        HpcInfo(..), noHpcInfo,
+        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,

 
         -- Breakpoints
         ModBreaks (..), BreakIndex, emptyModBreaks,
 
         -- Breakpoints
         ModBreaks (..), BreakIndex, emptyModBreaks,

@@ -77,9 +76,7 @@ import ByteCodeAsm    ( CompiledByteCode )
 import {-# SOURCE #-}  InteractiveEval ( Resume )
 #endif
 
 import {-# SOURCE #-}  InteractiveEval ( Resume )
 #endif
 

-import RdrName         ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), 
-                          unQualOK, ImpDeclSpec(..), Provenance(..),
-                          ImportSpec(..), lookupGlobalRdrEnv )
+import RdrName

 import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
 import NameEnv
 import NameSet 
 import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
 import NameEnv
 import NameSet 

@@ -90,15 +87,17 @@ import InstEnv              ( InstEnv, Instance )
 import FamInstEnv      ( FamInstEnv, FamInst )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )
 import FamInstEnv      ( FamInstEnv, FamInst )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )

+import VarEnv

 import VarSet
 import VarSet

+import Var       hiding ( setIdType )

 import Id
 import Id

-import Type            ( TyThing(..) )
+import Type            

 
 import Class           ( Class, classSelIds, classATs, classTyCon )
 import TyCon
 import DataCon         ( DataCon, dataConImplicitIds )
 import PrelNames       ( gHC_PRIM )
 
 import Class           ( Class, classSelIds, classATs, classTyCon )
 import TyCon
 import DataCon         ( DataCon, dataConImplicitIds )
 import PrelNames       ( gHC_PRIM )

-import Packages                ( PackageId )
+import Packages hiding ( Version(..) )

 import DynFlags                ( DynFlags(..), isOneShot, HscTarget (..) )
 import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString, Phase )
 import BasicTypes      ( Version, initialVersion, IPName, 
 import DynFlags                ( DynFlags(..), isOneShot, HscTarget (..) )
 import DriverPhases    ( HscSource(..), isHsBoot, hscSourceString, Phase )
 import BasicTypes      ( Version, initialVersion, IPName, 

@@ -113,12 +112,12 @@ import SrcLoc             ( SrcSpan, Located )
 import UniqFM          ( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply      ( UniqSupply )
 import FastString      ( FastString )
 import UniqFM          ( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply      ( UniqSupply )
 import FastString      ( FastString )

-

 import StringBuffer    ( StringBuffer )
 
 import System.Time     ( ClockTime )
 import Data.IORef
 import Data.Array       ( Array, array )
 import StringBuffer    ( StringBuffer )
 
 import System.Time     ( ClockTime )
 import Data.IORef
 import Data.Array       ( Array, array )

+import Data.List

 \end{code}
 
 
 \end{code}
 
 

@@ -229,6 +228,7 @@ pprTarget (Target id _) = pprTargetId id
 instance Outputable Target where
     ppr = pprTarget
 
 instance Outputable Target where
     ppr = pprTarget
 

+pprTargetId :: TargetId -> SDoc

 pprTargetId (TargetModule m) = ppr m
 pprTargetId (TargetFile f _) = text f
 
 pprTargetId (TargetModule m) = ppr m
 pprTargetId (TargetFile f _) = text f
 

@@ -241,7 +241,10 @@ type HomePackageTable  = ModuleNameEnv HomeModInfo
 type PackageIfaceTable = ModuleEnv ModIface
        -- Domain = modules in the imported packages
 
 type PackageIfaceTable = ModuleEnv ModIface
        -- Domain = modules in the imported packages
 

+emptyHomePackageTable :: HomePackageTable

 emptyHomePackageTable  = emptyUFM
 emptyHomePackageTable  = emptyUFM

+
+emptyPackageIfaceTable :: PackageIfaceTable

 emptyPackageIfaceTable = emptyModuleEnv
 
 data HomeModInfo 
 emptyPackageIfaceTable = emptyModuleEnv
 
 data HomeModInfo 

@@ -330,6 +333,15 @@ hptRules hsc_env deps
 
        -- And get its dfuns
     , rule <- rules ]
 
        -- And get its dfuns
     , rule <- rules ]

+
+hptVectInfo :: HscEnv -> VectInfo
+-- Get the combined VectInfo of all modules in the home package table.  In
+-- contrast to instances and rules, we don't care whether the modules are
+-- "below" or us.  The VectInfo of those modules not "below" us does not
+-- affect the compilation of the current module.
+hptVectInfo hsc_env 
+  = foldr plusVectInfo noVectInfo [ md_vect_info (hm_details mod_info)
+                                  | mod_info <- eltsUFM (hsc_HPT hsc_env)]

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -420,7 +432,7 @@ data ModIface
                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Deprecations
                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Deprecations

-       mi_deprecs  :: IfaceDeprecs,
+       mi_deprecs  :: Deprecations,

                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Type, class and variable declarations
                -- NOT STRICT!  we read this field lazily from the interface file
 
                -- Type, class and variable declarations

@@ -461,12 +473,14 @@ data ModIface
                -- and are not put into the interface file
        mi_dep_fn  :: Name -> Maybe DeprecTxt,  -- Cached lookup for mi_deprecs
        mi_fix_fn  :: OccName -> Fixity,        -- Cached lookup for mi_fixities
                -- and are not put into the interface file
        mi_dep_fn  :: Name -> Maybe DeprecTxt,  -- Cached lookup for mi_deprecs
        mi_fix_fn  :: OccName -> Fixity,        -- Cached lookup for mi_fixities

-       mi_ver_fn  :: OccName -> Maybe (OccName, Version)
+       mi_ver_fn  :: OccName -> Maybe (OccName, Version),

                         -- Cached lookup for mi_decls
                        -- The Nothing in mi_ver_fn means that the thing
                        -- isn't in decls. It's useful to know that when
                        -- seeing if we are up to date wrt the old interface
                         -- The 'OccName' is the parent of the name, if it has one.
                         -- Cached lookup for mi_decls
                        -- The Nothing in mi_ver_fn means that the thing
                        -- isn't in decls. It's useful to know that when
                        -- seeing if we are up to date wrt the old interface
                         -- The 'OccName' is the parent of the name, if it has one.

+       mi_hpc    :: !AnyHpcUsage
+         -- True if this program uses Hpc at any point in the program.

      }
 
 -- Should be able to construct ModDetails from mi_decls in ModIface
      }
 
 -- Should be able to construct ModDetails from mi_decls in ModIface

@@ -475,18 +489,20 @@ data ModDetails
        -- The next two fields are created by the typechecker
        md_exports   :: [AvailInfo],
         md_types     :: !TypeEnv,
        -- 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_insts     :: ![Instance],  -- Dfun-ids for the instances in this module

         md_fam_insts :: ![FamInst],
         md_fam_insts :: ![FamInst],

-        md_rules     :: ![CoreRule],   -- Domain may include Ids from other modules
-        md_modBreaks :: !ModBreaks  -- breakpoint information for this module 
+        md_rules     :: ![CoreRule],  -- Domain may include Ids from other modules
+        md_vect_info :: !VectInfo     -- Vectorisation information

      }
 
      }
 

+emptyModDetails :: ModDetails

 emptyModDetails = ModDetails { md_types = emptyTypeEnv,
                               md_exports = [],
                               md_insts     = [],
                               md_rules     = [],
                               md_fam_insts = [],
 emptyModDetails = ModDetails { md_types = emptyTypeEnv,
                               md_exports = [],
                               md_insts     = [],
                               md_rules     = [],
                               md_fam_insts = [],

-                               md_modBreaks = emptyModBreaks } 
+                               md_vect_info = noVectInfo
+                             } 

 
 -- 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
 
 -- 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

@@ -505,13 +521,9 @@ data ModGuts
        mg_usages    :: ![Usage],        -- Version info for what it needed
 
         mg_rdr_env   :: !GlobalRdrEnv,  -- Top-level lexical environment
        mg_usages    :: ![Usage],        -- Version info for what it needed
 
         mg_rdr_env   :: !GlobalRdrEnv,  -- Top-level lexical environment

-       mg_fix_env   :: !FixityEnv,      -- Fixity env, for things declared in
-                                        --   this module 
-
-       mg_fam_inst_env :: FamInstEnv,   -- Type-family instance enviroment
-                                        -- for *home-package* modules (including
-                                        -- this one).  c.f. tcg_fam_inst_env

 
 

+       -- These fields all describe the things **declared in this module**
+       mg_fix_env   :: !FixityEnv,      -- Fixities

        mg_types     :: !TypeEnv,
        mg_insts     :: ![Instance],     -- Instances 
        mg_fam_insts :: ![FamInst],      -- Instances 
        mg_types     :: !TypeEnv,
        mg_insts     :: ![Instance],     -- Instances 
        mg_fam_insts :: ![FamInst],      -- Instances 

@@ -521,7 +533,19 @@ data ModGuts
        mg_deprecs   :: !Deprecations,   -- Deprecations declared in the module
        mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
         mg_modBreaks :: !ModBreaks,
        mg_deprecs   :: !Deprecations,   -- Deprecations declared in the module
        mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
         mg_modBreaks :: !ModBreaks,

-        mg_vect_info :: !VectInfo        -- Pool of vectorised declarations
+        mg_vect_info :: !VectInfo,        -- Pool of vectorised declarations
+
+       -- The next two fields are unusual, because they give instance
+       -- environments for *all* modules in the home package, including
+       -- this module, rather than for *just* this module.  
+       -- Reason: when looking up an instance we don't want to have to
+       --        look at each module in the home package in turn
+       mg_inst_env     :: InstEnv,      -- Class instance enviroment fro
+                                        -- *home-package* modules (including
+                                        -- this one); c.f. tcg_inst_env
+       mg_fam_inst_env :: FamInstEnv    -- Type-family instance enviroment
+                                        -- for *home-package* modules (including
+                                        -- this one); c.f. tcg_fam_inst_env

     }
 
 -- The ModGuts takes on several slightly different forms:
     }
 
 -- The ModGuts takes on several slightly different forms:

@@ -559,7 +583,8 @@ data CgGuts
 
        cg_foreign  :: !ForeignStubs,   
        cg_dep_pkgs :: ![PackageId],    -- Used to generate #includes for C code gen
 
        cg_foreign  :: !ForeignStubs,   
        cg_dep_pkgs :: ![PackageId],    -- Used to generate #includes for C code gen

-        cg_hpc_info :: !HpcInfo         -- info about coverage tick boxes
+        cg_hpc_info :: !HpcInfo,         -- info about coverage tick boxes
+        cg_modBreaks :: !ModBreaks

     }
 
 -----------------------------------
     }
 
 -----------------------------------

@@ -583,8 +608,6 @@ data ForeignStubs = NoStubs
                                         --     "foreign exported" functions
                        [FastString]    -- Headers that need to be included
                                        --      into C code generated for this module
                                         --     "foreign exported" functions
                        [FastString]    -- Headers that need to be included
                                        --      into C code generated for this module

-                       [Id]            -- Foreign-exported binders
-                                       --      we have to generate code to register these

 
 \end{code}
 
 
 \end{code}
 

@@ -611,7 +634,8 @@ emptyModIface mod
                mi_vect_info = noIfaceVectInfo,
               mi_dep_fn = emptyIfaceDepCache,
               mi_fix_fn = emptyIfaceFixCache,
                mi_vect_info = noIfaceVectInfo,
               mi_dep_fn = emptyIfaceDepCache,
               mi_fix_fn = emptyIfaceFixCache,

-              mi_ver_fn = emptyIfaceVerCache
+              mi_ver_fn = emptyIfaceVerCache,
+              mi_hpc    = False

     }          
 \end{code}
 
     }          
 \end{code}
 

@@ -650,6 +674,7 @@ data InteractiveContext
     }
 
 
     }
 
 

+emptyInteractiveContext :: InteractiveContext

 emptyInteractiveContext
   = InteractiveContext { ic_toplev_scope = [],
                         ic_exports = [],
 emptyInteractiveContext
   = InteractiveContext { ic_toplev_scope = [],
                         ic_exports = [],

@@ -661,8 +686,8 @@ emptyInteractiveContext
 #endif
                        }
 
 #endif
                        }
 

-icPrintUnqual :: InteractiveContext -> PrintUnqualified
-icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt)
+icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
+icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (ic_rn_gbl_env ictxt)

 
 
 extendInteractiveContext
 
 
 extendInteractiveContext

@@ -675,6 +700,22 @@ extendInteractiveContext ictxt ids tyvars
                           -- NB. must be this way around, because we want
                           -- new ids to shadow existing bindings.
             ic_tyvars   = ic_tyvars ictxt `unionVarSet` tyvars }
                           -- NB. must be this way around, because we want
                           -- new ids to shadow existing bindings.
             ic_tyvars   = ic_tyvars ictxt `unionVarSet` tyvars }

+
+
+substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
+substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
+substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst =
+   let ids'     = map (\id -> id `setIdType` substTy subst (idType id)) ids
+       subst_dom= varEnvKeys$ getTvSubstEnv subst
+       subst_ran= varEnvElts$ getTvSubstEnv subst
+       new_tvs  = [ tv | Just tv <- map getTyVar_maybe subst_ran]  
+       ic_tyvars'= (`delVarSetListByKey` subst_dom) 
+                 . (`extendVarSetList`   new_tvs)
+                   $ ic_tyvars ictxt
+    in ictxt { ic_tmp_ids = ids'
+             , ic_tyvars   = ic_tyvars' }
+
+          where delVarSetListByKey = foldl' delVarSetByKey

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -683,23 +724,71 @@ extendInteractiveContext ictxt ids tyvars
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

+Deciding how to print names is pretty tricky.  We are given a name
+P:M.T, where P is the package name, M is the defining module, and T is
+the occurrence name, and we have to decide in which form to display
+the name given a GlobalRdrEnv describing the current scope.
+
+Ideally we want to display the name in the form in which it is in
+scope.  However, the name might not be in scope at all, and that's
+where it gets tricky.  Here are the cases:
+
+ 1. T   uniquely maps to  P:M.T                         --->  "T"
+ 2. there is an X for which X.T uniquely maps to  P:M.T --->  "X.T"
+ 3. there is no binding for "M.T"                       --->  "M.T"
+ 4. otherwise                                           --->  "P:M.T"
+
+3 and 4 apply when P:M.T is not in scope.  In these cases we want to
+refer to the name as "M.T", but "M.T" might mean something else in the
+current scope (e.g. if there's an "import X as M"), so to avoid
+confusion we avoid using "M.T" if there's already a binding for it.
+
+There's one further subtlety: if the module M cannot be imported
+because it is not exposed by any package, then we must refer to it as
+"P:M".  This is handled by the qual_mod component of PrintUnqualified.
+

 \begin{code}
 \begin{code}

-mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified
-mkPrintUnqualified env = (qual_name, qual_mod)
+mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
+mkPrintUnqualified dflags env = (qual_name, qual_mod)

   where
   where

-  qual_name mod occ
-        | null gres = Just (moduleName mod)
-                -- it isn't in scope at all, this probably shouldn't happen,
-                -- but we'll qualify it by the original module anyway.
-        | any unQualOK gres = Nothing
-        | (Imported is : _) <- map gre_prov gres, (idecl : _) <- is
-          = Just (is_as (is_decl idecl))
-        | otherwise = panic "mkPrintUnqualified" 
+  qual_name mod occ    -- The (mod,occ) pair is the original name of the thing
+        | [gre] <- unqual_gres, right_name gre = NameUnqual
+               -- If there's a unique entity that's in scope unqualified with 'occ'
+               -- AND that entity is the right one, then we can use the unqualified name
+
+        | [gre] <- qual_gres = NameQual (get_qual_mod (gre_prov gre))
+
+        | null qual_gres = 
+              if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
+                   then NameNotInScope1
+                   else NameNotInScope2
+
+       | otherwise = panic "mkPrintUnqualified"

       where
       where

-        gres  = [ gre | gre <- lookupGlobalRdrEnv env occ,
-                       nameModule (gre_name gre) == mod ]
+       right_name gre = nameModule (gre_name gre) == mod
+
+        unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
+        qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)
+
+       get_qual_mod LocalDef      = moduleName mod
+       get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is))
+
+    -- we can mention a module P:M without the P: qualifier iff
+    -- "import M" would resolve unambiguously to P:M.  (if P is the
+    -- current package we can just assume it is unqualified).
+
+  qual_mod mod
+     | modulePackageId mod == thisPackage dflags = False

 
 

-  qual_mod mod = Nothing       -- For now...
+     | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup, 
+                             exposed pkg && exposed_module],
+       packageConfigId pkgconfig == modulePackageId mod
+        -- this says: we are given a module P:M, is there just one exposed package
+        -- that exposes a module M, and is it package P?
+     = False
+
+     | otherwise = True
+     where lookup = lookupModuleInAllPackages dflags (moduleName mod)

 \end{code}
 
 
 \end{code}
 
 

@@ -710,31 +799,62 @@ mkPrintUnqualified env = (qual_name, qual_mod)
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

+-- N.B. the set of TyThings returned here *must* match the set of
+-- names returned by LoadIface.ifaceDeclSubBndrs, in the sense that
+-- TyThing.getOccName should define a bijection between the two lists.
+-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
+-- The order of the list does not matter.

 implicitTyThings :: TyThing -> [TyThing]
 implicitTyThings :: TyThing -> [TyThing]

--- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync
-
-implicitTyThings (AnId id)   = []
-
-       -- For type constructors, add the data cons (and their extras),
-       -- and the selectors and generic-programming Ids too
-       --
-       -- Newtypes don't have a worker Id, so don't generate that?
-implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
-                              map AnId (tyConSelIds tc) ++ 
-                              concatMap (extras_plus . ADataCon) 
-                                        (tyConDataCons tc)
+
+-- For data and newtype declarations:
+implicitTyThings (ATyCon tc) = 
+    -- fields (names of selectors)
+    map AnId (tyConSelIds tc) ++ 
+    -- (possibly) implicit coercion and family coercion
+    --   depending on whether it's a newtype or a family instance or both
+    implicitCoTyCon tc ++
+    -- for each data constructor in order,
+    --   the contructor, worker, and (possibly) wrapper
+    concatMap (extras_plus . ADataCon) (tyConDataCons tc)

                     
                     

-       -- For classes, add the class selector Ids, and assoicated TyCons
-       -- and the class TyCon too (and its extras)

 implicitTyThings (AClass cl) 
 implicitTyThings (AClass cl) 

-  = map AnId (classSelIds cl) ++
+  = -- dictionary datatype:
+    --    [extras_plus:]
+    --      type constructor 
+    --    [recursive call:]
+    --      (possibly) newtype coercion; definitely no family coercion here
+    --      data constructor
+    --      worker
+    --      (no wrapper by invariant)
+    extras_plus (ATyCon (classTyCon cl)) ++
+    -- associated types 
+    --    No extras_plus (recursive call) for the classATs, because they
+    --    are only the family decls; they have no implicit things

     map ATyCon (classATs 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))
+    -- superclass and operation selectors
+    map AnId (classSelIds cl)
+
+implicitTyThings (ADataCon dc) = 
+    -- For data cons add the worker and (possibly) wrapper
+    map AnId (dataConImplicitIds dc)
+
+implicitTyThings (AnId _)   = []
+
+-- add a thing and recursive call
+extras_plus :: TyThing -> [TyThing]
+extras_plus thing = thing : implicitTyThings thing
+
+-- For newtypes and indexed data types (and both),
+-- add the implicit coercion tycon
+implicitCoTyCon :: TyCon -> [TyThing]
+implicitCoTyCon tc 
+  = map ATyCon . catMaybes $ [-- Just if newtype, Nothing if not
+                              newTyConCo_maybe tc, 
+                              -- Just if family instance, Nothing if not
+                               tyConFamilyCoercion_maybe tc] 
+
+-- sortByOcc = sortBy (\ x -> \ y -> getOccName x < getOccName y)

 
 

-       -- For data cons add the worker and wrapper (if any)
-implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)

 
 -- | returns 'True' if there should be no interface-file declaration
 -- for this thing on its own: either it is built-in, or it is part
 
 -- | returns 'True' if there should be no interface-file declaration
 -- for this thing on its own: either it is built-in, or it is part

@@ -746,13 +866,6 @@ isImplicitTyThing (AnId     id) = isImplicitId id
 isImplicitTyThing (AClass   _)  = False
 isImplicitTyThing (ATyCon   tc) = isImplicitTyCon tc
 
 isImplicitTyThing (AClass   _)  = False
 isImplicitTyThing (ATyCon   tc) = isImplicitTyCon tc
 

-       -- For newtypes and indexed data types, add the implicit coercion tycon
-implicitCoTyCon tc 
-  = map ATyCon . catMaybes $ [newTyConCo_maybe tc, 
-                             tyConFamilyCoercion_maybe tc]
-
-extras_plus thing = thing : implicitTyThings thing
-

 extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
 extendTypeEnvWithIds env ids
   = extendNameEnvList env [(getName id, AnId id) | id <- ids]
 extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
 extendTypeEnvWithIds env ids
   = extendNameEnvList env [(getName id, AnId id) | id <- ids]

@@ -814,17 +927,21 @@ lookupType dflags hpt pte name
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

+tyThingTyCon :: TyThing -> TyCon

 tyThingTyCon (ATyCon tc) = tc
 tyThingTyCon (ATyCon tc) = tc

-tyThingTyCon other      = pprPanic "tyThingTyCon" (ppr other)
+tyThingTyCon other      = pprPanic "tyThingTyCon" (pprTyThing other)

 
 

+tyThingClass :: TyThing -> Class

 tyThingClass (AClass cls) = cls
 tyThingClass (AClass cls) = cls

-tyThingClass other       = pprPanic "tyThingClass" (ppr other)
+tyThingClass other       = pprPanic "tyThingClass" (pprTyThing other)

 
 

+tyThingDataCon :: TyThing -> DataCon

 tyThingDataCon (ADataCon dc) = dc
 tyThingDataCon (ADataCon dc) = dc

-tyThingDataCon other        = pprPanic "tyThingDataCon" (ppr other)
+tyThingDataCon other        = pprPanic "tyThingDataCon" (pprTyThing other)

 
 

+tyThingId :: TyThing -> Id

 tyThingId (AnId id) = id
 tyThingId (AnId id) = id

-tyThingId other     = pprPanic "tyThingId" (ppr other)
+tyThingId other     = pprPanic "tyThingId" (pprTyThing other)

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -850,37 +967,49 @@ mkIfaceVerCache pairs
           add_imp bndr env = extendOccEnv env bndr (decl_name, v)
 
 emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)
           add_imp bndr env = extendOccEnv env bndr (decl_name, v)
 
 emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)

-emptyIfaceVerCache occ = Nothing
+emptyIfaceVerCache _occ = Nothing

 
 ------------------ Deprecations -------------------------
 
 ------------------ Deprecations -------------------------

-data Deprecs a
+data Deprecations

   = NoDeprecs
   = NoDeprecs

-  | DeprecAll DeprecTxt        -- Whole module deprecated
-  | DeprecSome a       -- Some specific things deprecated
+  | DeprecAll DeprecTxt                -- Whole module deprecated
+  | DeprecSome [(OccName,DeprecTxt)] -- Some specific things deprecated
+     -- Only an OccName is needed because
+     --    (1) a deprecation always applies to a binding
+     --        defined in the module in which the deprecation appears.
+     --    (2) deprecations are only reported outside the defining module.
+     --        this is important because, otherwise, if we saw something like
+     --
+     --        {-# DEPRECATED f "" #-}
+     --        f = ...
+     --        h = f
+     --        g = let f = undefined in f
+     --
+     --        we'd need more information than an OccName to know to say something
+     --        about the use of f in h but not the use of the locally bound f in g
+     --
+     --        however, because we only report about deprecations from the outside,
+     --        and a module can only export one value called f,
+     --        an OccName suffices.
+     --
+     --        this is in contrast with fixity declarations, where we need to map
+     --        a Name to its fixity declaration.

   deriving( Eq )
 
   deriving( Eq )
 

-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
-mkIfaceDepCache (DeprecAll t)    = \n -> Just t
+mkIfaceDepCache :: Deprecations -> Name -> Maybe DeprecTxt
+mkIfaceDepCache NoDeprecs        = \_ -> Nothing
+mkIfaceDepCache (DeprecAll t)    = \_ -> Just t

 mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
 
 emptyIfaceDepCache :: Name -> Maybe DeprecTxt
 mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
 
 emptyIfaceDepCache :: Name -> Maybe DeprecTxt

-emptyIfaceDepCache n = Nothing
+emptyIfaceDepCache _ = Nothing

 
 plusDeprecs :: Deprecations -> Deprecations -> Deprecations
 plusDeprecs d NoDeprecs = d
 plusDeprecs NoDeprecs d = d
 
 plusDeprecs :: Deprecations -> Deprecations -> Deprecations
 plusDeprecs d NoDeprecs = d
 plusDeprecs NoDeprecs d = d

-plusDeprecs d (DeprecAll t) = DeprecAll t
-plusDeprecs (DeprecAll t) d = DeprecAll t
-plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
+plusDeprecs _ (DeprecAll t) = DeprecAll t
+plusDeprecs (DeprecAll t) _ = DeprecAll t
+plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 ++ v2)

 \end{code}
 
 
 \end{code}
 
 

@@ -915,7 +1044,7 @@ availName (AvailTC n _) = n
 
 availNames :: GenAvailInfo name -> [name]
 availNames (Avail n)      = [n]
 
 availNames :: GenAvailInfo name -> [name]
 availNames (Avail n)      = [n]

-availNames (AvailTC n ns) = ns
+availNames (AvailTC _ ns) = ns

 
 instance Outputable n => Outputable (GenAvailInfo n) where
    ppr = pprAvail
 
 instance Outputable n => Outputable (GenAvailInfo n) where
    ppr = pprAvail

@@ -933,24 +1062,24 @@ mkIfaceFixCache pairs
    env = mkOccEnv pairs
 
 emptyIfaceFixCache :: OccName -> Fixity
    env = mkOccEnv pairs
 
 emptyIfaceFixCache :: OccName -> Fixity

-emptyIfaceFixCache n = defaultFixity
+emptyIfaceFixCache _ = defaultFixity

 
 -- This fixity environment is for source code only
 type FixityEnv = NameEnv FixItem
 
 -- We keep the OccName in the range so that we can generate an interface from it
 
 -- This fixity environment is for source code only
 type FixityEnv = NameEnv FixItem
 
 -- We keep the OccName in the range so that we can generate an interface from it

-data FixItem = FixItem OccName Fixity SrcSpan
+data FixItem = FixItem OccName Fixity

 
 instance Outputable FixItem where
 
 instance Outputable FixItem where

-  ppr (FixItem occ fix loc) = ppr fix <+> ppr occ <+> parens (ppr loc)
+  ppr (FixItem occ fix) = ppr fix <+> ppr occ

 
 emptyFixityEnv :: FixityEnv
 emptyFixityEnv = emptyNameEnv
 
 lookupFixity :: FixityEnv -> Name -> Fixity
 lookupFixity env n = case lookupNameEnv env n of
 
 emptyFixityEnv :: FixityEnv
 emptyFixityEnv = emptyNameEnv
 
 lookupFixity :: FixityEnv -> Name -> Fixity
 lookupFixity env n = case lookupNameEnv env n of

-                       Just (FixItem _ fix _) -> fix
-                       Nothing                -> defaultFixity
+                       Just (FixItem _ fix) -> fix
+                       Nothing         -> defaultFixity

 \end{code}
 
 
 \end{code}
 
 

@@ -1212,14 +1341,26 @@ showModMsg target recomp mod_summary
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-data HpcInfo = HpcInfo 
+data HpcInfo 
+  = HpcInfo 

      { hpcInfoTickCount :: Int 
      , hpcInfoHash      :: Int  
      }
      { hpcInfoTickCount :: Int 
      , hpcInfoHash      :: Int  
      }

-     | NoHpcInfo
+  | NoHpcInfo 
+     { hpcUsed          :: AnyHpcUsage  -- is hpc used anywhere on the module tree?
+     }
+
+-- This is used to mean there is no module-local hpc usage,
+-- but one of my imports used hpc instrumentation.

 
 

-noHpcInfo :: HpcInfo
-noHpcInfo = NoHpcInfo
+type AnyHpcUsage = Bool
+
+emptyHpcInfo :: AnyHpcUsage -> HpcInfo
+emptyHpcInfo = NoHpcInfo 
+
+isHpcUsed :: HpcInfo -> AnyHpcUsage
+isHpcUsed (HpcInfo {})                  = True
+isHpcUsed (NoHpcInfo { hpcUsed = used }) = used

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -1232,26 +1373,54 @@ The following information is generated and consumed by the vectorisation
 subsystem.  It communicates the vectorisation status of declarations from one
 module to another.
 
 subsystem.  It communicates the vectorisation status of declarations from one
 module to another.
 

+Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo
+below?  We need to know `f' when converting to IfaceVectInfo.  However, during
+vectorisation, we need to know `f_v', whose `Var' we cannot lookup based
+on just the OccName easily in a Core pass.
+

 \begin{code}
 \begin{code}

--- ModGuts version
-data VectInfo      = VectInfo {
-                       vectInfoCCVar :: NameSet
-                     }
+-- ModGuts/ModDetails/EPS version
+data VectInfo      
+  = VectInfo {
+      vectInfoVar     :: VarEnv  (Var    , Var  ),   -- (f, f_v) keyed on f
+      vectInfoTyCon   :: NameEnv (TyCon  , TyCon),   -- (T, T_v) keyed on T
+      vectInfoDataCon :: NameEnv (DataCon, DataCon), -- (C, C_v) keyed on C
+      vectInfoPADFun  :: NameEnv (TyCon  , Var),     -- (T_v, paT) keyed on T_v
+      vectInfoIso     :: NameEnv (TyCon  , Var)      -- (T, isoT) keyed on T
+    }
+    -- all of this is always tidy, even in ModGuts

 
 -- ModIface version
 
 -- ModIface version

-data IfaceVectInfo = IfaceVectInfo {
-                       ifaceVectInfoCCVar :: [Name]
-                     }
+data IfaceVectInfo 
+  = IfaceVectInfo {
+      ifaceVectInfoVar        :: [Name],
+        -- all variables in here have a vectorised variant;
+        -- the name of the vectorised variant is determined by `mkCloVect'
+      ifaceVectInfoTyCon      :: [Name],
+        -- all tycons in here have a vectorised variant;
+        -- the name of the vectorised variant and those of its
+        -- data constructors are determined by `mkVectTyConOcc'
+        -- and `mkVectDataConOcc'; the names of
+        -- the isomorphisms is determined by `mkVectIsoOcc'
+      ifaceVectInfoTyConReuse :: [Name]              
+        -- the vectorised form of all the tycons in here coincids with
+        -- the unconverted from; the names of the isomorphisms is determined
+        -- by `mkVectIsoOcc'
+    }

 
 noVectInfo :: VectInfo
 
 noVectInfo :: VectInfo

-noVectInfo = VectInfo emptyNameSet
+noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv

 
 plusVectInfo :: VectInfo -> VectInfo -> VectInfo
 plusVectInfo vi1 vi2 = 
 
 plusVectInfo :: VectInfo -> VectInfo -> VectInfo
 plusVectInfo vi1 vi2 = 

-  VectInfo (vectInfoCCVar vi1 `unionNameSets` vectInfoCCVar vi2)
+  VectInfo (vectInfoVar     vi1 `plusVarEnv`  vectInfoVar     vi2)
+           (vectInfoTyCon   vi1 `plusNameEnv` vectInfoTyCon   vi2)
+           (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
+           (vectInfoPADFun  vi1 `plusNameEnv` vectInfoPADFun  vi2)
+           (vectInfoIso     vi1 `plusNameEnv` vectInfoIso     vi2)

 
 noIfaceVectInfo :: IfaceVectInfo
 
 noIfaceVectInfo :: IfaceVectInfo

-noIfaceVectInfo = IfaceVectInfo []
+noIfaceVectInfo = IfaceVectInfo [] [] []

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -1290,10 +1459,10 @@ data Unlinked
    = DotO FilePath
    | DotA FilePath
    | DotDLL FilePath
    = DotO FilePath
    | DotA FilePath
    | DotDLL FilePath

-   | BCOs CompiledByteCode
+   | BCOs CompiledByteCode ModBreaks

 
 #ifndef GHCI
 
 #ifndef GHCI

-data CompiledByteCode = NoByteCode
+data CompiledByteCode

 #endif
 
 instance Outputable Unlinked where
 #endif
 
 instance Outputable Unlinked where

@@ -1301,25 +1470,29 @@ instance Outputable Unlinked where
    ppr (DotA path)   = text "DotA" <+> text path
    ppr (DotDLL path) = text "DotDLL" <+> text path
 #ifdef GHCI
    ppr (DotA path)   = text "DotA" <+> text path
    ppr (DotDLL path) = text "DotDLL" <+> text path
 #ifdef GHCI

-   ppr (BCOs bcos)   = text "BCOs" <+> ppr bcos
+   ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos

 #else
 #else

-   ppr (BCOs bcos)   = text "No byte code"
+   ppr (BCOs _ _)    = text "No byte code"

 #endif
 
 #endif
 

+isObject :: Unlinked -> Bool

 isObject (DotO _)   = True
 isObject (DotA _)   = True
 isObject (DotDLL _) = True
 isObject _          = False
 
 isObject (DotO _)   = True
 isObject (DotA _)   = True
 isObject (DotDLL _) = True
 isObject _          = False
 

+isInterpretable :: Unlinked -> Bool

 isInterpretable = not . isObject
 
 isInterpretable = not . isObject
 

+nameOfObject :: Unlinked -> FilePath

 nameOfObject (DotO fn)   = fn
 nameOfObject (DotA fn)   = fn
 nameOfObject (DotDLL fn) = fn
 nameOfObject other       = pprPanic "nameOfObject" (ppr other)
 
 nameOfObject (DotO fn)   = fn
 nameOfObject (DotA fn)   = fn
 nameOfObject (DotDLL fn) = fn
 nameOfObject other       = pprPanic "nameOfObject" (ppr other)
 

-byteCodeOfObject (BCOs bc) = bc
-byteCodeOfObject other     = pprPanic "byteCodeOfObject" (ppr other)
+byteCodeOfObject :: Unlinked -> CompiledByteCode
+byteCodeOfObject (BCOs bc _) = bc
+byteCodeOfObject other       = pprPanic "byteCodeOfObject" (ppr other)

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************