Commit fc4e2a03 authored by Sebastian Graf's avatar Sebastian Graf
Browse files

Introduce isGcPtrType

And use it to fix getCgIdInfo and get rid of linker errors
parent 5856e92c
Pipeline #13078 canceled with stages
in 10 minutes and 33 seconds
......@@ -34,7 +34,7 @@ import GHC.StgToCmm.Closure
import CLabel
import BlockId
import CmmExpr
import CmmExpr hiding (isGcPtrType) -- we want the one from Type
import CmmUtils
import DynFlags
import Id
......@@ -131,12 +131,15 @@ getCgIdInfo id
let name = idName id
; if isExternalName name then
let ext_lbl
| isUnliftedType (idType id) =
| isGcPtrType (idType id)
= mkClosureLabel name $ idCafInfo id
| isUnliftedType (idType id)
-- An unlifted external Id must refer to a top-level
-- string literal. See Note [Bytes label] in CLabel.
ASSERT( idType id `eqType` addrPrimTy )
mkBytesLabel name
| otherwise = mkClosureLabel name $ idCafInfo id
= ASSERT( idType id `eqType` addrPrimTy )
mkBytesLabel name
| otherwise
= pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id))
in return $
litIdInfo dflags id (mkLFImported id) (CmmLabel ext_lbl)
else
......
......@@ -2022,11 +2022,12 @@ sumRepDataConKey = mkPreludeDataConUnique 73
-- See Note [Wiring in RuntimeRep] in TysWiredIn
runtimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique]
liftedRepDataConKey :: Unique
runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys)
liftedRepDataConKey, unliftedRepDataConKey :: Unique
runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedRepDataConKey : unliftedSimpleRepDataConKeys)
= map mkPreludeDataConUnique [74..88]
unliftedRepDataConKeys = vecRepDataConKey :
unliftedRepDataConKeys = unliftedRepDataConKey :
vecRepDataConKey :
tupleRepDataConKey :
sumRepDataConKey :
unliftedSimpleRepDataConKeys
......
......@@ -465,7 +465,7 @@ mkStgAltType bndr alts
| otherwise
= case prim_reps of
[rep] | rep == LiftedRep || rep == UnliftedRep ->
[rep] | isGcPtrRep rep ->
case tyConAppTyCon_maybe (unwrapType bndr_ty) of
Just tc
| isAbstractTyCon tc -> look_for_better_tycon
......@@ -473,7 +473,7 @@ mkStgAltType bndr alts
| otherwise -> ASSERT2( _is_poly_alt_tycon tc, ppr tc )
PolyAlt
Nothing -> PolyAlt
[non_gcd_ptr] -> PrimAlt non_gcd_ptr
[non_gcd] -> PrimAlt non_gcd
not_unary -> MultiValAlt (length not_unary)
where
bndr_ty = idType bndr
......
......@@ -114,9 +114,9 @@ module Type (
-- *** Levity and boxity
isLiftedType_maybe,
isLiftedTypeKind, isUnliftedTypeKind,
isLiftedRuntimeRep, isUnliftedRuntimeRep,
isUnliftedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
isLiftedTypeKind, isUnliftedTypeKind, isGcPtrTypeKind,
isLiftedRuntimeRep, isUnliftedRuntimeRep, isGcPtrRuntimeRep,
isUnliftedType, isGcPtrType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
isAlgType, isDataFamilyAppType,
isPrimitiveType, isStrictType,
isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,
......@@ -536,6 +536,26 @@ isUnliftedRuntimeRep rep
| otherwise {- Variables, applications -}
= False
-- | Returns True if the kind classifies types which are allocated on the
-- Haskell heap and False otherwise. Note that this returns False for
-- levity-polymorphic kinds, which may be specialized to a kind that classifies
-- AddrRep or even unboxed kinds.
isGcPtrTypeKind :: Kind -> Bool
isGcPtrTypeKind kind
= case kindRep_maybe kind of
Just rep -> isGcPtrRuntimeRep rep
Nothing -> False
isGcPtrRuntimeRep :: Type -> Bool
-- True <=> LiftedRep or UnliftedRep, which are represented by pointers to the
-- Haskell heap
isGcPtrRuntimeRep rep
| Just rep' <- coreView rep = isGcPtrRuntimeRep rep'
| TyConApp rr_tc _ <- rep
= rr_tc `hasKey` liftedRepDataConKey || rr_tc `hasKey` unliftedRepDataConKey
| otherwise
= False
-- | Is this the type 'RuntimeRep'?
isRuntimeRepTy :: Type -> Bool
isRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty'
......@@ -1982,6 +2002,13 @@ mightBeUnliftedType ty
Just is_lifted -> not is_lifted
Nothing -> True
-- | See "Type#type_classification" for what an unlifted type is.
-- Panics on levity polymorphic types; See 'mightBeUnliftedType' for
-- a more approximate predicate that behaves better in the presence of
-- levity polymorphism.
isGcPtrType :: Type -> Bool
isGcPtrType ty = isGcPtrRuntimeRep (getRuntimeRep ty)
-- | Is this a type of kind RuntimeRep? (e.g. LiftedRep)
isRuntimeRepKindedTy :: Type -> Bool
isRuntimeRepKindedTy = isRuntimeRepTy . typeKind
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment