Re: Sort on vectors slow

[Roland Orre]

On Thu, 2004-10-14 at 14:28, Roland Orre wrote:
> PS. Code to the restricted-vector-msort! below. I suggest that this
> should go into the distribution, alternatively we should replace the
> current default quicksort for vectors with merge sort.

Typical, the code I sent contained a little bug, which I hadn't
noticed as I'm usually using a temporary vector (optional arg)
supplied. So, here is a new version of restricted-vector-msort!
if anyone is interested or maybe consider it should be put into
the distribution.
/Roland

SCM_DEFINE (scm_restricted_vector_msort_x,
            "restricted-vector-msort!", 4, 1, 0, 
            (SCM vec, SCM less, SCM startpos, SCM endpos, SCM tmpv),
            "Sort the sequence @var{items}, which may be a list or a\n"
            "vector. @var{less} is used for comparing the sequence elements.\n"
            "The sorting is destructive, that means that the input sequence\n"
            "is modified to produce the sorted result.\n"
            "This is a stable sort.")
#define FUNC_NAME s_scm_restricted_vector_msort_x
{
  const scm_t_trampoline_2 cmp = compare_function (less, 2, FUNC_NAME);
  size_t  vlen, spos, high;

  if (SCM_VECTORP (vec))
    {
      SCM *temp;
      vlen = SCM_VECTOR_LENGTH (vec);

      SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos);
      SCM_ASSERT_RANGE (3, startpos, spos <= vlen);
      SCM_VALIDATE_INUM_RANGE (4, endpos,0, vlen);
      high = SCM_INUM (endpos) - spos;

      /*
         the following array does not contain any new references to
         SCM objects, so we can get away with allocing it on the heap.
      */
      if (SCM_UNBNDP(tmpv)) {
        temp = scm_malloc (vlen * sizeof(SCM));
      }
      else
        if (SCM_VECTORP(tmpv) && (SCM_VECTOR_LENGTH(tmpv) >= vlen))
          {
            temp = SCM_WRITABLE_VELTS(tmpv);
          }
        else SCM_WRONG_TYPE_ARG (5, tmpv);

      scm_merge_vector_step (vec, temp, cmp, less, spos, high);

      if (SCM_UNBNDP(tmpv))
        free(temp);

      return SCM_UNSPECIFIED;
    }
  else
    SCM_WRONG_TYPE_ARG (1, vec);
}
#undef FUNC_NAME