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);
} }

213
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,89 +269,52 @@ 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);
t2 = Deref(t2);
if (t1 == t2) if (t1 == t2)
return (0); return 0;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
if (IsVarTerm(t2)) if (IsVarTerm(t2))
return (Signed(t1) - Signed(t2)); return Signed(t1) - Signed(t2);
return (-1); return -1;
} else if (IsVarTerm(t2)) } else if (IsVarTerm(t2)) {
return (1); /* get rid of variables */
return 1;
}
if (IsAtomOrIntTerm(t1)) {
if (IsAtomTerm(t1)) { if (IsAtomTerm(t1)) {
if (IsAtomTerm(t2)) if (IsAtomTerm(t2))
return (strcmp( return strcmp(
RepAtom(AtomOfTerm(t1))->StrOfAE, RepAtom(AtomOfTerm(t1))->StrOfAE,
RepAtom(AtomOfTerm(t2))->StrOfAE RepAtom(AtomOfTerm(t2))->StrOfAE
)); );
if (IsPrimitiveTerm(t2)) if (IsPrimitiveTerm(t2))
return (1); return 1;
return (-1); return -1;
} } else {
if (IsIntTerm(t1)) {
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
if (IsBigIntTerm(t2))
return(-mpz_cmp_si(Yap_BigIntOfTerm(t2),IntOfTerm(t1)));
#endif
if (IsRefTerm(t2))
return (1);
return (-1);
}
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 (IsLongIntTerm(t2))
return (LongIntOfTerm(t1) - LongIntOfTerm(t2));
#ifdef USE_GMP
if (IsBigIntTerm(t2))
return(-mpz_cmp_si(Yap_BigIntOfTerm(t2), LongIntOfTerm(t1)));
#endif
if (IsRefTerm(t2))
return (1);
return (-1);
} }
#ifdef USE_GMP #ifdef USE_GMP
if (IsBigIntTerm(t1)) { if (IsBigIntTerm(t2)) {
if (IsIntTerm(t2)) return -mpz_cmp_si(Yap_BigIntOfTerm(t2),IntOfTerm(t1));
return(mpz_cmp_si(Yap_BigIntOfTerm(t1), IntOfTerm(t2)));
if (IsFloatTerm(t2)) {
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(t2))
return 1;
return -1;
}
} else if (IsPairTerm(t1)) {
if (IsApplTerm(t2)) { if (IsApplTerm(t2)) {
Functor f = FunctorOfTerm(t2); Functor f = FunctorOfTerm(t2);
if (IsExtensionFunctor(f)) if (IsExtensionFunctor(f))
return(1); return 1;
else { else {
int out; int out;
if (!(out = 2-ArityOfFunctor(f))) if (!(out = 2-ArityOfFunctor(f)))
@ -364,53 +327,101 @@ compare(register Term t1,register Term t2) /* compare terms t1 and t2 */
RepPair(t1)+1, RepPair(t1)+1,
RepPair(t2)-1)); RepPair(t2)-1));
} }
else return (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 (IsLongIntTerm(t2))
return LongIntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
if (IsBigIntTerm(t2))
return -mpz_cmp_si(Yap_BigIntOfTerm(t2), LongIntOfTerm(t1));
#endif
if (IsRefTerm(t2))
return 1;
return -1;
}
#ifdef USE_GMP
if (IsBigIntTerm(t1)) {
if (IsIntTerm(t2))
return mpz_cmp_si(Yap_BigIntOfTerm(t1), IntOfTerm(t2));
if (IsFloatTerm(t2)) {
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
if (IsRefTerm(t1)) { if (IsRefTerm(t1)) {
if (IsRefTerm(t2)) if (IsRefTerm(t2))
return (Unsigned(RefOfTerm(t2)) - return Unsigned(RefOfTerm(t2)) -
Unsigned(RefOfTerm(t1))); Unsigned(RefOfTerm(t1));
return (-1); return -1;
}
}
if (!IsApplTerm(t2)) {
return 1;
} else {
Functor fun2 = FunctorOfTerm(t2);
Int r;
if (IsExtensionFunctor(fun2)) {
return 1;
} }
if (!IsApplTerm(t2))
return (1);
/* compound term */
{ Functor fun1 = FunctorOfTerm(t1);
Functor fun2;
fun2 = FunctorOfTerm(t2);
if (IsExtensionFunctor(fun2))
return(1);
r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2); r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
if (r) if (r)
return (r); return r;
r = strcmp(RepAtom(NameOfFunctor(fun1))->StrOfAE, r = strcmp(RepAtom(NameOfFunctor(fun1))->StrOfAE,
RepAtom(NameOfFunctor(fun2))->StrOfAE); RepAtom(NameOfFunctor(fun2))->StrOfAE);
if (r) if (r)
return (r); return r;
else else
return(compare_complex(RepAppl(t1), return(compare_complex(RepAppl(t1),
RepAppl(t1)+ArityOfFunctor(fun1), RepAppl(t1)+ArityOfFunctor(fun1),
RepAppl(t2))); 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) if (r < 0)
p = AtomLT; p = AtomLT;
else if (r > 0) else if (r > 0)
p = AtomGT; p = AtomGT;
else else
p = AtomEQ; p = AtomEQ;
return (Yap_unify_constant(ARG1, MkAtomTerm(p))); 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);
} }