Exemple #1
0
template <class T, class C> int
ACE_Unbounded_Set_Ex<T, C>::insert_tail (const T &item)
{
  // ACE_TRACE ("ACE_Unbounded_Set_Ex<T, C>::insert_tail");
  NODE *temp = 0;

  // Insert <item> into the old dummy node location.
  this->head_->item_ = item;

  // Create a new dummy node.
  ACE_NEW_MALLOC_RETURN (temp,
                         static_cast<NODE*> (this->allocator_->malloc (sizeof (NODE))),
                         NODE (this->head_->next_),
                         -1);
  // Link this pointer into the list.
  this->head_->next_ = temp;

  // Point the head to the new dummy node.
  this->head_ = temp;

  ++this->cur_size_;
  return 0;
}
Exemple #2
0
struct Node * node_stmt_new(struct Node * first, ...)
{
    va_list args;
    va_start(args, first);

    va_list args_for_count;
    va_copy(args_for_count, args);
    size_t n_nodes = 0;
    struct Node *node = first;
    while(node) {
        ++ n_nodes;
        node = va_arg(args_for_count, struct Node *);
    }
    va_end(args_for_count);

    struct NodeStmt *self = node_new(NODE_STMT, sizeof(struct Node *) * n_nodes);
    self->n_nodes = n_nodes;
    for(; n_nodes >= 0; -- n_nodes) {
        self->nodes[self->n_nodes - n_nodes] = va_arg(args, struct Node *);
    }

