summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-06-11 18:17:11 +0200
committerKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-06-11 18:17:24 +0200
commit6873c603c632536f97c8a112f521872946855a3a (patch)
tree1ff18bc1b024936afe27630cfef1006aaf8a0add
parent69e72ecda720d10308516366044952ddd6290e7e (diff)
downloadhaskell-wip/virtual-tycon.tar.gz
-rw-r--r--compiler/GHC/Types/RepType.hs20
1 files changed, 20 insertions, 0 deletions
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index 2c0d93afb5..5d2f3beb65 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -22,6 +22,7 @@ module GHC.Types.RepType
ubxSumRepType, layoutUbxSum, typeSlotTy, SlotTy (..),
slotPrimRep, primRepSlot,
+ isVirtualTyCon,
) where
import GHC.Prelude
@@ -674,3 +675,22 @@ primRepToRuntimeRep rep = case rep of
-- See also Note [RuntimeRep and PrimRep]
primRepToType :: PrimRep -> Type
primRepToType = anyTypeOfKind . mkTYPEapp . primRepToRuntimeRep
+
+isVirtualTyCon :: TyCon -> Bool
+isVirtualTyCon tc
+ -- Exactly one constructor
+ | [dc] <- tyConDataCons tc
+ -- No constraints (TODO: maybe allow equalities? Do we have to check dataConEqSpec?)
+ , [] <- filter (not . isZeroBitTy) (dataConOtherTheta dc)
+ -- There's an exactly one non-void field
+ , [(field, strictness)] <- filter (not . isZeroBitTy . fst) $
+ zipWithEqual "isVirtualTyCon" (\a b -> (scaledThing a, b))
+ (dataConOrigArgTys dc) (dataConImplBangs dc)
+ -- That field is boxed
+ , isBoxedType field
+ -- That field is either unlifted or strict
+ , isUnliftedType field || (case strictness of HsStrict -> True; _ -> False)
+ -- Result is boxed
+ , isBoxedType (dataConOrigResTy dc)
+ = True
+isVirtualTyCon _ = False