| ... |
... |
@@ -1674,7 +1674,10 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs |
|
1674
|
1674
|
return ()
|
|
1675
|
1675
|
-}
|
|
1676
|
1676
|
|
|
1677
|
|
- ; let env' = env { se_subst = subst'' }
|
|
|
1677
|
+ ; let inner_rhs_bndrs = dropList all_call_args rhs_bndrs
|
|
|
1678
|
+ env' = env { se_subst = subst'' }
|
|
|
1679
|
+ (env'', inner_rhs_bndrs') = substBndrs env' inner_rhs_bndrs
|
|
|
1680
|
+
|
|
1678
|
1681
|
all_rules = rules_acc ++ existing_rules
|
|
1679
|
1682
|
-- all_rules: we look both in the rules_acc (generated by this invocation
|
|
1680
|
1683
|
-- of specCalls), and in existing_rules (passed in to specCalls)
|
| ... |
... |
@@ -1684,13 +1687,13 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs |
|
1684
|
1687
|
then return spec_acc
|
|
1685
|
1688
|
else
|
|
1686
|
1689
|
do { -- Run the specialiser on the specialised RHS
|
|
1687
|
|
- (rhs_body', rhs_uds) <- specExpr env' $
|
|
1688
|
|
- mkLams (dropList all_call_args rhs_bndrs) rhs_body
|
|
|
1690
|
+ (rhs_body', rhs_uds) <- specExpr env'' rhs_body
|
|
1689
|
1691
|
|
|
1690
|
1692
|
-- Add the { d1' = dx1; d2' = dx2 } usage stuff
|
|
1691
|
1693
|
-- to the rhs_uds; see Note [Specialising Calls]
|
|
1692
|
|
- ; let (spec_uds, dumped_dbs) = dumpUDs spec_bndrs (dx_binds `consDictBinds` rhs_uds)
|
|
1693
|
|
- spec_rhs = mkLams spec_bndrs $
|
|
|
1694
|
+ ; let all_spec_bndrs = spec_bndrs ++ inner_rhs_bndrs'
|
|
|
1695
|
+ (spec_uds, dumped_dbs) = dumpUDs all_spec_bndrs (dx_binds `consDictBinds` rhs_uds)
|
|
|
1696
|
+ spec_rhs = mkLams all_spec_bndrs $
|
|
1694
|
1697
|
wrapDictBindsE dumped_dbs rhs_body'
|
|
1695
|
1698
|
spec_fn_ty = exprType spec_rhs
|
|
1696
|
1699
|
|