[commit: ghc] wip/spj-early-inline2: More tracing in SpecConstr (0e83753)

[git at git.haskell.org]

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

On branch  : wip/spj-early-inline2
Link       : http://ghc.haskell.org/trac/ghc/changeset/0e8375372bf830459dd4aeaa7159a72b582d5b64/ghc

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

commit 0e8375372bf830459dd4aeaa7159a72b582d5b64
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Feb 9 09:35:19 2017 +0000

    More tracing in SpecConstr


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

0e8375372bf830459dd4aeaa7159a72b582d5b64
 compiler/specialise/SpecConstr.hs | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs
index 15c031b..8a3e227 100644
--- a/compiler/specialise/SpecConstr.hs
+++ b/compiler/specialise/SpecConstr.hs
@@ -1346,7 +1346,8 @@ scTopBind env body_usage (Rec prs)
   , not force_spec
   , not (all (couldBeSmallEnoughToInline (sc_dflags env) threshold) rhss)
                 -- No specialisation
-  = do  { (rhs_usgs, rhss')   <- mapAndUnzipM (scExpr env) rhss
+  = -- pprTrace "scTopBind: nospec" (ppr bndrs) $
+    do  { (rhs_usgs, rhss')   <- mapAndUnzipM (scExpr env) rhss
         ; return (body_usage `combineUsage` combineUsages rhs_usgs, Rec (bndrs `zip` rhss')) }
 
   | otherwise   -- Do specialisation
@@ -1469,7 +1470,10 @@ specRec top_lvl env body_usg rhs_infos
     -- Loop, specialising, until you get no new specialisations
     go seed_calls usg_so_far spec_infos
       | isEmptyVarEnv seed_calls
-      = return (usg_so_far, spec_infos)
+      = -- pprTrace "specRec" (vcat [ ppr (map ri_fn rhs_infos)
+        --                         , ppr seed_calls
+        --                         , ppr body_usg ]) $
+        return (usg_so_far, spec_infos)
       | otherwise
       = do  { specs_w_usg <- zipWithM (specialise env seed_calls) rhs_infos spec_infos
             ; let (extra_usg_s, new_spec_infos) = unzip specs_w_usg
@@ -1499,11 +1503,13 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs
                spec_info@(SI specs spec_count mb_unspec)
   | isBottomingId fn      -- Note [Do not specialise diverging functions]
                           -- and do not generate specialisation seeds from its RHS
-  = return (nullUsage, spec_info)
+  = -- pprTrace "specialise bot" (ppr fn) $
+    return (nullUsage, spec_info)
 
   | isNeverActive (idInlineActivation fn) -- See Note [Transfer activation]
     || null arg_bndrs                     -- Only specialise functions
-  = case mb_unspec of    -- Behave as if there was a single, boring call
+  = -- pprTrace "specialise inactive" (ppr fn) $
+    case mb_unspec of    -- Behave as if there was a single, boring call
       Just rhs_usg -> return (rhs_usg, SI specs spec_count Nothing)
                          -- See Note [spec_usg includes rhs_usg]
       Nothing      -> return (nullUsage, spec_info)