static void sexp_print_simple (sexp ctx, sexp x, sexp out, int depth) { int i; if ((!sexp_pointerp(x)) || sexp_symbolp(x) || sexp_stringp(x) || sexp_flonump(x) || sexp_bignump(x)) { sexp_write(ctx, x, out); } else if (depth <= 0) { goto print_name; } else if (sexp_synclop(x)) { sexp_write_string(ctx, "#<sc ", out); sexp_print_simple(ctx, sexp_synclo_expr(x), out, depth); sexp_write_string(ctx, ">", out); } else if (sexp_pairp(x)) { sexp_write_char(ctx, '(', out); sexp_print_simple(ctx, sexp_car(x), out, depth-1); sexp_write_string(ctx, " . ", out); sexp_print_simple(ctx, sexp_cdr(x), out, depth-1); sexp_write_char(ctx, ')', out); } else if (sexp_vectorp(x)) { sexp_write_string(ctx, "#(", out); for (i=0; i<SEXP_HEAP_VECTOR_DEPTH && i<(int)sexp_vector_length(x); i++) { if (i>0) sexp_write_char(ctx, ' ', out); sexp_print_simple(ctx, sexp_vector_ref(x, i), out, depth-1); } if (i<(int)sexp_vector_length(x)) sexp_write_string(ctx, " ...", out); sexp_write_char(ctx, ')', out); } else { print_name: sexp_write_string(ctx, "#<", out); sexp_write(ctx, sexp_object_type_name(ctx, x), out); sexp_write_string(ctx, ">", out); } }
static void sexp_insert_timed (sexp ctx, sexp thread, sexp timeout) { #if SEXP_USE_FLONUMS double d; #endif sexp ls1=SEXP_NULL, ls2; sexp_delete_list(ctx, SEXP_G_THREADS_PAUSED, thread); ls2 = sexp_global(ctx, SEXP_G_THREADS_PAUSED); if (sexp_integerp(timeout) || sexp_flonump(timeout)) gettimeofday(&sexp_context_timeval(thread), NULL); if (sexp_integerp(timeout)) { sexp_context_timeval(thread).tv_sec += sexp_unbox_fixnum(timeout); #if SEXP_USE_FLONUMS } else if (sexp_flonump(timeout)) { d = sexp_flonum_value(timeout); sexp_context_timeval(thread).tv_sec += trunc(d); sexp_context_timeval(thread).tv_usec += (d-trunc(d))*1000000; if (sexp_context_timeval(thread).tv_usec > 1000000) { sexp_context_timeval(thread).tv_sec += 1; sexp_context_timeval(thread).tv_usec -= 1000000; } #endif } else if (sexp_contextp(timeout)) { sexp_context_timeval(thread).tv_sec = sexp_context_timeval(timeout).tv_sec; sexp_context_timeval(thread).tv_usec = sexp_context_timeval(timeout).tv_usec; } else { sexp_context_timeval(thread).tv_sec = 0; sexp_context_timeval(thread).tv_usec = 0; } if (sexp_numberp(timeout) || sexp_contextp(timeout)) while (sexp_pairp(ls2) && sexp_context_before(sexp_car(ls2), sexp_context_timeval(thread))) ls1=ls2, ls2=sexp_cdr(ls2); else while (sexp_pairp(ls2) && sexp_context_timeval(sexp_car(ls2)).tv_sec) ls1=ls2, ls2=sexp_cdr(ls2); if (ls1 == SEXP_NULL) sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cons(ctx, thread, ls2); else sexp_cdr(ls1) = sexp_cons(ctx, thread, ls2); }
static double sexp_to_double (sexp x) { if (sexp_flonump(x)) return sexp_flonum_value(x); else if (sexp_fixnump(x)) return sexp_fixnum_to_double(x); else if (sexp_bignump(x)) return sexp_bignum_to_double(x); #if SEXP_USE_RATIOS else if (sexp_ratiop(x)) return sexp_ratio_to_double(x); #endif else return 0.0; }
static sexp sexp_to_complex (sexp ctx, sexp x) { #if SEXP_USE_RATIOS sexp_gc_var1(tmp); #endif if (sexp_flonump(x) || sexp_fixnump(x) || sexp_bignump(x)) { return sexp_make_complex(ctx, x, SEXP_ZERO); #if SEXP_USE_RATIOS } else if (sexp_ratiop(x)) { sexp_gc_preserve1(ctx, tmp); tmp = sexp_make_complex(ctx, SEXP_ZERO, SEXP_ZERO); sexp_complex_real(tmp) = sexp_make_flonum(ctx, sexp_to_double(x)); sexp_gc_release1(ctx); return tmp; #endif } else { return x; } }
static sexp sexp_type_of (sexp ctx, sexp self, sexp_sint_t n, sexp x) { if (sexp_pointerp(x)) return sexp_object_type(ctx, x); else if (sexp_fixnump(x)) return sexp_type_by_index(ctx, SEXP_FIXNUM); else if (sexp_booleanp(x)) return sexp_type_by_index(ctx, SEXP_BOOLEAN); else if (sexp_charp(x)) return sexp_type_by_index(ctx, SEXP_CHAR); #if SEXP_USE_HUFF_SYMS else if (sexp_symbolp(x)) return sexp_type_by_index(ctx, SEXP_SYMBOL); #endif #if SEXP_USE_IMMEDIATE_FLONUMS else if (sexp_flonump(x)) return sexp_type_by_index(ctx, SEXP_FLONUM); #endif else return sexp_type_by_index(ctx, SEXP_OBJECT); }