/
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
*/

#include "defs.h"

#include "operators.h"
#include "execute.h"
#include "util.h" /* fformat() */

COLDC_FUNC(listgraft) {
    cData * args, * d1, * d2;
    cList * new, * l1, * l2;
    Int pos, x;

    if (!func_init_3(&args, LIST, INTEGER, LIST))
        return;

    pos = args[1].u.val;
    l1 = args[0].u.list;
    l2 = args[2].u.list;

    if (pos-1 > list_length(l1) || pos < 1) {
        cthrow(range_id,
               "Position %D is outside of the range of the list.",
               &args[1]);
        return;
    } else if (pos == 1) {
        new = list_dup(l2);
        new = list_append(new, l1);
    } else if (pos-1 == list_length(l1)) {
        new = list_dup(l1);
        new = list_append(new, l2);
    } else {
        new = list_new(list_length(l1) + list_length(l2));
        for (x=2, d1=list_first(l1); d1; d1=list_next(l1, d1), x++) {
            new = list_add(new, d1);
            if (x==pos) {
                for (d2=list_first(l2); d2; d2=list_next(l2, d2))
                    new = list_add(new, d2);
            }
        }
    }

    pop(3);
    push_list(new);
    list_discard(new);
}

COLDC_FUNC(listlen) {
    cData *args;
    Int len;

    /* Accept a list to take the length of. */
    if (!func_init_1(&args, LIST))
	return;

    /* Replace the argument with its length. */
    len = list_length(args[0].u.list);
    pop(1);
    push_int(len);
}

COLDC_FUNC(sublist) {
    Int num_args, start, span, list_len;
    cData *args;

    /* Accept a list, an integer, and an optional integer. */
    if (!func_init_2_or_3(&args, &num_args, LIST, INTEGER, INTEGER))
	return;

    list_len = list_length(args[0].u.list);
    start = args[1].u.val - 1;
    span = (num_args == 3) ? args[2].u.val : list_len - start;

    /* Make sure range is in bounds. */
    if (start < 0) {
	cthrow(range_id, "Start (%d) less than one", start + 1);
    } else if (span < 0) {
	cthrow(range_id, "Sublist length (%d) less than zero", span);
    } else if (start + span > list_len) {
	cthrow(range_id, "Sublist extends to %d, past end of list (length %d)",
	      start + span, list_len);
    } else {
	/* Replace first argument with sublist, and pop other arguments. */
	anticipate_assignment();
	args[0].u.list = list_sublist(args[0].u.list, start, span);
	pop(num_args - 1);
    }
}

COLDC_FUNC(insert) {
    Int pos, list_len;
    cData *args;

    /* Accept a list, an integer offset, and a data value of any type. */
    if (!func_init_3(&args, LIST, INTEGER, 0))
	return;

    pos = args[1].u.val - 1;
    list_len = list_length(args[0].u.list);

    if (pos < 0) {
	cthrow(range_id, "Position (%d) less than one", pos + 1);
    } else if (pos > list_len) {
	cthrow(range_id, "Position (%d) beyond end of list (length %d)",
	      pos + 1, list_len);
    } else {
	/* Modify the list and pop the offset and data. */
	anticipate_assignment();
	args[0].u.list = list_insert(args[0].u.list, pos, &args[2]);
	pop(2);
    }
}

COLDC_FUNC(replace) {
    Int pos, list_len;
    cData *args;

    /* Accept a list, an integer offset, and a data value of any type. */
    if (!func_init_3(&args, LIST, INTEGER, 0))
	return;

    list_len = list_length(args[0].u.list);
    pos = args[1].u.val - 1;

    if (pos < 0) {
	cthrow(range_id, "Position (%d) less than one", pos + 1);
    } else if (pos > list_len - 1) {
	cthrow(range_id, "Position (%d) greater than length of list (%d)",
	      pos + 1, list_len);
    } else {
	/* Modify the list and pop the offset and data. */
	anticipate_assignment();
	args[0].u.list = list_replace(args[0].u.list, pos, &args[2]);
	pop(2);
    }
}

COLDC_FUNC(delete) {
    Int pos, list_len;
    cData *args;

    /* Accept a list and an integer offset. */
    if (!func_init_2(&args, LIST, INTEGER))
	return;

    list_len = list_length(args[0].u.list);
    pos = args[1].u.val - 1;

    if (pos < 0) {
	cthrow(range_id, "Position (%d) less than one", pos + 1);
    } else if (pos > list_len - 1) {
	cthrow(range_id, "Position (%d) greater than length of list (%d)",
	      pos + 1, list_len);
    } else {
	/* Modify the list and pop the offset. */
	anticipate_assignment();
	args[0].u.list = list_delete(args[0].u.list, pos);
	pop(1);
    }
}

COLDC_FUNC(setadd) {
    cData *args;

    /* Accept a list and a data value of any type. */
    if (!func_init_2(&args, LIST, 0))
	return;

    /* Add args[1] to args[0] and pop args[1]. */
    anticipate_assignment();
    args[0].u.list = list_setadd(args[0].u.list, &args[1]);
    pop(1);
}

COLDC_FUNC(setremove) {
    cData *args;

    /* Accept a list and a data value of any type. */
    if (!func_init_2(&args, LIST, 0))
	return;

    /* Remove args[1] from args[0] and pop args[1]. */
    anticipate_assignment();
    args[0].u.list = list_setremove(args[0].u.list, &args[1]);
    pop(1);
}

COLDC_FUNC(union) {
    cData *args;

    /* Accept two lists. */
    if (!func_init_2(&args, LIST, LIST))
	return;

    /* Union args[1] into args[0] and pop args[1]. */
    anticipate_assignment();
    args[0].u.list = list_union(args[0].u.list, args[1].u.list);
    pop(1);
}

COLDC_FUNC(join) {
    cData * args;
    Int      argc, discard_sep=NO;
    cStr    * str, * sep;

    if (!func_init_1_or_2(&args, &argc, LIST, STRING))
        return;

    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);
    }

    pop(argc);
    push_string(str);
    string_discard(str);
}

COLDC_FUNC(listidx) {
    int origin;
    int r; 
    
    INIT_2_OR_3_ARGS(LIST, ANY_TYPE, INTEGER);

    if (argc == 3)  
        origin = INT3;
    else
        origin = 1;
    
    if ((r = list_index(LIST1, &args[1], origin)) == F_FAILURE)
        THROW((range_id, "Origin is beyond the range of the list."))
    
    pop(argc); 
    push_int(r);
}