diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-02-23 13:59:21 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-02-23 17:26:44 -0500 |
| commit | 39d926cd353f203c6dfa2c106179946fa2615d45 (patch) | |
| tree | 3c99f34d90fee20cddf4e0cf239bd5588d40b3fb | |
| parent | 12e21d35ee1b77f5f2bb8bd747848f07a32d592f (diff) | |
| download | haskell-39d926cd353f203c6dfa2c106179946fa2615d45.tar.gz | |
More tracing in SpecConstr
Reviewers: austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D3179
| -rw-r--r-- | compiler/specialise/SpecConstr.hs | 14 |
1 files changed, 10 insertions, 4 deletions
diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs index 15c031bd3f..8a3e227c94 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) |