Skip to content

Commit

Permalink
Adding parse_url/2, re issue #306
Browse files Browse the repository at this point in the history
  • Loading branch information
@infradig
infradig committed Aug 26, 2023
1 parent 3cc6084 commit 2d85de6
Show file tree
Hide file tree
Showing 12 changed files with 435 additions and 157 deletions.
2 changes: 2 additions & 0 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -762,6 +762,8 @@ A server *Goal* takes a single arg, the connection stream.
Networking ##EXPERIMENTAL##
==========

parse_url/2 # parse_url(?atom,?list)

server/2 # server(+host,-stream)
server/3 # server(+host,-stream,+list)
accept/2 # accept(+stream,-stream)
Expand Down
62 changes: 31 additions & 31 deletions src/control.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -759,30 +759,30 @@ bool throw_error3(query *q, cell *c, pl_idx c_ctx, const char *err_type, const c
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 2);
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, err_type));
make_atom(tmp+nbr_cells, index_from_pool(q->pl, expected));
make_atom(tmp+nbr_cells++, new_atom(q->pl, err_type));
make_atom(tmp+nbr_cells, new_atom(q->pl, expected));
} else if (!strcmp(err_type, "type_error") && !strcmp(expected, "var")) {
err_type = "uninstantiation_error";
//printf("error(%s(%s),(%s)/%u).\n", err_type, C_STR(q, c), functor, goal->arity);
tmp = alloc_on_heap(q, 6+(c->nbr_cells-1));
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 5+(c->nbr_cells-1));
make_struct(tmp+nbr_cells++, index_from_pool(q->pl, err_type), NULL, 1, 1+(c->nbr_cells-1));
make_struct(tmp+nbr_cells++, new_atom(q->pl, err_type), NULL, 1, 1+(c->nbr_cells-1));
safe_copy_cells(tmp+nbr_cells, c, c->nbr_cells);
nbr_cells += c->nbr_cells;
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, functor));
make_atom(tmp+nbr_cells++, new_atom(q->pl, functor));
make_int(tmp+nbr_cells, !is_string(goal)?goal->arity:0);
} else if (!strcmp(err_type, "type_error") && !strcmp(expected, "evaluable")) {
//printf("error(%s(%s,(%s)/%u),(%s)/%u).\n", err_type, expected, C_STR(q, c), c->arity, functor, goal->arity);
tmp = alloc_on_heap(q, 9);
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 8);
make_struct(tmp+nbr_cells++, index_from_pool(q->pl, err_type), NULL, 2, 4);
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, expected));
make_struct(tmp+nbr_cells++, new_atom(q->pl, err_type), NULL, 2, 4);
make_atom(tmp+nbr_cells++, new_atom(q->pl, expected));
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
tmp[nbr_cells] = *c;
Expand All @@ -792,18 +792,18 @@ bool throw_error3(query *q, cell *c, pl_idx c_ctx, const char *err_type, const c
make_int(tmp+nbr_cells++, c->arity);
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, functor));
make_atom(tmp+nbr_cells++, new_atom(q->pl, functor));
make_int(tmp+nbr_cells, !is_string(goal)?goal->arity:0);
} else if (!strcmp(err_type, "permission_error") && is_structure(c) && CMP_STR_TO_CSTR(q, c, "/") && is_var(FIRST_ARG(c))) {
//printf("error(%s(%s,(%s)/%u),(%s)/%u).\n", err_type, expected, tmpbuf, c->arity, functor, goal->arity);
tmp = alloc_on_heap(q, 9+extra);
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 8+extra);
make_struct(tmp+nbr_cells++, index_from_pool(q->pl, err_type), NULL, 2+extra, 4+extra);
make_struct(tmp+nbr_cells++, new_atom(q->pl, err_type), NULL, 2+extra, 4+extra);

if (!extra)
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, expected));
make_atom(tmp+nbr_cells++, new_atom(q->pl, expected));
else {
char tmpbuf[1024*8];
strcpy(tmpbuf, expected);
Expand All @@ -812,12 +812,12 @@ bool throw_error3(query *q, cell *c, pl_idx c_ctx, const char *err_type, const c
if (*ptr2) *ptr2++ = '\0';

while (ptr2) {
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, ptr));
make_atom(tmp+nbr_cells++, new_atom(q->pl, ptr));
ptr = ptr2;
ptr2 = strchr(ptr, ',');
}

