Inherit the ForceSpecConstr flag in non-recursive nested bindings

[ghc-hetmet.git] / compiler / specialise / SpecConstr.lhs

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index cbe1c0b..3c84d3a 100644 (file)
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -452,6 +452,10 @@ sc_force to True when calling specLoop. This flag does three things:
   * Specialise even for arguments that are not scrutinised in the loop
         (see argToPat; Trac #4488)
 
+This flag is inherited for nested non-recursive bindings (which are likely to
+be join points and hence should be fully specialised) but reset for nested
+recursive bindings.
+
 What alternatives did I consider? Annotating the loop itself doesn't
 work because (a) it is local and (b) it will be w/w'ed and I having
 w/w propagating annotation somehow doesn't seem like a good idea. The
@@ -1041,11 +1045,9 @@ scExpr' env (Let (NonRec bndr rhs) body)
 
        ; (body_usg, body') <- scExpr body_env3 body
 
-          -- NB: We don't use the ForceSpecConstr mechanism (see
-          -- Note [Forcing specialisation]) for non-recursive bindings
-          -- at the moment. I'm not sure if this is the right thing to do.
-       ; let env' = scForce env False
-       ; (spec_usg, specs) <- specialise env'
+          -- NB: For non-recursive bindings we inherit sc_force flag from
+          -- the parent function (see Note [Forcing specialisation])
+       ; (spec_usg, specs) <- specialise env
                                           (scu_calls body_usg) 
                                          rhs_info
                                           (SI [] 0 (Just rhs_usg))
@@ -1549,6 +1551,9 @@ argToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ
 -}
 
 argToPat env in_scope val_env (Cast arg co) arg_occ
+  | isIdentityCoercion co     -- Substitution in the SpecConstr itself
+                              -- can lead to identity coercions
+  = argToPat env in_scope val_env arg arg_occ
   | not (ignoreType env ty2)
   = do { (interesting, arg') <- argToPat env in_scope val_env arg arg_occ
        ; if not interesting then