Beispiel #1
0
static inline Functor
FuncAdjust(Functor f)
{
  if (!IsExtensionFunctor(f)) {  
    AtomEntry *ae = RepAtom(NameOfFunctor(f));
    MarkAtomEntry(ae);
  }
  return(f);
}
Beispiel #2
0
YAP_tag_t YAPTerm::tag() {
  Term tt = gt();
  if (IsVarTerm(tt)) {
    CELL *pt = VarOfTerm(tt);
    if (IsUnboundVar(pt)) {
      CACHE_REGS
      if (IsAttVar(pt))
        return YAP_TAG_ATT;
      return YAP_TAG_UNBOUND;
    }
    return YAP_TAG_REF;
  }
  if (IsPairTerm(tt))
    return YAP_TAG_PAIR;
  if (IsAtomOrIntTerm(tt)) {
    if (IsAtomTerm(tt))
      return YAP_TAG_ATOM;
    return YAP_TAG_INT;
  } else {
    Functor f = FunctorOfTerm(tt);

    if (IsExtensionFunctor(f)) {
      if (f == FunctorDBRef) {
        return YAP_TAG_DBREF;
      }
      if (f == FunctorLongInt) {
        return YAP_TAG_LONG_INT;
      }
      if (f == FunctorBigInt) {
        big_blob_type bt = (big_blob_type)RepAppl(tt)[1];
        switch (bt) {
        case BIG_INT:
          return YAP_TAG_BIG_INT;
        case BIG_RATIONAL:
          return YAP_TAG_RATIONAL;
        default:
          return YAP_TAG_OPAQUE;
        }
      }
    }
    return YAP_TAG_APPL;
  }
}
Beispiel #3
0
static inline int
rational_tree(Term d0) {
CACHE_REGS
  CELL  **to_visit_max = (CELL **)AuxBase, **to_visit  = (CELL **)AuxSp;

  if (IsPairTerm(d0)) {
    CELL *pt0 = RepPair(d0);

    return Yap_rational_tree_loop(pt0-1, pt0+1, to_visit, to_visit_max);
  } else if (IsApplTerm(d0)) {
    CELL *pt0 = RepAppl(d0);
    Functor f = (Functor)(*pt0);

    if (IsExtensionFunctor(f))
      return FALSE;
    return Yap_rational_tree_loop(pt0, pt0+ArityOfFunctor(f), to_visit, to_visit_max);
  } else
    return FALSE;
}
Beispiel #4
0
YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) {
  Term t0 = t;
  ap = nullptr;
restart:
  if (IsVarTerm(t)) {
    throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
  } else if (IsAtomTerm(t)) {
    ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
    ts = nullptr;
  } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
    ts = nullptr;
    ap = Yap_FindLUIntKey(IntegerOfTerm(t));
  } else if (IsPairTerm(t)) {
    t = Yap_MkApplTerm(FunctorCsult, 1, &t);
    goto restart;
  } else if (IsApplTerm(t)) {
    Functor fun = FunctorOfTerm(t);
    if (IsExtensionFunctor(fun)) {
      throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE,
                     Yap_TermToIndicator(t, tmod), pname);
    }
    if (fun == FunctorModule) {
      tmod = ArgOfTerm(1, t);
      if (IsVarTerm(tmod)) {
        throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
      }
      if (!IsAtomTerm(tmod)) {
        throw YAPError(SOURCE(), TYPE_ERROR_ATOM, t0, pname);
      }
      t = ArgOfTerm(2, t);
      goto restart;
    }
    ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
    ts = RepAppl(t) + 1;
  } else {
    throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, t0, pname);
  }
}
Beispiel #5
0
inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2	 */
{

  if (t1 == t2)
    return 0;
  if (IsVarTerm(t1)) {
    if (IsVarTerm(t2))
      return Signed(t1) - Signed(t2);
    return -1;
  } else if (IsVarTerm(t2)) {
    /* get rid of variables */
    return 1;
  }
  if (IsAtomOrIntTerm(t1)) {
    if (IsAtomTerm(t1)) {
      if (IsAtomTerm(t2))
        return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2));
      if (IsPrimitiveTerm(t2))
        return 1;
      if (IsStringTerm(t2))
        return 1;
      return -1;
    } else {
      if (IsIntTerm(t2)) {
        return IntOfTerm(t1) - IntOfTerm(t2);
      }
      if (IsApplTerm(t2)) {
        Functor fun2 = FunctorOfTerm(t2);
        switch ((CELL)fun2) {
        case double_e:
          return 1;
        case long_int_e:
          return IntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
        case big_int_e:
          return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
#endif
        case db_ref_e:
          return 1;
        case string_e:
          return -1;
        }
      }
      return -1;
    }
  } else if (IsPairTerm(t1)) {
    if (IsApplTerm(t2)) {
      Functor f = FunctorOfTerm(t2);
      if (IsExtensionFunctor(f))
        return 1;
      else {
        if (f != FunctorDot)
          return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE);
        else {
          return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2));
        }
      }
    }
    if (IsPairTerm(t2)) {
      return (
          compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1));
    } else
      return 1;
  } else {
    /* compound term */
    Functor fun1 = FunctorOfTerm(t1);

    if (IsExtensionFunctor(fun1)) {
      /* float, long, big, dbref */
      switch ((CELL)fun1) {
      case double_e: {
        if (IsFloatTerm(t2))
          return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
        if (IsRefTerm(t2))
          return 1;
        return -1;
      }
      case long_int_e: {
        if (IsIntTerm(t2))
          return LongIntOfTerm(t1) - IntOfTerm(t2);
        if (IsFloatTerm(t2)) {
          return 1;
        }
        if (IsLongIntTerm(t2))
          return LongIntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
        if (IsBigIntTerm(t2)) {
          return Yap_gmp_tcmp_int_big(LongIntOfTerm(t1), t2);
        }
#endif
        if (IsRefTerm(t2))
          return 1;
        return -1;
      }
#ifdef USE_GMP
      case big_int_e: {
        if (IsIntTerm(t2))
          return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2));
        if (IsFloatTerm(t2)) {
          return 1;
        }
        if (IsLongIntTerm(t2))
          return Yap_gmp_tcmp_big_int(t1, LongIntOfTerm(t2));
        if (IsBigIntTerm(t2)) {
          return Yap_gmp_tcmp_big_big(t1, t2);
        }
        if (IsRefTerm(t2))
          return 1;
        return -1;
      }
#endif
      case string_e: {
        if (IsApplTerm(t2)) {
          Functor fun2 = FunctorOfTerm(t2);
          switch ((CELL)fun2) {
          case double_e:
            return 1;
          case long_int_e:
            return 1;
#ifdef USE_GMP
          case big_int_e:
            return 1;
#endif
          case db_ref_e:
            return 1;
          case string_e:
            return strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2));
          }
          return -1;
        }
        return -1;
      }
      case db_ref_e:
        if (IsRefTerm(t2))
          return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1));
        return -1;
      }
    }
    if (!IsApplTerm(t2)) {
      if (IsPairTerm(t2)) {
        Int out;
        Functor f = FunctorOfTerm(t1);

        if (!(out = ArityOfFunctor(f)) - 2)
          out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE, ".");
        return out;
      }
      return 1;
    } else {
      Functor fun2 = FunctorOfTerm(t2);
      Int r;

      if (IsExtensionFunctor(fun2)) {
        return 1;
      }
      r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
      if (r)
        return r;
      r = cmp_atoms(NameOfFunctor(fun1), NameOfFunctor(fun2));
      if (r)
        return r;
      else
        return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1),
                                RepAppl(t2)));
    }
  }
}
Beispiel #6
0
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
                           register CELL *pt1) {
  CACHE_REGS
  register CELL **to_visit = (CELL **)HR;
  register Int out = 0;

loop:
  while (pt0 < pt0_end) {
    register CELL d0, d1;
    ++pt0;
    ++pt1;
    d0 = Derefa(pt0);
    d1 = Derefa(pt1);
    if (IsVarTerm(d0)) {
      if (IsVarTerm(d1)) {
        out = Signed(d0) - Signed(d1);
        if (out)
          goto done;
      } else {
        out = -1;
        goto done;
      }
    } else if (IsVarTerm(d1)) {
      out = 1;
      goto done;
    } else {
      if (d0 == d1)
        continue;
      else if (IsAtomTerm(d0)) {
        if (IsAtomTerm(d1))
          out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1));
        else if (IsPrimitiveTerm(d1))
          out = 1;
        else
          out = -1;
        /* I know out must be != 0 */
        goto done;
      } else if (IsIntTerm(d0)) {
        if (IsIntTerm(d1))
          out = IntOfTerm(d0) - IntOfTerm(d1);
        else if (IsFloatTerm(d1)) {
          out = 1;
        } else if (IsLongIntTerm(d1)) {
          out = IntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
        } else if (IsBigIntTerm(d1)) {
          out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1);
#endif
        } else if (IsRefTerm(d1))
          out = 1;
        else
          out = -1;
        if (out != 0)
          goto done;
      } else if (IsFloatTerm(d0)) {
        if (IsFloatTerm(d1)) {
          out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1));
        } else if (IsRefTerm(d1)) {
          out = 1;
        } else {
          out = -1;
        }
        if (out != 0)
          goto done;
      } else if (IsStringTerm(d0)) {
        if (IsStringTerm(d1)) {
          out = strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1));
        } else if (IsIntTerm(d1))
          out = 1;
        else if (IsFloatTerm(d1)) {
          out = 1;
        } else if (IsLongIntTerm(d1)) {
          out = 1;
#ifdef USE_GMP
        } else if (IsBigIntTerm(d1)) {
          out = 1;
#endif
        } else if (IsRefTerm(d1)) {
          out = 1;
        } else {
          out = -1;
        }
        if (out != 0)
          goto done;
      } else if (IsLongIntTerm(d0)) {
        if (IsIntTerm(d1))
          out = LongIntOfTerm(d0) - IntOfTerm(d1);
        else if (IsFloatTerm(d1)) {
          out = 1;
        } else if (IsLongIntTerm(d1)) {
          out = LongIntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
        } else if (IsBigIntTerm(d1)) {
          out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1);
#endif
        } else if (IsRefTerm(d1)) {
          out = 1;
        } else {
          out = -1;
        }
        if (out != 0)
          goto done;
      }
