C++ (Cpp) PL_strip_module Examples

Example #1

File: pcecall.c Project: edechter/packages-xpce

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

Example #2

File: pl-dwim.c Project: AaronZhangL/swipl-devel

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

Example #3

File: time.c Project: lamby/pkg-swi-prolog

static foreign_t
alarm4_gen(time_abs_rel abs_rel, term_t time, term_t callable,
	   term_t id, term_t options)
{ Event ev;
  double t;
  module_t m = NULL;
  unsigned long flags = 0L;

  if ( options )
  { term_t tail = PL_copy_term_ref(options);
    term_t head = PL_new_term_ref();

    while( PL_get_list(tail, head, tail) )
    { atom_t name;
      int arity;

      if ( PL_get_name_arity(head, &name, &arity) )
      { if ( arity == 1 )
	{ term_t arg = PL_new_term_ref();

	  _PL_get_arg(1, head, arg);

	  if ( name == ATOM_remove )
	  { int t = FALSE;

	    if ( !pl_get_bool_ex(arg, &t) )
	      return FALSE;
	    if ( t )
	      flags |= EV_REMOVE;
	  } else if ( name == ATOM_install )
	  { int t = TRUE;

	    if ( !pl_get_bool_ex(arg, &t) )
	      return FALSE;
	    if ( !t )
	      flags |= EV_NOINSTALL;
	  }
	}
      }
    }
    if ( !PL_get_nil(tail) )
      return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 4, options, "list");
  }

  if ( !PL_get_float(time, &t) )
    return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1,
		    time, "number");


  if ( !(ev = allocEvent()) )
    return FALSE;

  if (abs_rel==TIME_REL)
	  setTimeEvent(ev, t);
  else
	  setTimeEventAbs(ev,t);

  if ( !unify_timer(id, ev) )
  { freeEvent(ev);			/* not linked: no need to lock */
    return FALSE;
  }

  ev->flags = flags;
  PL_strip_module(callable, &m, callable);
  ev->module = m;
  ev->goal = PL_record(callable);

  if ( !(ev->flags & EV_NOINSTALL) )
  { int rc;

    if ( (rc=installEvent(ev)) != TRUE )
    { freeEvent(ev);			/* not linked: no need to lock */
      return alarm_error(id, rc);
    }
  }

  return TRUE;
}