| ... |
... |
@@ -51,7 +51,7 @@ import GHC.HsToCore.Pmc.Utils |
|
51
|
51
|
import GHC.HsToCore.Pmc.Desugar
|
|
52
|
52
|
import GHC.HsToCore.Pmc.Check
|
|
53
|
53
|
import GHC.HsToCore.Pmc.Solver
|
|
54
|
|
-import GHC.Types.Basic (Origin(..), isDoExpansionGenerated)
|
|
|
54
|
+import GHC.Types.Basic (Origin(..))
|
|
55
|
55
|
import GHC.Core
|
|
56
|
56
|
import GHC.Driver.DynFlags
|
|
57
|
57
|
import GHC.Hs
|
| ... |
... |
@@ -68,7 +68,7 @@ import GHC.HsToCore.Monad |
|
68
|
68
|
import GHC.Data.Bag
|
|
69
|
69
|
import GHC.Data.OrdList
|
|
70
|
70
|
|
|
71
|
|
-import Control.Monad (when, unless, forM_)
|
|
|
71
|
+import Control.Monad (when, forM_)
|
|
72
|
72
|
import qualified Data.Semigroup as Semi
|
|
73
|
73
|
import Data.List.NonEmpty ( NonEmpty(..) )
|
|
74
|
74
|
import qualified Data.List.NonEmpty as NE
|
| ... |
... |
@@ -189,12 +189,11 @@ pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do |
|
189
|
189
|
Just matches -> do
|
|
190
|
190
|
matches <- {-# SCC "desugarMatches" #-}
|
|
191
|
191
|
noCheckDs $ desugarMatches vars matches
|
|
192
|
|
- tracePm "desugared matches" (ppr matches)
|
|
|
192
|
+ -- tracePm "desugared matches" (ppr matches)
|
|
193
|
193
|
result <- {-# SCC "checkMatchGroup" #-}
|
|
194
|
194
|
unCA (checkMatchGroup matches) missing
|
|
195
|
195
|
tracePm "}: " (ppr (cr_uncov result))
|
|
196
|
|
- unless (isDoExpansionGenerated origin) -- Do expansion generated code shouldn't emit overlapping warnings
|
|
197
|
|
- ({-# SCC "formatReportWarnings" #-}
|
|
|
196
|
+ ({-# SCC "formatReportWarnings" #-}
|
|
198
|
197
|
formatReportWarnings ReportMatchGroup ctxt vars result)
|
|
199
|
198
|
return (NE.toList (ldiMatchGroup (cr_ret result)))
|
|
200
|
199
|
|
| ... |
... |
@@ -585,18 +584,18 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars |
|
585
|
584
|
approx = precision == Approximate
|
|
586
|
585
|
|
|
587
|
586
|
when (approx && (exists_u || exists_i)) $
|
|
588
|
|
- putSrcSpanDs loc (diagnosticDs (DsMaxPmCheckModelsReached (maxPmCheckModels dflags)))
|
|
|
587
|
+ maybePutSrcSpanDs loc (diagnosticDs (DsMaxPmCheckModelsReached (maxPmCheckModels dflags)))
|
|
589
|
588
|
|
|
590
|
589
|
when exists_b $ forM_ redundant_bangs $ \(SrcInfo (L l q)) ->
|
|
591
|
|
- putSrcSpanDs l (diagnosticDs (DsRedundantBangPatterns kind q))
|
|
|
590
|
+ maybePutSrcSpanDs l (diagnosticDs (DsRedundantBangPatterns kind q))
|
|
592
|
591
|
|
|
593
|
592
|
when exists_r $ forM_ redundant_rhss $ \(SrcInfo (L l q)) ->
|
|
594
|
|
- putSrcSpanDs l (diagnosticDs (DsOverlappingPatterns kind q))
|
|
|
593
|
+ maybePutSrcSpanDs l (diagnosticDs (DsOverlappingPatterns kind q))
|
|
595
|
594
|
when exists_i $ forM_ inaccessible_rhss $ \(SrcInfo (L l q)) ->
|
|
596
|
|
- putSrcSpanDs l (diagnosticDs (DsInaccessibleRhs kind q))
|
|
|
595
|
+ maybePutSrcSpanDs l (diagnosticDs (DsInaccessibleRhs kind q))
|
|
597
|
596
|
|
|
598
|
597
|
when exists_u $
|
|
599
|
|
- putSrcSpanDs loc (diagnosticDs (DsNonExhaustivePatterns kind check_type maxPatterns vars unc_examples))
|
|
|
598
|
+ maybePutSrcSpanDs loc (diagnosticDs (DsNonExhaustivePatterns kind check_type maxPatterns vars unc_examples))
|
|
600
|
599
|
where
|
|
601
|
600
|
flag_i = overlapping dflags kind
|
|
602
|
601
|
flag_u = exhaustive dflags kind
|
| ... |
... |
@@ -608,6 +607,15 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars |
|
608
|
607
|
|
|
609
|
608
|
maxPatterns = maxUncoveredPatterns dflags
|
|
610
|
609
|
|
|
|
610
|
+ -- we only want to report warnings for source constructs and not compiler generated constructors
|
|
|
611
|
+ -- c.f. Typeable1
|
|
|
612
|
+ maybePutSrcSpanDs :: SrcSpan -> DsM () -> DsM ()
|
|
|
613
|
+ maybePutSrcSpanDs l thing_inside =
|
|
|
614
|
+ if isGeneratedSrcSpan l
|
|
|
615
|
+ then return ()
|
|
|
616
|
+ else putSrcSpanDs l thing_inside
|
|
|
617
|
+
|
|
|
618
|
+
|
|
611
|
619
|
getNFirstUncovered :: GenerateInhabitingPatternsMode -> [Id] -> Int -> Nablas -> DsM [Nabla]
|
|
612
|
620
|
getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas)
|
|
613
|
621
|
where
|