static foreign_t
uri_query_components(term_t string, term_t list)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(string, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ return unify_query_string_components(list, len, s);
} else if ( PL_is_list(list) )
{ term_t tail = PL_copy_term_ref(list);
term_t head = PL_new_term_ref();
term_t nv = PL_new_term_refs(2);
charbuf out;
int rc;
fill_flags();
init_charbuf(&out);
while( PL_get_list(tail, head, tail) )
{ atom_t fname;
int arity;
if ( PL_is_functor(head, FUNCTOR_equal2) ||
PL_is_functor(head, FUNCTOR_pair2) )
{ _PL_get_arg(1, head, nv+0);
_PL_get_arg(2, head, nv+1);
} else if ( PL_get_name_arity(head, &fname, &arity) && arity == 1 )
{ PL_put_atom(nv+0, fname);
_PL_get_arg(1, head, nv+1);
} else
{ free_charbuf(&out);
return type_error("name_value", head);
}
if ( out.here != out.base )
add_charbuf(&out, '&');
if ( !add_encoded_term_charbuf(&out, nv+0, ESC_QNAME) )
{ free_charbuf(&out);
return FALSE;
}
add_charbuf(&out, '=');
if ( !add_encoded_term_charbuf(&out, nv+1, ESC_QVALUE) )
{ free_charbuf(&out);
return FALSE;
}
}
rc = PL_unify_wchars(string, PL_ATOM, out.here-out.base, out.base);
free_charbuf(&out);
return rc;
} else
{ return PL_get_wchars(string, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
return FALSE;
}
static int
put_write_options(term_t opts_in, write_options *options)
{ GET_LD
term_t newlist = PL_new_term_ref();
term_t precopt = PL_new_term_ref();
fid_t fid = PL_open_foreign_frame();
term_t head = PL_new_term_ref();
term_t tail = PL_copy_term_ref(opts_in);
term_t newhead = PL_new_term_ref();
term_t newtail = PL_copy_term_ref(newlist);
int rc = TRUE;
while(rc && PL_get_list(tail, head, tail))
{ if ( !PL_is_functor(head, FUNCTOR_priority1) )
rc = ( PL_unify_list(newtail, newhead, newtail) &&
PL_unify(newhead, head) );
}
if ( rc )
{ rc = ( PL_unify_list(newtail, head, newtail) &&
PL_unify_functor(head, FUNCTOR_priority1) &&
PL_get_arg(1, head, precopt) &&
PL_unify_nil(newtail) );
}
if ( rc )
{ options->write_options = newlist;
options->prec_opt = precopt;
}
PL_close_foreign_frame(fid);
return rc;
}
int
get_prefixed_iri(rdf_db *db, term_t t, atom_t *ap)
{ if ( PL_is_functor(t, FUNCTOR_colon2) )
{ term_t a = PL_new_term_ref();
atom_t alias, local, uri;
_PL_get_arg(1, t, a);
if ( !PL_get_atom(a, &alias) )
return FALSE;
_PL_get_arg(2, t, a);
if ( !PL_get_atom(a, &local) )
return FALSE;
if ( (uri = cached_expansion(alias, local)) )
{ *ap = uri;
return TRUE;
}
if ( (uri = expand_prefix(db, alias, local)) )
{ cache_expansion(alias, local, uri);
*ap = uri;
return TRUE;
}
}
return FALSE;
}
static int conj_size(term_t source) {
if (PL_is_functor(source, FUNCTOR_comma2)) {
term_t a1 = PL_new_term_ref(), a2 = PL_new_term_ref();
if (PL_get_arg(1, source, a1) <= 0 || PL_get_arg(2, source, a2) <= 0)
return -1;
return conj_size(a1) + conj_size(a2);
}
return 1;
}
static int get_assumption(term_t t, clingo_symbolic_literal_t *assump) {
if (PL_is_functor(t, FUNCTOR_tilde1)) {
_PL_get_arg(1, t, t);
assump->positive = FALSE;
} else {
assump->positive = TRUE;
}
return get_value(t, &assump->symbol, FALSE);
}
static int
parse_environment(term_t t, p_options *info)
{ term_t tail = PL_copy_term_ref(t);
term_t head = PL_new_term_ref();
term_t tmp = PL_new_term_ref();
ecbuf *eb = &info->envbuf;
int count = 0;
#ifndef __WINDOWS__
echar *q;
char **ep;
int c = 0;
#endif
assert(eb->size == 0);
assert(eb->allocated == 0);
assert(eb->buffer == NULL);
while( PL_get_list(tail, head, tail) )
{ echar *s;
size_t len;
if ( !PL_is_functor(head, FUNCTOR_eq2) )
return type_error(head, "environment_variable");
if ( !get_echars_arg_ex(1, head, tmp, &s, &len) )
return FALSE;
add_ecbuf(eb, s, len);
add_ecbuf(eb, ECHARS("="), 1);
if ( !get_echars_arg_ex(2, head, tmp, &s, &len) )
return FALSE;
add_ecbuf(eb, s, len);
add_ecbuf(eb, ECHARS("\0"), 1);
count++;
}
if ( !PL_get_nil(tail) )
return type_error(tail, "list");
#ifdef __WINDOWS__
add_ecbuf(eb, ECHARS("\0"), 1);
#else
info->envp = PL_malloc((count+1)*sizeof(char*));
for(ep=info->envp, c=0, q=eb->buffer; c<count; c++, ep++)
{ *ep = q;
q += strlen(q)+1;
}
assert((size_t)(q-eb->buffer) == eb->size);
*ep = NULL;
#endif
return TRUE;
}
static foreign_t
p_setrand(term_t state)
{ if ( !PL_is_functor(state, FUNCTOR_rand3) )
return PL_type_error("rand_state", state);
if ( !get_short_arg_ex(1, state, &a1) ||
!get_short_arg_ex(2, state, &b1) ||
!get_short_arg_ex(3, state, &c1) )
return FALSE;
return TRUE;
}
static int conj_copy(term_t target, PyObject *e, int pos) {
if (PL_is_functor(target, FUNCTOR_comma2)) {
term_t a1 = PL_new_term_ref(), a2 = PL_new_term_ref();
if (PL_get_arg(1, target, a1) <= 0 || PL_get_arg(2, target, a2) <= 0)
return -1;
int p1 = conj_copy(a1, e, pos);
return conj_copy(a2, e, p1);
} else {
assign_python(py_Main, target, PyTuple_GetItem(e, pos));
return pos + 1;
}
}
static foreign_t
uri_authority_components(term_t Authority, term_t components)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(Authority, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ return unify_uri_authority_components(components, len, s);
} else if ( PL_is_functor(components, FUNCTOR_uri_authority4) )
{ charbuf b;
int rc;
init_charbuf(&b);
if ( (rc=get_text_arg(components, 1, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
if ( (rc=get_text_arg(components, 2, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, ':');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
add_charbuf(&b, '@');
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
if ( (rc=get_text_arg(components, 3, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
if ( (rc=get_text_arg(components, 4, &len, &s,
TXT_EX_TEXT|CVT_INTEGER)) == TRUE )
{ add_charbuf(&b, ':');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
rc = PL_unify_wchars(Authority, PL_ATOM, b.here-b.base, b.base);
free_charbuf(&b);
return rc;
} else
{ return PL_get_wchars(Authority, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
}
static foreign_t python_export(term_t t, term_t pl) {
foreign_t rc = false;
if (PL_is_functor(t, FUNCTOR_pointer1)) {
void *ptr;
term_t targ = PL_new_term_ref();
if (!PL_get_arg(1, t, targ)) {
return false;
}
if (!PL_get_pointer(targ, &ptr)) {
return false;
}
Py_INCREF((PyObject *)ptr);
/* return __main__,s */
rc = python_to_term((PyObject *)ptr, pl);
}
return rc;
}
tcp_get_socket(term_t Socket, int *id)
{ IOSTREAM *s;
int socket;
if ( PL_is_functor(Socket, FUNCTOR_socket1) )
{ term_t a = PL_new_term_ref();
_PL_get_arg(1, Socket, a);
if ( PL_get_integer(a, id) )
return TRUE;
}
if ( PL_get_stream_handle(Socket, &s) )
{ socket = (int)(intptr_t)s->handle;
*id = socket;
return TRUE;
}
return pl_error(NULL, 0, NULL, ERR_ARGTYPE, -1, Socket, "socket");
}
static int
get_stream(term_t t, p_options *info, p_stream *stream)
{ atom_t a;
if ( PL_get_atom(t, &a) )
{ if ( a == ATOM_null )
{ stream->type = std_null;
return TRUE;
} else if ( a == ATOM_std )
{ stream->type = std_std;
return TRUE;
} else
{ return domain_error(t, "process_stream");
}
} else if ( PL_is_functor(t, FUNCTOR_pipe1) )
{ stream->term = PL_new_term_ref();
_PL_get_arg(1, t, stream->term);
stream->type = std_pipe;
info->pipes++;
return TRUE;
} else
return type_error(t, "process_stream");
}
static int
get_timer(term_t t, Event *ev)
{ if ( PL_is_functor(t, FUNCTOR_alarm1) )
{ term_t a = PL_new_term_ref();
void *p;
_PL_get_arg(1, t, a);
if ( PL_get_pointer(a, &p) )
{ Event e = p;
if ( e->magic == EV_MAGIC )
{ *ev = e;
return TRUE;
} else
{ return pl_error("get_timer", 1, NULL,
ERR_DOMAIN, t, "alarm");
}
}
}
return pl_error("get_timer", 1, NULL,
ERR_ARGTYPE, 1, t, "alarm");
}
static void
rewrite_callable(atom_t *expected, term_t actual)
{ GET_LD
term_t a = 0;
int loops = 0;
while ( PL_is_functor(actual, FUNCTOR_colon2) )
{ if ( !a )
a = PL_new_term_ref();
_PL_get_arg(1, actual, a);
if ( !PL_is_atom(a) )
{ *expected = ATOM_atom;
PL_put_term(actual, a);
return;
} else
{ _PL_get_arg(2, actual, a);
PL_put_term(actual, a);
}
if ( ++loops > 100 && !PL_is_acyclic(actual) )
break;
}
}
int
is_literal(term_t t)
{ return PL_is_functor(t, FUNCTOR_literal1);
}
static int
nbio_get_tipc(term_t tipc, struct sockaddr_tipc *sockaddr)
{ term_t a = PL_new_term_ref();
sockaddr->family = AF_TIPC;
do
{
if ( PL_is_functor(tipc, FUNCTOR_port_id) )
{
unsigned ref, node;
_PL_get_arg(1, tipc, a);
if ( !get_uint(a, &ref) )
break;
_PL_get_arg(2, tipc, a);
if ( !get_uint(a, &node) )
break;
sockaddr->addrtype = TIPC_ADDR_ID;
sockaddr->addr.id.ref = ref;
sockaddr->addr.id.node = node;
return TRUE;
}
if ( PL_is_functor(tipc, FUNCTOR_name3) )
{
unsigned arg1, arg2, arg3;
_PL_get_arg(1, tipc, a);
if ( !get_uint(a, &arg1) )
break;
_PL_get_arg(2, tipc, a);
if ( !get_uint(a, &arg2) )
break;
_PL_get_arg(3, tipc, a);
if ( !get_uint(a, &arg3) )
break;
sockaddr->addrtype = TIPC_ADDR_NAME;
sockaddr->addr.name.name.type = arg1;
sockaddr->addr.name.name.instance = arg2;
sockaddr->addr.name.domain = arg3;
return TRUE;
}
if ( PL_is_functor(tipc, FUNCTOR_name_seq3) ||
PL_is_functor(tipc, FUNCTOR_mcast3))
{
unsigned arg1, arg2, arg3;
_PL_get_arg(1, tipc, a);
if ( !get_uint(a, &arg1) )
break;
_PL_get_arg(2, tipc, a);
if ( !get_uint(a, &arg2) )
break;
_PL_get_arg(3, tipc, a);
if ( !get_uint(a, &arg3) )
break;
sockaddr->addrtype = TIPC_ADDR_NAMESEQ;
sockaddr->addr.nameseq.type = arg1;
sockaddr->addr.nameseq.lower = arg2;
sockaddr->addr.nameseq.upper = arg3;
return TRUE;
}
} while(FALSE);
return FALSE;
}
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
uri_components(term_t URI, term_t components)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(URI, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ uri_component_ranges ranges;
term_t rt = PL_new_term_refs(6);
term_t av = rt+1;
parse_uri(&ranges, len, s);
unify_range(av+0, &ranges.scheme);
unify_range(av+1, &ranges.authority);
unify_range(av+2, &ranges.path);
unify_range(av+3, &ranges.query);
unify_range(av+4, &ranges.fragment);
return (PL_cons_functor_v(rt, FUNCTOR_uri_components5, av) &&
PL_unify(components, rt));
} else if ( PL_is_functor(components, FUNCTOR_uri_components5) )
{ charbuf b;
int rc;
init_charbuf(&b);
/* schema */
if ( (rc=get_text_arg(components, 1, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
add_charbuf(&b, ':');
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* authority */
if ( (rc=get_text_arg(components, 2, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, '/');
add_charbuf(&b, '/');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* path */
if ( (rc=get_text_arg(components, 3, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* query */
if ( (rc=get_text_arg(components, 4, &len, &s, TXT_EX_TEXT)) == TRUE )
{ if ( len > 0 )
{ add_charbuf(&b, '?');
add_nchars_charbuf(&b, len, s);
}
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* fragment */
if ( (rc=get_text_arg(components, 5, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, '#');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
rc = PL_unify_wchars(URI, PL_ATOM, b.here-b.base, b.base);
free_charbuf(&b);
return rc;
} else /* generate an error */
{ return PL_get_wchars(URI, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
}
