| ... |
... |
@@ -1282,11 +1282,12 @@ simplExprF1 env expr@(Lam {}) cont |
|
1282
|
1282
|
-- NB: countArgs counts all the args (incl type args)
|
|
1283
|
1283
|
-- and likewise drop counts all binders (incl type lambdas)
|
|
1284
|
1284
|
|
|
1285
|
|
-simplExprF1 env (Case scrut bndr _ alts) cont
|
|
|
1285
|
+simplExprF1 env expr@(Case scrut bndr _ alts) cont
|
|
1286
|
1286
|
| not (seCaseCase env) -- See (COC-INV) in Note [sm_case_case: switching off case continuations]
|
|
1287
|
|
- = do { let scrut_out_ty = substTy env (idType bndr)
|
|
1288
|
|
- ; scrut' <- simplExprC env scrut (mkBoringStop scrut_out_ty)
|
|
1289
|
|
- ; rebuildCase (SAF_In, env) scrut' bndr alts cont }
|
|
|
1287
|
+ , (inner, outer) <- splitContArgs cont
|
|
|
1288
|
+ , not (contIsStop outer)
|
|
|
1289
|
+ = do { expr' <- simplExprC env expr inner
|
|
|
1290
|
+ ; rebuild env expr' outer }
|
|
1290
|
1291
|
|
|
1291
|
1292
|
| otherwise
|
|
1292
|
1293
|
= {-#SCC "simplExprF1-Case" #-}
|
| ... |
... |
@@ -1318,11 +1319,19 @@ simplExprF1 env (Let bind body) cont |
|
1318
|
1319
|
| Just bind' <- joinPointBind_maybe bind
|
|
1319
|
1320
|
= simplJoinPointBind env bind' body cont
|
|
1320
|
1321
|
|
|
|
1322
|
+simplExprF1 env expr@(Let {}) cont
|
|
|
1323
|
+ | not (seCaseCase env)
|
|
|
1324
|
+ , (inner, outer) <- splitContArgs cont
|
|
|
1325
|
+ , not (contIsStop outer)
|
|
|
1326
|
+ = do { expr' <- simplExprC env expr inner
|
|
|
1327
|
+ ; rebuild env expr' outer }
|
|
|
1328
|
+
|
|
1321
|
1329
|
-- Non-recursive let
|
|
1322
|
1330
|
simplExprF1 env (Let (NonRec bndr rhs) body) cont
|
|
1323
|
1331
|
= {-#SCC "simplNonRecE" #-}
|
|
1324
|
1332
|
simplNonRecE env FromLet bndr (rhs, env) body cont
|
|
1325
|
1333
|
|
|
|
1334
|
+-- Recursive let
|
|
1326
|
1335
|
simplExprF1 env (Let (Rec pairs) body) cont
|
|
1327
|
1336
|
= {-#SCC "simplRecE" #-}
|
|
1328
|
1337
|
simplRecE env pairs body cont
|