688 lines
17 KiB
C
688 lines
17 KiB
C
/* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT
|
|
* Copyright 1989 Massachusetts Institute of Technology
|
|
*/
|
|
/*********************\
|
|
* *
|
|
* WOOL_OBJECT List *
|
|
* BODY *
|
|
* *
|
|
\*********************/
|
|
|
|
#include "EXTERN.h"
|
|
#include <stdio.h>
|
|
#include "wool.h"
|
|
#include "wl_number.h"
|
|
#include "wl_atom.h"
|
|
#include "wl_name.h"
|
|
#include "wl_coll.h"
|
|
#include "wl_func.h"
|
|
#include "INTERN.h"
|
|
#include "wl_list.h"
|
|
|
|
/*
|
|
* Constructor:
|
|
* used mainly in parser, called by WLList_make
|
|
*/
|
|
|
|
WOOL_List
|
|
WLList_make(col)
|
|
WOOL_Collection col;
|
|
{
|
|
if (col -> size) {
|
|
WOOL_List object = (WOOL_List)
|
|
Malloc(sizeof(struct _WOOL_List) +
|
|
((col -> size -1) * sizeof(WOOL_OBJECT)));
|
|
|
|
zrt_put(object);
|
|
object -> type = WLList;
|
|
copy_n_objects(col -> list, object -> list, col -> size);
|
|
object -> size = col -> size;
|
|
return object;
|
|
} else { /* a list of size 0 is just NIL */
|
|
return (WOOL_List) NIL;
|
|
}
|
|
}
|
|
|
|
/* makes a list with size slots, to be filled by the C programmer */
|
|
|
|
WOOL_List
|
|
wool_list_make(size)
|
|
int size;
|
|
{
|
|
WOOL_List wl_list;
|
|
|
|
wl_list = (WOOL_List) Malloc(sizeof(struct _WOOL_List) +
|
|
(size -1) * sizeof(WOOL_OBJECT));
|
|
zrt_put(wl_list);
|
|
wl_list -> type = WLList;
|
|
wl_list -> size = size;
|
|
return wl_list;
|
|
}
|
|
|
|
/* makes a list of argc, argv WOOL_OBJECTS */
|
|
|
|
WOOL_List
|
|
wool_list_make_from_evaluated_array(argc, argv)
|
|
int argc;
|
|
WOOL_OBJECT argv[];
|
|
{
|
|
WOOL_List wl_list;
|
|
int i;
|
|
|
|
wl_list = (WOOL_List) Malloc(sizeof(struct _WOOL_List) +
|
|
(argc - 1) * sizeof(WOOL_OBJECT));
|
|
zrt_put(wl_list);
|
|
wl_list -> type = WLList;
|
|
wl_list -> size = argc;
|
|
for (i = 0; i < argc; i++)
|
|
increase_reference(wl_list -> list[i] =
|
|
WOOL_send(WOOL_eval, argv[i], (argv[i])));
|
|
return wl_list;
|
|
}
|
|
|
|
/* externally callable list-make:
|
|
* (list-make n elements...)
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
wool_list_make_from_wool(argc, argv)
|
|
int argc;
|
|
WOOL_OBJECT argv[];
|
|
{
|
|
WOOL_List wl_list;
|
|
int i;
|
|
|
|
if (argc < 1)
|
|
wool_error(BAD_NUMBER_OF_ARGS, argc);
|
|
must_be_number(argv[0], 0);
|
|
if (((WOOL_Number) argv[0]) -> number) {
|
|
wl_list = wool_list_make(((WOOL_Number) argv[0]) -> number);
|
|
if (argc == 1)
|
|
for (i = 0; i < wl_list -> size; i++)
|
|
increase_reference(wl_list -> list[i] = NIL);
|
|
else
|
|
for (i = 0; i < wl_list -> size; i++)
|
|
increase_reference(wl_list -> list[i] =
|
|
argv[(i % (argc - 1)) + 1]);
|
|
return (WOOL_OBJECT) wl_list;
|
|
} else {
|
|
return NIL;
|
|
}
|
|
}
|
|
|
|
/*
|
|
* WLList_eval:
|
|
* the heart of the interpreter:
|
|
* evaluating a list is calling the function associated with car by
|
|
* sending WOOL_execute to the CAR, with the list of parameters.
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_eval(obj)
|
|
WOOL_List obj;
|
|
{
|
|
WOOL_OBJECT result;
|
|
|
|
calling_function_push(obj);
|
|
#ifdef USER_DEBUG
|
|
if (wool_tracing_on) {
|
|
wool_tracing_level++;
|
|
wool_put_spaces(wool_tracing_level);
|
|
wool_puts("-> ");
|
|
wool_print(obj);
|
|
wool_puts("\n");
|
|
if (wool_tracing_on_EXPR) {
|
|
wool_tracing_on = 0;
|
|
eval(wool_tracing_on_EXPR);
|
|
wool_tracing_on = 1;
|
|
}
|
|
result = WOOL_send(WOOL_execute, (*(obj -> list)),
|
|
(*(obj -> list), obj));
|
|
if (wool_tracing_on_EXPR) {
|
|
wool_tracing_on = 0;
|
|
eval(wool_tracing_on_EXPR);
|
|
if (wool_still_tracing)
|
|
wool_tracing_on = 1;
|
|
else
|
|
wool_still_tracing = 1;
|
|
}
|
|
wool_put_spaces(wool_tracing_level);
|
|
wool_puts("<- ");
|
|
wool_print(result);
|
|
wool_puts("\n");
|
|
wool_tracing_level--;
|
|
} else
|
|
#endif /* USER_DEBUG */
|
|
{
|
|
#ifdef DEBUG /* stack overflow check */
|
|
if ((calling_function_current - calling_function_stack) >= 10000) {
|
|
printf("Stack size is %d!\n", (calling_function_current
|
|
- calling_function_stack));
|
|
stop_if_in_dbx();
|
|
}
|
|
#endif /* DEBUG */
|
|
result = WOOL_send(WOOL_execute, (*(obj -> list)),
|
|
(*(obj -> list), obj));
|
|
}
|
|
calling_function_pop();
|
|
return result;
|
|
}
|
|
|
|
/*
|
|
* WLList_print:
|
|
* classical: "(a b c d)"
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_print(obj)
|
|
WOOL_List obj;
|
|
{
|
|
int i;
|
|
WOOL_OBJECT *p = obj -> list;
|
|
|
|
wool_putchar('(');
|
|
if(++wool_print_level <= wool_max_print_level) {
|
|
for (i = 0; i < obj -> size; i++, p++) {
|
|
if (i)
|
|
wool_putchar(' ');
|
|
WOOL_send(WOOL_print, *p, (*p));
|
|
}
|
|
}else{
|
|
wool_puts("...");
|
|
}
|
|
wool_print_level--;
|
|
wool_putchar(')');
|
|
return (WOOL_OBJECT) obj;
|
|
}
|
|
|
|
/*
|
|
* freeing a list decreases the reference count of all the elements before
|
|
* freeing itself!
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_free(obj)
|
|
WOOL_List obj;
|
|
{
|
|
WOOL_OBJECT *last = obj -> list + obj -> size, *list = obj -> list;
|
|
|
|
while (list < last) {
|
|
decrease_reference(*list);
|
|
list++;
|
|
}
|
|
Free(obj);
|
|
return NULL;
|
|
}
|
|
|
|
/*
|
|
* executing a list is evaluating it and sending execute to the result
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_execute(obj, list)
|
|
WOOL_List obj;
|
|
WOOL_List list;
|
|
{
|
|
WOOL_OBJECT eval = WLList_eval(obj);
|
|
|
|
if (eval -> type != WLList) {
|
|
return WOOL_send(WOOL_execute, eval, (eval, list));
|
|
} else {
|
|
return (wool_error(UNDEFINED_FUNCTION, obj));
|
|
}
|
|
}
|
|
|
|
/*
|
|
* equality of two lists is equality of their elements
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_equal(l1, l2)
|
|
WOOL_List l1,l2;
|
|
{
|
|
int i;
|
|
|
|
if ((l2 -> type != l1 -> type)
|
|
|| (l2 -> size != l1 -> size))
|
|
return NIL;
|
|
for (i = 0; i < l1 -> size; i++) {
|
|
if (WOOL_send(WOOL_equal, l1 -> list[i],
|
|
(l1 -> list[i], l2 -> list[i])) == NIL)
|
|
return NIL;
|
|
}
|
|
return (WOOL_OBJECT) l1;
|
|
}
|
|
|
|
WOOL_OBJECT *
|
|
wool_flatten_pairlist(argc, argv)
|
|
int argc;
|
|
WOOL_List *argv;
|
|
{
|
|
WOOL_OBJECT *list =
|
|
(WOOL_OBJECT *) Malloc(sizeof(WOOL_OBJECT) * 2 * argc);
|
|
int i;
|
|
|
|
for (i = 0; i < argc; i++) {
|
|
if ((argv[i] -> type != WLList) || (argv[i] -> size != 2))
|
|
return (WOOL_OBJECT *) wool_error(BAD_LOCAL_SYNTAX, "");
|
|
list[i * 2] = argv[i] -> list[0];
|
|
list[i * 2 + 1] = argv[i] -> list[1];
|
|
}
|
|
return list;
|
|
}
|
|
|
|
|
|
/*****************************\
|
|
* *
|
|
* List manipulation routines *
|
|
* *
|
|
\*****************************/
|
|
|
|
/*
|
|
* returns sublist ifrom... ito
|
|
* (sublist from to list)
|
|
* from included, to excluded
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_sub(argc, argv)
|
|
int argc;
|
|
WOOL_List argv[];
|
|
{
|
|
WOOL_List newlist;
|
|
int from, to, i;
|
|
|
|
if (argc != 3)
|
|
wool_error(BAD_NUMBER_OF_ARGS, argc);
|
|
must_be_number(argv[0], 0);
|
|
must_be_number(argv[1], 1);
|
|
must_be_or_nil(WLList, argv[2], 2);
|
|
from = ((WOOL_Number) argv[0]) -> number;
|
|
to = ((WOOL_Number) argv[1]) -> number;
|
|
if (from >= to)
|
|
return NIL;
|
|
newlist = wool_list_make(to - from);
|
|
for (i = 0; i < newlist -> size; i++)
|
|
if (i + from < argv[2] -> size) {
|
|
increase_reference(newlist -> list[i] =
|
|
argv[2] -> list[i + from]);
|
|
} else {
|
|
increase_reference(newlist -> list[i] = NIL);
|
|
}
|
|
return (WOOL_OBJECT) newlist;
|
|
}
|
|
|
|
|
|
WOOL_OBJECT
|
|
WLList_concat(argc,argv)
|
|
int argc;
|
|
WOOL_List argv[];
|
|
{
|
|
WOOL_List newlist;
|
|
int i, newsize = 0, size;
|
|
|
|
for (i = 0; i < argc; i++) {
|
|
must_be_or_nil(WLList, argv[i], i);
|
|
newsize += ((argv[i] == (WOOL_List) NIL) ? 0 : argv[i] -> size);
|
|
}
|
|
if (!newsize)
|
|
return NIL;
|
|
newlist = wool_list_make(newsize);
|
|
newsize = 0;
|
|
for (i = 0; i < argc; i++) {
|
|
if (size = ((argv[i] == (WOOL_List) NIL) ? 0 : argv[i] -> size))
|
|
copy_n_objects(argv[i] -> list, &(newlist -> list)[newsize],
|
|
size);
|
|
newsize += size;
|
|
}
|
|
return (WOOL_OBJECT) newlist;
|
|
}
|
|
|
|
WOOL_List
|
|
WLList_physically_append(list, key, value)
|
|
WOOL_List list;
|
|
WOOL_OBJECT key;
|
|
WOOL_OBJECT value;
|
|
{
|
|
WOOL_List old_list = list;
|
|
|
|
if (key -> type == WLNumber) {
|
|
list = (WOOL_List) Realloc(list, sizeof(struct _WOOL_List) +
|
|
list -> size * sizeof(WOOL_OBJECT));
|
|
} else {
|
|
list = (WOOL_List) Realloc(list, sizeof(struct _WOOL_List) +
|
|
(list -> size + 1) * sizeof(WOOL_OBJECT));
|
|
increase_reference(list -> list[list -> size] = key);
|
|
list -> size ++;
|
|
}
|
|
increase_reference(list -> list[list -> size] = value);
|
|
list -> size ++;
|
|
if (list != old_list && !(REF(list) & 1)) { /* old list was in zrt! */
|
|
zrt_replace_element(old_list, list);
|
|
}
|
|
return list;
|
|
}
|
|
|
|
|
|
int
|
|
WLList_length(list)
|
|
WOOL_List list;
|
|
{
|
|
if (list == (WOOL_List) NIL)
|
|
return 0;
|
|
else
|
|
return list -> size;
|
|
}
|
|
|
|
/*
|
|
* (# n list) gives n-th element (nil if out bounds) returns obj
|
|
* (# n list obj) sets n-th element (increasing size if needed) returns
|
|
* newlist
|
|
* referencing via an atom is like giving the n tof the position after atom
|
|
* list can also be an atom or a wob
|
|
*/
|
|
|
|
#ifdef GWM
|
|
#include "EXTERN.h"
|
|
#include "gwm.h" /* TO_DO remove and treat as method */
|
|
#endif /* GWM */
|
|
|
|
WOOL_OBJECT
|
|
WLList_nth(argc, argv)
|
|
int argc;
|
|
WOOL_List argv[];
|
|
{
|
|
WOOL_List newlist, list;
|
|
int size, newsize, i;
|
|
int position, symbolic = 0;
|
|
|
|
if (argc < 2 || argc > 3)
|
|
return wool_error(BAD_NUMBER_OF_ARGS, argc);
|
|
if (argv[1] -> type == WLList || argv[1] == (WOOL_List) NIL) {
|
|
list = argv[1];
|
|
#ifdef GWM
|
|
} else if (argv[1] -> type == WLNumber) { /* WOB */
|
|
if (!WobIsValid(((WOOL_Number) argv[1]) -> number)
|
|
|| !((Wob) ((WOOL_Number) argv[1])->number) -> property)
|
|
return NIL;
|
|
list = (WOOL_List)
|
|
((Wob) ((WOOL_Number) argv[1]) -> number) -> property;
|
|
#endif /* GWM */
|
|
} else if (argv[1] -> type == WLAtom || argv[1] -> type == WLName) {
|
|
list = (WOOL_List) WOOL_send(WOOL_eval, argv[1], (argv[1]));
|
|
must_be_or_nil(WLList, list, 1);
|
|
} else {
|
|
bad_argument(argv[1], 1, "list or pointer to list");
|
|
}
|
|
|
|
size = (list == (WOOL_List) NIL ? 0 : list -> size);
|
|
if (argv[0] -> type == WLNumber)
|
|
position = ((WOOL_Number) argv[0]) -> number;
|
|
else {
|
|
symbolic = 1;
|
|
position = size + 1;
|
|
for (i = 0; i < size; i++) {
|
|
if (argv[0] == (WOOL_List) list -> list[i]) {
|
|
position = i + 1;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
|
|
if (argc == 2) { /* GET */
|
|
if (position < 0 || position >= size)
|
|
return NIL;
|
|
else
|
|
return (list) -> list[position];
|
|
|
|
} else { /* SET */
|
|
newsize = Max(size, position + 1);
|
|
newlist = wool_list_make(newsize);
|
|
if (size)
|
|
copy_n_objects(&(list -> list)[0], newlist -> list, size);
|
|
if (newsize > size) {
|
|
for (i = size; i < newsize - symbolic; i++)
|
|
increase_reference(newlist -> list[i] = NIL);
|
|
} else {
|
|
decrease_reference(newlist -> list[position]);
|
|
}
|
|
if (symbolic) {
|
|
if (size < position)
|
|
increase_reference(newlist -> list[position - 1] =
|
|
(WOOL_OBJECT) argv[0]);
|
|
increase_reference(newlist -> list[position] =
|
|
(WOOL_OBJECT) argv[2]);
|
|
} else {
|
|
increase_reference(newlist -> list[position] =
|
|
(WOOL_OBJECT) argv[2]);
|
|
}
|
|
return (WOOL_OBJECT) newlist;
|
|
}
|
|
}
|
|
|
|
/* physical replacement of an element of a list
|
|
* succeeds only if there is room, else returns ()
|
|
* returns list
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_replace_nth(argc, argv)
|
|
int argc;
|
|
WOOL_List argv[];
|
|
{
|
|
int size, i;
|
|
int position = 0;
|
|
WOOL_List list, *list_ptr;
|
|
|
|
if (argc != 3)
|
|
return wool_error(BAD_NUMBER_OF_ARGS, argc);
|
|
if (argv[1] -> type == WLList || argv[1] == (WOOL_List) NIL) {
|
|
list = argv[1];
|
|
list_ptr = NULL;
|
|
#ifdef GWM
|
|
} else if (argv[1] -> type == WLNumber) {/* WOB */
|
|
if (!WobIsValid(((WOOL_Number) argv[1]) -> number)
|
|
|| !((Wob) ((WOOL_Number) argv[1])->number) -> property)
|
|
return NIL;
|
|
list_ptr = (WOOL_List*)&
|
|
((Wob) ((WOOL_Number) argv[1])->number) -> property;
|
|
list = *list_ptr;
|
|
must_be_or_nil(WLList, list, 1);
|
|
#endif /* GWM */
|
|
} else if (argv[1] -> type == WLAtom) {
|
|
list_ptr = (WOOL_List*)& ((WOOL_Atom) argv[1])->c_val;
|
|
list = *list_ptr;
|
|
must_be_or_nil(WLList, list, 1);
|
|
} else if (argv[1] -> type == WLName) {
|
|
list_ptr = (WOOL_List *) WLName_slot(argv[1]);
|
|
list = *list_ptr;
|
|
must_be_or_nil(WLList, list, 1);
|
|
} else {
|
|
bad_argument(argv[1], 1, "list or pointer to list");
|
|
}
|
|
|
|
size = (list == (WOOL_List) NIL ? 0 : list -> size);
|
|
if (argv[0] -> type == WLNumber)
|
|
position = Max(0, ((WOOL_Number) argv[0]) -> number);
|
|
else {
|
|
position = size + 1;
|
|
for (i = 0; i < size; i++) {
|
|
if (argv[0] == (WOOL_List) list -> list[i]) {
|
|
position = i + 1;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
|
|
if (position >= size) { /* increase size */
|
|
if (list_ptr) {
|
|
if (REF(list) >= 4) {/* 2 or more objs point to it */
|
|
decrease_reference(list);
|
|
increase_reference(*list_ptr = list =
|
|
(WOOL_List) WLList_nth(argc, argv));
|
|
} else { /* pointed by one object */
|
|
*list_ptr = list =
|
|
WLList_physically_append(list, argv[0], argv[2]);
|
|
}
|
|
} else { /* cannot resize a non-pointed to list */
|
|
wool_error("Could not modify %s\n", "list");
|
|
}
|
|
} else { /* replace an existing element */
|
|
if (list_ptr && REF(list) >= 4) { /* duplicate first */
|
|
decrease_reference(list);
|
|
increase_reference(*list_ptr = list =
|
|
(WOOL_List) WLList_nth(argc, argv));
|
|
} else { /* physical modif */
|
|
decrease_reference(list -> list[position]);
|
|
increase_reference(list -> list[position]
|
|
= (WOOL_OBJECT) argv[2]);
|
|
}
|
|
}
|
|
return (WOOL_OBJECT) list;
|
|
}
|
|
|
|
/* physical deletion of an element of a list
|
|
* succeeds only if there is room, else returns ()
|
|
* returns list
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_delete_nth(key, wl_list)
|
|
WOOL_OBJECT key;
|
|
WOOL_List wl_list;
|
|
{
|
|
int size, i;
|
|
int position = 0;
|
|
WOOL_List list, *list_ptr;
|
|
|
|
if (wl_list -> type == WLList || wl_list == (WOOL_List) NIL) {
|
|
list = wl_list;
|
|
list_ptr = NULL;
|
|
#ifdef GWM
|
|
} else if (wl_list -> type == WLNumber) {/* WOB */
|
|
if (!WobIsValid(((WOOL_Number) wl_list) -> number)
|
|
|| !((Wob) ((WOOL_Number) wl_list)->number) -> property)
|
|
return NIL;
|
|
list_ptr = (WOOL_List*)&
|
|
((Wob) ((WOOL_Number) wl_list) -> number) -> property;
|
|
list = *list_ptr;
|
|
must_be_or_nil(WLList, list, 1);
|
|
#endif /* GWM */
|
|
} else if (wl_list -> type == WLAtom) {
|
|
list_ptr = (WOOL_List*) & ((WOOL_Atom) wl_list) -> c_val;
|
|
list = *list_ptr;
|
|
must_be_or_nil(WLList, list, 1);
|
|
} else if (wl_list -> type == WLName) {
|
|
list_ptr = (WOOL_List *) WLName_slot(wl_list);
|
|
list = *list_ptr;
|
|
must_be_or_nil(WLList, list, 1);
|
|
} else {
|
|
bad_argument(wl_list, 1, "list or pointer to list");
|
|
}
|
|
|
|
size = (list == (WOOL_List) NIL ? 0 : list -> size);
|
|
if (key -> type == WLNumber)
|
|
position = Max(0, ((WOOL_Number) key) -> number);
|
|
else {
|
|
position = size + 1;
|
|
for (i = 0; i < size; i++) {
|
|
if (key == list -> list[i]) {
|
|
position = i + 1;
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
|
|
if (position < size) { /* increase size */
|
|
if (list_ptr && REF(list) >= 4) { /* duplicate first */
|
|
decrease_reference(list);
|
|
increase_reference(*list_ptr = list =
|
|
(WOOL_List) WLList_copy(list));
|
|
}
|
|
/* delete elements */
|
|
{
|
|
int i;
|
|
int number = (key -> type == WLNumber ? 1 : 2);
|
|
|
|
decrease_reference(list -> list[position - number + 1]);
|
|
list -> size -= number;
|
|
for (i = position - number + 1; i < list -> size; i++)
|
|
list -> list[i] = list -> list[i + number];
|
|
}
|
|
}
|
|
if (list -> size)
|
|
return (WOOL_OBJECT) list;
|
|
else
|
|
return NIL;
|
|
}
|
|
|
|
/* the quicksort of a list
|
|
*/
|
|
|
|
static WOOL_List WLList_qsort_compare_call;
|
|
#ifdef PROTOTYPES
|
|
/* correct typing for the actual call to qsort */
|
|
typedef int (*WLListQsortCompareFuncType) (const void *, const void *);
|
|
#endif
|
|
|
|
int
|
|
WLList_qsort_compare_func(o1, o2)
|
|
WOOL_OBJECT *o1, *o2;
|
|
{
|
|
WOOL_Number wl_num;
|
|
|
|
WLList_qsort_compare_call -> list[1] = *o1;
|
|
WLList_qsort_compare_call -> list[2] = *o2;
|
|
wl_num = (WOOL_Number) WOOL_send(WOOL_execute,
|
|
(WLList_qsort_compare_call -> list[0]),
|
|
(WLList_qsort_compare_call -> list[0], WLList_qsort_compare_call));
|
|
|
|
if (wl_num -> type != WLNumber)
|
|
wool_error("sort compare function must return a number, not a %s",
|
|
((WOOL_Atom) wl_num -> type[0]) -> p_name);
|
|
return wl_num -> number;
|
|
}
|
|
|
|
WOOL_OBJECT
|
|
WLList_qsort(list, compare_func)
|
|
WOOL_List list;
|
|
WOOL_OBJECT compare_func; /* any function */
|
|
{
|
|
if (list->type != WLList)
|
|
return NIL;
|
|
if (!WLList_qsort_compare_call) {
|
|
increase_reference(WLList_qsort_compare_call = wool_list_make(3));
|
|
}
|
|
WLList_qsort_compare_call -> list[0] = compare_func;
|
|
qsort((char *) list -> list, list ->size, sizeof(WOOL_OBJECT),
|
|
#ifdef PROTOTYPES
|
|
(WLListQsortCompareFuncType)
|
|
#endif
|
|
WLList_qsort_compare_func);
|
|
return (WOOL_OBJECT) list;
|
|
}
|
|
|
|
/* copy of a list (but not of its elements)
|
|
*/
|
|
|
|
WOOL_OBJECT
|
|
WLList_copy(list)
|
|
WOOL_List list;
|
|
{
|
|
if (list -> type != WLList) /* copy of () = () */
|
|
return (WOOL_OBJECT) list;
|
|
else { /* normal case */
|
|
WOOL_List wl_list;
|
|
int i;
|
|
|
|
wl_list = (WOOL_List) Malloc(sizeof(struct _WOOL_List) +
|
|
(list -> size - 1) * sizeof(WOOL_OBJECT));
|
|
zrt_put(wl_list);
|
|
wl_list -> type = WLList;
|
|
wl_list -> size = list -> size;
|
|
for (i = 0; i < list -> size; i++)
|
|
increase_reference(wl_list -> list[i] = list -> list[i]);
|
|
return (WOOL_OBJECT) wl_list;
|
|
}
|
|
}
|