diff --git a/src/core/c-do.c b/src/core/c-do.c index 4b928faa15..f5dd6bb8e3 100644 --- a/src/core/c-do.c +++ b/src/core/c-do.c @@ -35,6 +35,9 @@ #include #include "sys-state.h" +REBNATIVE(do); // Forward declaration for detection and special cases +#define IS_DO(v) (IS_NATIVE(v) && (VAL_FUNC_CODE(v) == &N_do)) + enum Eval_Types { ET_INVALID, // not valid to evaluate ET_WORD, @@ -1336,9 +1339,9 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN ** ***********************************************************************/ { - REBINT ftype = VAL_TYPE(func) - REB_NATIVE; // function type REBSER *block = VAL_SERIES(args); REBCNT index = VAL_INDEX(args); + REBCNT dsp; REBCNT dsf; REBSER *words; @@ -1347,6 +1350,10 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN REBINT start; REBVAL *val; + dsp = DSP; // in case we have to reset it later + +reapply: // Go back here to start over with a new func + if (index > SERIES_TAIL(block)) index = SERIES_TAIL(block); // Push function frame: @@ -1362,6 +1369,17 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN if (reduce) { // Reduce block contents to stack: n = 0; + // Check for DO any-function + if (index < BLK_LEN(block)) { + index = Do_Next(block, index, 0); + val = DS_TOP; + if (IS_DO(func) && ANY_FUNC(val)) { + func = val; // apply this func directly (volatile reference!) + DSP = dsp; // reset the stack + goto reapply; // go back to the beginning + } + n++; + } while (index < BLK_LEN(block)) { index = Do_Next(block, index, 0); if (THROWN(DS_TOP)) return; @@ -1370,8 +1388,16 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN if (n > len) DSP = start + len; } else { + // Get args block and check for DO any-function + n = BLK_LEN(block) - index; + val = BLK_SKIP(block, index); + if (n > 0 && IS_DO(func) && ANY_FUNC(val)) { + func = val; // apply this func directly + index++; // skip past the func value in the args + DSP = dsp; // reset the stack + goto reapply; // go back to the beginning + } // Copy block contents to stack: - n = VAL_BLK_LEN(args); if (len < n) n = len; if (start + n + 100 > SERIES_REST(DS_Series)) Expand_Stack(STACK_MIN); memcpy(&DS_Base[start], BLK_SKIP(block, index), n * sizeof(REBVAL)); @@ -1410,7 +1436,7 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN // Evaluate the function: DSF = dsf; func = DSF_FUNC(dsf); //stack could be expanded - Func_Dispatch[ftype](func); + Func_Dispatch[VAL_TYPE(func) - REB_NATIVE](func); DSP = dsf; DSF = PRIOR_DSF(dsf); } diff --git a/src/tests/units/func-test.r3 b/src/tests/units/func-test.r3 index 15e3e23f4d..36c380a550 100644 --- a/src/tests/units/func-test.r3 +++ b/src/tests/units/func-test.r3 @@ -8,6 +8,12 @@ Rebol [ ~~~start-file~~~ "Function" +===start-group=== "Apply" + +--test-- "apply :do [:func]" + ;@@ https://github.com/Oldes/Rebol-issues/issues/1950 + --assert 2 = try [apply :do [:add 1 1]] + ===start-group=== "body-of" --test-- "body-of NATIVE or ACTION"