{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
module GHC.Types.RepType
(
UnaryType, NvUnaryType, isNvUnaryType,
unwrapType,
isVoidTy,
typePrimRep, typePrimRep1,
runtimeRepPrimRep, typePrimRepArgs,
PrimRep(..), primRepToType,
countFunRepArgs, countConRepArgs, tyConPrimRep, tyConPrimRep1,
ubxSumRepType, layoutUbxSum, typeSlotTy, SlotTy (..),
slotPrimRep, primRepSlot
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Types.Basic (Arity, RepArity)
import GHC.Core.DataCon
import GHC.Builtin.Names
import GHC.Core.Coercion
import GHC.Core.TyCon
import GHC.Core.TyCon.RecWalk
import GHC.Core.TyCo.Rep
import GHC.Core.Type
import GHC.Builtin.Types.Prim
import {-# SOURCE #-} GHC.Builtin.Types ( anyTypeOfKind )
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.List (sort)
import qualified Data.IntSet as IS
type NvUnaryType = Type
type UnaryType = Type
isNvUnaryType :: Type -> Bool
isNvUnaryType :: Type -> Bool
isNvUnaryType Type
ty
| [PrimRep
_] <- HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep Type
ty
= Bool
True
| Bool
otherwise
= Bool
False
typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep]
typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep]
typePrimRepArgs Type
ty
| [] <- [PrimRep]
reps
= [PrimRep
VoidRep]
| Bool
otherwise
= [PrimRep]
reps
where
reps :: [PrimRep]
reps = HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep Type
ty
unwrapType :: Type -> Type
unwrapType :: Type -> Type
unwrapType Type
ty
| Just (()
_, Type
unwrapped)
<- NormaliseStepper () -> (() -> () -> ()) -> Type -> Maybe ((), Type)
forall ev.
NormaliseStepper ev -> (ev -> ev -> ev) -> Type -> Maybe (ev, Type)
topNormaliseTypeX NormaliseStepper ()
stepper () -> () -> ()
forall a. Monoid a => a -> a -> a
mappend Type
inner_ty
= Type
unwrapped
| Bool
otherwise
= Type
inner_ty
where
inner_ty :: Type
inner_ty = Type -> Type
go Type
ty
go :: Type -> Type
go Type
t | Just Type
t' <- Type -> Maybe Type
coreView Type
t = Type -> Type
go Type
t'
go (ForAllTy TyCoVarBinder
_ Type
t) = Type -> Type
go Type
t
go (CastTy Type
t KindCoercion
_) = Type -> Type
go Type
t
go Type
t = Type
t
stepper :: NormaliseStepper ()
stepper RecTcChecker
rec_nts TyCon
tc [Type]
tys
| Just (Type
ty', KindCoercion
_) <- TyCon -> [Type] -> Maybe (Type, KindCoercion)
instNewTyCon_maybe TyCon
tc [Type]
tys
= case RecTcChecker -> TyCon -> Maybe RecTcChecker
checkRecTc RecTcChecker
rec_nts TyCon
tc of
Just RecTcChecker
rec_nts' -> RecTcChecker -> Type -> () -> NormaliseStepResult ()
forall ev. RecTcChecker -> Type -> ev -> NormaliseStepResult ev
NS_Step RecTcChecker
rec_nts' (Type -> Type
go Type
ty') ()
Maybe RecTcChecker
Nothing -> NormaliseStepResult ()
forall ev. NormaliseStepResult ev
NS_Abort
| Bool
otherwise
= NormaliseStepResult ()
forall ev. NormaliseStepResult ev
NS_Done
countFunRepArgs :: Arity -> Type -> RepArity
countFunRepArgs :: Int -> Type -> Int
countFunRepArgs Int
0 Type
_
= Int
0
countFunRepArgs Int
n Type
ty
| FunTy AnonArgFlag
_ Type
_ Type
arg Type
res <- Type -> Type
unwrapType Type
ty
= [PrimRep] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRepArgs Type
arg) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Type -> Int
countFunRepArgs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Type
res
| Bool
otherwise
= String -> SDoc -> Int
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"countFunRepArgs: arity greater than type can handle" ((Int, Type, [PrimRep]) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int
n, Type
ty, HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep Type
ty))
countConRepArgs :: DataCon -> RepArity
countConRepArgs :: DataCon -> Int
countConRepArgs DataCon
dc = Int -> Type -> Int
go (DataCon -> Int
dataConRepArity DataCon
dc) (DataCon -> Type
dataConRepType DataCon
dc)
where
go :: Arity -> Type -> RepArity
go :: Int -> Type -> Int
go Int
0 Type
_
= Int
0
go Int
n Type
ty
| FunTy AnonArgFlag
_ Type
_ Type
arg Type
res <- Type -> Type
unwrapType Type
ty
= [PrimRep] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep Type
arg) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Type -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Type
res
| Bool
otherwise
= String -> SDoc -> Int
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"countConRepArgs: arity greater than type can handle" ((Int, Type, [PrimRep]) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Int
n, Type
ty, HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep Type
ty))
isVoidTy :: Type -> Bool
isVoidTy :: Type -> Bool
isVoidTy = [PrimRep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PrimRep] -> Bool) -> (Type -> [PrimRep]) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep
type SortedSlotTys = [SlotTy]
ubxSumRepType :: [[PrimRep]] -> [SlotTy]
ubxSumRepType :: [[PrimRep]] -> SortedSlotTys
ubxSumRepType [[PrimRep]]
constrs0
| [[PrimRep]]
constrs0 [[PrimRep]] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthLessThan` Int
2
= [SlotTy
WordSlot]
| Bool
otherwise
= let
combine_alts :: [SortedSlotTys]
-> SortedSlotTys
combine_alts :: [SortedSlotTys] -> SortedSlotTys
combine_alts [SortedSlotTys]
constrs = (SortedSlotTys -> SortedSlotTys -> SortedSlotTys)
-> SortedSlotTys -> [SortedSlotTys] -> SortedSlotTys
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge [] [SortedSlotTys]
constrs
merge :: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge :: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge SortedSlotTys
existing_slots []
= SortedSlotTys
existing_slots
merge [] SortedSlotTys
needed_slots
= SortedSlotTys
needed_slots
merge (SlotTy
es : SortedSlotTys
ess) (SlotTy
s : SortedSlotTys
ss)
| Just SlotTy
s' <- SlotTy
s SlotTy -> SlotTy -> Maybe SlotTy
`fitsIn` SlotTy
es
=
SlotTy
s' SlotTy -> SortedSlotTys -> SortedSlotTys
forall a. a -> [a] -> [a]
: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge SortedSlotTys
ess SortedSlotTys
ss
| SlotTy
s SlotTy -> SlotTy -> Bool
forall a. Ord a => a -> a -> Bool
< SlotTy
es
=
SlotTy
s SlotTy -> SortedSlotTys -> SortedSlotTys
forall a. a -> [a] -> [a]
: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge (SlotTy
es SlotTy -> SortedSlotTys -> SortedSlotTys
forall a. a -> [a] -> [a]
: SortedSlotTys
ess) SortedSlotTys
ss
| Bool
otherwise
=
SlotTy
es SlotTy -> SortedSlotTys -> SortedSlotTys
forall a. a -> [a] -> [a]
: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge SortedSlotTys
ess (SlotTy
s SlotTy -> SortedSlotTys -> SortedSlotTys
forall a. a -> [a] -> [a]
: SortedSlotTys
ss)
rep :: [PrimRep] -> SortedSlotTys
rep :: [PrimRep] -> SortedSlotTys
rep [PrimRep]
ty = SortedSlotTys -> SortedSlotTys
forall a. Ord a => [a] -> [a]
sort ((PrimRep -> SlotTy) -> [PrimRep] -> SortedSlotTys
forall a b. (a -> b) -> [a] -> [b]
map PrimRep -> SlotTy
primRepSlot [PrimRep]
ty)
sumRep :: SortedSlotTys
sumRep = SlotTy
WordSlot SlotTy -> SortedSlotTys -> SortedSlotTys
forall a. a -> [a] -> [a]
: [SortedSlotTys] -> SortedSlotTys
combine_alts (([PrimRep] -> SortedSlotTys) -> [[PrimRep]] -> [SortedSlotTys]
forall a b. (a -> b) -> [a] -> [b]
map [PrimRep] -> SortedSlotTys
rep [[PrimRep]]
constrs0)
in
SortedSlotTys
sumRep
layoutUbxSum :: SortedSlotTys
-> [SlotTy]
-> [Int]
layoutUbxSum :: SortedSlotTys -> SortedSlotTys -> [Int]
layoutUbxSum SortedSlotTys
sum_slots0 SortedSlotTys
arg_slots0 =
SortedSlotTys -> IntSet -> [Int]
go SortedSlotTys
arg_slots0 IntSet
IS.empty
where
go :: [SlotTy] -> IS.IntSet -> [Int]
go :: SortedSlotTys -> IntSet -> [Int]
go [] IntSet
_
= []
go (SlotTy
arg : SortedSlotTys
args) IntSet
used
= let slot_idx :: Int
slot_idx = SlotTy -> Int -> SortedSlotTys -> IntSet -> Int
findSlot SlotTy
arg Int
0 SortedSlotTys
sum_slots0 IntSet
used
in Int
slot_idx Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: SortedSlotTys -> IntSet -> [Int]
go SortedSlotTys
args (Int -> IntSet -> IntSet
IS.insert Int
slot_idx IntSet
used)
findSlot :: SlotTy -> Int -> SortedSlotTys -> IS.IntSet -> Int
findSlot :: SlotTy -> Int -> SortedSlotTys -> IntSet -> Int
findSlot SlotTy
arg Int
slot_idx (SlotTy
slot : SortedSlotTys
slots) IntSet
useds
| Bool -> Bool
not (Int -> IntSet -> Bool
IS.member Int
slot_idx IntSet
useds)
, SlotTy -> Maybe SlotTy
forall a. a -> Maybe a
Just SlotTy
slot Maybe SlotTy -> Maybe SlotTy -> Bool
forall a. Eq a => a -> a -> Bool
== SlotTy
arg SlotTy -> SlotTy -> Maybe SlotTy
`fitsIn` SlotTy
slot
= Int
slot_idx
| Bool
otherwise
= SlotTy -> Int -> SortedSlotTys -> IntSet -> Int
findSlot SlotTy
arg (Int
slot_idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) SortedSlotTys
slots IntSet
useds
findSlot SlotTy
_ Int
_ [] IntSet
_
= String -> SDoc -> Int
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"findSlot" (String -> SDoc
text String
"Can't find slot" SDoc -> SDoc -> SDoc
$$ SortedSlotTys -> SDoc
forall a. Outputable a => a -> SDoc
ppr SortedSlotTys
sum_slots0 SDoc -> SDoc -> SDoc
$$ SortedSlotTys -> SDoc
forall a. Outputable a => a -> SDoc
ppr SortedSlotTys
arg_slots0)
data SlotTy = PtrLiftedSlot | PtrUnliftedSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot
deriving (SlotTy -> SlotTy -> Bool
(SlotTy -> SlotTy -> Bool)
-> (SlotTy -> SlotTy -> Bool) -> Eq SlotTy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlotTy -> SlotTy -> Bool
$c/= :: SlotTy -> SlotTy -> Bool
== :: SlotTy -> SlotTy -> Bool
$c== :: SlotTy -> SlotTy -> Bool
Eq, Eq SlotTy
Eq SlotTy
-> (SlotTy -> SlotTy -> Ordering)
-> (SlotTy -> SlotTy -> Bool)
-> (SlotTy -> SlotTy -> Bool)
-> (SlotTy -> SlotTy -> Bool)
-> (SlotTy -> SlotTy -> Bool)
-> (SlotTy -> SlotTy -> SlotTy)
-> (SlotTy -> SlotTy -> SlotTy)
-> Ord SlotTy
SlotTy -> SlotTy -> Bool
SlotTy -> SlotTy -> Ordering
SlotTy -> SlotTy -> SlotTy
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SlotTy -> SlotTy -> SlotTy
$cmin :: SlotTy -> SlotTy -> SlotTy
max :: SlotTy -> SlotTy -> SlotTy
$cmax :: SlotTy -> SlotTy -> SlotTy
>= :: SlotTy -> SlotTy -> Bool
$c>= :: SlotTy -> SlotTy -> Bool
> :: SlotTy -> SlotTy -> Bool
$c> :: SlotTy -> SlotTy -> Bool
<= :: SlotTy -> SlotTy -> Bool
$c<= :: SlotTy -> SlotTy -> Bool
< :: SlotTy -> SlotTy -> Bool
$c< :: SlotTy -> SlotTy -> Bool
compare :: SlotTy -> SlotTy -> Ordering
$ccompare :: SlotTy -> SlotTy -> Ordering
Ord)
instance Outputable SlotTy where
ppr :: SlotTy -> SDoc
ppr SlotTy
PtrLiftedSlot = String -> SDoc
text String
"PtrLiftedSlot"
ppr SlotTy
PtrUnliftedSlot = String -> SDoc
text String
"PtrUnliftedSlot"
ppr SlotTy
Word64Slot = String -> SDoc
text String
"Word64Slot"
ppr SlotTy
WordSlot = String -> SDoc
text String
"WordSlot"
ppr SlotTy
DoubleSlot = String -> SDoc
text String
"DoubleSlot"
ppr SlotTy
FloatSlot = String -> SDoc
text String
"FloatSlot"
typeSlotTy :: UnaryType -> Maybe SlotTy
typeSlotTy :: Type -> Maybe SlotTy
typeSlotTy Type
ty
| Type -> Bool
isVoidTy Type
ty
= Maybe SlotTy
forall a. Maybe a
Nothing
| Bool
otherwise
= SlotTy -> Maybe SlotTy
forall a. a -> Maybe a
Just (PrimRep -> SlotTy
primRepSlot (HasDebugCallStack => Type -> PrimRep
Type -> PrimRep
typePrimRep1 Type
ty))
primRepSlot :: PrimRep -> SlotTy
primRepSlot :: PrimRep -> SlotTy
primRepSlot PrimRep
VoidRep = String -> SDoc -> SlotTy
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"primRepSlot" (String -> SDoc
text String
"No slot for VoidRep")
primRepSlot PrimRep
LiftedRep = SlotTy
PtrLiftedSlot
primRepSlot PrimRep
UnliftedRep = SlotTy
PtrUnliftedSlot
primRepSlot PrimRep
IntRep = SlotTy
WordSlot
primRepSlot PrimRep
Int8Rep = SlotTy
WordSlot
primRepSlot PrimRep
Int16Rep = SlotTy
WordSlot
primRepSlot PrimRep
Int32Rep = SlotTy
WordSlot
primRepSlot PrimRep
Int64Rep = SlotTy
Word64Slot
primRepSlot PrimRep
WordRep = SlotTy
WordSlot
primRepSlot PrimRep
Word8Rep = SlotTy
WordSlot
primRepSlot PrimRep
Word16Rep = SlotTy
WordSlot
primRepSlot PrimRep
Word32Rep = SlotTy
WordSlot
primRepSlot PrimRep
Word64Rep = SlotTy
Word64Slot
primRepSlot PrimRep
AddrRep = SlotTy
WordSlot
primRepSlot PrimRep
FloatRep = SlotTy
FloatSlot
primRepSlot PrimRep
DoubleRep = SlotTy
DoubleSlot
primRepSlot VecRep{} = String -> SDoc -> SlotTy
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"primRepSlot" (String -> SDoc
text String
"No slot for VecRep")
slotPrimRep :: SlotTy -> PrimRep
slotPrimRep :: SlotTy -> PrimRep
slotPrimRep SlotTy
PtrLiftedSlot = PrimRep
LiftedRep
slotPrimRep SlotTy
PtrUnliftedSlot = PrimRep
UnliftedRep
slotPrimRep SlotTy
Word64Slot = PrimRep
Word64Rep
slotPrimRep SlotTy
WordSlot = PrimRep
WordRep
slotPrimRep SlotTy
DoubleSlot = PrimRep
DoubleRep
slotPrimRep SlotTy
FloatSlot = PrimRep
FloatRep
fitsIn :: SlotTy -> SlotTy -> Maybe SlotTy
fitsIn :: SlotTy -> SlotTy -> Maybe SlotTy
fitsIn SlotTy
ty1 SlotTy
ty2
| SlotTy
ty1 SlotTy -> SlotTy -> Bool
forall a. Eq a => a -> a -> Bool
== SlotTy
ty2
= SlotTy -> Maybe SlotTy
forall a. a -> Maybe a
Just SlotTy
ty1
| SlotTy -> Bool
isWordSlot SlotTy
ty1 Bool -> Bool -> Bool
&& SlotTy -> Bool
isWordSlot SlotTy
ty2
= SlotTy -> Maybe SlotTy
forall a. a -> Maybe a
Just (SlotTy -> SlotTy -> SlotTy
forall a. Ord a => a -> a -> a
max SlotTy
ty1 SlotTy
ty2)
| SlotTy -> Bool
isFloatSlot SlotTy
ty1 Bool -> Bool -> Bool
&& SlotTy -> Bool
isFloatSlot SlotTy
ty2
= SlotTy -> Maybe SlotTy
forall a. a -> Maybe a
Just (SlotTy -> SlotTy -> SlotTy
forall a. Ord a => a -> a -> a
max SlotTy
ty1 SlotTy
ty2)
| Bool
otherwise
= Maybe SlotTy
forall a. Maybe a
Nothing
where
isWordSlot :: SlotTy -> Bool
isWordSlot SlotTy
Word64Slot = Bool
True
isWordSlot SlotTy
WordSlot = Bool
True
isWordSlot SlotTy
_ = Bool
False
isFloatSlot :: SlotTy -> Bool
isFloatSlot SlotTy
DoubleSlot = Bool
True
isFloatSlot SlotTy
FloatSlot = Bool
True
isFloatSlot SlotTy
_ = Bool
False
typePrimRep :: HasDebugCallStack => Type -> [PrimRep]
typePrimRep :: HasDebugCallStack => Type -> [PrimRep]
typePrimRep Type
ty = HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
kindPrimRep (String -> SDoc
text String
"typePrimRep" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
parens (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty)))
(HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty)
typePrimRep1 :: HasDebugCallStack => UnaryType -> PrimRep
typePrimRep1 :: HasDebugCallStack => Type -> PrimRep
typePrimRep1 Type
ty = case HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep Type
ty of
[] -> PrimRep
VoidRep
[PrimRep
rep] -> PrimRep
rep
[PrimRep]
_ -> String -> SDoc -> PrimRep
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"typePrimRep1" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
$$ [PrimRep] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Type -> [PrimRep]
Type -> [PrimRep]
typePrimRep Type
ty))
tyConPrimRep :: HasDebugCallStack => TyCon -> [PrimRep]
tyConPrimRep :: HasDebugCallStack => TyCon -> [PrimRep]
tyConPrimRep TyCon
tc
= HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
kindPrimRep (String -> SDoc
text String
"kindRep tc" SDoc -> SDoc -> SDoc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
$$ Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
res_kind)
Type
res_kind
where
res_kind :: Type
res_kind = TyCon -> Type
tyConResKind TyCon
tc
tyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep
tyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep
tyConPrimRep1 TyCon
tc = case HasDebugCallStack => TyCon -> [PrimRep]
TyCon -> [PrimRep]
tyConPrimRep TyCon
tc of
[] -> PrimRep
VoidRep
[PrimRep
rep] -> PrimRep
rep
[PrimRep]
_ -> String -> SDoc -> PrimRep
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConPrimRep1" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
$$ [PrimRep] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => TyCon -> [PrimRep]
TyCon -> [PrimRep]
tyConPrimRep TyCon
tc))
kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep]
kindPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep]
kindPrimRep SDoc
doc Type
ki
| Just Type
ki' <- Type -> Maybe Type
coreView Type
ki
= HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
kindPrimRep SDoc
doc Type
ki'
kindPrimRep SDoc
doc (TyConApp TyCon
typ [Type
runtime_rep])
= ASSERT( typ `hasKey` tYPETyConKey )
HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc Type
runtime_rep
kindPrimRep SDoc
doc Type
ki
= String -> SDoc -> [PrimRep]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"kindPrimRep" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ki SDoc -> SDoc -> SDoc
$$ SDoc
doc)
runtimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep]
runtimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc Type
rr_ty
| Just Type
rr_ty' <- Type -> Maybe Type
coreView Type
rr_ty
= HasDebugCallStack => SDoc -> Type -> [PrimRep]
SDoc -> Type -> [PrimRep]
runtimeRepPrimRep SDoc
doc Type
rr_ty'
| TyConApp TyCon
rr_dc [Type]
args <- Type
rr_ty
, RuntimeRep [Type] -> [PrimRep]
fun <- TyCon -> RuntimeRepInfo
tyConRuntimeRepInfo TyCon
rr_dc
= [Type] -> [PrimRep]
fun [Type]
args
| Bool
otherwise
= String -> SDoc -> [PrimRep]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"runtimeRepPrimRep" (SDoc
doc SDoc -> SDoc -> SDoc
$$ Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rr_ty)
primRepToType :: PrimRep -> Type
primRepToType :: PrimRep -> Type
primRepToType = Type -> Type
anyTypeOfKind (Type -> Type) -> (PrimRep -> Type) -> PrimRep -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
tYPE (Type -> Type) -> (PrimRep -> Type) -> PrimRep -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimRep -> Type
primRepToRuntimeRep