示例#1
0
/*-------------------------------------------------------------------------*
 * PL_BETWEEN_3                                                            *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Between_3(WamWord l_word, WamWord u_word, WamWord i_word)
{
  WamWord word, tag_mask;
  PlLong l, u, i;

  l = Pl_Rd_Integer_Check(l_word);
  u = Pl_Rd_Integer_Check(u_word);

  DEREF(i_word, word, tag_mask);
  if (tag_mask != TAG_REF_MASK)
    {
      i = Pl_Rd_Integer_Check(word);
      return i >= l && i <= u;
    }
  i_word = word;

  if (l > u)
    return FALSE;
				/* here i_word is a variable */
  if (l < u)			/* non deterministic case */
    {
      A(0) = l + 1;
      A(1) = u;
      A(2) = i_word;
      Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(BETWEEN_ALT, 0), 3);
    }

  return Pl_Get_Integer(l, i_word); /* always TRUE */
}
示例#2
0
/*-------------------------------------------------------------------------*
 * PL_CURRENT_STREAM_1                                                     *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Current_Stream_1(WamWord stm_word)
{
  WamWord word, tag_mask;
  int stm = 0;


  DEREF(stm_word, word, tag_mask);	/* either an INT or a REF */
  if (tag_mask == TAG_INT_MASK)
    {
      stm = UnTag_INT(word);
      return (stm >= 0 && stm <= pl_stm_last_used && pl_stm_tbl[stm] != NULL);
    }

  for (; stm <= pl_stm_last_used; stm++)
    if (pl_stm_tbl[stm])
      break;

  if (stm >= pl_stm_last_used)
    {
      if (stm > pl_stm_last_used)
	return FALSE;
    }
  else				/* non deterministic case */
    {
      A(0) = stm_word;
      A(1) = stm + 1;
      Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_STREAM_ALT, 0),
			  2);
    }

  return Pl_Get_Integer(stm, stm_word);
}
示例#3
0
/*-------------------------------------------------------------------------*
 * PL_CURRENT_ATOM_2                                                       *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Current_Atom_2(WamWord atom_word, WamWord hide_word)
{
  WamWord word, tag_mask;
  Bool hide;
  int atom;

  hide = Pl_Rd_Integer_Check(hide_word);

  DEREF(atom_word, word, tag_mask);
  if (tag_mask != TAG_REF_MASK)
    return *Pl_Rd_String_Check(word) != '$' || !hide;

  atom = -1;
  for (;;)
    {
      atom = Pl_Find_Next_Atom(atom);
      if (atom == -1)
	return FALSE;

      if (!hide || pl_atom_tbl[atom].name[0] != '$')
	break;
    }
				/* non deterministic case */
  A(0) = atom_word;
  A(1) = hide;
  A(2) = atom;
  Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ATOM_ALT, 0), 3);

  return Pl_Get_Atom(atom, atom_word);
}
示例#4
0
/*-------------------------------------------------------------------------*
 * PL_QUERY_BEGIN                                                          *
 *                                                                         *
 *-------------------------------------------------------------------------*/
void
Pl_Query_Begin(Bool recoverable)

{
  if (query_stack_top - query_stack >= QUERY_STACK_SIZE)
    Pl_Fatal_Error("too many nested Pl_Query_Start() (max: %d)",
		QUERY_STACK_SIZE);

  if (recoverable)
    Pl_Create_Choice_Point(Prolog_Predicate(PL_QUERY_RECOVER_ALT, 0), 0);
}
示例#5
0
文件: engine.c 项目: adinho/Testing
/*-------------------------------------------------------------------------*
 * PL_RESET_PROLOG                                                         *
 *                                                                         *
 * Reset top stack pointers and create first choice point (for Call_Prolog)*
 *-------------------------------------------------------------------------*/
