diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

inline compare

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1322 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-06-01 21:23:44 +00:00
parent 7af3eafd12
commit f79365e0f6
2 changed files with 170 additions and 146 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * comments: abstract machine assembler *
* * * *
* Last rev: $Date: 2005-06-01 20:25:23 $ * * Last rev: $Date: 2005-06-01 21:23:44 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.80 2005/06/01 20:25:23 vsc
* == and \= should not need a choice-point in ->
*
* Revision 1.79 2005/06/01 16:42:30 vsc * Revision 1.79 2005/06/01 16:42:30 vsc
* put switch_list_nl back * put switch_list_nl back
* *
@ -1111,17 +1114,27 @@ compile_cmp_flags(char *s)
{ {
if (strcmp(s,"=<") == 0) if (strcmp(s,"=<") == 0)
return(EQ_OK_IN_CMP|LT_OK_IN_CMP); return(EQ_OK_IN_CMP|LT_OK_IN_CMP);
if (strcmp(s,"@=<") == 0)
return(EQ_OK_IN_CMP|LT_OK_IN_CMP);
if (strcmp(s,"<") == 0) if (strcmp(s,"<") == 0)
return(LT_OK_IN_CMP); return(LT_OK_IN_CMP);
if (strcmp(s,"@<") == 0)
return(LT_OK_IN_CMP);
if (strcmp(s,">=") == 0) if (strcmp(s,">=") == 0)
return(EQ_OK_IN_CMP|GT_OK_IN_CMP); return(EQ_OK_IN_CMP|GT_OK_IN_CMP);
if (strcmp(s,"@>=") == 0)
return(EQ_OK_IN_CMP|GT_OK_IN_CMP);
if (strcmp(s,">") == 0) if (strcmp(s,">") == 0)
return(GT_OK_IN_CMP); return(GT_OK_IN_CMP);
if (strcmp(s,"@>") == 0)
return(GT_OK_IN_CMP);
if (strcmp(s,"=:=") == 0) if (strcmp(s,"=:=") == 0)
return(EQ_OK_IN_CMP); return(EQ_OK_IN_CMP);
if (strcmp(s,"=\\=") == 0) if (strcmp(s,"=\\=") == 0)
return(GT_OK_IN_CMP|LT_OK_IN_CMP); return(GT_OK_IN_CMP|LT_OK_IN_CMP);
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "internal assembler error in flags for %s", s); if (strcmp(s,"\\==") == 0)
return(GT_OK_IN_CMP|LT_OK_IN_CMP);
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "internal assembler error, %s is not recognised", s);
return(0); return(0);
} }

299
C/cmppreds.c
View File