#ifdef USE_GMP
      else if (IsBigIntTerm(d0)) {
        if (IsIntTerm(d1)) {
          out = Yap_gmp_tcmp_big_int(d0, IntOfTerm(d1));
        } else if (IsFloatTerm(d1)) {
          out = 1;
        } else if (IsLongIntTerm(d1)) {
          out = Yap_gmp_tcmp_big_int(d0, LongIntOfTerm(d1));
        } else if (IsBigIntTerm(d1)) {
          out = Yap_gmp_tcmp_big_big(d0, d1);
        } else if (IsRefTerm(d1))
          out = 1;
        else
          out = -1;
        if (out != 0)
          goto done;
      }
#endif
      else if (IsPairTerm(d0)) {
        if (!IsPairTerm(d1)) {
          if (IsApplTerm(d1)) {
            Functor f = FunctorOfTerm(d1);
            if (IsExtensionFunctor(f))
              out = 1;
            else if (!(out = 2 - ArityOfFunctor(f)))
              out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE);
          } else
            out = 1;
          goto done;
        }
#ifdef RATIONAL_TREES
        to_visit[0] = pt0;
        to_visit[1] = pt0_end;
        to_visit[2] = pt1;
        to_visit[3] = (CELL *)*pt0;
        to_visit += 4;
        *pt0 = d1;