void
Pl_Reset_Prolog(void)
{
  E = B = LSSA = Local_Stack;
  H = heap_actual_start;	/* restart after needed global terms */
  TR = Trail_Stack;
  CP = NULL;
  STAMP = 0;
  CS = Cstr_Stack;
  BCI = 0;			/* BCI only needed for byte-code (cf. bips prolog) */

  Pl_Create_Choice_Point(Call_Prolog_Fail, 0);	/* 1st choice point */

  Pl_Fd_Reset_Solver();
}
示例#6
0
/*-------------------------------------------------------------------------*
 * PL_CURRENT_ALIAS_2                                                      *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Current_Alias_2(WamWord stm_word, WamWord alias_word)
{
  WamWord word, tag_mask;
  int stm;
  HashScan scan;
  AliasInf *alias;
  AliasInf *save_alias;

  stm = Pl_Rd_Integer_Check(stm_word);	/* stm is a valid stream entry */

  DEREF(alias_word, word, tag_mask);
  if (tag_mask != TAG_REF_MASK)
    return Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(word)) == stm;

  for (alias = (AliasInf *) Pl_Hash_First(pl_alias_tbl, &scan); alias;
       alias = (AliasInf *) Pl_Hash_Next(&scan))
    if (alias->stm == stm)
      break;

  if (alias == NULL)
    return FALSE;

  save_alias = alias;

  for (;;)
    {
      alias = (AliasInf *) Pl_Hash_Next(&scan);
      if (alias == NULL || alias->stm == stm)
	break;
    }


  if (alias)			/* non deterministic case */
    {
      A(0) = stm;
      A(1) = alias_word;
      A(2) = (WamWord) scan.endt;
      A(3) = (WamWord) scan.cur_t;
      A(4) = (WamWord) scan.cur_p;
      A(5) = (WamWord) alias;
      Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ALIAS_ALT, 0),
			  6);
    }

  Pl_Get_Atom(save_alias->atom, alias_word);
  return TRUE;
}
示例#7
0
/*-------------------------------------------------------------------------*
 * PL_CURRENT_MIRROR_2                                                     *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Current_Mirror_2(WamWord stm_word, WamWord m_stm_word)
{
  int stm = Pl_Rd_Integer_Check(stm_word);	/* stm is a valid stream entry */
  StmInf *pstm = pl_stm_tbl[stm];
  StmLst *m = pstm->mirror;

				/* From here, the code also works with     */
				/* m = m_pstm->mirror_of. Could be used    */
				/* if m_stm_word is given and not stm_word */
  if (m == NULL)
    return FALSE;

  if (m->next != NULL) /* non deterministic case */
    {
      A(0) = stm;		/* useless in fact */
      A(1) = m_stm_word;
      A(2) = (WamWord) m->next;
      Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_MIRROR_ALT, 0), 3);
    }

  return Pl_Get_Integer(m->stm, m_stm_word);
}
示例#8
0
/*-------------------------------------------------------------------------*
 * PL_GROUP_SOLUTIONS_3                                                    *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Group_Solutions_3(WamWord all_sol_word, WamWord gl_key_word,
		     WamWord sol_word)
{
  WamWord word, tag_mask;
  WamWord key_word;

  DEREF(all_sol_word, word, tag_mask);
  if (word == NIL_WORD)
    return FALSE;

  word = Group(all_sol_word, gl_key_word, &key_word);
  if (word != NOT_A_WAM_WORD)
    {
      A(0) = word;
      A(1) = gl_key_word;
      A(2) = sol_word;
      Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(GROUP_SOLUTIONS_ALT, 0), 3);
    }

  Pl_Unify(key_word, gl_key_word);
  return Pl_Unify(sol_word, all_sol_word);
}
示例#9
0
/*-------------------------------------------------------------------------*
 * PL_SUB_ATOM_5                                                           *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Sub_Atom_5(WamWord atom_word, WamWord before_word, WamWord length_word,
	   WamWord after_word, WamWord sub_atom_word)
{
  WamWord word, tag_mask;
  AtomInf *patom;
  AtomInf *psub_atom = NULL;	/* only for the compiler */
  int length;
  PlLong b, l, a;
  int b1, l1, a1;
  Bool nondet;
  int mask = 0;
  char *str;

  patom = pl_atom_tbl + Pl_Rd_Atom_Check(atom_word);
  length = patom->prop.length;


  DEREF_LG(before_word, b);
  DEREF_LG(length_word, l);
  DEREF_LG(after_word, a);


  DEREF(sub_atom_word, word, tag_mask);
  if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK)
    Pl_Err_Type(pl_type_atom, word);
  sub_atom_word = word;
  if (tag_mask == TAG_ATM_MASK)
    {
      psub_atom = pl_atom_tbl + UnTag_ATM(word);
      l = psub_atom->prop.length;
      if (!Pl_Get_Integer(l, length_word))
	return FALSE;

      if ((mask & 5) == 5 && length != b + l + a) /* B and A fixed */
	return FALSE;

      if (mask & 4)		/* B fixed */
	{
	  a = length - b - l;
	  return strncmp(patom->name + b, psub_atom->name, l) == 0 &&
	    Pl_Get_Integer(a, after_word);
	}

      if (mask & 1)		/* A fixed */
	{
	  b = length - l - a;
	  return strncmp(patom->name + b, psub_atom->name, l) == 0 &&
	    Pl_Get_Integer(b, before_word);
	}
      mask = 8;			/* set sub_atom as fixed */
    }


  switch (mask)			/* mask <= 7, B L A (1: fixed, 0: var) */
    {
    case 0:			/* nothing fixed */
    case 2:			/* L fixed */
    case 4:			/* B fixed */
      a = length - b - l;
      nondet = TRUE;
      break;

    case 1:			/* A fixed */
      l = length - b - a;
      nondet = TRUE;
      break;

    case 3:			/* L A fixed */
      b = length - l - a;
      nondet = FALSE;
      break;

    case 5:			/* B A fixed */
      l = length - b - a;
      nondet = FALSE;
      break;

    case 6:			/* B L fixed */
    case 7:			/* B L A fixed */
      a = length - b - l;
      nondet = FALSE;
      break;

    default:			/* sub_atom fixed */
      if ((str = strstr(patom->name + b, psub_atom->name)) == NULL)
	return FALSE;

      b = str - patom->name;
      a = length - b - l;
      nondet = TRUE;
      break;
    }

  if (b < 0 || l < 0 || a < 0)
    return FALSE;

  if (nondet
      && Compute_Next_BLA(mask, patom, psub_atom, b, l, a, &b1, &l1, &a1))
    {				/* non deterministic case */
      A(0) = before_word;
      A(1) = length_word;
      A(2) = after_word;
      A(3) = sub_atom_word;
      A(4) = (WamWord) patom;
      A(5) = (WamWord) psub_atom;
      A(6) = mask;
      A(7) = b1;
      A(8) = l1;
      A(9) = a1;

      Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(SUB_ATOM_ALT, 0), 10);
    }

  if (mask <= 7)
    {
      MALLOC_STR(l);
      strncpy(str, patom->name + b, l);
      str[l] = '\0';
      Pl_Get_Atom(Create_Malloc_Atom(str), sub_atom_word);
      Pl_Get_Integer(l, length_word);
    }

  return Pl_Get_Integer(b, before_word) && Pl_Get_Integer(a, after_word);
}
示例#10
0
/*-------------------------------------------------------------------------*
 * PL_ATOM_CONCAT_3                                                        *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Atom_Concat_3(WamWord atom1_word, WamWord atom2_word, WamWord atom3_word)
{
  WamWord word, tag_mask;
  int tag1, tag2, tag3;
  AtomInf *patom1, *patom2, *patom3;
  char *str;
  int l;


  DEREF(atom1_word, word, tag_mask);
  if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK)
    Pl_Err_Type(pl_type_atom, atom1_word);
  tag1 = tag_mask;
  atom1_word = word;


  DEREF(atom2_word, word, tag_mask);
  if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK)
    Pl_Err_Type(pl_type_atom, atom2_word);
  tag2 = tag_mask;
  atom2_word = word;


  DEREF(atom3_word, word, tag_mask);
  if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK)
    Pl_Err_Type(pl_type_atom, atom3_word);
  tag3 = tag_mask;
  atom3_word = word;


  if (tag3 == TAG_REF_MASK && (tag1 == TAG_REF_MASK || tag2 == TAG_REF_MASK))
    Pl_Err_Instantiation();


  if (tag1 == TAG_ATM_MASK)
    {
      patom1 = pl_atom_tbl + UnTag_ATM(atom1_word);

      if (tag2 == TAG_ATM_MASK)
	{
	  patom2 = pl_atom_tbl + UnTag_ATM(atom2_word);
	  l = patom1->prop.length + patom2->prop.length;
	  MALLOC_STR(l);
	  strcpy(str, patom1->name);
	  strcpy(str + patom1->prop.length, patom2->name);
	  return Pl_Get_Atom(Create_Malloc_Atom(str), atom3_word);
	}

      patom3 = pl_atom_tbl + UnTag_ATM(atom3_word);
      l = patom3->prop.length - patom1->prop.length;
      if (l < 0 || strncmp(patom1->name, patom3->name, patom1->prop.length) != 0)
	return FALSE;
      MALLOC_STR(l);
      strcpy(str, patom3->name + patom1->prop.length);

      return Pl_Get_Atom(Create_Malloc_Atom(str), atom2_word);
    }

  if (tag2 == TAG_ATM_MASK)	/* here tag1 == REF */
    {
      patom2 = pl_atom_tbl + UnTag_ATM(atom2_word);
      patom3 = pl_atom_tbl + UnTag_ATM(atom3_word);
      l = patom3->prop.length - patom2->prop.length;
      if (l < 0 || strncmp(patom2->name, patom3->name + l, patom2->prop.length) != 0)
	return FALSE;

      MALLOC_STR(l);
      strncpy(str, patom3->name, l);
      str[l] = '\0';

      return Pl_Get_Atom(Create_Malloc_Atom(str), atom1_word);
    }

  /* A1 and A2 are variables: non deterministic case */

  patom3 = pl_atom_tbl + UnTag_ATM(atom3_word);

  if (patom3->prop.length > 0)
    {
      A(0) = atom1_word;
      A(1) = atom2_word;
      A(2) = (WamWord) patom3;
      A(3) = (WamWord) (patom3->name + 1);
      Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(ATOM_CONCAT_ALT, 0), 4);
    }

  return Pl_Get_Atom(pl_atom_void, atom1_word) &&
    Pl_Get_Atom_Tagged(atom3_word, atom2_word);
}
示例#11
0
/*-------------------------------------------------------------------------*
 * PL_FOREIGN_CREATE_CHOICE                                                *
 *                                                                         *
 *-------------------------------------------------------------------------*/
