/
Genesis-1.0p36-DEV/
Genesis-1.0p36-DEV/bin/
Genesis-1.0p36-DEV/doc/
Genesis-1.0p36-DEV/etc/
Genesis-1.0p36-DEV/src/data/
/*
// Full copyright information is available in the file ../doc/CREDITS
*/

#define NATIVE_MODULE "$list"

#include "cdc.h"

NATIVE_METHOD(listlen) {
    Int len;

    INIT_1_ARG(LIST);

    len = list_length(LIST1);

    CLEAN_RETURN_INTEGER(len);
}

NATIVE_METHOD(sublist) {
    Int      start,
             span,
             len;
    cList * list;

    INIT_2_OR_3_ARGS(LIST, INTEGER, INTEGER)

    len = list_length(LIST1);
    start = INT2 - 1;
    span = (argc == 3) ? INT3 : len - start;

    /* Make sure range is in bounds. */
    if (start < 0)
        THROW((range_id, "Start (%d) less than one", start + 1))
    else if (span < 0)
        THROW((range_id, "Sublist length (%d) less than zero", span))
    else if (start + span > len)
        THROW((range_id, "Sublist extends to %d, past end of list (length %d)",
              start + span, len))

    list = list_dup(LIST1);

    CLEAN_STACK();
    anticipate_assignment();

    list = list_sublist(list, start, span);

    RETURN_LIST(list);
}

NATIVE_METHOD(insert) {
    Int      pos,
             len;
    cList * list;
    cData   data;
    DEF_args;

    INIT_ARGC(ARG_COUNT, 3, "three");
    INIT_ARG1(LIST)
    INIT_ARG2(INTEGER)

    pos = INT2 - 1;
    len = list_length(LIST1);

    if (pos < 0)
        THROW((range_id, "Position (%d) less than one", pos + 1))
    else if (pos > len)
        THROW((range_id, "Position (%d) beyond end of list (length %d)",
              pos + 1, len))

    data_dup(&data, &args[2]);
    list = list_dup(LIST1);

    CLEAN_STACK();
    anticipate_assignment();

    list = list_insert(list, pos, &data);
    data_discard(&data);

    RETURN_LIST(list);
}

NATIVE_METHOD(replace) {
    Int      pos,
             len;
    cList * list;
    cData   data;
    DEF_args;

    INIT_ARGC(ARG_COUNT, 3, "three");
    INIT_ARG1(LIST)
    INIT_ARG2(INTEGER)

    len = list_length(LIST1);
    pos = INT2 - 1;

    if (pos < 0)
        THROW((range_id, "Position (%d) less than one", pos + 1))
    else if (pos > len - 1)
        THROW((range_id, "Position (%d) greater than length of list (%d)",
              pos + 1, len))

    data_dup(&data, &args[2]);
    list = list_dup(LIST1);
    CLEAN_STACK();
    anticipate_assignment();

    list = list_replace(list, pos, &data);
    data_discard(&data);
    
    RETURN_LIST(list);
}

NATIVE_METHOD(delete) {
    Int      pos,
             len;
    cList * list;

    INIT_2_ARGS(LIST, INTEGER)

    len = list_length(LIST1);
    pos = INT2 - 1;

    if (pos < 0)
        THROW((range_id, "Position (%d) less than one", pos + 1))
    else if (pos > len - 1)
        THROW((range_id, "Position (%d) greater than length of list (%d)",
              pos + 1, len))

    list = list_dup(LIST1);

    CLEAN_STACK();
    anticipate_assignment();

    RETURN_LIST(list_delete(list, pos));
}

NATIVE_METHOD(setadd) {
    cList * list;
    cData   data;
    DEF_args;

    INIT_ARGC(ARG_COUNT, 2, "two")
    INIT_ARG1(LIST)

    data_dup(&data, &args[1]);
    list = list_dup(LIST1);

    CLEAN_STACK();
    anticipate_assignment();

    list = list_setadd(list, &data);
    data_discard(&data);

    RETURN_LIST(list);
}

