[commit: ghc] wip/T12618: DataCon wrapper: Use ConApp in the body (b486662)
git at git.haskell.org
git at git.haskell.org
Thu Oct 6 23:20:31 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T12618
Link : http://ghc.haskell.org/trac/ghc/changeset/b486662d3c75ef8a1c96d2d29f8e5ca547c23c25/ghc
>---------------------------------------------------------------
commit b486662d3c75ef8a1c96d2d29f8e5ca547c23c25
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Tue Oct 4 14:20:05 2016 -0400
DataCon wrapper: Use ConApp in the body
>---------------------------------------------------------------
b486662d3c75ef8a1c96d2d29f8e5ca547c23c25
compiler/basicTypes/MkId.hs | 19 +++++++++++--------
1 file changed, 11 insertions(+), 8 deletions(-)
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index ac07cfd..2267a47 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -481,7 +481,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
| otherwise
= do { wrap_args <- mapM newLocal wrap_arg_tys
; (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_body = unbox_fn $ build_con_app rep_ids
; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info
wrap_info = noCafIdInfo
@@ -557,10 +557,12 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
|| isFamInstTyCon tycon -- Cast result
|| (not $ null eq_spec)) -- GADT
- initial_wrap_app = Var (dataConWorkId data_con)
- `mkTyApps` res_ty_args
- `mkVarApps` ex_tvs
- `mkCoApps` map (mkReflCo Nominal . eqSpecType) eq_spec
+ build_con_app rep_ids = mkConApp data_con $ concat
+ [ map Type res_ty_args
+ , map (Type . mkTyVarTy) ex_tvs
+ , map (Coercion . mkReflCo Nominal . eqSpecType) eq_spec
+ , map Var rep_ids
+ ]
mk_boxer :: [Boxer] -> DataConBoxer
mk_boxer boxers = DCB (\ ty_args src_vars ->
@@ -734,9 +736,10 @@ dataConArgUnpack arg_ty
; return (rep_ids, unbox_fn) }
, Boxer $ \ subst ->
do { rep_ids <- mapM (newLocal . TcType.substTyUnchecked subst) rep_tys
- ; return (rep_ids, Var (dataConWorkId con)
- `mkTyApps` (substTysUnchecked subst tc_args)
- `mkVarApps` rep_ids ) } ) )
+ ; return (rep_ids, ConApp con (
+ map Type (substTysUnchecked subst tc_args) ++
+ map Var rep_ids))
+ }))
| otherwise
= pprPanic "dataConArgUnpack" (ppr arg_ty)
-- An interface file specified Unpacked, but we couldn't unpack it
More information about the ghc-commits
mailing list