예제 #1
0
파일: term_inl_c.c 프로젝트: mnd/gprolog-cx
/*-------------------------------------------------------------------------*
 * PL_BLT_COMPARE                                                          *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Compare(WamWord cmp_word, WamWord x, WamWord y)
{
  int cmp;
  char c;
  Bool res;

  Pl_Set_C_Bip_Name("compare", 3);

  cmp = Pl_Term_Compare(x, y);
  c = (cmp < 0) ? '<' : (cmp == 0) ? '=' : '>';

  res = Pl_Un_Atom_Check(ATOM_CHAR(c), cmp_word);
  if (!res)			/* check if it is one of < = > */
    {
      WamWord word, tag_mask;
      char *s;

      DEREF(cmp_word, word, tag_mask); /* we know it is an atom */
      s = pl_atom_tbl[UnTag_ATM(word)].name;
      if ((s[0] != '<' && s[0] != '=' && s[0] != '>') || s[1] != '\0')
	Pl_Err_Domain(pl_domain_order, cmp_word);
    }

  Pl_Unset_C_Bip_Name();

  return res;
}
예제 #2
0
파일: term_inl_c.c 프로젝트: adinho/Testing
/*-------------------------------------------------------------------------*
 * PL_BLT_COMPARE                                                          *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Compare(WamWord cmp_word, WamWord x, WamWord y)
{
  int cmp;
  char c;
  Bool res;

  Pl_Set_C_Bip_Name("compare", 3);

  cmp = Pl_Term_Compare(x, y);
  c = (cmp < 0) ? '<' : (cmp == 0) ? '=' : '>';

  res = Pl_Un_Atom_Check(ATOM_CHAR(c), cmp_word);

  Pl_Unset_C_Bip_Name();

  return res;
}
예제 #3
0
/*-------------------------------------------------------------------------*
 * GROUP                                                                   *
 *                                                                         *
 *-------------------------------------------------------------------------*/
static WamWord
Group(WamWord all_sol_word, WamWord gl_key_word, WamWord *key_adr)
{
  WamWord word, tag_mask;
  WamWord *adr;
  WamWord *lst_adr, *prev_lst_adr;
  WamWord key_word, key_word1;

  DEREF(all_sol_word, word, tag_mask);

  lst_adr = UnTag_LST(word);
  DEREF(Car(lst_adr), word, tag_mask);	/* term of the form Key-Value */
  adr = UnTag_STC(word);
  *key_adr = key_word = Arg(adr, 0);

  for (;;)
    {				/* Arg(adr,1) cannot be a Dont_Separate_Tag */
      Car(lst_adr) = Arg(adr, 1);

      prev_lst_adr = lst_adr;
      DEREF(Cdr(lst_adr), word, tag_mask);
      if (word == NIL_WORD)
	return NOT_A_WAM_WORD;

      prev_lst_adr = lst_adr;
      lst_adr = UnTag_LST(word);
      DEREF(Car(lst_adr), word, tag_mask); /* term of the form Key-Value */
      adr = UnTag_STC(word);
      key_word1 = Arg(adr, 0);

      if (Pl_Term_Compare(key_word, key_word1) != 0)
	break;
    }

  all_sol_word = Cdr(prev_lst_adr);
  Cdr(prev_lst_adr) = NIL_WORD;

  return all_sol_word;
}
예제 #4
0
파일: term_inl_c.c 프로젝트: adinho/Testing
/*-------------------------------------------------------------------------*
 * PL_BLT_TERM_LTE                                                         *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Term_Lte(WamWord x, WamWord y)
{
  return Pl_Term_Compare(x, y) <= 0;
}
예제 #5
0
파일: term_inl_c.c 프로젝트: adinho/Testing
/*-------------------------------------------------------------------------*
 * PL_BLT_TERM_NEQ                                                         *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Term_Neq(WamWord x, WamWord y)
{
  return Pl_Term_Compare(x, y) != 0;
}
예제 #6
0
파일: term_inl_c.c 프로젝트: adinho/Testing
/*-------------------------------------------------------------------------*
 * PL_BLT_TERM_GT                                                          *
 *                                                                         *
 *-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Term_Gt(WamWord x, WamWord y)
{
  return Pl_Term_Compare(x, y) > 0;
}
예제 #7
0
파일: term_supp.c 프로젝트: adinho/Testing
/*-------------------------------------------------------------------------*
 * PL_TERM_COMPARE                                                         *
 *                                                                         *
 *-------------------------------------------------------------------------*/
long
Pl_Term_Compare(WamWord start_u_word, WamWord start_v_word)
{
    WamWord u_word, u_tag_mask;
    WamWord v_word, v_tag_mask;
    WamWord u_tag, v_tag;
    int u_func, u_arity;
    WamWord *u_arg_adr;
    int v_func, v_arity;
    WamWord *v_arg_adr;
    int i, x;
    double d1, d2;

    DEREF(start_u_word, u_word, u_tag_mask);
    DEREF(start_v_word, v_word, v_tag_mask);

    u_tag = Tag_From_Tag_Mask(u_tag_mask);
    v_tag = Tag_From_Tag_Mask(v_tag_mask);

    switch (u_tag)
    {
    case REF:
        return (v_tag != REF) ? -1 :  UnTag_REF(u_word) - UnTag_REF(v_word);

#ifndef NO_USE_FD_SOLVER
    case FDV:
        if (v_tag == REF)
            return 1;

        return (v_tag != FDV) ? -1 : UnTag_FDV(u_word) - UnTag_FDV(v_word);
#endif

    case FLT:
        if (v_tag == REF
#ifndef NO_USE_FD_SOLVER
                || v_tag == FDV
#endif
           )
            return 1;

        if (v_tag != FLT)
            return -1;

        d1 = Pl_Obtain_Float(UnTag_FLT(u_word));
        d2 = Pl_Obtain_Float(UnTag_FLT(v_word));
        return (d1 < d2) ? -1 : (d1 == d2) ? 0 : 1;


    case INT:
        if (v_tag == REF ||
#ifndef NO_USE_FD_SOLVER
                v_tag == FDV ||
#endif
                v_tag == FLT)
            return 1;

        return (v_tag != INT) ? -1 : UnTag_INT(u_word) - UnTag_INT(v_word);

    case ATM:
        if (v_tag == REF ||
#ifndef NO_USE_FD_SOLVER
                v_tag == FDV ||
#endif
                v_tag == FLT || v_tag == INT)
            return 1;

        return (v_tag != ATM) ? -1 : strcmp(pl_atom_tbl[UnTag_ATM(u_word)].name,
                                            pl_atom_tbl[UnTag_ATM(v_word)].name);
    }

    /* u_tag == LST / STC */

    v_arg_adr = Pl_Rd_Compound(v_word, &v_func, &v_arity);
    if (v_arg_adr == NULL)	/* v_tag != LST / STC */
        return 1;

    u_arg_adr = Pl_Rd_Compound(u_word, &u_func, &u_arity);

    if (u_arity != v_arity)
        return u_arity - v_arity;

    if (u_func != v_func)
        return strcmp(pl_atom_tbl[u_func].name, pl_atom_tbl[v_func].name);

    for (i = 0; i < u_arity; i++)
        if ((x = Pl_Term_Compare(*u_arg_adr++, *v_arg_adr++)) != 0)
            return x;

    return 0;
}