Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T12618
Link : http://ghc.haskell.org/trac/ghc/changeset/f10cbcb7aab88b38ce1dc17568af4454abf624ae/ghc
>---------------------------------------------------------------
commit f10cbcb7aab88b38ce1dc17568af4454abf624ae
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Tue Oct 4 14:10:09 2016 -0400
mkDataConRep: Do not interleave applying arguments and unboxers
in preparation to using ConApp in the data con wrapper (where this is
not possible).
>---------------------------------------------------------------
f10cbcb7aab88b38ce1dc17568af4454abf624ae
compiler/basicTypes/MkId.hs | 17 +++++++++--------
1 file changed, 9 insertions(+), 8 deletions(-)
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 8b48aa9..ac07cfd 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -480,8 +480,8 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
| otherwise
= do { wrap_args <- mapM newLocal wrap_arg_tys
- ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers)
- initial_wrap_app
+ ; (rep_ids, unbox_fn) <- combine_unboxers (wrap_args `zip` dropList eq_spec unboxers)
+ ; let wrap_body = unbox_fn $ mkVarApps initial_wrap_app rep_ids
; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info
wrap_info = noCafIdInfo
@@ -581,13 +581,14 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) }
go _ (_:_) [] = pprPanic "mk_boxer" (ppr data_con)
- mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr
- mk_rep_app [] con_app
- = return con_app
- mk_rep_app ((wrap_arg, unboxer) : prs) con_app
+ combine_unboxers :: [(Id,Unboxer)] -> UniqSM ([Id],CoreExpr -> CoreExpr)
+ combine_unboxers []
+ = return ([],id)
+ combine_unboxers ((wrap_arg, unboxer) : other_unboxers)
= do { (rep_ids, unbox_fn) <- unboxer wrap_arg
- ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)
- ; return (unbox_fn expr) }
+ ; (other_rep_ids, other_unbox_fn) <- combine_unboxers other_unboxers
+ ; return (rep_ids ++ other_rep_ids, unbox_fn . other_unbox_fn)
+ }
{-
Note [Bangs on imported data constructors]