//
// Destroy_External_Storage: C
//
// Destroy the external storage pointed by `->data` by calling the routine
// `free_func` if it's not NULL
//
// out Result
// ser The series
// free_func A routine to free the storage, if it's NULL, only mark the
// external storage non-accessible
//
REB_R Destroy_External_Storage(REBVAL *out,
REBSER *ser,
REBVAL *free_func)
{
SET_VOID(out);
if (!GET_SER_FLAG(ser, SERIES_FLAG_EXTERNAL)) {
fail (Error(RE_NO_EXTERNAL_STORAGE));
}
if (!GET_SER_FLAG(ser, SERIES_FLAG_ACCESSIBLE)) {
REBVAL i;
SET_INTEGER(&i, cast(REBUPT, SER_DATA_RAW(ser)));
fail (Error(RE_ALREADY_DESTROYED, &i));
}
CLEAR_SER_FLAG(ser, SERIES_FLAG_ACCESSIBLE);
if (free_func) {
REBVAL safe;
REBARR *array;
REBVAL *elem;
REBOOL threw;
array = Make_Array(2);
MANAGE_ARRAY(array);
PUSH_GUARD_ARRAY(array);
elem = Alloc_Tail_Array(array);
*elem = *free_func;
elem = Alloc_Tail_Array(array);
SET_INTEGER(elem, cast(REBUPT, SER_DATA_RAW(ser)));
threw = Do_At_Throws(&safe, array, 0, SPECIFIED); // 2 non-relative val
DROP_GUARD_ARRAY(array);
if (threw) return R_OUT_IS_THROWN;
}
return R_OUT;
}
*/ RL_API int RL_Do_String(int *exit_status, const REBYTE *text, REBCNT flags, RXIARG *result)
/*
** Load a string and evaluate the resulting block.
**
** Returns:
** The datatype of the result if a positive number (or 0 if the
** type has no representation in the "RXT" API). An error code
** if it's a negative number. Two negative numbers are reserved
** for non-error conditions: -1 for halting (e.g. Escape), and
** -2 is reserved for exiting with exit_status set.
**
** Arguments:
** text - A null terminated UTF-8 (or ASCII) string to transcode
** into a block and evaluate.
** flags - set to zero for now
** result - value returned from evaluation, if NULL then result
** will be returned on the top of the stack
**
** Notes:
** This API was from before Rebol's open sourcing and had little
** vetting and few clients. The one client it did have was the
** "sample" console code (which wound up being the "only"
** console code for quite some time).
**
***********************************************************************/
{
REBSER *code;
REBVAL out;
REBOL_STATE state;
const REBVAL *error;
// assumes it can only be run at the topmost level where
// the data stack is completely empty.
assert(DSP == -1);
PUSH_UNHALTABLE_TRAP(&error, &state);
// The first time through the following code 'error' will be NULL, but...
// `raise Error` can longjmp here, so 'error' won't be NULL *if* that happens!
if (error) {
if (VAL_ERR_NUM(error) == RE_HALT)
return -1; // !!! Revisit hardcoded #
// Save error for WHY?
*Get_System(SYS_STATE, STATE_LAST_ERROR) = *error;
if (result)
*result = Value_To_RXI(error);
else
DS_PUSH(error);
return -VAL_ERR_NUM(error);
}
code = Scan_Source(text, LEN_BYTES(text));
PUSH_GUARD_SERIES(code);
// Bind into lib or user spaces?
if (flags) {
// Top words will be added to lib:
Bind_Values_Set_Forward_Shallow(BLK_HEAD(code), Lib_Context);
Bind_Values_Deep(BLK_HEAD(code), Lib_Context);
} else {
REBCNT len;
REBVAL vali;
REBSER *user = VAL_OBJ_FRAME(Get_System(SYS_CONTEXTS, CTX_USER));
len = user->tail;
Bind_Values_All_Deep(BLK_HEAD(code), user);
SET_INTEGER(&vali, len);
Resolve_Context(user, Lib_Context, &vali, FALSE, 0);
}
if (Do_At_Throws(&out, code, 0)) {
DROP_GUARD_SERIES(code);
if (
IS_NATIVE(&out) && (
VAL_FUNC_CODE(&out) == VAL_FUNC_CODE(ROOT_QUIT_NATIVE)
|| VAL_FUNC_CODE(&out) == VAL_FUNC_CODE(ROOT_EXIT_NATIVE)
)
) {
CATCH_THROWN(&out, &out);
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
*exit_status = Exit_Status_From_Value(&out);
return -2; // Revisit hardcoded #
}
raise Error_No_Catch_For_Throw(&out);
}
DROP_GUARD_SERIES(code);
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
if (result)
*result = Value_To_RXI(&out);
else
DS_PUSH(&out);
return Reb_To_RXT[VAL_TYPE(&out)];
}
//
// RL_Do_String: C
//
// Load a string and evaluate the resulting block.
//
// Returns:
// The datatype of the result if a positive number (or 0 if the
// type has no representation in the "RXT" API). An error code
// if it's a negative number. Two negative numbers are reserved
// for non-error conditions: -1 for halting (e.g. Escape), and
// -2 is reserved for exiting with exit_status set.
//
// Arguments:
// text - A null terminated UTF-8 (or ASCII) string to transcode
// into a block and evaluate.
// flags - set to zero for now
// result - value returned from evaluation, if NULL then result
// will be returned on the top of the stack
//
// Notes:
// This API was from before Rebol's open sourcing and had little
// vetting and few clients. The one client it did have was the
// "sample" console code (which wound up being the "only"
// console code for quite some time).
//
RL_API int RL_Do_String(
int *exit_status,
const REBYTE *text,
REBCNT flags,
RXIARG *out
) {
REBARR *code;
struct Reb_State state;
REBCTX *error;
REBVAL result;
VAL_INIT_WRITABLE_DEBUG(&result);
// assumes it can only be run at the topmost level where
// the data stack is completely empty.
//
assert(DSP == 0);
PUSH_UNHALTABLE_TRAP(&error, &state);
// The first time through the following code 'error' will be NULL, but...
// `fail` can longjmp here, so 'error' won't be NULL *if* that happens!
if (error) {
// Save error for WHY?
REBVAL *last = Get_System(SYS_STATE, STATE_LAST_ERROR);
Val_Init_Error(last, error);
if (ERR_NUM(error) == RE_HALT)
return -1; // !!! Revisit hardcoded #
if (out)
Value_To_RXI(out, last);
else
DS_PUSH(last);
return -ERR_NUM(error);
}
code = Scan_Source(text, LEN_BYTES(text));
PUSH_GUARD_ARRAY(code);
// Bind into lib or user spaces?
if (flags) {
// Top words will be added to lib:
Bind_Values_Set_Midstream_Shallow(ARR_HEAD(code), Lib_Context);
Bind_Values_Deep(ARR_HEAD(code), Lib_Context);
}
else {
REBCTX *user = VAL_CONTEXT(Get_System(SYS_CONTEXTS, CTX_USER));
REBVAL vali;
VAL_INIT_WRITABLE_DEBUG(&vali);
SET_INTEGER(&vali, CTX_LEN(user) + 1);
Bind_Values_All_Deep(ARR_HEAD(code), user);
Resolve_Context(user, Lib_Context, &vali, FALSE, FALSE);
}
if (Do_At_Throws(&result, code, 0)) {
DROP_GUARD_ARRAY(code);
if (
IS_FUNCTION_AND(&result, FUNC_CLASS_NATIVE) && (
VAL_FUNC_CODE(&result) == &N_quit
|| VAL_FUNC_CODE(&result) == &N_exit
)
) {
CATCH_THROWN(&result, &result);
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
*exit_status = Exit_Status_From_Value(&result);
return -2; // Revisit hardcoded #
}
fail (Error_No_Catch_For_Throw(&result));
}
DROP_GUARD_ARRAY(code);
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
if (out)
Value_To_RXI(out, &result);
else
DS_PUSH(&result);
return Reb_To_RXT[VAL_TYPE_0(&result)];
}
//
// Do_String()
//
// This is a version of a routine that was offered by the RL_Api, which has
// been expanded here in order to permit the necessary customizations for
// interesting REPL behavior w.r.t. binding, error handling, and response
// to throws.
//
// !!! Now that this code has been moved into the host, the convoluted
// integer-return-scheme can be eliminated and the code integrated more
// clearly into the surrounding calls.
//
int Do_String(
int *exit_status,
REBVAL *out,
const REBYTE *text,
REBOOL at_breakpoint
) {
struct Reb_State state;
REBCTX *error;
// Breakpoint REPLs are nested, and we may wish to jump out of them to
// the topmost level via a HALT. However, all other errors need to be
// confined, so that if one is doing evaluations during the pause of
// a breakpoint an error doesn't "accidentally resume" by virtue of
// jumping the stack out of the REPL.
//
// The topmost layer REPL, however, needs to catch halts in order to
// keep control and not crash out.
//
if (at_breakpoint)
PUSH_TRAP(&error, &state);
else
PUSH_UNHALTABLE_TRAP(&error, &state);
// The first time through the following code 'error' will be NULL, but...
// `fail` can longjmp here, so 'error' won't be NULL *if* that happens!
if (error) {
// Save error for WHY?
REBVAL *last = Get_System(SYS_STATE, STATE_LAST_ERROR);
if (ERR_NUM(error) == RE_HALT) {
assert(!at_breakpoint);
return -1; // !!! Revisit hardcoded #
}
Val_Init_Error(out, error);
*last = *out;
return -cast(REBINT, ERR_NUM(error));
}
REBARR *code = Scan_UTF8_Managed(text, LEN_BYTES(text));
// Where code ends up being bound when loaded at the REPL prompt should
// be more generally configurable. (It may be, for instance, that one
// wants to run something with it not bound at all.) Such choices
// must come from this REPL host...not from the interpreter itself.
{
// First the scanned code is bound into the user context with a
// fallback to the lib context.
//
// !!! This code is very old, and is how the REPL has bound since
// R3-Alpha. It comes from RL_Do_String, but should receive a modern
// review of why it's written exactly this way.
//
REBCTX *user_ctx = VAL_CONTEXT(Get_System(SYS_CONTEXTS, CTX_USER));
REBVAL vali;
SET_INTEGER(&vali, CTX_LEN(user_ctx) + 1);
Bind_Values_All_Deep(ARR_HEAD(code), user_ctx);
Resolve_Context(user_ctx, Lib_Context, &vali, FALSE, FALSE);
// If we're stopped at a breakpoint, the REPL should have a concept
// of what stack level it is inspecting (conveyed by the |#|>> in the
// prompt). This does a binding pass using the function for that
// stack level, just the way a body is bound during Make_Function()
//
if (at_breakpoint) {
REBVAL level;
SET_INTEGER(&level, HG_Stack_Level);
REBFRM *frame = Frame_For_Stack_Level(NULL, &level, FALSE);
assert(frame);
// Need to manage because it may be no words get bound into it,
// and we're not putting it into a FRAME! value, so it might leak
// otherwise if it's reified.
//
REBCTX *frame_ctx = Context_For_Frame_May_Reify_Managed(frame);
Bind_Values_Deep(ARR_HEAD(code), frame_ctx);
}
// !!! This was unused code that used to be in Do_String from
// RL_Api. It was an alternative path under `flags` which said
// "Bind into lib or user spaces?" and then "Top words will be
// added to lib". Is it relevant in any way?
//
/* Bind_Values_Set_Midstream_Shallow(ARR_HEAD(code), Lib_Context);
Bind_Values_Deep(ARR_HEAD(code), Lib_Context); */
}
if (Do_At_Throws(out, code, 0, SPECIFIED)) { // `code` will be GC protected
if (at_breakpoint) {
if (
IS_FUNCTION(out)
&& VAL_FUNC_DISPATCHER(out) == &N_resume
) {
//
// This means we're done with the embedded REPL. We want to
// resume and may be returning a piece of code that will be
// run by the finishing BREAKPOINT command in the target
// environment.
//
// We'll never return a halt, so we reuse -1 (in this very
// temporary scheme built on the very clunky historical REPL,
// which will not last much longer...fingers crossed.)
//
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
CATCH_THROWN(out, out);
*exit_status = -1;
return -1;
}
if (
IS_FUNCTION(out)
&& VAL_FUNC_DISPATCHER(out) == &N_quit
) {
//
// It would be frustrating if the system did not respond to
// a QUIT and forced you to do `resume/with [quit]`. So
// this is *not* caught, rather passed back up with the
// special -2 status code.
//
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
CATCH_THROWN(out, out);
*exit_status = -2;
return -2;
}
}
else {
// We are at the top level REPL, where we catch QUIT and for
// now, also EXIT as meaning you want to leave.
//
if (
IS_FUNCTION(out)
&& (
VAL_FUNC_DISPATCHER(out) == &N_quit
|| VAL_FUNC_DISPATCHER(out) == &N_exit
)
) {
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
CATCH_THROWN(out, out);
*exit_status = Exit_Status_From_Value(out);
return -2; // Revisit hardcoded #
}
}
fail (Error_No_Catch_For_Throw(out));
}
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
return 0;
}
//
// Next_Path_Throws: C
//
// Evaluate next part of a path.
//
REBOOL Next_Path_Throws(REBPVS *pvs)
{
REBPEF dispatcher;
// Path must have dispatcher, else return:
dispatcher = Path_Dispatch[VAL_TYPE(pvs->value)];
if (!dispatcher) return FALSE; // unwind, then check for errors
pvs->item++;
//Debug_Fmt("Next_Path: %r/%r", pvs->path-1, pvs->path);
// Determine the "selector". See notes on pvs->selector_temp for why
// a local variable can't be used for the temporary space.
//
if (IS_GET_WORD(pvs->item)) { // e.g. object/:field
pvs->selector
= GET_MUTABLE_VAR_MAY_FAIL(pvs->item, pvs->item_specifier);
if (IS_VOID(pvs->selector))
fail (Error_No_Value_Core(pvs->item, pvs->item_specifier));
SET_TRASH_IF_DEBUG(&pvs->selector_temp);
}
// object/(expr) case:
else if (IS_GROUP(pvs->item)) {
if (Do_At_Throws(
&pvs->selector_temp,
VAL_ARRAY(pvs->item),
VAL_INDEX(pvs->item),
IS_RELATIVE(pvs->item)
? pvs->item_specifier // if relative, use parent specifier...
: VAL_SPECIFIER(const_KNOWN(pvs->item)) // ...else use child's
)) {
*pvs->store = pvs->selector_temp;
return TRUE;
}
pvs->selector = &pvs->selector_temp;
}
else {
// object/word and object/value case:
//
COPY_VALUE(&pvs->selector_temp, pvs->item, pvs->item_specifier);
pvs->selector = &pvs->selector_temp;
}
switch (dispatcher(pvs)) {
case PE_OK:
break;
case PE_SET_IF_END:
if (pvs->opt_setval && IS_END(pvs->item + 1)) {
*pvs->value = *pvs->opt_setval;
pvs->opt_setval = NULL;
}
break;
case PE_NONE:
SET_BLANK(pvs->store);
case PE_USE_STORE:
pvs->value = pvs->store;
pvs->value_specifier = SPECIFIED;
break;
default:
assert(FALSE);
}
if (NOT_END(pvs->item + 1)) return Next_Path_Throws(pvs);
return FALSE;
}
//
// Do_Path_Throws_Core: 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_Core(
REBVAL *out,
REBSTR **label_out,
const RELVAL *path,
REBCTX *specifier,
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_DEBUG(out));
assert(!IN_DATA_STACK_DEBUG(path));
assert(!opt_setval || !IN_DATA_STACK_DEBUG(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!
// The path value that's coming in may be relative (in which case it
// needs to use the specifier passed in). Or it may be specific already,
// in which case we should use the specifier in the value to process
// its array contents.
//
if (IS_RELATIVE(path)) {
#if !defined(NDEBUG)
assert(specifier != SPECIFIED);
if (VAL_RELATIVE(path) != VAL_FUNC(CTX_FRAME_FUNC_VALUE(specifier))) {
Debug_Fmt("Specificity mismatch found in path dispatch");
PROBE_MSG(path, "the path being evaluated");
PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(path)), "expected func");
PROBE_MSG(CTX_FRAME_FUNC_VALUE(specifier), "actual func");
assert(FALSE);
}
#endif
pvs.item_specifier = specifier;
}
else pvs.item_specifier = VAL_SPECIFIER(const_KNOWN(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, pvs.item_specifier);
pvs.value_specifier = SPECIFIED;
if (IS_VOID(pvs.value))
fail (Error_No_Value_Core(pvs.item, pvs.item_specifier));
}
else {
// !!! Ideally there would be some way to deal with writes to
// temporary locations, like this pvs.value...if a set-path sets
// it, then it will be discarded.
COPY_VALUE(pvs.store, VAL_ARRAY_AT(pvs.orig), pvs.item_specifier);
pvs.value = pvs.store;
pvs.value_specifier = SPECIFIED;
}
// 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(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:
REBVAL specified_orig;
COPY_VALUE(&specified_orig, pvs.orig, specifier);
REBVAL specified_item;
COPY_VALUE(&specified_item, pvs.item, specifier);
fail (Error(RE_INVALID_PATH, &specified_orig, &specified_item));
}
}
else if (!IS_FUNCTION(pvs.value)) {
REBVAL specified;
COPY_VALUE(&specified, pvs.orig, specifier);
fail (Error(RE_BAD_PATH_TYPE, &specified, 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)
COPY_VALUE(pvs.store, pvs.value, pvs.value_specifier);
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_out) {
REBVAL 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_out = VAL_WORD_SPELLING(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_out = Canon(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_VOID(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_At_Throws(
&refinement,
VAL_ARRAY(pvs.item),
VAL_INDEX(pvs.item),
IS_RELATIVE(pvs.item)
? pvs.item_specifier // if relative, use parent's
: VAL_SPECIFIER(const_KNOWN(pvs.item)) // else embedded
)) {
*out = refinement;
DS_DROP_TO(dsp_orig);
return TRUE;
}
if (IS_VOID(&refinement)) continue;
DS_PUSH(&refinement);
}
else if (IS_GET_WORD(pvs.item)) {
DS_PUSH_TRASH;
*DS_TOP = *GET_OPT_VAR_MAY_FAIL(pvs.item, pvs.item_specifier);
if (IS_VOID(DS_TOP)) {
DS_DROP;
continue;
}
}
else DS_PUSH_RELVAL(pvs.item, pvs.item_specifier);
// 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_SPELLING(DS_TOP, VAL_WORD_CANON(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;
}