    return NODE(self);
}
t_parser_result         parse_pipeline(t_token_list **list_pointer)
{
  t_parser_result       result;
  t_redir               redir;
  t_node                *first;
  t_hs                  error;

  parser_redir_init(&redir);
  result = parse_command(list_pointer);
  first = result.node;
  if (!first)
    return (result);
  result = parse_pipeline_end(first, list_pointer, &redir);
  if (!result.node)
    return (result);
  if (glist_voidp_length(&result.node->children) == 1)
    {
      return (NODE(first));
    }
  if (hs_length(error = parser_setup_pipeline(result.node)))
    return (ERROR(error));
  return (result);
}
Exemple #4
0
static int parse_id(struct peg_grammar_parser *pgp, struct peg_cursor *pc,
                    int *idp)
{
	int id;
        struct peg_node *pn;
	struct peg_grammar *peg = pgp->peg;
        struct raw name;

        if ( !cset_contains(cs_id_start, CHAR(pgp, pc)) )
                return 0;

        name.data = (char *)STR(pgp, pc);
        name.len = 1 + str_spn(name.data + 1, cs_id_cont);
	pn = find_id(peg, &name);
        if ( pn != NULL ) {
		++pn->pi_refcnt;
        } else {
                id = peg_node_new(peg, PEG_IDENTIFIER, pc->line);
                if ( id < 0 ) {
                        pgp->err = PEG_ERR_NOMEM;
                        return -1;
                }
		pn = NODE(peg, id);
                if ( copy_str(pgp, pc, name.len, &pn->pi_name) < 0 ) {
                        pgp->err = PEG_ERR_NOMEM;
                        peg_node_free(peg, id);
                        return -1;
                }
                pn->pi_def = -1;
                pn->pi_refcnt = 1;
        }

        *idp = node2idx(peg, pn);
        pc->pos += name.len;
        skip_space(pgp, pc);
        return 1;
}
Exemple #5
0
void BTreePrint_(btree_t t, index_t nidx)
{
  int j;
  node_t n;

  n = NODE(t, nidx);

  printf("btree(%zu, %d, %d,\n[", nidx, n->level, n->count);
  for (j = 0; j < n->count; j++)
    printf("%lf,",n->branch[j].key);
  for (; j < MAXCARD_(t) - 1; j++)
    printf("nil,");
  printf("],\n[");

  for (j = 0; j < n->count; j++)
    printf("%zu,",n->branch[j].child);
  for (; j < MAXCARD_(t); j++)
    printf("nil,");
  printf("]).\n\n");

  if (n->level > 0)
    for (j = 0; j < n->count; j++)
      BTreePrint_(t, n->branch[j].child);
}
Exemple #6
0
static int parse_expr(struct peg_grammar_parser *pgp, struct peg_cursor *pc,
		      int *exprp)
{
	struct peg_grammar *peg = pgp->peg;
	struct peg_cursor npc = *pc;
	int expr = -1;
	int snn;
	int nn;
	int rv;

	rv = parse_seq(pgp, &npc, &expr);
	if ( rv <= 0 )
		return rv;

	snn = expr;
	while ( string_match(pgp, "/", &npc) ) {
		rv = parse_seq(pgp, &npc, &nn);
		if ( rv < 0 )
			goto err;
		if ( rv == 0 ) {
			pgp->err = PEG_ERR_BAD_EXPR;
			goto err;
		}
		NODE(peg, snn)->pn_next = nn;
		snn = nn;
	}

	*pc = npc;
	*exprp = expr;
	return 1;

err:
	pgp->eloc = npc;
	peg_node_free(peg, expr);
	return -1;
}
Exemple #7
0
static ast_result_t sugar_module(ast_t* ast)
{
  ast_t* docstring = ast_child(ast);

  ast_t* package = ast_parent(ast);
  assert(ast_id(package) == TK_PACKAGE);

  if(strcmp(package_name(package), "$0") != 0)
  {
    // Every module not in builtin has an implicit use builtin command.
    // Since builtin is always the first package processed it is $0.
    BUILD(builtin, ast,
      NODE(TK_USE,
      NONE
      STRING(stringtab("builtin"))
      NONE));

    ast_add(ast, builtin);
  }

  if((docstring == NULL) || (ast_id(docstring) != TK_STRING))
    return AST_OK;

  ast_t* package_docstring = ast_childlast(package);

  if(ast_id(package_docstring) == TK_STRING)
  {
    ast_error(docstring, "the package already has a docstring");
    ast_error(package_docstring, "the existing docstring is here");
    return AST_ERROR;
  }

  ast_append(package, docstring);
  ast_remove(docstring);
  return AST_OK;
}
Exemple #8
0
static ast_result_t sugar_as(pass_opt_t* opt, ast_t** astp)
{
  typecheck_t* t = &opt->check;
  ast_t* ast = *astp;
  AST_GET_CHILDREN(ast, expr, type);

  ast_t* pattern_root = ast_from(type, TK_LEX_ERROR);
  ast_t* body_root = ast_from(type, TK_LEX_ERROR);
  add_as_type(t, type, pattern_root, body_root);

  ast_t* body = ast_pop(body_root);
  ast_free(body_root);

  if(body == NULL)
  {
    // No body implies all types are "don't care"
    ast_error(ast, "Cannot treat value as \"don't care\"");
    ast_free(pattern_root);
    return AST_ERROR;
  }

  // Don't need top sequence in pattern
  assert(ast_id(ast_child(pattern_root)) == TK_SEQ);
  ast_t* pattern = ast_pop(ast_child(pattern_root));
  ast_free(pattern_root);

  REPLACE(astp,
    NODE(TK_MATCH, AST_SCOPE
      NODE(TK_SEQ, TREE(expr))
      NODE(TK_CASES, AST_SCOPE
        NODE(TK_CASE, AST_SCOPE
          TREE(pattern)
          NONE
          TREE(body)))
      NODE(TK_SEQ, AST_SCOPE NODE(TK_ERROR, NONE))));

  return ast_visit(astp, pass_sugar, NULL, opt, PASS_SUGAR);
}
Exemple #9
0
static int BTreeAddBranch(btree_t t, index_t nidx,
                          int idx,
                          double *k, index_t *ptr)
{
  int i,j;
  double key[MAXCARD];
  index_t branch[MAXCARD+1];
  int level;
  index_t nidx1;
  node_t n1;
  node_t n;

  n = NODE(t,nidx);

  if (n->count < MAXCARD - 1)
    {
      i = n->count;
      if (i > 0)
        /*shift to get space*/
        for(; n->branch[i-1].key > *k ; i--)
          {
            n->branch[i].key = n->branch[i-1].key;
            n->branch[i+1].child = n->branch[i].child;
          }
      n->branch[i].key = *k;
      n->branch[i+1].child = (index_t) *ptr;
      n->branch[i].child = n->branch[idx].child;
      n->count ++;
      return FALSE;
    }
  else
    {
      for(i = n->count, j = MAXCARD_(t);
          n->branch[i-1].key > *k;
          i--, j--)
        {
          key[j - 1] = n->branch[i-1].key;
          branch[j] = n->branch[i].child;
        }
      key[j - 1] = *k;
      branch[j - 1] = n->branch[idx].child;
      branch[j] = (index_t) *ptr;
      j--;
      for(; i > 0;i--,j--)
        {
          key[j-1] = n->branch[i-1].key;
          branch[j-1] = n->branch[i-1].child;
        }

      level = n->level;
      BTreeNodeInit(t,nidx);
      n->level = level;

      nidx1 = BTreeNewNode(t);
      /* account for possible node pointer change*/
      n = NODE(t,nidx);
      n1 = NODE(t,nidx1);

      n1->level = level;

      for (i = 0; i < MAXCARD / 2; i ++)
        {
          n->branch[i].key = key[i];
          n->branch[i].child = branch[i];
          n->count ++;
        }
      n->branch[i].child = branch[i];

      *k = key[i];
      *ptr = nidx1;

      for (j = 0, i++; i < MAXCARD; j ++, i ++)
        {
          n1->branch[j].key = key[i];
          n1->branch[j].child = branch[i];
          n1->count ++;
        }
      n1->branch[j].child = branch[i];

      return TRUE;
    }
}
Exemple #10
0
bool expr_this(pass_opt_t* opt, ast_t* ast)
{
  typecheck_t* t = &opt->check;

  if(t->frame->def_arg != NULL)
  {
    ast_error(ast, "can't reference 'this' in a default argument");
    return false;
  }

  sym_status_t status;
  ast_get(ast, stringtab("this"), &status);

  if(status == SYM_CONSUMED)
  {
    ast_error(ast, "can't use a consumed 'this' in an expression");
    return false;
  }

  assert(status == SYM_NONE);
  token_id cap = cap_for_this(t);

  if(!cap_sendable(cap) && (t->frame->recover != NULL))
    cap = TK_TAG;

  bool make_arrow = false;

  if(cap == TK_BOX)
  {
    cap = TK_REF;
    make_arrow = true;
  }

  ast_t* type = type_for_this(opt, ast, cap, TK_NONE, false);

  if(make_arrow)
  {
    BUILD(arrow, ast, NODE(TK_ARROW, NODE(TK_THISTYPE) TREE(type)));
    type = arrow;
  }

  // Get the nominal type, which may be the right side of an arrow type.
  ast_t* nominal;
  bool arrow;

  if(ast_id(type) == TK_NOMINAL)
  {
    nominal = type;
    arrow = false;
  } else {
    nominal = ast_childidx(type, 1);
    arrow = true;
  }

  ast_t* typeargs = ast_childidx(nominal, 2);
  ast_t* typearg = ast_child(typeargs);

  while(typearg != NULL)
  {
    if(!expr_nominal(opt, &typearg))
    {
      ast_error(ast, "couldn't create a type for 'this'");
      ast_free(type);
      return false;
    }

    typearg = ast_sibling(typearg);
  }

  if(!expr_nominal(opt, &nominal))
  {
    ast_error(ast, "couldn't create a type for 'this'");
    ast_free(type);
    return false;
  }

  if(arrow)
    type = ast_parent(nominal);
  else
    type = nominal;

  ast_settype(ast, type);
  return true;
}
Exemple #11
0
SEXP is_pdag_acyclic(SEXP arcs, SEXP nodes, SEXP return_nodes, 
    SEXP directed, SEXP debug) {

int i = 0, j = 0, z = 0;
int nrows = LENGTH(nodes);
int check_status = nrows, check_status_old = nrows;
int *rowsums = NULL, *colsums = NULL, *crossprod = NULL, *a = NULL;
int *debuglevel = NULL;
short int *status = NULL;
SEXP amat;

  /* dereference the debug parameter. */
  debuglevel = LOGICAL(debug);

  /* build the adjacency matrix from the arc set.  */
  if (*debuglevel > 0)
    Rprintf("* building the adjacency matrix.\n");

  PROTECT(amat = arcs2amat(arcs, nodes));
  a = INTEGER(amat);

  /* should we consider only directed arcs? */
  if (isTRUE(directed)) {

    /* removing undirected arcs, so that only cycles made only of directed
     * arcs will make the function return TRUE. */

    for (i = 0; i < nrows; i++)
      for (j = 0; j < nrows; j++)
        if ((a[CMC(i, j, nrows)] == 1) && (a[CMC(j, i, nrows)] == 1))
          a[CMC(i, j, nrows)] = a[CMC(j, i, nrows)] = 0;

  }/*THEN*/

  /* initialize the status, {row,col}sums and crossprod arrays. */
  status = allocstatus(nrows);
  rowsums = alloc1dcont(nrows);
  colsums = alloc1dcont(nrows);
  crossprod = alloc1dcont(nrows);

  if (*debuglevel > 0)
    Rprintf("* checking whether the partially directed graph is acyclic.\n");

  /* even in the worst case scenario at least two nodes are marked as
   * good at each iteration, so even ceil(nrows/2) iterations should be
   * enough. */
  for (z = 0; z < nrows; z++) {

start:

    if (*debuglevel > 0)
      Rprintf("* beginning iteration %d.\n", z + 1);

    for (i = 0; i < nrows; i++) {

      /* skip known-good nodes. */
      if (status[i] == GOOD) continue;

      /* reset and update row and column totals. */
      rowsums[i] = colsums[i] = crossprod[i] = 0;

      /* compute row and column totals for the i-th node. */
      for (j = 0; j < nrows; j++) {

        rowsums[i] += a[CMC(i, j, nrows)];
        colsums[i] += a[CMC(j, i, nrows)];
        crossprod[i] += a[CMC(i, j, nrows)] * a[CMC(j, i, nrows)];

      }/*FOR*/

there:

      if (*debuglevel > 0)
        Rprintf("  > checking node %s (%d child(ren), %d parent(s), %d neighbours).\n",
          NODE(i), rowsums[i], colsums[i], crossprod[i]);

      /* if either total is zero, the node is either a root node or a
       * leaf node, and is not part of any cycle. */
      if (((rowsums[i] == 0) || (colsums[i] == 0)) ||
          ((crossprod[i] == 1) && (rowsums[i] == 1) && (colsums[i] == 1))) {

        if (*debuglevel > 0)
          Rprintf("  @ node %s is cannot be part of a cycle.\n", NODE(i));

        /* update the adjacency matrix and the row/column totals. */
        for (j = 0; j < nrows; j++)
          a[CMC(i, j, nrows)] = a[CMC(j, i, nrows)] = 0;

        rowsums[i] = colsums[i] = crossprod[i] = 0;

        /* mark the node as good. */
        status[i] = GOOD;
        check_status--;

      }/*THEN*/
      else if (crossprod[i] == 1) {

        /* find the other of the undirected arc. */
        for (j = 0; j < i; j++)
          if (a[CMC(i, j, nrows)] * a[CMC(j, i, nrows)] == 1)
            break;

        /* safety check, just in case. */
        if (i == j) continue;

        if (((colsums[i] == 1) && (colsums[j] == 1)) ||
            ((rowsums[i] == 1) && (rowsums[j] == 1))) {

          if (*debuglevel > 0)
            Rprintf("  @ arc %s - %s is cannot be part of a cycle.\n", NODE(i), NODE(j));

          /* update the adjacency matrix and the row/column totals. */
          a[CMC(i, j, nrows)] = a[CMC(j, i, nrows)] = 0;
          crossprod[i] = 0;
          rowsums[i]--;
          colsums[i]--;
          rowsums[j]--;
          colsums[j]--;

          /* jump back to the first check; if either the row or column total
           * was equal to 1 only because of the undirected arc, the node can
           * now be marked as good. */
          if ((rowsums[i] == 0) || (colsums[i] == 0))
            goto there;

        }/*THEN*/

      }/*THEN*/

    }/*FOR*/

    /* at least three nodes are needed to have a cycle. */
    if (check_status < 3) {

      if (*debuglevel > 0)
        Rprintf("@ at least three nodes are needed to have a cycle.\n");

      UNPROTECT(1);
      return build_return_array(nodes, status, nrows, check_status, return_nodes);

    }/*THEN*/

    /* if there are three or more bad nodes and there was no change in
     * the last iteration, the algorithm is stuck on a cycle. */
    if (check_status_old == check_status) {

      if (*debuglevel > 0)
        Rprintf("@ no change in the last iteration.\n");

      /* give up and call c_has_path() to kill some undirected arcs. */
      for (i = 0; i < nrows; i++)
        for (j = 0; j < i; j++)
          if (a[CMC(i, j, nrows)] * a[CMC(j, i, nrows)] == 1) {

            /* remove the arc from the adjacency matrix while testing it,
             * there's a path is always found (the arc itself). */
            a[CMC(i, j, nrows)] = a[CMC(j, i, nrows)] = 0;

            if(!c_has_path(i, j, INTEGER(amat), nrows, nodes, FALSE, TRUE, FALSE) &&
               !c_has_path(j, i, INTEGER(amat), nrows, nodes, FALSE, TRUE, FALSE)) {

              if (*debuglevel > 0)
                Rprintf("@ arc %s - %s is not part of any cycle, removing.\n", NODE(i), NODE(j));

              /* increase the iteration counter and start again. */
              z++;
              goto start;

            }/*THEN*/
            else {

              /* at least one cycle is really present; give up and return.  */
              UNPROTECT(1);
              return build_return_array(nodes, status, nrows, check_status, return_nodes);

            }/*ELSE*/

          }/*THEN*/

      /* give up if there are no undirected arcs, cycles composed
       * entirely by directed arcs are never false positives. */
      UNPROTECT(1);
      return build_return_array(nodes, status, nrows, check_status, return_nodes);

    }/*THEN*/
    else {

      check_status_old = check_status;

    }/*ELSE*/

  }/*FOR*/

  UNPROTECT(1);
  return build_return_array(nodes, status, nrows, check_status, return_nodes);

}/*IS_PDAG_ACYCLIC*/
Exemple #12
0
static bool is_fun_sub_fun(ast_t* sub, ast_t* super,
  ast_t* isub, ast_t* isuper)
{
  token_id tsub = ast_id(sub);
  token_id tsuper = ast_id(super);

  switch(tsub)
  {
    case TK_NEW:
    case TK_BE:
    case TK_FUN:
      break;

    default:
      return false;
  }

  switch(tsuper)
  {
    case TK_NEW:
    case TK_BE:
    case TK_FUN:
      break;

    default:
      return false;
  }

  // A constructor can only be a subtype of a constructor.
  if(((tsub == TK_NEW) || (tsuper == TK_NEW)) && (tsub != tsuper))
    return false;

  AST_GET_CHILDREN(sub, sub_cap, sub_id, sub_typeparams, sub_params);
  AST_GET_CHILDREN(super, super_cap, super_id, super_typeparams, super_params);

  // Must have the same name.
  if(ast_name(sub_id) != ast_name(super_id))
    return false;

  // Must have the same number of type parameters and parameters.
  if((ast_childcount(sub_typeparams) != ast_childcount(super_typeparams)) ||
    (ast_childcount(sub_params) != ast_childcount(super_params)))
    return false;

  ast_t* r_sub = sub;

  if(ast_id(super_typeparams) != TK_NONE)
  {
    // Reify sub with the type parameters of super.
    BUILD(typeargs, super_typeparams, NODE(TK_TYPEARGS));
    ast_t* super_typeparam = ast_child(super_typeparams);

    while(super_typeparam != NULL)
    {
      AST_GET_CHILDREN(super_typeparam, super_id, super_constraint);
      token_id cap = cap_from_constraint(super_constraint);

      BUILD(typearg, super_typeparam,
        NODE(TK_TYPEPARAMREF, TREE(super_id) NODE(cap) NONE));

      ast_t* def = ast_get(super_typeparam, ast_name(super_id), NULL);
      ast_setdata(typearg, def);
      ast_append(typeargs, typearg);

      super_typeparam = ast_sibling(super_typeparam);
    }

    r_sub = reify(sub, sub, sub_typeparams, typeargs);
    ast_free_unattached(typeargs);
  }

  bool ok = is_reified_fun_sub_fun(r_sub, super, isub, isuper);

  if(r_sub != sub)
    ast_free_unattached(r_sub);

  return ok;
}
Exemple #13
0
/* predict the value of the training variable in a naive Bayes or Tree-Augmented
 * naive Bayes classifier. */
