Introduce isGcPtrType

And use it to fix getCgIdInfo and get rid of linker errors

compiler/GHC/StgToCmm/Env.hs

@@ -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

compiler/prelude/PrelNames.hs

@@ -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

compiler/stgSyn/CoreToStg.hs

@@ -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

compiler/types/Type.hs

@@ -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