File: gprolog_cfli.hh

package info (click to toggle)
ppl 1:1.2-8.1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 44,328 kB
  • sloc: cpp: 212,085; sh: 12,176; makefile: 7,192; perl: 6,333; java: 2,220; ansic: 1,842; ml: 1,132; sed: 80
file content (486 lines) | stat: -rw-r--r-- 12,220 bytes parent folder | download
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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
/* GNU Prolog Common Foreign Language Interface.
   Copyright (C) 2001-2010 Roberto Bagnara <bagnara@cs.unipr.it>
   Copyright (C) 2010-2016 BUGSENG srl (http://bugseng.com)

This file is part of the Parma Polyhedra Library (PPL).

The PPL is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3 of the License, or (at your
option) any later version.

The PPL is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1307, USA.

For the most up-to-date information see the Parma Polyhedra Library
site: http://bugseng.com/products/ppl/ . */

#ifndef PCFLI_gprolog_cfli_hh
#define PCFLI_gprolog_cfli_hh 1

#if SIZEOF_FP == SIZEOF_INTP
// Horrible kludge working around an horrible bug in <gprolog.h> (see
// http://www.cs.unipr.it/pipermail/ppl-devel/2008-August/012277.html).
#define byte_code byte_code(void)
#define last_read_line last_read_line(void)
#define last_read_col last_read_col(void)
#include <gprolog.h>
#undef byte_code
#undef last_read_line
#undef last_read_col
#else
#include <gprolog.h>
#endif

#if defined(__GPROLOG_VERSION__) && __GPROLOG_VERSION__ >= 10301
#define PPL_GPROLOG_H_IS_CLEAN
#endif

#ifndef PPL_GPROLOG_H_IS_CLEAN
// <gprolog.h> pollutes the namespace: try to clean up
// (see http://www.cs.unipr.it/pipermail/ppl-devel/2004-April/004270.html).
#ifdef B
#undef B
#endif
#ifdef H
#undef H
#endif
#ifdef CP
#undef CP
#endif
#ifdef E
#undef E
#endif
#ifdef CS
#undef CS
#endif
#ifdef S
#undef S
#endif
#ifdef STAMP
#undef STAMP
#endif
#endif

#include <cassert>
#include <cstdlib>

typedef PlTerm Prolog_term_ref;
typedef int Prolog_atom;
#ifndef PPL_GPROLOG_H_IS_CLEAN
typedef Bool Prolog_foreign_return_type;

const Prolog_foreign_return_type PROLOG_SUCCESS = TRUE;
const Prolog_foreign_return_type PROLOG_FAILURE = FALSE;
#else
typedef PlBool Prolog_foreign_return_type;

const Prolog_foreign_return_type PROLOG_SUCCESS = PL_TRUE;
const Prolog_foreign_return_type PROLOG_FAILURE = PL_FALSE;
#endif

namespace {

inline Prolog_atom
a_dollar_address() {
  // We use the `name' variable, instead of directly using the string
  // literal, in order to avoid a compiler warning.
  static char name[] = "$address";
  static Prolog_atom atom = Create_Allocate_Atom(name);
  return atom;
}

inline Prolog_atom
a_throw() {
  // We use the `name' variable, instead of directly using the string
  // literal, in order to avoid a compiler warning.
  static char name[] = "throw";
  static Prolog_atom a = Find_Atom(name);
  return a;
}

} // namespace

/*!
  Return a new term reference.
*/
inline Prolog_term_ref
Prolog_new_term_ref() {
  return 0;
}

/*!
  Make \p t be a reference to the same term referenced by \p u,
  i.e., assign \p u to \p t.
*/
inline int
Prolog_put_term(Prolog_term_ref& t, Prolog_term_ref u) {
  t = u;
  return 1;
}

/*!
  Assign to \p t a Prolog integer with value \p l.
*/
inline int
Prolog_put_long(Prolog_term_ref& t, long l) {
  if (l < INT_LOWEST_VALUE || l > INT_GREATEST_VALUE)
    return 0;
  else {
    t = Mk_Integer(l);
    return 1;
  }
}

/*!
  Assign to \p t a Prolog integer with value \p ul.
*/
inline int
Prolog_put_ulong(Prolog_term_ref& t, unsigned long ul) {
  if (ul > static_cast<unsigned long>(INT_GREATEST_VALUE))
    return 0;
  else {
    t = Mk_Integer(ul);
    return 1;
  }
}

/*!
  Assign to \p t an atom whose name is given
  by the null-terminated string \p s.
*/
inline int
Prolog_put_atom_chars(Prolog_term_ref& t, const char* s) {
  t = Mk_Atom(Create_Allocate_Atom(const_cast<char*>(s)));
  return 1;
}

/*!
  Assign to \p t the Prolog atom \p a.
*/
inline int
Prolog_put_atom(Prolog_term_ref& t, Prolog_atom a) {
  t = Mk_Atom(a);
  return 1;
}

