1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 2012-2016, VU University Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #ifndef YAP_INTERFACE_H_INCLUDED
36 #define YAP_INTERFACE_H_INCLUDED
37
38 #include <SWI-Prolog.h>
39 #include <math.h>
40 #include <gmp.h>
41
42 #define YAP_UserCPredicate(name, func, arity) \
43 PL_register_foreign(name, arity, func, PL_FA_VARARGS)
44
45 #define YAP_ARGS term_t YAP_ARG1, int _arity, control_t _ctx
46 #define YAP_PASS_ARGS YAP_ARG1, _arity, _ctx
47 #define YAP_ARG2 (YAP_ARG1+1)
48 #define YAP_ARG3 (YAP_ARG1+2)
49 #define YAP_ARG4 (YAP_ARG1+3)
50 #define YAP_ARG5 (YAP_ARG1+4)
51 #define YAP_ARG6 (YAP_ARG1+5)
52 #define YAP_ARG7 (YAP_ARG1+6)
53 #define YAP_ARG8 (YAP_ARG1+7)
54 #define YAP_ARG9 (YAP_ARG1+8)
55
56 typedef int64_t YAP_Int;
57 typedef atom_t YAP_Atom;
58 typedef functor_t YAP_Functor;
59 typedef term_t YAP_Term;
60 typedef foreign_t YAP_Rc;
61
62 #define YAP_IsAtomTerm(t) PL_is_atom(t)
63 #define YAP_IsIntTerm(t) PL_is_integer(t)
64 #define YAP_IsFloatTerm(t) PL_is_float(t)
65 #define YAP_IsPairTerm(t) (PL_is_list(t) && !PL_is_atom(t))
66 #define YAP_IsVarTerm(t) PL_is_variable(t)
67 #define YAP_IsNilTerm(t) PL_get_nil(t)
68 #define YAP_IsNonVarTerm(t) (!PL_is_variable(t))
69 #define YAP_IsApplTerm(t) PL_is_compound(t)
70 #define YAP_Deref(t) (t)
71
72 #define YAP_LookupAtom(s) PL_new_atom(s)
73 #define YAP_ArityOfFunctor(f) PL_functor_arity(f)
74 #define YAP_NameOfFunctor(f) PL_functor_name(f)
75 #define YAP_MkFunctor(name, arity) PL_new_functor(name, arity)
76 #define YAP_MkNilTerm(t) PL_put_nil(t)
77
78 #define YAP_Unify(t1, t2) PL_unify(t1, t2)
79
80 #define YAP_AllocSpaceFromYap(size) PL_malloc(size)
81 #define YAP_FreeSpaceFromYap(ptr) PL_free(ptr)
82
83 static inline atom_t
YAP_AtomOfTerm(term_t t)84 YAP_AtomOfTerm(term_t t)
85 { atom_t a;
86
87 if ( PL_get_atom(t, &a) )
88 return a;
89
90 return (atom_t)0;
91 }
92
93 static inline const char *
YAP_AtomName(atom_t a)94 YAP_AtomName(atom_t a)
95 { const char *s;
96
97 if ( a && (s=PL_atom_nchars(a, NULL)) )
98 return s;
99
100 return NULL;
101 }
102
103
104 static inline YAP_Int
YAP_IntOfTerm(term_t t)105 YAP_IntOfTerm(term_t t)
106 { int64_t i;
107
108 if ( PL_get_int64(t, &i) )
109 return i;
110
111 return -1;
112 }
113
114
115 #ifndef NAN
116 #define NAN 0.0
117 #endif
118
119 static inline double
YAP_FloatOfTerm(term_t t)120 YAP_FloatOfTerm(term_t t)
121 { double f;
122
123 if ( PL_get_float(t, &f) )
124 return f;
125
126 return NAN;
127 }
128
129
130 static inline term_t
YAP_MkVarTerm(void)131 YAP_MkVarTerm(void)
132 { return PL_new_term_ref();
133 }
134
135
136 static inline term_t
YAP_MkIntTerm(YAP_Int i)137 YAP_MkIntTerm(YAP_Int i)
138 { term_t t = PL_new_term_ref();
139
140 if ( PL_put_int64(t, i) )
141 return t;
142
143 return (term_t)0; /* stack overflow */
144 }
145
146
147 static inline term_t
YAP_MkAtomTerm(atom_t a)148 YAP_MkAtomTerm(atom_t a)
149 { term_t t = PL_new_term_ref();
150
151 PL_put_atom(t, a);
152
153 return t;
154 }
155
156
157 static inline term_t
YAP_MkFloatTerm(double f)158 YAP_MkFloatTerm(double f)
159 { term_t t = PL_new_term_ref();
160
161 if ( PL_put_float(t, f) )
162 return t;
163
164 return (term_t)0;
165 }
166
167
168 static inline term_t
YAP_MkPairTerm(term_t head,term_t tail)169 YAP_MkPairTerm(term_t head, term_t tail)
170 { term_t t;
171
172 if ( (t = PL_new_term_ref()) &&
173 PL_cons_list(t, head, tail) )
174 return t;
175
176 return (term_t)0;
177 }
178
179
180 static inline term_t
YAP_MkApplTerm(functor_t f,int arity,term_t * tv)181 YAP_MkApplTerm(functor_t f, int arity, term_t *tv)
182 { term_t t = PL_new_term_ref();
183 term_t t0;
184
185 if ( arity == 1 )
186 { t0 = *tv;
187 } else
188 { int i;
189
190 t0 = PL_new_term_refs(arity);
191 for(i=0; i<arity; i++)
192 PL_put_term(t0+0, tv[i]);
193 }
194
195 if ( PL_cons_functor_v(t, f, t0) )
196 return t;
197
198 return (term_t)0;
199 }
200
201
202 /* NOTE: The arity is encoded in the functor. We check consistency
203 */
204
205 static inline term_t
YAP_MkNewApplTerm(functor_t f,int arity)206 YAP_MkNewApplTerm(functor_t f, int arity)
207 { term_t t = PL_new_term_ref();
208
209 assert(PL_functor_arity(f) == arity);
210 if ( PL_put_functor(t, f) )
211 return t;
212 else
213 return (term_t)0;
214 }
215
216
217 /* NOTE: This is expensive in SWI-Prolog. YAP term-references are
218 direct pointers and thus it merely returns a pointer to the
219 array of arguments. In SWI-Prolog, term references are indirect
220 handles and thus we must allocate a handle for each argument.
221 */
222
223 static inline term_t
YAP_ArgsOfTerm(term_t t)224 YAP_ArgsOfTerm(term_t t)
225 { atom_t name;
226 int arity, i, res;
227 term_t args;
228
229 if ( !(res = PL_get_name_arity( t, &name, &arity)) ||
230 !(args = PL_new_term_refs(arity)) ) /* Leaves an exception on failure */
231 return (term_t)0;
232
233 for (i=1; i<=arity; i++)
234 _PL_get_arg(i, t, args+i-1);
235
236 return args;
237 }
238
239
240 static inline functor_t
YAP_FunctorOfTerm(term_t t)241 YAP_FunctorOfTerm(term_t t)
242 { functor_t f;
243
244 if ( PL_get_functor(t, &f) )
245 return f;
246
247 return (functor_t)f;
248 }
249
250
251 static inline term_t
YAP_HeadOfTerm(term_t t)252 YAP_HeadOfTerm(term_t t)
253 { term_t ht = PL_new_term_refs(2);
254
255 if ( PL_get_list(t, ht, ht+1) )
256 return ht;
257
258 return 0;
259 }
260
261 static inline term_t
YAP_TailOfTerm(term_t t)262 YAP_TailOfTerm(term_t t)
263 { term_t ht = PL_new_term_refs(2);
264
265 if ( PL_get_list(t, ht, ht+1) )
266 return ht+1;
267
268 return 0;
269 }
270
271 static inline term_t
YAP_ArgOfTerm(int arg,term_t t)272 YAP_ArgOfTerm(int arg, term_t t)
273 { term_t a = PL_new_term_ref();
274
275 _PL_get_arg(arg, t, a);
276
277 return a;
278 }
279
280
281
282
283 #endif /*YAP_INTERFACE_H_INCLUDED*/
284