// // 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); }