blob: 888f2a1d6ee4fdd0adedd9b61f908f325b150e22 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
-- | Foreign primitive calls
--
-- This is for `@foreign import prim@' declarations.
--
-- Currently, at the core level we pretend that these primitive calls are
-- foreign calls. It may make more sense in future to have them as a distinct
-- kind of Id, or perhaps to bundle them with PrimOps since semantically and for
-- calling convention they are really prim ops.
module GHC.HsToCore.Foreign.Prim
( dsPrimCall
)
where
import GHC.Prelude
import GHC.Tc.Utils.Monad -- temp
import GHC.Tc.Utils.TcType
import GHC.Core
import GHC.Core.Type
import GHC.Core.Coercion
import GHC.HsToCore.Monad
import GHC.HsToCore.Foreign.Call
import GHC.Types.Id
import GHC.Types.ForeignStubs
import GHC.Types.ForeignCall
dsPrimCall :: Id -> Coercion -> ForeignCall
-> DsM ([(Id, Expr TyVar)], CHeader, CStub)
dsPrimCall fn_id co fcall = do
let
ty = coercionLKind co
(tvs, fun_ty) = tcSplitForAllInvisTyVars ty
(arg_tys, io_res_ty) = tcSplitFunTys fun_ty
args <- newSysLocalsDs arg_tys -- no FFI representation polymorphism
ccall_uniq <- newUnique
let
call_app = mkFCall ccall_uniq fcall (map Var args) io_res_ty
rhs = mkLams tvs (mkLams args call_app)
rhs' = Cast rhs co
return ([(fn_id, rhs')], mempty, mempty)
|
