| ... |
... |
@@ -109,7 +109,7 @@ import GHC.Core.Lint ( lintMessage ) |
|
109
|
109
|
import GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isMarkedCbv )
|
|
110
|
110
|
import GHC.Types.CostCentre ( isCurrentCCS )
|
|
111
|
111
|
import GHC.Types.Id
|
|
112
|
|
-import GHC.Types.Literal ( isLitRubbish )
|
|
|
112
|
+import GHC.Types.Literal ( Literal, isLitRubbish )
|
|
113
|
113
|
import GHC.Types.Var.Set
|
|
114
|
114
|
import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom )
|
|
115
|
115
|
import GHC.Types.RepType
|
| ... |
... |
@@ -186,7 +186,7 @@ lintStgConArg arg = do |
|
186
|
186
|
text "Its PrimReps are: " <> ppr badRep
|
|
187
|
187
|
|
|
188
|
188
|
case arg of
|
|
189
|
|
- StgLitArg _ -> pure ()
|
|
|
189
|
+ StgLitArg l -> lintStgLit l
|
|
190
|
190
|
StgVarArg v -> lintStgVar v
|
|
191
|
191
|
|
|
192
|
192
|
lintStgFunArg :: StgArg -> LintM ()
|
| ... |
... |
@@ -201,7 +201,7 @@ lintStgFunArg arg = do |
|
201
|
201
|
text "Its PrimReps are: " <> ppr badRep
|
|
202
|
202
|
|
|
203
|
203
|
case arg of
|
|
204
|
|
- StgLitArg _ -> pure ()
|
|
|
204
|
+ StgLitArg l -> lintStgLit l
|
|
205
|
205
|
StgVarArg v -> lintStgVar v
|
|
206
|
206
|
|
|
207
|
207
|
lintStgVar :: Id -> LintM ()
|
| ... |
... |
@@ -275,9 +275,7 @@ lintStgRhs rhs@(StgRhsCon _ con _ _ args _) = do |
|
275
|
275
|
|
|
276
|
276
|
lintStgExpr :: (OutputablePass a, BinderP a ~ Id) => GenStgExpr a -> LintM ()
|
|
277
|
277
|
|
|
278
|
|
-lintStgExpr (StgLit lit)
|
|
279
|
|
- | isLitRubbish lit = addErrL (hang (text "Found rubbish literal:") 2 (ppr lit))
|
|
280
|
|
- | otherwise = return ()
|
|
|
278
|
+lintStgExpr (StgLit lit) = lintStgLit lit
|
|
281
|
279
|
|
|
282
|
280
|
lintStgExpr e@(StgApp fun args) = do
|
|
283
|
281
|
lintStgVar fun
|
| ... |
... |
@@ -285,8 +283,6 @@ lintStgExpr e@(StgApp fun args) = do |
|
285
|
283
|
lintAppCbvMarks e
|
|
286
|
284
|
lintStgAppReps fun args
|
|
287
|
285
|
|
|
288
|
|
-
|
|
289
|
|
-
|
|
290
|
286
|
lintStgExpr app@(StgConApp con _n args _arg_tys) = do
|
|
291
|
287
|
-- unboxed sums should vanish during unarise
|
|
292
|
288
|
lf <- getLintFlags
|
| ... |
... |
@@ -324,6 +320,11 @@ lintStgExpr (StgCase scrut bndr alts_type alts) = do |
|
324
|
320
|
|
|
325
|
321
|
addInScopeVars [bndr | in_scope] (mapM_ lintAlt alts)
|
|
326
|
322
|
|
|
|
323
|
+lintStgLit :: Literal -> LintM ()
|
|
|
324
|
+lintStgLit lit
|
|
|
325
|
+ | isLitRubbish lit = addErrL (hang (text "Found rubbish literal:") 2 (ppr lit))
|
|
|
326
|
+ | otherwise = return ()
|
|
|
327
|
+
|
|
327
|
328
|
lintAlt
|
|
328
|
329
|
:: (OutputablePass a, BinderP a ~ Id)
|
|
329
|
330
|
=> GenStgAlt a -> LintM ()
|