yap-6.3/C/sort.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_Error(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);
}