make_atom(tmp+nbr_cells++, index_from_pool(q->pl, ptr));
make_atom(tmp+nbr_cells++, new_atom(q->pl, ptr));
}

make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
Expand All @@ -829,18 +829,18 @@ bool throw_error3(query *q, cell *c, pl_idx c_ctx, const char *err_type, const c
make_int(tmp+nbr_cells++, c->arity);
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, functor));
make_atom(tmp+nbr_cells++, new_atom(q->pl, functor));
make_int(tmp+nbr_cells, !is_string(goal)?goal->arity:0);
} else if (!strcmp(err_type, "permission_error") && (is_builtin || (is_op && c->arity)) && !is_abolish) {
//printf("error(%s(%s,(%s)/%u),(%s)/%u).\n", err_type, expected, tmpbuf, c->arity, functor, goal->arity);
tmp = alloc_on_heap(q, 9+extra);
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 8+extra);
make_struct(tmp+nbr_cells++, index_from_pool(q->pl, err_type), NULL, 2+extra, 4+extra);
make_struct(tmp+nbr_cells++, new_atom(q->pl, err_type), NULL, 2+extra, 4+extra);

if (!extra)
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, expected));
make_atom(tmp+nbr_cells++, new_atom(q->pl, expected));
else {
char tmpbuf[1024*8];
strcpy(tmpbuf, expected);
Expand All @@ -849,12 +849,12 @@ bool throw_error3(query *q, cell *c, pl_idx c_ctx, const char *err_type, const c
if (*ptr2) *ptr2++ = '\0';

while (ptr2) {
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, ptr));
make_atom(tmp+nbr_cells++, new_atom(q->pl, ptr));
ptr = ptr2;
ptr2 = strchr(ptr, ',');
}

make_atom(tmp+nbr_cells++, index_from_pool(q->pl, ptr));
make_atom(tmp+nbr_cells++, new_atom(q->pl, ptr));
}