#else
        /* store the terms to visit */
        if (pt0 < pt0_end) {
          to_visit[0] = pt0;
          to_visit[1] = pt0_end;
          to_visit[2] = pt1;
          to_visit += 3;
        }
#endif
        pt0 = RepPair(d0) - 1;
        pt0_end = RepPair(d0) + 1;
        pt1 = RepPair(d1) - 1;
        continue;
      } else if (IsRefTerm(d0)) {
        if (IsRefTerm(d1))
          out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0));
        else
          out = -1;
        goto done;
      } else if (IsApplTerm(d0)) {
        register Functor f;
        register CELL *ap2, *ap3;
        if (!IsApplTerm(d1)) {
          out = 1;
          goto done;
        } else {
          /* store the terms to visit */
          Functor f2;
          ap2 = RepAppl(d0);
          ap3 = RepAppl(d1);
          f = (Functor)(*ap2);
          if (IsExtensionFunctor(f)) {
            out = 1;
            goto done;
          }
          f2 = (Functor)(*ap3);
          if (IsExtensionFunctor(f2)) {
            out = -1;
            goto done;
          }
          /* compare functors */
          if (f != (Functor)*ap3) {
            if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2)))
              out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2));
            goto done;
          }
#ifdef RATIONAL_TREES
          to_visit[0] = pt0;
          to_visit[1] = pt0_end;
          to_visit[2] = pt1;
          to_visit[3] = (CELL *)*pt0;
          to_visit += 4;
          *pt0 = d1;
