diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-03-26 17:32:43 +0000 |
---|---|---|
committer | Sebastian Graf <sgraf1337@gmail.com> | 2022-01-03 18:11:33 +0000 |
commit | 0139b77a8236f12d59a35b22b5be1440c8a53736 (patch) | |
tree | cd19be38ed2fca99ca0937ab0318ab0570085f6f | |
parent | f212cece72b4be2750afa0f71f833f4b0190383a (diff) | |
download | haskell-wip/T19569.tar.gz |
Experimental patch inlining dictionary applicationswip/T19569
See #19569 for more details.
-rw-r--r-- | compiler/GHC/Core/Type.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Core/Utils.hs | 3 |
2 files changed, 10 insertions, 1 deletions
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 85cc635791..035fcb2f35 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -55,6 +55,7 @@ module GHC.Core.Type ( splitForAllTyCoVar_maybe, splitForAllTyCoVar, splitForAllTyVar_maybe, splitForAllCoVar_maybe, splitPiTy_maybe, splitPiTy, splitPiTys, + allTypeOrInvisArgs, mkTyConBindersPreferAnon, mkPiTy, mkPiTys, piResultTy, piResultTys, @@ -2154,6 +2155,13 @@ splitInvisPiTysN n ty = split n ty ty [] = split (n-1) res res (Anon InvisArg (Scaled mult arg) : bs) | otherwise = (reverse bs, orig_ty) +allTypeOrInvisArgs :: Arity -> Type -> Bool +allTypeOrInvisArgs 0 _ = True +allTypeOrInvisArgs n ty | Just ty' <- coreView ty = allTypeOrInvisArgs n ty' +allTypeOrInvisArgs n (ForAllTy _ ty) = allTypeOrInvisArgs n ty +allTypeOrInvisArgs n (FunTy { ft_af = InvisArg, ft_res = res }) = allTypeOrInvisArgs (n-1) res +allTypeOrInvisArgs _ _ = False + -- | Given a 'TyCon' and a list of argument types, filter out any invisible -- (i.e., 'Inferred' or 'Specified') arguments. filterOutInvisibleTypes :: TyCon -> [Type] -> [Type] diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index 2df35f01ea..16cc9a6af8 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -1396,7 +1396,8 @@ isWorkFreeApp fn n_val_args | otherwise = case idDetails fn of DataConWorkId {} -> True - _ -> False + _ -> allTypeOrInvisArgs n_val_args (idType fn) + -- Experimental: see #19569 isCheapApp :: CheapAppFun isCheapApp fn n_val_args |