static void createcat (lua_State *L, const char *catname, int (catf) (int)) {
TTree *t = newcharset(L);
int i;
for (i = 0; i <= UCHAR_MAX; i++)
if (catf(i)) setchar(treebuffer(t), i);
lua_setfield(L, -2, catname);
}
// Handy for pretty-printing local variables in an env
char* print_env(cell c) {
if (!buf) {
buf = GC_MALLOC(64);
buf_len = 64;
}
buf_index = 0;
catf("(");
while (IS_PAIR(c)) {
if (!IS_PAIR(car(c))) break;
if (TYPE(caar(c)) != SYMBOL) break;
if (!strcmp(SYM_STR(caar(c)), "GLOBALS")) break;
catf("\n%20s . ", SYM_STR(caar(c)));
print(cadr(c));
c = cdr(c);
}
catf(")");
return buf;
}
int
main(int argc, char *argv[])
{
int rv;
if (argc != 2) {
fprintf(stderr, "usage: catf <filename>\n");
exit(1);
}
do {
rv = catf(argv[1]);
} while (rv == 0);
exit(1);
}
// Recursive print function - updates buf_index as appropriate
// during its traversal of c
static int print(cell c) {
switch (TYPE(c)) {
case PAIR:
if (TYPE(car(c)) == PAIR) {
catf("(");
print(car(c));
catf(")");
} else
print(car(c));
if (!cdr(c)) return 0;
catf(" ");
if (TYPE(cdr(c)) != PAIR) catf(". ");
return print(cdr(c));
case S64:
case S32:
return catf("%ld", INT_VAL(c));
case SYMBOL:
return catf("%s", SYM_STR(c));
case NATIVE_FN:
case NATIVE_FN_TCO:
case NATIVE_MACRO:
return catf("NATIVE_FUNCTION<%p>", PTR(c));
case FFI_SYM:
return catf("FFI_SYM<%p>", PTR(c));
case FFI_FN:
return catf("FFI_FN<%p>", PTR(c));
case FFI_LIBRARY:
return catf("FFI_LIBRARY<%p>", PTR(c));
case MACRO:
catf("(macro (");
goto print_args_body;
case FN:
catf("(lambda (");
print_args_body:
print(((fn_t*)PTR(c))->args);
catf(") ");
print(((fn_t*)PTR(c))->body);
return catf(")");
case CONS:
return catf("CONS");
case NIL:
return catf("()");
default:
return catf("UNKNOWN<%p>", c);
}
}