@ -35,11 +35,11 @@ STATIC_PROTO(Int a_gt, (Term, Term));
STATIC_PROTO(Int a_ge, (Term,Term)); STATIC_PROTO(Int a_ge, (Term,Term));
STATIC_PROTO(Int a_lt, (Term,Term)); STATIC_PROTO(Int a_lt, (Term,Term));
STATIC_PROTO(Int a_le, (Term,Term)); STATIC_PROTO(Int a_le, (Term,Term));
STATIC_PROTO(Int p_noteq, (void)); STATIC_PROTO(Int a_noteq, (Term,Term));
STATIC_PROTO(Int p_gen_lt, (void)); STATIC_PROTO(Int a_gen_lt, (Term,Term));
STATIC_PROTO(Int p_gen_le, (void)); STATIC_PROTO(Int a_gen_le, (Term,Term));
STATIC_PROTO(Int p_gen_gt, (void)); STATIC_PROTO(Int a_gen_gt, (Term,Term));
STATIC_PROTO(Int p_gen_ge, (void)); STATIC_PROTO(Int a_gen_ge, (Term,Term));
#define rfloat(X) ( X > 0.0 ? 1 : ( X == 0.0 ? 0 : -1)) #define rfloat(X) ( X > 0.0 ? 1 : ( X == 0.0 ? 0 : -1))
@ -269,148 +269,159 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
} }
inline static Int inline static Int
compare(register Term t1,register Term t2) /* compare terms t1 and t2 */ compare(Term t1, Term t2) /* compare terms t1 and t2 */
{ {
Int r;
t1 = Deref(t1); if (t1 == t2)
t2 = Deref(t2); return 0;
if (t1 == t2) if (IsVarTerm(t1)) {
return (0); if (IsVarTerm(t2))
if (IsVarTerm(t1)) { return Signed(t1) - Signed(t2);
if (IsVarTerm(t2)) return -1;
return (Signed(t1) - Signed(t2)); } else if (IsVarTerm(t2)) {
return (-1); /* get rid of variables */
} else if (IsVarTerm(t2)) return 1;
return (1); }
if (IsAtomTerm(t1)) { if (IsAtomOrIntTerm(t1)) {
if (IsAtomTerm(t2)) if (IsAtomTerm(t1)) {
return (strcmp( if (IsAtomTerm(t2))
RepAtom(AtomOfTerm(t1))->StrOfAE, return strcmp(
RepAtom(AtomOfTerm(t2))->StrOfAE RepAtom(AtomOfTerm(t1))->StrOfAE,
)); RepAtom(AtomOfTerm(t2))->StrOfAE
if (IsPrimitiveTerm(t2)) );
return (1); if (IsPrimitiveTerm(t2))
return (-1); return 1;
} return -1;
if (IsIntTerm(t1)) { } else {
if (IsIntTerm(t2)) if (IsIntTerm(t2))
return (IntOfTerm(t1) - IntOfTerm(t2)); return IntOfTerm(t1) - IntOfTerm(t2);
if (IsFloatTerm(t2)) { if (IsFloatTerm(t2)) {
return(1); return 1;
} }
if (IsLongIntTerm(t2)) if (IsLongIntTerm(t2)) {
return(IntOfTerm(t1) - LongIntOfTerm(t2)); return IntOfTerm(t1) - LongIntOfTerm(t2);
}
#ifdef USE_GMP #ifdef USE_GMP
if (IsBigIntTerm(t2)) if (IsBigIntTerm(t2)) {
return(-mpz_cmp_si(Yap_BigIntOfTerm(t2),IntOfTerm(t1))); return -mpz_cmp_si(Yap_BigIntOfTerm(t2),IntOfTerm(t1));
}
#endif #endif
if (IsRefTerm(t2)) if (IsRefTerm(t2))
return (1); return 1;
return (-1); return -1;
}
} else if (IsPairTerm(t1)) {
if (IsApplTerm(t2)) {
Functor f = FunctorOfTerm(t2);
if (IsExtensionFunctor(f))
return 1;
else {
int out;
if (!(out = 2-ArityOfFunctor(f)))
out = strcmp(".",RepAtom(NameOfFunctor(f))->StrOfAE);
return(out);
}
}
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 */
if (IsFloatTerm(t1)) {
if (IsFloatTerm(t2))
return(rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
if (IsRefTerm(t2))
return 1;
return -1;
}
if (IsLongIntTerm(t1)) {
if (IsIntTerm(t2))
return LongIntOfTerm(t1) - IntOfTerm(t2);
if (IsFloatTerm(t2)) {
return 1;
} }
if (IsFloatTerm(t1)) { if (IsLongIntTerm(t2))
if (IsFloatTerm(t2)) return LongIntOfTerm(t1) - LongIntOfTerm(t2);
return(rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
if (IsRefTerm(t2))
return (1);
return (-1);
}
if (IsLongIntTerm(t1)) {
if (IsIntTerm(t2))
return (LongIntOfTerm(t1) - IntOfTerm(t2));
if (IsFloatTerm(t2)) {
return(1);
}
if (IsLongIntTerm(t2))
return (LongIntOfTerm(t1) - LongIntOfTerm(t2));
#ifdef USE_GMP #ifdef USE_GMP
if (IsBigIntTerm(t2)) if (IsBigIntTerm(t2))
return(-mpz_cmp_si(Yap_BigIntOfTerm(t2), LongIntOfTerm(t1))); return -mpz_cmp_si(Yap_BigIntOfTerm(t2), LongIntOfTerm(t1));
#endif #endif
if (IsRefTerm(t2)) if (IsRefTerm(t2))
return (1); return 1;
return (-1); return -1;
} }
#ifdef USE_GMP #ifdef USE_GMP
if (IsBigIntTerm(t1)) { if (IsBigIntTerm(t1)) {
if (IsIntTerm(t2)) if (IsIntTerm(t2))
return(mpz_cmp_si(Yap_BigIntOfTerm(t1), IntOfTerm(t2))); return mpz_cmp_si(Yap_BigIntOfTerm(t1), IntOfTerm(t2));
if (IsFloatTerm(t2)) { if (IsFloatTerm(t2)) {
return(1); return 1;
}
if (IsLongIntTerm(t2))
return(mpz_cmp_si(Yap_BigIntOfTerm(t1), LongIntOfTerm(t2)));
if (IsBigIntTerm(t2))
return(mpz_cmp(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
if (IsRefTerm(t2))
return(1);
return(-1);
} }
if (IsLongIntTerm(t2))
return mpz_cmp_si(Yap_BigIntOfTerm(t1), LongIntOfTerm(t2));
if (IsBigIntTerm(t2))
return mpz_cmp(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
if (IsRefTerm(t2))
return 1;
return -1;
}
#endif #endif
if (IsPairTerm(t1)) { if (IsRefTerm(t1)) {
if (IsApplTerm(t2)) { if (IsRefTerm(t2))
Functor f = FunctorOfTerm(t2); return Unsigned(RefOfTerm(t2)) -
if (IsExtensionFunctor(f)) Unsigned(RefOfTerm(t1));
return(1); return -1;
else { }
int out; }
if (!(out = 2-ArityOfFunctor(f))) if (!IsApplTerm(t2)) {
out = strcmp(".",RepAtom(NameOfFunctor(f))->StrOfAE); return 1;
return(out); } else {
} Functor fun2 = FunctorOfTerm(t2);
} Int r;
if (IsPairTerm(t2)) {
return(compare_complex(RepPair(t1)-1, if (IsExtensionFunctor(fun2)) {
RepPair(t1)+1, return 1;
RepPair(t2)-1)); }
} r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
else return (1); if (r)
} return r;
if (IsRefTerm(t1)) { r = strcmp(RepAtom(NameOfFunctor(fun1))->StrOfAE,
if (IsRefTerm(t2)) RepAtom(NameOfFunctor(fun2))->StrOfAE);
return (Unsigned(RefOfTerm(t2)) - if (r)
Unsigned(RefOfTerm(t1))); return r;
return (-1); else
} return(compare_complex(RepAppl(t1),
if (!IsApplTerm(t2)) RepAppl(t1)+ArityOfFunctor(fun1),
return (1); RepAppl(t2)));
/* compound term */ }
{ Functor fun1 = FunctorOfTerm(t1); }
Functor fun2;
fun2 = FunctorOfTerm(t2);
if (IsExtensionFunctor(fun2))
return(1);
r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
if (r)
return (r);
r = strcmp(RepAtom(NameOfFunctor(fun1))->StrOfAE,
RepAtom(NameOfFunctor(fun2))->StrOfAE);
if (r)
return (r);
else
return(compare_complex(RepAppl(t1),
RepAppl(t1)+ArityOfFunctor(fun1),
RepAppl(t2)));
}
} }
int Yap_compare_terms(register CELL d0, register CELL d1) int Yap_compare_terms(register CELL d0, register CELL d1)
{ {
return (compare(d0,d1)); return (compare(Deref(d0),Deref(d1)));
} }
static Int static Int
p_compare(void) p_compare(void)
{ /* compare(?Op,?T1,?T2) */ { /* compare(?Op,?T1,?T2) */
Int r = compare(ARG2, ARG3); Int r = compare(Deref(ARG2), Deref(ARG3));
Atom p; Atom p;
if (r < 0)
p = AtomLT; if (r < 0)
else if (r > 0) p = AtomLT;
p = AtomGT; else if (r > 0)
else p = AtomGT;
p = AtomEQ; else
return (Yap_unify_constant(ARG1, MkAtomTerm(p))); p = AtomEQ;
return Yap_unify_constant(ARG1, MkAtomTerm(p));
} }
inline static int inline static int
@ -995,33 +1006,33 @@ a_le(Term t1, Term t2)
static Int static Int
p_noteq(void) a_noteq(Term t1, Term t2)
{ {
return (compare(ARG1, ARG2) != 0); return (compare(t1, t2) != 0);
} }
static Int static Int
p_gen_lt(void) a_gen_lt(Term t1, Term t2)
{ {
return (compare(ARG1, ARG2) < 0); return (compare(t1, t2) < 0);
} }
static Int static Int
p_gen_le(void) a_gen_le(Term t1, Term t2)
{ {
return (compare(ARG1, ARG2) <= 0); return (compare(t1, t2) <= 0);
} }
static Int static Int
p_gen_gt(void) a_gen_gt(Term t1, Term t2)
{ {
return (compare(ARG1, ARG2) > 0); return (compare(t1, t2) > 0);
} }
static Int static Int
p_gen_ge(void) a_gen_ge(Term t1, Term t2)
{ {
return (compare(ARG1, ARG2) >= 0); return (compare(t1, t2) >= 0);
} }
@ -1035,10 +1046,10 @@ Yap_InitCmpPreds(void)
Yap_InitCmpPred("<", 2, a_lt, SafePredFlag | BinaryTestPredFlag); Yap_InitCmpPred("<", 2, a_lt, SafePredFlag | BinaryTestPredFlag);
Yap_InitCmpPred(">=", 2, a_ge, SafePredFlag | BinaryTestPredFlag); Yap_InitCmpPred(">=", 2, a_ge, SafePredFlag | BinaryTestPredFlag);
Yap_InitCPred("$a_compare", 3, p_acomp, TestPredFlag | SafePredFlag|HiddenPredFlag); Yap_InitCPred("$a_compare", 3, p_acomp, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("\\==", 2, p_noteq, TestPredFlag | SafePredFlag); Yap_InitCmpPred("\\==", 2, a_noteq, BinaryTestPredFlag | SafePredFlag);
Yap_InitCPred("@<", 2, p_gen_lt, TestPredFlag | SafePredFlag); Yap_InitCmpPred("@<", 2, a_gen_lt, BinaryTestPredFlag | SafePredFlag);
Yap_InitCPred("@=<", 2, p_gen_le, TestPredFlag | SafePredFlag); Yap_InitCmpPred("@=<", 2, a_gen_le, BinaryTestPredFlag | SafePredFlag);
Yap_InitCPred("@>", 2, p_gen_gt, TestPredFlag | SafePredFlag); Yap_InitCmpPred("@>", 2, a_gen_gt, BinaryTestPredFlag | SafePredFlag);
Yap_InitCPred("@>=", 2, p_gen_ge, TestPredFlag | SafePredFlag); Yap_InitCmpPred("@>=", 2, a_gen_ge, BinaryTestPredFlag | SafePredFlag);
Yap_InitCPred("compare", 3, p_compare, TestPredFlag | SafePredFlag); Yap_InitCPred("compare", 3, p_compare, TestPredFlag | SafePredFlag);
} }