static foreign_t
pl_order_table_mapping(term_t handle, term_t from, term_t to, control_t ctrl)
{ OrdTable t;
int f;
if ( !get_order_table(handle, &t) )
return FALSE;
if ( PL_get_integer(from, &f) && f >= 0 && f <= 255 )
return unify_mapped_code(to, ORD(t, f));
if ( PL_is_variable(from) )
{ switch(PL_foreign_control(ctrl))
{ case PL_FIRST_CALL:
f = 0;
break;
case PL_REDO:
f = (int)PL_foreign_context(ctrl);
break;
case PL_PRUNED:
return TRUE;
}
while( f <= 255 && !unify_mapped_code(to, ORD(t, f)) )
f++;
if ( f <= 255 )
{ if ( !PL_unify_integer(from, f) )
return FALSE;
PL_retry(f+1);
}
return FALSE;
}
return FALSE;
}
static foreign_t pl_clingo_assign_external(term_t ccontrol, term_t Atom,
term_t Value) {
clingo_env *ctl;
clingo_symbol_t atom;
clingo_truth_value_t value;
int bv, rc;
if (!(rc = get_clingo(ccontrol, &ctl))) {
goto out;
}
if (!(rc = clingo_status(get_value(Atom, &atom, FALSE)))) {
goto out;
}
if (PL_is_variable(Value)) {
value = clingo_truth_value_free;
} else if (PL_get_bool_ex(Value, &bv)) {
value = bv ? clingo_truth_value_true : clingo_truth_value_false;
} else {
rc = PL_domain_error("assign_external", Value);
goto out;
}
if (!(rc = clingo_status(
clingo_control_assign_external(ctl->control, atom, value)))) {
goto out;
}
out:
return rc;
}
static foreign_t
pl_bind(term_t Socket, term_t Address)
{ struct sockaddr_in sockaddr;
int socket;
memset(&sockaddr, 0, sizeof(sockaddr));
if ( !tcp_get_socket(Socket, &socket) ||
!nbio_get_sockaddr(Address, &sockaddr) )
return FALSE;
if ( nbio_bind(socket, (struct sockaddr*)&sockaddr, sizeof(sockaddr)) < 0 )
return FALSE;
if ( PL_is_variable(Address) )
{ SOCKET fd = nbio_fd(socket);
struct sockaddr_in addr;
#ifdef __WINDOWS__
int len = sizeof(addr);
#else
socklen_t len = sizeof(addr);
#endif
if ( getsockname(fd, (struct sockaddr *) &addr, &len) )
return nbio_error(errno, TCP_ERRNO);
return PL_unify_integer(Address, ntohs(addr.sin_port));
}
return TRUE;
}
static int
unify_timer(term_t t, Event ev)
{ if ( !PL_is_variable(t) )
return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 0, t, "unbound");
return PL_unify_term(t,
PL_FUNCTOR, FUNCTOR_alarm1,
PL_POINTER, ev);
}
static int
get_text_arg(term_t term, int pos, size_t *len, pl_wchar_t **s, int flags)
{ term_t tmp = PL_new_term_ref();
_PL_get_arg(pos, term, tmp);
if ( PL_is_variable(tmp) )
return FALSE;
if ( !PL_get_wchars(tmp, len, s, flags) )
return -1;
return TRUE;
}
/*
lookup_ht(HT,Key,Values) :-
term_hash(Key,Hash),
HT = ht(Capacity,_,Table),
Index is (Hash mod Capacity) + 1,
arg(Index,Table,Bucket),
nonvar(Bucket),
( Bucket = K-Vs ->
K == Key,
Values = Vs
;
lookup(Bucket,Key,Values)
).
lookup([K - V | KVs],Key,Value) :-
( K = Key ->
V = Value
;
lookup(KVs,Key,Value)
).
*/
static foreign_t
pl_lookup_ht1(term_t ht, term_t pl_hash, term_t key, term_t values)
{
int capacity;
int hash;
int index;
term_t pl_capacity = PL_new_term_ref();
term_t table = PL_new_term_ref();
term_t bucket = PL_new_term_ref();
/* HT = ht(Capacity,_,Table) */
PL_get_arg(1, ht, pl_capacity);
PL_get_integer(pl_capacity, &capacity);
PL_get_arg(3, ht, table);
/* Index is (Hash mod Capacity) + 1 */
PL_get_integer(pl_hash, &hash);
index = (hash % capacity) + 1;
/* arg(Index,Table,Bucket) */
PL_get_arg(index, table, bucket);
/* nonvar(Bucket) */
if (PL_is_variable(bucket)) PL_fail;
if (PL_is_list(bucket)) {
term_t pair = PL_new_term_ref();
term_t k = PL_new_term_ref();
term_t vs = PL_new_term_ref();
while (PL_get_list(bucket, pair,bucket)) {
PL_get_arg(1, pair, k);
if ( PL_compare(k,key) == 0 ) {
/* Values = Vs */
PL_get_arg(2, pair, vs);
return PL_unify(values,vs);
}
}
PL_fail;
} else {
term_t k = PL_new_term_ref();
term_t vs = PL_new_term_ref();
PL_get_arg(1, bucket, k);
/* K == Key */
if ( PL_compare(k,key) == 0 ) {
/* Values = Vs */
PL_get_arg(2, bucket, vs);
return PL_unify(values,vs);
} else {
PL_fail;
}
}
}
static int
get_voff_arg(int i, term_t t, term_t a, int *val)
{ GET_LD
_PL_get_arg(i, t, a);
if ( PL_is_variable(a) )
{ *val = NO_UTC_OFFSET;
return TRUE;
} else
{ return PL_get_integer_ex(a, val);
}
}
static int
get_tz_arg(int i, term_t t, term_t a, atom_t *tz)
{ GET_LD
atom_t name;
_PL_get_arg(i, t, a);
if ( !PL_is_variable(a) )
{ if ( !PL_get_atom_ex(a, &name) )
fail;
if ( name != ATOM_minus )
*tz = name;
}
succeed;
}
static foreign_t
uri_encoded(term_t what, term_t qv, term_t enc)
{ pl_wchar_t *s;
size_t len;
atom_t w;
int flags;
if ( !PL_get_atom(what, &w) )
return type_error("atom", what);
if ( w == ATOM_query_value )
flags = ESC_QVALUE;
else if ( w == ATOM_fragment )
flags = ESC_FRAGMENT;
else if ( w == ATOM_path )
flags = ESC_PATH;
else
return domain_error("uri_component", what);
fill_flags();
if ( !PL_is_variable(qv) )
{ charbuf out;
int rc;
init_charbuf(&out);
if ( !add_encoded_term_charbuf(&out, qv, flags) )
{ free_charbuf(&out);
return FALSE;
}
rc = PL_unify_wchars(enc, PL_ATOM, out.here-out.base, out.base);
free_charbuf(&out);
return rc;
} else if ( PL_get_wchars(enc, &len, &s, CVT_ATOM|CVT_STRING|CVT_EXCEPTION) )
{ range r;
r.start = s;
r.end = s+len;
return unify_decoded_atom(qv, &r, flags);
} else
{ return FALSE;
}
}
void getQueryString(term_t t,char* buf)
{
int i=0;
char* c;
term_t h;
while(PL_get_list(t,h,t))
{
if(!PL_is_variable(h))
{
PL_get_chars(h,&c,CVT_ATOM|BUF_DISCARDABLE);
buf[i]=c[0];
}
else
buf[i]='_';
++i;
}
buf[i]='\0';
printf("buf : %s\n",buf);
}
void getQueryString(term_t t,char* buf)
{
term_t head = PL_new_term_ref();
term_t list = PL_copy_term_ref(t);
int i=0;
char* c;
while(PL_get_list(list,head,list))
{
if(!PL_is_variable(head))
{
PL_get_chars(head,&c,CVT_ATOM|BUF_DISCARDABLE);
buf[i]=c[0];
}
else
buf[i]='_';
++i;
}
buf[i]='\0';
}
/********************
* swi_list_new
********************/
term_t
swi_list_new(char **items, int n, term_t result)
{
term_t list = PL_new_term_ref();
term_t item = PL_new_term_ref();
if (n < 0) { /* NULL-terminated list, calculate items */
n = 0;
if (items)
while (items[n])
n++;
}
PL_put_nil(list);
while (n-- > 0) {
PL_put_atom_chars(item, items[n]);
PL_cons_list(list, item, list);
}
if (result && PL_is_variable(result))
PL_unify(list, result);
return list;
}
static int
get_dst_arg(int i, term_t t, term_t a, int *val)
{ GET_LD
atom_t name;
_PL_get_arg(i, t, a);
if ( PL_get_atom(a, &name) )
{ if ( name == ATOM_true )
{ *val = TRUE;
return TRUE;
} else if ( name == ATOM_false )
{ *val = FALSE;
return TRUE;
} else if ( name == ATOM_minus )
{ *val = -1;
return TRUE;
}
} else if ( PL_is_variable(a) )
{ *val = -2;
return TRUE;
}
return PL_get_bool_ex(a, val); /* generate an error */
}
int
pl_error(const char *pred, int arity, const char *msg, int id, ...)
{ fid_t fid;
term_t except, formal, swi;
int rc;
va_list args;
if ( !(fid=PL_open_foreign_frame()) )
return FALSE;
except = PL_new_term_ref();
formal = PL_new_term_ref();
swi = PL_new_term_ref();
va_start(args, id);
switch(id)
{ case ERR_ERRNO:
{ int err = va_arg(args, int);
const char *action = va_arg(args, const char *);
const char *type = va_arg(args, const char *);
term_t object = va_arg(args, term_t);
if ( !object )
object = PL_new_term_ref();
msg = strerror(err);
switch(err)
{ case ENOMEM:
case EAGAIN: /* fork(); might be other resource */
rc = PL_unify_term(formal,
CompoundArg("resource_error", 1),
AtomArg("no_memory"));
break;
case EACCES:
case EPERM:
{ rc = PL_unify_term(formal,
CompoundArg("permission_error", 3),
AtomArg(action),
AtomArg(type),
PL_TERM, object);
break;
}
case ENOENT:
case ESRCH:
{ rc = PL_unify_term(formal,
CompoundArg("existence_error", 2),
AtomArg(type),
PL_TERM, object);
break;
}
default:
rc = PL_unify_atom_chars(formal, "system_error");
break;
}
break;
}
case ERR_ARGTYPE:
{ int argn = va_arg(args, int); /* argument position (unused) */
term_t actual = va_arg(args, term_t);
atom_t expected = PL_new_atom(va_arg(args, const char*));
(void)argn; /* avoid unused warning */
if ( PL_is_variable(actual) && expected != PL_new_atom("variable") )
rc = PL_unify_atom_chars(formal, "instantiation_error");
else
rc = PL_unify_term(formal,
CompoundArg("type_error", 2),
PL_ATOM, expected,
PL_TERM, actual);
break;
}
case ERR_TYPE:
{ term_t actual = va_arg(args, term_t);
atom_t expected = PL_new_atom(va_arg(args, const char*));
if ( PL_is_variable(actual) && expected != PL_new_atom("variable") )
rc = PL_unify_atom_chars(formal, "instantiation_error");
else
rc = PL_unify_term(formal,
CompoundArg("type_error", 2),
PL_ATOM, expected,
PL_TERM, actual);
break;
}
case ERR_DOMAIN:
{ term_t actual = va_arg(args, term_t);
atom_t expected = PL_new_atom(va_arg(args, const char*));
rc = PL_unify_term(formal,
CompoundArg("domain_error", 2),
PL_ATOM, expected,
PL_TERM, actual);
break;
}
case ERR_EXISTENCE:
{ const char *type = va_arg(args, const char *);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
CompoundArg("existence_error", 2),
PL_CHARS, type,
PL_TERM, obj);
break;
}
case ERR_PERMISSION:
{ term_t obj = va_arg(args, term_t);
const char *op = va_arg(args, const char *);
const char *objtype = va_arg(args, const char *);
rc = PL_unify_term(formal,
CompoundArg("permission_error", 3),
AtomArg(op),
AtomArg(objtype),
PL_TERM, obj);
break;
}
case ERR_NOTIMPLEMENTED:
{ const char *op = va_arg(args, const char *);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
CompoundArg("not_implemented", 2),
AtomArg(op),
PL_TERM, obj);
break;
}
case ERR_RESOURCE:
{ const char *res = va_arg(args, const char *);
rc = PL_unify_term(formal,
CompoundArg("resource_error", 1),
AtomArg(res));
break;
}
case ERR_SYNTAX:
{ const char *culprit = va_arg(args, const char *);
rc = PL_unify_term(formal,
CompoundArg("syntax_error", 1),
AtomArg(culprit));
break;
}
default:
assert(0);
rc = FALSE;
}
va_end(args);
if ( rc && (pred || msg) )
{ term_t predterm = PL_new_term_ref();
term_t msgterm = PL_new_term_ref();
if ( pred )
{ rc = PL_unify_term(predterm,
CompoundArg("/", 2),
AtomArg(pred),
IntArg(arity));
}
if ( msg )
{ rc = PL_put_atom_chars(msgterm, msg);
}
if ( rc )
rc = PL_unify_term(swi,
CompoundArg("context", 2),
PL_TERM, predterm,
PL_TERM, msgterm);
}
if ( rc )
rc = PL_unify_term(except,
CompoundArg("error", 2),
PL_TERM, formal,
PL_TERM, swi);
if ( rc )
rc = PL_raise_exception(except);
PL_close_foreign_frame(fid);
return rc;
}
int
sgml2pl_error(plerrorid id, ...)
{ int rc;
term_t except, formal, swi;
va_list args;
char msgbuf[1024];
char *msg = NULL;
if ( !(except = PL_new_term_ref()) ||
!(formal = PL_new_term_ref()) ||
!(swi = PL_new_term_ref()) )
return FALSE;
va_start(args, id);
switch(id)
{ case ERR_ERRNO:
{ int err = va_arg(args, int);
msg = strerror(err);
switch(err)
{ case ENOMEM:
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "resource_error", 1,
PL_CHARS, "no_memory");
break;
case EACCES:
{ const char *file = va_arg(args, const char *);
const char *action = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "permission_error", 3,
PL_CHARS, action,
PL_CHARS, "file",
PL_CHARS, file);
break;
}
case ENOENT:
{ const char *file = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "existence_error", 2,
PL_CHARS, "file",
PL_CHARS, file);
break;
}
default:
rc = PL_unify_atom_chars(formal, "system_error");
break;
}
break;
}
case ERR_TYPE:
{ const char *expected = va_arg(args, const char*);
term_t actual = va_arg(args, term_t);
if ( PL_is_variable(actual) &&
strcmp(expected, "variable") != 0 )
rc = PL_unify_atom_chars(formal, "instantiation_error");
else
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "type_error", 2,
PL_CHARS, expected,
PL_TERM, actual);
break;
}
case ERR_DOMAIN:
{ const char *expected = va_arg(args, const char*);
term_t actual = va_arg(args, term_t);
if ( PL_is_variable(actual) )
rc = PL_unify_atom_chars(formal, "instantiation_error");
else
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "domain_error", 2,
PL_CHARS, expected,
PL_TERM, actual);
break;
}
case ERR_EXISTENCE:
{ const char *type = va_arg(args, const char *);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "existence_error", 2,
PL_CHARS, type,
PL_TERM, obj);
break;
}
case ERR_FAIL:
{ term_t goal = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "goal_failed", 1,
PL_TERM, goal);
break;
}
case ERR_LIMIT:
{ const char *limit = va_arg(args, const char *);
long maxval = va_arg(args, long);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "limit_exceeded", 2,
PL_CHARS, limit,
PL_LONG, maxval);
break;
}
case ERR_MISC:
{ const char *id = va_arg(args, const char *);
const char *fmt = va_arg(args, const char *);
vsprintf(msgbuf, fmt, args);
msg = msgbuf;
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "miscellaneous", 1,
PL_CHARS, id);
break;
}
default:
assert(0);
}
va_end(args);
if ( rc && msg )
{ term_t predterm = PL_new_term_ref();
term_t msgterm = PL_new_term_ref();
if ( !(predterm = PL_new_term_ref()) ||
!(msgterm = PL_new_term_ref()) ||
!PL_put_atom_chars(msgterm, msg) ||
!PL_unify_term(swi,
PL_FUNCTOR_CHARS, "context", 2,
PL_TERM, predterm,
PL_TERM, msgterm) )
rc = FALSE;
}
if ( rc )
rc = PL_unify_term(except,
PL_FUNCTOR_CHARS, "error", 2,
PL_TERM, formal,
PL_TERM, swi);
if ( rc )
return PL_raise_exception(except);
return FALSE;
}
word
pl_current_functor(term_t name, term_t arity, control_t h)
{ GET_LD
atom_t nm = 0;
size_t index;
int i, last=FALSE;
int ar;
fid_t fid;
switch( ForeignControl(h) )
{ case FRG_FIRST_CALL:
if ( PL_get_atom(name, &nm) &&
PL_get_integer(arity, &ar) )
return isCurrentFunctor(nm, ar) ? TRUE : FALSE;
if ( !(PL_is_integer(arity) || PL_is_variable(arity)) )
return PL_error("current_functor", 2, NULL, ERR_DOMAIN,
ATOM_integer, arity);
if ( !(PL_is_atom(name) || PL_is_variable(name)) )
return PL_error("current_functor", 2, NULL, ERR_DOMAIN,
ATOM_atom, name);
index = 1;
break;
case FRG_REDO:
PL_get_atom(name, &nm);
index = ForeignContextInt(h);
break;
case FRG_CUTTED:
default:
succeed;
}
fid = PL_open_foreign_frame();
LOCK();
for(i=MSB(index); !last; i++)
{ size_t upto = (size_t)2<<i;
FunctorDef *b = GD->functors.array.blocks[i];
if ( upto >= GD->functors.highest )
{ upto = GD->functors.highest;
last = TRUE;
}
for(; index<upto; index++)
{ FunctorDef fd = b[index];
if ( fd && fd->arity > 0 && (!nm || nm == fd->name) )
{ if ( PL_unify_atom(name, fd->name) &&
PL_unify_integer(arity, fd->arity) )
{ UNLOCK();
ForeignRedoInt(index+1);
} else
{ PL_rewind_foreign_frame(fid);
}
}
}
}
UNLOCK();
return FALSE;
}
foreign_t
fcgi_param(term_t name, term_t value, control_t h)
{
fcgi_context *ctxt;
char **env, **cgi_environ;
char *s, *v, *sep;
ctxt = pthread_getspecific(key);
if ( FCGX_IsCGI() )
{ cgi_environ = environ;
}
else
{ cgi_environ = ctxt->env;
}
if ( !PL_is_variable(name) )
{
if ( !PL_get_atom_chars(name, &s) )
{ return PL_type_error("atom", name);
}
v = FCGX_GetParam(s, cgi_environ);
if ( !v )
{ return FALSE;
}
return PL_unify_chars(value, PL_ATOM|REP_UTF8, -1, v);
}
switch ( PL_foreign_control(h) )
{
case PL_FIRST_CALL:
{ env = cgi_environ;
break;
}
case PL_REDO:
{ env = PL_foreign_context_address(h);
break;
}
case PL_PRUNED:
default:
{ return TRUE;
}
}
for ( ; *env; env++ )
{
s = strdup(*env);
sep = index(s, '=');
sep[0] = '\0';
if ( !PL_unify_chars(name, PL_ATOM|REP_UTF8, -1, s) )
{ free(s);
return FALSE;
}
if ( !PL_unify_chars(value, PL_ATOM|REP_UTF8, -1, sep+1) )
{ free(s);
return FALSE;
}
free(s);
PL_retry_address(env+1);
}
return FALSE;
}
bool
scan_options(term_t options, int flags, atom_t optype,
const opt_spec *specs, ...)
{ GET_LD
va_list args;
const opt_spec *s;
optvalue values[MAXOPTIONS];
term_t list = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
term_t tmp = PL_new_term_ref();
term_t val = PL_new_term_ref();
int n;
if ( truePrologFlag(PLFLAG_ISO) )
flags |= OPT_ALL;
va_start(args, specs);
for( n=0, s = specs; s->name; s++, n++ )
values[n].ptr = va_arg(args, void *);
va_end(args);
while ( PL_get_list(list, head, list) )
{ atom_t name;
int arity;
if ( PL_get_name_arity(head, &name, &arity) )
{ if ( name == ATOM_equals && arity == 2 )
{ _PL_get_arg(1, head, tmp);
if ( !PL_get_atom(tmp, &name) )
goto itemerror;
_PL_get_arg(2, head, val);
} else if ( arity == 1 )
{ _PL_get_arg(1, head, val);
} else if ( arity == 0 )
PL_put_atom(val, ATOM_true);
} else if ( PL_is_variable(head) )
{ return PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
} else
{ itemerror:
return PL_error(NULL, 0, NULL, ERR_DOMAIN, optype, head);
}
for( n=0, s = specs; s->name; n++, s++ )
{ if ( s->name == name )
{ switch((s->type & OPT_TYPE_MASK))
{ case OPT_BOOL:
{ int bval;
if ( !PL_get_bool_ex(val, &bval) )
return FALSE;
*values[n].b = bval;
break;
}
case OPT_INT:
{ if ( !PL_get_integer_ex(val, values[n].i) )
return FALSE;
break;
}
case OPT_LONG:
{ if ( (s->type & OPT_INF) && PL_is_inf(val) )
*values[n].l = LONG_MAX;
else if ( !PL_get_long_ex(val, values[n].l) )
return FALSE;
break;
}
case OPT_NATLONG:
{ if ( !PL_get_long_ex(val, values[n].l) )
return FALSE;
if ( *(values[n].l) <= 0 )
return PL_error(NULL, 0, NULL, ERR_DOMAIN,
ATOM_not_less_than_one, val);
break;
}
case OPT_SIZE:
{ if ( (s->type & OPT_INF) && PL_is_inf(val) )
*values[n].sz = (size_t)-1;
else if ( !PL_get_size_ex(val, values[n].sz) )
return FALSE;
break;
}
case OPT_DOUBLE:
{ if ( !PL_get_float_ex(val, values[n].f) )
return FALSE;
break;
}
case OPT_STRING:
{ char *str;
if ( !PL_get_chars(val, &str, CVT_ALL|CVT_EXCEPTION) ) /* copy? */
return FALSE;
*values[n].s = str;
break;
}
case OPT_ATOM:
{ atom_t a;
if ( !PL_get_atom_ex(val, &a) )
return FALSE;
*values[n].a = a;
break;
}
#ifdef O_LOCALE
case OPT_LOCALE:
{ PL_locale *l;
PL_locale **lp = values[n].ptr;
if ( !getLocaleEx(val, &l) )
return FALSE;
*lp = l;
break;
}
#endif
case OPT_TERM:
{ *values[n].t = val;
val = PL_new_term_ref(); /* can't reuse anymore */
break;
}
default:
assert(0);
fail;
}
break;
}
}
if ( !s->name && (flags & OPT_ALL) )
goto itemerror;
}
if ( !PL_get_nil(list) )
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, list);
succeed;
}
int
PL_error(const char *pred, int arity, const char *msg, PL_error_code id, ...)
{ GET_LD
char msgbuf[50];
Definition caller;
term_t except, formal, swi, msgterm=0;
va_list args;
int do_throw = FALSE;
fid_t fid;
int rc;
if ( exception_term ) /* do not overrule older exception */
return FALSE;
if ( environment_frame )
caller = environment_frame->predicate;
else
caller = NULL;
if ( id == ERR_FILE_OPERATION &&
!truePrologFlag(PLFLAG_FILEERRORS) )
fail;
if ( msg == MSG_ERRNO )
{ if ( errno == EPLEXCEPTION )
return FALSE;
msg = OsError();
}
LD->exception.processing = TRUE; /* allow using spare stack */
if ( !(fid = PL_open_foreign_frame()) )
goto nomem;
except = PL_new_term_ref();
formal = PL_new_term_ref();
swi = PL_new_term_ref();
/* build (ISO) formal part */
va_start(args, id);
switch(id)
{ case ERR_INSTANTIATION:
err_instantiation:
rc = PL_unify_atom(formal, ATOM_instantiation_error);
break;
case ERR_UNINSTANTIATION:
{ int argn = va_arg(args, int);
term_t bound = va_arg(args, term_t);
if ( !msg && argn > 0 )
{ Ssprintf(msgbuf, "%d-%s argument",
argn, argn == 1 ? "st" : argn == 2 ? "nd" : "th");
msg = msgbuf;
}
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_uninstantiation_error1,
PL_TERM, bound);
break;
}
case ERR_TYPE: /* ERR_INSTANTIATION if var(actual) */
{ atom_t expected = va_arg(args, atom_t);
term_t actual = va_arg(args, term_t);
case_type_error:
if ( expected == ATOM_callable )
rewrite_callable(&expected, actual);
if ( PL_is_variable(actual) && expected != ATOM_variable )
goto err_instantiation;
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_ATOM, expected,
PL_TERM, actual);
break;
case ERR_PTR_TYPE: /* atom_t, Word */
{ Word ptr;
expected = va_arg(args, atom_t);
ptr = va_arg(args, Word);
actual = PL_new_term_ref();
*valTermRef(actual) = *ptr;
goto case_type_error;
}
}
case ERR_CHARS_TYPE: /* ERR_INSTANTIATION if var(actual) */
{ const char *expected = va_arg(args, const char*);
term_t actual = va_arg(args, term_t);
if ( PL_is_variable(actual) && !streq(expected, "variable") )
goto err_instantiation;
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_CHARS, expected,
PL_TERM, actual);
break;
}
case ERR_AR_TYPE: /* arithmetic type error */
{ atom_t expected = va_arg(args, atom_t);
Number num = va_arg(args, Number);
term_t actual = PL_new_term_ref();
rc = (_PL_put_number(actual, num) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_ATOM, expected,
PL_TERM, actual));
break;
}
case ERR_AR_DOMAIN:
{ atom_t domain = va_arg(args, atom_t);
Number num = va_arg(args, Number);
term_t actual = PL_new_term_ref();
rc = (_PL_put_number(actual, num) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_domain_error2,
PL_ATOM, domain,
PL_TERM, actual));
break;
}
case ERR_AR_UNDEF:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, ATOM_undefined);
break;
}
case ERR_AR_OVERFLOW:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, ATOM_float_overflow);
break;
}
case ERR_AR_UNDERFLOW:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, ATOM_float_underflow);
break;
}
case ERR_DOMAIN: /* ERR_INSTANTIATION if var(arg) */
{ atom_t domain = va_arg(args, atom_t);
term_t arg = va_arg(args, term_t);
if ( PL_is_variable(arg) )
goto err_instantiation;
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_domain_error2,
PL_ATOM, domain,
PL_TERM, arg);
break;
}
case ERR_RANGE: /* domain_error(range(low,high), arg) */
{ term_t low = va_arg(args, term_t);
term_t high = va_arg(args, term_t);
term_t arg = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_domain_error2,
PL_FUNCTOR, FUNCTOR_range2,
PL_TERM, low,
PL_TERM, high,
PL_TERM, arg);
break;
}
case ERR_REPRESENTATION:
{ atom_t what = va_arg(args, atom_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_representation_error1,
PL_ATOM, what);
break;
}
{ Definition def; /* shared variables */
Procedure proc;
term_t pred;
case ERR_MODIFY_STATIC_PROC:
proc = va_arg(args, Procedure);
def = proc->definition;
goto modify_static;
case ERR_MODIFY_STATIC_PREDICATE:
def = va_arg(args, Definition);
modify_static:
rc = ((pred = PL_new_term_ref()) &&
unify_definition(MODULE_user, pred, def, 0,
GP_NAMEARITY|GP_HIDESYSTEM) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, ATOM_modify,
PL_ATOM, ATOM_static_procedure,
PL_TERM, pred));
break;
}
case ERR_MODIFY_THREAD_LOCAL_PROC:
{ Procedure proc = va_arg(args, Procedure);
term_t pred = PL_new_term_ref();
rc = (unify_definition(MODULE_user, pred, proc->definition, 0,
GP_NAMEARITY|GP_HIDESYSTEM) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, ATOM_modify,
PL_ATOM, ATOM_thread_local_procedure,
PL_TERM, pred));
break;
}
case ERR_UNDEFINED_PROC:
{ Definition def = va_arg(args, Definition);
Definition clr = va_arg(args, Definition);
term_t pred = PL_new_term_ref();
if ( clr )
caller = clr;
rc = (unify_definition(MODULE_user, pred, def, 0, GP_NAMEARITY) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, ATOM_procedure,
PL_TERM, pred));
break;
}
case ERR_PERMISSION_PROC:
{ atom_t op = va_arg(args, atom_t);
atom_t type = va_arg(args, atom_t);
predicate_t pred = va_arg(args, predicate_t);
term_t pi = PL_new_term_ref();
rc = ( PL_unify_predicate(pi, pred, GP_NAMEARITY|GP_HIDESYSTEM) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, op,
PL_ATOM, type,
PL_TERM, pi));
break;
}
case ERR_NOT_IMPLEMENTED_PROC:
{ const char *name = va_arg(args, const char *);
int arity = va_arg(args, int);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_not_implemented2,
PL_ATOM, ATOM_procedure,
PL_FUNCTOR, FUNCTOR_divide2,
PL_CHARS, name,
PL_INT, arity);
break;
}
case ERR_IMPORT_PROC:
{ predicate_t pred = va_arg(args, predicate_t);
atom_t dest = va_arg(args, atom_t);
atom_t old = va_arg(args, atom_t);
term_t pi = PL_new_term_ref();
rc = ( PL_unify_predicate(pi, pred, GP_NAMEARITY) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_FUNCTOR, FUNCTOR_import_into1,
PL_ATOM, dest,
PL_ATOM, ATOM_procedure,
PL_TERM, pi));
if ( rc && old )
{ rc = ( (msgterm = PL_new_term_ref()) &&
PL_unify_term(msgterm,
PL_FUNCTOR_CHARS, "already_from", 1,
PL_ATOM, old) );
}
break;
}
case ERR_FAILED:
{ term_t goal = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_failure_error1,
PL_TERM, goal);
break;
}
case ERR_EVALUATION:
{ atom_t what = va_arg(args, atom_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, what);
break;
}
case ERR_NOT_EVALUABLE:
{ functor_t f = va_arg(args, functor_t);
term_t actual = PL_new_term_ref();
rc = (put_name_arity(actual, f) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_ATOM, ATOM_evaluable,
PL_TERM, actual));
break;
}
case ERR_DIV_BY_ZERO:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, ATOM_zero_divisor);
break;
}
case ERR_PERMISSION:
{ atom_t op = va_arg(args, atom_t);
atom_t type = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, op,
PL_ATOM, type,
PL_TERM, obj);
break;
}
case ERR_OCCURS_CHECK:
{ Word p1 = va_arg(args, Word);
Word p2 = va_arg(args, Word);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_occurs_check2,
PL_TERM, pushWordAsTermRef(p1),
PL_TERM, pushWordAsTermRef(p2));
popTermRef();
popTermRef();
break;
}
case ERR_TIMEOUT:
{ atom_t op = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_timeout_error2,
PL_ATOM, op,
PL_TERM, obj);
break;
}
case ERR_EXISTENCE:
{ atom_t type = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, type,
PL_TERM, obj);
break;
}
case ERR_EXISTENCE3:
{ atom_t type = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
term_t in = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error3,
PL_ATOM, type,
PL_TERM, obj,
PL_TERM, in);
break;
}
case ERR_FILE_OPERATION:
{ atom_t action = va_arg(args, atom_t);
atom_t type = va_arg(args, atom_t);
term_t file = va_arg(args, term_t);
switch(errno)
{ case EAGAIN:
action = ATOM_lock; /* Hack for file-locking*/
/*FALLTHROUGH*/
case EACCES:
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, action,
PL_ATOM, type,
PL_TERM, file);
break;
case EMFILE:
case ENFILE:
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_max_files);
break;
#ifdef EPIPE
case EPIPE:
if ( !msg )
msg = "Broken pipe";
/*FALLTHROUGH*/
#endif
default: /* what about the other cases? */
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, type,
PL_TERM, file);
break;
}
break;
}
case ERR_STREAM_OP:
{ atom_t action = va_arg(args, atom_t);
term_t stream = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_io_error2,
PL_ATOM, action,
PL_TERM, stream);
break;
}
case ERR_DDE_OP:
{ const char *op = va_arg(args, const char *);
const char *err = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_dde_error2,
PL_CHARS, op,
PL_CHARS, err);
break;
}
case ERR_SHARED_OBJECT_OP:
{ atom_t action = va_arg(args, atom_t);
const char *err = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_shared_object2,
PL_ATOM, action,
PL_CHARS, err);
break;
}
case ERR_NOT_IMPLEMENTED: /* non-ISO */
{ const char *what = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_not_implemented2,
PL_ATOM, ATOM_feature,
PL_CHARS, what);
break;
}
case ERR_RESOURCE:
{ atom_t what = va_arg(args, atom_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, what);
break;
}
case ERR_SYNTAX:
{ const char *what = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_syntax_error1,
PL_CHARS, what);
break;
}
case ERR_NOMEM:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_no_memory);
break;
}
case ERR_SYSCALL:
{ const char *op = va_arg(args, const char *);
if ( !msg )
msg = op;
switch(errno)
{ case ENOMEM:
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_no_memory);
break;
default:
rc = PL_unify_atom(formal, ATOM_system_error);
break;
}
break;
}
case ERR_SHELL_FAILED:
{ term_t cmd = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_shell2,
PL_ATOM, ATOM_execute,
PL_TERM, cmd);
break;
}
case ERR_SHELL_SIGNALLED:
{ term_t cmd = va_arg(args, term_t);
int sig = va_arg(args, int);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_shell2,
PL_FUNCTOR, FUNCTOR_signal1,
PL_INT, sig,
PL_TERM, cmd);
break;
}
case ERR_SIGNALLED:
{ int sig = va_arg(args, int);
char *signame = va_arg(args, char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_signal2,
PL_CHARS, signame,
PL_INT, sig);
break;
}
case ERR_CLOSED_STREAM:
{ IOSTREAM *s = va_arg(args, IOSTREAM *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, ATOM_stream,
PL_POINTER, s);
do_throw = TRUE;
break;
}
case ERR_BUSY:
{ atom_t type = va_arg(args, atom_t);
term_t mutex = va_arg(args, term_t);
rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_busy2, type, mutex);
break;
}
case ERR_FORMAT:
{ const char *s = va_arg(args, const char*);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "format", 1,
PL_CHARS, s);
break;
}
case ERR_FORMAT_ARG:
{ const char *s = va_arg(args, const char*);
term_t arg = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "format_argument_type", 2,
PL_CHARS, s,
PL_TERM, arg);
break;
}
case ERR_DUPLICATE_KEY:
{ term_t key = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_duplicate_key1,
PL_TERM, key);
break;
}
default:
assert(0);
}
va_end(args);
/* build SWI-Prolog context term */
if ( rc && (pred || msg || msgterm || caller) )
{ term_t predterm = PL_new_term_ref();
if ( !msgterm )
msgterm = PL_new_term_ref();
if ( pred )
{ rc = PL_unify_term(predterm,
PL_FUNCTOR, FUNCTOR_divide2,
PL_CHARS, pred,
PL_INT, arity);
} else if ( caller )
{ rc = unify_definition(MODULE_user, predterm, caller, 0, GP_NAMEARITY);
}
if ( rc && msg )
{ rc = PL_put_atom_chars(msgterm, msg);
}
if ( rc )
rc = PL_unify_term(swi,
PL_FUNCTOR, FUNCTOR_context2,
PL_TERM, predterm,
PL_TERM, msgterm);
}
if ( rc )
rc = PL_unify_term(except,
PL_FUNCTOR, FUNCTOR_error2,
PL_TERM, formal,
PL_TERM, swi);
if ( !rc )
{ nomem:
fatalError("Cannot report error: no memory");
}
if ( do_throw )
rc = PL_throw(except);
else
rc = PL_raise_exception(except);
PL_close_foreign_frame(fid);
return rc;
}
static int
get_ftm(term_t t, ftm *ftm)
{ GET_LD
term_t tmp = PL_new_term_ref();
int date9;
memset(ftm, 0, sizeof(*ftm));
if ( (date9=PL_is_functor(t, FUNCTOR_date9)) )
{ if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
get_int_arg (2, t, tmp, &ftm->tm.tm_mon) &&
get_int_arg (3, t, tmp, &ftm->tm.tm_mday) &&
get_int_arg (4, t, tmp, &ftm->tm.tm_hour) &&
get_int_arg (5, t, tmp, &ftm->tm.tm_min) &&
get_float_arg(6, t, tmp, &ftm->sec) &&
get_voff_arg (7, t, tmp, &ftm->utcoff) &&
get_tz_arg (8, t, tmp, &ftm->tzname) &&
get_dst_arg (9, t, tmp, &ftm->isdst) )
{ double fp, ip;
ftm->tm.tm_isdst = (ftm->isdst == -2 ? -1 : ftm->isdst);
fixup:
fp = modf(ftm->sec, &ip);
if ( fp < 0.0 )
{ fp += 1.0;
ip -= 1.0;
}
ftm->tm.tm_sec = (int)ip;
ftm->tm.tm_year -= 1900; /* 1900 based */
ftm->tm.tm_mon--; /* 0-based */
if ( ftm->utcoff == NO_UTC_OFFSET )
{ if ( ftm->tm.tm_isdst < 0 ) /* unknown DST */
{ int offset;
if ( mktime(&ftm->tm) == (time_t)-1 )
return PL_representation_error("dst");
ftm->flags |= HAS_WYDAY;
offset = tz_offset();
if ( ftm->tm.tm_isdst > 0 )
offset -= 3600;
ftm->utcoff = offset;
if ( date9 ) /* variable */
{ _PL_get_arg(7, t, tmp);
if ( !PL_unify_integer(tmp, ftm->utcoff) )
return FALSE;
} else
{ ftm->utcoff = offset;
}
}
if ( ftm->isdst == -2 )
{ ftm->isdst = ftm->tm.tm_isdst;
_PL_get_arg(9, t, tmp);
if ( ftm->isdst < 0 )
{ if ( !PL_unify_atom(tmp, ATOM_minus) )
return FALSE;
} else
{ if ( !PL_unify_bool(tmp, ftm->isdst) )
return FALSE;
}
}
if ( !ftm->tzname )
{ ftm->tzname = tz_name_as_atom(ftm->isdst);
_PL_get_arg(8, t, tmp);
if ( PL_is_variable(tmp) &&
!PL_unify_atom(tmp, ftm->tzname) )
return FALSE;
}
}
succeed;
}
} else if ( PL_is_functor(t, FUNCTOR_date3) )
{ if ( get_int_arg (1, t, tmp, &ftm->tm.tm_year) &&
get_int_arg (2, t, tmp, &ftm->tm.tm_mon) &&
get_int_arg (3, t, tmp, &ftm->tm.tm_mday) )
{ ftm->tm.tm_isdst = -1;
ftm->utcoff = NO_UTC_OFFSET;
goto fixup;
}
}
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_time, t);
}
static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
term_t tf) {
PyObject *pF;
PyObject *pArgs, *pKeywords;
PyObject *pValue;
int i, arity;
atom_t aname;
foreign_t out;
term_t targ = PL_new_term_ref();
pF = term_to_python(tin, true);
PyErr_Clear();
if (pF == NULL) {
{
return false;
}
}
if (PL_is_atom(targs)) {
pArgs = NULL;
} else {
if (!PL_get_name_arity(targs, &aname, &arity)) {
{
return false;
}
}
if (arity == 1 && PL_get_arg(1, targs, targ) && PL_is_variable(targ)) {
/* ignore (_) */
pArgs = NULL;
} else {
pArgs = PyTuple_New(arity);
if (!pArgs) {
return false;
}
for (i = 0; i < arity; i++) {
PyObject *pArg;
if (!PL_get_arg(i + 1, targs, targ)) {
return false;
}
pArg = term_to_python(targ, true);
if (pArg == NULL) {
return false;
}
/* pArg reference stolen here: */
PyTuple_SetItem(pArgs, i, pArg);
}
}
}
if (PL_is_atom(keywds)) {
pKeywords = NULL;
} else {
pKeywords = term_to_python(keywds, true);
}
if (PyCallable_Check(pF)) {
pValue = PyEval_CallObjectWithKeywords(pF, pArgs, pKeywords);
// PyObject_Print(pF,stderr,0);fprintf(stderr, "\n");
// PyObject_Print(pArgs,stderr,0);fprintf(stderr, " ");
// PyObject_Print(pKeywords,stderr,0);fprintf(stderr, "\n");
if (!pValue)
PyErr_Print();
else
Py_IncRef(pValue);
} else if (pArgs == NULL) {
pValue = pF;
if (pF) {
Py_IncRef(pValue);
}
} else {
PyErr_Print();
{
return false;
}
}
if (pArgs)
Py_DECREF(pArgs);
Py_DECREF(pF);
if (pValue == NULL) {
return false;
}
out = python_to_ptr(pValue, tf);
return out;
}
static foreign_t python_builtin_eval(term_t caller, term_t dict, term_t out) {
PyObject *pI, *pArgs, *pOut;
PyObject *env;
atom_t name;
char *s;
int i, arity;
term_t targ = PL_new_term_ref();
if ((env = py_Builtin) == NULL) {
// no point in even trying
{
return false;
}
}
if (PL_get_name_arity(caller, &name, &arity)) {
if (!(s = PL_atom_chars(name))) {
return false;
}
if ((pI = PyObject_GetAttrString(env, s)) == NULL) {
PyErr_Print();
{
return false;
}
}
} else {
// Prolog should make sure this never happens.
{
return false;
}
}
pArgs = PyTuple_New(arity);
for (i = 0; i < arity; i++) {
PyObject *pArg;
if (!PL_get_arg(i + 1, caller, targ)) {
return false;
}
/* ignore (_) */
if (i == 0 && PL_is_variable(targ)) {
pArg = Py_None;
} else {
pArg = term_to_python(targ, true);
if (pArg == NULL) {
return false;
}
}
/* pArg reference stolen here: */
if (PyTuple_SetItem(pArgs, i, pArg)) {
PyErr_Print();
{
return false;
}
}
}
pOut = PyObject_CallObject(pI, pArgs);
Py_DECREF(pArgs);
Py_DECREF(pI);
if (pOut == NULL) {
PyErr_Print();
{
return false;
}
}
{
foreign_t rc = python_to_ptr(pOut, out);
;
return rc;
}
}
static foreign_t python_access(term_t obj, term_t f, term_t out) {
PyObject *o = term_to_python(obj, true), *pValue, *pArgs, *pF;
atom_t name;
char *s;
int i, arity;
term_t targ = PL_new_term_ref();
if (o == NULL) {
return false;
}
if (PL_is_atom(f)) {
if (!PL_get_atom_chars(f, &s)) {
return false;
}
if ((pValue = PyObject_GetAttrString(o, s)) == NULL) {
PyErr_Print();
{
return false;
}
}
{
return python_to_term(pValue, out);
}
}
if (!PL_get_name_arity(f, &name, &arity)) {
{
return false;
}
}
/* follow chains of the form a.b.c.d.e() */
while (name == ATOM_dot && arity == 2) {
term_t tleft = PL_new_term_ref();
PyObject *lhs;
if (!PL_get_arg(1, f, tleft)) {
return false;
}
lhs = term_to_python(tleft, true);
if ((o = PyObject_GetAttr(o, lhs)) == NULL) {
PyErr_Print();
{
return false;
}
}
if (!PL_get_arg(2, f, f)) {
return false;
}
if (!PL_get_name_arity(f, &name, &arity)) {
{
return false;
}
}
}
s = PL_atom_chars(name);
if (!s) {
return false;
}
if ((pF = PyObject_GetAttrString(o, s)) == NULL) {
PyErr_Print();
{
return false;
}
}
pArgs = PyTuple_New(arity);
for (i = 0; i < arity; i++) {
PyObject *pArg;
if (!PL_get_arg(i + 1, f, targ)) {
return false;
}
/* ignore (_) */
if (i == 0 && PL_is_variable(targ)) {
pArgs = Py_None;
}
pArg = term_to_python(targ, true);
if (pArg == NULL) {
return false;
}
/* pArg reference stolen here: */
PyTuple_SetItem(pArgs, i, pArg);
}
pValue = PyObject_CallObject(pF, pArgs);
Py_DECREF(pArgs);
Py_DECREF(pF);
if (pValue == NULL) {
{
return false;
}
}
{
return python_to_term(pValue, out);
}
}
