422 lines
11 KiB
C
422 lines
11 KiB
C
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: sort.c *
|
|
* Last rev: *
|
|
* mods: *
|
|
* comments: sorting in Prolog *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
/* for the moment, follow Prolog's traditional mergesort */
|
|
|
|
#include "Yap.h"
|
|
#include "Yatom.h"
|
|
#include "YapHeap.h"
|
|
#ifndef NULL
|
|
#define NULL (void *)0
|
|
#endif
|
|
|
|
/* fill in the even or the odd elements */
|
|
#define M_EVEN 0
|
|
#define M_ODD 1
|
|
|
|
static Int build_new_list(CELL *, Term CACHE_TYPE);
|
|
static void simple_mergesort(CELL *, Int, int);
|
|
static Int compact_mergesort(CELL *, Int, int);
|
|
static int key_mergesort(CELL *, Int, int, Functor);
|
|
static void adjust_vector(CELL *, Int);
|
|
static Int p_sort( USES_REGS1 );
|
|
static Int p_msort( USES_REGS1 );
|
|
static Int p_ksort( USES_REGS1 );
|
|
|
|
/* copy to a new list of terms */
|
|
static Int
|
|
build_new_list(CELL *pt, Term t USES_REGS)
|
|
{
|
|
Int out = 0;
|
|
if (IsVarTerm(t))
|
|
return(-1);
|
|
if (t == TermNil)
|
|
return(0);
|
|
restart:
|
|
while (IsPairTerm(t)) {
|
|
out++;
|
|
pt[0] = HeadOfTerm(t);
|
|
t = TailOfTerm(t);
|
|
if (IsVarTerm(t))
|
|
return(-1);
|
|
if (t == TermNil) {
|
|
return(out);
|
|
}
|
|
pt += 2;
|
|
if (pt > ASP - 4096) {
|
|
if (!Yap_gcl((ASP-HR)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
|
|
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
return(FALSE);
|
|
}
|
|
t = Deref(ARG1);
|
|
pt = HR;
|
|
out = 0;
|
|
goto restart;
|
|
}
|
|
}
|
|
return(-1);
|
|
}
|
|
|
|
/* copy to a new list of terms */
|
|
static
|
|
void simple_mergesort(CELL *pt, Int size, int my_p)
|
|
{
|
|
|
|
if (size > 2) {
|
|
Int half_size = size / 2;
|
|
CELL *pt_left, *pt_right, *end_pt, *end_pt_left;
|
|
int left_p, right_p;
|
|
|
|
pt_right = pt + half_size*2;
|
|
left_p = my_p^1;
|
|
right_p = my_p;
|
|
simple_mergesort(pt, half_size, left_p);
|
|
simple_mergesort(pt_right, size-half_size, right_p);
|
|
/* now implement a simple merge routine */
|
|
|
|
/* pointer to after the end of the list */
|
|
end_pt = pt + 2*size;
|
|
/* pointer to the element after the last element to the left */
|
|
end_pt_left = pt+half_size*2;
|
|
/* where is left list */
|
|
pt_left = pt+left_p;
|
|
/* where is right list */
|
|
pt_right += right_p;
|
|
/* where is new list */
|
|
pt += my_p;
|
|
/* while there are elements in the left or right vector do compares */
|
|
while (pt_left < end_pt_left && pt_right < end_pt) {
|
|
/* if the element to the left is larger than the one to the right */
|
|
if (Yap_compare_terms(pt_left[0], pt_right[0]) <= 0) {
|
|
/* copy the one to the left */
|
|
pt[0] = pt_left[0];
|
|
/* and avance the two pointers */
|
|
pt += 2;
|
|
pt_left += 2;
|
|
} else {
|
|
/* otherwise, copy the one to the right */
|
|
pt[0] = pt_right[0];
|
|
pt += 2;
|
|
pt_right += 2;
|
|
}
|
|
}
|
|
/* if any elements were left in the left vector just copy them */
|
|
while (pt_left < end_pt_left) {
|
|
pt[0] = pt_left[0];
|
|
pt += 2;
|
|
pt_left += 2;
|
|
}
|
|
/* if any elements were left in the right vector
|
|
and they are in the wrong place, just copy them */
|
|
if (my_p != right_p) {
|
|
while(pt_right < end_pt) {
|
|
pt[0] = pt_right[0];
|
|
pt += 2;
|
|
pt_right += 2;
|
|
}
|
|
}
|
|
} else {
|
|
if (size > 1 && (Yap_compare_terms(pt[0],pt[2]) > 0)) {
|
|
CELL t = pt[2];
|
|
pt[2+my_p] = pt[0];
|
|
pt[my_p] = t;
|
|
} else if (my_p) {
|
|
pt[1] = pt[0];
|
|
if (size > 1)
|
|
pt[3] = pt[2];
|
|
}
|
|
}
|
|
}
|
|
|
|
/* copy to a new list of terms */
|
|
static
|
|
int key_mergesort(CELL *pt, Int size, int my_p, Functor FuncDMinus)
|
|
{
|
|
|
|
if (size > 2) {
|
|
Int half_size = size / 2;
|
|
CELL *pt_left, *pt_right, *end_pt, *end_pt_left;
|
|
int left_p, right_p;
|
|
|
|
pt_right = pt + half_size*2;
|
|
left_p = my_p^1;
|
|
right_p = my_p;
|
|
if (!key_mergesort(pt, half_size, left_p, FuncDMinus))
|
|
return(FALSE);
|
|
if (!key_mergesort(pt_right, size-half_size, right_p, FuncDMinus))
|
|
return(FALSE);
|
|
/* now implement a simple merge routine */
|
|
|
|
/* pointer to after the end of the list */
|
|
end_pt = pt + 2*size;
|
|
/* pointer to the element after the last element to the left */
|
|
end_pt_left = pt+half_size*2;
|
|
/* where is left list */
|
|
pt_left = pt+left_p;
|
|
/* where is right list */
|
|
pt_right += right_p;
|
|
/* where is new list */
|
|
pt += my_p;
|
|
/* while there are elements in the left or right vector do compares */
|
|
while (pt_left < end_pt_left && pt_right < end_pt) {
|
|
/* if the element to the left is larger than the one to the right */
|
|
Term t0 = pt_left[0] , t1 = pt_right[0];
|
|
if (IsVarTerm(t0) || !IsApplTerm(t0) || FunctorOfTerm(t0) != FuncDMinus)
|
|
return(FALSE);
|
|
t0 = ArgOfTerm(1,t0);
|
|
if (IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FuncDMinus)
|
|
return(FALSE);
|
|
t1 = ArgOfTerm(1,t1);
|
|
if (Yap_compare_terms(t0, t1) <= 0) {
|
|
/* copy the one to the left */
|
|
pt[0] = pt_left[0];
|
|
/* and avance the two pointers */
|
|
pt += 2;
|
|
pt_left += 2;
|
|
} else {
|
|
/* otherwise, copy the one to the right */
|
|
pt[0] = pt_right[0];
|
|
pt += 2;
|
|
pt_right += 2;
|
|
}
|
|
}
|
|
/* if any elements were left in the left vector just copy them */
|
|
while (pt_left < end_pt_left) {
|
|
pt[0] = pt_left[0];
|
|
pt += 2;
|
|
pt_left += 2;
|
|
}
|
|
/* if any elements were left in the right vector
|
|
and they are in the wrong place, just copy them */
|
|
if (my_p != right_p) {
|
|
while(pt_right < end_pt) {
|
|
pt[0] = pt_right[0];
|
|
pt += 2;
|
|
pt_right += 2;
|
|
}
|
|
}
|
|
} else {
|
|
if (size > 1) {
|
|
Term t0 = pt[0], t1 = pt[2];
|
|
if (IsVarTerm(t0) || !IsApplTerm(t0) || FunctorOfTerm(t0) != FuncDMinus)
|
|
return(FALSE);
|
|
t0 = ArgOfTerm(1,t0);
|
|
if (IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FuncDMinus)
|
|
return(FALSE);
|
|
t1 = ArgOfTerm(1,t1);
|
|
if (Yap_compare_terms(t0,t1) > 0) {
|
|
CELL t = pt[2];
|
|
pt[2+my_p] = pt[0];
|
|
pt[my_p] = t;
|
|
} else if (my_p) {
|
|
pt[1] = pt[0];
|
|
pt[3] = pt[2];
|
|
}
|
|
} else {
|
|
if (my_p)
|
|
pt[1] = pt[0];
|
|
}
|
|
}
|
|
return(TRUE);
|
|
}
|
|
|
|
/* copy to a new list of terms and compress duplicates */
|
|
static
|
|
Int compact_mergesort(CELL *pt, Int size, int my_p)
|
|
{
|
|
|
|
if (size > 2) {
|
|
Int half_size = size / 2;
|
|
CELL *pt_left, *pt_right, *end_pt_right, *end_pt_left;
|
|
int left_p, right_p;
|
|
Int lsize, rsize;
|
|
|
|
pt_right = pt + half_size*2;
|
|
left_p = my_p^1;
|
|
right_p = my_p;
|
|
lsize = compact_mergesort(pt, half_size, left_p);
|
|
rsize = compact_mergesort(pt_right, size-half_size, right_p);
|
|
/* now implement a simple merge routine */
|
|
|
|
/* where is left list */
|
|
pt_left = pt+left_p;
|
|
/* pointer to the element after the last element to the left */
|
|
end_pt_left = pt+2*lsize;
|
|
/* where is right list */
|
|
pt_right += right_p;
|
|
/* pointer to after the end of the list */
|
|
end_pt_right = pt_right + 2*rsize;
|
|
/* where is new list */
|
|
pt += my_p;
|
|
size = 0;
|
|
/* while there are elements in the left or right vector do compares */
|
|
while (pt_left < end_pt_left && pt_right < end_pt_right) {
|
|
/* if the element to the left is larger than the one to the right */
|
|
Int cmp = Yap_compare_terms(pt_left[0], pt_right[0]);
|
|
if (cmp < (Int)0) {
|
|
/* copy the one to the left */
|
|
pt[0] = pt_left[0];
|
|
/* and avance the two pointers */
|
|
pt += 2;
|
|
size ++;
|
|
pt_left += 2;
|
|
} else if (cmp == (Int)0) {
|
|
/* otherwise, just skip one of them, anyone */
|
|
pt_left += 2;
|
|
} else {
|
|
/* otherwise, copy the one to the right */
|
|
pt[0] = pt_right[0];
|
|
pt += 2;
|
|
pt_right += 2;
|
|
size++;
|
|
}
|
|
}
|
|
/* if any elements were left in the left vector just copy them */
|
|
while (pt_left < end_pt_left) {
|
|
pt[0] = pt_left[0];
|
|
pt += 2;
|
|
pt_left += 2;
|
|
size++;
|
|
}
|
|
/* if any elements were left in the right vector
|
|
and they are in the wrong place, just copy them */
|
|
while(pt_right < end_pt_right) {
|
|
pt[0] = pt_right[0];
|
|
pt += 2;
|
|
pt_right += 2;
|
|
size++;
|
|
}
|
|
return(size);
|
|
} else if (size == 2) {
|
|
Int cmp = Yap_compare_terms(pt[0],pt[2]);
|
|
if (cmp > 0) {
|
|
/* swap */
|
|
CELL t = pt[2];
|
|
pt[2+my_p] = pt[0];
|
|
pt[my_p] = t;
|
|
return(2);
|
|
} else if (cmp == 0) {
|
|
if (my_p)
|
|
pt[1] = pt[0];
|
|
return(1);
|
|
} else {
|
|
if (my_p) {
|
|
pt[1] = pt[0];
|
|
pt[3] = pt[2];
|
|
}
|
|
return(2);
|
|
}
|
|
} else {
|
|
/* size = 1 */
|
|
if (my_p)
|
|
pt[1] = pt[0];
|
|
return(1);
|
|
}
|
|
}
|
|
|
|
static void
|
|
adjust_vector(CELL *pt, Int size)
|
|
{
|
|
/* the elements are where they should be */
|
|
CELL *ptf = pt + 2*(size-1);
|
|
pt ++;
|
|
while (pt < ptf) {
|
|
pt[0] = AbsPair(pt+1);
|
|
pt += 2;
|
|
}
|
|
/* close the list */
|
|
pt[0] = TermNil;
|
|
}
|
|
|
|
static Int
|
|
p_sort( USES_REGS1 )
|
|
{
|
|
/* use the heap to build a new list */
|
|
CELL *pt = HR;
|
|
Term out;
|
|
/* list size */
|
|
Int size;
|
|
size = build_new_list(pt, Deref(ARG1) PASS_REGS);
|
|
if (size < 0)
|
|
return(FALSE);
|
|
if (size < 2)
|
|
return(Yap_unify(ARG1, ARG2));
|
|
pt = HR; /* because of possible garbage collection */
|
|
/* make sure no one writes on our temp data structure */
|
|
HR += size*2;
|
|
/* reserve the necessary space */
|
|
size = compact_mergesort(pt, size, M_EVEN);
|
|
/* reajust space */
|
|
HR = pt+size*2;
|
|
adjust_vector(pt, size);
|
|
out = AbsPair(pt);
|
|
return(Yap_unify(out, ARG2));
|
|
}
|
|
|
|
static Int
|
|
p_msort( USES_REGS1 )
|
|
{
|
|
/* use the heap to build a new list */
|
|
CELL *pt = HR;
|
|
Term out;
|
|
/* list size */
|
|
Int size;
|
|
size = build_new_list(pt, Deref(ARG1) PASS_REGS);
|
|
if (size < 0)
|
|
return(FALSE);
|
|
if (size < 2)
|
|
return(Yap_unify(ARG1, ARG2));
|
|
pt = HR; /* because of possible garbage collection */
|
|
/* reserve the necessary space */
|
|
HR += size*2;
|
|
simple_mergesort(pt, size, M_EVEN);
|
|
adjust_vector(pt, size);
|
|
out = AbsPair(pt);
|
|
return(Yap_unify(out, ARG2));
|
|
}
|
|
|
|
static Int
|
|
p_ksort( USES_REGS1 )
|
|
{
|
|
/* use the heap to build a new list */
|
|
CELL *pt = HR;
|
|
Term out;
|
|
/* list size */
|
|
Int size;
|
|
size = build_new_list(pt, Deref(ARG1) PASS_REGS);
|
|
if (size < 0)
|
|
return(FALSE);
|
|
if (size < 2)
|
|
return(Yap_unify(ARG1, ARG2));
|
|
/* reserve the necessary space */
|
|
pt = HR; /* because of possible garbage collection */
|
|
HR += size*2;
|
|
if (!key_mergesort(pt, size, M_EVEN, FunctorMinus))
|
|
return(FALSE);
|
|
adjust_vector(pt, size);
|
|
out = AbsPair(pt);
|
|
return(Yap_unify(out, ARG2));
|
|
}
|
|
|
|
void
|
|
Yap_InitSortPreds(void)
|
|
{
|
|
Yap_InitCPred("$sort", 2, p_sort, 0);
|
|
Yap_InitCPred("$msort", 2, p_msort, 0);
|
|
Yap_InitCPred("$keysort", 2, p_ksort, 0);
|
|
}
|