CHANGE: REMOVE-EACH returns the modified series at the argument pos…

…ition as in Rebol2

Added a `REMOVE-EACH/count` refinement, which toggles `REMOVE-EACH` to returning the removal count.

resolves: Oldes/Rebol-issues#931

src/boot/natives.reb

@@ -270,10 +270,11 @@ repeat: native [
 ]
 
 remove-each: native [
-	{Removes values for each block that returns true; returns removal count.}
+	{Removes values for each block that returns truthy value.}
 	'word [word! block!] {Word or block of words to set each time (local)}
 	data [series! map!] {The series to traverse (modified)}
 	body [block!] {Block to evaluate (return TRUE to remove)}
+	/count {Returns removal count}
 ]
 
 return: native [

src/core/n-loop.c

@@ -31,6 +31,12 @@
 #include "sys-core.h"
 #include "sys-int-funcs.h" //REB_I64_ADD_OF
 
+enum loop_each_mode {
+	LM_FOR = 0,
+	LM_REMOVE,
+	LM_REMOVE_COUNT,
+	LM_MAP
+};
 
 /***********************************************************************
 **
@@ -271,15 +277,15 @@
 	return R_RET;
 }
 
-
 /***********************************************************************
 **
 */	static int Loop_Each(REBVAL *ds, REBINT mode)
 /*
 **		Supports these natives (modes):
 **			0: foreach
 **			1: remove-each
-**			2: map
+**			2: remove-each/count
+**			3: map-each
 **
 ***********************************************************************/
 {
@@ -289,7 +295,7 @@
 	REBSER *frame;
 	REBVAL *value;
 	REBSER *series;
-	REBSER *out = NULL;	// output block (for MAP, mode = 2)
+	REBSER *out = NULL;	// output block (for LM_MAP, mode = 2)
 
 	REBINT index;	// !!!! should these be REBCNT?
 	REBINT tail;
@@ -298,8 +304,9 @@
 	REBINT err;
 	REBCNT i;
 	REBCNT j;
+	REBOOL return_count = FALSE;
 
-	ASSERT2(mode >= 0 && mode < 3, RP_MISC);
+	ASSERT2(mode >= 0 && mode < 4, RP_MISC);
 
 	value = D_ARG(2); // series
 	if (IS_NONE(value)) return R_NONE;
@@ -311,11 +318,15 @@
 	SET_NONE(D_RET);
 	SET_NONE(DS_NEXT);
 
-	// If it's MAP, create result block:
-	if (mode == 2) {
+	// If it's `map-each`, create result block:
+	if (mode == LM_MAP) {
 		out = Make_Block(VAL_LEN(value));
 		Set_Block(D_RET, out);
 	}
+	else if (mode == LM_REMOVE_COUNT) {
+		mode = LM_REMOVE;
+		return_count = TRUE;
+	}
 
 	// Get series info:
 	if (ANY_OBJECT(value)) {
@@ -333,14 +344,16 @@
 		series = VAL_SERIES(value);
 		index  = VAL_INDEX(value);
 		if (index >= (REBINT)SERIES_TAIL(series)) {
-			if (mode == 1) {
-				SET_INTEGER(D_RET, 0);
+			if (mode == LM_REMOVE) {
+				if(return_count)
+					SET_INTEGER(D_RET, 0);
+				else return R_ARG2;
 			}
 			return R_RET;
 		}
 	}
 
-	if (mode==1 && IS_PROTECT_SERIES(series)) 
+	if (mode==LM_REMOVE && IS_PROTECT_SERIES(series)) 
 		Trap0(RE_PROTECTED);
 
 	windex = index;
@@ -448,16 +461,16 @@
 				break;
 			}
 			// else CONTINUE:
-			if (mode == 1) SET_FALSE(ds); // keep the value (for mode == 1)
+			if (mode == LM_REMOVE) SET_FALSE(ds); // keep the value (for mode == LM_REMOVE)
 		} else {
 			err = 0; // prevent later test against uninitialized value
 		}
 
-		if (mode > 0) {
+		if (mode > LM_FOR) {
 			//if (ANY_OBJECT(value)) Trap_Types(words, REB_BLOCK, VAL_TYPE(value)); //check not needed
 
 			// If FALSE return, copy values to the write location:
-			if (mode == 1) {  // remove-each
+			if (mode == LM_REMOVE) {  // remove-each
 				if (IS_FALSE(ds)) {
 					REBCNT wide = SERIES_WIDE(series);
 					// memory areas may overlap, so use memmove and not memcpy!
@@ -467,24 +480,27 @@
 				}
 			}
 			else
-				if (!IS_UNSET(ds)) Append_Val(out, ds); // (mode == 2)
+				if (!IS_UNSET(ds)) Append_Val(out, ds); // (mode == LM_MAP)
 		}
 skip_hidden: ;
 	}
 
 	// Finish up:
-	if (mode == 1) {
+	if (mode == LM_REMOVE) {
 		// Remove hole (updates tail):
 		if (windex < index) Remove_Series(series, windex, index - windex);
-		SET_INTEGER(DS_RETURN, index - windex);
-		if (IS_MAP(value)) return R_ARG2;
-		return R_RET;
+		if (return_count) {
+			index -= windex;
+			SET_INTEGER(DS_RETURN, IS_MAP(value) ? index / 2 : index);
+			return R_RET;
+		}
+		return R_ARG2;
 	}
 
-	// If MAP and not BREAK/RETURN:
-	if (mode == 2 && err != 2) return R_RET;
+	// If map-each and not BREAK/RETURN:
+	if (mode == LM_MAP && err != 2) return R_RET;
 
-	return R_TOS1;
+	return R_TOS1; // foreach
 }
 
 
@@ -586,7 +602,7 @@ skip_hidden: ;
 **
 ***********************************************************************/
 {
-	return Loop_Each(ds, 0);
+	return Loop_Each(ds, LM_FOR);
 }
 
 
@@ -597,10 +613,11 @@ skip_hidden: ;
 **		'word [get-word! word! block!] {Word or block of words}
 **		data [series!] {The series to traverse}
 **		body [block!] {Block to evaluate each time}
+**		/count
 **
 ***********************************************************************/
 {
-	return Loop_Each(ds, 1);
+	return Loop_Each(ds, D_REF(4) ? LM_REMOVE_COUNT : LM_REMOVE);
 }
 
 
@@ -614,7 +631,7 @@ skip_hidden: ;
 **
 ***********************************************************************/
 {
-	return Loop_Each(ds, 2);
+	return Loop_Each(ds, LM_MAP);
 }
 
 

src/tests/units/map-test.r3

@@ -313,6 +313,10 @@ Rebol [
 		m: #(a 1 "b" 2 c #[none] d: 3)
 		--assert m = remove-each [k v] m [any [string? k none? v]]
 		--assert [a d] = words-of m
+	--test-- "remove-each/count with map"
+		m: #(a 1 "b" 2 c #[none] d: 3)
+		--assert 2 = remove-each/count [k v] m [any [string? k none? v]]
+		--assert [a d] = words-of m
 
 ===end-group===
 

src/tests/units/series-test.r3

@@ -950,14 +950,39 @@ Rebol [
 	data: copy ""
 	foreach x "123" [append data x]
 	--assert "123" = data
+--test-- "FOREACH result"
+	--assert #"3" = foreach x "123" [x]
+	--assert 3 = foreach x [1 2 3] [x]
+	--assert unset? foreach x [1 2 3] [if x = 2 [break]]
+	--assert 4 = foreach x [1 2 3] [if x = 2 [break/return 4]]
 
 ===end-group===
 
 ===start-group=== "REMOVE-EACH"
+--test-- "remove-each result"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/931
+	b: [a 1 b 2]
+	--assert [b 2] = remove-each [k v] b [v < 2]
+	--assert [b 2] = b
+
+	s: next [1 2 3 4]
+	--assert [3 4] = remove-each n s [n < 3]
+	--assert [1 3 4] = head s
+
+--test-- "remove-each/count result"
+	b: [a 1 b 2]
+	--assert 2 = remove-each/count [k v] b [v < 2]
+	--assert b = [b 2]
+
+	s: next [1 2 3 4]
+	--assert 1 = remove-each/count n s [n < 3]
+	--assert [1 3 4] = head s
 
 --test-- "break in remove-each"
 	;@@ https://github.com/Oldes/Rebol-issues/issues/2192
-	remove-each n s: [1 2 3 4] [if n = 2 [break] true]
+	--assert [2 3 4] = remove-each n s: [1 2 3 4] [if n = 2 [break] true]
+	--assert s = [2 3 4]
+	--assert 1 = remove-each/count n s: [1 2 3 4] [if n = 2 [break] true]
 	--assert s = [2 3 4]
 
 ===end-group===