Example #1
0
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;
}
Example #2
0
gboolean
plgi_gbytes_to_term(GBytes *bytes,
                    term_t  t)
{
  term_t list = PL_copy_term_ref(t);
  term_t head = PL_new_term_ref();
  const guint8 *data;
  gsize size;
  gint i;

  PLGI_debug("    GBytes: %p  --->  term: 0x%lx", bytes, t);

  data = g_bytes_get_data(bytes, &size);

  for ( i = 0; i < size; i++ )
  { term_t a = PL_new_term_ref();
    guint8 v = data[i];

    if ( !plgi_guint8_to_term(v, a) )
    { return FALSE;
    }

    if ( !(PL_unify_list(list, head, list) &&
           PL_unify(head, a)) )
    { return FALSE;
    }
  }

  if ( !PL_unify_nil(list) )
  { return FALSE;
  }

  return TRUE;
}
Example #3
0
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;
}
Example #4
0
static foreign_t
archive_property(term_t archive, term_t prop, term_t value)
{ archive_wrapper *ar;
  atom_t pn;
  const char *s;

  if ( !get_archive(archive, &ar) ||
       !PL_get_atom_ex(prop, &pn) )
    return FALSE;

#ifdef HAVE_ARCHIVE_FILTER_COUNT
  if ( pn == ATOM_filter )
  { int i, fcount = archive_filter_count(ar->archive);
    term_t tail = PL_copy_term_ref(value);
    term_t head = PL_new_term_ref();

    for(i=0; i<fcount; i++)
    { s = archive_filter_name(ar->archive, i);

      if ( !s || strcmp(s, "none") == 0 )
	continue;

      if ( !PL_unify_list(tail, head, tail) ||
	   !PL_unify_atom_chars(head, s) )
	return FALSE;
    }
    return PL_unify_nil(tail);
  }
#endif

  return FALSE;
}
Example #5
0
static foreign_t
pl_group_info(term_t group, term_t info)
{ int gid;
  struct group grp, *pgrp;
  char buf[1000];
  char *name;
  term_t members = PL_new_term_ref();
  term_t tail = PL_copy_term_ref(members);
  term_t head = PL_new_term_ref();
  char **memp;

  if ( PL_get_integer(group, &gid) )
  { again1:
    errno = 0;
    if ( getgrgid_r(gid, &grp, buf, sizeof(buf), &pgrp) != 0 )
    { if ( errno == EINTR )
      { if ( PL_handle_signals() < 0 )
	  return FALSE;
	goto again1;
      }
      return error(errno, "info", "group", group);
    }
  } else if ( PL_get_chars(group, &name, CVT_ATOMIC|REP_MB) )
  { again2:
    errno = 0;
    if ( getgrnam_r(name, &grp, buf, sizeof(buf), &pgrp) != 0 )
    { if ( errno == EINTR )
      { if ( PL_handle_signals() < 0 )
	  return FALSE;
	goto again2;
      }
      return error(errno, "info", "group", group);
    }
  } else
  { return PL_type_error("group", group);
  }

  if ( !pgrp )
    return PL_existence_error("group", group);

  for(memp=pgrp->gr_mem; *memp; memp++)
  { if ( !PL_unify_list(tail, head, tail) ||
	 !PL_unify_chars(head, PL_ATOM|REP_MB, -1, *memp) )
      return FALSE;
  }
  if ( !PL_unify_nil(tail) )
    return FALSE;

  return PL_unify_term(info,
		       PL_FUNCTOR_CHARS, "group_info", 4,
		         PL_MBCHARS, pgrp->gr_name,
		         PL_MBCHARS, pgrp->gr_passwd,
		         PL_INT, (int)pgrp->gr_gid,
		         PL_TERM, members
		      );
}
Example #6
0
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);
  }
}
Example #7
0
static foreign_t
snowball_algorithms(term_t list)
{ term_t tail = PL_copy_term_ref(list);
  term_t head = PL_new_term_ref();
  const char **algos = sb_stemmer_list();
  int i;

  for(i=0; algos[i]; i++)
  { if ( !PL_unify_list(tail, head, tail) ||
	 !PL_unify_atom_chars(head, algos[i]) )
      return FALSE;
  }

  return PL_unify_nil(tail);
}
Example #8
0
static foreign_t
pl_cgi_get_form(term_t form)
{ size_t len = 0;
  char *data;
  int must_free = FALSE;
  term_t list = PL_copy_term_ref(form);
  char *ct, *boundary;

  if ( !get_raw_form_data(&data, &len, &must_free) )
    return FALSE;

  if ( (ct = getenv("CONTENT_TYPE")) &&
       (boundary = strstr(ct, "boundary=")) )
  { boundary = strchr(boundary, '=')+1;

    switch( break_multipart(data, len, boundary,
			    mp_add_to_form, (void *)list) )
    { case FALSE:
	return FALSE;
      case TRUE:
	break;
      default:
	assert(0);
        return FALSE;
    }
  } else
  { switch( break_form_argument(data, add_to_form, (void *)list) )
    { case FALSE:
	return FALSE;
      case TRUE:
	break;
      case ERROR_NOMEM:
	return pl_error("cgi_get_form", 1, NULL,
			ERR_RESOURCE, "memory");
      case ERROR_SYNTAX_ERROR:
	return pl_error("cgi_get_form", 1, NULL,
			ERR_SYNTAX, "cgi_value");
      default:
	assert(0);
        return FALSE;
    }
  }

  if ( must_free )
    free(data);

  return PL_unify_nil(list);
}
Example #9
0
// handle OSC message by calling the associated Prolog goal
static int prolog_handler(const char *path, const char *types, lo_arg **argv,
		    int argc, lo_message msg, void *user_data) 
{
	term_t goal  = PL_new_term_ref();
	term_t term0 = PL_new_term_refs(3);
	term_t term1 = term0+1;
	term_t term2 = term0+2;
	term_t list;
	int 	i, rc=0;

	PL_recorded((record_t)user_data,goal); // retrieve the goal term
	PL_put_term(term0,goal); // term_t goal encoded in user_data
	PL_put_atom_chars(term1,path);

	list = PL_copy_term_ref(term2);
	for (i=0; i<argc; i++) {
		term_t head=PL_new_term_ref();
		term_t tail=PL_new_term_ref();
		if (!PL_unify_list(list,head,tail)) PL_fail; 
		switch (types[i]) {
			case 'c': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"char",1,PL_INT,(int)argv[i]->c); break;
			case 'i': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int",1,PL_INT,argv[i]->i); break;
			case 'h': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int64",1,PL_INT64,argv[i]->h); break;
			case 'f': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"float",1,PL_FLOAT,(double)argv[i]->f); break;
			case 'd': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"double",1,PL_DOUBLE,argv[i]->d); break;
			case 's': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"string",1,PL_CHARS,&argv[i]->s); break;
			case 'S': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"symbol",1,PL_CHARS,&argv[i]->S); break;
			case 'T': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"true",0); break;
			case 'F': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"false",0); break;
			case 'N': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"nil",0); break;
			case 'I': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"inf",0); break;
			case 'b': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"blob",0); break;
			case 't': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"timetag",2,
								PL_INT64,(int64_t)argv[i]->t.sec,
								PL_INT64,(int64_t)argv[i]->t.frac); 
						 break;
			case 'm': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"midi",4,
								PL_INT,(int)argv[i]->m[0], PL_INT,(int)argv[i]->m[1],
								PL_INT,(int)argv[i]->m[2], PL_INT,(int)argv[i]->m[3]);
						 break;
		}
		if (!rc) PL_fail;
		list=tail;
	}
	return PL_unify_nil(list) && PL_call_predicate(NULL,PL_Q_NORMAL,call3,term0);
}
Example #10
0
static int unify_list_from_span(term_t list, clingo_symbol_t const *syms,
                                size_t slen) {
    int rc;
    term_t tail = PL_copy_term_ref(list);
    term_t head = PL_new_term_ref();
    term_t tmp = PL_new_term_ref();
    clingo_symbol_t const *it, *ie;

    for (it = syms, ie = it + slen; it != ie; ++it) {
        PL_put_variable(tmp);

        if (!(rc = (unify_value(tmp, *it) && PL_unify_list(tail, head, tail) &&
                    PL_unify(head, tmp)))) {
            goto out;
        }
    }

    if (!(rc = PL_unify_nil(tail))) {
        goto out;
    }
out:
    return rc;
}
Example #11
0
static foreign_t
tcp_select(term_t Streams, term_t Available, term_t timeout)
{ fd_set fds;
  struct timeval t, *to;
  double time;
  int n, max = 0, ret, min = 1000000;
  fdentry *map     = NULL;
  term_t head      = PL_new_term_ref();
  term_t streams   = PL_copy_term_ref(Streams);
  term_t available = PL_copy_term_ref(Available);
  term_t ahead     = PL_new_term_ref();
  int from_buffer  = 0;
  atom_t a;

  FD_ZERO(&fds);
  while( PL_get_list(streams, head, streams) )
  { IOSTREAM *s;
#ifdef __WINDOWS__
    nbio_sock_t fd;
#else
    int fd;
#endif
    fdentry *e;

    if ( !PL_get_stream_handle(head, &s) )
      return FALSE;

#ifdef __WINDOWS__
    fd = fdFromHandle(s->handle);
#else
    fd = Sfileno(s);
#endif

    PL_release_stream(s);
    if ( fd < 0 || !is_socket_stream(s) )
    { return pl_error("tcp_select", 3, NULL, ERR_DOMAIN,
		      head, "socket_stream");
    }
					/* check for input in buffer */
    if ( s->bufp < s->limitp )
    { if ( !PL_unify_list(available, ahead, available) ||
	   !PL_unify(ahead, head) )
	return FALSE;
      from_buffer++;
    }

    e         = alloca(sizeof(*e));
    e->fd     = fd;
    e->stream = PL_copy_term_ref(head);
    e->next   = map;
    map       = e;

#ifdef __WINDOWS__
    FD_SET((SOCKET)fd, &fds);
#else
    FD_SET(fd, &fds);
#endif

    if ( fd > max )
      max = fd;
    if( fd < min )
      min = fd;
  }
  if ( !PL_get_nil(streams) )
    return pl_error("tcp_select", 3, NULL, ERR_TYPE, Streams, "list");

  if ( from_buffer > 0 )
    return PL_unify_nil(available);

  if ( PL_get_atom(timeout, &a) && a == ATOM_infinite )
  { to = NULL;
  } else
  { if ( !PL_get_float(timeout, &time) )
      return pl_error("tcp_select", 3, NULL,
		      ERR_TYPE, timeout, "number");

    if ( time >= 0.0 )
    { t.tv_sec  = (int)time;
      t.tv_usec = ((int)(time * 1000000) % 1000000);
    } else
    { t.tv_sec  = 0;
      t.tv_usec = 0;
    }
    to = &t;
  }

  while( (ret=nbio_select(max+1, &fds, NULL, NULL, to)) == -1 &&
	 errno == EINTR )
  { fdentry *e;

    if ( PL_handle_signals() < 0 )
      return FALSE;			/* exception */

    FD_ZERO(&fds);			/* EINTR may leave fds undefined */
    for(e=map; e; e=e->next)		/* so we rebuild it to be safe */
    { FD_SET((SOCKET)e->fd, &fds);
    }
  }

  switch(ret)
  { case -1:
      return pl_error("tcp_select", 3, NULL, ERR_ERRNO, errno, "select", "streams", Streams);

    case 0: /* Timeout */
      break;

    default: /* Something happened -> check fds */
      for(n=min; n <= max; n++)
      { if ( FD_ISSET(n, &fds) )
	{ if ( !PL_unify_list(available, ahead, available) ||
	       !PL_unify(ahead, findmap(map, n)) )
	    return FALSE;
	}
      }
      break;
  }

  return PL_unify_nil(available);
}
Example #12
0
static foreign_t
cgi_property(term_t cgi, term_t prop)
{ IOSTREAM *s;
  cgi_context *ctx;
  term_t arg = PL_new_term_ref();
  atom_t name;
  int arity;
  int rc = TRUE;

  if ( !get_cgi_stream(cgi, &s, &ctx) )
    return FALSE;

  if ( !PL_get_name_arity(prop, &name, &arity) || arity != 1 )
  { rc = type_error(prop, "cgi_property");
    goto out;
  }

  _PL_get_arg(1, prop, arg);
  if ( name == ATOM_request )
  { if ( ctx->request )
      rc = unify_record(arg, ctx->request);
    else
      rc = PL_unify_nil(arg);
  } else if ( name == ATOM_header )
  { if ( ctx->header )
      rc = unify_record(arg, ctx->header);
     else
      rc = PL_unify_nil(arg);
  } else if ( name == ATOM_id )
  { rc = PL_unify_int64(arg, ctx->id);
  } else if ( name == ATOM_client )
  { rc = PL_unify_stream(arg, ctx->stream);
  } else if ( name == ATOM_transfer_encoding )
  { rc = PL_unify_atom(arg, ctx->transfer_encoding);
  } else if ( name == ATOM_connection )
  { rc = PL_unify_atom(arg, ctx->connection ? ctx->connection : ATOM_close);
  } else if ( name == ATOM_content_length )
  { if ( ctx->transfer_encoding == ATOM_chunked )
      rc = PL_unify_int64(arg, ctx->chunked_written);
    else
      rc = PL_unify_int64(arg, ctx->datasize - ctx->data_offset);
  } else if ( name == ATOM_header_codes )
  { if ( ctx->data_offset > 0 )
      rc = PL_unify_chars(arg, PL_CODE_LIST, ctx->data_offset, ctx->data);
    else					/* incomplete header */
      rc = PL_unify_chars(arg, PL_CODE_LIST, ctx->datasize, ctx->data);
  } else if ( name == ATOM_state )
  { atom_t state;

    switch(ctx->state)
    { case CGI_HDR:       state = ATOM_header; break;
      case CGI_DATA:      state = ATOM_data; break;
      case CGI_DISCARDED: state = ATOM_discarded; break;
      default:
	assert(0);
    }

    rc = PL_unify_atom(arg, state);
  } else
  { rc = existence_error(prop, "cgi_property");
  }

out:
  if ( !PL_release_stream(s) )
  { if ( PL_exception(0) )
      PL_clear_exception();
  }

  return rc;
}
Example #13
0
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);
}