| ... |
... |
@@ -292,7 +292,8 @@ simplRecOrTopPair env bind_cxt old_bndr new_bndr rhs |
|
292
|
292
|
|
|
293
|
293
|
BC_Let top_lvl is_rec -> simplTrace "SimplBind:normal" (ppr old_bndr) $
|
|
294
|
294
|
simplLazyBind top_lvl is_rec
|
|
295
|
|
- (old_bndr,env) (new_bndr,env) (rhs,env)
|
|
|
295
|
+ (old_bndr,env) (new_bndr,env)
|
|
|
296
|
+ (rhs,env,MRefl)
|
|
296
|
297
|
|
|
297
|
298
|
simplTrace :: String -> SDoc -> SimplM a -> SimplM a
|
|
298
|
299
|
simplTrace herald doc thing_inside = do
|
| ... |
... |
@@ -307,11 +308,11 @@ simplLazyBind :: TopLevelFlag -> RecFlag |
|
307
|
308
|
-> (OutId, SimplEnv) -- OutBinder, and SimplEnv after simplifying that binder
|
|
308
|
309
|
-- The OutId has IdInfo (notably RULES),
|
|
309
|
310
|
-- except arity, unfolding
|
|
310
|
|
- -> (InExpr, SimplEnv) -- The RHS and its static environment
|
|
|
311
|
+ -> (InExpr, SimplEnv, MOutCoercion) -- The RHS and its static environment
|
|
311
|
312
|
-> SimplM (SimplFloats, SimplEnv)
|
|
312
|
313
|
-- Precondition: Ids only, no TyVars; not a JoinId
|
|
313
|
314
|
-- Precondition: rhs obeys the let-can-float invariant
|
|
314
|
|
-simplLazyBind top_lvl is_rec (bndr,unf_se) (bndr1,env) (rhs,rhs_se)
|
|
|
315
|
+simplLazyBind top_lvl is_rec (bndr,unf_se) (bndr1,env) (rhs,rhs_se,mco)
|
|
315
|
316
|
= assert (isId bndr )
|
|
316
|
317
|
assertPpr (not (isJoinId bndr)) (ppr bndr) $
|
|
317
|
318
|
-- pprTrace "simplLazyBind" ((ppr bndr <+> ppr bndr1) $$ ppr rhs $$ ppr (seIdSubst rhs_se)) $
|
| ... |
... |
@@ -364,7 +365,9 @@ simplLazyBind top_lvl is_rec (bndr,unf_se) (bndr1,env) (rhs,rhs_se) |
|
364
|
365
|
|
|
365
|
366
|
; let env1 = env `setInScopeFromF` rhs_floats
|
|
366
|
367
|
; rhs' <- rebuildLam env1 tvs' body3 rhs_cont
|
|
367
|
|
- ; (bind_float, env2) <- completeBind (BC_Let top_lvl is_rec) (bndr,unf_se) (bndr1,rhs',env1)
|
|
|
368
|
+ ; (bind_float, env2) <- completeBind (BC_Let top_lvl is_rec)
|
|
|
369
|
+ (bndr, unf_se)
|
|
|
370
|
+ (bndr1, mkCastMCo rhs' mco, env1)
|
|
368
|
371
|
; return (rhs_floats `addFloats` bind_float, env2) }
|
|
369
|
372
|
|
|
370
|
373
|
--------------------------
|
| ... |
... |
@@ -1875,7 +1878,7 @@ simplNonRecE env from_what bndr (ContEx rhs_se rhs mco) body cont |
|
1875
|
1878
|
= do { (env1, bndr1) <- simplNonRecBndr env bndr
|
|
1876
|
1879
|
; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive)
|
|
1877
|
1880
|
; (floats1, env3) <- simplLazyBind NotTopLevel NonRecursive
|
|
1878
|
|
- (bndr,env) (bndr2,env2) (rhs,rhs_se)
|
|
|
1881
|
+ (bndr,env) (bndr2,env2) (rhs,rhs_se,mco)
|
|
1879
|
1882
|
; (floats2, expr') <- simplNonRecBody env3 from_what body cont
|
|
1880
|
1883
|
; return (floats1 `addFloats` floats2, expr') }
|
|
1881
|
1884
|
|
| ... |
... |
@@ -2243,7 +2246,7 @@ simplCloArg :: SimplEnvIS -- ^ Used only for its InScopeSet |
|
2243
|
2246
|
-- continuation passed to 'simplExprC'
|
|
2244
|
2247
|
-> SimplClo
|
|
2245
|
2248
|
-> SimplM OutExpr
|
|
2246
|
|
-simplCloArg env fun_ty mb_arg_info clo@(ContEx arg_se arg mco)
|
|
|
2249
|
+simplCloArg env fun_ty mb_arg_info (ContEx arg_se arg mco)
|
|
2247
|
2250
|
= simplExprC arg_env arg (pushCastCont mco stop)
|
|
2248
|
2251
|
where
|
|
2249
|
2252
|
arg_env = arg_se `setInScopeFromE` env
|