//
// Do_Path_Throws: C
//
// Evaluate an ANY_PATH! REBVAL, starting from the index position of that
// path value and continuing to the end.
//
// The evaluator may throw because GROUP! is evaluated, e.g. `foo/(throw 1020)`
//
// If label_sym is passed in as being non-null, then the caller is implying
// readiness to process a path which may be a function with refinements.
// These refinements will be left in order on the data stack in the case
// that `out` comes back as IS_FUNCTION().
//
// If `opt_setval` is given, the path operation will be done as a "SET-PATH!"
// if the path evaluation did not throw or error. HOWEVER the set value
// is NOT put into `out`. This provides more flexibility on performance in
// the evaluator, which may already have the `val` where it wants it, and
// so the extra assignment would just be overhead.
//
// !!! Path evaluation is one of the parts of R3-Alpha that has not been
// vetted very heavily by Ren-C, and needs a review and overhaul.
//
REBOOL Do_Path_Throws(
REBVAL *out,
REBSYM *label_sym,
const REBVAL *path,
REBVAL *opt_setval
) {
REBPVS pvs;
REBDSP dsp_orig = DSP;
assert(ANY_PATH(path));
// !!! There is a bug in the dispatch such that if you are running a
// set path, it does not always assign the output, because it "thinks you
// aren't going to look at it". This presumably originated from before
// parens were allowed in paths, and neglects cases like:
//
// foo/(throw 1020): value
//
// We always have to check to see if a throw occurred. Until this is
// streamlined, we have to at minimum set it to something that is *not*
// thrown so that we aren't testing uninitialized memory. A safe trash
// will do, which is unset in release builds.
//
if (opt_setval)
SET_TRASH_SAFE(out);
// None of the values passed in can live on the data stack, because
// they might be relocated during the path evaluation process.
//
assert(!IN_DATA_STACK(out));
assert(!IN_DATA_STACK(path));
assert(!opt_setval || !IN_DATA_STACK(opt_setval));
// Not currently robust for reusing passed in path or value as the output
assert(out != path && out != opt_setval);
assert(!opt_setval || !THROWN(opt_setval));
// Initialize REBPVS -- see notes in %sys-do.h
//
pvs.opt_setval = opt_setval;
pvs.store = out;
pvs.orig = path;
pvs.item = VAL_ARRAY_AT(pvs.orig); // may not be starting at head of PATH!
// Seed the path evaluation process by looking up the first item (to
// get a datatype to dispatch on for the later path items)
//
if (IS_WORD(pvs.item)) {
pvs.value = GET_MUTABLE_VAR_MAY_FAIL(pvs.item);
if (IS_UNSET(pvs.value))
fail (Error(RE_NO_VALUE, pvs.item));
}
else {
// !!! Ideally there would be some way to protect pvs.value during
// successive path dispatches to make sure it does not get written.
// This is semi-dangerously giving pvs.value a reference into the
// input path, which should not be modified!
pvs.value = VAL_ARRAY_AT(pvs.orig);
}
// Start evaluation of path:
if (IS_END(pvs.item + 1)) {
// If it was a single element path, return the value rather than
// try to dispatch it (would cause a crash at time of writing)
//
// !!! Is this the desired behavior, or should it be an error?
}
else if (Path_Dispatch[VAL_TYPE_0(pvs.value)]) {
REBOOL threw = Next_Path_Throws(&pvs);
// !!! See comments about why the initialization of out is necessary.
// Without it this assertion can change on some things:
//
// t: now
// t/time: 10:20:03
//
// (It thinks pvs.value has its THROWN bit set when it completed
// successfully. It was a PE_USE_STORE case where pvs.value was reset to
// pvs.store, and pvs.store has its thrown bit set. Valgrind does not
// catch any uninitialized variables.)
//
// There are other cases that do trip valgrind when omitting the
// initialization, though not as clearly reproducible.
//
assert(threw == THROWN(pvs.value));
if (threw) return TRUE;
// Check for errors:
if (NOT_END(pvs.item + 1) && !IS_FUNCTION(pvs.value)) {
// Only function refinements should get by this line:
fail (Error(RE_INVALID_PATH, pvs.orig, pvs.item));
}
}
else if (!IS_FUNCTION(pvs.value))
fail (Error(RE_BAD_PATH_TYPE, pvs.orig, Type_Of(pvs.value)));
if (opt_setval) {
// If SET then we don't return anything
assert(IS_END(pvs.item) + 1);
return FALSE;
}
// If storage was not used, then copy final value back to it:
if (pvs.value != pvs.store) *pvs.store = *pvs.value;
assert(!THROWN(out));
// Return 0 if not function or is :path/word...
if (!IS_FUNCTION(pvs.value)) {
assert(IS_END(pvs.item) + 1);
return FALSE;
}
if (label_sym) {
REBVAL refinement;
VAL_INIT_WRITABLE_DEBUG(&refinement);
// When a function is hit, path processing stops as soon as the
// processed sub-path resolves to a function. The path is still sitting
// on the position of the last component of that sub-path. Usually,
// this last component in the sub-path is a word naming the function.
//
if (IS_WORD(pvs.item)) {
*label_sym = VAL_WORD_SYM(pvs.item);
}
else {
// In rarer cases, the final component (completing the sub-path to
// the function to call) is not a word. Such as when you use a path
// to pick by index out of a block of functions:
//
// functions: reduce [:add :subtract]
// functions/1 10 20
//
// Or when you have an immediate function value in a path with a
// refinement. Tricky to make, but possible:
//
// do reduce [
// to-path reduce [:append 'only] [a] [b]
// ]
//
// !!! When a function was not invoked through looking up a word
// (or a word in a path) to use as a label, there were once three
// different alternate labels used. One was SYM__APPLY_, another
// was ROOT_NONAME, and another was to be the type of the function
// being executed. None are fantastic, we do the type for now.
*label_sym = SYM_FROM_KIND(VAL_TYPE(pvs.value));
}
// Move on to the refinements (if any)
++pvs.item;
// !!! Currently, the mainline path evaluation "punts" on refinements.
// When it finds a function, it stops the path evaluation and leaves
// the position pvs.path before the list of refinements.
//
// A more elegant solution would be able to process and notice (for
// instance) that `:APPEND/ONLY` should yield a function value that
// has been specialized with a refinement. Path chaining should thus
// be able to effectively do this and give the refined function object
// back to the evaluator or other client.
//
// If a label_sym is passed in, we recognize that a function dispatch
// is going to be happening. We do not want to pay to generate the
// new series that would be needed to make a temporary function that
// will be invoked and immediately GC'd So we gather the refinements
// on the data stack.
//
// This code simulates that path-processing-to-data-stack, but it
// should really be something in dispatch iself. In any case, we put
// refinements on the data stack...and caller knows refinements are
// from dsp_orig to DSP (thanks to accounting, all other operations
// should balance!)
for (; NOT_END(pvs.item); ++pvs.item) { // "the refinements"
if (IS_NONE(pvs.item)) continue;
if (IS_GROUP(pvs.item)) {
// Note it is not legal to use the data stack directly as the
// output location for a DO (might be resized)
if (DO_VAL_ARRAY_AT_THROWS(&refinement, pvs.item)) {
*out = refinement;
DS_DROP_TO(dsp_orig);
return TRUE;
}
if (IS_NONE(&refinement)) continue;
DS_PUSH(&refinement);
}
else if (IS_GET_WORD(pvs.item)) {
DS_PUSH_TRASH;
*DS_TOP = *GET_OPT_VAR_MAY_FAIL(pvs.item);
if (IS_NONE(DS_TOP)) {
DS_DROP;
continue;
}
}
else DS_PUSH(pvs.item);
// Whatever we were trying to use as a refinement should now be
// on the top of the data stack, and only words are legal ATM
//
if (!IS_WORD(DS_TOP))
fail (Error(RE_BAD_REFINE, DS_TOP));
// Go ahead and canonize the word symbol so we don't have to
// do it each time in order to get a case-insenstive compare
//
INIT_WORD_SYM(DS_TOP, SYMBOL_TO_CANON(VAL_WORD_SYM(DS_TOP)));
}
// To make things easier for processing, reverse the refinements on
// the data stack (we needed to evaluate them in forward order).
// This way we can just pop them as we go, and know if they weren't
// all consumed if it doesn't get back to `dsp_orig` by the end.
if (dsp_orig != DSP) {
REBVAL *bottom = DS_AT(dsp_orig + 1);
REBVAL *top = DS_TOP;
while (top > bottom) {
refinement = *bottom;
*bottom = *top;
*top = refinement;
top--;
bottom++;
}
}
}
else {
// !!! Historically this just ignores a result indicating this is a
// function with refinements, e.g. ':append/only'. However that
// ignoring seems unwise. It should presumably create a modified
// function in that case which acts as if it has the refinement.
//
// If the caller did not pass in a label pointer we assume they are
// likely not ready to process any refinements.
//
if (NOT_END(pvs.item + 1))
fail (Error(RE_TOO_LONG)); // !!! Better error or add feature
}
return FALSE;
}
//
// For_Each_Unspecialized_Param: C
//
// We have to take into account specialization of refinements in order to know
// the correct order. If someone has:
//
// foo: func [a [integer!] /b [integer!] /c [integer!]] [...]
//
// They can partially specialize this as :foo/c/b. This makes it seem to the
// caller a function originally written with spec:
//
// [a [integer!] c [integer!] b [integer!]]
//
// But the frame order doesn't change; the information for knowing the order
// is encoded with instructions occupying the non-fully-specialized slots.
// (See %c-specialize.c for a description of the mechanic.)
//
// The true order could be cached when the function is generated, but to keep
// things "simple" we capture the behavior in this routine.
//
// Unspecialized parameters are visited in two passes: unsorted, then sorted.
//
void For_Each_Unspecialized_Param(
REBACT *act,
PARAM_HOOK hook,
void *opaque
){
REBDSP dsp_orig = DSP;
// Do an initial scan to push the partial refinements in the reverse
// order that they apply. While walking the parameters in a potentially
// "unsorted" fashion, offer them to the passed-in hook in case it has a
// use for this first pass (e.g. just counting, to make an array big
// enough to hold what's going to be given to it in the second pass.
REBVAL *param = ACT_PARAMS_HEAD(act);
REBVAL *special = ACT_SPECIALTY_HEAD(act);
REBCNT index = 1;
for (; NOT_END(param); ++param, ++special, ++index) {
if (Is_Param_Hidden(param))
continue; // specialized out, not in interface
Reb_Param_Class pclass = VAL_PARAM_CLASS(param);
if (pclass == REB_P_RETURN or pclass == REB_P_LOCAL)
continue; // locals not in interface
if (not hook(param, false, opaque)) { // false => unsorted pass
DS_DROP_TO(dsp_orig);
return;
}
if (IS_SYM_WORD(special)) {
assert(TYPE_CHECK(param, REB_TS_REFINEMENT));
Move_Value(DS_PUSH(), special);
}
}
// Refinements are now on stack such that topmost is first in-use
// specialized refinement.
// Now second loop, where we print out just the normal args.
//
param = ACT_PARAMS_HEAD(act);
for (; NOT_END(param); ++param) {
if (Is_Param_Hidden(param))
continue;
if (TYPE_CHECK(param, REB_TS_REFINEMENT))
continue;
Reb_Param_Class pclass = VAL_PARAM_CLASS(param);
if (pclass == REB_P_LOCAL or pclass == REB_P_RETURN)
continue;
if (not hook(param, true, opaque)) { // true => sorted pass
DS_DROP_TO(dsp_orig);
return;
}
}
// Now jump around and take care of the partial refinements.
DECLARE_LOCAL (unrefined);
REBDSP dsp = DSP; // highest priority are at *top* of stack, go downward
while (dsp != dsp_orig) {
param = ACT_PARAM(act, VAL_WORD_INDEX(DS_AT(dsp)));
--dsp;
Move_Value(unrefined, param);
assert(TYPE_CHECK(unrefined, REB_TS_REFINEMENT));
TYPE_CLEAR(unrefined, REB_TS_REFINEMENT);
PUSH_GC_GUARD(unrefined);
bool cancel = not hook(unrefined, true, opaque); // true => sorted
DROP_GC_GUARD(unrefined);
if (cancel) {
DS_DROP_TO(dsp_orig);
return;
}
}
// Finally, output any fully unspecialized refinements
param = ACT_PARAMS_HEAD(act);
for (; NOT_END(param); ++param) {
if (Is_Param_Hidden(param))
continue;
if (not TYPE_CHECK(param, REB_TS_REFINEMENT))
continue;
dsp = dsp_orig;
while (dsp != DSP) {
++dsp;
if (SAME_STR(
VAL_WORD_SPELLING(DS_AT(dsp)),
VAL_PARAM_SPELLING(param)
)){
goto continue_unspecialized_loop;
}
}
if (not hook(param, true, opaque)) { // true => sorted pass
DS_DROP_TO(dsp_orig);
return; // stack should be balanced here
}
continue_unspecialized_loop:
NOOP;
}
DS_DROP_TO(dsp_orig);
}
//
// 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);
}
//
// Specialize_Action_Throws: C
//
// Create a new ACTION! value that uses the same implementation as another,
// but just takes fewer arguments or refinements. It does this by storing a
// heap-based "exemplar" FRAME! in the specialized action; this stores the
// values to preload in the stack frame cells when it is invoked.
//
// The caller may provide information on the order in which refinements are
// to be specialized, using the data stack. These refinements should be
// pushed in the *reverse* order of their invocation, so append/dup/part
// has /DUP at DS_TOP, and /PART under it. List stops at lowest_ordered_dsp.
//
bool Specialize_Action_Throws(
REBVAL *out,
REBVAL *specializee,
REBSTR *opt_specializee_name,
REBVAL *opt_def, // !!! REVIEW: binding modified directly (not copied)
REBDSP lowest_ordered_dsp
){
assert(out != specializee);
struct Reb_Binder binder;
if (opt_def)
INIT_BINDER(&binder);
REBACT *unspecialized = VAL_ACTION(specializee);
// This produces a context where partially specialized refinement slots
// will be on the stack (including any we are adding "virtually", from
// the current DSP down to the lowest_ordered_dsp).
//
REBCTX *exemplar = Make_Context_For_Action_Push_Partials(
specializee,
lowest_ordered_dsp,
opt_def ? &binder : nullptr,
CELL_MASK_NON_STACK
);
Manage_Array(CTX_VARLIST(exemplar)); // destined to be managed, guarded
if (opt_def) { // code that fills the frame...fully or partially
//
// Bind all the SET-WORD! in the body that match params in the frame
// into the frame. This means `value: value` can very likely have
// `value:` bound for assignments into the frame while `value` refers
// to whatever value was in the context the specialization is running
// in, but this is likely the more useful behavior.
//
// !!! This binds the actual arg data, not a copy of it--following
// OBJECT!'s lead. However, ordinary functions make a copy of the
// body they are passed before rebinding. Rethink.
// See Bind_Values_Core() for explanations of how the binding works.
Bind_Values_Inner_Loop(
&binder,
VAL_ARRAY_AT(opt_def),
exemplar,
FLAGIT_KIND(REB_SET_WORD), // types to bind (just set-word!)
0, // types to "add midstream" to binding as we go (nothing)
BIND_DEEP
);
// !!! Only one binder can be in effect, and we're calling arbitrary
// code. Must clean up now vs. in loop we do at the end. :-(
//
RELVAL *key = CTX_KEYS_HEAD(exemplar);
REBVAL *var = CTX_VARS_HEAD(exemplar);
for (; NOT_END(key); ++key, ++var) {
if (Is_Param_Unbindable(key))
continue; // !!! is this flag still relevant?
if (Is_Param_Hidden(key)) {
assert(GET_CELL_FLAG(var, ARG_MARKED_CHECKED));
continue;
}
if (GET_CELL_FLAG(var, ARG_MARKED_CHECKED))
continue; // may be refinement from stack, now specialized out
Remove_Binder_Index(&binder, VAL_KEY_CANON(key));
}
SHUTDOWN_BINDER(&binder);
// Run block and ignore result (unless it is thrown)
//
PUSH_GC_GUARD(exemplar);
bool threw = Do_Any_Array_At_Throws(out, opt_def, SPECIFIED);
DROP_GC_GUARD(exemplar);
if (threw) {
DS_DROP_TO(lowest_ordered_dsp);
return true;
}
}
REBVAL *rootkey = CTX_ROOTKEY(exemplar);
// Build up the paramlist for the specialized function on the stack.
// The same walk used for that is used to link and process REB_X_PARTIAL
// arguments for whether they become fully specialized or not.
REBDSP dsp_paramlist = DSP;
Move_Value(DS_PUSH(), ACT_ARCHETYPE(unspecialized));
REBVAL *param = rootkey + 1;
REBVAL *arg = CTX_VARS_HEAD(exemplar);
REBDSP ordered_dsp = lowest_ordered_dsp;
for (; NOT_END(param); ++param, ++arg) {
if (TYPE_CHECK(param, REB_TS_REFINEMENT)) {
if (IS_NULLED(arg)) {
//
// A refinement that is nulled is a candidate for usage at the
// callsite. Hence it must be pre-empted by our ordered
// overrides. -but- the overrides only apply if their slot
// wasn't filled by the user code. Yet these values we are
// putting in disrupt that detection (!), so use another
// flag (PUSH_PARTIAL) to reflect this state.
//
while (ordered_dsp != dsp_paramlist) {
++ordered_dsp;
REBVAL *ordered = DS_AT(ordered_dsp);
if (not IS_WORD_BOUND(ordered)) // specialize 'print/asdf
fail (Error_Bad_Refine_Raw(ordered));
REBVAL *slot = CTX_VAR(exemplar, VAL_WORD_INDEX(ordered));
if (
IS_NULLED(slot) or GET_CELL_FLAG(slot, PUSH_PARTIAL)
){
// It's still partial, so set up the pre-empt.
//
Init_Any_Word_Bound(
arg,
REB_SYM_WORD,
VAL_STORED_CANON(ordered),
exemplar,
VAL_WORD_INDEX(ordered)
);
SET_CELL_FLAG(arg, PUSH_PARTIAL);
goto unspecialized_arg;
}
// Otherwise the user filled it in, so skip to next...
}
goto unspecialized_arg; // ran out...no pre-empt needed
}
if (GET_CELL_FLAG(arg, ARG_MARKED_CHECKED)) {
assert(
IS_BLANK(arg)
or (
IS_REFINEMENT(arg)
and (
VAL_REFINEMENT_SPELLING(arg)
== VAL_PARAM_SPELLING(param)
)
)
);
}
else
Typecheck_Refinement_And_Canonize(param, arg);
goto specialized_arg_no_typecheck;
}
switch (VAL_PARAM_CLASS(param)) {
case REB_P_RETURN:
case REB_P_LOCAL:
assert(IS_NULLED(arg)); // no bindings, you can't set these
goto unspecialized_arg;
default:
break;
}
// It's an argument, either a normal one or a refinement arg.
if (not IS_NULLED(arg))
goto specialized_arg_with_check;
unspecialized_arg:
assert(NOT_CELL_FLAG(arg, ARG_MARKED_CHECKED));
assert(
IS_NULLED(arg)
or (IS_SYM_WORD(arg) and TYPE_CHECK(param, REB_TS_REFINEMENT))
);
Move_Value(DS_PUSH(), param);
continue;
specialized_arg_with_check:
// !!! If argument was previously specialized, should have been type
// checked already... don't type check again (?)
//
if (Is_Param_Variadic(param))
fail ("Cannot currently SPECIALIZE variadic arguments.");
if (TYPE_CHECK(param, REB_TS_DEQUOTE_REQUOTE) and IS_QUOTED(arg)) {
//
// Have to leave the quotes on, but still want to type check.
if (not TYPE_CHECK(param, CELL_KIND(VAL_UNESCAPED(arg))))
fail (arg); // !!! merge w/Error_Invalid_Arg()
}
else if (not TYPE_CHECK(param, VAL_TYPE(arg)))
fail (arg); // !!! merge w/Error_Invalid_Arg()
SET_CELL_FLAG(arg, ARG_MARKED_CHECKED);
specialized_arg_no_typecheck:
// Specialized-out arguments must still be in the parameter list,
// for enumeration in the evaluator to line up with the frame values
// of the underlying function.
assert(GET_CELL_FLAG(arg, ARG_MARKED_CHECKED));
Move_Value(DS_PUSH(), param);
TYPE_SET(DS_TOP, REB_TS_HIDDEN);
continue;
}
REBARR *paramlist = Pop_Stack_Values_Core(
dsp_paramlist,
SERIES_MASK_PARAMLIST
| (SER(unspecialized)->header.bits & PARAMLIST_MASK_INHERIT)
);
Manage_Array(paramlist);
RELVAL *rootparam = ARR_HEAD(paramlist);
VAL_ACT_PARAMLIST_NODE(rootparam) = NOD(paramlist);
// Everything should have balanced out for a valid specialization
//
while (ordered_dsp != DSP) {
++ordered_dsp;
REBVAL *ordered = DS_AT(ordered_dsp);
if (not IS_WORD_BOUND(ordered)) // specialize 'print/asdf
fail (Error_Bad_Refine_Raw(ordered));
REBVAL *slot = CTX_VAR(exemplar, VAL_WORD_INDEX(ordered));
assert(not IS_NULLED(slot) and NOT_CELL_FLAG(slot, PUSH_PARTIAL));
UNUSED(slot);
}
DS_DROP_TO(lowest_ordered_dsp);
// See %sysobj.r for `specialized-meta:` object template
REBVAL *example = Get_System(SYS_STANDARD, STD_SPECIALIZED_META);
REBCTX *meta = Copy_Context_Shallow_Managed(VAL_CONTEXT(example));
Init_Nulled(CTX_VAR(meta, STD_SPECIALIZED_META_DESCRIPTION)); // default
Move_Value(
CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE),
specializee
);
if (not opt_specializee_name)
Init_Nulled(CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE_NAME));
else
Init_Word(
CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE_NAME),
opt_specializee_name
);
MISC_META_NODE(paramlist) = NOD(meta);
REBACT *specialized = Make_Action(
paramlist,
&Specializer_Dispatcher,
ACT_UNDERLYING(unspecialized), // same underlying action as this
exemplar, // also provide a context of specialization values
1 // details array capacity
);
assert(CTX_KEYLIST(exemplar) == ACT_PARAMLIST(unspecialized));
assert(
GET_ACTION_FLAG(specialized, IS_INVISIBLE)
== GET_ACTION_FLAG(unspecialized, IS_INVISIBLE)
);
// The "body" is the FRAME! value of the specialization. It takes on the
// binding we want to use (which we can't put in the exemplar archetype,
// that binding has to be UNBOUND). It also remembers the original
// action in the phase, so Specializer_Dispatcher() knows what to call.
//
RELVAL *body = ARR_HEAD(ACT_DETAILS(specialized));
Move_Value(body, CTX_ARCHETYPE(exemplar));
INIT_BINDING(body, VAL_BINDING(specializee));
INIT_VAL_CONTEXT_PHASE(body, unspecialized);
Init_Action_Unbound(out, specialized);
return false; // code block did not throw
}