34
35:- module(foreign_props,
36 [foreign/1,
37 foreign/2,
38 foreign_spec/1,
39 (native)/1,
40 (native)/2,
41 normalize_ftype/2,
42 normalize_ftgen/2,
43 fimport/1,
44 fimport/2,
45 nimport/1,
46 nimport/2,
47 int64/1,
48 lang/1,
49 long/1,
50 returns/2,
51 parent/2,
52 returns_state/1,
53 memory_root/1,
54 ptr/1,
55 ptr/2,
56 array/3,
57 setof/2,
58 float_t/1,
59 size_t/1,
60 tgen/1,
61 tgen/2,
62 dict_t/2,
63 dict_t/3,
64 dict_join_t/4,
65 dict_extend_t/4,
66 join_dict_types/6,
67 join_type_desc/4]). 68
69:- use_module(library(assertions)). 70:- use_module(library(metaprops)). 71:- use_module(library(plprops)). 72:- use_module(library(extend_args)). 73:- use_module(library(mapargs)). 74:- use_module(library(neck)). 75
76:- init_expansors. 77
78:- type foreign_spec/1.
79
80foreign_spec(name( Name )) :- atm(Name).
81foreign_spec(prefix(Prefix)) :- atm(Prefix).
82foreign_spec(suffix(Suffix)) :- atm(Suffix).
83foreign_spec(lang(Lang)) :- lang(Lang).
84
85:- type lang/1.
86lang(prolog).
87lang(native).
88
89normalize_ftype(native( O, G), native( O, G)).
90normalize_ftype(foreign(O, G), foreign(O, G)).
91normalize_ftype(fimport(O, G), foreign([lang(prolog), O], G)).
92normalize_ftype(native( G), native( [prefix(pl_)], G)).
93normalize_ftype(foreign( G), foreign([prefix('')], G)).
94normalize_ftype(fimport( G), foreign([lang(prolog), prefix('')], G)).
95normalize_ftype(nimport(O, G), foreign([lang(native), O], G)).
96normalize_ftype(nimport( G), foreign([lang(native), prefix('')], G)).
97
98:- type ftype_spec/1.
99
100ftype_spec(decl). 101ftype_spec(gett). 102ftype_spec(unif). 103
104normalize_ftgen(tgen( G), tgen([decl, gett, unif], G)).
105normalize_ftgen(tgen(O, G), tgen(O, G)).
106
107%! native(+ForeignSpec, :Predicate)
108%
109% Predicate is implemented in C as specified by ForeignSpec.
110
111%! native(:Predicate)
112%
113% Predicate is implemented in C with a pl_ prefix.
114
115%! tgen(:FTypeSpec, :Predicate)
116%
117% Type is implemented in C as specified by FTypeSpec.
118
119:- global native( nlist(foreign_spec), callable).
120:- global foreign(nlist(foreign_spec), callable).
121:- global fimport(nlist(foreign_spec), callable).
122:- global nimport(nlist(foreign_spec), callable).
123:- global native( callable).
124:- global foreign(callable).
125:- global fimport(callable).
126:- global nimport(callable).
127:- global tgen(callable).
128:- global tgen(nlist(ftype_spec), callable).
129
130H :-
131 ( normalize_ftype(H, N)
132 ; normalize_ftgen(H, N)
133 ),
134 ( H == N
135 ->functor(H, _, A),
136 arg(A, H, G),
137 B = call(G)
138 ; B = N
139 ),
140 necki,
141 B.
142
143:- global returns/2.
144returns(_, G) :- call(G).
145
146:- global parent/2.
147parent(_, G) :- call(G).
148
149:- global returns_state/1.
150returns_state(G) :- call(G).
151
152:- global memory_root/1.
153memory_root(G) :- call(G).
154
155:- type float_t/1 # "Defines a float".
156float_t(Num) :- num(Num).
157
158:- type ptr/1 # "Defines a void pointer".
159ptr(Ptr) :- int(Ptr).
160
161:- type long/1 # "Defines a long integer".
162long(Long) :- int(Long).
163
164:- type size_t/1 # "Defines a size".
165size_t(Size) :- nnegint(Size).
166
167:- type int64/1 # "Defines a 64 bits integer".
168int64(I) :- int(I).
169
170%! array(:Type, Dimensions:list(nnegint), Array)
171%
172% Defines an array of dimensions Dimentions. In Prolog an array is implemented
173% as nested terms, with a functor arity equal to the dimension at each
174% level. In the foreign language is the typical array structure. Note that we
175% use functor since they are equivalent to arrays in Prolog.
176
177:- type array(1, list(size_t), term).
178:- meta_predicate array(1, +, ?). 179
180array(Type, DimL, Array) :-
181 array_(DimL, Type, Array).
182
183array_([], T, V) :- type(T, V).
184array_([Dim|DimL], T, V) :-
185 size_t(Dim),
186 functor(V, v, Dim),
187 mapargs(array_(DimL, T), V).
188
189%! setof(:Type, ?Set)
190%
191% Set is a set of Type. The actual implementation would be a bit tricky,
192% but for now we simple use list/2.
193
194:- type setof/2 # "Defines a set of elements".
195
196:- meta_predicate setof(1, ?). 197
198setof(Type, List) :-
199 list(Type, List).
200
201%! ptr(:Type, ?Ptr)
202%
203% Defines a typed pointer. Note that if the value was allocated dynamically by
204% foreign_interface, it allows its usage as parent in FI_new_child_value/array
205% in the C side to perform semi-automatic memory management
206
207:- type ptr/2.
208
209:- meta_predicate ptr(1, ?). 210
211ptr(Type, Ptr) :-
212 call(Type, Ptr).
213
214prolog:called_by(dict_t(Desc, _), foreign_props, M, L) :-
215 called_by_dict_t(Desc, M, L).
216prolog:called_by(dict_t(_, Desc, _), foreign_props, M, L) :-
217 called_by_dict_t(Desc, M, L).
218
219called_by_dict_t(Desc, CM, L) :-
220 nonvar(Desc),
221 dict_create(Dict, _Tag, Desc),
222 findall(M:P,
223 ( MType=Dict._Key,
224 strip_module(CM:MType, M, T),
225 nonvar(T),
226 extend_args(T, [_], P)
227 ), L).
228
229:- type dict_t/2.
230:- meta_predicate dict_t(:, ?). 231dict_t(Desc, Term) :-
232 dict_t(_, Desc, Term).
233
234:- type dict_t/3.
235:- meta_predicate dict_t(?, :, ?). 236dict_t(Tag, M:Desc, Term) :-
237 dict_mq(Desc, M, Tag, Dict),
238 dict_pairs(Term, Tag, Pairs),
239 maplist(dict_kv(Dict), Pairs).
240
241:- type dict_join_t/4.
242:- meta_predicate dict_join_t(?, ?, 1, 1). 243dict_join_t(Term, Tag, M1:Type1, M2:Type2) :-
244 join_dict_types(Type1, M1, Type2, M2, Tag, Dict),
245 dict_pairs(Term, Tag, Pairs),
246 maplist(dict_kv(Dict), Pairs).
247
248:- type dict_extend_t/4.
249:- meta_predicate dict_extend_t(1, ?, +, ?). 250dict_extend_t(Type, Tag, Desc, Term) :-
251 join_type_desc(Type, Tag, Desc, Dict),
252 dict_pairs(Term, Tag, Pairs),
253 maplist(dict_kv(Dict), Pairs).
254
255:- meta_predicate join_type_desc(1, ?, +, -). 256join_type_desc(M:Type, Tag, Desc2, Dict) :-
257 type_desc(M:Type, Desc1),
258 join_dict_descs(M:Desc1, M:Desc2, Tag, Dict).
259
260dict_mq(M:Desc, _, Tag, Dict) :- !,
261 dict_mq(Desc, M, Tag, Dict).
262dict_mq(Desc, M, Tag, Dict) :-
263 dict_create(Dict, Tag, Desc),
264 forall(Value=Dict.Key, nb_set_dict(Key, Dict, M:Value)).
265
266dict_kv(Dict, Key-Value) :-
267 Type=Dict.Key,
268 call(Type, Value).
269
270:- pred extend_one_arg(1, -goal) is det.
271
272extend_one_arg(Call1, Call) :- extend_args(Call1, [_], Call).
273
274type_desc(MType, Desc) :-
275 extend_one_arg(MType, MCall),
276 clause(MCall, dict_t(_, Desc, _)).
277
278join_dict_types(Type1, M1, Type2, M2, Tag, Dict) :-
279 type_desc(M1:Type1, Desc1),
280 type_desc(M2:Type2, Desc2),
281 join_dict_descs(M1:Desc1, M2:Desc2, Tag, Dict).
282
283join_dict_descs(M1:Desc1, M2:Desc2, Tag, Dict) :-
284 dict_mq(Desc1, M1, Tag, Dict1),
285 dict_mq(Desc2, M2, Tag, Dict2),
286 Dict=Dict1.put(Dict2),
287 assertion(Dict=Dict2.put(Dict1))