{-# LANGUAGE MultiWayIf #-}
module GHC.HsToCore.Foreign.Utils
( Binding
, getPrimTyOf
, primTyDescChar
, ppPrimTyConStgType
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Tc.Utils.TcType
import GHC.Core (CoreExpr)
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core.TyCo.Rep
import GHC.Types.Id
import GHC.Types.RepType
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
type Binding = (Id, CoreExpr)
getPrimTyOf :: Type -> UnaryType
getPrimTyOf :: Type -> Type
getPrimTyOf Type
ty
| Type -> Bool
isBoolTy Type
rep_ty = Type
intPrimTy
| Bool
otherwise =
case Type -> Maybe (TyCon, [Type], DataCon, [Scaled Type])
splitDataProductType_maybe Type
rep_ty of
Just (TyCon
_, [Type]
_, DataCon
data_con, [Scaled Type
_ Type
prim_ty]) ->
forall a. HasCallStack => Bool -> a -> a
assert (DataCon -> Arity
dataConSourceArity DataCon
data_con forall a. Eq a => a -> a -> Bool
== Arity
1) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (HasDebugCallStack => Type -> Bool
isUnliftedType Type
prim_ty) (forall a. Outputable a => a -> SDoc
ppr Type
prim_ty)
Type
prim_ty
Maybe (TyCon, [Type], DataCon, [Scaled Type])
_other -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getPrimTyOf" (forall a. Outputable a => a -> SDoc
ppr Type
ty)
where
rep_ty :: Type
rep_ty = Type -> Type
unwrapType Type
ty
primTyDescChar :: Platform -> Type -> Char
primTyDescChar :: Platform -> Type -> Char
primTyDescChar !Platform
platform Type
ty
| Type
ty Type -> Type -> Bool
`eqType` Type
unitTy = Char
'v'
| Bool
otherwise
= case HasDebugCallStack => Type -> PrimRep
typePrimRep1 (Type -> Type
getPrimTyOf Type
ty) of
PrimRep
IntRep -> Char
signed_word
PrimRep
WordRep -> Char
unsigned_word
PrimRep
Int8Rep -> Char
'B'
PrimRep
Word8Rep -> Char
'b'
PrimRep
Int16Rep -> Char
'S'
PrimRep
Word16Rep -> Char
's'
PrimRep
Int32Rep -> Char
'W'
PrimRep
Word32Rep -> Char
'w'
PrimRep
Int64Rep -> Char
'L'
PrimRep
Word64Rep -> Char
'l'
PrimRep
AddrRep -> Char
'p'
PrimRep
FloatRep -> Char
'f'
PrimRep
DoubleRep -> Char
'd'
PrimRep
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"primTyDescChar" (forall a. Outputable a => a -> SDoc
ppr Type
ty)
where
(Char
signed_word, Char
unsigned_word) = case Platform -> PlatformWordSize
platformWordSize Platform
platform of
PlatformWordSize
PW4 -> (Char
'W',Char
'w')
PlatformWordSize
PW8 -> (Char
'L',Char
'l')
ppPrimTyConStgType :: TyCon -> Maybe String
ppPrimTyConStgType :: TyCon -> Maybe String
ppPrimTyConStgType TyCon
tc =
if | TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
charPrimTyCon -> forall a. a -> Maybe a
Just String
"StgChar"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
intPrimTyCon -> forall a. a -> Maybe a
Just String
"StgInt"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
int8PrimTyCon -> forall a. a -> Maybe a
Just String
"StgInt8"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
int16PrimTyCon -> forall a. a -> Maybe a
Just String
"StgInt16"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
int32PrimTyCon -> forall a. a -> Maybe a
Just String
"StgInt32"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
int64PrimTyCon -> forall a. a -> Maybe a
Just String
"StgInt64"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
wordPrimTyCon -> forall a. a -> Maybe a
Just String
"StgWord"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
word8PrimTyCon -> forall a. a -> Maybe a
Just String
"StgWord8"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
word16PrimTyCon -> forall a. a -> Maybe a
Just String
"StgWord16"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
word32PrimTyCon -> forall a. a -> Maybe a
Just String
"StgWord32"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
word64PrimTyCon -> forall a. a -> Maybe a
Just String
"StgWord64"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
floatPrimTyCon -> forall a. a -> Maybe a
Just String
"StgFloat"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
doublePrimTyCon -> forall a. a -> Maybe a
Just String
"StgDouble"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
addrPrimTyCon -> forall a. a -> Maybe a
Just String
"StgAddr"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
stablePtrPrimTyCon -> forall a. a -> Maybe a
Just String
"StgStablePtr"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
arrayPrimTyCon -> forall a. a -> Maybe a
Just String
"const StgAddr"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
mutableArrayPrimTyCon -> forall a. a -> Maybe a
Just String
"StgAddr"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
byteArrayPrimTyCon -> forall a. a -> Maybe a
Just String
"const StgAddr"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
mutableByteArrayPrimTyCon -> forall a. a -> Maybe a
Just String
"StgAddr"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
smallArrayPrimTyCon -> forall a. a -> Maybe a
Just String
"const StgAddr"
| TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
smallMutableArrayPrimTyCon -> forall a. a -> Maybe a
Just String
"StgAddr"
| Bool
otherwise -> forall a. Maybe a
Nothing