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