{-# LANGUAGE FlexibleContexts #-}
module GHC.Types.RepType
(
UnaryType, NvUnaryType, isNvUnaryType,
unwrapType,
isZeroBitTy,
typePrimRep, typePrimRep1,
runtimeRepPrimRep, typePrimRepArgs,
PrimRep(..), primRepToRuntimeRep, primRepToType,
countFunRepArgs, countConRepArgs, dataConRuntimeRepStrictness,
tyConPrimRep, tyConPrimRep1,
runtimeRepPrimRep_maybe, kindPrimRep_maybe, typePrimRep_maybe,
ubxSumRepType, layoutUbxSum, typeSlotTy, SlotTy (..),
slotPrimRep, primRepSlot,
mightBeFunTy
) where
import GHC.Prelude
import GHC.Types.Basic (Arity, RepArity)
import GHC.Core.DataCon
import GHC.Core.Coercion
import GHC.Core.TyCon
import GHC.Core.TyCon.RecWalk
import GHC.Core.TyCo.Rep
import GHC.Core.Type
import {-# SOURCE #-} GHC.Builtin.Types ( anyTypeOfKind
, vecRepDataConTyCon
, liftedRepTy, unliftedRepTy, zeroBitRepTy
, intRepDataConTy
, int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy
, wordRepDataConTy
, word16RepDataConTy, word8RepDataConTy, word32RepDataConTy, word64RepDataConTy
, addrRepDataConTy
, floatRepDataConTy, doubleRepDataConTy
, vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy
, vec64DataConTy
, int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy
, int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy
, word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
, doubleElemRepDataConTy )
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.List.NonEmpty (NonEmpty (..))
import Data.List (sort)
import qualified Data.IntSet as IS
type NvUnaryType = Type
type UnaryType = Type
isNvUnaryType :: Type -> Bool
isNvUnaryType :: UnaryType -> Bool
isNvUnaryType UnaryType
ty
| [PrimRep
_] <- HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty
= Bool
True
| Bool
otherwise
= Bool
False
typePrimRepArgs :: HasDebugCallStack => Type -> [PrimRep]
typePrimRepArgs :: HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRepArgs UnaryType
ty
| [] <- [PrimRep]
reps
= [PrimRep
VoidRep]
| Bool
otherwise
= [PrimRep]
reps
where
reps :: [PrimRep]
reps = HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty
unwrapType :: Type -> Type
unwrapType :: UnaryType -> UnaryType
unwrapType UnaryType
ty
| Just (()
_, UnaryType
unwrapped)
<- forall ev.
NormaliseStepper ev
-> (ev -> ev -> ev) -> UnaryType -> Maybe (ev, UnaryType)
topNormaliseTypeX RecTcChecker -> TyCon -> [UnaryType] -> NormaliseStepResult ()
stepper forall a. Monoid a => a -> a -> a
mappend UnaryType
inner_ty
= UnaryType
unwrapped
| Bool
otherwise
= UnaryType
inner_ty
where
inner_ty :: UnaryType
inner_ty = UnaryType -> UnaryType
go UnaryType
ty
go :: UnaryType -> UnaryType
go UnaryType
t | Just UnaryType
t' <- UnaryType -> Maybe UnaryType
coreView UnaryType
t = UnaryType -> UnaryType
go UnaryType
t'
go (ForAllTy ForAllTyBinder
_ UnaryType
t) = UnaryType -> UnaryType
go UnaryType
t
go (CastTy UnaryType
t KindCoercion
_) = UnaryType -> UnaryType
go UnaryType
t
go UnaryType
t = UnaryType
t
stepper :: RecTcChecker -> TyCon -> [UnaryType] -> NormaliseStepResult ()
stepper RecTcChecker
rec_nts TyCon
tc [UnaryType]
tys
| Just (UnaryType
ty', KindCoercion
_) <- TyCon -> [UnaryType] -> Maybe (UnaryType, KindCoercion)
instNewTyCon_maybe TyCon
tc [UnaryType]
tys
= case RecTcChecker -> TyCon -> Maybe RecTcChecker
checkRecTc RecTcChecker
rec_nts TyCon
tc of
Just RecTcChecker
rec_nts' -> forall ev.
RecTcChecker -> UnaryType -> ev -> NormaliseStepResult ev
NS_Step RecTcChecker
rec_nts' (UnaryType -> UnaryType
go UnaryType
ty') ()
Maybe RecTcChecker
Nothing -> forall ev. NormaliseStepResult ev
NS_Abort
| Bool
otherwise
= forall ev. NormaliseStepResult ev
NS_Done
countFunRepArgs :: Arity -> Type -> RepArity
countFunRepArgs :: Int -> UnaryType -> Int
countFunRepArgs Int
0 UnaryType
_
= Int
0
countFunRepArgs Int
n UnaryType
ty
| FunTy FunTyFlag
_ UnaryType
_ UnaryType
arg UnaryType
res <- UnaryType -> UnaryType
unwrapType UnaryType
ty
= forall (t :: * -> *) a. Foldable t => t a -> Int
length (HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRepArgs UnaryType
arg) forall a. Num a => a -> a -> a
+ Int -> UnaryType -> Int
countFunRepArgs (Int
n forall a. Num a => a -> a -> a
- Int
1) UnaryType
res
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"countFunRepArgs: arity greater than type can handle" (forall a. Outputable a => a -> SDoc
ppr (Int
n, UnaryType
ty, HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty))
countConRepArgs :: DataCon -> RepArity
countConRepArgs :: DataCon -> Int
countConRepArgs DataCon
dc = Int -> UnaryType -> Int
go (DataCon -> Int
dataConRepArity DataCon
dc) (DataCon -> UnaryType
dataConRepType DataCon
dc)
where
go :: Arity -> Type -> RepArity
go :: Int -> UnaryType -> Int
go Int
0 UnaryType
_
= Int
0
go Int
n UnaryType
ty
| FunTy FunTyFlag
_ UnaryType
_ UnaryType
arg UnaryType
res <- UnaryType -> UnaryType
unwrapType UnaryType
ty
= forall (t :: * -> *) a. Foldable t => t a -> Int
length (HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
arg) forall a. Num a => a -> a -> a
+ Int -> UnaryType -> Int
go (Int
n forall a. Num a => a -> a -> a
- Int
1) UnaryType
res
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"countConRepArgs: arity greater than type can handle" (forall a. Outputable a => a -> SDoc
ppr (Int
n, UnaryType
ty, HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty))
dataConRuntimeRepStrictness :: HasDebugCallStack => DataCon -> [StrictnessMark]
dataConRuntimeRepStrictness :: HasDebugCallStack => DataCon -> [StrictnessMark]
dataConRuntimeRepStrictness DataCon
dc =
let repMarks :: [StrictnessMark]
repMarks = DataCon -> [StrictnessMark]
dataConRepStrictness DataCon
dc
repTys :: [UnaryType]
repTys = forall a b. (a -> b) -> [a] -> [b]
map forall a. Scaled a -> a
irrelevantMult forall a b. (a -> b) -> a -> b
$ DataCon -> [Scaled UnaryType]
dataConRepArgTys DataCon
dc
in
[StrictnessMark]
-> [UnaryType] -> [StrictnessMark] -> [StrictnessMark]
go [StrictnessMark]
repMarks [UnaryType]
repTys []
where
go :: [StrictnessMark]
-> [UnaryType] -> [StrictnessMark] -> [StrictnessMark]
go (StrictnessMark
mark:[StrictnessMark]
marks) (UnaryType
ty:[UnaryType]
types) [StrictnessMark]
out_marks
|
(HasDebugCallStack => UnaryType -> Bool
isZeroBitTy UnaryType
ty)
= [StrictnessMark]
-> [UnaryType] -> [StrictnessMark] -> [StrictnessMark]
go [StrictnessMark]
marks [UnaryType]
types [StrictnessMark]
out_marks
| [PrimRep
_] <- [PrimRep]
reps
= [StrictnessMark]
-> [UnaryType] -> [StrictnessMark] -> [StrictnessMark]
go [StrictnessMark]
marks [UnaryType]
types (StrictnessMark
markforall a. a -> [a] -> [a]
:[StrictnessMark]
out_marks)
| Bool
otherwise
= [StrictnessMark]
-> [UnaryType] -> [StrictnessMark] -> [StrictnessMark]
go [StrictnessMark]
marks [UnaryType]
types ((forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [PrimRep]
real_reps) StrictnessMark
NotMarkedStrict)forall a. [a] -> [a] -> [a]
++[StrictnessMark]
out_marks)
where
reps :: [PrimRep]
reps = HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty
real_reps :: [PrimRep]
real_reps = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimRep -> Bool
isVoidRep) forall a b. (a -> b) -> a -> b
$ [PrimRep]
reps
go [] [] [StrictnessMark]
out_marks = forall a. [a] -> [a]
reverse [StrictnessMark]
out_marks
go [StrictnessMark]
_m [UnaryType]
_t [StrictnessMark]
_o = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"dataConRuntimeRepStrictness2" (forall a. Outputable a => a -> SDoc
ppr DataCon
dc forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr [StrictnessMark]
_m forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr [UnaryType]
_t forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr [StrictnessMark]
_o)
isZeroBitTy :: HasDebugCallStack => Type -> Bool
isZeroBitTy :: HasDebugCallStack => UnaryType -> Bool
isZeroBitTy = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep
type SortedSlotTys = [SlotTy]
ubxSumRepType :: [[PrimRep]] -> NonEmpty SlotTy
ubxSumRepType :: [[PrimRep]] -> NonEmpty SlotTy
ubxSumRepType [[PrimRep]]
constrs0
| [[PrimRep]]
constrs0 forall a. [a] -> Int -> Bool
`lengthLessThan` Int
2
= SlotTy
WordSlot forall a. a -> [a] -> NonEmpty a
:| []
| Bool
otherwise
= let
combine_alts :: [SortedSlotTys]
-> SortedSlotTys
combine_alts :: [SortedSlotTys] -> SortedSlotTys
combine_alts [SortedSlotTys]
constrs = 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' forall a. a -> [a] -> [a]
: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge SortedSlotTys
ess SortedSlotTys
ss
| SlotTy
s forall a. Ord a => a -> a -> Bool
< SlotTy
es
=
SlotTy
s forall a. a -> [a] -> [a]
: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge (SlotTy
es forall a. a -> [a] -> [a]
: SortedSlotTys
ess) SortedSlotTys
ss
| Bool
otherwise
=
SlotTy
es forall a. a -> [a] -> [a]
: SortedSlotTys -> SortedSlotTys -> SortedSlotTys
merge SortedSlotTys
ess (SlotTy
s forall a. a -> [a] -> [a]
: SortedSlotTys
ss)
rep :: [PrimRep] -> SortedSlotTys
rep :: [PrimRep] -> SortedSlotTys
rep [PrimRep]
ty = forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map PrimRep -> SlotTy
primRepSlot [PrimRep]
ty)
sumRep :: NonEmpty SlotTy
sumRep = SlotTy
WordSlot forall a. a -> [a] -> NonEmpty a
:| [SortedSlotTys] -> SortedSlotTys
combine_alts (forall a b. (a -> b) -> [a] -> [b]
map [PrimRep] -> SortedSlotTys
rep [[PrimRep]]
constrs0)
in
NonEmpty SlotTy
sumRep
layoutUbxSum :: HasDebugCallStack
=> SortedSlotTys
-> [SlotTy]
-> [Int]
layoutUbxSum :: HasDebugCallStack => 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 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)
, forall a. a -> Maybe a
Just SlotTy
slot 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 forall a. Num a => a -> a -> a
+ Int
1) SortedSlotTys
slots IntSet
useds
findSlot SlotTy
_ Int
_ [] IntSet
_
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"findSlot" (forall doc. IsLine doc => String -> doc
text String
"Can't find slot" forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"sum_slots:" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr SortedSlotTys
sum_slots0
forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsLine doc => String -> doc
text String
"arg_slots:" forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr SortedSlotTys
arg_slots0 )
data SlotTy = PtrLiftedSlot | PtrUnliftedSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot | VecSlot Int PrimElemRep
deriving (SlotTy -> SlotTy -> Bool
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
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 = forall doc. IsLine doc => String -> doc
text String
"PtrLiftedSlot"
ppr SlotTy
PtrUnliftedSlot = forall doc. IsLine doc => String -> doc
text String
"PtrUnliftedSlot"
ppr SlotTy
Word64Slot = forall doc. IsLine doc => String -> doc
text String
"Word64Slot"
ppr SlotTy
WordSlot = forall doc. IsLine doc => String -> doc
text String
"WordSlot"
ppr SlotTy
DoubleSlot = forall doc. IsLine doc => String -> doc
text String
"DoubleSlot"
ppr SlotTy
FloatSlot = forall doc. IsLine doc => String -> doc
text String
"FloatSlot"
ppr (VecSlot Int
n PrimElemRep
e) = forall doc. IsLine doc => String -> doc
text String
"VecSlot" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
n forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr PrimElemRep
e
typeSlotTy :: UnaryType -> Maybe SlotTy
typeSlotTy :: UnaryType -> Maybe SlotTy
typeSlotTy UnaryType
ty = case HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty of
[] -> forall a. Maybe a
Nothing
[PrimRep
rep] -> forall a. a -> Maybe a
Just (PrimRep -> SlotTy
primRepSlot PrimRep
rep)
[PrimRep]
reps -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"typeSlotTy" (forall a. Outputable a => a -> SDoc
ppr UnaryType
ty forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr [PrimRep]
reps)
primRepSlot :: PrimRep -> SlotTy
primRepSlot :: PrimRep -> SlotTy
primRepSlot PrimRep
VoidRep = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"primRepSlot" (forall doc. IsLine doc => String -> doc
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 Int
n PrimElemRep
e) = Int -> PrimElemRep -> SlotTy
VecSlot Int
n PrimElemRep
e
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
slotPrimRep (VecSlot Int
n PrimElemRep
e) = Int -> PrimElemRep -> PrimRep
VecRep Int
n PrimElemRep
e
fitsIn :: SlotTy -> SlotTy -> Maybe SlotTy
fitsIn :: SlotTy -> SlotTy -> Maybe SlotTy
fitsIn SlotTy
ty1 SlotTy
ty2
| SlotTy
ty1 forall a. Eq a => a -> a -> Bool
== SlotTy
ty2
= forall a. a -> Maybe a
Just SlotTy
ty1
| SlotTy -> Bool
isWordSlot SlotTy
ty1 Bool -> Bool -> Bool
&& SlotTy -> Bool
isWordSlot SlotTy
ty2
= forall a. a -> Maybe a
Just (forall a. Ord a => a -> a -> a
max SlotTy
ty1 SlotTy
ty2)
| Bool
otherwise
= forall a. Maybe a
Nothing
where
isWordSlot :: SlotTy -> Bool
isWordSlot SlotTy
Word64Slot = Bool
True
isWordSlot SlotTy
WordSlot = Bool
True
isWordSlot SlotTy
_ = Bool
False
typePrimRep :: HasDebugCallStack => Type -> [PrimRep]
typePrimRep :: HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty = HasDebugCallStack => SDoc -> UnaryType -> [PrimRep]
kindPrimRep (forall doc. IsLine doc => String -> doc
text String
"typePrimRep" forall doc. IsLine doc => doc -> doc -> doc
<+>
forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr UnaryType
ty forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => UnaryType -> UnaryType
typeKind UnaryType
ty)))
(HasDebugCallStack => UnaryType -> UnaryType
typeKind UnaryType
ty)
typePrimRep_maybe :: Type -> Maybe [PrimRep]
typePrimRep_maybe :: UnaryType -> Maybe [PrimRep]
typePrimRep_maybe UnaryType
ty = HasDebugCallStack => UnaryType -> Maybe [PrimRep]
kindPrimRep_maybe (HasDebugCallStack => UnaryType -> UnaryType
typeKind UnaryType
ty)
typePrimRep1 :: HasDebugCallStack => UnaryType -> PrimRep
typePrimRep1 :: HasDebugCallStack => UnaryType -> PrimRep
typePrimRep1 UnaryType
ty = case HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty of
[] -> PrimRep
VoidRep
[PrimRep
rep] -> PrimRep
rep
[PrimRep]
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"typePrimRep1" (forall a. Outputable a => a -> SDoc
ppr UnaryType
ty forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty))
tyConPrimRep :: HasDebugCallStack => TyCon -> [PrimRep]
tyConPrimRep :: HasDebugCallStack => TyCon -> [PrimRep]
tyConPrimRep TyCon
tc
= HasDebugCallStack => SDoc -> UnaryType -> [PrimRep]
kindPrimRep (forall doc. IsLine doc => String -> doc
text String
"kindRep tc" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr TyCon
tc forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr UnaryType
res_kind)
UnaryType
res_kind
where
res_kind :: UnaryType
res_kind = TyCon -> UnaryType
tyConResKind TyCon
tc
tyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep
tyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep
tyConPrimRep1 TyCon
tc = case HasDebugCallStack => TyCon -> [PrimRep]
tyConPrimRep TyCon
tc of
[] -> PrimRep
VoidRep
[PrimRep
rep] -> PrimRep
rep
[PrimRep]
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConPrimRep1" (forall a. Outputable a => a -> SDoc
ppr TyCon
tc forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => TyCon -> [PrimRep]
tyConPrimRep TyCon
tc))
kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep]
kindPrimRep :: HasDebugCallStack => SDoc -> UnaryType -> [PrimRep]
kindPrimRep SDoc
doc UnaryType
ki
| Just UnaryType
runtime_rep <- HasDebugCallStack => UnaryType -> Maybe UnaryType
kindRep_maybe UnaryType
ki
= HasDebugCallStack => SDoc -> UnaryType -> [PrimRep]
runtimeRepPrimRep SDoc
doc UnaryType
runtime_rep
kindPrimRep SDoc
doc UnaryType
ki
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"kindPrimRep" (forall a. Outputable a => a -> SDoc
ppr UnaryType
ki forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
doc)
kindPrimRep_maybe :: HasDebugCallStack => Kind -> Maybe [PrimRep]
kindPrimRep_maybe :: HasDebugCallStack => UnaryType -> Maybe [PrimRep]
kindPrimRep_maybe UnaryType
ki
| Just (TypeOrConstraint
_torc, UnaryType
rep) <- UnaryType -> Maybe (TypeOrConstraint, UnaryType)
sORTKind_maybe UnaryType
ki
= UnaryType -> Maybe [PrimRep]
runtimeRepPrimRep_maybe UnaryType
rep
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"kindPrimRep" (forall a. Outputable a => a -> SDoc
ppr UnaryType
ki)
runtimeRepPrimRep :: HasDebugCallStack => SDoc -> RuntimeRepType -> [PrimRep]
runtimeRepPrimRep :: HasDebugCallStack => SDoc -> UnaryType -> [PrimRep]
runtimeRepPrimRep SDoc
doc UnaryType
rr_ty
| Just UnaryType
rr_ty' <- UnaryType -> Maybe UnaryType
coreView UnaryType
rr_ty
= HasDebugCallStack => SDoc -> UnaryType -> [PrimRep]
runtimeRepPrimRep SDoc
doc UnaryType
rr_ty'
| TyConApp TyCon
rr_dc [UnaryType]
args <- UnaryType
rr_ty
, RuntimeRep [UnaryType] -> [PrimRep]
fun <- TyCon -> PromDataConInfo
tyConPromDataConInfo TyCon
rr_dc
= [UnaryType] -> [PrimRep]
fun [UnaryType]
args
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"runtimeRepPrimRep" (SDoc
doc forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr UnaryType
rr_ty)
runtimeRepPrimRep_maybe :: Type -> Maybe [PrimRep]
runtimeRepPrimRep_maybe :: UnaryType -> Maybe [PrimRep]
runtimeRepPrimRep_maybe UnaryType
rr_ty
| Just UnaryType
rr_ty' <- UnaryType -> Maybe UnaryType
coreView UnaryType
rr_ty
= UnaryType -> Maybe [PrimRep]
runtimeRepPrimRep_maybe UnaryType
rr_ty'
| TyConApp TyCon
rr_dc [UnaryType]
args <- UnaryType
rr_ty
, RuntimeRep [UnaryType] -> [PrimRep]
fun <- TyCon -> PromDataConInfo
tyConPromDataConInfo TyCon
rr_dc
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! [UnaryType] -> [PrimRep]
fun [UnaryType]
args
| Bool
otherwise
= forall a. Maybe a
Nothing
primRepToRuntimeRep :: PrimRep -> RuntimeRepType
primRepToRuntimeRep :: PrimRep -> UnaryType
primRepToRuntimeRep PrimRep
rep = case PrimRep
rep of
PrimRep
VoidRep -> UnaryType
zeroBitRepTy
PrimRep
LiftedRep -> UnaryType
liftedRepTy
PrimRep
UnliftedRep -> UnaryType
unliftedRepTy
PrimRep
IntRep -> UnaryType
intRepDataConTy
PrimRep
Int8Rep -> UnaryType
int8RepDataConTy
PrimRep
Int16Rep -> UnaryType
int16RepDataConTy
PrimRep
Int32Rep -> UnaryType
int32RepDataConTy
PrimRep
Int64Rep -> UnaryType
int64RepDataConTy
PrimRep
WordRep -> UnaryType
wordRepDataConTy
PrimRep
Word8Rep -> UnaryType
word8RepDataConTy
PrimRep
Word16Rep -> UnaryType
word16RepDataConTy
PrimRep
Word32Rep -> UnaryType
word32RepDataConTy
PrimRep
Word64Rep -> UnaryType
word64RepDataConTy
PrimRep
AddrRep -> UnaryType
addrRepDataConTy
PrimRep
FloatRep -> UnaryType
floatRepDataConTy
PrimRep
DoubleRep -> UnaryType
doubleRepDataConTy
VecRep Int
n PrimElemRep
elem -> TyCon -> [UnaryType] -> UnaryType
TyConApp TyCon
vecRepDataConTyCon [UnaryType
n', UnaryType
elem']
where
n' :: UnaryType
n' = case Int
n of
Int
2 -> UnaryType
vec2DataConTy
Int
4 -> UnaryType
vec4DataConTy
Int
8 -> UnaryType
vec8DataConTy
Int
16 -> UnaryType
vec16DataConTy
Int
32 -> UnaryType
vec32DataConTy
Int
64 -> UnaryType
vec64DataConTy
Int
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Disallowed VecCount" (forall a. Outputable a => a -> SDoc
ppr Int
n)
elem' :: UnaryType
elem' = case PrimElemRep
elem of
PrimElemRep
Int8ElemRep -> UnaryType
int8ElemRepDataConTy
PrimElemRep
Int16ElemRep -> UnaryType
int16ElemRepDataConTy
PrimElemRep
Int32ElemRep -> UnaryType
int32ElemRepDataConTy
PrimElemRep
Int64ElemRep -> UnaryType
int64ElemRepDataConTy
PrimElemRep
Word8ElemRep -> UnaryType
word8ElemRepDataConTy
PrimElemRep
Word16ElemRep -> UnaryType
word16ElemRepDataConTy
PrimElemRep
Word32ElemRep -> UnaryType
word32ElemRepDataConTy
PrimElemRep
Word64ElemRep -> UnaryType
word64ElemRepDataConTy
PrimElemRep
FloatElemRep -> UnaryType
floatElemRepDataConTy
PrimElemRep
DoubleElemRep -> UnaryType
doubleElemRepDataConTy
primRepToType :: PrimRep -> Type
primRepToType :: PrimRep -> UnaryType
primRepToType = UnaryType -> UnaryType
anyTypeOfKind forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnaryType -> UnaryType
mkTYPEapp forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimRep -> UnaryType
primRepToRuntimeRep
mightBeFunTy :: Type -> Bool
mightBeFunTy :: UnaryType -> Bool
mightBeFunTy UnaryType
ty
| [PrimRep
LiftedRep] <- HasDebugCallStack => UnaryType -> [PrimRep]
typePrimRep UnaryType
ty
, Just TyCon
tc <- UnaryType -> Maybe TyCon
tyConAppTyCon_maybe (UnaryType -> UnaryType
unwrapType UnaryType
ty)
, TyCon -> Bool
isDataTyCon TyCon
tc
= Bool
False
| Bool
otherwise
= Bool
True