| ... |
... |
@@ -1067,7 +1067,13 @@ lintIdOcc in_id nargs |
|
1067
|
1067
|
checkL (idName in_id /= makeStaticName) $
|
|
1068
|
1068
|
text "Found makeStatic nested in an expression"
|
|
1069
|
1069
|
|
|
1070
|
|
- ; checkDeadIdOcc in_id
|
|
|
1070
|
+ -- Occurrences of an Id should never be dead....
|
|
|
1071
|
+ -- except in a couple of special cases
|
|
|
1072
|
+ -- See Note [Dead occurrences]
|
|
|
1073
|
+ ; flags <- getLintFlags
|
|
|
1074
|
+ ; checkL (not (isDeadOcc (idOccInfo in_id))
|
|
|
1075
|
+ || lf_allow_dead_occs flags)
|
|
|
1076
|
+ (text "Occurrence of a dead Id" <+> ppr in_id)
|
|
1071
|
1077
|
|
|
1072
|
1078
|
; case isDataConId_maybe in_id of
|
|
1073
|
1079
|
Nothing -> return ()
|
| ... |
... |
@@ -1078,7 +1084,17 @@ lintIdOcc in_id nargs |
|
1078
|
1084
|
|
|
1079
|
1085
|
; return (out_ty, usage) }
|
|
1080
|
1086
|
|
|
1081
|
|
-
|
|
|
1087
|
+{- Note [Dead occurrences]
|
|
|
1088
|
+~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
1089
|
+An occurrence of an Id whose binder is marked as dead is usually
|
|
|
1090
|
+a mistake. But
|
|
|
1091
|
+ * For the RULE forall a b. f [a,b] = g a
|
|
|
1092
|
+ we mark `b` as dead because it is unused in the body, even though
|
|
|
1093
|
+ it is of course used in the patterns
|
|
|
1094
|
+ * For case patterns... I don't really understand, but it dates back a long way
|
|
|
1095
|
+
|
|
|
1096
|
+We permit these dead occurrences by setting the flag `lf_allow_dead_occs`
|
|
|
1097
|
+-}
|
|
1082
|
1098
|
|
|
1083
|
1099
|
lintCoreFun :: CoreExpr
|
|
1084
|
1100
|
-> Int -- Number of arguments (type or val) being passed
|
| ... |
... |
@@ -1104,17 +1120,6 @@ lintLambda var lintBody = |
|
1104
|
1120
|
do { (body_ty, ue) <- lintBody
|
|
1105
|
1121
|
; ue' <- checkLinearity ue var'
|
|
1106
|
1122
|
; return (mkLamType var' body_ty, ue') }
|
|
1107
|
|
-------------------
|
|
1108
|
|
-checkDeadIdOcc :: Id -> LintM ()
|
|
1109
|
|
--- Occurrences of an Id should never be dead....
|
|
1110
|
|
--- except when we are checking a case pattern
|
|
1111
|
|
-checkDeadIdOcc id
|
|
1112
|
|
- | isDeadOcc (idOccInfo id)
|
|
1113
|
|
- = do { in_case <- inCasePat
|
|
1114
|
|
- ; checkL in_case
|
|
1115
|
|
- (text "Occurrence of a dead Id" <+> ppr id) }
|
|
1116
|
|
- | otherwise
|
|
1117
|
|
- = return ()
|
|
1118
|
1123
|
|
|
1119
|
1124
|
------------------
|
|
1120
|
1125
|
lintJoinBndrType :: OutType -- Type of the body
|
| ... |
... |
@@ -1737,7 +1742,8 @@ lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rh |
|
1737
|
1742
|
-- And now bring the new binders into scope
|
|
1738
|
1743
|
; lintBinders CasePatBind args $ \ args' -> do
|
|
1739
|
1744
|
{ rhs_ue <- lintAltExpr rhs alt_ty
|
|
1740
|
|
- ; rhs_ue' <- addLoc (CasePat alt) $
|
|
|
1745
|
+ ; rhs_ue' <- allowDeadOccs $ -- See Note [Dead occurrences]
|
|
|
1746
|
+ addLoc (CasePat alt) $
|
|
1741
|
1747
|
lintAltBinders rhs_ue case_bndr scrut_ty con_payload_ty
|
|
1742
|
1748
|
(zipEqual multiplicities args')
|
|
1743
|
1749
|
; return $ deleteUE rhs_ue' case_bndr
|
| ... |
... |
@@ -2221,7 +2227,8 @@ lintCoreRule fun fun_ty rule@(Rule { ru_name = name, ru_bndrs = bndrs |
|
2221
|
2227
|
= noMultiplicityChecks $ -- Skip linearity checking for rules
|
|
2222
|
2228
|
-- See Note [Linting linearity]
|
|
2223
|
2229
|
lintBinders LambdaBind bndrs $ \ _ ->
|
|
2224
|
|
- do { (lhs_ty, _) <- lintCoreArgs (fun_ty, zeroUE) args
|
|
|
2230
|
+ do { (lhs_ty, _) <- allowDeadOccs $ -- See Note [Dead occurrences]
|
|
|
2231
|
+ lintCoreArgs (fun_ty, zeroUE) args
|
|
2225
|
2232
|
; (rhs_ty, _) <- case idJoinPointHood fun of
|
|
2226
|
2233
|
JoinPoint join_arity
|
|
2227
|
2234
|
-> do { checkL (args `lengthIs` join_arity) $
|
| ... |
... |
@@ -2999,7 +3006,8 @@ data LintFlags |
|
2999
|
3006
|
, lf_check_linearity :: Bool -- ^ See Note [Linting linearity]
|
|
3000
|
3007
|
, lf_check_fixed_rep :: Bool -- ^ See Note [Checking for representation polymorphism]
|
|
3001
|
3008
|
, lf_check_rubbish_lits :: Bool -- ^ See Note [Checking for rubbish literals]
|
|
3002
|
|
- , lf_allow_weak_joins :: Bool -- ^ See Note [Linting join points with casts or ticks]
|
|
|
3009
|
+ , lf_allow_weak_joins :: Bool -- ^ See Note [Linting join points with casts or ticks]
|
|
|
3010
|
+ , lf_allow_dead_occs :: Bool -- ^ See Note [Dead occurrences]
|
|
3003
|
3011
|
}
|
|
3004
|
3012
|
|
|
3005
|
3013
|
-- See Note [Checking StaticPtrs]
|
| ... |
... |
@@ -3366,6 +3374,10 @@ noMultiplicityChecks :: LintM a -> LintM a |
|
3366
|
3374
|
noMultiplicityChecks =
|
|
3367
|
3375
|
updLintFlags $ \ flags -> flags { lf_check_linearity = False }
|
|
3368
|
3376
|
|
|
|
3377
|
+allowDeadOccs :: LintM a -> LintM a
|
|
|
3378
|
+allowDeadOccs =
|
|
|
3379
|
+ updLintFlags $ \ flags -> flags { lf_allow_dead_occs = True }
|
|
|
3380
|
+
|
|
3369
|
3381
|
getLintFlags :: LintM LintFlags
|
|
3370
|
3382
|
getLintFlags = LintM $ \ env errs -> fromBoxedLResult (Just (le_flags env), errs)
|
|
3371
|
3383
|
|
| ... |
... |
@@ -3429,12 +3441,6 @@ addLoc extra_loc m |
|
3429
|
3441
|
= LintM $ \ env errs ->
|
|
3430
|
3442
|
unLintM m (env { le_loc = extra_loc : le_loc env }) errs
|
|
3431
|
3443
|
|
|
3432
|
|
-inCasePat :: LintM Bool -- A slight hack; see the unique call site
|
|
3433
|
|
-inCasePat = LintM $ \ env errs -> fromBoxedLResult (Just (is_case_pat env), errs)
|
|
3434
|
|
- where
|
|
3435
|
|
- is_case_pat (LE { le_loc = CasePat {} : _ }) = True
|
|
3436
|
|
- is_case_pat _other = False
|
|
3437
|
|
-
|
|
3438
|
3444
|
addInScopeId :: InId -> OutType -> (OutId -> LintM a) -> LintM a
|
|
3439
|
3445
|
-- Unlike addInScopeTyCoVar, this function does no cloning; Ids never get cloned
|
|
3440
|
3446
|
addInScopeId in_id out_ty thing_inside
|