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;
}
/*
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;
}
}
}
// parse a term representing argument types - types can be a list
// as accepted by get_types_list() above or the atom 'any'
static int get_types(term_t types, char *buffer, int len, char **typespec)
{
if (PL_is_list(types)) {
*typespec=buffer;
return get_types_list(types,buffer,len);
} else if (PL_is_atom(types)) {
char *a;
PL_get_atom_chars(types,&a);
if (strcmp(a,"any")==0) { *typespec=NULL; return TRUE; }
else return type_error(types,"list or 'any'");
} else return type_error(types,"list or 'any'");
}
/********************
* pl_fact_exists
********************/
static foreign_t
pl_fact_exists(term_t pl_name,
term_t pl_fields, term_t pl_list, control_t handle)
{
context_t *ctx;
char *name, factname[64];
fid_t frame;
term_t pl_values;
OhmFact *f;
switch (PL_foreign_control(handle)) {
case PL_FIRST_CALL:
if (!PL_is_list(pl_fields) || /*!PL_is_list(pl_list) ||*/
!PL_get_chars(pl_name, &name, CVT_ALL))
PL_fail;
strncpy(factname, name, sizeof(factname));
factname[sizeof(factname)-1] = '\0';
if ((ctx = malloc(sizeof(*ctx))) == NULL)
PL_fail;
memset(ctx, 0, sizeof(*ctx));
if (get_field_names(ctx, pl_fields) != 0) {
free(ctx);
PL_fail;
}
ctx->store = ohm_fact_store_get_fact_store();
ctx->facts = ohm_fact_store_get_facts_by_name(ctx->store, factname);
break;
case PL_REDO:
ctx = PL_foreign_context_address(handle);
break;
case PL_CUTTED:
ctx = PL_foreign_context_address(handle);
goto nomore;
default:
PL_fail;
}
/* XXX TODO: shouldn't we discard the frame here instead of closing them */
frame = PL_open_foreign_frame();
while (ctx->facts != NULL) {
f = (OhmFact *)ctx->facts->data;
ctx->facts = g_slist_next(ctx->facts);
if (!fact_values(ctx, f, &pl_values) && PL_unify(pl_list, pl_values)) {
PL_close_foreign_frame(frame); /* PL_discard_foreign_frame ??? */
PL_retry_address(ctx);
}
PL_rewind_foreign_frame(frame);
}
PL_close_foreign_frame(frame); /* PL_discard_foreign_frame ??? */
nomore:
if (ctx->fields)
free(ctx->fields);
free(ctx);
PL_fail;
}