SEXP naivepred(SEXP fitted, SEXP data, SEXP parents, SEXP training, SEXP prior,
    SEXP prob, SEXP debug) {

int i = 0, j = 0, k = 0, n = 0, nvars = LENGTH(fitted), nmax = 0, tr_nlevels = 0;
int *res = NULL, **ex = NULL, *ex_nlevels = NULL;
int idx = 0, *tr_id = INTEGER(training);
int *iscratch = NULL, *maxima = NULL, *prn = NULL, *debuglevel = LOGICAL(debug);
int *include_prob = LOGICAL(prob);
double **cpt = NULL, *pr = NULL, *scratch = NULL, *buf = NULL, *pt = NULL;
double sum = 0;
SEXP class, temp, tr, tr_levels, result, nodes, probtab, dimnames;

  /* cache the node labels. */
  nodes = getAttrib(fitted, R_NamesSymbol);

  /* cache the pointers to all the variables. */
  ex = (int **) alloc1dpointer(nvars);
  ex_nlevels = alloc1dcont(nvars);

  for (i = 0; i < nvars; i++) {

    temp = VECTOR_ELT(data, i);
    ex[i] = INTEGER(temp);
    ex_nlevels[i] = NLEVELS(temp);

  }/*FOR*/

  /* get the training variable and its levels. */
  n = LENGTH(VECTOR_ELT(data, 0));
  tr = getListElement(VECTOR_ELT(fitted, *tr_id - 1), "prob");
  tr_levels = VECTOR_ELT(getAttrib(tr, R_DimNamesSymbol), 0);
  tr_nlevels = LENGTH(tr_levels);
  /* get the prior distribution. */
  pr = REAL(prior);

  if (*debuglevel > 0) {

    Rprintf("* the prior distribution for the target variable is:\n");
    PrintValue(prior);

  }/*THEN*/

  /* allocate the scratch space used to compute posterior probabilities. */
  scratch = alloc1dreal(tr_nlevels);
  buf = alloc1dreal(tr_nlevels);

  /* cache the pointers to the conditional probability tables. */
  cpt = (double **) alloc1dpointer(nvars);

  for (i = 0; i < nvars; i++) 
    cpt[i] = REAL(getListElement(VECTOR_ELT(fitted, i), "prob"));

  /* dereference the parents' vector. */
  prn = INTEGER(parents);

  /* create the vector of indexes. */
  iscratch = alloc1dcont(tr_nlevels);

  /* allocate the array for the indexes of the maxima. */
  maxima = alloc1dcont(tr_nlevels);

  /* allocate the return value. */
  PROTECT(result = allocVector(INTSXP, n));
  res = INTEGER(result);

  /* allocate and initialize the table of the posterior probabilities. */
  if (*include_prob > 0) {

    PROTECT(probtab = allocMatrix(REALSXP, tr_nlevels, n));
    pt = REAL(probtab);
    memset(pt, '\0', n * tr_nlevels * sizeof(double));

  }/*THEN*/

  /* initialize the random seed, just in case we need it for tie breaking. */
  GetRNGstate();

  /* for each observation... */
  for (i = 0; i < n; i++) {

    /* ... reset the scratch space and the indexes array... */
    for (k = 0; k < tr_nlevels; k++) {

      scratch[k] = log(pr[k]);
      iscratch[k] = k + 1;

    }/*FOR*/

    if (*debuglevel > 0)
      Rprintf("* predicting the value of observation %d.\n", i + 1);

    /* ... and for each conditional probability table... */
    for (j = 0; j < nvars; j++) {

      /* ... skip the training variable... */
      if (*tr_id == j + 1)
        continue;

      /* ... (this is the root node of the Chow-Liu tree) ... */
      if (prn[j] == NA_INTEGER) {

        /* ... and for each row of the conditional probability table... */
        for (k = 0; k < tr_nlevels; k++) {

          if (*debuglevel > 0) {

            Rprintf("  > node %s: picking cell %d (%d, %d) from the CPT (p = %lf).\n",
              NODE(j), CMC(ex[j][i] - 1, k, ex_nlevels[j]), ex[j][i], k + 1,
              cpt[j][CMC(ex[j][i] - 1, k, ex_nlevels[j])]);

          }/*THEN*/

          /* ... update the posterior probability. */
          scratch[k] += log(cpt[j][CMC(ex[j][i] - 1, k, ex_nlevels[j])]);

        }/*FOR*/

      }/*THEN*/
      else {

        /* ... and for each row of the conditional probability table... */
        for (k = 0; k < tr_nlevels; k++) {

          /* (the first dimension corresponds to the current node [X], the second
           * to the training node [Y], the third to the only parent of the current
           * node [Z]; CMC coordinates are computed as X + Y * NX + Z * NX * NY. */
          idx = (ex[j][i] - 1) + k * ex_nlevels[j] + 
                  (ex[prn[j] - 1][i] - 1) * ex_nlevels[j] * tr_nlevels;

          if (*debuglevel > 0) {

            Rprintf("  > node %s: picking cell %d (%d, %d, %d) from the CPT (p = %lf).\n",
              NODE(j), idx, ex[j][i], k + 1, ex[prn[j] - 1][i], cpt[j][idx]);

          }/*THEN*/

          /* ... update the posterior probability. */
          scratch[k] += log(cpt[j][idx]);

        }/*FOR*/

      }/*ELSE*/

    }/*FOR*/

    /* find out the mode(s). */
    all_max(scratch, tr_nlevels, maxima, &nmax, iscratch, buf);

    /* compute the posterior probabilities on the right scale, to attach them
     * to the return value. */
    if (*include_prob) {

      /* copy the log-probabilities from scratch. */
      memcpy(pt + i * tr_nlevels, scratch, tr_nlevels * sizeof(double));

      /* transform log-probabilitiees into plain probabilities. */
      for (k = 0, sum = 0; k < tr_nlevels; k++)
        sum += pt[i * tr_nlevels + k] = exp(pt[i * tr_nlevels + k] - scratch[maxima[0] - 1]);

      /* rescale them to sum up to 1. */
      for (k = 0; k < tr_nlevels; k++)
        pt[i * tr_nlevels + k] /= sum;

    }/*THEN*/

    if (nmax == 1) {

      res[i] = maxima[0];

      if (*debuglevel > 0) {

        Rprintf("  @ prediction for observation %d is '%s' with (log-)posterior:\n",
          i + 1, CHAR(STRING_ELT(tr_levels, res[i] - 1)));

        Rprintf("  ");
        for (k = 0; k < tr_nlevels; k++)
          Rprintf("  %lf", scratch[k]);
        Rprintf("\n");

      }/*THEN*/

    }/*THEN*/
    else {

      /* break ties: sample with replacement from all the maxima. */
      SampleReplace(1, nmax, res + i, maxima);

      if (*debuglevel > 0) {

        Rprintf("  @ there are %d levels tied for prediction of observation %d, applying tie breaking.\n", nmax, i + 1);

        Rprintf("  ");
        for (k = 0; k < tr_nlevels; k++)
          Rprintf("  %lf", scratch[k]);
        Rprintf("\n");

        Rprintf("  @ tied levels are:");
        for (k = 0; k < nmax; k++)
          Rprintf(" %s", CHAR(STRING_ELT(tr_levels, maxima[k] - 1)));
        Rprintf(".\n");

      }/*THEN*/

    }/*ELSE*/

  }/*FOR*/

  /* save the state of the random number generator. */
  PutRNGstate();

  /* add back the attributes and the class to the return value. */
  PROTECT(class = allocVector(STRSXP, 1));
  SET_STRING_ELT(class, 0, mkChar("factor"));
  setAttrib(result, R_LevelsSymbol, tr_levels);
  setAttrib(result, R_ClassSymbol, class);

  if (*include_prob > 0) {

    /* set the levels of the taregt variable as rownames. */
    PROTECT(dimnames = allocVector(VECSXP, 2));
    SET_VECTOR_ELT(dimnames, 0, tr_levels);
    setAttrib(probtab, R_DimNamesSymbol, dimnames);
    /* add the posterior probabilities to the return value. */
    setAttrib(result, install("prob"), probtab);

    UNPROTECT(4);

  }/*THEN*/
  else {

    UNPROTECT(2);

  }/*ELSE*/

  return result;

}/*NAIVEPRED*/
Exemple #14
0
static int parse_literal(struct peg_grammar_parser *pgp, struct peg_cursor *pc,
			 int *litp)
{
	struct peg_grammar *peg = pgp->peg;
	struct peg_cursor npc = *pc;
	int nn;
	struct peg_node *pn;
	int c;
	int rv;
	uint i;
	char quote;
	struct raw value;

	quote = CHAR(pgp, &npc);
	if ( quote != '"' && quote != '\'' )
		return 0;
	npc.pos += 1;

	value.len = 0;
	do {
		rv = parse_char(pgp, &npc, &c);
		if ( rv < 0 )
			goto err;
		if ( rv == 0 ) {
			pgp->err = PEG_ERR_BAD_LITERAL;
			goto err;
		}
		value.len += 1;
	} while ( c != quote );

	nn = peg_node_new(peg, PEG_LITERAL, pc->line);
	if ( nn < 0 ) {
		pgp->err = PEG_ERR_NOMEM;
		return -1;
	}
	value.data = malloc(value.len);
	if ( value.data == NULL ) {
		pgp->err = PEG_ERR_NOMEM;
		peg_node_free(peg, nn);
		return -1;
	}

	/* now copy/translate the string for real since we know */
	/* its true length and that it decodes correctly. */
	npc.pos = pc->pos + 1;
	npc.line = pc->line;
	for ( i = 0; i < value.len - 1; ++i ) {
		rv = parse_char(pgp, &npc, &c);
		abort_unless(rv > 0); /* tested above */
		value.data[i] = c;
	}
	value.data[i] = '\0';

	pn = NODE(peg, nn);
	pn->pl_value = value;
	pn->pl_value.len -= 1;

	pc->pos = npc.pos + 1; /* skip last quote */
	pc->line = npc.line;
	*litp = nn;
	skip_space(pgp, pc);
	return 1;

err:
	pgp->eloc = npc;
	return -1;
}
Exemple #15
0
/**
 * Get the text of this node.
 * @return	Node text.
 */
