Safe Haskell | None |
---|---|
Language | GHC2021 |
Types used through-out pattern match checking. This module is mostly there to be imported from GHC.HsToCore.Types. The exposed API is that of GHC.HsToCore.Pmc.
These types model the paper Lower Your Guards: A Compositional Pattern-Match Coverage Checker".
Synopsis
- newtype SrcInfo = SrcInfo (Located SDoc)
- data PmGrd
- = PmCon {
- pm_id :: !Id
- pm_con_con :: !PmAltCon
- pm_con_tvs :: ![TyVar]
- pm_con_dicts :: ![EvVar]
- pm_con_args :: ![Id]
- | PmBang { }
- | PmLet {
- pm_id :: !Id
- _pm_let_expr :: !CoreExpr
- = PmCon {
- data GrdDag
- consGrdDag :: PmGrd -> GrdDag -> GrdDag
- gdSeq :: GrdDag -> GrdDag -> GrdDag
- sequencePmGrds :: [PmGrd] -> GrdDag
- sequenceGrdDags :: [GrdDag] -> GrdDag
- alternativesGrdDags :: NonEmpty GrdDag -> GrdDag
- newtype PmMatchGroup p = PmMatchGroup (NonEmpty (PmMatch p))
- data PmMatch p = PmMatch {}
- data PmGRHSs p = PmGRHSs {}
- data PmGRHS p = PmGRHS {}
- newtype PmPatBind p = PmPatBind (PmGRHS p)
- newtype PmEmptyCase = PmEmptyCase {}
- data PmRecSel v = PmRecSel {
- pr_arg_var :: v
- pr_arg :: CoreExpr
- pr_cons :: [ConLike]
- data RedSets = RedSets {}
- data Precision
- data CheckResult a = CheckResult {}
- type Pre = GrdDag
- type Post = RedSets
- module GHC.HsToCore.Pmc.Solver.Types
LYG syntax
Guard language
Means by which we identify a source construct for later pretty-printing in
a warning message. SDoc
for the equation to show, Located
for the
location.
Instances
A very simple language for pattern guards. Let bindings, bang patterns, and matching variables against flat constructor patterns. The LYG guard language.
PmCon |
|
| |
PmBang |
|
PmLet |
|
|
Instances
Outputable PmGrd Source # | Should not be user-facing. |
A series-parallel graph of PmGrd
s, so very nearly a guard tree, if
it weren't for or-patterns/GdAlt
!
The implicit "source" corresponds to "before the match" and the implicit
"sink" corresponds to "after a successful match".
GdEnd
is aGrdDag
that always matches.GdOne
is aGrdDag
that matches iff itsPmGrd
matches.
corresponds to matching guardsGdSeq
g1 g2g1
and theng2
if matchingg1
succeeded. Example: The Haskell guard| x > 1, x < 10 = ...
will testx > 1
beforex < 10
, failing if either test fails.
is far less common thanGdAlt
g1 g2GdSeq
and corresponds to matching an or-pattern(LT; EQ)
, succeeding if the match variable matches eitherLT
orEQ
. See Note [Implementation of OrPatterns] for a larger example.
Instances
Outputable GrdDag Source # | Format LYG guards as |
Guard tree language
newtype PmMatchGroup p Source #
A guard tree denoting MatchGroup
.
PmMatchGroup (NonEmpty (PmMatch p)) |
Instances
Outputable p => Outputable (PmMatchGroup p) Source # | |
Defined in GHC.HsToCore.Pmc.Types ppr :: PmMatchGroup p -> SDoc Source # |
A guard tree denoting Match
: A payload describing the pats and a bunch of
GRHS.
Instances
Outputable p => Outputable (PmMatch p) Source # | |
A guard tree denoting GRHSs
: A bunch of PmLet
guards for local
bindings from the GRHSs
s where
clauses and the actual list of GRHS
.
See Note [Long-distance information for HsLocalBinds] in
GHC.HsToCore.Pmc.Desugar.
Instances
Outputable p => Outputable (PmGRHSs p) Source # | |
A guard tree denoting GRHS
: A payload describing the grds and a SrcInfo
useful for printing out in warnings messages.
Instances
Outputable p => Outputable (PmGRHS p) Source # | |
A guard tree denoting a pattern binding.
Instances
Outputable p => Outputable (PmPatBind p) Source # | |
newtype PmEmptyCase Source #
A guard tree denoting an -XEmptyCase.
Instances
Outputable PmEmptyCase Source # | |
Defined in GHC.HsToCore.Pmc.Types ppr :: PmEmptyCase -> SDoc Source # |
Coverage Checking types
Redundancy sets, used to determine redundancy of RHSs and bang patterns
(later digested into a CIRB
).
RedSets | |
|
Instances
data CheckResult a Source #
Pattern-match coverage check result
CheckResult | |
|
Instances
Functor CheckResult Source # | |
Defined in GHC.HsToCore.Pmc.Types fmap :: (a -> b) -> CheckResult a -> CheckResult b # (<$) :: a -> CheckResult b -> CheckResult a # | |
Outputable a => Outputable (CheckResult a) Source # | |
Defined in GHC.HsToCore.Pmc.Types ppr :: CheckResult a -> SDoc Source # |