/*!
  Return an atom whose name is given by the null-terminated string \p s.
*/
inline Prolog_atom
Prolog_atom_from_string(const char* s) {
  return Create_Allocate_Atom(const_cast<char*>(s));
}

/*!
  Assign to \p t a compound term whose principal functor is \p f
  of arity 1 with argument \p a1.
*/
inline int
Prolog_construct_compound(Prolog_term_ref& t, Prolog_atom f,
                          Prolog_term_ref a1) {
  Prolog_term_ref args[1];
  args[0] = a1;
  t = Mk_Compound(f, 1, args);
  return 1;
}

/*!
  Assign to \p t a compound term whose principal functor is \p f
  of arity 2 with arguments \p a1 and \p a2.
*/
inline int
Prolog_construct_compound(Prolog_term_ref& t, Prolog_atom f,
                          Prolog_term_ref a1, Prolog_term_ref a2) {
  Prolog_term_ref args[2];
  args[0] = a1;
  args[1] = a2;
  t = Mk_Compound(f, 2, args);
  return 1;
}

/*!
  Assign to \p t a compound term whose principal functor is \p f
  of arity 3 with arguments \p a1, \p a2 and \p a3.
*/
inline int
Prolog_construct_compound(Prolog_term_ref& t, Prolog_atom f,
                          Prolog_term_ref a1, Prolog_term_ref a2,
                          Prolog_term_ref a3) {
  Prolog_term_ref args[3];
  args[0] = a1;
  args[1] = a2;
  args[2] = a3;
  t = Mk_Compound(f, 3, args);
  return 1;
}

/*!
  Assign to \p t a compound term whose principal functor is \p f
  of arity 4 with arguments \p a1, \p a2, \p a3 and \p a4.
*/
inline int
Prolog_construct_compound(Prolog_term_ref& t, Prolog_atom f,
                          Prolog_term_ref a1, Prolog_term_ref a2,
                          Prolog_term_ref a3, Prolog_term_ref a4) {
  Prolog_term_ref args[4];
  args[0] = a1;
  args[1] = a2;
  args[2] = a3;
  args[3] = a4;
  t = Mk_Compound(f, 4, args);
  return 1;
}

/*!
  Assign to \p c a Prolog list whose head is \p h and tail is \p t.
*/
inline int
Prolog_construct_cons(Prolog_term_ref& c,
                      Prolog_term_ref h, Prolog_term_ref t) {
  Prolog_term_ref args[2];
  args[0] = h;
  args[1] = t;
  c = Mk_List(args);
  return 1;
}

/*!
  Assign to \p t the list terminator <CODE>[]</CODE> (which needs not
  be an atom).
*/
inline int
Prolog_put_nil(Prolog_term_ref& t) {
  t = Mk_Atom(atom_nil);
  return 1;
}

/*!
  Assign to \p t a term representing the address contained in \p p.
*/
inline int
Prolog_put_address(Prolog_term_ref& t, void* p) {
  union {
    void* l;
    unsigned short s[sizeof(void*)/sizeof(unsigned short)];
  } u;
  u.l = reinterpret_cast<void*>(p);
  if (sizeof(unsigned short)*2 == sizeof(void*))
    return Prolog_construct_compound(t, a_dollar_address(),
                                     Mk_Positive(u.s[0]),
                                     Mk_Positive(u.s[1]));
  else if (sizeof(unsigned short)*4 == sizeof(void*))
    return Prolog_construct_compound(t, a_dollar_address(),
                                     Mk_Positive(u.s[0]),
                                     Mk_Positive(u.s[1]),
                                     Mk_Positive(u.s[2]),
                                     Mk_Positive(u.s[3]));
  else
    abort();
}

/*!
  Raise a Prolog exception with \p t as the exception term.
*/
inline void
Prolog_raise_exception(Prolog_term_ref t) {
  Pl_Exec_Continuation(a_throw(), 1, &t);
}

/*!
  Return true if \p t is a Prolog variable, false otherwise.
*/
inline int
Prolog_is_variable(Prolog_term_ref t) {
  return Blt_Var(t) != FALSE;
}

/*!
  Return true if \p t is a Prolog atom, false otherwise.
*/
inline int
Prolog_is_atom(Prolog_term_ref t) {
  return Blt_Atom(t) != FALSE;
}

/*!
  Return true if \p t is a Prolog integer, false otherwise.
*/
inline int
Prolog_is_integer(Prolog_term_ref t) {
  return Blt_Integer(t) != FALSE;
}

/*!
  Return true if \p t is a Prolog compound term, false otherwise.
*/
inline int
Prolog_is_compound(Prolog_term_ref t) {
  return Blt_Compound(t) != FALSE;
}

/*!
  Return true if \p t is a Prolog cons (list constructor), false otherwise.
*/
inline int
Prolog_is_cons(Prolog_term_ref t) {
  if (Blt_Compound(t) == FALSE)
    return 0;
  Prolog_atom name;
  int arity;
  Rd_Compound(t, &name, &arity);
  return name == ATOM_CHAR('.') && arity == 2;
}