#else
          /* store the terms to visit */
          if (pt0 < pt0_end) {
            to_visit[0] = pt0;
            to_visit[1] = pt0_end;
            to_visit[2] = pt1;
            to_visit += 3;
          }
#endif
          d0 = ArityOfFunctor(f);
          pt0 = ap2;
          pt0_end = ap2 + d0;
          pt1 = ap3;
          continue;
        }
      }
    }
  }
  /* Do we still have compound terms to visit */
  if (to_visit > (CELL **)HR) {
#ifdef RATIONAL_TREES
    to_visit -= 4;
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    pt1 = to_visit[2];
    *pt0 = (CELL)to_visit[3];
#else
    to_visit -= 3;
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    pt1 = to_visit[2];
#endif
    goto loop;
  }

done:
/* failure */
#ifdef RATIONAL_TREES
  while (to_visit > (CELL **)HR) {
    to_visit -= 4;
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    pt1 = to_visit[2];
    *pt0 = (CELL)to_visit[3];
  }
#endif
  return (out);
}
Beispiel #7
0
static Int
p_setarg( USES_REGS1 )
{
  CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
  Int i;

  if (IsVarTerm(t3) &&
      VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) {
    /* local variable */
    Term tn = MkVarTerm();
    Bind_Local(VarOfTerm(t3), tn);
    t3 = tn;
  }
  if (IsVarTerm(ti)) {
    Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
    return FALSE;
  } else {
    if (IsIntTerm(ti))
      i = IntOfTerm(ti);
    else {
      Term te = Yap_Eval(ti);
      if (IsIntegerTerm(te)) {
	i = IntegerOfTerm(te);
      } else {
	Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
	return FALSE;
      }
    }
  }
  if (IsVarTerm(ts)) {
    Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
  } else if(IsApplTerm(ts)) {
    CELL *pt;
    if (IsExtensionFunctor(FunctorOfTerm(ts))) {
      Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
      return FALSE;
    }
    if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
      if (i<0)
	Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
      return FALSE;
      if (i==0)
	Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
      return FALSE;
    }
    pt = RepAppl(ts)+i;
    /* the evil deed is to be done now */
    MaBind(pt, t3);
  } else if(IsPairTerm(ts)) {
    CELL *pt;
    if (i < 1 || i > 2) {
      if (i<0)
	Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
      return FALSE;
    }
    pt = RepPair(ts)+i-1;
    /* the evil deed is to be done now */
    MaBind(pt, t3);    
  } else {
    Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
    return FALSE;
  }
  return TRUE;
}
Beispiel #8
0
xarg *
Yap_ArgListToVector (Term listl, const param_t *def, int n)
{
  CACHE_REGS
    xarg *a = calloc(  n , sizeof(xarg) );
  if (IsApplTerm(listl) && FunctorOfTerm(listl) == FunctorModule)
    listl = ArgOfTerm(2,listl);
  if (!IsPairTerm(listl) && listl != TermNil) {
    if (IsVarTerm(listl) ) {
	free( a );
	LOCAL_Error_TYPE = INSTANTIATION_ERROR;
	LOCAL_Error_Term = listl;
	return NULL;
      }
    if (IsAtomTerm(listl) ) {
      xarg *na = matchKey( AtomOfTerm(listl), a, n, def);
      if (!na) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;
      }
    } else if (IsApplTerm(listl)) {
      Functor f = FunctorOfTerm( listl );
      if (IsExtensionFunctor(f)) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;    
      }
      arity_t arity = ArityOfFunctor( f );
      if (arity != 1) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;
      }
      xarg *na = matchKey( NameOfFunctor( f ), a, n, def);
      if (!na) {
	free( a );
	LOCAL_Error_TYPE = TYPE_ERROR_LIST;
	LOCAL_Error_Term = listl;
	return NULL;
      }
    } else {
      free( a );
      LOCAL_Error_TYPE = TYPE_ERROR_LIST;
      LOCAL_Error_Term = listl;
      return NULL;
    }
    listl = MkPairTerm( listl, TermNil );
  }
  while (IsPairTerm(listl)) {
    Term hd = HeadOfTerm( listl );
    listl = TailOfTerm( listl );
    if (IsVarTerm(hd) || IsVarTerm(listl))  {
      LOCAL_Error_TYPE = INSTANTIATION_ERROR;
      if (IsVarTerm(hd)) {
	LOCAL_Error_Term = hd;
      } else {
	LOCAL_Error_Term = listl;
      }
      free( a );
      return NULL;
    }
    if (IsAtomTerm(hd)) {
      xarg *na = matchKey( AtomOfTerm( hd ), a, n, def);
      if (!na)
	return NULL;

      na->used = true;
      na->tvalue = TermNil;
      continue;
    } else if (IsApplTerm( hd )) {
      Functor f = FunctorOfTerm( hd );
      if (IsExtensionFunctor(f)) {
	LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
	LOCAL_Error_Term = hd;
	free( a );
	return NULL;    
      }
      arity_t arity = ArityOfFunctor( f );
      if (arity != 1) {
	LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE;
	LOCAL_Error_Term = hd;
	free( a );
	return NULL;
      }
      xarg *na = matchKey( NameOfFunctor( f ), a, n, def);
      if (!na) {
        free( a );
	return NULL;
      }
      na->used = 1;
      na->tvalue = ArgOfTerm(1, hd);      
    } else {
      LOCAL_Error_TYPE = TYPE_ERROR_PARAMETER;
      free( a );
      return NULL;    
    }
  }
  if (IsVarTerm(listl)) {
    LOCAL_Error_TYPE = INSTANTIATION_ERROR;
    LOCAL_Error_Term = listl;
    free( a );
    return NULL;
  } else if (listl != TermNil) {
    LOCAL_Error_TYPE = TYPE_ERROR_LIST;
    LOCAL_Error_Term = listl;
    free( a );
    return NULL;
  }
  return a;
}              
Beispiel #9
0
static int 
unifiable(CELL d0, CELL d1)
{
CACHE_REGS
#if THREADS
#undef Yap_REGS
  register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
  register REGSTORE *regp = &Yap_REGS;

#define Yap_REGS (*regp)
#endif /* defined(B) || defined(TR) */
#endif

#if SHADOW_HB
  register CELL *HBREG = HB;
#endif

  register CELL *pt0, *pt1;

  deref_head(d0, unifiable_unk);

unifiable_nvar:
  /* d0 is bound */
  deref_head(d1, unifiable_nvar_unk);
unifiable_nvar_nvar:
  /* both arguments are bound */
  if (d0 == d1)
    return TRUE;
  if (IsPairTerm(d0)) {
    if (!IsPairTerm(d1)) {
      return (FALSE);
    }
    pt0 = RepPair(d0);
    pt1 = RepPair(d1);
    return (unifiable_complex(pt0 - 1, pt0 + 1, pt1 - 1));
  }
  else if (IsApplTerm(d0)) {
    pt0 = RepAppl(d0);
    d0 = *pt0;
    if (!IsApplTerm(d1))
      return (FALSE);      
    pt1 = RepAppl(d1);
    d1 = *pt1;
    if (d0 != d1) {
      return (FALSE);
    } else {
      if (IsExtensionFunctor((Functor)d0)) {
	switch(d0) {
	case (CELL)FunctorDBRef:
	  return(pt0 == pt1);
	case (CELL)FunctorLongInt:
	  return(pt0[1] == pt1[1]);
	case (CELL)FunctorString:
	  return(strcmp( (const char *)(pt0+2),  (const char *)(pt1+2)) == 0);
	case (CELL)FunctorDouble:
	  return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP
	case (CELL)FunctorBigInt:
	  return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
	default:
	  return(FALSE);
	}
      }
      return (unifiable_complex(pt0, pt0 + ArityOfFunctor((Functor) d0),
			     pt1));
    }
  } else {
    return (FALSE);
  }

  deref_body(d1, pt1, unifiable_nvar_unk, unifiable_nvar_nvar);
  /* d0 is bound and d1 is unbound */
  *(pt1) = d0;
  DO_TRAIL(pt1, d0);
  return (TRUE);

  deref_body(d0, pt0, unifiable_unk, unifiable_nvar);
  /* pt0 is unbound */
  deref_head(d1, unifiable_var_unk);
unifiable_var_nvar:
  /* pt0 is unbound and d1 is bound */
  *pt0 = d1;
   DO_TRAIL(pt0, d1);
  return TRUE;

  deref_body(d1, pt1, unifiable_var_unk, unifiable_var_nvar);
  /* d0 and pt1 are unbound */
  UnifyAndTrailCells(pt0, pt1);
  return (TRUE);
#if THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)  
#elif SHADOW_REGS
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */
#endif
}
Beispiel #10
0
static int 
unifiable_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
{
CACHE_REGS
#ifdef THREADS
#undef Yap_REGS
  register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif defined(SHADOW_REGS)
#if defined(B) || defined(TR)
  register REGSTORE *regp = &Yap_REGS;

#define Yap_REGS (*regp)
#endif /* defined(B) || defined(TR) || defined(HB) */
#endif

#ifdef SHADOW_HB
  register CELL *HBREG = HB;
#endif /* SHADOW_HB */

  struct unif_record  *unif = (struct unif_record *)AuxBase;
  struct v_record *to_visit  = (struct v_record *)AuxSp;
#define unif_base ((struct unif_record *)AuxBase)
#define to_visit_base ((struct v_record *)AuxSp)

loop:
  while (pt0 < pt0_end) {
    register CELL *ptd0 = pt0+1; 
    register CELL d0;

    ++pt1;
    pt0 = ptd0;
    d0 = *ptd0;
    deref_head(d0, unifiable_comp_unk);
  unifiable_comp_nvar:
    {
      register CELL *ptd1 = pt1;
      register CELL d1 = *ptd1;

      deref_head(d1, unifiable_comp_nvar_unk);
    unifiable_comp_nvar_nvar:
      if (d0 == d1)
	continue;
      if (IsPairTerm(d0)) {
	if (!IsPairTerm(d1)) {
	  goto cufail;
	}
	/* now link the two structures so that no one else will */
	/* come here */
	/* store the terms to visit */
	if (RATIONAL_TREES || pt0 < pt0_end) {
	  to_visit --;
#ifdef RATIONAL_TREES
	  unif++;
#endif
	  if ((void *)to_visit < (void *)unif) {
	    CELL **urec = (CELL **)unif;
	    to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
	    unif = (struct unif_record *)urec;
	  }
	  to_visit->start0 = pt0;
	  to_visit->end0 = pt0_end;
	  to_visit->start1 = pt1;
#ifdef RATIONAL_TREES
	  unif[-1].old = *pt0;
	  unif[-1].ptr = pt0;
	  *pt0 = d1;
#endif
	}
	pt0_end = (pt0 = RepPair(d0) - 1) + 2;
	pt1 = RepPair(d1) - 1;
	continue;
      }
      if (IsApplTerm(d0)) {
	register Functor f;
	register CELL *ap2, *ap3;

	if (!IsApplTerm(d1)) {
	  goto cufail;
	}
	/* store the terms to visit */
	ap2 = RepAppl(d0);
	ap3 = RepAppl(d1);
	f = (Functor) (*ap2);
	/* compare functors */
	if (f != (Functor) *ap3)
	  goto cufail;
	if (IsExtensionFunctor(f)) {
	  if (unify_extension(f, d0, ap2, d1))
	    continue;
	  goto cufail;
	}
	/* now link the two structures so that no one else will */
	/* come here */
	/* store the terms to visit */
	if (RATIONAL_TREES || pt0 < pt0_end) {
	  to_visit --;
#ifdef RATIONAL_TREES
	  unif++;
#endif
	  if ((void *)to_visit < (void *)unif) {
	    CELL **urec = (CELL **)unif;
	    to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
	    unif = (struct unif_record *)urec;
	  }
	  to_visit->start0 = pt0;
	  to_visit->end0 = pt0_end;
	  to_visit->start1 = pt1;
#ifdef RATIONAL_TREES
	  unif[-1].old = *pt0;
	  unif[-1].ptr = pt0;
	  *pt0 = d1;
#endif
	}
	d0 = ArityOfFunctor(f);
	pt0 = ap2;
	pt0_end = ap2 + d0;
	pt1 = ap3;
	continue;
      }
      goto cufail;

      derefa_body(d1, ptd1, unifiable_comp_nvar_unk, unifiable_comp_nvar_nvar);
	/* d1 and pt2 have the unbound value, whereas d0 is bound */
      *(ptd1) = d0;
      DO_TRAIL(ptd1, d0);
      continue;
    }

    derefa_body(d0, ptd0, unifiable_comp_unk, unifiable_comp_nvar);
    /* first arg var */
    {
      register CELL d1;
      register CELL *ptd1;

      ptd1 = pt1;
      d1 = ptd1[0];
      /* pt2 is unbound */
      deref_head(d1, unifiable_comp_var_unk);
    unifiable_comp_var_nvar:
      /* pt2 is unbound and d1 is bound */
      *ptd0 = d1;
       DO_TRAIL(ptd0, d1);
      continue;

      derefa_body(d1, ptd1, unifiable_comp_var_unk, unifiable_comp_var_nvar);
      /* ptd0 and ptd1 are unbound */
      UnifyAndTrailGlobalCells(ptd0, ptd1);
    }
  }
  /* Do we still have compound terms to visit */
  if (to_visit < to_visit_base) {
    pt0 = to_visit->start0;
    pt0_end = to_visit->end0;
    pt1 = to_visit->start1;
    to_visit++;
    goto loop;
  }
#ifdef RATIONAL_TREES
  /* restore bindigs */
  while (unif-- != unif_base) {
    CELL *pt0;

    pt0 = unif->ptr;
    *pt0 = unif->old;
  }
#endif
  return TRUE;

cufail:
#ifdef RATIONAL_TREES
  /* restore bindigs */
  while (unif-- != unif_base) {
    CELL *pt0;

    pt0 = unif->ptr;
    *pt0 = unif->old;
  }
#endif
  return FALSE;
#ifdef THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)  
#elif defined(SHADOW_REGS)
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */
#endif
}
Beispiel #11
0
int
Yap_rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit, CELL **to_visit_max)
{
  CELL ** base = to_visit;
rtree_loop:
  while (pt0 < pt0_end) {
    register CELL *ptd0;
    register CELL d0;

    ptd0 = ++pt0; 
    pt0 = ptd0;
    d0 = *ptd0;
    deref_head(d0, rtree_loop_unk);
  rtree_loop_nvar:
    {
      if (d0 == TermFoundVar)
	goto cufail;
      if (IsPairTerm(d0)) {
	to_visit -= 3;
	if (to_visit < to_visit_max) {
	  to_visit = Yap_shift_visit(to_visit, &to_visit_max, &base);
	}
	to_visit[0] = pt0;
	to_visit[1] = pt0_end;
	to_visit[2] = (CELL *)*pt0;
	*pt0 = TermFoundVar;
	pt0_end = (pt0 = RepPair(d0) - 1) + 2;
	continue;
      }
      if (IsApplTerm(d0)) {
	register Functor f;
	register CELL *ap2;

	/* store the terms to visit */
	ap2 = RepAppl(d0);
	f = (Functor) (*ap2);
	/* compare functors */
	if (IsExtensionFunctor(f)) {
	  continue;
	}
	to_visit -= 3;
	if (to_visit < to_visit_max) {
	  to_visit = Yap_shift_visit(to_visit, &to_visit_max, &base);
	}
	to_visit[0] = pt0;
	to_visit[1] = pt0_end;
	to_visit[2] = (CELL *)*pt0;
	*pt0 = TermFoundVar;
	d0 = ArityOfFunctor(f);
	pt0 = ap2;
	pt0_end = ap2 + d0;
	continue;
      }
      continue;
    }

    derefa_body(d0, ptd0, rtree_loop_unk, rtree_loop_nvar);
  }
  /* Do we still have compound terms to visit */
  if (to_visit < base) {
    pt0 = to_visit[0];
    pt0_end = to_visit[1];
    *pt0 = (CELL)to_visit[2];
    to_visit += 3;
    goto rtree_loop;
  }
  return FALSE;

cufail:
  /* we found an infinite term */
  while (to_visit < (CELL **)base) {
    CELL *pt0;
    pt0 = to_visit[0];
    *pt0 = (CELL)to_visit[2];
    to_visit += 3;
  }
  return TRUE;
}
Beispiel #12
0
static int 
OCUnify(register CELL d0, register CELL d1)
{
CACHE_REGS
  register CELL *pt0, *pt1;

#if SHADOW_HB
  register CELL *HBREG = HB;
#endif

  deref_head(d0, oc_unify_unk);

oc_unify_nvar:
  /* d0 is bound */
  deref_head(d1, oc_unify_nvar_unk);
oc_unify_nvar_nvar:

  if (d0 == d1) {
    return (!rational_tree(d0));
  }
  /* both arguments are bound */
  if (IsPairTerm(d0)) {
    if (!IsPairTerm(d1)) {
	return (FALSE);
    }
    pt0 = RepPair(d0);
    pt1 = RepPair(d1);
    return (OCUnify_complex(pt0 - 1, pt0 + 1, pt1 - 1));
  }
  else if (IsApplTerm(d0)) {
    if (!IsApplTerm(d1))
	return (FALSE);
    pt0 = RepAppl(d0);
    d0 = *pt0;
    pt1 = RepAppl(d1);
    d1 = *pt1;
    if (d0 != d1) {
      return (FALSE);
    } else {
      if (IsExtensionFunctor((Functor)d0)) {
	switch(d0) {
	case (CELL)FunctorDBRef:
	  return(pt0 == pt1);
	case (CELL)FunctorLongInt:
	  return(pt0[1] == pt1[1]);
	case (CELL)FunctorDouble:
	  return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
	case (CELL)FunctorString:
	  return(strcmp( (const char *)(pt0+2),  (const char *)(pt1+2)) == 0);
#ifdef USE_GMP
	case (CELL)FunctorBigInt:
	  return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
	default:
	  return(FALSE);
	}
      }
      return (OCUnify_complex(pt0, pt0 + ArityOfFunctor((Functor) d0),
			      pt1));
    }
  } else {
    return(FALSE);
  }

  deref_body(d1, pt1, oc_unify_nvar_unk, oc_unify_nvar_nvar);
  /* d0 is bound and d1 is unbound */
  YapBind(pt1, d0);
  /* local variables cannot be in a term */
  if (pt1 > HR && pt1 < LCL0)
    return TRUE;
  if (rational_tree(d0))
    return(FALSE);
  return (TRUE);

  deref_body(d0, pt0, oc_unify_unk, oc_unify_nvar);
  /* pt0 is unbound */
  deref_head(d1, oc_unify_var_unk);
oc_unify_var_nvar:
  /* pt0 is unbound and d1 is bound */
  YapBind(pt0, d1);
  /* local variables cannot be in a term */
  if (pt0 > HR && pt0 < LCL0)
    return TRUE;
  if (rational_tree(d1))
    return(FALSE);
  return (TRUE);

  deref_body(d1, pt1, oc_unify_var_unk, oc_unify_var_nvar);
  /* d0 and pt1 are unbound */
  UnifyCells(pt0, pt1);
  return (TRUE);
  return (TRUE);
}
Beispiel #13
0
/// Yap_ArgList2ToVector is much the same as before,
/// but assumes parameters also have something called a
/// scope
xarg *
Yap_ArgList2ToVector (Term listl, const param2_t *def, int n)
{
  CACHE_REGS
    xarg *a = calloc(  n , sizeof(xarg) );
  if (!IsPairTerm(listl) && listl != TermNil) {
    if (IsVarTerm(listl) ) {
      return failed( INSTANTIATION_ERROR, listl, a);      
    }
    if (IsAtomTerm(listl) ) {
      xarg *na = matchKey2( AtomOfTerm(listl), a, n, def);
      if (!na) {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
      }
    }
    if (IsApplTerm(listl)) {
      Functor f = FunctorOfTerm( listl );
      if (IsExtensionFunctor(f)) {
        return failed( TYPE_ERROR_PARAMETER, listl, a);      
      }
      arity_t arity = ArityOfFunctor( f );
      if (arity != 1) {
        return failed( TYPE_ERROR_LIST, listl, a);      
      }
      xarg *na = matchKey2( NameOfFunctor( f ), a, n, def);
      if (!na) {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, listl, a);
      }
    } else {
      return failed( TYPE_ERROR_LIST, listl, a);      
    }
    listl = MkPairTerm( listl, TermNil );
  }
  while (IsPairTerm(listl)) {
    Term hd = HeadOfTerm( listl );
    if (IsVarTerm(hd))  {
      return failed( INSTANTIATION_ERROR, hd, a);      
    }
    if (IsAtomTerm(hd)) {
      xarg *na = matchKey2( AtomOfTerm( hd ), a, n, def);
      if (!na) {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
      }
      na->used = true;
      na->tvalue = TermNil;
      continue;
    } else if (IsApplTerm( hd )) {
      Functor f = FunctorOfTerm( hd );
      if (IsExtensionFunctor(f)) {
        return failed( TYPE_ERROR_PARAMETER, hd, a);      
      }
      arity_t arity = ArityOfFunctor( f );
      if (arity != 1) {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
      }
      xarg *na = matchKey2( NameOfFunctor( f ), a, n, def);
      if (na) {
	na->used = 1;
	na->tvalue = ArgOfTerm(1, hd);
      } else {
        return failed( DOMAIN_ERROR_GENERIC_ARGUMENT, hd, a);
      }
    } else {
      return failed( INSTANTIATION_ERROR, hd, a);      
    }
    listl = TailOfTerm(listl);
  }
  if (IsVarTerm(listl))  {
    return failed( INSTANTIATION_ERROR, listl, a);      
  }
  if (TermNil != listl) {
    return failed( TYPE_ERROR_LIST, listl, a);      
  }
  return a;
}