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