*/ REBFLG Copy_Function(REBVAL *value, REBVAL *args)
/*
***********************************************************************/
{
REBVAL *spec = VAL_BLK(args);
REBVAL *body = VAL_BLK_SKIP(args, 1);
if (IS_END(spec)) body = 0;
else {
// Spec given, must be block or *
if (IS_BLOCK(spec)) {
VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
} else
if (!IS_STAR(spec)) return FALSE;
}
if (body && !IS_END(body)) {
if (!IS_FUNCTION(value) && !IS_CLOSURE(value)) return FALSE;
// Body must be block:
if (!IS_BLOCK(body)) return FALSE;
VAL_FUNC_BODY(value) = VAL_SERIES(body);
}
// No body, use protytpe:
else if (IS_FUNCTION(value) || IS_CLOSURE(value))
VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(value));
// Rebind function words:
if (IS_FUNCTION(value))
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));
return TRUE;
}
// Validates that the given argument in [args] is a function. Returns true if
// it is. If not, reports an error and returns false.
static bool validateFn(WrenVM* vm, Value* args, int index, const char* argName)
{
if (IS_FN(args[index]) || IS_CLOSURE(args[index])) return true;
args[0] = OBJ_VAL(wrenStringConcat(vm, argName, " must be a function."));
return false;
}
void print_exception(VM *vm, VALUE result) {
// TODO: fprintf to stderr and teach dump_titled to optionally fprintf to stderr too
printf("====== Exception of type '%s' ======\n", obj_to_cstring(NGS_TYPE_NAME(NORMAL_TYPE_INSTANCE_TYPE(result))));
// TODO: maybe macro to iterate attributes
VALUE fields = NGS_TYPE_FIELDS(NORMAL_TYPE_INSTANCE_TYPE(result));
HASH_OBJECT_ENTRY *e;
for(e=HASH_HEAD(fields); e; e=e->insertion_order_next) {
if(obj_is_of_type(ARRAY_ITEMS(NORMAL_TYPE_INSTANCE_FIELDS(result))[GET_INT(e->val)], vm->Backtrace)) {
printf("=== [ backtrace ] ===\n");
// Backtrace.frames = [{"closure": ..., "ip": ...}, ...]
VALUE backtrace = ARRAY_ITEMS(NORMAL_TYPE_INSTANCE_FIELDS(result))[GET_INT(e->val)];
VALUE frames;
assert(get_normal_type_instace_attribute(backtrace, make_string("frames"), &frames) == METHOD_OK);
unsigned int i;
for(i = 0; i < OBJ_LEN(frames); i++) {
VALUE frame, resolved_ip, ip;
frame = ARRAY_ITEMS(frames)[i];
H(ip, frame, "ip");
resolved_ip = resolve_ip(vm, (IP)(GET_INT(ip) - 1));
if(IS_HASH(resolved_ip)) {
VALUE file, first_line, first_column, last_line, last_column;
HASH_OBJECT_ENTRY *closure_entry;
char *closure_name = "<anonymous>";
H(file, resolved_ip, "file");
H(first_line, resolved_ip, "first_line");
H(first_column, resolved_ip, "first_column");
H(last_line, resolved_ip, "last_line");
H(last_column, resolved_ip, "last_column");
closure_entry = get_hash_key(frame, make_string("closure"));
if(closure_entry && IS_CLOSURE(closure_entry->val) && (IS_HASH(CLOSURE_OBJ_ATTRS(closure_entry->val)))) {
HASH_OBJECT_ENTRY *name_entry;
name_entry = get_hash_key(CLOSURE_OBJ_ATTRS(closure_entry->val), make_string("name"));
if(name_entry) {
closure_name = obj_to_cstring(name_entry->val);
}
}
// TODO: fix types
printf("[Frame #%u] %s:%d:%d - %d:%d [in %s]\n", i, obj_to_cstring(file), (int) GET_INT(first_line), (int) GET_INT(first_column), (int) GET_INT(last_line), (int) GET_INT(last_column), closure_name);
} else {
printf("[Frame #%u] (no source location)\n", i);
}
}
continue;
}
if(obj_is_of_type(ARRAY_ITEMS(NORMAL_TYPE_INSTANCE_FIELDS(result))[GET_INT(e->val)], vm->Exception)) {
assert(IS_STRING(e->key));
printf("---8<--- %s - start ---8<---\n", obj_to_cstring(e->key));
print_exception(vm, ARRAY_ITEMS(NORMAL_TYPE_INSTANCE_FIELDS(result))[GET_INT(e->val)]);
printf("---8<--- %s - end ---8<---\n", obj_to_cstring(e->key));
continue;
}
if(IS_STRING(e->key)) {
dump_titled(obj_to_cstring(e->key), ARRAY_ITEMS(NORMAL_TYPE_INSTANCE_FIELDS(result))[GET_INT(e->val)]);
} else {
// Should not happen
dump_titled("attribute key", e->key);
dump_titled("attribute value", ARRAY_ITEMS(NORMAL_TYPE_INSTANCE_FIELDS(result))[GET_INT(e->val)]);
}
}
}
bool validateFn(WrenVM* vm, Value* args, int index, const char* argName)
{
if (IS_FN(args[index]) || IS_CLOSURE(args[index])) return true;
args[0] = wrenStringFormat(vm, "$ must be a function.", argName);
return false;
}
bool validateFn(WrenVM* vm, Value arg, const char* argName)
{
if (IS_FN(arg) || IS_CLOSURE(arg)) return true;
vm->fiber->error = wrenStringFormat(vm, "$ must be a function.", argName);
return false;
}
void _show(value_t p, FILE* stream) {
if (IS_FIXNUM(p)) {
fprintf(stream, "%ld", VALUE_TO_FIXNUM(p));
} else if (IS_PAIR(p)) {
pair_t pair = VALUE_TO_PAIR(p);
fprintf(stream, "(");
_show(pair.first, stream);
fprintf(stream, " ");
_show(pair.second, stream);
fprintf(stream, ")");
} else if (IS_CLOSURE(p)) {
fprintf(stream, "#<closure 0x%08lx>", p);
} else if (IS_IMMEDIATE(p)) {
if (p == BOOL_F) {
fprintf(stream, "#f");
} else if (p == BOOL_T) {
fprintf(stream, "#t");
} else if (p == NIL) {
fprintf(stream, "()");
} else {
fprintf(stream, "#<immediate 0x%08lx>", p);
}
} else {
fprintf(stream, "#<unknown 0x%08lx>", p);
}
}
*/ void Get_Var_Into_Core(REBVAL *out, const REBVAL *word)
/*
** Variant of Get_Var_Core that always traps and never returns a
** direct pointer into a frame. It is thus able to give back
** `self` lookups, and doesn't have to check the word's protection
** status before returning.
**
** See comments in Get_Var_Core for what it's actually doing.
**
***********************************************************************/
{
REBSER *context = VAL_WORD_FRAME(word);
if (context) {
REBINT index = VAL_WORD_INDEX(word);
if (index > 0) {
*out = *(FRM_VALUES(context) + index);
assert(!IS_TRASH(out));
assert(!THROWN(out));
return;
}
if (index < 0) {
struct Reb_Call *call = DSF;
while (call) {
if (
call->args_ready
&& context == VAL_FUNC_WORDS(DSF_FUNC(call))
) {
assert(!IS_CLOSURE(DSF_FUNC(call)));
*out = *DSF_ARG(call, -index);
assert(!IS_TRASH(out));
assert(!THROWN(out));
return;
}
call = PRIOR_DSF(call);
}
raise Error_1(RE_NO_RELATIVE, word);
}
// Key difference between Get_Var_Into and Get_Var...fabricating
// an object REBVAL.
// !!! Could fake function frames stow the function value itself
// so 'binding-of' can return it and use for binding (vs. TRUE)?
assert(!IS_SELFLESS(context));
Val_Init_Object(out, context);
return;
}
raise Error_1(RE_NOT_DEFINED, word);
}
static te_expr *new_expr(const int type, const te_expr *parameters[]) {
const int arity = ARITY(type);
const int psize = sizeof(void*) * arity;
const int size = sizeof(te_expr) + psize + (IS_CLOSURE(type) ? sizeof(void*) : 0);
te_expr *ret = malloc(size);
memset(ret, 0, size);
if (arity && parameters) {
memcpy(ret->parameters, parameters, psize);
}
ret->type = type;
ret->bound = 0;
return ret;
}
*/ void Bind_Frame(REBSER *obj)
/*
** Clone a frame, knowing which types of values need to be
** copied, deep copied, and rebound.
**
***********************************************************************/
{
REBVAL *val;
REBOOL funcs = FALSE;
//DISABLE_GC;
// Copy functions:
for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) {
if (IS_FUNCTION(val)) {
Clone_Function(val, val);
funcs = TRUE;
}
else if (IS_CLOSURE(val)) {
funcs = TRUE;
}
}
// Rebind all values:
Bind_Block(obj, BLK_SKIP(obj, 1), BIND_DEEP | BIND_FUNC);
if (funcs) {
// Rebind functions:
for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) {
if (IS_FUNCTION(val)) {
Bind_Relative(VAL_FUNC_ARGS(val), VAL_FUNC_BODY(val), VAL_FUNC_BODY(val));
}
else if (IS_CLOSURE(val)) {
}
}
}
//ENABLE_GC;
}
STOID Mold_Function(REBVAL *value, REB_MOLD *mold)
{
Pre_Mold(value, mold);
Append_Byte(mold->series, '[');
Mold_Block_Series(mold, VAL_FUNC_SPEC(value), 0, 0); //// & ~(1<<MOPT_MOLD_ALL)); // Never literalize it (/all).
if (IS_FUNCTION(value) || IS_CLOSURE(value))
Mold_Block_Series(mold, VAL_FUNC_BODY(value), 0, 0);
Append_Byte(mold->series, ']');
End_Mold(mold);
}
*/ static void Bind_Block_Words(REBSER *frame, REBVAL *value, REBCNT mode)
/*
** Inner loop of bind block. Modes are:
**
** BIND_ONLY Only bind the words found in the frame.
** BIND_SET Add set-words to the frame during the bind.
** BIND_ALL Add words to the frame during the bind.
** BIND_DEEP Recurse into sub-blocks.
**
** NOTE: BIND_SET must be used carefully, because it does not
** bind prior instances of the word before the set-word. That is
** forward references are not allowed.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBCNT n;
REBFLG selfish = !IS_SELFLESS(frame);
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
// Is the word found in this frame?
if (NZ(n = binds[VAL_WORD_CANON(value)])) {
if (n == NO_RESULT) n = 0; // SELF word
ASSERT1(n < SERIES_TAIL(frame), RP_BIND_BOUNDS);
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame;
}
else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = frame;
}
else {
// Word is not in frame. Add it if option is specified:
if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
Append_Frame(frame, value, 0);
binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
}
}
}
else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
Bind_Block_Words(frame, VAL_BLK_DATA(value), mode);
else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
Bind_Block_Words(frame, BLK_HEAD(VAL_FUNC_BODY(value)), mode);
}
}
static PrimitiveResult callFn(WrenVM* vm, Value* args, int numArgs)
{
ObjFn* fn;
if (IS_CLOSURE(args[0]))
{
fn = AS_CLOSURE(args[0])->fn;
}
else
{
fn = AS_FN(args[0]);
}
if (numArgs < fn->arity) RETURN_ERROR("Function expects more arguments.");
return PRIM_CALL;
}
*/ static void Bind_Values_Inner_Loop(REBINT *binds, REBVAL value[], REBSER *frame, REBCNT mode)
/*
** Bind_Values_Core() sets up the binding table and then calls
** this recursive routine to do the actual binding.
**
***********************************************************************/
{
REBFLG selfish = !IS_SELFLESS(frame);
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
// Is the word found in this frame?
REBCNT n = binds[VAL_WORD_CANON(value)];
if (n != 0) {
if (n == NO_RESULT) n = 0; // SELF word
assert(n < SERIES_TAIL(frame));
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame;
}
else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = frame;
}
else {
// Word is not in frame. Add it if option is specified:
if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
Expand_Frame(frame, 1, 1);
Append_Frame(frame, value, 0);
binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
}
}
}
else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
Bind_Values_Inner_Loop(
binds, VAL_BLK_DATA(value), frame, mode
);
else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
Bind_Values_Inner_Loop(
binds, BLK_HEAD(VAL_FUNC_BODY(value)), frame, mode
);
}
}
*/ void Rebind_Block(REBSER *src_frame, REBSER *dst_frame, REBVAL *data, REBFLG modes)
/*
** Rebind all words that reference src frame to dst frame.
** Rebind is always deep.
**
** There are two types of frames: relative frames and normal frames.
** When frame_src type and frame_dst type differ,
** modes must have REBIND_TYPE.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table);
for (; NOT_END(data); data++) {
if (ANY_BLOCK(data))
Rebind_Block(src_frame, dst_frame, VAL_BLK_DATA(data), modes);
else if (ANY_WORD(data) && VAL_WORD_FRAME(data) == src_frame) {
VAL_WORD_FRAME(data) = dst_frame;
if (modes & REBIND_TABLE) VAL_WORD_INDEX(data) = binds[VAL_WORD_CANON(data)];
if (modes & REBIND_TYPE) VAL_WORD_INDEX(data) = - VAL_WORD_INDEX(data);
} else if ((modes & REBIND_FUNC) && (IS_FUNCTION(data) || IS_CLOSURE(data)))
Rebind_Block(src_frame, dst_frame, BLK_HEAD(VAL_FUNC_BODY(data)), modes);
}
}
int procedurep(int x){
if((IS_SUBR(x)) || (IS_CLOSURE(x)) || (IS_CONT(x)))
return(1);
else
return(0);
}
int closurep(int x){
if(IS_CLOSURE(x))
return(1);
else
return(0);
}
*/ REBVAL *Get_Var_Core(const REBVAL *word, REBOOL trap, REBOOL writable)
/*
** Get the word--variable--value. (Generally, use the macros like
** GET_VAR or GET_MUTABLE_VAR instead of this). This routine is
** called quite a lot and so attention to performance is important.
**
** Coded assuming most common case is trap=TRUE and writable=FALSE
**
***********************************************************************/
{
REBSER *context = VAL_WORD_FRAME(word);
if (context) {
REBINT index = VAL_WORD_INDEX(word);
// POSITIVE INDEX: The word is bound directly to a value inside
// a frame, and represents the zero-based offset into that series.
// This is how values would be picked out of object-like things...
// (Including looking up 'append' in the user context.)
if (index > 0) {
REBVAL *value;
if (
writable &&
VAL_GET_EXT(FRM_WORDS(context) + index, EXT_WORD_LOCK)
) {
if (trap) raise Error_1(RE_LOCKED_WORD, word);
return NULL;
}
value = FRM_VALUES(context) + index;
assert(!THROWN(value));
return value;
}
// NEGATIVE INDEX: Word is stack-relative bound to a function with
// no persistent frame held by the GC. The value *might* be found
// on the stack (or not, if all instances of the function on the
// call stack have finished executing). We walk backward in the call
// stack to see if we can find the function's "identifying series"
// in a call frame...and take the first instance we see (even if
// multiple invocations are on the stack, most recent wins)
if (index < 0) {
struct Reb_Call *call = DSF;
// Get_Var could theoretically be called with no evaluation on
// the stack, so check for no DSF first...
while (call) {
if (
call->args_ready
&& context == VAL_FUNC_WORDS(DSF_FUNC(call))
) {
REBVAL *value;
assert(!IS_CLOSURE(DSF_FUNC(call)));
if (
writable &&
VAL_GET_EXT(
VAL_FUNC_PARAM(DSF_FUNC(call), -index),
EXT_WORD_LOCK
)
) {
if (trap) raise Error_1(RE_LOCKED_WORD, word);
return NULL;
}
value = DSF_ARG(call, -index);
assert(!THROWN(value));
return value;
}
call = PRIOR_DSF(call);
}
if (trap) raise Error_1(RE_NO_RELATIVE, word);
return NULL;
}
// ZERO INDEX: The word is SELF. Although the information needed
// to produce an OBJECT!-style REBVAL lives in the zero offset
// of the frame, it's not a value that we can return a direct
// pointer to. Use GET_VAR_INTO instead for that.
assert(!IS_SELFLESS(context));
if (trap) raise Error_0(RE_SELF_PROTECTED);
return NULL; // is this a case where we should *always* trap?
}
if (trap) raise Error_1(RE_NOT_DEFINED, word);
return NULL;
}
static te_expr *base(state *s) {
/* <base> = <constant> | <variable> | <function-0> {"(" ")"} | <function-1> <power> | <function-X> "(" <expr> {"," <expr>} ")" | "(" <list> ")" */
te_expr *ret;
int arity;
switch (TYPE_MASK(s->type)) {
case TOK_NUMBER:
ret = new_expr(TE_CONSTANT, 0);
ret->value = s->value;
next_token(s);
break;
case TOK_VARIABLE:
ret = new_expr(TE_VARIABLE, 0);
ret->bound = s->bound;
next_token(s);
break;
case TE_FUNCTION0:
case TE_CLOSURE0:
ret = new_expr(s->type, 0);
ret->function = s->function;
if (IS_CLOSURE(s->type)) ret->parameters[0] = s->context;
next_token(s);
if (s->type == TOK_OPEN) {
next_token(s);
if (s->type != TOK_CLOSE) {
s->type = TOK_ERROR;
} else {
next_token(s);
}
}
break;
case TE_FUNCTION1:
case TE_CLOSURE1:
ret = new_expr(s->type, 0);
ret->function = s->function;
if (IS_CLOSURE(s->type)) ret->parameters[1] = s->context;
next_token(s);
ret->parameters[0] = power(s);
break;
case TE_FUNCTION2: case TE_FUNCTION3: case TE_FUNCTION4:
case TE_FUNCTION5: case TE_FUNCTION6: case TE_FUNCTION7:
case TE_CLOSURE2: case TE_CLOSURE3: case TE_CLOSURE4:
case TE_CLOSURE5: case TE_CLOSURE6: case TE_CLOSURE7:
arity = ARITY(s->type);
ret = new_expr(s->type, 0);
ret->function = s->function;
if (IS_CLOSURE(s->type)) ret->parameters[arity] = s->context;
next_token(s);
if (s->type != TOK_OPEN) {
s->type = TOK_ERROR;
} else {
int i;
for(i = 0; i < arity; i++) {
next_token(s);
ret->parameters[i] = expr(s);
if(s->type != TOK_SEP) {
break;
}
}
if(s->type != TOK_CLOSE || i != arity - 1) {
s->type = TOK_ERROR;
} else {
next_token(s);
}
}
break;
case TOK_OPEN:
next_token(s);
ret = list(s);
if (s->type != TOK_CLOSE) {
s->type = TOK_ERROR;
} else {
next_token(s);
}
break;
default:
ret = new_expr(0, 0);
s->type = TOK_ERROR;
ret->value = NAN;
break;
}
return ret;
}
struct atom *eval(struct atom *expr, struct env *env)
{
// symbols and not-a-lists are evaluated or returned directly
if (IS_SYM(expr))
{
struct atom *atom = env_lookup(env, expr->str.str);
if (atom)
{
return atom;
}
else
{
printf("error: undefined variable: %s\n",
expr->str.str);
return &nil_atom;
}
}
if (!IS_LIST(expr))
return expr;
struct list *list = expr->list;
struct atom *op = LIST_FIRST(list);
// Check if the first elem is not a symbol or a closure. If it's
// not, then we'll evaluate it (it could be a lambda form).
if (!IS_SYM(op) && !IS_CLOSURE(op))
{
struct atom *evaluated_op = eval(op, env);
// Replace the evaluated one to the list!
LIST_REMOVE(op, entries);
LIST_INSERT_HEAD(list, evaluated_op, entries);
op = evaluated_op;
}
// If the first elem is a symbol, it should be a name for a builtin
// function or a closure bound to that name by the user. If the
// first argument is directly a closure, eval that with the args.
if (IS_SYM(op))
{
struct builtin_function_def *def = builtin_function_defs;
while (def->name && def->fn)
{
if (strcmp(op->str.str, def->name) == 0)
{
return def->fn(expr, env);
}
++def;
}
struct atom *closure = env_lookup(env, op->str.str);
if (closure)
{
return eval_closure(closure, CDR(op), env);
}
printf("error: unknown function %s\n", op->str.str);
}
else if (IS_CLOSURE(op))
{
return eval_closure(op, CDR(op), env);
}
printf("error: cannot evaluate\n");
return &nil_atom;
}
static void _dump(VALUE v, int level) {
char **symbols;
void *symbols_buffer[1];
VALUE *ptr;
size_t i;
HASH_OBJECT_ENTRY *e;
HASH_OBJECT_ENTRY **buckets;
if(IS_NULL(v)) { printf("%*s* null\n", level << 1, ""); goto exit; }
if(IS_TRUE(v)) { printf("%*s* true\n", level << 1, ""); goto exit; }
if(IS_FALSE(v)) { printf("%*s* false\n", level << 1, ""); goto exit; }
if(IS_UNDEF(v)) { printf("%*s* undef\n", level << 1, ""); goto exit; }
if(IS_KWARGS_MARKER(v)){ printf("%*s* kwargs marker\n", level << 1, ""); goto exit; }
if(IS_INT(v)) { printf("%*s* int %" VALUE_NUM_FMT "\n", level << 1, "", GET_INT(v)); goto exit; }
if(IS_REAL(v)) { printf("%*s* real %g\n", level << 1, "", REAL_OBJECT_VAL(v)); goto exit; }
if(IS_STRING(v)) {
// TODO: properly handle
// 1. non-printable characters
// 2. zero character
printf("%*s* string(len=%zu) %.*s\n", level << 1, "", OBJ_LEN(v), (int) OBJ_LEN(v), (char *)OBJ_DATA_PTR(v));
goto exit;
}
if(IS_NATIVE_METHOD(v)) {
symbols_buffer[0] = OBJ_DATA_PTR(v);
symbols = backtrace_symbols(symbols_buffer, 1);
printf("%*s* native method %s at %p req_params=%d\n", level << 1, "", symbols[0], OBJ_DATA_PTR(v), NATIVE_METHOD_OBJ_N_REQ_PAR(v));
for(i=0; i<NATIVE_METHOD_OBJ_N_REQ_PAR(v); i++) {
printf("%*s* required parameter %zu\n", (level+1) << 1, "", i+1);
_dump(NATIVE_METHOD_OBJ_PARAMS(v)[i*2+0], level+2);
_dump(NATIVE_METHOD_OBJ_PARAMS(v)[i*2+1], level+2);
}
goto exit;
}
if(IS_CLOSURE(v)) {
printf("%*s* closure name=%s ip=%zu locals_including_params=%d req_params=%d opt_params=%d n_uplevels=%d params_flags=%d\n", level << 1, "",
IS_NULL(CLOSURE_OBJ_NAME(v)) ? "(none)" : obj_to_cstring(CLOSURE_OBJ_NAME(v)),
CLOSURE_OBJ_IP(v),
CLOSURE_OBJ_N_LOCALS(v),
CLOSURE_OBJ_N_REQ_PAR(v),
CLOSURE_OBJ_N_OPT_PAR(v),
CLOSURE_OBJ_N_UPLEVELS(v),
CLOSURE_OBJ_PARAMS_FLAGS(v)
);
for(i=0; i<CLOSURE_OBJ_N_REQ_PAR(v); i++) {
printf("%*s* required parameter %zu (name and type follow)\n", (level+1) << 1, "", i+1);
_dump(CLOSURE_OBJ_PARAMS(v)[i*2+0], level+2);
_dump(CLOSURE_OBJ_PARAMS(v)[i*2+1], level+2);
}
for(i=0; i<CLOSURE_OBJ_N_OPT_PAR(v); i++) {
printf("%*s* optional parameter %zu (name, type and default value follow)\n", (level+1) << 1, "", i+1);
_dump(CLOSURE_OBJ_PARAMS(v)[CLOSURE_OBJ_N_REQ_PAR(v)*2 + i*3 + 0], level+2);
_dump(CLOSURE_OBJ_PARAMS(v)[CLOSURE_OBJ_N_REQ_PAR(v)*2 + i*3 + 1], level+2);
_dump(CLOSURE_OBJ_PARAMS(v)[CLOSURE_OBJ_N_REQ_PAR(v)*2 + i*3 + 2], level+2);
}
i = CLOSURE_OBJ_N_REQ_PAR(v)*2 + CLOSURE_OBJ_N_OPT_PAR(v)*3;
if(CLOSURE_OBJ_PARAMS_FLAGS(v) & PARAMS_FLAG_ARR_SPLAT) {
printf("%*s* array splat parameter\n", (level+1) << 1, "");
_dump(CLOSURE_OBJ_PARAMS(v)[i+0], level+2);
_dump(CLOSURE_OBJ_PARAMS(v)[i+1], level+2);
i+=3;
}
if(CLOSURE_OBJ_PARAMS_FLAGS(v) & PARAMS_FLAG_HASH_SPLAT) {
printf("%*s* hash splat parameter\n", (level+1) << 1, "");
_dump(CLOSURE_OBJ_PARAMS(v)[i+0], level+2);
_dump(CLOSURE_OBJ_PARAMS(v)[i+1], level+2);
i+=3;
}
goto exit;
}
if(IS_ARRAY(v)) {
printf("%*s* array of length %zu\n", level << 1, "", OBJ_LEN(v));
for(i=0, ptr=(VALUE *)OBJ_DATA_PTR(v); i<OBJ_LEN(v); i++, ptr++) {
_dump(*ptr, level+1);
}
goto exit;
}
if(IS_HASH(v)) {
printf("%*s* hash with total of %zu items in %zu buckets at %p\n", level << 1, "", OBJ_LEN(v), HASH_BUCKETS_N(v), OBJ_DATA_PTR(v));
buckets = OBJ_DATA_PTR(v);
for(i=0; i<HASH_BUCKETS_N(v); i++) {
if(!buckets[i]) { continue; }
printf("%*s* bucket # %zu\n", (level+1) << 1, "", i);
for(e=buckets[i]; e; e=e->bucket_next) {
printf("%*s* item at %p with hash() of %u insertion_order_prev=%p insertion_order_next=%p \n", (level+2) << 1, "", (void *)e, e->hash, (void *)e->insertion_order_prev, (void *)e->insertion_order_next);
printf("%*s* key\n", (level+3) << 1, "");
_dump(e->key, level+4);
printf("%*s* value\n", (level+3) << 1, "");
_dump(e->val, level+4);
}
}
goto exit;
}
if(IS_NGS_TYPE(v)) {
printf("%*s* type (name and optionally constructors and parents follow) id=%" PRIdPTR " ptr=%p\n", level << 1, "", NGS_TYPE_ID(v), IS_NORMAL_TYPE(v) ? v.ptr : 0);
_dump(NGS_TYPE_NAME(v), level + 1);
if(level < 3) {
_dump(NGS_TYPE_FIELDS(v), level + 1);
_dump(NGS_TYPE_CONSTRUCTORS(v), level + 1);
_dump(NGS_TYPE_PARENTS(v), level + 1);
}
goto exit;
}
if(IS_CLIB(v)) {
printf("%*s* C library (name follows) ptr=%p\n", level << 1, "", OBJ_DATA_PTR(v));
_dump(CLIB_OBJECT_NAME(v), level + 1);
goto exit;
}
if(IS_CSYM(v)) {
printf("%*s* C symbol (name and libraray follow) ptr=%p\n", level << 1, "", OBJ_DATA_PTR(v));
_dump(CSYM_OBJECT_NAME(v), level + 1);
_dump(CSYM_OBJECT_LIB(v), level + 1);
goto exit;
}
if(IS_NORMAL_TYPE_CONSTRUCTOR(v)) {
printf("%*s* user type constructor (type optionally follows)\n", level << 1, "");
if(level < 3) {
_dump(OBJ_DATA(v), level + 1);
}
goto exit;
}
if(IS_NORMAL_TYPE_INSTANCE(v)) {
printf("%*s* user type instance (type and fields optionally follow)\n", level << 1, "");
// level < 4 so that uncaught exception ImplNotFound could display the type of the arguments
if(level < 4) {
_dump(NORMAL_TYPE_INSTANCE_TYPE(v), level + 1);
_dump(NORMAL_TYPE_INSTANCE_FIELDS(v), level + 1);
}
goto exit;
}
printf("%*s* (dump not implemented for the object at %p)\n", level << 1, "", OBJ_DATA_PTR(v));
exit:
return;
}
