diff options
| author | Sebastian Graf <sebastian.graf@kit.edu> | 2021-08-17 18:50:25 +0200 |
|---|---|---|
| committer | Sebastian Graf <sebastian.graf@kit.edu> | 2021-08-20 13:29:28 +0200 |
| commit | 08f5ec098ce284a00c74e0b7f22d32374fac3155 (patch) | |
| tree | 0ae20d22418bf0154fb805adc40375529cfddb3d /compiler/GHC/HsToCore/Pmc.hs | |
| parent | acb188e0c02a114927d340dac78a68626c659cd3 (diff) | |
| download | haskell-wip/improve-pmc.tar.gz | |
Pmc: Better SCC annotations and trace outputwip/improve-pmc
While investigating #20106, I made a few refactorings to the pattern-match
checker that I don't want to lose. Here are the changes:
* Some key functions of the checker now have SCC annotations
* Better `-ddump-ec-trace` diagnostics for easier debugging. I added
'traceWhenFailPm' to see *why* a particular `MaybeT` computation fails and
made use of it in `instCon`.
I also increased the acceptance threshold of T11545, which seems to fail
randomly lately due to ghc/max flukes.
Diffstat (limited to 'compiler/GHC/HsToCore/Pmc.hs')
| -rw-r--r-- | compiler/GHC/HsToCore/Pmc.hs | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/compiler/GHC/HsToCore/Pmc.hs b/compiler/GHC/HsToCore/Pmc.hs index 04236d54b9..0b2ef7f8cb 100644 --- a/compiler/GHC/HsToCore/Pmc.hs +++ b/compiler/GHC/HsToCore/Pmc.hs @@ -150,7 +150,7 @@ pmcMatches -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. -pmcMatches ctxt vars matches = do +pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do -- We have to force @missing@ before printing out the trace message, -- otherwise we get interleaved output from the solver. This function -- should be strict in @missing@ anyway! @@ -169,10 +169,12 @@ pmcMatches ctxt vars matches = do formatReportWarnings cirbsEmptyCase ctxt vars result return [] Just matches -> do - matches <- noCheckDs $ desugarMatches vars matches - result <- unCA (checkMatchGroup matches) missing + matches <- {-# SCC "desugarMatches" #-} + noCheckDs $ desugarMatches vars matches + result <- {-# SCC "checkMatchGroup" #-} + unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings cirbsMatchGroup ctxt vars result + {-# SCC "formatReportWarnings" #-} formatReportWarnings cirbsMatchGroup ctxt vars result return (NE.toList (ldiMatchGroup (cr_ret result))) {- Note [pmcPatBind only checks PatBindRhs] |