[commit: ghc] wip/T10613: SpecConstr: Transport strictness annotation to specialization’s argument’s binders (8649ac6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T10613
Link       : http://ghc.haskell.org/trac/ghc/changeset/8649ac61698c8600f5db64ff7947828bb4715a5d/ghc

>---------------------------------------------------------------

commit 8649ac61698c8600f5db64ff7947828bb4715a5d
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Mar 22 15:39:06 2016 +0100

    SpecConstr: Transport strictness annotation to specialization’s argument’s binders
    
    This is a result of the discussion in ticket:11731#comment:9.


>---------------------------------------------------------------

8649ac61698c8600f5db64ff7947828bb4715a5d
 compiler/specialise/SpecConstr.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs
index 10d5614..46fda8e 100644
--- a/compiler/specialise/SpecConstr.hs
+++ b/compiler/specialise/SpecConstr.hs
@@ -1648,12 +1648,19 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number)
                              `setIdStrictness` spec_str
                              `setIdArity` count isId spec_lam_args
               spec_str   = calcSpecStrictness fn spec_lam_args pats
+
+
                 -- Conditionally use result of new worker-wrapper transform
               (spec_lam_args, spec_call_args) = mkWorkerArgs (sc_dflags env) qvars NoOneShotInfo body_ty
                 -- Usual w/w hack to avoid generating
                 -- a spec_rhs of unlifted type and no args
 
-              spec_rhs   = mkLams spec_lam_args spec_body
+              spec_lam_args_str = zipWith setIdDemandInfo spec_lam_args $
+                fst (splitStrictSig spec_str) ++ repeat topDmd
+                -- Annotate the variables with the strictness information from
+                -- the function
+
+              spec_rhs   = mkLams spec_lam_args_str spec_body
               body_ty    = exprType spec_body
               rule_rhs   = mkVarApps (Var spec_id) spec_call_args
               inline_act = idInlineActivation fn