C++ (Cpp) Pl_Check_For_Un_List Examples

Example #1

File: term_inl_c.c Project: mnd/gprolog-cx

/*-------------------------------------------------------------------------*
 * PL_TERM_VARIABLES_3                                                     *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Term_Variables_3(WamWord start_word, WamWord list_word, WamWord tail_word)
{
  PlLong *p;

  /* only check if no Tail since if there is no vars in Term
   * then List = Tail and Tail can be any term */

  if (tail_word == NOT_A_WAM_WORD)
    Pl_Check_For_Un_List(list_word);

  var_ptr = pl_glob_dico_var;	/* pl_glob_dico_var: stores variables */

  Pl_Treat_Vars_Of_Term(start_word, TRUE, Collect_Variable);

  for(p = pl_glob_dico_var; p < var_ptr; p++)
    {
      if (!Pl_Get_List(list_word) || !Pl_Unify_Value(*p))
	return FALSE;
      list_word = Pl_Unify_Variable();
    }

  if (tail_word == NOT_A_WAM_WORD)
    return Pl_Get_Nil(list_word);

  return Pl_Unify(list_word, tail_word);
}

Example #2

File: fd_infos_c.c Project: adinho/Testing

/*-------------------------------------------------------------------------*
 * PL_FD_DOM_2                                                             *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool
Pl_Fd_Dom_2(WamWord fdv_word, WamWord list_word)
{
  WamWord word, tag_mask;
  WamWord *fdv_adr;
  int x, end;
  int vec_elem;

  Pl_Check_For_Un_List(list_word);

  Fd_Deref_Check_Fd_Var(fdv_word, word, tag_mask);
  if (tag_mask == TAG_INT_MASK)
    {
      x = UnTag_INT(word);

      if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(x))
	return FALSE;

      list_word = Pl_Unify_Variable();
    }
  else
    {
      fdv_adr = UnTag_FDV(word);
      if (Is_Interval(Range(fdv_adr)))
	{
	  end = Max(fdv_adr);
	  for (x = Min(fdv_adr); x <= end; x++)
	    {
	      if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(x))
		return FALSE;

	      list_word = Pl_Unify_Variable();
	    }
	}
      else
	{
	  VECTOR_BEGIN_ENUM(Vec(fdv_adr), vec_elem);

	  if (!Pl_Get_List(list_word) || !Pl_Unify_Integer(vec_elem))
	    return FALSE;

	  list_word = Pl_Unify_Variable();

	  VECTOR_END_ENUM;
	}
    }

  return Pl_Get_Nil(list_word);
}

Example #3

File: term_inl_c.c Project: adinho/Testing

/*-------------------------------------------------------------------------*
 * PL_BLT_UNIV                                                             *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Univ(WamWord term_word, WamWord list_word)
{
  WamWord word, tag_mask;
  WamWord *adr;
  WamWord car_word;
  int lst_length;
  WamWord *arg1_adr;
  WamWord *term_adr, *lst_adr, *stc_adr;
  WamWord functor_word, functor_tag;
  int functor;
  int arity;


  Pl_Set_C_Bip_Name("=..", 2);

  DEREF(term_word, word, tag_mask);

  if (tag_mask == TAG_REF_MASK)
    goto list_to_term;

				/* from term to list functor+args */

  if (tag_mask == TAG_LST_MASK)
    {
      adr = UnTag_LST(word);
      car_word = Tag_ATM(ATOM_CHAR('.'));
      lst_length = 1 + 2;
      arg1_adr = &Car(adr);
    }
  else if (tag_mask == TAG_STC_MASK)
    {
      adr = UnTag_STC(word);
      car_word = Tag_ATM(Functor(adr));
      lst_length = 1 + Arity(adr);
      arg1_adr = &Arg(adr, 0);
    }
#ifndef NO_USE_FD_SOLVER
  else if (tag_mask == TAG_FDV_MASK)
    {
      adr = UnTag_FDV(word);
      car_word = Tag_REF(adr);	/* since Dont_Separate_Tag */
      lst_length = 1 + 0;
    } 
#endif
  else				/* TAG_ATM/INT/FLT_MASK */
    {
      car_word = word;
      lst_length = 1 + 0;
    }

  Pl_Check_For_Un_List(list_word);

  Pl_Unset_C_Bip_Name();

  for (;;)
    {
      if (!Pl_Get_List(list_word) || !Pl_Unify_Value(car_word))
	return FALSE;

      list_word = Pl_Unify_Variable();

      if (--lst_length == 0)
	break;

      car_word = *arg1_adr++;
    }

  return Pl_Get_Nil(list_word);

  /* from list functor+args to term */

list_to_term:

  term_adr = UnTag_REF(word);

  DEREF(list_word, word, tag_mask);
  if (tag_mask == TAG_REF_MASK)
    Pl_Err_Instantiation();

  if (word == NIL_WORD)
    Pl_Err_Domain(pl_domain_non_empty_list, list_word);

  if (tag_mask != TAG_LST_MASK)
    Pl_Err_Type(pl_type_list, list_word);

  lst_adr = UnTag_LST(word);
  DEREF(Car(lst_adr), functor_word, functor_tag);
  if (functor_tag == TAG_REF_MASK)
    Pl_Err_Instantiation();

  DEREF(Cdr(lst_adr), word, tag_mask);

  if (word == NIL_WORD)
    {
      if (functor_tag != TAG_ATM_MASK && functor_tag != TAG_INT_MASK &&
	  functor_tag != TAG_FLT_MASK)
	Pl_Err_Type(pl_type_atomic, functor_word);

      term_word = functor_word;
      goto finish;
    }

  if (functor_tag != TAG_ATM_MASK)
    Pl_Err_Type(pl_type_atom, functor_word);

  if (tag_mask == TAG_REF_MASK)
    Pl_Err_Instantiation();

  if (tag_mask != TAG_LST_MASK)
    Pl_Err_Type(pl_type_list, list_word);

  functor = UnTag_ATM(functor_word);

  stc_adr = H;

  H++;				/* space for f/n maybe lost if a list */
  arity = 0;

  for (;;)
    {
      arity++;
      lst_adr = UnTag_LST(word);
      DEREF(Car(lst_adr), word, tag_mask);
      Do_Copy_Of_Word(tag_mask, word); /* since Dont_Separate_Tag */
      Global_Push(word);

      DEREF(Cdr(lst_adr), word, tag_mask);
      if (word == NIL_WORD)
	break;

      if (tag_mask == TAG_REF_MASK)
	Pl_Err_Instantiation();

      if (tag_mask != TAG_LST_MASK)
	Pl_Err_Type(pl_type_list, list_word);
    }

  if (arity > MAX_ARITY)
    Pl_Err_Representation(pl_representation_max_arity);

  if (functor == ATOM_CHAR('.') && arity == 2)	/* a list */
    term_word = Tag_LST(stc_adr + 1);
  else
    {
      *stc_adr = Functor_Arity(functor, arity);
      term_word = Tag_STC(stc_adr);
    }

finish:
  Bind_UV(term_adr, term_word);
  Pl_Unset_C_Bip_Name();
  return TRUE;
}