/*
* %CopyrightBegin%
*
* Copyright Ericsson AB 1999-2009. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
* compliance with the License. You should have received a copy of the
* Erlang Public License along with this software. If not, it can be
* retrieved online at http://www.erlang.org/.
*
* Software distributed under the License is distributed on an "AS IS"
* basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
* the License for the specific language governing rights and limitations
* under the License.
*
* %CopyrightEnd%
*/
/*
* BIFs logically belonging to the lists module.
*/
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
#include "sys.h"
#include "erl_vm.h"
#include "global.h"
#include "erl_process.h"
#include "error.h"
#include "bif.h"
static Eterm keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List);
/*
* erlang:'++'/2
*/
Eterm
ebif_plusplus_2(Process* p, Eterm A, Eterm B)
{
return append_2(p, A, B);
}
/*
* erlang:'--'/2
*/
Eterm
ebif_minusminus_2(Process* p, Eterm A, Eterm B)
{
return subtract_2(p, A, B);
}
BIF_RETTYPE append_2(BIF_ALIST_2)
{
Eterm list;
Eterm copy;
Eterm last;
size_t need;
Eterm* hp;
int i;
if ((i = list_length(BIF_ARG_1)) < 0) {
BIF_ERROR(BIF_P, BADARG);
}
if (i == 0) {
BIF_RET(BIF_ARG_2);
} else if (is_nil(BIF_ARG_2)) {
BIF_RET(BIF_ARG_1);
}
need = 2*i;
hp = HAlloc(BIF_P, need);
list = BIF_ARG_1;
copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2));
list = CDR(list_val(list));
hp += 2;
i--;
while(i--) {
Eterm* listp = list_val(list);
last = CONS(hp, CAR(listp), make_list(hp+2));
list = CDR(listp);
hp += 2;
}
CDR(list_val(last)) = BIF_ARG_2;
BIF_RET(copy);
}
BIF_RETTYPE subtract_2(BIF_ALIST_2)
{
Eterm list;
Eterm* hp;
Uint need;
Eterm res;
Eterm small_vec[10]; /* Preallocated memory for small lists */
Eterm* vec_p;
Eterm* vp;
int i;
int n;
int m;
if ((n = list_length(BIF_ARG_1)) < 0) {
BIF_ERROR(BIF_P, BADARG);
}
if ((m = list_length(BIF_ARG_2)) < 0) {
BIF_ERROR(BIF_P, BADARG);
}
if (n == 0)
BIF_RET(NIL);
if (m == 0)
BIF_RET(BIF_ARG_1);
/* allocate element vector */
if (n <= sizeof(small_vec)/sizeof(small_vec[0]))
vec_p = small_vec;
else
vec_p = (Eterm*) erts_alloc(ERTS_ALC_T_TMP, n * sizeof(Eterm));
/* PUT ALL ELEMENTS IN VP */
vp = vec_p;
list = BIF_ARG_1;
i = n;
while(i--) {
Eterm* listp = list_val(list);
*vp++ = CAR(listp);
list = CDR(listp);
}
/* UNMARK ALL DELETED CELLS */
list = BIF_ARG_2;
m = 0; /* number of deleted elements */
while(is_list(list)) {
Eterm* listp = list_val(list);
Eterm elem = CAR(listp);
i = n;
vp = vec_p;
while(i--) {
if (is_value(*vp) && eq(*vp, elem)) {
*vp = THE_NON_VALUE;
m++;
break;
}
vp++;
}
list = CDR(listp);
}
if (m == n) /* All deleted ? */
res = NIL;
else if (m == 0) /* None deleted ? */
res = BIF_ARG_1;
else { /* REBUILD LIST */
res = NIL;
need = 2*(n - m);
hp = HAlloc(BIF_P, need);
vp = vec_p + n - 1;
while(vp >= vec_p) {
if (is_value(*vp)) {
res = CONS(hp, *vp, res);
hp += 2;
}
vp--;
}
}
if (vec_p != small_vec)
erts_free(ERTS_ALC_T_TMP, (void *) vec_p);
BIF_RET(res);
}
BIF_RETTYPE lists_member_2(BIF_ALIST_2)
{
Eterm term;
Eterm list;
Eterm item;
int non_immed_key;
int max_iter = 10 * CONTEXT_REDS;
if (is_nil(BIF_ARG_2)) {
BIF_RET(am_false);
} else if (is_not_list(BIF_ARG_2)) {
BIF_ERROR(BIF_P, BADARG);
}
term = BIF_ARG_1;
non_immed_key = is_not_immed(term);
list = BIF_ARG_2;
while (is_list(list)) {
if (--max_iter < 0) {
BUMP_ALL_REDS(BIF_P);
BIF_TRAP2(bif_export[BIF_lists_member_2], BIF_P, term, list);
}
item = CAR(list_val(list));
if ((item == term) || (non_immed_key && eq(item, term))) {
BIF_RET2(am_true, CONTEXT_REDS - max_iter/10);
}
list = CDR(list_val(list));
}
if (is_not_nil(list)) {
BIF_ERROR(BIF_P, BADARG);
}
BIF_RET2(am_false, CONTEXT_REDS - max_iter/10);
}
BIF_RETTYPE lists_reverse_2(BIF_ALIST_2)
{
Eterm list;
Eterm tmp_list;
Eterm result;
Eterm* hp;
Uint n;
int max_iter;
/*
* Handle legal and illegal non-lists quickly.
*/
if (is_nil(BIF_ARG_1)) {
BIF_RET(BIF_ARG_2);
} else if (is_not_list(BIF_ARG_1)) {
error:
BIF_ERROR(BIF_P, BADARG);
}
/*
* First use the rest of the remaning heap space.
*/
list = BIF_ARG_1;
result = BIF_ARG_2;
hp = HEAP_TOP(BIF_P);
n = HeapWordsLeft(BIF_P) / 2;
while (n != 0 && is_list(list)) {
Eterm* pair = list_val(list);
result = CONS(hp, CAR(pair), result);
list = CDR(pair);
hp += 2;
n--;
}
HEAP_TOP(BIF_P) = hp;
if (is_nil(list)) {
BIF_RET(result);
}
/*
* Calculate length of remaining list (up to a suitable limit).
*/
max_iter = CONTEXT_REDS * 40;
n = 0;
tmp_list = list;
while (max_iter-- > 0 && is_list(tmp_list)) {
tmp_list = CDR(list_val(tmp_list));
n++;
}
if (is_not_nil(tmp_list) && is_not_list(tmp_list)) {
goto error;
}
/*
* Now do one HAlloc() and continue reversing.
*/
hp = HAlloc(BIF_P, 2*n);
while (n != 0 && is_list(list)) {
Eterm* pair = list_val(list);
result = CONS(hp, CAR(pair), result);
list = CDR(pair);
hp += 2;
n--;
}
if (is_nil(list)) {
BIF_RET(result);
} else {
BUMP_ALL_REDS(BIF_P);
BIF_TRAP2(bif_export[BIF_lists_reverse_2], BIF_P, list, result);
}
}
BIF_RETTYPE
lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
{
Eterm res;
res = keyfind(BIF_lists_keymember_3, p, Key, Pos, List);
if (is_value(res) && is_tuple(res)) {
return am_true;
} else {
return res;
}
}
BIF_RETTYPE
lists_keysearch_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
{
Eterm res;
res = keyfind(BIF_lists_keysearch_3, p, Key, Pos, List);
if (is_non_value(res) || is_not_tuple(res)) {
return res;
} else { /* Tuple */
Eterm* hp = HAlloc(p, 3);
return TUPLE2(hp, am_value, res);
}
}
BIF_RETTYPE
lists_keyfind_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
{
return keyfind(BIF_lists_keyfind_3, p, Key, Pos, List);
}
static Eterm
keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List)
{
int max_iter = 10 * CONTEXT_REDS;
Sint pos;
Eterm term;
if (!is_small(Pos) || (pos = signed_val(Pos)) < 1) {
BIF_ERROR(p, BADARG);
}
if (is_small(Key)) {
double float_key = (double) signed_val(Key);
while (is_list(List)) {
if (--max_iter < 0) {
BUMP_ALL_REDS(p);
BIF_TRAP3(bif_export[Bif], p, Key, Pos, List);
}
term = CAR(list_val(List));
List = CDR(list_val(List));
if (is_tuple(term)) {
Eterm *tuple_ptr = tuple_val(term);
if (pos <= arityval(*tuple_ptr)) {
Eterm element = tuple_ptr[pos];
if (Key == element) {
return term;
} else if (is_float(element)) {
FloatDef f;
GET_DOUBLE(element, f);
if (f.fd == float_key) {
return term;
}
}
}
}
}
} else if (is_immed(Key)) {
while (is_list(List)) {
if (--max_iter < 0) {
BUMP_ALL_REDS(p);
BIF_TRAP3(bif_export[Bif], p, Key, Pos, List);
}
term = CAR(list_val(List));
List = CDR(list_val(List));
if (is_tuple(term)) {
Eterm *tuple_ptr = tuple_val(term);
if (pos <= arityval(*tuple_ptr)) {
Eterm element = tuple_ptr[pos];
if (Key == element) {
return term;
}
}
}
}
} else {
while (is_list(List)) {
if (--max_iter < 0) {
BUMP_ALL_REDS(p);
BIF_TRAP3(bif_export[Bif], p, Key, Pos, List);
}
term = CAR(list_val(List));
List = CDR(list_val(List));
if (is_tuple(term)) {
Eterm *tuple_ptr = tuple_val(term);
if (pos <= arityval(*tuple_ptr)) {
Eterm element = tuple_ptr[pos];
if (cmp(Key, element) == 0) {
return term;
}
}
}
}
}
if (is_not_nil(List)) {
BIF_ERROR(p, BADARG);
}
return am_false;
}
