C++ PL_new_term_ref函数代码示例

/*************************
 * swi_list_walk
 *************************/
int
swi_list_walk(term_t list,
              int (*callback)(term_t item, int i, void *data), void *data)
{
    term_t pl_list, pl_head;
    int    i, err;
    
    pl_list = PL_copy_term_ref(list);
    pl_head = PL_new_term_ref();

    for (i = err = 0; !err && PL_get_list(pl_list, pl_head, pl_list); i++)
        err = callback(pl_head, i, data);
    
    return err;
}

static int
domain_error(term_t actual, const char *expected)
{ term_t ex;

  if ( (ex=PL_new_term_ref()) &&
       PL_unify_term(ex,
		     PL_FUNCTOR, FUNCTOR_error2,
		       PL_FUNCTOR, FUNCTOR_domain_error2,
		         PL_CHARS, expected,
		         PL_TERM, actual,
		       PL_VARIABLE) )
    return PL_raise_exception(ex);

  return FALSE;
}

static int
type_error(const char *expected, term_t found)
{ term_t ex;

  if ( (ex=PL_new_term_ref()) &&
       PL_unify_term(ex,
		     PL_FUNCTOR, FUNCTOR_error2,
		       PL_FUNCTOR, FUNCTOR_type_error2,
		         PL_CHARS, expected,
			 PL_TERM, found,
		       PL_VARIABLE) )
    return PL_raise_exception(ex);

  return FALSE;
}

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);
}

static int
init_prolog_goal(prolog_goal *g, term_t goal, int acknowledge)
{ term_t plain = PL_new_term_ref();

  g->module	 = NULL;
  g->acknowledge = acknowledge;
  g->state       = G_WAITING;
  if ( !PL_strip_module(goal, &g->module, plain) )
    return FALSE;
  if ( !(PL_is_compound(plain) || PL_is_atom(plain)) )
    return type_error(goal, "callable");
  g->goal = PL_record(plain);

  return TRUE;
}

static int
existence_error(term_t actual, const char *type)
{ term_t ex;

  if ( (ex = PL_new_term_ref()) &&
       PL_unify_term(ex,
		     PL_FUNCTOR, FUNCTOR_error2,
		       PL_FUNCTOR, FUNCTOR_existence_error2,
		         PL_CHARS, type,
		         PL_TERM, actual,
		       PL_VARIABLE) )
    return PL_raise_exception(ex);

  return FALSE;
}

static foreign_t
pl_memberchk_eq(term_t element, term_t maybe_list)
{

  term_t head = PL_new_term_ref();      	/* variable for the elements */
  term_t list = PL_copy_term_ref(maybe_list);   /* copy as we need to write */

  while( PL_get_list(list, head, list) )
  { if ( PL_compare(element,head) == 0 )
     PL_succeed ;
  }

  PL_fail;  

}

/********************
 * swi_list_new
 ********************/
term_t
swi_list_new(char **items, int n, term_t result)
{
    term_t list = PL_new_term_ref();
    term_t item = PL_new_term_ref();

    if (n < 0) {                  /* NULL-terminated list, calculate items */
        n = 0;
        if (items)
            while (items[n])
                n++;
    }

    PL_put_nil(list);
    while (n-- > 0) {
        PL_put_atom_chars(item, items[n]);
        PL_cons_list(list, item, list);
    }
    
    if (result && PL_is_variable(result))
        PL_unify(list, result);
    
    return list;
}

static int
permission_error(const char *op, const char *objtype, term_t obj)
{ term_t ex;

  if ( (ex = PL_new_term_ref()) &&
       PL_unify_term(ex,
		     PL_FUNCTOR, FUNCTOR_error2,
		       PL_FUNCTOR, FUNCTOR_permission_error3,
		         PL_CHARS, op,
		         PL_CHARS, objtype,
		         PL_TERM, obj,
		       PL_VARIABLE) )
    return PL_raise_exception(ex);

  return FALSE;
}

