{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.HsToCore.Foreign.Call
( dsCCall
, mkFCall
, unboxArg
, boxResult
, resultWrapper
)
where
import GHC.Prelude
import GHC.Core
import GHC.HsToCore.Monad
import GHC.Core.Utils
import GHC.Core.Make
import GHC.Types.SourceText
import GHC.Types.Id.Make
import GHC.Types.ForeignCall
import GHC.Core.DataCon
import GHC.HsToCore.Utils
import GHC.Tc.Utils.TcType
import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.Coercion
import GHC.Builtin.Types.Prim
import GHC.Core.TyCon
import GHC.Builtin.Types
import GHC.Types.Basic
import GHC.Types.Literal
import GHC.Builtin.Names
import GHC.Driver.DynFlags
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.Maybe
import GHC.Types.RepType (typePrimRep1)
dsCCall :: CLabelString
-> [CoreExpr]
-> Safety
-> Type
-> DsM CoreExpr
dsCCall :: CLabelString -> [CoreExpr] -> Safety -> Type -> DsM CoreExpr
dsCCall CLabelString
lbl [CoreExpr]
args Safety
may_gc Type
result_ty
= do (unboxed_args, arg_wrappers) <- (CoreExpr
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr))
-> [CoreExpr]
-> IOEnv
(Env DsGblEnv DsLclEnv) ([CoreExpr], [CoreExpr -> CoreExpr])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM CoreExpr
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
unboxArg [CoreExpr]
args
(ccall_result_ty, res_wrapper) <- boxResult result_ty
uniq <- newUnique
let
target = SourceText -> CLabelString -> Maybe Unit -> Bool -> CCallTarget
StaticTarget SourceText
NoSourceText CLabelString
lbl Maybe Unit
forall a. Maybe a
Nothing Bool
True
the_fcall = CCallSpec -> ForeignCall
CCall (CCallTarget -> CCallConv -> Safety -> CCallSpec
CCallSpec CCallTarget
target CCallConv
CCallConv Safety
may_gc)
the_prim_app = Unique -> ForeignCall -> [CoreExpr] -> Type -> CoreExpr
mkFCall Unique
uniq ForeignCall
the_fcall [CoreExpr]
unboxed_args Type
ccall_result_ty
return (foldr ($) (res_wrapper the_prim_app) arg_wrappers)
mkFCall :: Unique -> ForeignCall
-> [CoreExpr]
-> Type
-> CoreExpr
mkFCall :: Unique -> ForeignCall -> [CoreExpr] -> Type -> CoreExpr
mkFCall Unique
uniq ForeignCall
the_fcall [CoreExpr]
val_args Type
res_ty
= Bool -> CoreExpr -> CoreExpr
forall a. HasCallStack => Bool -> a -> a
assert ((Var -> Bool) -> [Var] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Var -> Bool
isTyVar [Var]
tyvars) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall a b. (a -> b) -> a -> b
$
CoreExpr -> [CoreExpr] -> CoreExpr
forall b. Expr b -> [Expr b] -> Expr b
mkApps (CoreExpr -> [Var] -> CoreExpr
forall b. Expr b -> [Var] -> Expr b
mkVarApps (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
the_fcall_id) [Var]
tyvars) [CoreExpr]
val_args
where
arg_tys :: [Type]
arg_tys = (CoreExpr -> Type) -> [CoreExpr] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => CoreExpr -> Type
CoreExpr -> Type
exprType [CoreExpr]
val_args
body_ty :: Type
body_ty = ([Type] -> Type -> Type
mkVisFunTysMany [Type]
arg_tys Type
res_ty)
tyvars :: [Var]
tyvars = Type -> [Var]
tyCoVarsOfTypeWellScoped Type
body_ty
ty :: Type
ty = [Var] -> Type -> Type
mkInfForAllTys [Var]
tyvars Type
body_ty
the_fcall_id :: Var
the_fcall_id = Unique -> ForeignCall -> Type -> Var
mkFCallId Unique
uniq ForeignCall
the_fcall Type
ty
unboxArg :: CoreExpr
-> DsM (CoreExpr,
CoreExpr -> CoreExpr
)
unboxArg :: CoreExpr
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
unboxArg CoreExpr
arg
| Type -> Bool
isPrimitiveType Type
arg_ty Bool -> Bool -> Bool
||
(Type -> Bool
isUnboxedTupleType Type
arg_ty Bool -> Bool -> Bool
&& HasDebugCallStack => Type -> PrimOrVoidRep
Type -> PrimOrVoidRep
typePrimRep1 Type
arg_ty PrimOrVoidRep -> PrimOrVoidRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimOrVoidRep
VoidRep)
= (CoreExpr, CoreExpr -> CoreExpr)
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr
arg, \CoreExpr
body -> CoreExpr
body)
| Just(Coercion
co, Type
_rep_ty) <- Type -> Maybe (Coercion, Type)
topNormaliseNewType_maybe Type
arg_ty
= CoreExpr
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
unboxArg (CoreExpr -> Coercion -> CoreExpr
mkCastDs CoreExpr
arg Coercion
co)
| Just TyCon
tc <- Type -> Maybe TyCon
tyConAppTyCon_maybe Type
arg_ty,
TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
boolTyConKey
= do dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
prim_arg <- newSysLocalMDs intPrimTy
return (Var prim_arg,
\ CoreExpr
body -> CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case (CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
mkIfThenElse CoreExpr
arg (Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLit Platform
platform Integer
1) (Platform -> Integer -> CoreExpr
forall b. Platform -> Integer -> Expr b
mkIntLit Platform
platform Integer
0))
Var
prim_arg
(HasDebugCallStack => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
body)
[AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
DEFAULT [] CoreExpr
body])
| Bool
is_product_type Bool -> Bool -> Bool
&& Arity
data_con_arity Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1
= Bool
-> SDoc
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (HasDebugCallStack => Type -> Bool
Type -> Bool
isUnliftedType Type
data_con_arg_ty1) (Type -> SDoc
pprType Type
arg_ty) (IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr))
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
-> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr, CoreExpr -> CoreExpr)
forall a b. (a -> b) -> a -> b
$
do case_bndr <- Type -> DsM Var
newSysLocalMDs Type
arg_ty
prim_arg <- newSysLocalMDs data_con_arg_ty1
return (Var prim_arg,
\ CoreExpr
body -> CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case CoreExpr
arg Var
case_bndr (HasDebugCallStack => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
body) [AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (DataCon -> AltCon
DataAlt DataCon
data_con) [Var
prim_arg] CoreExpr
body]
)
| Bool
is_product_type Bool -> Bool -> Bool
&&
Arity
data_con_arity Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
3,
Just TyCon
arg3_tycon <- Maybe TyCon
maybe_arg3_tycon,
(TyCon
arg3_tycon TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
byteArrayPrimTyCon Bool -> Bool -> Bool
||
TyCon
arg3_tycon TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
mutableByteArrayPrimTyCon)
= do case_bndr <- Type -> DsM Var
newSysLocalMDs Type
arg_ty
vars@[_l_var, _r_var, arr_cts_var] <- newSysLocalsDs (map unrestricted data_con_arg_tys)
return (Var arr_cts_var,
\ CoreExpr
body -> CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case CoreExpr
arg Var
case_bndr (HasDebugCallStack => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
body) [AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (DataCon -> AltCon
DataAlt DataCon
data_con) [Var]
vars CoreExpr
body]
)
| Bool
otherwise
= do l <- DsM SrcSpan
getSrcSpanDs
pprPanic "unboxArg: " (ppr l <+> ppr arg_ty)
where
arg_ty :: Type
arg_ty = HasDebugCallStack => CoreExpr -> Type
CoreExpr -> Type
exprType CoreExpr
arg
maybe_product_type :: Maybe (TyCon, [Type], DataCon, [Scaled Type])
maybe_product_type = Type -> Maybe (TyCon, [Type], DataCon, [Scaled Type])
splitDataProductType_maybe Type
arg_ty
is_product_type :: Bool
is_product_type = Maybe (TyCon, [Type], DataCon, [Scaled Type]) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (TyCon, [Type], DataCon, [Scaled Type])
maybe_product_type
Just (TyCon
_, [Type]
_, DataCon
data_con, [Scaled Type]
scaled_data_con_arg_tys) = Maybe (TyCon, [Type], DataCon, [Scaled Type])
maybe_product_type
data_con_arg_tys :: [Type]
data_con_arg_tys = (Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
scaledThing [Scaled Type]
scaled_data_con_arg_tys
data_con_arity :: Arity
data_con_arity = DataCon -> Arity
dataConSourceArity DataCon
data_con
(Type
data_con_arg_ty1 : [Type]
_) = [Type]
data_con_arg_tys
(Type
_ : Type
_ : Type
data_con_arg_ty3 : [Type]
_) = [Type]
data_con_arg_tys
maybe_arg3_tycon :: Maybe TyCon
maybe_arg3_tycon = Type -> Maybe TyCon
tyConAppTyCon_maybe Type
data_con_arg_ty3
boxResult :: Type
-> DsM (Type, CoreExpr -> CoreExpr)
boxResult :: Type -> DsM (Type, CoreExpr -> CoreExpr)
boxResult Type
result_ty
| Just (TyCon
io_tycon, Type
io_res_ty) <- Type -> Maybe (TyCon, Type)
tcSplitIOType_maybe Type
result_ty
= do { res <- Type -> DsM (Maybe Type, CoreExpr -> CoreExpr)
resultWrapper Type
io_res_ty
; let return_result CoreExpr
state CoreExpr
anss = [CoreExpr] -> CoreExpr
mkCoreUnboxedTuple [CoreExpr
state, CoreExpr
anss]
; (ccall_res_ty, the_alt) <- mk_alt return_result res
; state_id <- newSysLocalMDs realWorldStatePrimTy
; let io_data_con = [DataCon] -> DataCon
forall a. HasCallStack => [a] -> a
head (TyCon -> [DataCon]
tyConDataCons TyCon
io_tycon)
toIOCon = DataCon -> Var
dataConWrapId DataCon
io_data_con
wrap CoreExpr
the_call =
CoreExpr -> [CoreExpr] -> CoreExpr
forall b. Expr b -> [Expr b] -> Expr b
mkApps (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
toIOCon)
[ Type -> CoreExpr
forall b. Type -> Expr b
Type Type
io_res_ty,
Var -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Var
state_id (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
forall a b. (a -> b) -> a -> b
$
CoreExpr -> Scaled Type -> Type -> [Alt Var] -> CoreExpr
mkWildCase (CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App CoreExpr
the_call (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
state_id))
(Type -> Scaled Type
forall a. a -> Scaled a
unrestricted Type
ccall_res_ty)
(Alt Var -> Type
coreAltType Alt Var
the_alt)
[Alt Var
the_alt]
]
; return (realWorldStatePrimTy `mkVisFunTyMany` ccall_res_ty, wrap) }
boxResult Type
result_ty
= do
res <- Type -> DsM (Maybe Type, CoreExpr -> CoreExpr)
resultWrapper Type
result_ty
(ccall_res_ty, the_alt) <- mk_alt return_result res
let
wrap = \ CoreExpr
the_call -> CoreExpr -> Scaled Type -> Type -> [Alt Var] -> CoreExpr
mkWildCase (CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App CoreExpr
the_call (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
realWorldPrimId))
(Type -> Scaled Type
forall a. a -> Scaled a
unrestricted Type
ccall_res_ty)
(Alt Var -> Type
coreAltType Alt Var
the_alt)
[Alt Var
the_alt]
return (realWorldStatePrimTy `mkVisFunTyMany` ccall_res_ty, wrap)
where
return_result :: p -> p -> p
return_result p
_ p
ans = p
ans
mk_alt :: (Expr Var -> Expr Var -> Expr Var)
-> (Maybe Type, Expr Var -> Expr Var)
-> DsM (Type, CoreAlt)
mk_alt :: (CoreExpr -> CoreExpr -> CoreExpr)
-> (Maybe Type, CoreExpr -> CoreExpr) -> DsM (Type, Alt Var)
mk_alt CoreExpr -> CoreExpr -> CoreExpr
return_result (Maybe Type
Nothing, CoreExpr -> CoreExpr
wrap_result)
= do
state_id <- Type -> DsM Var
newSysLocalMDs Type
realWorldStatePrimTy
let
the_rhs = CoreExpr -> CoreExpr -> CoreExpr
return_result (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
state_id)
(CoreExpr -> CoreExpr
wrap_result (String -> CoreExpr
forall a. HasCallStack => String -> a
panic String
"boxResult"))
ccall_res_ty = Boxity -> [Type] -> Type
mkTupleTy Boxity
Unboxed [Type
realWorldStatePrimTy]
the_alt = AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (DataCon -> AltCon
DataAlt (Boxity -> Arity -> DataCon
tupleDataCon Boxity
Unboxed Arity
1)) [Var
state_id] CoreExpr
the_rhs
return (ccall_res_ty, the_alt)
mk_alt CoreExpr -> CoreExpr -> CoreExpr
return_result (Just Type
prim_res_ty, CoreExpr -> CoreExpr
wrap_result)
=
Bool -> SDoc -> DsM (Type, Alt Var) -> DsM (Type, Alt Var)
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Type -> Bool
isPrimitiveType Type
prim_res_ty) (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
prim_res_ty) (DsM (Type, Alt Var) -> DsM (Type, Alt Var))
-> DsM (Type, Alt Var) -> DsM (Type, Alt Var)
forall a b. (a -> b) -> a -> b
$
do { result_id <- Type -> DsM Var
newSysLocalMDs Type
prim_res_ty
; state_id <- newSysLocalMDs realWorldStatePrimTy
; let the_rhs = CoreExpr -> CoreExpr -> CoreExpr
return_result (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
state_id)
(CoreExpr -> CoreExpr
wrap_result (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
result_id))
ccall_res_ty = Boxity -> [Type] -> Type
mkTupleTy Boxity
Unboxed [Type
realWorldStatePrimTy, Type
prim_res_ty]
the_alt = AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (DataCon -> AltCon
DataAlt (Boxity -> Arity -> DataCon
tupleDataCon Boxity
Unboxed Arity
2)) [Var
state_id, Var
result_id] CoreExpr
the_rhs
; return (ccall_res_ty, the_alt) }
resultWrapper :: Type
-> DsM (Maybe Type,
CoreExpr -> CoreExpr)
resultWrapper :: Type -> DsM (Maybe Type, CoreExpr -> CoreExpr)
resultWrapper Type
result_ty
| Type -> Bool
isPrimitiveType Type
result_ty
= (Maybe Type, CoreExpr -> CoreExpr)
-> DsM (Maybe Type, CoreExpr -> CoreExpr)
forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
result_ty, \CoreExpr
e -> CoreExpr
e)
| Just (TyCon
tc,[Type]
_) <- Maybe (TyCon, [Type])
maybe_tc_app
, TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
unitTyConKey
= (Maybe Type, CoreExpr -> CoreExpr)
-> DsM (Maybe Type, CoreExpr -> CoreExpr)
forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type
forall a. Maybe a
Nothing, \CoreExpr
_ -> CoreExpr
unitExpr)
| Just (TyCon
tc,[Type]
_) <- Maybe (TyCon, [Type])
maybe_tc_app
, TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
boolTyConKey
= do { dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; let platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
; let marshal_bool CoreExpr
e
= CoreExpr -> Scaled Type -> Type -> [Alt Var] -> CoreExpr
mkWildCase CoreExpr
e (Type -> Scaled Type
forall a. a -> Scaled a
unrestricted Type
intPrimTy) Type
boolTy
[ AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
DEFAULT [] (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
trueDataConId )
, AltCon -> [Var] -> CoreExpr -> Alt Var
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (Literal -> AltCon
LitAlt (Platform -> Integer -> Literal
mkLitInt Platform
platform Integer
0)) [] (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
falseDataConId)]
; return (Just intPrimTy, marshal_bool) }
| Just (Coercion
co, Type
rep_ty) <- Type -> Maybe (Coercion, Type)
topNormaliseNewType_maybe Type
result_ty
= do { (maybe_ty, wrapper) <- Type -> DsM (Maybe Type, CoreExpr -> CoreExpr)
resultWrapper Type
rep_ty
; return (maybe_ty, \CoreExpr
e -> CoreExpr -> Coercion -> CoreExpr
mkCastDs (CoreExpr -> CoreExpr
wrapper CoreExpr
e) (Coercion -> Coercion
mkSymCo Coercion
co)) }
| Just (Var
tyvar, Type
rest) <- Type -> Maybe (Var, Type)
splitForAllTyCoVar_maybe Type
result_ty
= do { (maybe_ty, wrapper) <- Type -> DsM (Maybe Type, CoreExpr -> CoreExpr)
resultWrapper Type
rest
; return (maybe_ty, \CoreExpr
e -> Var -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Var
tyvar (CoreExpr -> CoreExpr
wrapper CoreExpr
e)) }
| Just (TyCon
tycon, [Type]
tycon_arg_tys) <- Maybe (TyCon, [Type])
maybe_tc_app
, Just DataCon
data_con <- TyCon -> Maybe DataCon
tyConSingleAlgDataCon_maybe TyCon
tycon
, [Var] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataCon -> [Var]
dataConExTyCoVars DataCon
data_con)
, [Scaled Type
_ Type
unwrapped_res_ty] <- DataCon -> [Type] -> [Scaled Type]
dataConInstOrigArgTys DataCon
data_con [Type]
tycon_arg_tys
= do { (maybe_ty, wrapper) <- Type -> DsM (Maybe Type, CoreExpr -> CoreExpr)
resultWrapper Type
unwrapped_res_ty
; let marshal_con CoreExpr
e = Var -> CoreExpr
forall b. Var -> Expr b
Var (DataCon -> Var
dataConWrapId DataCon
data_con)
CoreExpr -> [Type] -> CoreExpr
forall b. Expr b -> [Type] -> Expr b
`mkTyApps` [Type]
tycon_arg_tys
CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
`App` CoreExpr -> CoreExpr
wrapper CoreExpr
e
; return (maybe_ty, marshal_con) }
| Bool
otherwise
= String -> SDoc -> DsM (Maybe Type, CoreExpr -> CoreExpr)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"resultWrapper" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
result_ty)
where
maybe_tc_app :: Maybe (TyCon, [Type])
maybe_tc_app = HasDebugCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
result_ty