//
// Val_Init_Context: C
//
// Common routine for initializing OBJECT, MODULE!, PORT!, and ERROR!
//
// A fully constructed context can reconstitute the ANY-CONTEXT! REBVAL that
// is its canon form from a single pointer...the REBVAL sitting in the 0 slot
// of the context's varlist.
//
void Val_Init_Context(REBVAL *out, enum Reb_Kind kind, REBCTX *context) {
//
// In a debug build we check to make sure the type of the embedded value
// matches the type of what is intended (so someone who thinks they are
// initializing a REB_OBJECT from a CONTEXT does not accidentally get a
// REB_ERROR, for instance.) It's a point for several other integrity
// checks as well.
//
#if !defined(NDEBUG)
REBVAL *value = CTX_VALUE(context);
assert(ANY_CONTEXT(value));
assert(CTX_TYPE(context) == kind);
assert(VAL_CONTEXT(value) == context);
if (!CTX_KEYLIST(context)) {
Debug_Fmt("Context found with no keylist set");
Panic_Context(context);
}
assert(GET_ARR_FLAG(CTX_VARLIST(context), ARRAY_FLAG_CONTEXT_VARLIST));
// !!! Historically spec is a frame of an object for a "module spec",
// may want to use another word of that and make a block "spec"
//
if (IS_FRAME(CTX_VALUE(context))) {
assert(IS_FUNCTION(FUNC_VALUE(CTX_FRAME_FUNC(context))));
}
else
assert(
NOT(CTX_SPEC(context))
|| ANY_CONTEXT(CTX_VALUE(CTX_SPEC(context)))
);
#endif
// Some contexts (stack frames in particular) start out unmanaged, and
// then check to see if an operation like Val_Init_Context set them to
// managed. If not, they will free the context. This avoids the need
// for the garbage collector to have to deal with the series if there's
// no reason too.
//
// Here is a case of where we mark the context as having an extant usage,
// so that at minimum this value must become unreachable from the root GC
// set before they are GC'd. For another case, see INIT_WORD_CONTEXT(),
// where an ANY-WORD! can mark a context as in use.
//
ENSURE_ARRAY_MANAGED(CTX_VARLIST(context));
// Keylists are different, because they may-or-may-not-be-reused by some
// operations. There needs to be a uniform policy on their management,
// or certain routines would return "sometimes managed, sometimes not"
// keylist series...a bad invariant.
//
ASSERT_ARRAY_MANAGED(CTX_KEYLIST(context));
*out = *CTX_VALUE(context);
}
//
// 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;
}
//
// Resolve_Path: C
//
// Given a path, return a context and index for its terminal.
//
REBCTX *Resolve_Path(REBVAL *path, REBCNT *index)
{
REBVAL *sel; // selector
const REBVAL *val;
REBARR *blk;
REBCNT i;
if (VAL_LEN_HEAD(path) < 2) return 0;
blk = VAL_ARRAY(path);
sel = ARR_HEAD(blk);
if (!ANY_WORD(sel)) return 0;
val = GET_OPT_VAR_MAY_FAIL(sel);
sel = ARR_AT(blk, 1);
while (TRUE) {
if (!ANY_CONTEXT(val) || !IS_WORD(sel)) return 0;
i = Find_Word_In_Context(VAL_CONTEXT(val), VAL_WORD_SYM(sel), FALSE);
sel++;
if (IS_END(sel)) {
*index = i;
return VAL_CONTEXT(val);
}
}
return 0; // never happens
}
//
// Resolve_Path: C
//
// Given a path, determine if it is ultimately specifying a selection out
// of a context...and if it is, return that context. So `a/obj/key` would
// return the object assocated with obj, while `a/str/1` would return
// NULL if `str` were a string as it's not an object selection.
//
// !!! This routine overlaps the logic of Do_Path, and should potentially
// be a mode of that instead. It is not very complete, considering that it
// does not execute GROUP! (and perhaps shouldn't?) and only supports a
// path that picks contexts out of other contexts, via word selection.
//
REBCTX *Resolve_Path(const REBVAL *path, REBCNT *index_out)
{
RELVAL *selector;
const REBVAL *var;
REBARR *array;
REBCNT i;
array = VAL_ARRAY(path);
selector = ARR_HEAD(array);
if (IS_END(selector) || !ANY_WORD(selector))
return NULL; // !!! only handles heads of paths that are ANY-WORD!
var = GET_OPT_VAR_MAY_FAIL(selector, VAL_SPECIFIER(path));
++selector;
if (IS_END(selector))
return NULL; // !!! does not handle single-element paths
while (ANY_CONTEXT(var) && IS_WORD(selector)) {
i = Find_Canon_In_Context(
VAL_CONTEXT(var), VAL_WORD_CANON(selector), FALSE
);
++selector;
if (IS_END(selector)) {
*index_out = i;
return VAL_CONTEXT(var);
}
var = CTX_VAR(VAL_CONTEXT(var), i);
}
DEAD_END;
}
//
// Uncolor_Array: C
//
void Uncolor_Array(REBARR *a)
{
if (Is_Series_White(SER(a)))
return; // avoid loop
Flip_Series_To_White(SER(a));
RELVAL *val;
for (val = ARR_HEAD(a); NOT_END(val); ++val)
if (ANY_ARRAY_OR_PATH(val) or IS_MAP(val) or ANY_CONTEXT(val))
Uncolor(val);
}
//
// Uncolor: C
//
// Clear the recusion markers for series and object trees.
//
void Uncolor(RELVAL *v)
{
REBARR *array;
if (ANY_ARRAY_OR_PATH(v))
array = VAL_ARRAY(v);
else if (IS_MAP(v))
array = MAP_PAIRLIST(VAL_MAP(v));
else if (ANY_CONTEXT(v))
array = CTX_VARLIST(VAL_CONTEXT(v));
else {
// Shouldn't have marked recursively any non-array series (no need)
//
assert(
not ANY_SERIES(v)
or Is_Series_White(VAL_SERIES(v))
);
return;
}
Uncolor_Array(array);
}
//
// In_Object: C
//
// Get value from nested list of objects. List is null terminated.
// Returns object value, else returns 0 if not found.
//
REBVAL *In_Object(REBCTX *base, ...)
{
REBVAL *context = NULL;
REBCNT n;
va_list va;
va_start(va, base);
while ((n = va_arg(va, REBCNT))) {
if (n > CTX_LEN(base)) {
va_end(va);
return NULL;
}
context = CTX_VAR(base, n);
if (!ANY_CONTEXT(context)) {
va_end(va);
return NULL;
}
base = VAL_CONTEXT(context);
}
va_end(va);
return context;
}
//
// Clonify: C
//
// Clone the series embedded in a value *if* it's in the given set of types
// (and if "cloning" makes sense for them, e.g. they are not simple scalars).
//
// Note: The resulting clones will be managed. The model for lists only
// allows the topmost level to contain unmanaged values...and we *assume* the
// values we are operating on here live inside of an array.
//
void Clonify(
REBVAL *v,
REBFLGS flags,
REBU64 types
){
if (C_STACK_OVERFLOWING(&types))
Fail_Stack_Overflow();
// !!! It may be possible to do this faster/better, the impacts on higher
// quoting levels could be incurring more cost than necessary...but for
// now err on the side of correctness. Unescape the value while cloning
// and then escape it back.
//
REBCNT num_quotes = VAL_NUM_QUOTES(v);
Dequotify(v);
enum Reb_Kind kind = cast(enum Reb_Kind, KIND_BYTE_UNCHECKED(v));
assert(kind < REB_MAX_PLUS_MAX); // we dequoted it (pseudotypes ok)
if (types & FLAGIT_KIND(kind) & TS_SERIES_OBJ) {
//
// Objects and series get shallow copied at minimum
//
REBSER *series;
if (ANY_CONTEXT(v)) {
INIT_VAL_CONTEXT_VARLIST(
v,
CTX_VARLIST(Copy_Context_Shallow_Managed(VAL_CONTEXT(v)))
);
series = SER(CTX_VARLIST(VAL_CONTEXT(v)));
}
else {
if (IS_SER_ARRAY(VAL_SERIES(v))) {
series = SER(
Copy_Array_At_Extra_Shallow(
VAL_ARRAY(v),
0, // !!! what if VAL_INDEX() is nonzero?
VAL_SPECIFIER(v),
0,
NODE_FLAG_MANAGED
)
);
INIT_VAL_NODE(v, series); // copies args
// If it was relative, then copying with a specifier
// means it isn't relative any more.
//
INIT_BINDING(v, UNBOUND);
}
else {
series = Copy_Sequence_Core(
VAL_SERIES(v),
NODE_FLAG_MANAGED
);
INIT_VAL_NODE(v, series);
}
}
// If we're going to copy deeply, we go back over the shallow
// copied series and "clonify" the values in it.
//
if (types & FLAGIT_KIND(kind) & TS_ARRAYS_OBJ) {
REBVAL *sub = KNOWN(ARR_HEAD(ARR(series)));
for (; NOT_END(sub); ++sub)
Clonify(sub, flags, types);
}
}
else if (types & FLAGIT_KIND(kind) & FLAGIT_KIND(REB_ACTION)) {
//
// !!! While Ren-C has abandoned the concept of copying the body
// of functions (they are black boxes which may not *have* a
// body), it would still theoretically be possible to do what
// COPY does and make a function with a new and independently
// hijackable identity. Assume for now it's better that the
// HIJACK of a method for one object will hijack it for all
// objects, and one must filter in the hijacking's body if one
// wants to take more specific action.
//
assert(false);
}
else {
// We're not copying the value, so inherit the const bit from the
// original value's point of view, if applicable.
//
if (NOT_CELL_FLAG(v, EXPLICITLY_MUTABLE))
v->header.bits |= (flags & ARRAY_FLAG_CONST_SHALLOW);
}
Quotify(v, num_quotes);
}
