//
// 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);
}
//
// Copy_And_Bind_Relative_Deep_Managed: C
//
// This routine is called by Make_Function in order to take the raw material
// given as a function body, and de-relativize any IS_RELATIVE(value)s that
// happen to be in it already (as any Copy does). But it also needs to make
// new relative references to ANY-WORD! that are referencing function
// parameters, as well as to relativize the copies of ANY-ARRAY! that contain
// these relative words...so that they refer to the archetypal function
// to which they should be relative.
//
REBARR *Copy_And_Bind_Relative_Deep_Managed(
const REBVAL *body,
REBARR *paramlist, // body of function is not actually ready yet
REBU64 bind_types
) {
// !!! Currently this is done in two phases, because the historical code
// would use the generic copying code and then do a bind phase afterward.
// Both phases are folded into this routine to make it easier to make
// a one-pass version when time permits.
//
REBARR *copy = COPY_ANY_ARRAY_AT_DEEP_MANAGED(body);
struct Reb_Binder binder;
INIT_BINDER(&binder);
// Setup binding table from the argument word list
//
REBCNT index = 1;
RELVAL *param = ARR_AT(paramlist, 1); // [0] is FUNCTION! value
for (; NOT_END(param); param++, index++)
Add_Binder_Index(&binder, VAL_KEY_CANON(param), index);
Bind_Relative_Inner_Loop(&binder, ARR_HEAD(copy), paramlist, bind_types);
// Reset binding table
//
param = ARR_AT(paramlist, 1); // [0] is FUNCTION! value
for (; NOT_END(param); param++)
Remove_Binder_Index(&binder, VAL_KEY_CANON(param));
SHUTDOWN_BINDER(&binder);
return copy;
}
//
// Bind_Values_Inner_Loop: C
//
// Bind_Values_Core() sets up the binding table and then calls
// this recursive routine to do the actual binding.
//
static void Bind_Values_Inner_Loop(
struct Reb_Binder *binder,
RELVAL *head,
REBCTX *context,
REBU64 bind_types, // !!! REVIEW: force word types low enough for 32-bit?
REBU64 add_midstream_types,
REBFLGS flags
) {
RELVAL *value = head;
for (; NOT_END(value); value++) {
REBU64 type_bit = FLAGIT_KIND(VAL_TYPE(value));
if (type_bit & bind_types) {
REBSTR *canon = VAL_WORD_CANON(value);
REBCNT n = Try_Get_Binder_Index(binder, canon);
if (n != 0) {
assert(n <= CTX_LEN(context));
// We're overwriting any previous binding, which may have
// been relative.
//
CLEAR_VAL_FLAG(value, VALUE_FLAG_RELATIVE);
SET_VAL_FLAG(value, WORD_FLAG_BOUND);
INIT_WORD_CONTEXT(value, context);
INIT_WORD_INDEX(value, n);
}
else if (type_bit & add_midstream_types) {
//
// Word is not in context, so add it if option is specified
//
Expand_Context(context, 1);
Append_Context(context, value, 0);
Add_Binder_Index(binder, canon, VAL_WORD_INDEX(value));
}
}
else if (ANY_ARRAY(value) && (flags & BIND_DEEP)) {
Bind_Values_Inner_Loop(
binder,
VAL_ARRAY_AT(value),
context,
bind_types,
add_midstream_types,
flags
);
}
else if (
IS_FUNCTION(value)
&& IS_FUNCTION_INTERPRETED(value)
&& (flags & BIND_FUNC)
) {
// !!! Likely-to-be deprecated functionality--rebinding inside the
// content of an already formed function. :-/
//
Bind_Values_Inner_Loop(
binder,
VAL_FUNC_BODY(value),
context,
bind_types,
add_midstream_types,
flags
);
}
}
}
//
// Make_Context_For_Action_Push_Partials: C
//
// This creates a FRAME! context with NULLED cells in the unspecialized slots
// that are available to be filled. For partial refinement specializations
// in the action, it will push the refinement to the stack. In this way it
// retains the ordering information implicit in the partial refinements of an
// action's existing specialization.
//
// It is able to take in more specialized refinements on the stack. These
// will be ordered *after* partial specializations in the function already.
// The caller passes in the stack pointer of the lowest priority refinement,
// which goes up to DSP for the highest of those added specializations.
//
// Since this is walking the parameters to make the frame already--and since
// we don't want to bind to anything specialized out (including the ad-hoc
// refinements added on the stack) we go ahead and collect bindings from the
// frame if needed.
//
REBCTX *Make_Context_For_Action_Push_Partials(
const REBVAL *action, // need ->binding, so can't just be a REBACT*
REBDSP lowest_ordered_dsp, // caller can add refinement specializations
struct Reb_Binder *opt_binder,
REBFLGS prep // cell formatting mask bits, result managed if non-stack
){
REBDSP highest_ordered_dsp = DSP;
REBACT *act = VAL_ACTION(action);
REBCNT num_slots = ACT_NUM_PARAMS(act) + 1; // +1 is for CTX_ARCHETYPE()
REBARR *varlist = Make_Array_Core(num_slots, SERIES_MASK_VARLIST);
REBVAL *rootvar = RESET_CELL(
ARR_HEAD(varlist),
REB_FRAME,
CELL_MASK_CONTEXT
);
INIT_VAL_CONTEXT_VARLIST(rootvar, varlist);
INIT_VAL_CONTEXT_PHASE(rootvar, VAL_ACTION(action));
INIT_BINDING(rootvar, VAL_BINDING(action));
const REBVAL *param = ACT_PARAMS_HEAD(act);
REBVAL *arg = rootvar + 1;
const REBVAL *special = ACT_SPECIALTY_HEAD(act); // of exemplar/paramlist
REBCNT index = 1; // used to bind REFINEMENT! values to parameter slots
REBCTX *exemplar = ACT_EXEMPLAR(act); // may be null
if (exemplar)
assert(special == CTX_VARS_HEAD(exemplar));
else
assert(special == ACT_PARAMS_HEAD(act));
for (; NOT_END(param); ++param, ++arg, ++special, ++index) {
arg->header.bits = prep;
if (Is_Param_Hidden(param)) { // specialized out
assert(GET_CELL_FLAG(special, ARG_MARKED_CHECKED));
Move_Value(arg, special); // doesn't copy ARG_MARKED_CHECKED
SET_CELL_FLAG(arg, ARG_MARKED_CHECKED);
continue_specialized:
assert(not IS_NULLED(arg));
assert(GET_CELL_FLAG(arg, ARG_MARKED_CHECKED));
continue; // Eval_Core() double-checks type in debug build
}
assert(NOT_CELL_FLAG(special, ARG_MARKED_CHECKED));
REBSTR *canon = VAL_PARAM_CANON(param); // for adding to binding
if (not TYPE_CHECK(param, REB_TS_REFINEMENT)) { // nothing to push
continue_unspecialized:
assert(arg->header.bits == prep);
Init_Nulled(arg);
if (opt_binder) {
if (not Is_Param_Unbindable(param))
Add_Binder_Index(opt_binder, canon, index);
}
continue;
}
// Unspecialized refinement slots may have an SYM-WORD! in them that
// reflects a partial that needs to be pushed to the stack. (They
// are in *reverse* order of use.)
assert(
(special == param and IS_PARAM(special))
or (IS_SYM_WORD(special) or IS_NULLED(special))
);
if (IS_SYM_WORD(special)) {
REBCNT partial_index = VAL_WORD_INDEX(special);
Init_Any_Word_Bound( // push a SYM-WORD! to data stack
DS_PUSH(),
REB_SYM_WORD,
VAL_STORED_CANON(special),
exemplar,
partial_index
);
}
// Unspecialized or partially specialized refinement. Check the
// passed-in refinements on the stack for usage.
//
REBDSP dsp = highest_ordered_dsp;
for (; dsp != lowest_ordered_dsp; --dsp) {
REBVAL *ordered = DS_AT(dsp);
if (VAL_STORED_CANON(ordered) != canon)
continue; // just continuing this loop
assert(not IS_WORD_BOUND(ordered)); // we bind only one
INIT_BINDING(ordered, varlist);
INIT_WORD_INDEX_UNCHECKED(ordered, index);
if (not Is_Typeset_Invisible(param)) // needs argument
goto continue_unspecialized;
// If refinement named on stack takes no arguments, then it can't
// be partially specialized...only fully, and won't be bound:
//
// specialize 'append/only [only: false] ; only not bound
//
Init_Word(arg, VAL_STORED_CANON(ordered));
Refinify(arg);
SET_CELL_FLAG(arg, ARG_MARKED_CHECKED);
goto continue_specialized;
}
goto continue_unspecialized;
}
TERM_ARRAY_LEN(varlist, num_slots);
MISC_META_NODE(varlist) = nullptr; // GC sees this, we must initialize
// !!! Can't pass SERIES_FLAG_STACK_LIFETIME into Make_Array_Core(),
// because TERM_ARRAY_LEN won't let it set stack array lengths.
//
if (prep & CELL_FLAG_STACK_LIFETIME)
SET_SERIES_FLAG(varlist, STACK_LIFETIME);
INIT_CTX_KEYLIST_SHARED(CTX(varlist), ACT_PARAMLIST(act));
return CTX(varlist);
}