String Comment::getText(void) {
	return NODE(node)->content;
}
Exemple #16
0
/**
 * Build a new text node by cloning an existing one.
 * @param text	Text node to clone.
 */
Comment::Comment(const Comment *comment): Node(xmlCopyNode(NODE(comment->node), 1)) {
	ASSERT(node);
}
Exemple #17
0
static inline void exchange(heap_t h, size_t i, size_t j)
{
   struct node tmp = NODE(h, j);
   NODE(h, j) = NODE(h, i);
   NODE(h, i) = tmp;
}
Exemple #18
0
void addentry(char *dir,char *file,uint32_t type,struct Node4D *boss,bool flow)
{
   struct osFileEntry *fe;
   struct fileentry *entry;
   struct Node4D n4d;
   char buf[200];
   char buf2[200];
   uint32_t hex;

   hex=hextodec(file);

   if(boss)
   {
      Copy4D(&n4d,boss);
      n4d.Point = hex;
   }
   else
   {
      n4d.Zone = cfg_Zone;
      n4d.Net = NET(hex);
      n4d.Node = NODE(hex);
      n4d.Point = 0;
   }

   if(Compare4DPat(&cfg_Pattern,&n4d)!=0)
      return;

   if(dir) MakeFullPath(dir,file,buf,200);
   else    mystrncpy(buf,file,200);

   MakeFullPath(cfg_Dir,buf,buf2,200);

   if(!(fe=osGetFileEntry(buf2)))
   {
      return;
   }

   if(!(entry=osAlloc(sizeof(struct fileentry))))
   {
      osFree(fe);
      return;
   }

   Copy4D(&entry->Node,&n4d);

   if(dir)
   {
      MakeFullPath(dir,file,entry->file,100);
      MakeFullPath(cfg_Dir,dir,entry->dir,100);
   }
   else
   {
      mystrncpy(entry->file,file,100);
      mystrncpy(entry->dir,cfg_Dir,100);
   }

   mystrncpy(entry->file,buf,100);
   entry->size=fe->Size;
   entry->date=fe->Date;
   entry->type=type;
   entry->flow=flow;

   jbAddNode(&list,(struct jbNode *)entry);
   osFree(fe);
}
Exemple #19
0
static int parse_primary(struct peg_grammar_parser *pgp, struct peg_cursor *pc,
			 int *prip)
{
	struct peg_grammar *peg = pgp->peg;
	int pri;
	int rv;
	int match = -1;
	struct peg_cursor npc = *pc;
	int prefix = PEG_ATTR_NONE;
	int suffix = PEG_ATTR_NONE;
	int action = PEG_ACT_NONE;
	struct raw r = { 0, NULL };
	struct peg_node *pn;

	if ( string_match(pgp, "&", &npc) )
		prefix = PEG_ATTR_AND;
	else if ( string_match(pgp, "!", &npc) )
		prefix = PEG_ATTR_NOT;

	if ( (rv = parse_id_and_not_arrow(pgp, &npc, &match)) != 0 ) {
		if ( rv < 0 )
			goto err;
	} else if ( (rv = parse_paren_expr(pgp, &npc, &match)) != 0 ) {
		if ( rv < 0 )
			goto err;
	} else if ( (rv = parse_literal(pgp, &npc, &match)) != 0 ) {
		if ( rv < 0 )
			goto err;
	} else if ( (rv = parse_class(pgp, &npc, &match)) != 0 ) {
		if ( rv < 0 )
			goto err;
	} else {
		if ( prefix == PEG_ATTR_NONE )
			return 0;
		pgp->err = PEG_ERR_BAD_PRIMARY;
		pgp->eloc = *pc;
		return -1;
	}

	pri = peg_node_new(peg, PEG_PRIMARY, pc->line);
	if ( pri < 0 ) {
		pgp->err = PEG_ERR_NOMEM;
		goto err;
	}

	if ( string_match(pgp, "?", &npc) )
		suffix = PEG_ATTR_QUESTION;
	else if ( string_match(pgp, "*", &npc) )
		suffix = PEG_ATTR_STAR;
	else if ( string_match(pgp, "+", &npc) )
		suffix = PEG_ATTR_PLUS;
	else
		suffix = PEG_ATTR_NONE;

	rv = parse_code(pgp, &npc, &r);
	if ( rv < 0 )
		goto err;
	if ( rv > 0 ) {
		action = PEG_ACT_CODE;
	} else {
		rv = parse_action_label(pgp, &npc, &r);
		if ( rv < 0 )
			goto err;
		if ( rv > 0 )
			action = PEG_ACT_LABEL;
	}

	pn = NODE(peg, pri);
	pn->pn_next = -1;
	pn->pp_match = match;
	pn->pp_prefix = prefix;
	pn->pp_suffix = suffix;
	pn->pp_action = action;
	pn->pn_action_cb = NULL;
	pn->pp_code = r;

	*pc = npc;
	*prip = pri;
	return 1;

err:
	peg_node_free(peg, match);
	return -1;
}
Exemple #20
0
static int BTreeAddLeaf(btree_t t, index_t nidx,
                        double *k, index_t *ptr)
{
  int i,j;
  double key[MAXCARD];
  index_t branch[MAXCARD];
  node_t n;
  index_t nidx1;
  node_t n1;

  n = NODE(t, nidx);
  assert(n);

  if (n->count < MAXCARD_(t) - 1) /*split not necessary*/
    {
      i = n->count;
      if (i > 0)
        for (; n->branch[i-1].key > *k; i--)
          {
            n->branch[i].key = n->branch[i-1].key;
            n->branch[i].child = n->branch[i-1].child;
          }
      n->branch[i].key = *k;
      n->branch[i].child = (index_t) *ptr;
      n->count ++;
      return FALSE;
    }
  else /*needs to split*/
    {
      for(i = n->count - 1, j = MAXCARD - 1;
          n->branch[i].key > *k;
          i--, j--)
        {
          key[j] = n->branch[i].key;
          branch[j] = n->branch[i].child;
        }
      key[j] = *k;
      branch[j] = (index_t) *ptr;
      j--;
      for(; i >= 0;i--,j--)
        {
          key[j] = n->branch[i].key;
          branch[j] = n->branch[i].child;
        }

      n->count = 0;

      nidx1 = BTreeNewNode(t);
      /* account for possible node pointer change*/
      n = NODE(t,nidx);
      n1 = NODE(t,nidx1);

      n1->level = n->level;

      for (i = 0; i <= MAXCARD_(t) / 2; i ++)
        {
          n->branch[i].key = key[i];
          n->branch[i].child = branch[i];
          n->count ++;
        }
      *k = key[i-1];
      *ptr = nidx1;
      for (j = 0; i < MAXCARD; j ++, i ++)
        {
          n1->branch[j].key = key[i];
          n1->branch[j].child = branch[i];
          n1->count ++;
        }

      /*linked list*/
      n1->branch[MAXCARD_(t)-1].child = n->branch[MAXCARD_(t)-1].child;
      n->branch[MAXCARD_(t)-1].child = nidx1;

    return TRUE;
    }
}
Exemple #21
0
bool expr_this(pass_opt_t* opt, ast_t* ast)
{
  typecheck_t* t = &opt->check;

  if(t->frame->def_arg != NULL)
  {
    ast_error(opt->check.errors, ast,
      "can't reference 'this' in a default argument");
    return false;
  }

  sym_status_t status;
  ast_get(ast, stringtab("this"), &status);

  if(status == SYM_CONSUMED)
  {
    ast_error(opt->check.errors, ast,
      "can't use a consumed 'this' in an expression");
    return false;
  }

  assert(status == SYM_NONE);
  token_id cap = cap_for_this(t);

  if(!cap_sendable(cap) && (t->frame->recover != NULL))
  {
    ast_t* parent = ast_parent(ast);
    if(ast_id(parent) != TK_DOT)
      cap = TK_TAG;
  }

  bool make_arrow = false;

  if(cap == TK_BOX)
  {
    cap = TK_REF;
    make_arrow = true;
  }

  ast_t* type = type_for_this(opt, ast, cap, TK_NONE, false);

  if(make_arrow)
  {
    BUILD(arrow, ast, NODE(TK_ARROW, NODE(TK_THISTYPE) TREE(type)));
    type = arrow;
  }

  // Get the nominal type, which may be the right side of an arrow type.
  ast_t* nominal;
  bool arrow;

  if(ast_id(type) == TK_NOMINAL)
  {
    nominal = type;
    arrow = false;
  } else {
    nominal = ast_childidx(type, 1);
    arrow = true;
  }

  ast_t* typeargs = ast_childidx(nominal, 2);
  ast_t* typearg = ast_child(typeargs);

  while(typearg != NULL)
  {
    if(!expr_nominal(opt, &typearg))
    {
      ast_error(opt->check.errors, ast, "couldn't create a type for 'this'");
      ast_free(type);
      return false;
    }

    typearg = ast_sibling(typearg);
  }

  if(!expr_nominal(opt, &nominal))
  {
    ast_error(opt->check.errors, ast, "couldn't create a type for 'this'");
    ast_free(type);
    return false;
  }

  // Unless this is a field lookup, treat an incomplete `this` as a tag.
  ast_t* parent = ast_parent(ast);
  bool incomplete_ok = false;

  if((ast_id(parent) == TK_DOT) && (ast_child(parent) == ast))
  {
    ast_t* right = ast_sibling(ast);
    assert(ast_id(right) == TK_ID);
    ast_t* find = lookup_try(opt, ast, nominal, ast_name(right));

    if(find != NULL)
    {
      switch(ast_id(find))
      {
        case TK_FVAR:
        case TK_FLET:
        case TK_EMBED:
          incomplete_ok = true;
          break;

        default: {}
      }
    }
  }

  if(!incomplete_ok && is_this_incomplete(t, ast))
  {
    ast_t* tag_type = set_cap_and_ephemeral(nominal, TK_TAG, TK_NONE);
    ast_replace(&nominal, tag_type);
  }

  if(arrow)
    type = ast_parent(nominal);
  else
    type = nominal;

  ast_settype(ast, type);
  return true;
}
Exemple #22
0
/* generator of layered networks for the shortest paths problem;
   extended DIMACS format for output */
