//
// Bind_Values_Core: C
//
// Bind words in an array of values terminated with END
// to a specified context. See warnings on the functions like
// Bind_Values_Deep() about not passing just a singular REBVAL.
//
// NOTE: If types are added, then they will be added in "midstream". Only
// bindings that come after the added value is seen will be bound.
//
void Bind_Values_Core(
RELVAL *head,
REBCTX *context,
REBU64 bind_types,
REBU64 add_midstream_types,
REBFLGS flags // see %sys-core.h for BIND_DEEP, etc.
) {
struct Reb_Binder binder;
INIT_BINDER(&binder);
// Via the global hash table, each spelling of the word can find the
// canon form of the word. Associate that with an index number to signal
// a binding should be created to this context (at that index.)
REBCNT index = 1;
REBVAL *key = CTX_KEYS_HEAD(context);
for (; index <= CTX_LEN(context); key++, index++)
if (!GET_VAL_FLAG(key, TYPESET_FLAG_UNBINDABLE))
Add_Binder_Index(&binder, VAL_KEY_CANON(key), index);
Bind_Values_Inner_Loop(
&binder, head, context, bind_types, add_midstream_types, flags
);
// Reset all the binder indices to zero, balancing out what was added.
key = CTX_KEYS_HEAD(context);
for (; NOT_END(key); key++)
Remove_Binder_Index(&binder, VAL_KEY_CANON(key));
SHUTDOWN_BINDER(&binder);
}
//
// VAL_SPECIFIC_Debug: C
//
REBCTX *VAL_SPECIFIC_Debug(const REBVAL *v)
{
REBCTX *specific;
assert(NOT(GET_VAL_FLAG(v, VALUE_FLAG_RELATIVE)));
assert(
ANY_WORD(v)
|| ANY_ARRAY(v)
|| IS_VARARGS(v)
|| IS_FUNCTION(v)
|| ANY_CONTEXT(v)
);
specific = VAL_SPECIFIC_COMMON(v);
if (specific != SPECIFIED) {
//
// Basic sanity check: make sure it's a context at all
//
if (!GET_CTX_FLAG(specific, ARRAY_FLAG_VARLIST)) {
printf("Non-CONTEXT found as specifier in specific value\n");
Panic_Series(cast(REBSER*, specific)); // may not be series either
}
// While an ANY-WORD! can be bound specifically to an arbitrary
// object, an ANY-ARRAY! only becomes bound specifically to frames.
// The keylist for a frame's context should come from a function's
// paramlist, which should have a FUNCTION! value in keylist[0]
//
if (ANY_ARRAY(v))
assert(IS_FUNCTION(CTX_ROOTKEY(specific)));
}
return specific;
}
//
// RL_Words_Of_Object: C
//
// Returns information about the object.
//
// Returns:
// Returns an array of words used as fields of the object.
// Arguments:
// obj - object pointer (e.g. from RXA_OBJECT)
// Notes:
// Returns a word array similar to MAP_WORDS().
// The array is allocated with OS_ALLOC. You can OS_FREE it any time.
//
RL_API u32 *RL_Words_Of_Object(REBSER *obj)
{
REBCNT index;
u32 *syms;
REBVAL *key;
REBCTX *context = AS_CONTEXT(obj);
key = CTX_KEYS_HEAD(context);
// We don't include hidden keys (e.g. SELF), but terminate by 0.
// Conservative estimate that there are no hidden keys, add one.
//
syms = OS_ALLOC_N(u32, CTX_LEN(context) + 1);
index = 0;
for (; NOT_END(key); key++) {
if (GET_VAL_FLAG(key, TYPESET_FLAG_HIDDEN))
continue;
syms[index] = VAL_TYPESET_CANON(key);
index++;
}
syms[index] = SYM_0; // Null terminate
return syms;
}
//
// Rebind_Values_Deep: C
//
// Rebind all words that reference src target to dst target.
// Rebind is always deep.
//
void Rebind_Values_Deep(
REBCTX *src,
REBCTX *dst,
RELVAL *head,
struct Reb_Binder *opt_binder
) {
RELVAL *value = head;
for (; NOT_END(value); value++) {
if (ANY_ARRAY(value)) {
Rebind_Values_Deep(src, dst, VAL_ARRAY_AT(value), opt_binder);
}
else if (
ANY_WORD(value)
&& GET_VAL_FLAG(value, WORD_FLAG_BOUND)
&& !GET_VAL_FLAG(value, VALUE_FLAG_RELATIVE)
&& VAL_WORD_CONTEXT(KNOWN(value)) == src
) {
INIT_WORD_CONTEXT(value, dst);
if (opt_binder != NULL) {
INIT_WORD_INDEX(
value,
Try_Get_Binder_Index(opt_binder, VAL_WORD_CANON(value))
);
}
}
else if (IS_FUNCTION(value) && IS_FUNCTION_INTERPRETED(value)) {
//
// !!! Extremely questionable feature--walking into function
// bodies and changing them. This R3-Alpha concept was largely
// broken (didn't work for closures) and created a lot of extra
// garbage (inheriting an object's methods meant making deep
// copies of all that object's method bodies...each time).
// Ren-C has a different idea in the works.
//
Rebind_Values_Deep(
src, dst, VAL_FUNC_BODY(value), opt_binder
);
}
}
}
//
// RL_Set_Field: C
//
// Set a field (context variable) of an object.
//
// Returns:
// The type arg, or zero if word not found in object or if field is protected.
// Arguments:
// obj - object pointer (e.g. from RXA_OBJECT)
// word_id - global word identifier (integer)
// val - new value for field
// type - datatype of value
//
RL_API int RL_Set_Field(REBSER *obj, u32 word_id, RXIARG val, int type)
{
REBCTX *context = AS_CONTEXT(obj);
word_id = Find_Word_In_Context(context, word_id, FALSE);
if (word_id == 0) return 0;
if (GET_VAL_FLAG(CTX_KEY(context, word_id), TYPESET_FLAG_LOCKED))
return 0;
RXI_To_Value(CTX_VAR(context, word_id), &val, type);
return type;
}
//
// INIT_WORD_INDEX_Debug: C
//
void INIT_WORD_INDEX_Debug(RELVAL *v, REBCNT i)
{
assert(ANY_WORD(v));
assert(GET_VAL_FLAG((v), WORD_FLAG_BOUND));
if (IS_RELATIVE(v))
assert(
VAL_WORD_CANON(v)
== VAL_PARAM_CANON(FUNC_PARAM(VAL_WORD_FUNC(v), i))
);
else
assert(
VAL_WORD_CANON(v)
== CTX_KEY_CANON(VAL_WORD_CONTEXT(KNOWN(v)), i)
);
v->payload.any_word.index = i;
}
//
// IS_RELATIVE_Debug: C
//
// One should only be testing relvals for their relativeness or specificness,
// because all REBVAL* should be guaranteed to be speciic!
//
REBOOL IS_RELATIVE_Debug(const RELVAL *value)
{
return GET_VAL_FLAG(value, VALUE_FLAG_RELATIVE);
}
