val ftw_wrap(val dirpath, val fn, val flags_in, val nopenfd_in)
{
if (s_callback) {
uw_throwf(error_s, lit("ftw: cannot be re-entered from "
"ftw callback"), nao);
} else if (dirpath == nil) {
return t;
} else if (consp(dirpath)) {
uses_or2;
val ret = nil;
for (; dirpath; dirpath = cdr(dirpath)) {
val res = ftw_wrap(car(dirpath), fn, flags_in, nopenfd_in);
if (res != t && res != nil)
return res;
ret = or2(ret, res);
}
return ret;
} else {
int nopenfd = c_num(default_arg(nopenfd_in, num_fast(20)));
int flags = c_num(default_arg(flags_in, zero));
char *dirpath_u8 = utf8_dup_to(c_str(dirpath));
int res = (s_callback = fn,
nftw(dirpath_u8, ftw_callback, nopenfd, flags));
s_callback = nil;
free(dirpath_u8);
if (s_exit_point) {
uw_frame_t *ep = s_exit_point;
s_exit_point = 0;
uw_continue(ep);
}
switch (res) {
case 0:
return t;
case -1:
return nil;
default:
return num(res);
}
}
}
static int ftw_callback(const char *c_path, const struct stat *c_sb,
int c_type, struct FTW *fb)
{
int c_result = 1;
uw_frame_t cont_guard;
uw_push_guard(&cont_guard, 0);
uw_simple_catch_begin;
sig_check_fast();
{
val path = string_utf8(c_path);
val type = num(c_type);
val sb = stat_to_struct(*c_sb, path);
val level = num(fb->level);
val base = num(fb->base);
val result;
args_decl(args, ARGS_MIN);
args_add5(args, path, type, sb, level, base);
result = generic_funcall(s_callback, args);
c_result = if3(integerp(result), c_num(result), 0);
}
uw_unwind {
s_exit_point = uw_curr_exit_point;
uw_curr_exit_point = 0; /* stops unwinding */
}
uw_catch_end;
uw_pop_frame(&cont_guard);
return c_result;
}
/**
\brief Return the size of the inductive datatype.
Pre-condition: The given argument constains the parameters of an inductive datatype.
*/
static sort_size get_datatype_size(parameter const * parameters) {
unsigned num_types = parameters[0].get_int();
unsigned tid = parameters[1].get_int();
buffer<sort_size> szs(num_types, sort_size());
buffer<status> already_found(num_types, WHITE);
buffer<unsigned> todo;
todo.push_back(tid);
while (!todo.empty()) {
unsigned tid = todo.back();
if (already_found[tid] == BLACK) {
todo.pop_back();
continue;
}
already_found[tid] = GRAY;
unsigned o = parameters[2 + 2*tid + 1].get_int(); // constructor offset
unsigned num_constructors = parameters[o].get_int();
bool is_very_big = false;
bool can_process = true;
for (unsigned s = 1; s <= num_constructors; s++) {
unsigned k_i = parameters[o+s].get_int();
unsigned num_accessors = parameters[k_i+2].get_int();
for (unsigned r = 0; r < num_accessors; r++) {
parameter const & a_type = parameters[k_i+4 + 2*r];
if (a_type.is_int()) {
int tid_prime = a_type.get_int();
switch (already_found[tid_prime]) {
case WHITE:
todo.push_back(tid_prime);
can_process = false;
break;
case GRAY:
// type is recursive
return sort_size();
case BLACK:
break;
}
}
else {
SASSERT(a_type.is_ast());
sort * ty = to_sort(a_type.get_ast());
if (ty->is_infinite()) {
// type is infinite
return sort_size();
}
else if (ty->is_very_big()) {
is_very_big = true;
}
}
}
}
if (can_process) {
todo.pop_back();
already_found[tid] = BLACK;
if (is_very_big) {
szs[tid] = sort_size::mk_very_big();
}
else {
// the type is not infinite nor the number of elements is infinite...
// computing the number of elements
rational num;
for (unsigned s = 1; s <= num_constructors; s++) {
unsigned k_i = parameters[o+s].get_int();
unsigned num_accessors = parameters[k_i+2].get_int();
rational c_num(1);
for (unsigned r = 0; r < num_accessors; r++) {
parameter const & a_type = parameters[k_i+4 + 2*r];
if (a_type.is_int()) {
int tid_prime = a_type.get_int();
SASSERT(!szs[tid_prime].is_infinite() && !szs[tid_prime].is_very_big());
c_num *= rational(szs[tid_prime].size(),rational::ui64());
}
else {
SASSERT(a_type.is_ast());
sort * ty = to_sort(a_type.get_ast());
SASSERT(!ty->is_infinite() && !ty->is_very_big());
c_num *= rational(ty->get_num_elements().size(), rational::ui64());
}
}
num += c_num;
}
szs[tid] = sort_size(num);
}
}
}
return szs[tid];
}
val debug(val ctx, val bindings, val data, val line, val pos, val base)
{
uses_or2;
val form = ctx_form(ctx);
val rl = source_loc(form);
cons_bind (lineno, file, rl);
if (consp(data))
data = car(data);
else if (data == t)
data = nil;
if (!step_mode && !memqual(rl, breakpoints)
&& (debug_depth > next_depth))
{
return nil;
} else {
val print_form = t;
val print_data = t;
for (;;) {
val input, command;
if (print_form) {
format(std_debug, lit("stopped at line ~d of ~a\n"),
lineno, file, nao);
format(std_debug, lit("form: ~s\n"), form, nao);
format(std_debug, lit("depth: ~s\n"), num(debug_depth), nao);
print_form = nil;
}
if (print_data) {
int lim = cols * 8;
if (data && pos) {
val half = num((lim - 8) / 2);
val full = num((lim - 8));
val prefix, suffix;
if (lt(pos, half)) {
prefix = sub_str(data, zero, pos);
suffix = sub_str(data, pos, full);
} else {
prefix = sub_str(data, minus(pos, half), pos);
suffix = sub_str(data, pos, plus(pos, half));
}
format(std_debug, lit("data (~d:~d):\n~s . ~s\n"),
line, plus(pos, base), prefix, suffix, nao);
} else if (data && length_str_ge(data, num(lim - 2))) {
format(std_debug, lit("data (~d):\n~s...~s\n"), line,
sub_str(data, zero, num(lim/2 - 4)),
sub_str(data, num(-(lim/2 - 3)), t), nao);
} else {
format(std_debug, lit("data (~d):\n~s\n"), line, data, nao);
}
print_data = nil;
}
format(std_debug, lit("txr> "), nao);
flush_stream(std_debug);
input = split_str_set(or2(get_line(std_input), lit("q")), lit("\t "));
command = if3(equal(first(input), null_string),
or2(last_command, lit("")), first(input));
last_command = command;
if (equal(command, lit("?")) || equal(command, lit("h"))) {
help(std_debug);
continue;
} else if (equal(command, null_string)) {
continue;
} else if (equal(command, lit("c"))) {
step_mode = 0;
next_depth = -1;
return nil;
} else if (equal(command, lit("s"))) {
step_mode = 1;
return nil;
} else if (equal(command, lit("n"))) {
step_mode = 0;
next_depth = debug_depth;
return nil;
} else if (equal(command, lit("f"))) {
step_mode = 0;
next_depth = debug_depth - 1;
return nil;
} else if (equal(command, lit("v"))) {
show_bindings(bindings, std_debug);
} else if (equal(command, lit("o"))) {
print_form = t;
} else if (equal(command, lit("i"))) {
print_data = t;
} else if (equal(command, lit("b")) || equal(command, lit("d")) ||
equal(command, lit("g")))
{
if (!rest(input)) {
format(std_debug, lit("~s needs arguments\n"), command, nao);
continue;
} else {
val n = int_str(second(input), num(10));
val l = cons(n, or2(third(input), file));
if (!n) {
format(std_debug, lit("~s needs <line> [ <file> ]\n"),
command, nao);
continue;
}
if (equal(command, lit("b"))) {
breakpoints = remqual(l, breakpoints, nil);
push(l, &breakpoints);
} else if (equal(command, lit("d"))) {
val breakpoints_old = breakpoints;
breakpoints = remqual(l, breakpoints, nil);
if (breakpoints == breakpoints_old)
format(std_debug, lit("no such breakpoint\n"), nao);
} else {
opt_loglevel = c_num(n);
}
}
} else if (equal(command, lit("l"))) {
format(std_debug, lit("breakpoints: ~s\n"), breakpoints, nao);
} else if (equal(command, lit("w"))) {
format(std_debug, lit("backtrace:\n"), nao);
{
uw_frame_t *iter;
for (iter = uw_current_frame(); iter != 0; iter = iter->uw.up) {
if (iter->uw.type == UW_DBG) {
if (iter->db.ub_p_a_pairs)
format(std_debug, lit("(~s ~s ~s)\n"), iter->db.func,
args_copy_to_list(iter->db.args),
iter->db.ub_p_a_pairs, nao);
else
format(std_debug, lit("(~s ~s)\n"), iter->db.func,
args_copy_to_list(iter->db.args), nao);
}
}
}
} else if (equal(command, lit("q"))) {
uw_throwf(debug_quit_s, lit("terminated via debugger"), nao);
} else {
format(std_debug, lit("unrecognized command: ~a\n"), command, nao);
}
}
return nil;
}
}
