const char *Yap_GetFileName(Term t USES_REGS) { char *buf = Malloc(YAP_FILENAME_MAX + 1); if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorSlash) { snprintf(buf, YAP_FILENAME_MAX, "%s/%s", Yap_GetFileName(ArgOfTerm(1, t)), Yap_GetFileName(ArgOfTerm(2, t))); } if (IsAtomTerm(t)) { return RepAtom(AtomOfTerm(t))->StrOfAE; } if (IsStringTerm(t)) { return StringOfTerm(t); } return Yap_TextTermToText(t PASS_REGS); }
static Term Eval(Term t USES_REGS) { if (IsVarTerm(t)) { return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic"); } else if (IsNumTerm(t)) { return t; } else if (IsAtomTerm(t)) { ExpEntry *p; Atom name = AtomOfTerm(t); if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) { /* error */ Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntTerm(0); t = Yap_MkApplTerm(FunctorSlash, 2, ti); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "atom %s in arithmetic expression", RepAtom(name)->StrOfAE); } return Yap_eval_atom(p->FOfEE); } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (fun == FunctorString) { const char *s = StringOfTerm(t); if (s[1] == '\0') return MkIntegerTerm(s[0]); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string in arithmetic expression"); } else if ((Atom)fun == AtomFoundVar) { return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "cyclic term in arithmetic expression"); } else { Int n = ArityOfFunctor(fun); Atom name = NameOfFunctor(fun); ExpEntry *p; Term t1, t2; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntegerTerm(n); t = Yap_MkApplTerm(FunctorSlash, 2, ti); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,n); } if (p->FOfEE == op_power && p->ArityOfEE == 2) { t2 = ArgOfTerm(2, t); if (IsPairTerm(t2)) { return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS); } } *RepAppl(t) = (CELL)AtomFoundVar; t1 = Eval(ArgOfTerm(1,t) PASS_REGS); if (t1 == 0L) { *RepAppl(t) = (CELL)fun; return FALSE; } if (n == 1) { *RepAppl(t) = (CELL)fun; return Yap_eval_unary(p->FOfEE, t1); } t2 = Eval(ArgOfTerm(2,t) PASS_REGS); *RepAppl(t) = (CELL)fun; if (t2 == 0L) return FALSE; return Yap_eval_binary(p->FOfEE,t1,t2); } } /* else if (IsPairTerm(t)) */ { if (TailOfTerm(t) != TermNil) { return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string must contain a single character to be evaluated as an arithmetic expression"); } return Eval(HeadOfTerm(t) PASS_REGS); } }
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))); } } }
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); }