diff options
| -rw-r--r-- | compiler/GHC/Types/Id/Make.hs | 23 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T5366.stdout | 4 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T7360.stderr | 10 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_compile/T16029.stdout | 5 |
4 files changed, 25 insertions, 17 deletions
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs index 4c2f028360..fe672f6143 100644 --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -696,7 +696,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con = return NoDataConRep | otherwise - = do { wrap_args <- mapM newLocal wrap_arg_tys + = do { wrap_args <- mapM (newLocal (fsLit "conrep")) wrap_arg_tys ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers) initial_wrap_app @@ -986,10 +986,15 @@ case of a newtype constructor, we simply hardcode its dcr_bangs field to -} ------------------------- -newLocal :: Scaled Type -> UniqSM Var -newLocal (Scaled w ty) = do { uniq <- getUniqueM - ; return (mkSysLocalOrCoVar (fsLit "dt") uniq w ty) } - -- We should not have "OrCoVar" here, this is a bug (#17545) + +-- | Conjure a fresh local binder. +newLocal :: FastString -- ^ a string which will form part of the 'Var'\'s name + -> Scaled Type -- ^ the type of the 'Var' + -> UniqSM Var +newLocal name_stem (Scaled w ty) = + do { uniq <- getUniqueM + ; return (mkSysLocalOrCoVar name_stem uniq w ty) } + -- We should not have "OrCoVar" here, this is a bug (#17545) -- | Unpack/Strictness decisions from source module. @@ -1072,14 +1077,14 @@ wrapCo :: Coercion -> Type -> (Unboxer, Boxer) -> (Unboxer, Boxer) wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty = (unboxer, boxer) where - unboxer arg_id = do { rep_id <- newLocal (Scaled (idMult arg_id) rep_ty) + unboxer arg_id = do { rep_id <- newLocal (fsLit "cowrap_unbx") (Scaled (idMult arg_id) rep_ty) ; (rep_ids, rep_fn) <- unbox_rep rep_id ; let co_bind = NonRec rep_id (Var arg_id `Cast` co) ; return (rep_ids, Let co_bind . rep_fn) } boxer = Boxer $ \ subst -> do { (rep_ids, rep_expr) <- case box_rep of - UnitBox -> do { rep_id <- newLocal (linear $ TcType.substTy subst rep_ty) + UnitBox -> do { rep_id <- newLocal (fsLit "cowrap_bx") (linear $ TcType.substTy subst rep_ty) ; return ([rep_id], Var rep_id) } Boxer boxer -> boxer subst ; let sco = substCoUnchecked subst co @@ -1112,7 +1117,7 @@ dataConArgUnpack (Scaled arg_mult arg_ty) -- Note [Unpacking GADTs and existentials] ( rep_tys `zip` dataConRepStrictness con ,( \ arg_id -> - do { rep_ids <- mapM newLocal rep_tys + do { rep_ids <- mapM (newLocal (fsLit "unbx")) rep_tys ; let r_mult = idMult arg_id ; let rep_ids' = map (scaleIdBy r_mult) rep_ids ; let unbox_fn body @@ -1120,7 +1125,7 @@ dataConArgUnpack (Scaled arg_mult arg_ty) (DataAlt con) rep_ids' body ; return (rep_ids, unbox_fn) } , Boxer $ \ subst -> - do { rep_ids <- mapM (newLocal . TcType.substScaledTyUnchecked subst) rep_tys + do { rep_ids <- mapM (newLocal (fsLit "bx") . TcType.substScaledTyUnchecked subst) rep_tys ; return (rep_ids, Var (dataConWorkId con) `mkTyApps` (substTysUnchecked subst tc_args) `mkVarApps` rep_ids ) } ) ) diff --git a/testsuite/tests/simplCore/should_compile/T5366.stdout b/testsuite/tests/simplCore/should_compile/T5366.stdout index 92fed9ddda..f2f58ea97f 100644 --- a/testsuite/tests/simplCore/should_compile/T5366.stdout +++ b/testsuite/tests/simplCore/should_compile/T5366.stdout @@ -1,2 +1,2 @@ - case ds of { Bar dt [Occ=Once1] _ [Occ=Dead] -> GHC.Types.I# dt }}] -f = \ (ds :: Bar) -> case ds of { Bar dt dt1 -> GHC.Types.I# dt } + case ds of { Bar bx [Occ=Once1] _ [Occ=Dead] -> GHC.Types.I# bx }}] +f = \ (ds :: Bar) -> case ds of { Bar bx bx1 -> GHC.Types.I# bx } diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index 070d7ef7fe..6b6438bf14 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -13,11 +13,13 @@ T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) - Tmpl= \ (dt [Occ=Once1!] :: Int) -> - case dt of { GHC.Types.I# dt [Occ=Once1] -> T7360.Foo3 dt }}] + Tmpl= \ (conrep [Occ=Once1!] :: Int) -> + case conrep of { GHC.Types.I# unbx [Occ=Once1] -> + T7360.Foo3 unbx + }}] T7360.$WFoo3 - = \ (dt [Occ=Once1!] :: Int) -> - case dt of { GHC.Types.I# dt [Occ=Once1] -> T7360.Foo3 dt } + = \ (conrep [Occ=Once1!] :: Int) -> + case conrep of { GHC.Types.I# unbx [Occ=Once1] -> T7360.Foo3 unbx } -- RHS size: {terms: 5, types: 2, coercions: 0, joins: 0/0} fun1 [InlPrag=NOINLINE] :: Foo -> () diff --git a/testsuite/tests/stranal/should_compile/T16029.stdout b/testsuite/tests/stranal/should_compile/T16029.stdout index 76bf2617fb..20861eac28 100644 --- a/testsuite/tests/stranal/should_compile/T16029.stdout +++ b/testsuite/tests/stranal/should_compile/T16029.stdout @@ -1,6 +1,7 @@ :: Int %1 -> Int %1 -> T - Tmpl= \ (dt [Occ=Once1!] :: Int) (dt [Occ=Once1!] :: Int) -> - = \ (dt [Occ=Once1!] :: Int) (dt [Occ=Once1!] :: Int) -> + Tmpl= \ (conrep [Occ=Once1!] :: Int) + (conrep [Occ=Once1!] :: Int) -> + = \ (conrep [Occ=Once1!] :: Int) (conrep [Occ=Once1!] :: Int) -> :: GHC.Prim.Int# -> GHC.Prim.Int# = \ (ww :: GHC.Prim.Int#) -> g2 [InlPrag=[2]] :: T -> Int -> Int |