int
gen_spgrid_topology (struct vty *vty, struct list *topology)
{
  /* ----- ajusting parameters ----- */

  /* spanning */
  if ( cl < cm ) { lx = cl; cl = cm; cm = lx; }

  /* additional arcs */
  if ( al < am ) { lx = al; al = am; am = lx; }

  /* interlayered arcs */
  if ( il < im ) { lx = il; il = im; im = lx; }

  /* potential parameters */
  if ( p_f )
    {
     if ( ! pl_f ) pl = il;
     if ( ! pm_f ) pm = im;
     if ( pl < pm ) { lx = pl; pl = pm; pm = lx; }
    }

  /* number of nodes and arcs */

  n = (double)X *(double)Y + 1;

  m  = (double)Y; /* arcs from source */

  switch ( cw )
  {
   case PATH:
    mc = (double)Y - 1;
    break;
   case CYCLE:
    mc = (double)Y;
    break;
   case DOUBLE_CYCLE:
    mc = 2*(double)Y;
  }

  m += (double)X * (double)mc;  /* spanning arcs */
  m += (double)X * (double)ax;  /* additional arcs */

  /* interlayered arcs */
  for ( x = 0; x < X; x ++ )
  {
    dl = ( ( X - x - 1 ) + ( ih - 1 ) ) / ih;
    if ( dl > ix ) dl = ix;
    m += (double)Y * (double)dl;
  }

   /* artifical source parameters */
  if ( s_f ) {
    m += n; n ++ ;
    if ( ! sm_f ) sm = sl;
    if ( sl < sm ) { lx = sl; sl = sm; sm = lx; }
  }

  if ( n >= (double)LONG_MAX || m >= (double)LONG_MAX )
  {
    zlog_err ("Too large problem. It can't be generated\n");
    exit (4);
  }
   else
  {
    n0 = (long)n; m0 = (long)m;
  }

  if ( ip_f )
     mess = (long*) calloc ( Y, sizeof ( long ) );

  /* printing title */
  zlog_info ("Generating topology for ISIS");

  source = ( s_f ) ? n0-1 : n0;

  if ( p_f ) /* generating potentials */ {
    p = (long*) calloc ( n0+1, sizeof (long) );
    seed1 = 2*seed + 1;
    init_rand ( seed1);
    pl = pl - pm + 1;

    for ( x = 0; x < X; x ++ )
      for ( y = 0; y < Y; y ++ ) {
        p_t = pm + nrand ( pl );
        if ( pn_f ) p_t *= (long) ( (1 + x) * pn );
        if ( ps_f ) p_t *= (long) ( (1 + x) * ( (1 + x) * ps ));

        p[ NODE ( x, y ) ] = p_t;
      }
      p[n0] = 0;
      if ( s_f ) p[n0-1] = 0;
    }

  if ( s_f ) /* additional arcs from artifical source */
    {
      seed2 = 3*seed + 1;
      init_rand ( seed2 );
      sl = sl - sm + 1;

      for ( x = X - 1; x >= 0; x -- )
        for ( y = Y - 1; y >= 0; y -- )
        {
          i = NODE ( x, y );
          s = sm + nrand ( sl );
          print_arc (vty, topology,  n0, i, s );
        }

      print_arc (vty, topology,  n0, n0-1, 0 );
    }


  /* ----- generating arcs within layers ----- */

  init_rand ( seed );
  cl = cl - cm + 1;
  al = al - am + 1;

  for ( x = 0; x < X; x ++ )
   {
  /* generating arcs within one layer */
    for ( y = 0; y < Y-1; y ++ )
    {
       /* generating spanning graph */
       i = NODE ( x, y );
       j = NODE ( x, y+1 );
       l = cm + nrand ( cl );
       print_arc (vty, topology,  i, j, l );

       if ( cw == DOUBLE_CYCLE )
         {
           l = cm + nrand ( cl );
           print_arc (vty, topology,  j, i, l );
         }
     }

    if ( cw <= CYCLE )
      {
        i = NODE ( x, Y-1 );
        j = NODE ( x, 0 );
        l = cm + nrand ( cl );
        print_arc (vty, topology,  i, j, l );

        if ( cw == DOUBLE_CYCLE )
          {
  	  l = cm + nrand ( cl );
            print_arc (vty, topology,  j, i, l );
          }
       }

  /* generating additional arcs */

    for ( k = ax; k > 0; k -- )
       {
         yy1 = nrand ( Y );
         do
            yy2 = nrand ( Y );
         while ( yy2 == yy1 );
         i  = NODE ( x, yy1 );
         j  = NODE ( x, yy2 );
         l = am + nrand ( al );
         print_arc (vty, topology,  i, j, l );
       }
   }

  /* ----- generating interlayered arcs ------ */

  il = il - im + 1;

  /* arcs from the source */

    for ( y = 0; y < Y; y ++ )
      {
        l = im + nrand ( il );
        i = NODE ( 0, y );
        print_arc (vty, topology,  source, i, l );
      }

  for ( x = 0; x < X-1; x ++ )
   {
  /* generating arcs from one layer */
     for ( count = 0, xn = x + 1;
           count < ix && xn < X;
           count ++, xn += ih )
      {
        if ( ip_f )
        for ( y = 0; y < Y; y ++ )
  	mess[y] = y;

        for ( y = 0; y < Y; y ++ )
         {
            i = NODE ( x, y );
  	  dx = xn - x;
  	  if ( ip_f )
  	    {
  	      yyp = nrand(Y-y);
  	      yyn = mess[ yyp ];
                mess[ yyp ] = mess[ Y - y - 1 ];
  	    }
  	  else
               yyn =  y;
  	  j = NODE ( xn, yyn );
  	  l = im + nrand ( il );
  	  if ( in != 0 )
              l *= (long) ( in * dx );
            if ( is_f )
              l *= (long) ( ( is * dx ) * dx );
            print_arc (vty, topology,  i, j, l );
  	}
      }
   }
  /* all is done */
  return ext;

return 0;
}
Exemple #23
0
/**
 * Set the content of the text.
 * @param data	Text to put in.
 */