make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
Expand All @@ -866,34 +866,34 @@ bool throw_error3(query *q, cell *c, pl_idx c_ctx, const char *err_type, const c
make_int(tmp+nbr_cells++, c->arity);
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, functor));
make_atom(tmp+nbr_cells++, new_atom(q->pl, functor));
make_int(tmp+nbr_cells, !is_string(goal)?goal->arity:0);
} else if (!strcmp(err_type, "instantiation_error")) {
//printf("error(%s,(%s)/%u).\n", err_type, functor, goal->arity);
tmp = alloc_on_heap(q, 5);
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 4);
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, err_type));
make_atom(tmp+nbr_cells++, new_atom(q->pl, err_type));
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, functor));
make_atom(tmp+nbr_cells++, new_atom(q->pl, functor));
make_int(tmp+nbr_cells, !is_string(goal)?goal->arity:0);
} else if (!strcmp(err_type, "existence_error") && !strcmp(expected, "procedure") && is_callable(c)) {
//printf("error(%s(%s,(%s)/%u),(%s)/%u).\n", err_type, expected, tmpbuf, c->arity, functor, goal->arity);
tmp = alloc_on_heap(q, 9);
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 8);
make_struct(tmp+nbr_cells++, index_from_pool(q->pl, err_type), NULL, 2, 4);
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, expected));
make_struct(tmp+nbr_cells++, new_atom(q->pl, err_type), NULL, 2, 4);
make_atom(tmp+nbr_cells++, new_atom(q->pl, expected));
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, C_STR(q, c)));
make_atom(tmp+nbr_cells++, new_atom(q->pl, C_STR(q, c)));
make_int(tmp+nbr_cells++, c->arity);
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, functor));
make_atom(tmp+nbr_cells++, new_atom(q->pl, functor));
make_int(tmp+nbr_cells, !is_string(goal)?goal->arity:0);
} else if (!strcmp(err_type, "representation_error")
|| !strcmp(err_type, "evaluation_error")
Expand All @@ -904,22 +904,22 @@ bool throw_error3(query *q, cell *c, pl_idx c_ctx, const char *err_type, const c
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 5);
make_struct(tmp+nbr_cells++, index_from_pool(q->pl, err_type), NULL, 1, 1);
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, expected));
make_struct(tmp+nbr_cells++, new_atom(q->pl, err_type), NULL, 1, 1);
make_atom(tmp+nbr_cells++, new_atom(q->pl, expected));
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, functor));
make_atom(tmp+nbr_cells++, new_atom(q->pl, functor));
make_int(tmp+nbr_cells, !is_string(goal)?goal->arity:0);
} else {
//printf("error(%s(%s,(%s)),(%s)/%u).\n", err_type, expected, C_STR(q, c), functor, goal->arity);
tmp = alloc_on_heap(q, 7+(c->nbr_cells-1)+extra);
check_heap_error(tmp);
pl_idx nbr_cells = 0;
make_struct(tmp+nbr_cells++, g_error_s, NULL, 2, 6+(c->nbr_cells-1)+extra);
make_struct(tmp+nbr_cells++, index_from_pool(q->pl, err_type), NULL, 2+extra, 2+(c->nbr_cells-1)+extra);
make_struct(tmp+nbr_cells++, new_atom(q->pl, err_type), NULL, 2+extra, 2+(c->nbr_cells-1)+extra);

if (!extra) {
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, expected));
make_atom(tmp+nbr_cells++, new_atom(q->pl, expected));
} else {
char tmpbuf[1024*8];
strcpy(tmpbuf, expected);
Expand All @@ -928,18 +928,18 @@ bool throw_error3(query *q, cell *c, pl_idx c_ctx, const char *err_type, const c
if (*ptr2) *ptr2++ = '\0';

while (ptr2) {
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, ptr));
make_atom(tmp+nbr_cells++, new_atom(q->pl, ptr));
ptr = ptr2;
ptr2 = strchr(ptr, ',');
}

make_atom(tmp+nbr_cells++, index_from_pool(q->pl, ptr));
make_atom(tmp+nbr_cells++, new_atom(q->pl, ptr));
}

nbr_cells += safe_copy_cells(tmp+nbr_cells, c, c->nbr_cells);
make_struct(tmp+nbr_cells, g_slash_s, NULL, 2, 2);
SET_OP(tmp+nbr_cells, OP_YFX); nbr_cells++;
make_atom(tmp+nbr_cells++, index_from_pool(q->pl, functor));
make_atom(tmp+nbr_cells++, new_atom(q->pl, functor));
make_int(tmp+nbr_cells, !is_string(goal)?goal->arity:0);
}

Expand Down
2 changes: 1 addition & 1 deletion src/heap.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -667,7 +667,7 @@ void allocate_structure(query *q, const char *functor, const cell *c)
if (!tmp) return;
tmp->tag = TAG_INTERNED;
tmp->nbr_cells = 1;
tmp->val_off = index_from_pool(q->pl, functor);
tmp->val_off = new_atom(q->pl, functor);
tmp->arity = 0;
tmp->flags = 0;
append_structure(q, c);
Expand Down
14 changes: 7 additions & 7 deletions src/module.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -296,7 +296,7 @@ static predicate *find_predicate_(module *m, cell *c, bool abolished)
tmp.nbr_cells = 1;

if (is_cstring(c)) {
tmp.val_off = index_from_pool(m->pl, C_STR(m, c));
tmp.val_off = new_atom(m->pl, C_STR(m, c));
}

