Adding pushing of hpc translation status through hi files.

[ghc-hetmet.git] / compiler / rename / RnNames.lhs

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 4a880ed..8b09f52 100644 (file)
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -57,7 +57,7 @@ import Monad          ( when )
 
 \begin{code}
 rnImports :: [LImportDecl RdrName]
-           -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails)
+           -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage)
 
 rnImports imports
          -- PROCESS IMPORT DECLS
@@ -75,18 +75,19 @@ rnImports imports
 
          stuff1 <- mapM (rnImportDecl this_mod) (prel_imports ++ ordinary)
          stuff2 <- mapM (rnImportDecl this_mod) source
-         let (decls, rdr_env, imp_avails) = combine (stuff1 ++ stuff2)
-         return (decls, rdr_env, imp_avails) 
+         let (decls, rdr_env, imp_avails,hpc_usage) = combine (stuff1 ++ stuff2)
+         return (decls, rdr_env, imp_avails,hpc_usage) 
 
     where
-   combine :: [(LImportDecl Name,  GlobalRdrEnv, ImportAvails)]
-           -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails)
-   combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails)
-        where plus (decl,  gbl_env1, imp_avails1)
-                   (decls, gbl_env2, imp_avails2)
+   combine :: [(LImportDecl Name,  GlobalRdrEnv, ImportAvails,AnyHpcUsage)]
+           -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage)
+   combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails,False)
+        where plus (decl,  gbl_env1, imp_avails1,hpc_usage1)
+                   (decls, gbl_env2, imp_avails2,hpc_usage2)
                 = (decl:decls, 
                    gbl_env1 `plusGlobalRdrEnv` gbl_env2,
-                   imp_avails1 `plusImportAvails` imp_avails2)
+                   imp_avails1 `plusImportAvails` imp_avails2,
+                  hpc_usage1 || hpc_usage2)
 
 mkPrelImports :: Module -> Bool -> [LImportDecl RdrName] -> [LImportDecl RdrName]
 -- Consruct the implicit declaration "import Prelude" (or not)
@@ -119,7 +120,7 @@ mkPrelImports this_mod implicit_prelude import_decls
 
 rnImportDecl  :: Module
              -> LImportDecl RdrName
-             -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails)
+             -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
 
 rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
                                          qual_only as_mod imp_details))
@@ -245,7 +246,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
     let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot
                                          qual_only as_mod new_imp_details)
 
-    returnM (new_imp_decl, gbl_env, imports)
+    returnM (new_imp_decl, gbl_env, imports, mi_hpc iface)
     )
 
 warnRedundantSourceImport mod_name
@@ -302,7 +303,7 @@ used for source code.
 
        *** See "THE NAMING STORY" in HsDecls ****
 
-Instances of indexed types
+Instances of type families
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 Indexed data/newtype instances contain data constructors that we need to
 collect, too.  Moreover, we need to descend into the data/newtypes instances
@@ -384,8 +385,8 @@ filterImports iface decl_spec Nothing all_avails
 
 filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
   = do   -- check for errors, convert RdrNames to Names
-        opt_indexedtypes <- doptM Opt_IndexedTypes
-        items1 <- mapM (lookup_lie opt_indexedtypes) import_items
+        opt_typeFamilies <- doptM Opt_TypeFamilies
+        items1 <- mapM (lookup_lie opt_typeFamilies) import_items
 
         let items2 :: [(LIE Name, AvailInfo)]
             items2 = concat items1
@@ -432,10 +433,10 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
            (name, AvailTC name subs, Just parent)
 
     lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
-    lookup_lie opt_indexedtypes (L loc ieRdr)
+    lookup_lie opt_typeFamilies (L loc ieRdr)
         = do 
              stuff <- setSrcSpan loc $ 
-                      case lookup_ie opt_indexedtypes ieRdr of
+                      case lookup_ie opt_typeFamilies ieRdr of
                             Failed err  -> addErr err >> return []
                             Succeeded a -> return a
              checkDodgyImport stuff
@@ -460,7 +461,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
        -- AvailInfos for the data constructors and the family (as they have
        -- different parents).  See the discussion at occ_env.
     lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)]
-    lookup_ie opt_indexedtypes ie 
+    lookup_ie opt_typeFamilies ie 
       = let bad_ie = Failed (badImportItemErr iface decl_spec ie)
 
             lookup_name rdrName = 
@@ -505,8 +506,8 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
            children <- if any isNothing mb_children
                         then bad_ie
                         else return (catMaybes mb_children)
-              -- check for proper import of indexed types
-           when (not opt_indexedtypes && any isTyConName children) $
+              -- check for proper import of type families
+           when (not opt_typeFamilies && any isTyConName children) $
               Failed (typeItemErr (head . filter isTyConName $ children)
                                  (text "in import list"))
             case mb_parent of
@@ -837,8 +838,8 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
                 then do addErr (exportItemErr ie)
                         return (IEThingWith name [], AvailTC name [name])
                 else do let names = catMaybes mb_names
-                        optIdxTypes <- doptM Opt_IndexedTypes
-                        when (not optIdxTypes && any isTyConName names) $
+                        optTyFam <- doptM Opt_TypeFamilies
+                        when (not optTyFam && any isTyConName names) $
                           addErr (typeItemErr ( head
                                               . filter isTyConName 
                                               $ names )
@@ -1300,8 +1301,8 @@ dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
 
 dodgyMsg kind tc
   = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)),
-         ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
-         ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
+         ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructors or class methods,"),
+         ptext SLIT("but it has none") ]
          
 exportItemErr export_item
   = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
@@ -1309,7 +1310,7 @@ exportItemErr export_item
 
 typeItemErr name wherestr
   = sep [ ptext SLIT("Using 'type' tag on") <+> quotes (ppr name) <+> wherestr,
-         ptext SLIT("Use -findexed-types to enable this extension") ]
+         ptext SLIT("Use -ftype-families to enable this extension") ]
 
 exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName
                -> Message