summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2021-03-26 17:32:43 +0000
committerSebastian Graf <sgraf1337@gmail.com>2022-01-03 18:11:33 +0000
commit0139b77a8236f12d59a35b22b5be1440c8a53736 (patch)
treecd19be38ed2fca99ca0937ab0318ab0570085f6f
parentf212cece72b4be2750afa0f71f833f4b0190383a (diff)
downloadhaskell-wip/T19569.tar.gz
Experimental patch inlining dictionary applicationswip/T19569
See #19569 for more details.
-rw-r--r--compiler/GHC/Core/Type.hs8
-rw-r--r--compiler/GHC/Core/Utils.hs3
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