sliter *iter = sl_find_key(m->index, &tmp);
Expand Down Expand Up @@ -596,7 +596,7 @@ void set_discontiguous_in_db(module *m, const char *name, unsigned arity)
{
cell tmp = (cell){0};
tmp.tag = TAG_INTERNED;
tmp.val_off = index_from_pool(m->pl, name);
tmp.val_off = new_atom(m->pl, name);
ensure(tmp.val_off != ERR_IDX);
tmp.arity = arity;
predicate *pr = find_predicate(m, &tmp);
Expand All @@ -613,7 +613,7 @@ void set_multifile_in_db(module *m, const char *name, pl_idx arity)
{
cell tmp = (cell){0};
tmp.tag = TAG_INTERNED;
tmp.val_off = index_from_pool(m->pl, name);
tmp.val_off = new_atom(m->pl, name);
ensure(tmp.val_off != ERR_IDX);
tmp.arity = arity;
predicate *pr = find_predicate(m, &tmp);
Expand All @@ -630,7 +630,7 @@ void set_dynamic_in_db(module *m, const char *name, unsigned arity)
{
cell tmp = (cell){0};
tmp.tag = TAG_INTERNED;
tmp.val_off = index_from_pool(m->pl, name);
tmp.val_off = new_atom(m->pl, name);
ensure(tmp.val_off != ERR_IDX);
tmp.arity = arity;
predicate *pr = find_predicate(m, &tmp);
Expand All @@ -649,7 +649,7 @@ void set_meta_predicate_in_db(module *m, cell *c)
unsigned arity = c->arity;
cell tmp = (cell){0};
tmp.tag = TAG_INTERNED;
tmp.val_off = index_from_pool(m->pl, name);
tmp.val_off = new_atom(m->pl, name);
ensure(tmp.val_off != ERR_IDX);
tmp.arity = arity;
predicate *pr = find_predicate(m, &tmp);
Expand Down Expand Up @@ -953,7 +953,7 @@ bool do_use_foreign_module(module *m, cell *p)
void convert_to_literal(module *m, cell *c)
{
char *src = DUP_STR(m, c);
pl_idx off = index_from_pool(m->pl, src);
pl_idx off = new_atom(m->pl, src);
unshare_cell(c);
c->tag = TAG_INTERNED;
c->val_off = off;
Expand All @@ -971,7 +971,7 @@ predicate *find_functor(module *m, const char *name, unsigned arity)
{
cell tmp = (cell){0};
tmp.tag = TAG_INTERNED;
tmp.val_off = index_from_pool(m->pl, name);
tmp.val_off = new_atom(m->pl, name);
tmp.arity = arity;
return find_predicate(m, &tmp);
}
Expand Down
8 changes: 4 additions & 4 deletions src/parser.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -580,7 +580,7 @@ static bool directives(parser *p, cell *d)
if (d->arity != 1)
return false;

d->val_off = index_from_pool(p->pl, "$directive");
d->val_off = new_atom(p->pl, "$directive");
CLR_OP(d);

if (!strcmp(dirname, "initialization") && (c->arity == 1)) {
Expand Down Expand Up @@ -1611,7 +1611,7 @@ static bool dcg_expansion(parser *p)

cell *c = p->cl->cells;
cell *tmp = alloc_on_heap(q, 1+c->nbr_cells+1+1);
make_struct(tmp, index_from_pool(p->pl, "dcg_translate"), NULL, 2, c->nbr_cells+1);
make_struct(tmp, new_atom(p->pl, "dcg_translate"), NULL, 2, c->nbr_cells+1);
safe_copy_cells(tmp+1, p->cl->cells, c->nbr_cells);
make_ref(tmp+1+c->nbr_cells, g_anon_s, p->cl->nbr_vars, 0);
make_end(tmp+1+c->nbr_cells+1);
Expand Down Expand Up @@ -3051,7 +3051,7 @@ static bool process_term(parser *p, cell *p1)
}

if (is_cstring(h)) {
pl_idx off = index_from_pool(p->m->pl, C_STR(p, h));
pl_idx off = new_atom(p->m->pl, C_STR(p, h));
if (off == ERR_IDX) {
p->error = true;
return false;
Expand Down Expand Up @@ -3709,7 +3709,7 @@ unsigned tokenize(parser *p, bool args, bool consing)
if (p->is_quoted)
c->flags |= FLAG_CSTR_QUOTED;

c->val_off = index_from_pool(p->m->pl, SB_cstr(p->token));
c->val_off = new_atom(p->m->pl, SB_cstr(p->token));
ensure(c->val_off != ERR_IDX);
} else {
c->tag = TAG_CSTR;
Expand Down
Loading

0 comments on commit 2d85de6

Please sign in to comment.