FIX: Make APPLY :DO [:func ...] work like DO :func ...

This makes APPLY :DO consistent with DO, as a special case for DO only.
It should deal with what will be perceived as an R3 bug by many users.
See Oldes/Rebol-issues#1950 for the rationale behind this.

The transformation is equivalent to changing this:
apply :do [:any-func ...]
into this:
apply :any-func [...]
without calling DO at all.

Originally suggested by Ladislav: rebol#80

(cherry picked from commit cd8250e)

src/core/c-do.c

@@ -35,6 +35,9 @@
 #include <stdio.h>
 #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);
 }

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"