NATIVE_METHOD(setremove) {
    cList * list;
    cData   data;
    DEF_args;
    
    INIT_ARGC(ARG_COUNT, 2, "two") 
    INIT_ARG1(LIST)

    data_dup(&data, &args[1]);
    list = list_dup(LIST1);
    
    CLEAN_STACK();
    anticipate_assignment();
    
    list = list_setremove(list, &data);
    data_discard(&data);
    
    RETURN_LIST(list);
}

NATIVE_METHOD(union) {
    cList * list, * list2;

    INIT_2_ARGS(LIST, LIST)

    list = list_dup(LIST1);
    list2 = list_dup(LIST2);

    CLEAN_STACK();
    anticipate_assignment();

    list = list_union(list, list2);

    list_discard(list2);

    RETURN_LIST(list);
}

NATIVE_METHOD(join) {
    Int      discard_sep=NO;
    cStr    * str, * sep;

    INIT_1_OR_2_ARGS(LIST, STRING)

    if (!LIST1->len) {
        str = string_new(0);
    } else {
        if (argc == 1) {
            sep = string_from_chars(" ", 1);
            discard_sep=YES;
        } else {    
            sep = STR2;
        }
        str = list_join(LIST1, sep);
        if (discard_sep)
            string_discard(sep);
    }
    
    CLEAN_RETURN_STRING(str);
}

static void merge_lists (cData *l, cData *key,
			 Int start1, Int end1,
			 Int start2, Int end2,
			 cData *l_out, cData *key_out)
{
    Int i,j,k;

    i=start1;
    j=start2;
    k=start1;

    while (i<=end1 && j<=end2)
	if (data_cmp(key+j,key+i)>=0)
	    key_out[k]=key[i], l_out[k++]=l[i++];
	else
	    key_out[k]=key[j], l_out[k++]=l[j++];
    while (i<=end1)
	key_out[k]=key[i], l_out[k++]=l[i++];
    while (j<=end2)
	key_out[k]=key[j], l_out[k++]=l[j++];
    memcpy (l+start1, l_out+start1, sizeof(cData)*(k-start1));
    memcpy (key+start1, key_out+start1, sizeof(cData)*(k-start1));
}

static void merge_sort (cData *l, cData *key,
			cData *l1, cData *key1,
			Int start, Int end)
{

    Int mid;

    if (start==end)
	return;

    mid=(start+end)/2;
    merge_sort (l, key, l1, key1, start, mid);
    merge_sort (l, key, l1, key1, mid+1, end);
    merge_lists (l, key, start, mid, mid+1, end, l1, key1);
}

NATIVE_METHOD(sort) {
    cData *d1, *d2, *key1, *key2;
    Int n, i;
    cList *data, *keys;
    cList *out;

    INIT_1_OR_2_ARGS(LIST, LIST);
    data=LIST1;
    if (argc==1)
	keys=data;
    else
	keys=LIST2;

    n=list_length(data);
    if (!(list_length(keys)==n)) {
	THROW((range_id, "Key and data lists are not of the same length"));
    }

    if (!n) {
	out=list_dup(data);
	CLEAN_RETURN_LIST(out);
    }

    d1=emalloc(sizeof(cData)*n);
    d2=emalloc(sizeof(cData)*n);
    key1=emalloc(sizeof(cData)*n);
    key2=emalloc(sizeof(cData)*n);

    for (i=0; i<n; i++) {
	data_dup(d1+i, list_elem(data, i));
	data_dup(key1+i, list_elem(keys, i));
    }
    merge_sort (d1, key1, d2, key2, 0, n-1);

    out=list_new(n);
    out->len=n;
    for (i=0; i<n; i++) {
        *list_elem(out, i)=d1[i]; /* We already did data_dup */
	data_discard(key1+i);
    }

    efree(d1);
    efree(d2);
    efree(key1);
    efree(key2);

    CLEAN_RETURN_LIST(out);
}