diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2022-06-11 18:17:11 +0200 |
---|---|---|
committer | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2022-06-11 18:17:24 +0200 |
commit | 6873c603c632536f97c8a112f521872946855a3a (patch) | |
tree | 1ff18bc1b024936afe27630cfef1006aaf8a0add | |
parent | 69e72ecda720d10308516366044952ddd6290e7e (diff) | |
download | haskell-wip/virtual-tycon.tar.gz |
-rw-r--r-- | compiler/GHC/Types/RepType.hs | 20 |
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 |