[commit: ghc] master: Annotate initIfaceCheck with usage information. (896d216)

git at git.haskell.org git at git.haskell.org
Sun Aug 21 09:46:35 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/896d216d47cf185d071e0388acbbaef10abada88/ghc

>---------------------------------------------------------------

commit 896d216d47cf185d071e0388acbbaef10abada88
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Sun Jun 19 22:31:06 2016 -0700

    Annotate initIfaceCheck with usage information.
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>


>---------------------------------------------------------------

896d216d47cf185d071e0388acbbaef10abada88
 compiler/ghci/Linker.hs         | 2 +-
 compiler/iface/MkIface.hs       | 2 +-
 compiler/main/GhcMake.hs        | 2 +-
 compiler/main/HscMain.hs        | 2 +-
 compiler/typecheck/TcRnMonad.hs | 6 +++---
 ghc/Main.hs                     | 2 +-
 6 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index f018a2e..251d9a8 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -610,7 +610,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
         = return (uniqDSetToList acc_mods, uniqDSetToList acc_pkgs)
     follow_deps (mod:mods) acc_mods acc_pkgs
         = do
-          mb_iface <- initIfaceCheck hsc_env $
+          mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $
                         loadInterface msg mod (ImportByUser False)
           iface <- case mb_iface of
                     Maybes.Failed err      -> throwGhcExceptionIO (ProgramError (showSDoc dflags err))
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index edab350..e78975b 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -952,7 +952,7 @@ checkOldIface hsc_env mod_summary source_modified maybe_iface
         showPass dflags $
             "Checking old interface for " ++
               (showPpr dflags $ ms_mod mod_summary)
-        initIfaceCheck hsc_env $
+        initIfaceCheck (text "checkOldIface") hsc_env $
             check_old_iface hsc_env mod_summary source_modified maybe_iface
 
 check_old_iface
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 93f1cd4..7f7773c 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1422,7 +1422,7 @@ typecheckLoop dflags hsc_env mods = do
   new_hpt <-
     fixIO $ \new_hpt -> do
       let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
-      mds <- initIfaceCheck new_hsc_env $
+      mds <- initIfaceCheck (text "typecheckLoop") new_hsc_env $
                 mapM (typecheckIface . hm_iface) hmis
       let new_hpt = addListToHpt old_hpt
                         (zip mods [ hmi{ hm_details = details }
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 94ab42e..9e4142b 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -739,7 +739,7 @@ genModDetails :: HscEnv -> ModIface -> IO ModDetails
 genModDetails hsc_env old_iface
   = do
     new_details <- {-# SCC "tcRnIface" #-}
-                   initIfaceCheck hsc_env (typecheckIface old_iface)
+                   initIfaceCheck (text "genModDetails") hsc_env (typecheckIface old_iface)
     dumpIfaceStats hsc_env
     return new_details
 
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index e8513d3..2e89852 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -1619,15 +1619,15 @@ initIfaceTcRn thing_inside
               ; get_type_env = readTcRef (tcg_type_env_var tcg_env) }
         ; setEnvs (if_env, ()) thing_inside }
 
-initIfaceCheck :: HscEnv -> IfG a -> IO a
+initIfaceCheck :: SDoc -> HscEnv -> IfG a -> IO a
 -- Used when checking the up-to-date-ness of the old Iface
 -- Initialise the environment with no useful info at all
-initIfaceCheck hsc_env do_this
+initIfaceCheck doc hsc_env do_this
  = do let rec_types = case hsc_type_env_var hsc_env of
                          Just (mod,var) -> Just (mod, readTcRef var)
                          Nothing        -> Nothing
           gbl_env = IfGblEnv {
-                        if_doc = text "initIfaceCheck",
+                        if_doc = text "initIfaceCheck" <+> doc,
                         if_rec_types = rec_types
                     }
       initTcRnIf 'i' hsc_env gbl_env () do_this
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 4870ce4..aa5f83f 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -891,7 +891,7 @@ abiHash strs = do
   mods <- mapM find_it strs
 
   let get_iface modl = loadUserInterface False (text "abiHash") modl
-  ifaces <- initIfaceCheck hsc_env $ mapM get_iface mods
+  ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods
 
   bh <- openBinMem (3*1024) -- just less than a block
   put_ bh hiVersion



More information about the ghc-commits mailing list