word
pl_dwim_predicate(term_t pred, term_t dwim, control_t h)
{ GET_LD
  functor_t fdef;
  Module module = (Module) NULL;
  Procedure proc;
  Symbol symb;
  term_t head = PL_new_term_ref();
  TableEnum e;

  if ( ForeignControl(h) == FRG_CUTTED )
  { e = ForeignContextPtr(h);
    freeTableEnum(e);
    succeed;
  }

  if ( !PL_strip_module(pred, &module, head) )
    fail;
  if ( !PL_get_functor(head, &fdef) )
    fail;				/* silent: leave errors for later */

  if ( ForeignControl(h) == FRG_FIRST_CALL )
    e = newTableEnum(module->procedures);
  else
    e = ForeignContextPtr(h);

  while( (symb = advanceTableEnum(e)) )
  { Definition def;
    char *name;

    proc = symb->value;
    def  = proc->definition;
    name = stringAtom(def->functor->name);

    if ( dwimMatch(stringAtom(nameFunctor(fdef)), name) &&
         isDefinedProcedure(proc) &&
         (name[0] != '$' || SYSTEM_MODE) )
    { if ( !PL_unify_functor(dwim, def->functor->functor) )
	continue;

      ForeignRedoPtr(e);
    }
  }

  freeTableEnum(e);
  fail;
}

void getQueryString(term_t t,char* buf)
{
  term_t head = PL_new_term_ref();
  term_t list = PL_copy_term_ref(t);
  int i=0;
  char* c;
  while(PL_get_list(list,head,list))
    {
      if(!PL_is_variable(head))
	{
	  PL_get_chars(head,&c,CVT_ATOM|BUF_DISCARDABLE);
	  buf[i]=c[0];
	}
      else
	buf[i]='_';
      ++i;
    }
  buf[i]='\0';
}

// parse a list of type terms and encode as a NULL terminated
// string where each character encodes the type of one argument.
static int get_types_list(term_t list, char *typespec, int len)
{
	term_t 	head=PL_new_term_ref();
	int		count=0;

	// copy term ref so as not to modify original
	list=PL_copy_term_ref(list);

	while (PL_get_list(list,head,list) && count<len) {
		atom_t name;
		int	 arity;
		const char  *type;

		if (!PL_get_name_arity(head,&name,&arity)) return type_error(head,"term");
		type=PL_atom_chars(name);
		switch (arity) {
		case 1: {
				if (!strcmp(type,"int")) {
					typespec[count++]='i';
				} else if (!strcmp(type,"double")) {
					typespec[count++]='d';
				} else if (!strcmp(type,"string")) {
					typespec[count++]='s';
				} else if (!strcmp(type,"symbol")) {
					typespec[count++]='S';
				} else if (!strcmp(type,"float")) {
					typespec[count++]='f';
				}
				break;
			}
		case 0: {
				if (!strcmp(type,"true")) typespec[count++]='T';
				else if (!strcmp(type,"false")) typespec[count++]='F';
				else if (!strcmp(type,"nil")) typespec[count++]='N';
				else if (!strcmp(type,"inf")) typespec[count++]='I';
				break;
			}
		}
	}
	typespec[count]=0;
	if (!PL_get_nil(list)) return type_error(list,"nil");
	return TRUE;
}

static bool
clearSourceAdmin(SourceFile sf)
{ GET_LD
  int rc = FALSE;

  fid_t fid = PL_open_foreign_frame();
  term_t name = PL_new_term_ref();
  static predicate_t pred = NULL;

  if ( !pred )
    pred = PL_predicate("$clear_source_admin", 1, "system");

  PL_put_atom(name, sf->name);
  rc = PL_call_predicate(MODULE_system, PL_Q_NORMAL, pred, name);

  PL_discard_foreign_frame(fid);

  return rc;
}