/*!
  Assuming \p t is a Prolog integer, return true if its value fits
  in a long, in which case the value is assigned to \p v,
  return false otherwise.  The behavior is undefined if \p t is
  not a Prolog integer.
*/
inline int
Prolog_get_long(Prolog_term_ref t, long* lp) {
  assert(Prolog_is_integer(t));
  *lp = Rd_Integer_Check(t);
  return 1;
}

/*!
  Return true if \p t is the representation of an address, false otherwise.
*/
inline int
Prolog_is_address(Prolog_term_ref t) {
  if (!Prolog_is_compound(t))
    return 0;
  Prolog_atom name;
  int arity;
  Prolog_term_ref* a = Rd_Compound_Check(t, &name, &arity);
  if (name != a_dollar_address()
      || sizeof(unsigned short)*arity != sizeof(void*))
    return 0;
  for (unsigned i = 0; i < sizeof(void*)/sizeof(unsigned short); ++i) {
    if (!Prolog_is_integer(a[i]))
      return 0;
    long l;
    if (!Prolog_get_long(a[i], &l))
      return 0;
    if (l < 0 || l > USHRT_MAX)
      return 0;
  }
  return 1;
}

/*!
  If \p t is the Prolog representation for a memory address, return
  true and store that address into \p v; return false otherwise.
  The behavior is undefined if \p t is not an address.
*/
inline int
Prolog_get_address(Prolog_term_ref t, void** vpp) {
  assert(Prolog_is_address(t));
  static Prolog_atom dummy_name;
  static int dummy_arity;
  Prolog_term_ref* a = Rd_Compound_Check(t, &dummy_name, &dummy_arity);
  union {
    void* l;
    unsigned short s[sizeof(void*)/sizeof(unsigned short)];
  } u;
  assert(dummy_arity >= 2);
  u.s[0] = Rd_Integer_Check(a[0]);
  u.s[1] = Rd_Integer_Check(a[1]);
  if (sizeof(unsigned short)*4 == sizeof(void*)) {
    assert(dummy_arity == 4);
    u.s[2] = Rd_Integer_Check(a[2]);
    u.s[3] = Rd_Integer_Check(a[3]);
  }
  *vpp = reinterpret_cast<void*>(u.l);
  return 1;
}

/*!
  If \p t is a Prolog atom, return true and store its name into \p name.
  The behavior is undefined if \p t is not a Prolog atom.
*/
inline int
Prolog_get_atom_name(Prolog_term_ref t, Prolog_atom* ap) {
  assert(Prolog_is_atom(t));
  *ap = Rd_Atom_Check(t);
  return 1;
}

/*!
  If \p t is a Prolog compound term, return true and store its name
  and arity into \p name and \p arity, respectively.
  The behavior is undefined if \p t is not a Prolog compound term.
*/
inline int
Prolog_get_compound_name_arity(Prolog_term_ref t, Prolog_atom* ap, size_t* ip) {
  assert(Prolog_is_compound(t));
  Rd_Compound_Check(t, ap, ip);
  return 1;
}

/*!
  If \p t is a Prolog compound term and \p i is a positive integer
  less than or equal to its arity, return true and assign to \p a the
  i-th (principal) argument of \p t.
  The behavior is undefined if \p t is not a Prolog compound term.
*/
inline int
Prolog_get_arg(int i, Prolog_term_ref t, Prolog_term_ref& a) {
  assert(Prolog_is_compound(t));
  static Prolog_atom dummy_name;
  static int dummy_arity;
  a = Rd_Compound_Check(t, &dummy_name, &dummy_arity)[i-1];
  return 1;
}

/*!
  Succeeds if and only if \p t represents the list terminator <CODE>[]</CODE>
  (which needs not be an atom).
*/
inline int
Prolog_get_nil(Prolog_term_ref t) {
  if (Blt_Atom(t) == FALSE) {
    return 0;
  }
  else {
    int a = atom_nil;
    return Rd_Atom_Check(t) == a;
  }
}

/*!
  If \p c is a Prolog cons (list constructor), assign its head and
  tail to \p h and \p t, respectively.
  The behavior is undefined if \p c is not a Prolog cons.
*/
inline int
Prolog_get_cons(Prolog_term_ref c, Prolog_term_ref& h, Prolog_term_ref& t) {
  assert(Prolog_is_cons(c));
  Prolog_term_ref* ht = Rd_List_Check(c);
  h = ht[0];
  t = ht[1];
  return 1;
}

/*!
  Unify the terms referenced by \p t and \p u and return true
  if the unification is successful; return false otherwise.
*/
inline int
Prolog_unify(Prolog_term_ref t, Prolog_term_ref u) {
#ifndef PPL_GPROLOG_H_IS_CLEAN
  return Unify(t, u) != FALSE;
#else
  return Pl_Unif(t, u) != PL_FALSE;
#endif
}

#endif // !defined(PCFLI_gprolog_cfli_hh)