/************************************************************************
* *
* C Prolog compare.c *
* ======== --------- *
* *
* By Fernando Pereira, July 1982. *
* EdCAAD, Dept. of Architecture, University of Edinburgh. *
* *
* Based on the Prolog system written in IMP by Luis Damas for ICL 2900 *
* computers, with some contributions by Lawrence Byrd. Stricter types *
* and several extensions by Richard O'Keefe, also BACKWARDS support. *
* *
* Copyright (C) 1982 Fernando Pereira, Luis Damas and Lawrence Byrd. *
* Copyright (C) 1984 R.A.O'Keefe. *
* *
************************************************************************/
/*----------------------------------------------------------------------+
| |
| compare() always compares X->v1ofcf and X->v2ofcf. It calls comp() |
| which actually compares the terms. Comparison starts with a quick |
| filter, using "comparison codes". The comparison code of a term is |
| if the term is a variable, -3 |
| if the term is a database ref, -2 |
| if the term is a number, -1 |
| if the term is an atom, 0 |
| if the term is compound, its arity (>= 1) |
| This manages to combine type comparison and arity comparison in a |
| single test. The Dec-10 system did this first. The really hairy |
| bit is that since the first word of an atom entry is a pointer to |
| itself, SkelFuncP() = SkelAtomP() = . UGH. I |
| have changed the original code four ways. First, I have made a |
| distinction between data base references and numbers; intsign was |
| not defined on dbrefs. Second, I have unfolded strcmp inline. |
| Third, I have made the last argument comparison a tail recursion, |
| similar to gunify(). This should make list comparison cheaper. |
| And fourth, I have unfolded intsign() in-line. There is no other |
| call to it. The order of dbrefs is arbitrary, but consistent. |
| |
+----------------------------------------------------------------------*/
#include "pl.h"
#define code(t) (IsRef(t) ? -3 : !IsPrim(t) ? SkelFuncP(t)->arityoffe \
:IsNumber(t) ? -1 : -2)
static Sint comp(T1,E1, T2,E2)
register PTR T1, T2;
PTR E1, E2;
{
register int n; /* basically an arity */
start:
/* compare the codes of the two terms */
n = code(T1);
{
register Sint d = n - code(T2);
if (d != 0) return d;
}
/* they are the same sort of term, see if they are identical */
if (T1 == T2 && E1 == E2) return 0;
/* if they are not atoms or compound terms, compare the Ti */
if (n < 0) {
double d1, d2;
if (n < -1) return Signed(T1) - Signed(T2);
d1 = IsInt(T1) ? (double)XtrInt(T1) : XtrFloat(T1);
d2 = IsInt(T2) ? (double)XtrInt(T2) : XtrFloat(T2);
return d1 > d2 ? 1 : d1 < d2 ? -1 : 0;
}
/* If they have the same principal functor, compare the arguments */
/* They cannot be the same atom, or == would be true */
/* If they have the same principal functor, the arities are equal */
/* so compare the names of the atoms of the functors as strings. */
if (SkelFuncP(T1) == SkelFuncP(T2)) {
PTR t1,e1, t2,e2;
register Sint d;
if (n == 0) return 0; /* an atom slipped by */
while (--n > 0) {
t1 = argv(NextArg(T1), E1, &e1);
t2 = argv(NextArg(T2), E2, &e2);
d = comp(t1,e1, t2,e2);
if (d != 0) return d;
}
T1 = argv(NextArg(T1), E1, &E1); /* the last arguments are handled */
T2 = argv(NextArg(T2), E2, &E2); /* as an explicit tail recursion */
goto start; /* to make list comparison faster */
} else { /* They have different functors */
register char *s1 = SkelAtomP(T1)->stofae;
register char *s2 = SkelAtomP(T2)->stofae;
while (*s1 == *s2) if (*s1++) s2++; else return 0;
return *s1 - *s2;
}
}
/* icompare() knows that it is always being called to compare X->v1ofcf
and X->v2ofcf, and that it is expected to return an integer <, =, or
> 0 as appropriate. Similarly, acompare() knows that it is being
called to compare X->v2ofcf and X->v3ofcf, and that it is expected
to return an atom '<', '=', or '>'. The reason for specialising the
procedures this way is to eliminate the cost of passing the
arguments. kcompare() is a specialised comparison routine for sort,
msort, and keysort, to compare the nth argument of two terms. If it
finds either term too short, it returns NullP, otherwise < = or >.
*/
Sint icompare()
{
PTR E1 = NullP;
PTR T1 = vvalue(Addr(X->v1ofcf), &E1);
PTR E2 = NullP;
PTR T2 = vvalue(Addr(X->v2ofcf), &E2);
return comp(T1,E1, T2,E2);
}
ATOMP acompare()
{
PTR E1 = NullP;
PTR T1 = vvalue(Addr(X->v2ofcf), &E1);
PTR E2 = NullP;
PTR T2 = vvalue(Addr(X->v3ofcf), &E2);
Sint n = comp(T1,E1, T2,E2);
return n < 0 ? LessThan : n > 0 ? GreaterThan : Equal;
}
ATOMP kcompare(T1,E1, T2,E2, n)
register PTR T1, T2; /* pointers to skeletons */
PTR E1, E2; /* pointers to global frames */
register int n; /* argument number (> 0) */
{
register Sint d;
if (SkelFuncP(T1)->arityoffe < n
|| SkelFuncP(T2)->arityoffe < n) return AtomP(0);
T1 = argv((PTR)(T1[n]), E1, &E1);
T2 = argv((PTR)(T2[n]), E2, &E2);
d = comp(T1,E1, T2,E2);
return d < 0 ? LessThan : d > 0 ? GreaterThan : Equal;
}