FEAT: CHANGE: making SET native to be more compatible with Red-langua…

…ge version

There is new refinement /ONLY which treat source block or object like single value (so the result is like it was in R3-alpha)

The /PAD refinement was replaced with /SOME refinement. The functionality is now reversed: when no refinement is used, it works like if there was /PAD before. If /SOME is used, there is no padding and also target value is not replaced with none value from the source, if there is any.

Related issue: metaeducation/rebol-issues#2358

src/boot/natives.r

@@ -549,7 +549,8 @@ set: native [
 	word [any-word! any-path! block! object!] {Word, block of words, path, or object to be set (modified)}
 	value [any-type!] {Value or block of values}
 	/any {Allows setting words to any value, including unset}
-	/pad {For objects, if block is too short, remaining words are set to NONE}
+	/only {Block or object value argument is set as a single value}
+	/some {None values in a block or object value argument, are not set}
 ]
 
 to-hex: native [

src/core/n-data.c

@@ -505,14 +505,17 @@ static int Check_Char_Range(REBVAL *val, REBINT limit)
 **		word [any-word! block! object!] {Word or words to set}
 **		value [any-type!] {Value or block of values}
 **		/any {Allows setting words to any value.}
-**		/pad {For objects, if block is too short, remaining words are set to NONE.}
+**		/only {Block or object value argument is set as a single value}
+**		/some {None values in a block or object value argument, are not set}
 **
 ***********************************************************************/
 {
 	REBVAL *word   = D_ARG(1);
 	REBVAL *val    = D_ARG(2);
 	REBVAL *tmp    = NULL;
 	REBOOL not_any = !D_REF(3);
+	REBOOL not_only= !D_REF(4);
+	REBOOL ref_some= D_REF(5);
 	REBOOL is_blk  = FALSE;
 	REBSER *obj;
 	REBVAL *obj_val;
@@ -533,7 +536,7 @@ static int Check_Char_Range(REBVAL *val, REBINT limit)
 
 	// Is value a block?
 	if (IS_BLOCK(val)) {
-		val = VAL_BLK_DATA(val);
+		if (not_only) val = VAL_BLK_DATA(val);
 		if (IS_END(val)) val = NONE_VALUE;
 		else is_blk = TRUE;
 	}
@@ -544,10 +547,10 @@ static int Check_Char_Range(REBVAL *val, REBINT limit)
 		// Check for protected or unset before setting anything.
 		for (tmp = val, word = VAL_OBJ_WORD(word, 1); NOT_END(word); word++) { // skip self
 			if (VAL_PROTECTED(word)) Trap1(RE_LOCKED_WORD, word);
-			if (not_any && is_blk && !IS_END(tmp) && IS_UNSET(tmp++)) // won't advance past end
+			if (not_any && is_blk && not_only && !IS_END(tmp) && IS_UNSET(tmp++)) // won't advance past end
 				Trap1(RE_NEED_VALUE, word);
 		}
-		if (IS_OBJECT(val)) {
+		if (IS_OBJECT(val) && not_only) {
 			obj = VAL_OBJ_FRAME(D_ARG(1));
 			// Keep the binding table.
 			Collect_Start(BIND_ALL);
@@ -557,13 +560,25 @@ static int Check_Char_Range(REBVAL *val, REBINT limit)
 			obj_val = VAL_OBJ_VALUES(D_ARG(1)) + 1;  // skip self
 			for (word = BLK_HEAD(VAL_OBJ_WORDS(D_ARG(1))) + 1; NOT_END(word); word++) { // skip self
 				tmp = Find_Word_Value(VAL_OBJ_FRAME(val), VAL_WORD_SYM(word));
-				if(tmp && !IS_UNSET(tmp)) *obj_val = *tmp;
+				if (tmp) {
+					// don't set to UNSET value if not used SET/ANY
+					if (IS_UNSET(tmp) && not_any) goto next_obj_val;
+					// don't overwrite target's existing value with NONE if used SET/SOME
+					if (ref_some && VAL_TYPE(obj_val) > REB_NONE && VAL_TYPE(tmp) <= REB_NONE) goto next_obj_val;
+
+					*obj_val = *tmp;
+				}
+next_obj_val:
 				obj_val++;
 			}
 			Copy_Deep_Values(obj, 1, SERIES_TAIL(obj), TS_CLONE);
 			Rebind_Block(VAL_OBJ_FRAME(val), obj, BLK_SKIP(obj, 1), REBIND_FUNC | REBIND_TABLE);
 			// release binding table
 			Collect_End(obj);
+		} else if (is_blk && !not_only) {
+			for (word = VAL_OBJ_VALUES(D_ARG(1)) + 1; NOT_END(word); word++) { // skip self
+				*word = *val;
+			}
 		} else {
 			for (word = VAL_OBJ_VALUES(D_ARG(1)) + 1; NOT_END(word); word++) { // skip self
 				// WARNING: Unwinds that make it here are assigned. All unwinds
@@ -573,7 +588,7 @@ static int Check_Char_Range(REBVAL *val, REBINT limit)
 				if (is_blk) {
 					val++;
 					if (IS_END(val)) {
-						if (!D_REF(4)) break; // /pad not provided
+						if (ref_some) break; // /pad not provided
 						is_blk = FALSE;
 						val = NONE_VALUE;
 					}
@@ -595,11 +610,13 @@ static int Check_Char_Range(REBVAL *val, REBINT limit)
 			}
 		}
 		for (word = VAL_BLK_DATA(D_ARG(1)); NOT_END(word); word++) {
-			if (IS_WORD(word) || IS_SET_WORD(word) || IS_LIT_WORD(word)) Set_Var(word, val);
-			else if (IS_GET_WORD(word))
-				Set_Var(word, IS_WORD(val) ? Get_Var(val) : val);
-			else Trap_Arg(word);
-			if (is_blk) {
+			if (IS_UNSET(word) || !(ref_some && IS_NONE(val))) {
+				if (IS_WORD(word) || IS_SET_WORD(word) || IS_LIT_WORD(word)) Set_Var(word, val);
+				else if (IS_GET_WORD(word))
+					Set_Var(word, IS_WORD(val) ? Get_Var(val) : val);
+				else Trap_Arg(word);
+			}
+			if (is_blk && not_only) {
 				val++;
 				if (IS_END(val)) is_blk = FALSE, val = NONE_VALUE;
 			}