cairo_bool_t
plcairo_filter_to_term(cairo_filter_t filter,
                       term_t         t)
{
  term_t t0 = PL_new_term_ref();

  PLCAIRO_debug("    cairo_filter_t: %d  --->  term: 0x%lx", filter, t);

  if ( !ATOM_cairo_filter_fast )
  {
    ATOM_cairo_filter_fast = PL_new_atom("CAIRO_FILTER_FAST");
    ATOM_cairo_filter_good = PL_new_atom("CAIRO_FILTER_GOOD");
    ATOM_cairo_filter_best = PL_new_atom("CAIRO_FILTER_BEST");
    ATOM_cairo_filter_nearest = PL_new_atom("CAIRO_FILTER_NEAREST");
    ATOM_cairo_filter_bilinear = PL_new_atom("CAIRO_FILTER_BILINEAR");
    ATOM_cairo_filter_gaussian = PL_new_atom("CAIRO_FILTER_GAUSSIAN");
  }

  if ( filter == CAIRO_FILTER_FAST )
  { PL_put_atom(t0, ATOM_cairo_filter_fast);
  }
  else if ( filter == CAIRO_FILTER_GOOD )
  { PL_put_atom(t0, ATOM_cairo_filter_good);
  }
  else if ( filter == CAIRO_FILTER_BEST )
  { PL_put_atom(t0, ATOM_cairo_filter_best);
  }
  else if ( filter == CAIRO_FILTER_NEAREST )
  { PL_put_atom(t0, ATOM_cairo_filter_nearest);
  }
  else if ( filter == CAIRO_FILTER_BILINEAR )
  { PL_put_atom(t0, ATOM_cairo_filter_bilinear);
  }
  else if ( filter == CAIRO_FILTER_GAUSSIAN )
  { PL_put_atom(t0, ATOM_cairo_filter_gaussian);
  }
  else
  { g_assert_not_reached();
  }

  return PL_unify(t, t0);
}

cairo_bool_t
plcairo_pattern_type_to_term(cairo_pattern_type_t pattern_type,
                             term_t               t)
{
  term_t t0 = PL_new_term_ref();

  PLCAIRO_debug("    cairo_pattern_type_t: %d  --->  term: 0x%lx", pattern_type, t);

  if ( !ATOM_cairo_pattern_type_solid )
  {
    ATOM_cairo_pattern_type_solid = PL_new_atom("CAIRO_PATTERN_TYPE_SOLID");
    ATOM_cairo_pattern_type_surface = PL_new_atom("CAIRO_PATTERN_TYPE_SURFACE");
    ATOM_cairo_pattern_type_linear = PL_new_atom("CAIRO_PATTERN_TYPE_LINEAR");
    ATOM_cairo_pattern_type_radial = PL_new_atom("CAIRO_PATTERN_TYPE_RADIAL");
    ATOM_cairo_pattern_type_mesh = PL_new_atom("CAIRO_PATTERN_TYPE_MESH");
    ATOM_cairo_pattern_type_raster_source = PL_new_atom("CAIRO_PATTERN_TYPE_RASTER_SOURCE");
  }

  if ( pattern_type == CAIRO_PATTERN_TYPE_SOLID )
  { PL_put_atom(t0, ATOM_cairo_pattern_type_solid);
  }
  else if ( pattern_type == CAIRO_PATTERN_TYPE_SURFACE )
  { PL_put_atom(t0, ATOM_cairo_pattern_type_surface);
  }
  else if ( pattern_type == CAIRO_PATTERN_TYPE_LINEAR )
  { PL_put_atom(t0, ATOM_cairo_pattern_type_linear);
  }
  else if ( pattern_type == CAIRO_PATTERN_TYPE_RADIAL )
  { PL_put_atom(t0, ATOM_cairo_pattern_type_radial);
  }
  else if ( pattern_type == CAIRO_PATTERN_TYPE_MESH )
  { PL_put_atom(t0, ATOM_cairo_pattern_type_mesh);
  }
  else if ( pattern_type == CAIRO_PATTERN_TYPE_RASTER_SOURCE )
  { PL_put_atom(t0, ATOM_cairo_pattern_type_raster_source);
  }
  else
  { g_assert_not_reached();
  }

  return PL_unify(t, t0);
}