void div_tree(bintree_t * bt, FILE * out) {
list_t * cvecs = bt_get_data(bt);
int32_t split = split_by(cvecs);
list_t * cvecs_l = NULL;
list_t * cvecs_r = NULL;
list_t * tmp = cvecs;
while (tmp != NULL) {
void * addr = list_head(tmp);
int32_t * cvec = (int32_t*)addr;
if (cvec[split+1]) {
cvecs_l = list_cons(cvecs_l, addr);
} else {
cvecs_r = list_cons(cvecs_r, addr);
}
tmp = list_tail(tmp);
}
if (cvecs_l == NULL || cvecs_r == NULL) {
return;
}
bt_insl(bt, cvecs_l);
bt_insr(bt, cvecs_r);
void * a1 = bt;
void * a2 = bt_get_left(bt);
void * a3 = bt_get_right(bt);
fprintf(out, "\"%p\"->\"%p\",\n", a1, a2);
fprintf(out, "\"%p\"->\"%p\",\n", a1, a3);
div_tree(bt_get_left(bt), out);
div_tree(bt_get_right(bt), out);
}
void pq_enqueue(pq_t * pq, void * obj) {
assert(pq != NULL);
if (pq->list == NULL || pq->cmp(obj, list_head(pq->list))) {
pq->list = list_cons(pq->list, obj);
pq->sz_lst++;
return;
}
list_t * tmp = list_init();
list_t * prev = tmp;
prev->tail = pq->list;
list_t * next = pq->list;
while (true) {
if (next == NULL || pq->cmp(obj, list_head(next))) {
prev->tail = list_cons(next, obj);
free(tmp);
pq->sz_lst++;
return;
}
prev = next;
next = list_tail(next);
}
}
static value_t *e_listcons(env_t *env, expr_t *expr)
{
value_t *result;
value_t *head;
value_t *tail;
head = e_expr(env, binary_left(expr));
tail = e_expr(env, binary_right(expr));
result = alloc_value(v_datacons);
datacons_tag(result) = listConsTag;
datacons_params(result) = list_cons(head, list_cons(tail, list_empty()));
return result;
}
int test(struct IridiumContext * context) {
struct list * l = list_new(5);
assertEqual(list_tail(list_cons(l, 7)), l);
return 0;
}
static value_t *e_listcons(env_t *env, expr_t *expr)
{
value_t *result;
value_t *head;
value_t *tail;
// "CONS should not evaluate its arguments."
head = thunk_create(env, binary_left(expr));
tail = thunk_create(env, binary_right(expr));
result = alloc_value(v_datacons);
datacons_tag(result) = listConsTag;
datacons_params(result) = list_cons(head, list_cons(tail, list_empty()));
return result;
}
static void destructure(struct Orb_priv_each_s* es, Orb_t s) {
for(;;) {
/*first check if array-backed*/
size_t start, sz;
if(Orb_array_backed(s, &es->backer, &start, &sz)) {
es->ptr = es->backer + start;
es->end = es->backer + start + sz;
return;
}
/*now destructure*/
Orb_t single;
Orb_t l, r;
switch(Orb_seq_decompose(s, &single, &l, &r)) {
case 0:
/*nothing to scan*/
es->backer = es->ptr = es->end = 0;
return;
case 1:
/*one item, store in one_value and have the pointers
point to it
*/
es->one_value = single;
es->backer = es->ptr = &es->one_value;
es->end = es->ptr + 1;
return;
case 2:
/*two subsequences, push the right one on the stack*/
es->stack = list_cons(r, es->stack);
/*and go to the left*/
s = l;
}
}
}
// Note the list is reversed, by construction.
static int thunk_list_i(void *data, void *info)
{
eli_closure_t *c = (eli_closure_t *)info;
expr_t *expr = (expr_t *)data;
list_cons(thunk_create(c->env, expr), c->list);
return 1;
}
// Note the list is reversed, by construction.
static int e_expr_list_i(void *data, void *info)
{
eli_closure_t *c = (eli_closure_t *)info;
expr_t *expr = (expr_t *)data;
list_cons(e_expr(c->env, expr), c->list);
return 1;
}
// FIXME this is pretty ugly.
static value_t *e_listlit_rec(env_t *env, list_t *exprs, int i, int limit)
{
value_t *result;
if (i < limit) {
value_t *list_elt = thunk_create(env, list_nth(exprs, i));
result = alloc_value(v_datacons);
datacons_tag(result) = listConsTag;
datacons_params(result) = list_cons(list_elt,
list_cons(e_listlit_rec(env, exprs, i + 1, limit),
list_empty()));
} else {
result = alloc_value(v_datacons);
datacons_tag(result) = listEmptyTag;
datacons_params(result) = list_empty();
}
return result;
}
static List list_files(const char *path)
{
List list = NULL;
char **files, **file;
if ((files = PHYSFS_enumerateFiles(path)))
{
for (file = files; *file; file++)
list = list_cons(strdup(*file), list);
PHYSFS_freeList(files);
}
return list;
}
static void sol_cmd_enq_deferred(void)
{
List l, r;
/* Reverse the list to preserve original command order. */
for (r = NULL, l = deferred_cmds;
l;
r = list_cons(l->data, r), l = list_rest(l));
/* Enqueue commands. */
for (; r; r = list_rest(r))
{
if (cmd_enq_fn)
cmd_enq_fn(r->data);
free(r->data);
}
deferred_cmds = NULL;
}