{-# 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
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]) ->
Bool -> Type -> Type
forall a. HasCallStack => Bool -> a -> a
assert (DataCon -> Arity
dataConSourceArity DataCon
data_con Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
Bool -> SDoc -> Type -> Type
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType Type
prim_ty) (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
prim_ty)
Type
prim_ty
Maybe (TyCon, [Type], DataCon, [Scaled Type])
_other -> String -> SDoc -> Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getPrimTyOf" (Type -> SDoc
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 HasCallStack => Type -> Type -> Bool
Type -> Type -> Bool
`eqType` Type
unitTy = Char
'v'
| Bool
otherwise
= case HasDebugCallStack => Type -> PrimRep
Type -> PrimRep
typePrimRepU (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
_ -> String -> SDoc -> Char
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"primTyDescChar" (Type -> SDoc
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 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
charPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgChar"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
intPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgInt"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
int8PrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgInt8"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
int16PrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgInt16"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
int32PrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgInt32"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
int64PrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgInt64"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
wordPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgWord"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
word8PrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgWord8"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
word16PrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgWord16"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
word32PrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgWord32"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
word64PrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgWord64"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
floatPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgFloat"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
doublePrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgDouble"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
addrPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgAddr"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
stablePtrPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgStablePtr"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
arrayPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"const StgAddr"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
mutableArrayPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgAddr"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
byteArrayPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"const StgAddr"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
mutableByteArrayPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgAddr"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
smallArrayPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"const StgAddr"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
smallMutableArrayPrimTyCon -> String -> Maybe String
forall a. a -> Maybe a
Just String
"StgAddr"
| Bool
otherwise -> Maybe String
forall a. Maybe a
Nothing