void Comment::setValue(String data) {
	xmlNodeSetContent(NODE(node), data);
}
Exemple #24
0
// Process the given capture and create the AST for the corresponding field.
// Returns the create field AST, which must be freed by the caller.
// Returns NULL on error.
static ast_t* make_capture_field(pass_opt_t* opt, ast_t* capture)
{
  assert(capture != NULL);

  AST_GET_CHILDREN(capture, id_node, type, value);
  const char* name = ast_name(id_node);

  // There are 3 varieties of capture:
  // x -> capture variable x, type from defn of x
  // x = y -> capture expression y, type inferred from expression type
  // x: T = y -> capture expression y, type T

  if(ast_id(value) == TK_NONE)
  {
    // Variable capture
    assert(ast_id(type) == TK_NONE);

    ast_t* def = ast_get(capture, name, NULL);

    if(def == NULL)
    {
      ast_error(opt->check.errors, id_node,
        "cannot capture \"%s\", variable not defined", name);
      return NULL;
    }

    token_id def_id = ast_id(def);

    if(def_id != TK_ID && def_id != TK_FVAR && def_id != TK_FLET &&
      def_id != TK_PARAM)
    {
      ast_error(opt->check.errors, id_node, "cannot capture \"%s\", can only "
        "capture fields, parameters and local variables", name);
      return NULL;
    }

    BUILD(capture_rhs, id_node, NODE(TK_REFERENCE, ID(name)));

    type = alias(ast_type(def));
    value = capture_rhs;
  } else if(ast_id(type) == TK_NONE) {
    // No type specified, use type of the captured expression
    type = alias(ast_type(value));
  } else {
    // Type given, infer literals
    if(!coerce_literals(&value, type, opt))
      return NULL;
  }

  if(is_typecheck_error(type))
    return NULL;

  type = sanitise_type(type);

  BUILD(field, id_node,
    NODE(TK_FVAR,
      TREE(id_node)
      TREE(type)
      TREE(value)
      NONE));  // Delegate type

  return field;
}
Exemple #25
0
// Determine the UIF types that the given formal parameter may be
static int uifset_formal_param(pass_opt_t* opt, ast_t* type_param_ref,
  lit_chain_t* chain)
{
  assert(type_param_ref != NULL);
  assert(ast_id(type_param_ref) == TK_TYPEPARAMREF);

  ast_t* type_param = (ast_t*)ast_data(type_param_ref);

  assert(type_param != NULL);
  assert(ast_id(type_param) == TK_TYPEPARAM);
  assert(chain != NULL);

  ast_t* constraint = ast_childidx(type_param, 1);
  assert(constraint != NULL);

  // If the constraint is not a subtype of (Real[A] & Number) then there are no
  // legal types in the set
  ast_t* number = type_builtin(opt, type_param, "Number");
  ast_t* real = type_builtin(opt, type_param, "Real");
  ast_setid(ast_childidx(real, 3), TK_BOX);

  ast_t* p_ref = ast_childidx(real, 2);
  REPLACE(&p_ref,
    NODE(TK_TYPEARGS,
      NODE(TK_TYPEPARAMREF, DATA(type_param)
        ID(ast_name(ast_child(type_param))) NODE(TK_VAL) NONE)));

  bool is_real = is_subtype(constraint, real);
  bool is_number = is_subtype(constraint, number);
  ast_free(number);
  ast_free(real);

  if(!is_real || !is_number)
    // The formal param is not a subset of (Real[A] & Number)
    return UIF_NO_TYPES;

  int uif_set = 0;

  for(int i = 0; i < UIF_COUNT; i++)
  {
    ast_t* uif = type_builtin(opt, type_param, _str_uif_types[i].name);

    BUILD(params, type_param, NODE(TK_TYPEPARAMS, TREE(ast_dup(type_param))));
    BUILD(args, type_param, NODE(TK_TYPEARGS, TREE(uif)));

    if(check_constraints(params, args, false))
      uif_set |= (1 << i);

    ast_free(args);
    ast_free(params);
  }

  if(uif_set == 0)  // No legal types
    return UIF_NO_TYPES;

  // Given formal parameter is legal to coerce to
  if(chain->formal != NULL && chain->formal != type_param)
  {
    ast_error(type_param_ref,
      "Cannot infer a literal type with multiple formal parameters");
    return UIF_ERROR;
  }

  chain->formal = type_param;
  chain->name = ast_name(ast_child(type_param));
  return uif_set | UIF_CONSTRAINED;
}
Exemple #26
0
bool expr_lambda(pass_opt_t* opt, ast_t** astp)
{
  assert(astp != NULL);
  ast_t* ast = *astp;
  assert(ast != NULL);

  AST_GET_CHILDREN(ast, cap, name, t_params, params, captures, ret_type,
    raises, body);

  ast_t* members = ast_from(ast, TK_MEMBERS);
  ast_t* last_member = NULL;
  bool failed = false;

  // Process captures
  for(ast_t* p = ast_child(captures); p != NULL; p = ast_sibling(p))
  {
    ast_t* field = make_capture_field(opt, p);

    if(field != NULL)
      ast_list_append(members, &last_member, field);
    else  // An error occurred, just keep going to potentially find more errors
      failed = true;
  }

  if(failed)
  {
    ast_free(members);
    return false;
  }

  // Stop the various elements being marked as preserve
  ast_clearflag(t_params, AST_FLAG_PRESERVE);
  ast_clearflag(params, AST_FLAG_PRESERVE);
  ast_clearflag(ret_type, AST_FLAG_PRESERVE);
  ast_clearflag(body, AST_FLAG_PRESERVE);

  const char* fn_name = "apply";

  if(ast_id(name) == TK_ID)
    fn_name = ast_name(name);

  // Make the apply function
  BUILD(apply, ast,
    NODE(TK_FUN, AST_SCOPE
      TREE(cap)
      ID(fn_name)
      TREE(t_params)
      TREE(params)
      TREE(ret_type)
      TREE(raises)
      TREE(body)
      NONE    // Doc string
      NONE)); // Guard

  ast_list_append(members, &last_member, apply);

  printbuf_t* buf = printbuf_new();
  printbuf(buf, "lambda(");
  bool first = true;

  for(ast_t* p = ast_child(params); p != NULL; p = ast_sibling(p))
  {
    if(first)
      first = false;
    else
      printbuf(buf, ", ");

    printbuf(buf, "%s", ast_print_type(ast_childidx(p, 1)));
  }

  printbuf(buf, ")");

  if(ast_id(ret_type) != TK_NONE)
    printbuf(buf, ": %s", ast_print_type(ret_type));

  if(ast_id(raises) != TK_NONE)
    printbuf(buf, " ?");

  printbuf(buf, " end");

  // Replace lambda with object literal
  REPLACE(astp,
    NODE(TK_OBJECT, DATA(stringtab(buf->m))
      NONE
      NONE  // Provides list
      TREE(members)));

  printbuf_free(buf);

  // Catch up passes
  if(ast_visit(astp, pass_syntax, NULL, opt, PASS_SYNTAX) != AST_OK)
    return false;

  return ast_passes_subtree(astp, opt, PASS_EXPR);
}
Exemple #27
0
/* construct a consistent DAG extension of a CPDAG. */
SEXP pdag_extension(SEXP arcs, SEXP nodes, SEXP debug) {

int i = 0, j = 0, k = 0, t = 0, nnodes = length(nodes);
int changed = 0, left = nnodes;
int *a = NULL, *nbr = NULL, debuglevel = isTRUE(debug);
short int *matched = NULL;
SEXP amat, result;

  /* build and dereference the adjacency matrix. */
  PROTECT(amat = arcs2amat(arcs, nodes));
  a = INTEGER(amat);

  /* allocate and initialize the neighbours and matched vectors. */
  nbr = Calloc1D(nnodes, sizeof(int));
  matched = Calloc1D(nnodes, sizeof(short int));

  for (t = 0; t < nnodes; t++) {

    if (debuglevel > 0) {

      Rprintf("----------------------------------------------------------------\n");
      Rprintf("> performing pass %d.\n", t + 1);
      Rprintf("> candidate nodes: ");
        for (j = 0; j < nnodes; j++)
          if (matched[j] == 0)
            Rprintf("%s ", NODE(j));
      Rprintf("\n");

    }/*THEN*/

    for (i = 0; i < nnodes; i++) {

      /* if the node is already ok, skip it. */
      if (matched[i] != 0)
        continue;

      /* check whether the node is a sink (that is, whether is does not have
       * any child). */
      is_a_sink(a, i, &k, nnodes, nbr, matched);

      /* if the node is not a sink move on. */
      if (k == -1) {

        if (debuglevel > 0)
          Rprintf("  * node %s is not a sink.\n", NODE(i));

        continue;

      }/*THEN*/
      else {

        if (debuglevel > 0)
          Rprintf("  * node %s is a sink.\n", NODE(i));

      }/*ELSE*/

      if (!all_adjacent(a, i, k, nnodes, nbr)) {

        if (debuglevel > 0)
          Rprintf("  * not all nodes linked to %s by an undirected arc are adjacent.\n", NODE(i));

        continue;

      }/*THEN*/
      else {

        if (debuglevel > 0) {

          if (k == 0)
            Rprintf("  * no node is linked to %s by an undirected arc.\n", NODE(i));
          else
            Rprintf("  * all nodes linked to %s by an undirected arc are adjacent.\n", NODE(i));

        }/*THEN*/

      }/*ELSE*/

      /* the current node meets all the conditions, direct all the arcs towards it. */
      if (k == 0) {

        if (debuglevel > 0)
          Rprintf("  @ no undirected arc to direct towards %s.\n", NODE(i));

      }/*THEN*/
      else {

        for (j = 0; j < k; j++)
          a[CMC(i, nbr[j], nnodes)] = 0;

        if (debuglevel > 0)
          Rprintf("  @ directing all incident undirected arcs towards %s.\n", NODE(i));

      }/*ELSE*/

      /* set the changed flag. */
      changed = 1;

      /* exclude the node from later iterations. */
      matched[i] = 1;
      left--;

    }/*FOR*/

    /* if nothing changed in the last iteration or there are no more candidate
     * nodes, there is nothing else to do. */
    if ((changed == 0) || (left == 0))
      break;
    else
      changed = 0;

  }/*FOR*/

  /* build the new arc set from the adjacency matrix. */
  PROTECT(result = amat2arcs(amat, nodes));

  Free1D(nbr);
  Free1D(matched);
  UNPROTECT(2);

  return result;

}/*PDAG_EXTENSION*/
Exemple #28
0
  char *cp;
  (void)arg;

  for (int i = 0; i < 100; i++) {
    cp = tor_malloc(DIGEST256_LEN);
    tt_assert(cp);
    crypto_rand(cp, DIGEST256_LEN);
    smartlist_add(downloadable, cp);
  }

  MOCK(initiate_descriptor_downloads, mock_initiate_descriptor_downloads);
  launch_descriptor_downloads(DIR_PURPOSE_FETCH_MICRODESC, downloadable,
                              NULL, now);
  tt_int_op(3, ==, count);
  UNMOCK(initiate_descriptor_downloads);

 done:
  SMARTLIST_FOREACH(downloadable, char *, cp1, tor_free(cp1));
  smartlist_free(downloadable);
}

