{-# 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]) ->
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 ((() :: Constraint) => 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 Type -> Type -> Bool
`eqType` Type
unitTy = Char
'v'
| Bool
otherwise
= case (() :: Constraint) => Type -> PrimRep
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
_ -> 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