diff options
| author | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2022-05-10 20:00:01 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2022-05-11 08:42:01 +0100 |
| commit | fdd9a3ed60385c46800a1444beb3ca80718acb70 (patch) | |
| tree | 9530312f2a2aceaf2e48fc87dc58536cb40616f1 /compiler | |
| parent | fec3e7aa72bee69ef3a3f363709377990650a5d3 (diff) | |
| download | haskell-wip/T21519.tar.gz | |
Add a missing guard in GHC.HsToCore.Utils.is_flat_prod_patwip/T21519
This missing guard gave rise to #21519.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Core/TyCon.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/HsToCore/Utils.hs | 6 |
2 files changed, 13 insertions, 1 deletions
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs index ab30175cb2..e50751c2a0 100644 --- a/compiler/GHC/Core/TyCon.hs +++ b/compiler/GHC/Core/TyCon.hs @@ -52,6 +52,7 @@ module GHC.Core.TyCon( isPrimTyCon, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, isUnboxedSumTyCon, isPromotedTupleTyCon, + isLiftedAlgTyCon, isTypeSynonymTyCon, mustBeSaturated, isPromotedDataCon, isPromotedDataCon_maybe, @@ -146,6 +147,8 @@ import {-# SOURCE #-} GHC.Core.DataCon ( DataCon, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumDataCon ) +import {-# SOURCE #-} GHC.Core.Type + ( isLiftedTypeKind ) import GHC.Builtin.Uniques ( tyConRepNameUnique , dataConTyRepNameUnique ) @@ -2360,6 +2363,11 @@ isUnboxedSumTyCon (AlgTyCon { algTcRhs = rhs }) = True isUnboxedSumTyCon _ = False +isLiftedAlgTyCon :: TyCon -> Bool +isLiftedAlgTyCon (AlgTyCon { tyConResKind = res_kind }) + = isLiftedTypeKind res_kind +isLiftedAlgTyCon _ = False + -- | Is this the 'TyCon' for a /promoted/ tuple? isPromotedTupleTyCon :: TyCon -> Bool isPromotedTupleTyCon tyCon diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs index be165c80dd..b6725331a1 100644 --- a/compiler/GHC/HsToCore/Utils.hs +++ b/compiler/GHC/HsToCore/Utils.hs @@ -607,6 +607,7 @@ There are two cases. ------ Special case (B) ------- For a pattern that is essentially just a tuple: * A product type, so cannot fail + * Boxed, so that it can be matched lazily * Only one level, so that - generating multiple matches is fine - seq'ing it evaluates the same as matching it @@ -783,6 +784,7 @@ strip_bangs (L _ (BangPat _ p)) = strip_bangs p strip_bangs lp = lp is_flat_prod_lpat :: LPat GhcTc -> Bool +-- Pattern is equivalent to a flat, boxed, lifted tuple is_flat_prod_lpat = is_flat_prod_pat . unLoc is_flat_prod_pat :: Pat GhcTc -> Bool @@ -791,7 +793,9 @@ is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps is_flat_prod_pat (ConPat { pat_con = L _ pcon , pat_args = ps}) | RealDataCon con <- pcon - , Just _ <- tyConSingleDataCon_maybe (dataConTyCon con) + , let tc = dataConTyCon con + , Just _ <- tyConSingleDataCon_maybe tc + , isLiftedAlgTyCon tc = all is_triv_lpat (hsConPatArgs ps) is_flat_prod_pat _ = False |