static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
if (_PL_rd->qq_tail) {
term_t av;
int rc;
if (!PL_unify_nil(_PL_rd->qq_tail))
return FALSE;
if (!_PL_rd->quasi_quotations) {
if ((av = PL_new_term_refs(2)) && PL_put_term(av + 0, _PL_rd->qq) &&
#if __YAP_PROLOG__
PL_put_atom(av + 1, YAP_SWIAtomFromAtom(_PL_rd->module->AtomOfME)) &&
#else
PL_put_atom(av + 1, _PL_rd->module->name) &&
#endif
PL_cons_functor_v(av, FUNCTOR_dparse_quasi_quotations2, av)) {
term_t ex;
rc = callProlog(MODULE_system, av + 0, PL_Q_CATCH_EXCEPTION, &ex);
if (rc)
return TRUE;
_PL_rd->exception = ex;
_PL_rd->has_exception = TRUE;
}
return FALSE;
} else
return TRUE;
} else if (_PL_rd->quasi_quotations) /* user option, but no quotes */
{
return PL_unify_nil(_PL_rd->quasi_quotations);
} else
return TRUE;
}
static int
syntax_error(IOSTREAM *in, const char *msg)
{ term_t ex = PL_new_term_refs(2);
IOPOS *pos;
if ( !PL_unify_term(ex+0, PL_FUNCTOR, FUNCTOR_syntax_error1,
PL_CHARS, msg) )
return FALSE;
if ( (pos=in->position) )
{ term_t stream;
if ( !(stream = PL_new_term_ref()) ||
!PL_unify_stream(stream, in) ||
!PL_unify_term(ex+1,
PL_FUNCTOR, FUNCTOR_stream4,
PL_TERM, stream,
PL_INT, (int)pos->lineno,
PL_INT, (int)(pos->linepos-1), /* one too late */
PL_INT64, (int64_t)(pos->charno-1)) )
return FALSE;
}
if ( PL_cons_functor_v(ex, FUNCTOR_error2, ex) )
{ int c;
do
{ c = Sgetcode(in);
} while(c != '\n' && c != -1);
return PL_raise_exception(ex);
}
return FALSE;
}
static int
unify_uri_authority_components(term_t components,
size_t len, const pl_wchar_t *s)
{ const pl_wchar_t *end = &s[len];
const pl_wchar_t *e;
range user = {0};
range passwd = {0};
range host = {0};
range port = {0};
term_t t = PL_new_term_refs(5);
term_t av = t+1;
if ( (e=skip_not(s, end, L"@")) && e<end )
{ user.start = s;
user.end = e;
s = e+1;
if ( (e=skip_not(user.start, user.end, L":")) && e<user.end )
{ passwd.start = e+1;
passwd.end = user.end;
user.end = e;
}
}
host.start = s;
host.end = skip_not(s, end, L":");
if ( host.end < end )
{ port.start = host.end+1;
port.end = end;
}
if ( user.start )
unify_decoded_atom(av+0, &user, ESC_USER);
if ( passwd.start )
unify_decoded_atom(av+1, &passwd, ESC_PASSWD);
unify_decoded_atom(av+2, &host, ESC_HOST);
if ( port.start )
{ wchar_t *ep;
long pn = wcstol(port.start, &ep, 10);
if ( ep == port.end )
{ if ( !PL_put_integer(av+3, pn) )
return FALSE;
} else
{ unify_decoded_atom(av+3, &port, ESC_PORT);
}
}
return (PL_cons_functor_v(t, FUNCTOR_uri_authority4, av) &&
PL_unify(components, t));
}
static int
unify_query_string_components(term_t list, size_t len, const pl_wchar_t *qs)
{ if ( len == 0 )
{ return PL_unify_nil(list);
} else
{ term_t tail = PL_copy_term_ref(list);
term_t head = PL_new_term_ref();
term_t eq = PL_new_term_refs(3);
term_t nv = eq+1;
const pl_wchar_t *end = &qs[len];
while(qs < end)
{ range name, value;
name.start = qs;
name.end = skip_not(qs, end, L"=");
if ( name.end < end )
{ value.start = name.end+1;
value.end = skip_not(value.start, end, L"&;");
qs = value.end+1;
} else
{ return syntax_error("illegal_uri_query");
}
PL_put_variable(nv+0);
PL_put_variable(nv+1);
unify_decoded_atom(nv+0, &name, ESC_QNAME);
unify_decoded_atom(nv+1, &value, ESC_QVALUE);
if ( !PL_cons_functor_v(eq, FUNCTOR_equal2, nv) ||
!PL_unify_list(tail, head, tail) ||
!PL_unify(head, eq) )
return FALSE;
}
return PL_unify_nil(tail);
}
}
static foreign_t
current_alarms(term_t time, term_t goal, term_t id, term_t status,
term_t matching)
{ Event ev;
term_t next = PL_new_term_ref();
term_t g = PL_new_term_ref();
term_t tail = PL_copy_term_ref(matching);
term_t head = PL_new_term_ref();
term_t av = PL_new_term_refs(4);
pthread_t self = pthread_self();
LOCK();
ev = TheSchedule()->first;
for(; ev; ev = ev->next)
{ atom_t s;
double at;
fid_t fid;
if ( !pthread_equal(self, ev->thread_id) )
continue;
fid = PL_open_foreign_frame();
if ( ev->flags & EV_DONE )
s = ATOM_done;
else if ( ev == TheSchedule()->scheduled )
s = ATOM_next;
else
s = ATOM_scheduled;
if ( !PL_unify_atom(status, s) )
goto nomatch;
PL_recorded(ev->goal, g);
if ( !PL_unify_term(goal,
PL_FUNCTOR, FUNCTOR_module2,
PL_ATOM, PL_module_name(ev->module),
PL_TERM, g) )
goto nomatch;
at = (double)ev->at.tv_sec + (double)ev->at.tv_usec / 1000000.0;
if ( !PL_unify_float(time, at) )
goto nomatch;
if ( !unify_timer(id, ev) )
goto nomatch;
PL_discard_foreign_frame(fid);
if ( !PL_put_float(av+0, at) || /* time */
!PL_recorded(ev->goal, av+1) || /* goal */
!PL_put_variable(av+2) || /* id */
!unify_timer(av+2, ev) ||
!PL_put_atom(av+3, s) || /* status */
!PL_cons_functor_v(next, FUNCTOR_alarm4, av) )
{ PL_close_foreign_frame(fid);
UNLOCK();
return FALSE;
}
if ( PL_unify_list(tail, head, tail) &&
PL_unify(head, next) )
{ continue;
} else
{ PL_close_foreign_frame(fid);
UNLOCK();
return FALSE;
}
nomatch:
PL_discard_foreign_frame(fid);
}
UNLOCK();
return PL_unify_nil(tail);
}
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);
}
}
