-
Notifications
You must be signed in to change notification settings - Fork 13
/
HsFFI.hs
133 lines (125 loc) · 4.19 KB
/
HsFFI.hs
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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module FFICXX.Generate.Code.HsFFI where
import Data.Maybe (fromMaybe, mapMaybe)
import FFICXX.Generate.Code.Primitive
( CFunSig (..),
accessorCFunSig,
genericFuncArgs,
genericFuncRet,
hsFFIFunType,
toGHCSafety,
)
import FFICXX.Generate.Dependency
( class_allparents,
)
import FFICXX.Generate.Name
( aliasedFuncName,
ffiClassName,
hscAccessorName,
hscFuncName,
subModuleName,
)
import FFICXX.Generate.Type.Class
( Accessor (Getter, Setter),
Arg (..),
Class (..),
Function (..),
Selfness (NoSelf, Self),
TLOrdinary (..),
Variable (unVariable),
getFunSafety,
isAbstractClass,
isNewFunc,
isStaticFunc,
virtualFuncs,
)
import FFICXX.Generate.Type.Module
( ClassImportHeader (..),
ClassModule (..),
TopLevelImportHeader (..),
)
import FFICXX.Generate.Util (toLowers)
import FFICXX.Generate.Util.GHCExactPrint
( mkForImpCcall,
mkImport,
)
import FFICXX.Runtime.CodeGen.Cxx (HeaderName (..))
import FFICXX.Runtime.Types (FFISafety (FFIUnsafe))
import GHC.Hs (GhcPs)
import Language.Haskell.Syntax
( ForeignDecl,
ImportDecl,
)
import System.FilePath ((<.>))
genHsFFI :: ClassImportHeader -> [ForeignDecl GhcPs]
genHsFFI header =
let c = cihClass header
-- TODO: This C header information should not be necessary according to up-to-date
-- version of Haskell FFI.
h = cihSelfHeader header
-- NOTE: We need to generate FFI both for member functions at the current class level
-- and parent level. For example, consider a class A with method foo, which a
-- subclass of B with method bar. Then, A::foo (c_a_foo) and A::bar (c_a_bar)
-- are made into a FFI function.
allfns =
concatMap
(virtualFuncs . class_funcs)
(class_allparents c)
<> (class_funcs c)
in mapMaybe (hsFFIClassFunc h c) allfns
<> concatMap
(\v -> [hsFFIAccessor c v Getter, hsFFIAccessor c v Setter])
(class_vars c)
hsFFIClassFunc :: HeaderName -> Class -> Function -> Maybe (ForeignDecl GhcPs)
hsFFIClassFunc headerfilename c f =
if isAbstractClass c
then Nothing
else
let hfile = unHdrName headerfilename
safety = getFunSafety f
-- TODO: Make this a separate function
cname = ffiClassName c <> "_" <> aliasedFuncName c f
csig = CFunSig (genericFuncArgs f) (genericFuncRet f)
typ =
if (isNewFunc f || isStaticFunc f)
then hsFFIFunType (Just (NoSelf, c)) csig
else hsFFIFunType (Just (Self, c)) csig
in Just (mkForImpCcall (toGHCSafety safety) (hfile <> " " <> cname) (hscFuncName c f) typ)
hsFFIAccessor :: Class -> Variable -> Accessor -> ForeignDecl GhcPs
hsFFIAccessor c v a =
let -- TODO: make this a separate function
cname = ffiClassName c <> "_" <> arg_name (unVariable v) <> "_" <> (case a of Getter -> "get"; Setter -> "set")
typ =
hsFFIFunType
(Just (Self, c))
(accessorCFunSig (arg_type (unVariable v)) a)
in mkForImpCcall (toGHCSafety FFIUnsafe) cname (hscAccessorName c v a) typ
-- import for FFI
genImportInFFI :: ClassModule -> [ImportDecl GhcPs]
genImportInFFI = fmap (mkImport . subModuleName) . cmImportedSubmodulesForFFI
----------------------------
-- for top level function --
----------------------------
genTopLevelFFI :: TopLevelImportHeader -> TLOrdinary -> ForeignDecl GhcPs
genTopLevelFFI header tfn =
mkForImpCcall (toGHCSafety safety) (hfilename <> " TopLevel_" <> fname) cfname typ
where
(safety, fname, args, ret) =
case tfn of
TopLevelFunction {..} ->
( toplevelfunc_safety,
fromMaybe toplevelfunc_name toplevelfunc_alias,
toplevelfunc_args,
toplevelfunc_ret
)
TopLevelVariable {..} ->
( FFIUnsafe,
fromMaybe toplevelvar_name toplevelvar_alias,
[],
toplevelvar_ret
)
hfilename = tihHeaderFileName header <.> "h"
-- TODO: This must be exposed as a top-level function
cfname = "c_" <> toLowers fname
typ = hsFFIFunType Nothing (CFunSig args ret)