예제 #1
0
파일: list_util.c 프로젝트: EarlGray/ling
//
// Flatten the valid iolist to the buffer of
// appropriate size pointed to by ptr
//
uint8_t *iolist_flatten(term_t l, uint8_t *ptr)
{
	if (is_nil(l))
		return ptr;

	if (is_cons(l))
	{
		do {
			uint32_t *term_data = peel_cons(l);
			term_t e = term_data[0];
			if (is_int(e))
				*ptr++ = int_value(e);
			else
			{
				assert(is_list(e) || (is_boxed(e) && is_binary(peel_boxed(e))));
				ptr = iolist_flatten(e, ptr);
			}
			l = term_data[1];
			if (is_boxed(l) && is_binary(peel_boxed(l)))
				return iolist_flatten(l, ptr);
		} while (is_cons(l));

		assert(is_nil(l));
	}
	else // is_binary()
	{
		bits_t bs, to;
		bits_get_real(peel_boxed(l), &bs);
		bits_init_buf(ptr, (bs.ends +7) /8, &to);
		ptr += (bs.ends - bs.starts) /8;
		bits_copy(&bs, &to);
		assert(bs.starts == bs.ends);
	}
	return ptr;
}
예제 #2
0
파일: alm_debug.c 프로젝트: garazdawi/alm
int alm_print_term(ATERM t) {
    int count = 0;
    if (is_num(t))
	count += printf("%.1lf", num_val(t));
    else if (is_nil(t))
	count += printf("[]");
    else if (is_cons(t)) {
	count += printf("[");
	ATERM tmp = t;
	while (is_cons(tmp)) {
	    count += alm_print_term(CAR(tmp));
	    if (is_cons(CDR(tmp))) {
		count += printf(",");
	    } else if (!is_nil(CDR(tmp))) {
		count += printf("|");
		count += alm_print_term(CDR(tmp));
	    }
	    tmp = CDR(tmp);
	}
	count += printf("]");
    } else if (is_boxed(t)) {
	ATERM *box = boxed_ptr(t);
	if (is_atom(*box))
	    count += printf("%.*s", (int) box[1].bin, (char*) (box + 2));
    } else if (is_frame(t)) {
	count += printf("<frame/0x%.3llX>",frame_val(t));
    }
    return count;
}
예제 #3
0
파일: bif_binary.c 프로젝트: EarlGray/ling
static term_t compile_pattern(term_t pat, heap_t *hp)
{
	term_t result = nil;
	if (is_cons(pat))
	{
		term_t l = pat;
		do {
			term_t *cons = peel_cons(l);
			if (!is_boxed_binary(cons[0]))
				return A_BADARG;
			term_t ctx = do_compile_pattern(cons[0], hp);
			if (is_atom(ctx))
				return ctx;

			result = heap_cons(hp, ctx, result);
			l = cons[1];
		} while (is_cons(l));

		if (l != nil)
			return A_BADARG;
	}
	else if is_boxed_binary(pat)
	{
		term_t ctx = do_compile_pattern(pat, hp);
		if (is_atom(ctx))
			return ctx;

		result = heap_cons(hp, ctx, result);
	}
	else
		return A_BADARG;
예제 #4
0
파일: gc.c 프로젝트: neosam/moelisp
static void gc_traverse(pobject env)
{
    pobject object;
    while (is_cons(env)) {
        gc_flag_set(env, GC_FLAG_ON);
        object = cons_car(env);
        if (object && (gc_flag_get(object) == 0)) {
            /*
            printf("%p\n", object);
            */
            gc_flag_set(object, GC_FLAG_ON);

            /* XXX: dotted list support??? */
            if (is_cons(object)) {
                gc_traverse(object);
            } else if (is_closure(object)) {
                gc_traverse(object->data.closure.env);
                gc_traverse(object->data.closure.code);
            } else if (is_macro(object)) {
                gc_traverse(object->data.macro.env);
                gc_traverse(object->data.macro.code);
            }

        }
        env = cons_cdr(env);
    }
}
예제 #5
0
파일: list_util.c 프로젝트: EarlGray/ling
static int64_t iolist_size2(int depth, term_t l)
{
	if (depth > IOLIST_MAX_DEPTH)
		return -TOO_DEEP;

	if (is_nil(l))
		return 0;

	if (is_cons(l))
	{
		int64_t size = 0;
		do {
			uint32_t *term_data = peel_cons(l);
			term_t e = term_data[0];
			if (is_int(e))
			{
				if (int_value(e) < 0 || int_value(e) > 255)
					return -BAD_ARG;
				size++;
			}
			else
			{
				if (!is_list(e) && (!is_boxed(e) || !is_binary(peel_boxed(e))))
					return -BAD_ARG;
				int64_t s = iolist_size2(depth+1, e);
				if (s < 0)
					return s;
				size += s;
			}
			l = term_data[1];
			if (is_boxed(l) && is_binary(peel_boxed(l)))
			{
				// odd list with binary tail allowed
				int64_t s = iolist_size2(depth+1, l);
				if (s < 0)
					return s;
				return size +s;
			}	
		} while (is_cons(l));

		if (!is_nil(l))
			return -BAD_ARG;

		return size;
	}
	else if (is_boxed_binary(l))
	{
		bits_t bs;
		bits_get_real(peel_boxed(l), &bs);

		int64_t bit_size = bit_size = bs.ends - bs.starts;
		if ((bit_size & 7) != 0)
			return -1;

		return bit_size /8;
	}
	else
		return -BAD_ARG;
}
예제 #6
0
파일: list_util.c 프로젝트: EarlGray/ling
static int64_t bits_list_size2(int depth, term_t l)
{
	if (depth > BITS_LIST_MAX_DEPTH)
		return -TOO_DEEP;

	if (is_nil(l))
		return 0;

	if (is_cons(l))
	{
		int64_t size = 0;
		do {
			uint32_t *term_data = peel_cons(l);
			term_t e = term_data[0];
			if (is_int(e))
			{
				if (int_value(e) < 0 || int_value(e) > 255)
					return -BAD_ARG;
				size += 8;
			}
			else
			{
				if (!is_list(e) && (!is_boxed(e) || !is_binary(peel_boxed(e))))
					return -BAD_ARG;
				int64_t s = bits_list_size2(depth+1, e);
				if (s < 0)
					return s;
				size += s;
			}
			l = term_data[1];
			if (is_boxed(l) && is_binary(peel_boxed(l)))
			{
				// odd list with binary tail allowed
				int64_t s = bits_list_size2(depth+1, l);
				if (s < 0)
					return s;
				size += s;
				if (size > MAX_BIT_SIZE)
					return -TOO_LONG;
				return size;
			}	
		} while (is_cons(l));

		if (!is_nil(l))
			return -BAD_ARG;
		if (size > MAX_BIT_SIZE)
			return -TOO_LONG;
		return size;
	}
	else // is_binary()
	{
		bits_t bs;
		bits_get_real(peel_boxed(l), &bs);
		if (bs.ends - bs.starts > MAX_BIT_SIZE)
			return -TOO_LONG;
		return bs.ends - bs.starts;
	}
}
예제 #7
0
파일: print.c 프로젝트: jthornber/dmexec
static void print_list(FILE *stream, Value v)
{
	fprintf(stream, "(");
	while (is_cons(v)) {
		print(stream, car(v));
		v = cdr(v);
		if (is_cons(v))
			fprintf(stream, " ");
	}
	fprintf(stream, ")");
}
예제 #8
0
static pobject cond(pobject env, pobject params)
{
    while (is_cons(params)) {
        pobject entry = cons_car(params);
        if (is_cons(entry)) {
            if (eval(env, cons_car(entry)))
                return eval(env, object_prepend_begin( cons_cdr( entry ) ) );
        } else {
            return eval(env, entry);
        }
        params = cons_cdr(params);
    }

    return NIL;
}
예제 #9
0
int main(int argc, char *argv[]) {
    secd_t secd;
    cell_t *heap = (cell_t *)malloc(sizeof(cell_t) * N_CELLS);

    init_secd(&secd, heap, N_CELLS);
#if ((CTRLDEBUG) || (MEMDEBUG))
    secd_setport(&secd, SECD_STDDBG, secd_fopen(&secd, "secd.log", "w"));
#endif

    cell_t *cmdport = SECD_NIL;
    if (argc == 2)
        cmdport = secd_fopen(&secd, argv[1], "r");

    cell_t *inp = sexp_parse(&secd, cmdport); // cmdport is dropped after
    if (is_nil(inp) || !is_cons(inp)) {
        secd_errorf(&secd, "list of commands expected\n");
        dbg_printc(&secd, inp);
        return 1;
    }

    cell_t *ret;
    ret = run_secd(&secd, inp);

    return (is_error(ret) ? EXIT_FAILURE : EXIT_SUCCESS);
}
예제 #10
0
파일: code_base.c 프로젝트: aidanhs/teeterl
apr_array_header_t *source_line_blocks(term_t info, apr_pool_t *pool)
{
	apr_array_header_t *refs = apr_array_make(pool, 64, sizeof(source_ref_t));
	term_t cons = info;
	while (is_cons(cons))
	{
		term_box_t *cb = peel(cons);
		term_t t = cb->cons.head;
		//{F,L,S,E}
		if (is_tuple(t))
		{
			term_box_t *tb = peel(t);
			if (tb->tuple.size == 4)
			{
				source_ref_t *ref = &APR_ARRAY_PUSH(refs, source_ref_t);
				ref->file_index = int_value(tb->tuple.elts[0]);
				ref->source_line = int_value(tb->tuple.elts[1]);
				ref->off_starts = int_value(tb->tuple.elts[2]);
				ref->off_ends = int_value(tb->tuple.elts[3]);
			}
		}
		cons = cb->cons.tail;
	}
	return refs;
}
예제 #11
0
void free_list(list *l) {
  while (is_cons(l)) {
    free(l);
    l = l->tail;
  }
  free(l->tail);
}
예제 #12
0
	void Printer::print(LispObjRef obj) {
		if (is_nil(obj))
			output_ << "NIL";
		else if (is_fixnum(obj))
			output_ << get_ctype<FixnumType>(obj); // (CFixnum)(boost::get<FixnumType>(*obj));
		else if (is_floatnum(obj))
			output_ <<  get_ctype<FloatnumType>(obj); //(CFloatnum)(boost::get<FloatnumType>(*obj));
		else if (is_string(obj))
			output_ << "\"" << get_ctype<StringType>(obj) << "\""; // ""(CString)(boost::get<StringType>(*obj)) << "\""; 
		else if (is_symbol(obj))
			output_ << get_ctype<SymbolType>(obj).name; // static_cast<LispSymbol>(boost::get<SymbolType>(*obj)).first;
		else if (is_cons(obj)) {
			output_ << "(";
			print_cons(obj);
			output_ << ")";			
		} else if (is_char(obj)) {
			CChar c = get_ctype<CharType>(obj);
			if (isprint(c)) {
				output_ << c;				
			} else {
				output_ << "#" << std::hex << (int) c << std::dec;
			}
		}
		else
			output_ << "#UNPRINTABLE#";
	}
예제 #13
0
void print_list(list *l) {
  do {
    printf("%d :: ", l->head);
    l = l->tail;
  } while(is_cons(l));
  printf("nil\n");
}
예제 #14
0
파일: compare.c 프로젝트: MCRedJay/ling
static int is_term_smaller_1(term_t l1, term_t l2)
{
	assert(is_cons(l1) && is_cons(l2));

	do {
		term_t *cons1 = peel_cons(l1);
		term_t *cons2 = peel_cons(l2);
		if (is_term_smaller(cons1[0], cons2[0]))
			return 1;
		if (is_term_smaller(cons2[0], cons1[0]))
			return 0;
		l1 = cons1[1];
		l2 = cons2[1];
	} while (is_cons(l1) && is_cons(l2));

	return is_term_smaller(l1, l2);
}
예제 #15
0
static pobject div(pobject env, pobject params)
{
    float result = 0;
    pobject o = eval(env, cons_car(params)); 
    if (is_number(o)) {
        result = number_value(o);
        params = cons_cdr(params);
        if (is_cons(params)) {
            while (is_cons(params)) {
                pobject o = eval(env, cons_car(params));
                if (is_number(o))
                    result /= number_value(o); /* TODO: division by zero error handling */
                params = cons_cdr(params);
            }
        }
    }

    return gc_add(number_new(result));
}
예제 #16
0
static pobject begin(pobject env, pobject params)
{
    pobject result = NIL;

    while (is_cons(params)) {
        result = eval(env, cons_car(params));
        params = cons_cdr(params);
    }

    return result;
}
예제 #17
0
파일: code_base.c 프로젝트: aidanhs/teeterl
apr_array_header_t *source_files_names(term_t info, apr_pool_t *pool)
{
	apr_array_header_t *files = apr_array_make(pool, 1, sizeof(const char *));
	term_t cons = info;
	while (is_cons(cons))
	{
		term_box_t *cb = peel(cons);
		APR_ARRAY_PUSH(files, const char *) = ltoz(cb->cons.head, pool);
		cons = cb->cons.tail;
	}
	return files;
}
예제 #18
0
파일: list_util.c 프로젝트: EarlGray/ling
term_t list_rev(term_t t, heap_t *hp)
{
	term_t r = nil;
	while (is_cons(t))
	{
		term_t *cons = peel_cons(t);
		r = heap_cons(hp, cons[0], r);
		t = cons[1];
	}
	assert(is_nil(t));
	return r;
}
예제 #19
0
static pobject defmacro(pobject env, pobject params)
{
    pobject p = cons_car(params);

    if (is_cons(p)) {
        return env_define(env,
                          cons_car(p),
                          gc_add(macro_new(env, cons_cdr(p), cons_cdr(params))));
    }

    return NIL;
}
예제 #20
0
static pobject mult(pobject env, pobject params)
{
    float result = 1;
    while (is_cons(params)) {
        pobject o = eval(env, cons_car(params));
        if (is_number(o))
            result *= number_value(o);
        params = cons_cdr(params);
    }

    return gc_add(number_new(result));
}
예제 #21
0
static pobject minus(pobject env, pobject params)
{
    float result = 0;
    pobject o = eval(env, cons_car(params)); 
    if (is_number(o)) {
        result = number_value(o);
        params = cons_cdr(params);
        if (is_cons(params)) {
            while (is_cons(params)) {
                pobject o = eval(env, cons_car(params));
                if (is_number(o))
                    result -= number_value(o);
                params = cons_cdr(params);
            }
        } else {
            result = -result;
        }
    }

    return gc_add(number_new(result));
}
예제 #22
0
static pobject builtin_macro_expand(pobject env, pobject params)
{
    pobject p = cons_car(params);

    if (is_cons(p)) {
        pobject macro = eval(env, cons_car(p));
        if (is_macro(macro))
            return macro_expand(env, macro, cons_cdr(p));
    }

    return NIL;
}
예제 #23
0
파일: list_util.c 프로젝트: EarlGray/ling
void byte_list_flatten(term_t t, uint8_t *data)
{	
	assert(is_list(t));
	uint8_t *ptr = data;
	while (is_cons(t))
	{
		term_t *cons = peel_cons(t);
		assert(is_int(cons[0]));
		*ptr++ = int_value(cons[0]);
		t = cons[1];
	}
	assert(is_nil(t));
}
예제 #24
0
파일: list_util.c 프로젝트: EarlGray/ling
//
// Flatten the valid bits list to the bits_t context
//
void bits_list_flatten(term_t l, bits_t *bs)
{
	if (is_nil(l))
		return;

	if (is_cons(l))
	{
		do {
			uint32_t *term_data = peel_cons(l);
			term_t e = term_data[0];
			if (is_int(e))
			{
				int o = int_value(e);
				assert(o >= 0 && o < 256);
				bits_put_octet(bs, (uint8_t)o);
			}
			else
			{
				assert(is_list(e) || (is_boxed(e) && is_binary(peel_boxed(e))));
				bits_list_flatten(e, bs);
			}
			l = term_data[1];
			if (is_boxed(l) && is_binary(peel_boxed(l)))
			{
				bits_list_flatten(l, bs);
				return;
			}
		} while (is_cons(l));

		assert(is_nil(l));
	}
	else // is_binary()
	{
		bits_t source;
		bits_get_real(peel_boxed(l), &source);
		bits_copy(&source, bs);
	}
}
예제 #25
0
void dbg_print_list(secd_t *secd, cell_t *list) {
    printf("  -= ");
    while (not_nil(list)) {
        assertv(is_cons(list),
                "Not a cons at [%ld]\n", cell_index(secd, list));
        printf("[%ld]:%ld\t",
                cell_index(secd, list),
                cell_index(secd, get_car(list)));
        dbg_print_cell(secd, get_car(list));
        printf("  -> ");
        list = list_next(secd, list);
    }
    printf("NIL\n");
}
예제 #26
0
	void Printer::print_cons(LispObjRef obj) {
		print(car(obj));
		LispObjRef next(cdr(obj));
		if (is_cons(next)) {
			output_ << " ";
			print_cons(next);					
			return;
		}
		if (is_nil(next)) {
			return;
		}
		output_ << " . ";
		print(next);
	}
예제 #27
0
static pobject set(pobject env, pobject params)
{
    pobject symbol = cons_car(params);
    if (is_symbol(symbol)) {
        pobject value = eval(env, cons_nth(params, 2));
        pobject cons  = env_lookup(env, symbol);
        if (is_cons(cons)) {
            cons_car_set(cons, value);
            return value;
        }
    }

    return NIL;
}
예제 #28
0
파일: compare.c 프로젝트: MCRedJay/ling
static int term_order(term_t t)
{
	if (is_cons(t))
		return TERM_ORDER_CONS;
	if (is_tuple(t))
		return TERM_ORDER_TUPLE;
	if (is_nil(t))
		return TERM_ORDER_NIL;
	if (is_int(t))
		return TERM_ORDER_NUMBER;
	if (is_atom(t))
		return TERM_ORDER_ATOM;
	if (is_short_pid(t))
		return TERM_ORDER_PID;
	if (is_short_oid(t))
		return TERM_ORDER_OID;
	assert(is_boxed(t));
	switch (boxed_tag(peel_boxed(t)))
	{
	case SUBTAG_POS_BIGNUM:
	case SUBTAG_NEG_BIGNUM:
	case SUBTAG_FLOAT:
		return TERM_ORDER_NUMBER;

	case SUBTAG_FUN:
		return TERM_ORDER_FUN;
	case SUBTAG_EXPORT:
		return TERM_ORDER_EXPORT;

	case SUBTAG_PID:
		return TERM_ORDER_PID;

	case SUBTAG_OID:
		return TERM_ORDER_OID;

	case SUBTAG_REF:
		return TERM_ORDER_REF;

	case SUBTAG_PROC_BIN:
	case SUBTAG_HEAP_BIN:
	case SUBTAG_MATCH_CTX:
	case SUBTAG_SUB_BIN:
		return TERM_ORDER_BINARY;

	default:
		fatal_error("subtag");
	}
}
예제 #29
0
static pobject define(pobject env, pobject params)
{
    pobject p = cons_car(params);

    if (is_symbol(p)) {
        return env_define(env, 
                          cons_car(params), 
                          eval(env, cons_car(cons_cdr(params))));
    } else if (is_cons(p)) {
        return env_define(env,
                          cons_car(p),
                          gc_add(closure_new(env, cons_cdr(p), cons_cdr(params))));
    }

    return NIL;
}
예제 #30
0
파일: list_util.c 프로젝트: EarlGray/ling
int list_len(term_t t)
{
	assert(is_list(t));
	int len = 0;
	while (is_cons(t))
	{
		term_t *cons = peel_cons(t);
		len++;
		t = cons[1];
	}

	if (!is_nil(t))
		return -BAD_ARG;	// odd list

	return len;
}