#define NODE(name, flags) \
  { #name, test_routerlist_##name, (flags), NULL, NULL }

struct testcase_t routerlist_tests[] = {
  NODE(initiate_descriptor_downloads, 0),
  NODE(launch_descriptor_downloads, 0),
  END_OF_TESTCASES
};

Exemple #29
0
/* find out the partial ordering of the nodes of a DAG. */
SEXP topological_ordering(SEXP bn, SEXP root_nodes, SEXP reverse, SEXP debug) {

int *depth = NULL, *matched = NULL, debuglevel = isTRUE(debug);
int d = 0, i = 0, j = 0, changed = 0, nnodes = 0;
char *direction = NULL;
SEXP nodes_data, nodes, try, children, ordering;

  if (isTRUE(reverse))
    direction = "parents";
  else
    direction = "children";

  /* get to the nodes' data in both 'bn' and 'bn.fit' objects. */
  nodes_data = getListElement(bn, "nodes");

  if (isNull(nodes_data))
    nodes_data = bn;

  /* get and count the node labels. */
  PROTECT(nodes = getAttrib(nodes_data, R_NamesSymbol));
  nnodes = length(nodes);

  /* allocate a status vector to trak the ordering of the nodes. */
  PROTECT(ordering = allocVector(INTSXP, nnodes));
  depth = INTEGER(ordering);
  memset(depth, '\0', nnodes * sizeof(int));

  if (debuglevel > 0)
    Rprintf("* currently at depth 1 (starting BFS).\n");

  /* set the root nodes as the starting point of the BFS. */
  PROTECT(try = match(nodes, root_nodes, 0));
  matched = INTEGER(try);

  for (i = 0; i < length(try); i++) {

    if (debuglevel > 0)
      Rprintf("  > got node %s.\n", NODE(matched[i] - 1));

    depth[matched[i] - 1] = 1;

  }/*FOR*/

  UNPROTECT(1);

  /* now let's go down from the roots to the leafs, one layer at a time. */
  for (d = 1; d <= nnodes; d++) {

    if (debuglevel > 0)
      Rprintf("* currently at depth %d.\n", d + 1);

    /* reset the changed flag. */
    changed = 0;

    for (i = 0; i < nnodes; i++) {

      /* this node has already been visisted, skip. */
      if (depth[i] < d)
        continue;

      children = getListElement(VECTOR_ELT(nodes_data, i), direction);

      /* this node is a leaf, nothing to do, move along. */
      if (length(children) == 0)
        continue;

      /* set the changed flag. */
      changed = 1;

      PROTECT(try = match(nodes, children, 0));
      matched = INTEGER(try);

      /* set the correct depth to the children of this node. */
      for (j = 0; j < length(try); j++) {

        if (debuglevel > 0)
          Rprintf("  > got node %s from %s.\n",
            NODE(matched[j] - 1), NODE(i));

        depth[matched[j] - 1] = d + 1;

      }/*FOR*/

      UNPROTECT(1);

    }/*FOR*/

    /* all nodes have been visited, break. */
    if (!changed) break;

  }/*FOR*/

  if (debuglevel > 0)
    Rprintf("* all nodes have been scheduled.\n");

  /* add the node labels to the return value. */
  setAttrib(ordering, R_NamesSymbol, nodes);

  UNPROTECT(2);

  return ordering;

}/*TOPOLOGICAL_ORDERING*/
Exemple #30
0
static WRITE8_DEVICE_HANDLER( gyruss_dac_w )
{
	discrete_sound_w(device, NODE(16), data);
}