void
Pl_Foreign_Create_Choice(CodePtr codep_alt, int arity, int choice_size)
{
  A(arity) = -1;		/* bkt_counter */
  Pl_Create_Choice_Point(codep_alt, arity + 1 + choice_size);
}
示例#12
0
文件: pred_c.c 项目: adinho/Testing
/*-------------------------------------------------------------------------*
 * PL_CURRENT_PREDICATE_2                                                  *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Current_Predicate_2(WamWord pred_indic_word, WamWord which_preds_word)
{
  WamWord name_word, arity_word;
  HashScan scan;
  PredInf *pred;
  int func, arity;
  int func1, arity1;
  int which_preds;		/* 0=user, 1=user+bips, 2=user+bips+system */
  Bool all;

  func = Pl_Get_Pred_Indicator(pred_indic_word, FALSE, &arity);
  name_word = pl_pi_name_word;
  arity_word = pl_pi_arity_word;

  which_preds = Pl_Rd_Integer(which_preds_word);

  if (which_preds == 0 && !Flag_Value(FLAG_STRICT_ISO))
    which_preds = 1;

#define Pred_Is_Ok(pred, func, which_preds) \
  (which_preds == 2 || (pl_atom_tbl[func].name[0] != '$' && \
   (which_preds == 1 || !(pred->prop & MASK_PRED_ANY_BUILTIN))))

  if (func >= 0 && arity >= 0)
    {
      pred = Pl_Lookup_Pred(func, arity);
      return pred && Pred_Is_Ok(pred, func, which_preds);
    }

				/* here func or arity == -1 (or both) */
  all = (func == -1 && arity == -1);

  pred = (PredInf *) Pl_Hash_First(pl_pred_tbl, &scan);
  for (;;)
    {
      if (pred == NULL)
	return FALSE;

      func1 = Functor_Of(pred->f_n);
      arity1 = Arity_Of(pred->f_n);

      if ((all || func == func1 || arity == arity1) &&
	  Pred_Is_Ok(pred, func1, which_preds))
	break;

      pred = (PredInf *) Pl_Hash_Next(&scan);
    }

				/* non deterministic case */
  A(0) = name_word;
  A(1) = arity_word;
  A(2) = which_preds;
  A(3) = (WamWord) scan.endt;
  A(4) = (WamWord) scan.cur_t;
  A(5) = (WamWord) scan.cur_p;
  Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_PREDICATE_ALT, 0),
		      6);
  return Pl_Get_Atom(Functor_Of(pred->f_n), name_word) &&
    Pl_Get_Integer(Arity_Of(pred->f_n), arity_word);
  /*
  return Pl_Un_Atom_Check(Functor_Of(pred->f_n), name_word) &&
    Pl_Un_Integer_Check(Arity_Of(pred->f_n), arity_word);
  */
}