diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2021-06-15 08:41:46 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-07-29 13:13:21 -0400 |
| commit | 4d5b4ed24ef8cecd7b74d1a3d54f443e1216b22d (patch) | |
| tree | f37d973e1e414e53527750f5cf3fa70767e4bd89 /compiler/GHC | |
| parent | e6731578246b6e6959026d4a9da9971b097c83aa (diff) | |
| download | haskell-4d5b4ed24ef8cecd7b74d1a3d54f443e1216b22d.tar.gz | |
compiler: Name generated locals more descriptively
Previously `GHC.Types.Id.Make.newLocal` would name all locals `dt`,
making it unnecessarily difficult to determine their origin.
Noticed while looking at #19557.
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Types/Id/Make.hs | 23 |
1 files changed, 14 insertions, 9 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 ) } ) ) |