YLIST Ylist_create()
{
YLIST list = allocate_list();
list->comp = def_comp;
return list;
} /* Ylist_create */
static int pop_as_list_internal (unsigned int count)
{
SLang_List_Type *list;
if (NULL == (list = allocate_list (count)))
return -1;
while (count)
{
SLang_Object_Type obj;
if (-1 == SLang_pop (&obj))
goto return_error;
if (-1 == insert_element (list, &obj, 0))
{
SLang_free_object (&obj);
goto return_error;
}
count--;
}
return push_list (list, 1);
return_error:
free_list (list);
return -1;
}
static void list_new (void)
{
SLang_List_Type *list;
int len = DEFAULT_CHUNK_SIZE;
if (SLang_Num_Function_Args == 1)
{
if (-1 == SLang_pop_integer (&len))
return;
if (len <= 0) len = DEFAULT_CHUNK_SIZE;
}
if (NULL == (list = allocate_list (len)))
return;
(void) push_list (list, 1);
}
/* FIXME: This is currently used only by list_dereference and breaks on an
* empty list. For this reason, it would probably fail in other contexts.
*/
static SLang_List_Type *make_sublist (SLang_List_Type *list, SLindex_Type indx_a, SLindex_Type length)
{
SLang_List_Type *new_list;
Chunk_Type *c, *new_c;
SLindex_Type i;
SLang_Object_Type *obj, *obj_max, *new_obj, *new_obj_max;
if (length == 0)
return allocate_list (0);
if ((indx_a < 0) || (indx_a + (length - 1) >= list->length))
{
_pSLang_verror (SL_Index_Error, "Indices are out of range for list object");
return NULL;
}
if (NULL == (new_list = allocate_list (length)))
return NULL;
if (-1 == make_chunk_chain (length, &new_list->first, &new_list->last, list->default_chunk_size))
{
free_list (new_list);
return NULL;
}
obj = find_nth_element (list, indx_a, &c);
if (obj == NULL)
{
free_list (new_list);
return NULL;
}
obj_max = c->elements + c->num_elements;
new_list->length = length;
new_c = new_list->first;
new_obj = new_c->elements;
new_obj_max = new_obj + new_c->chunk_size;
for (i = 0; i < length; i++)
{
while (obj == obj_max)
{
c = c->next;
obj = c->elements;
obj_max = obj + c->num_elements;
}
if (new_obj == new_obj_max)
{
new_c = new_c->next;
new_obj = new_c->elements;
new_obj_max = new_obj + new_c->chunk_size;
}
if ((-1 == _pSLpush_slang_obj (obj))
|| (-1 == SLang_pop (new_obj)))
{
free_list (new_list);
return NULL;
}
new_c->num_elements++;
obj++;
new_obj++;
}
return new_list;
}
SLang_List_Type *SLang_create_list (SLindex_Type chunk_size)
{
return allocate_list (chunk_size);
}
/* FIXME: Extend this to allow an index array */
static int _pSLlist_aget (SLtype type, unsigned int num_indices)
{
SLang_List_Type *list, *new_list;
SLang_Object_Type *obj;
SLang_Array_Type *ind_at;
SLindex_Type indx, *idx_data;
SLuindex_Type i, num;
int ret;
(void) type;
if (-1 == pop_list_and_index (num_indices, &list, &ind_at, &indx))
return -1;
ret = -1;
if (ind_at == NULL)
{
obj = find_nth_element (list, indx, NULL);
if (obj != NULL)
ret = _pSLpush_slang_obj (obj);
free_list (list);
return ret;
}
num = ind_at->num_elements;
if (NULL == (new_list = allocate_list (num)))
goto free_and_return;
idx_data = (SLindex_Type *)ind_at->data;
for (i = 0; i < num; i++)
{
SLang_Object_Type *obja;
SLang_Object_Type objb;
indx = idx_data[i];
if (NULL == (obja = find_nth_element (list, idx_data[i], NULL)))
goto free_and_return;
if (-1 == _pSLslang_copy_obj (obja, &objb))
goto free_and_return;
if (-1 == insert_element (new_list, &objb, i))
{
SLang_free_object (&objb);
goto free_and_return;
}
}
ret = push_list (new_list, 1); /* frees upon error */
new_list = NULL;
free_and_return:
if (new_list != NULL)
free_list (new_list);
free_list (list);
SLang_free_array (ind_at);
return ret;
}
