blob: 950d4aa42a7a04be274c3b0fd41d095374978d1e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
{-# LANGUAGE ExistentialQuantification #-}
module GHC.HsToCore.Errors.Types where
import Data.Typeable
import GHC.Prelude
import GHC.Core (CoreRule, CoreExpr, RuleName)
import GHC.Core.DataCon
import GHC.Core.Type
import GHC.Driver.Session
import GHC.Hs
import GHC.HsToCore.Pmc.Solver.Types
import GHC.Tc.Errors.Types (LevityCheckProvenance)
import GHC.Types.Basic (Activation)
import GHC.Types.Error
import GHC.Types.ForeignCall
import GHC.Types.Id
import GHC.Types.Name (Name)
import GHC.Utils.Outputable
import qualified GHC.LanguageExtensions as LangExt
newtype MinBound = MinBound Integer
newtype MaxBound = MaxBound Integer
type MaxUncoveredPatterns = Int
type MaxPmCheckModels = Int
-- | Diagnostics messages emitted during desugaring.
data DsMessage
-- | Simply wraps a generic 'Diagnostic' message.
= forall a. (Diagnostic a, Typeable a) => DsUnknownMessage a
{-| DsEmptyEnumeration is a warning (controlled by the -Wempty-enumerations flag) that is
emitted if an enumeration is empty.
Example(s):
main :: IO ()
main = do
let enum = [5 .. 3]
print enum
Here 'enum' would yield an empty list, because 5 is greater than 3.
Test case(s):
warnings/should_compile/T10930
warnings/should_compile/T18402
warnings/should_compile/T10930b
numeric/should_compile/T10929
numeric/should_compile/T7881
deSugar/should_run/T18172
-}
| DsEmptyEnumeration
{-| DsIdentitiesFound is a warning (controlled by the -Widentities flag) that is
emitted on uses of Prelude numeric conversions that are probably the identity
(and hence could be omitted).
Example(s):
main :: IO ()
main = do
let x = 10
print $ conv 10
where
conv :: Int -> Int
conv x = fromIntegral x
Here calling 'conv' is essentially the identity function, and therefore can be omitted.
Test case(s):
deSugar/should_compile/T4488
-}
| DsIdentitiesFound !Id -- The conversion function
!Type -- The type of conversion
| DsOverflowedLiterals !Integer
!Name
!(Maybe (MinBound, MaxBound))
!NegLiteralExtEnabled
-- FIXME(adn) Use a proper type instead of 'SDoc', but unfortunately
-- 'SrcInfo' gives us an 'SDoc' to begin with.
| DsRedundantBangPatterns !(HsMatchContext GhcRn) !SDoc
-- FIXME(adn) Use a proper type instead of 'SDoc', but unfortunately
-- 'SrcInfo' gives us an 'SDoc' to begin with.
| DsOverlappingPatterns !(HsMatchContext GhcRn) !SDoc
-- FIXME(adn) Use a proper type instead of 'SDoc'
| DsInaccessibleRhs !(HsMatchContext GhcRn) !SDoc
| DsMaxPmCheckModelsReached !MaxPmCheckModels
| DsNonExhaustivePatterns !(HsMatchContext GhcRn)
!ExhaustivityCheckType
!MaxUncoveredPatterns
[Id]
[Nabla]
| DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc)
| DsUselessSpecialiseForClassMethodSelector !Id
| DsUselessSpecialiseForNoInlineFunction !Id
| DsMultiplicityCoercionsNotSupported
| DsOrphanRule !CoreRule
| DsRuleLhsTooComplicated !CoreExpr !CoreExpr
| DsRuleIgnoredDueToConstructor !DataCon
| DsRuleBindersNotBound ![Var]
-- ^ The list of unbound binders
![Var]
-- ^ The original binders
!CoreExpr
-- ^ The original LHS
!CoreExpr
-- ^ The optimised LHS
| DsMultipleConForNewtype [LocatedN Name]
| DsLazyPatCantBindVarsOfUnliftedType [Var]
| DsNotYetHandledByTH !ThRejectionReason
| DsAggregatedViewExpressions [[LHsExpr GhcTc]]
| DsUnbangedStrictPatterns !(HsBindLR GhcTc GhcTc)
| DsCannotMixPolyAndUnliftedBindings !(HsBindLR GhcTc GhcTc)
| DsInvalidInstantiationDictAtType !Type
| DsWrongDoBind !(LHsExpr GhcTc) !Type
| DsUnusedDoBind !(LHsExpr GhcTc) !Type
| DsRecBindsNotAllowedForUnliftedTys ![LHsBindLR GhcTc GhcTc]
-- NOTE(adn) The first argument is an opaque 'expr' with an
-- 'Outputable' constraint because this messages is emitted from
-- 'GHC.HsToCore.Expr.checkLevPolyArgs' which gets passed a polymorphic
-- 'Outputable' type.
| forall expr. Outputable expr => DsCannotUseFunWithPolyArgs !expr !Type ![Type]
| DsRuleMightInlineFirst !RuleName !Var !Activation
| DsAnotherRuleMightFireFirst !RuleName
!RuleName -- the \"bad\" rule
!Var
| DsLevityPolyInExpr !CoreExpr !LevityExprProvenance
| DsLevityPolyInType !Type !LevityCheckProvenance
-- The positional number of the argument for an expression (first, second, third, etc)
newtype DsArgNum = DsArgNum Int
-- | Where the levity checking for the expression originated
data LevityExprProvenance
= LevityCheckHsExpr !(HsExpr GhcTc)
| LevityCheckWpFun !SDoc -- FIXME(adn) Alas 'WpFun' gives us an SDoc here.
| LevityCheckInSyntaxExpr !DsArgNum !(HsExpr GhcTc)
-- | Why TemplateHaskell rejected the splice. Used in the 'DsNotYetHandledByTH'
-- constructor of a 'DsMessage'.
data ThRejectionReason
= ThAmbiguousRecordUpdates !(HsRecUpdField GhcRn)
| ThAbstractClosedTypeFamily !(LFamilyDecl GhcRn)
| ThForeignLabel !CLabelString
| ThForeignExport !(LForeignDecl GhcRn)
| ThMinimalPragmas
| ThSCCPragmas
| ThNoUserInline
| ThExoticFormOfType !(HsType GhcRn)
| ThAmbiguousRecordSelectors !(HsExpr GhcRn)
| ThMonadComprehensionSyntax !(HsExpr GhcRn)
| ThCostCentres !(HsExpr GhcRn)
| ThExpressionForm !(HsExpr GhcRn)
| ThExoticStatement [Stmt GhcRn (LHsExpr GhcRn)]
| ThExoticLiteral !(HsLit GhcRn)
| ThExoticPattern !(Pat GhcRn)
| ThGuardedLambdas !(Match GhcRn (LHsExpr GhcRn))
| ThNegativeOverloadedPatterns !(Pat GhcRn)
| ThHaddockDocumentation
| ThWarningAndDeprecationPragmas [LIdP GhcRn]
| ThDefaultDeclarations !(DefaultDecl GhcRn)
| ThSplicesWithinDeclBrackets
data NegLiteralExtEnabled
= YesUsingNegLiterals
| NotUsingNegLiterals
negLiteralExtEnabled :: DynFlags -> NegLiteralExtEnabled
negLiteralExtEnabled dflags =
if (xopt LangExt.NegativeLiterals dflags) then YesUsingNegLiterals else NotUsingNegLiterals
newtype ExhaustivityCheckType = ExhaustivityCheckType (Maybe WarningFlag)
data BindsType
= UnliftedTypeBinds
| StrictBinds
|
