FEAT: new PUT action for replacing the value following a key (in blocks and maps)

implements: metaeducation/rebol-issues#2392

Author: Oldes

src/boot/actions.r

@@ -268,9 +268,17 @@ take: action [
 	/last {Take it from the tail end}
 ]
 
+put: action [
+	{Replaces the value following a key, and returns the new value.}
+	series [any-block! map!] {(modified)}
+	key    [scalar! any-string! any-word! binary!] 
+	value  [any-type!] {The new value (returned)}
+	/case  {Perform a case-sensitive search (only on block so far!)}
+]
+
 insert: action [
 	{Inserts element(s); for series, returns just past the insert.}
-	series [series! port! map! gob! object! bitset! port!] {At position (modified)}
+	series [series! port! map! gob! object! bitset!] {At position (modified)}
 	value [any-type!] {The value to insert}
 	/part {Limits to a given length or position}
 	length [number! series! pair!]

src/core/t-block.c

@@ -608,6 +608,7 @@ static struct {
 {
 	REBVAL	*value = D_ARG(1);
 	REBVAL  *arg = D_ARG(2);
+	REBVAL  *arg2;
 	REBSER  *ser;
 	REBINT	index;
 	REBINT	tail;
@@ -723,6 +724,25 @@ static struct {
 		Remove_Series(ser, index, len);
 		return R_RET;
 
+	case A_PUT:
+		arg2 = D_ARG(3);
+		args = D_REF(4) ? AM_FIND_CASE : 0;
+		ret = Find_Block(ser, index, tail, arg, len, args, 1);
+		if(ret != NOT_FOUND) {
+			ret++;
+			if (ret >= tail) {
+				// when key is last value in the block
+				Expand_Series(ser, tail, 1);
+			}
+			*BLK_SKIP(ser, ret) = *arg2;
+		}
+		else {
+			Expand_Series(ser, tail, 2);
+			*BLK_SKIP(ser, tail) = *arg;
+			*BLK_SKIP(ser, tail+1) = *arg2;
+		}
+		return R_ARG3;
+
 	//-- Search:
 
 	case A_FIND:

src/core/t-map.c

@@ -503,6 +503,10 @@
 		Append_Map(series, arg, Partial1(arg, D_ARG(AN_LENGTH)));
 		break;
 
+	case A_PUT:
+		Find_Entry(series, arg, D_ARG(3));
+		return R_ARG3;
+
 	case A_POKE:  // CHECK all pokes!!! to be sure they check args now !!!
 		Find_Entry(series, arg, D_ARG(3));
 		*D_RET = *D_ARG(3);

src/tests/units/map-test.r3

@@ -31,6 +31,25 @@ Rebol [
 
 ===end-group===
 
+===start-group=== "PUT"
+	--test-- "PUT into map"
+		m: map [a: 42]
+		--assert "foo" = put m 'b "foo"
+		--assert "baz" = put m 'a "baz"
+		--assert "foo" = m/b
+		--assert "baz" = m/a
+
+	--test-- "PUT into protected map"
+		m: map [a: 42]
+		protect m
+		--assert error? err: try [put m 'b "foo"]
+		--assert err/id = 'protected
+		--assert error? err: try [put m 'a "baz"]
+		--assert err/id = 'protected
+		unprotect m
+
+===end-group===
+
 ===start-group=== "reflection"
 	m: make map! b: [a 1 b: 2 :c 3 'd 4 #e 5 /f 6 "a" 7 <b> 8 9 9 #"c" 10 a@b 11]
 	--test-- "body of map"

src/tests/units/series-test.r3

@@ -112,6 +112,52 @@ Rebol [
 
 ===end-group===
 
+===start-group=== "PUT"
+	--test-- "PUT into BLOCK"
+	v: [a 1 b 2 c]
+	--assert 3 = put v 'a 3
+	--assert 4 = put v 'b 4
+	--assert 5 = put v 'c 5
+	--assert 6 = put v 'd 6
+	--assert v = [a 3 b 4 c 5 d 6]
+
+	--test-- "PUT into PAREN"
+	v: quote (a 1 b 2 c)
+	--assert 3 = put v 'a 3
+	--assert 4 = put v 'b 4
+	--assert 5 = put v 'c 5
+	--assert 6 = put v 'd 6
+	--assert v = quote (a 3 b 4 c 5 d 6)
+
+	--test-- "PUT into PATH"
+	v: to path! [a 1 b 2 c]
+	--assert 3 = put v 'a 3
+	--assert 4 = put v 'b 4
+	--assert 5 = put v 'c 5
+	--assert 6 = put v 'd 6
+	--assert v = 'a/3/b/4/c/5/d/6
+
+	--test-- "PUT/CASE words"
+	v: [a 1 b 2]
+	--assert 3 = put v 'a 3
+	--assert 4 = put/case v quote :a 4
+	--assert 5 = put/case v quote 'b 5
+	--assert v = [a 3 b 2 :a 4 'b 5]
+
+	--test-- "PUT/CASE strings"
+	v: ["a" 1 "b" 2]
+	--assert 3 = put v "a" 3
+	--assert 4 = put/case v "A" 4
+	--assert 5 = put/case v "B" 5
+	--assert v = ["a" 3 "b" 2 "A" 4 "B" 5]
+
+	--test-- "PUT on protected block"
+	v: protect [a 1]
+	--assert error? err: try [ put v 'a 2 ]
+	--assert 'protected = err/id
+
+===end-group===
+
 ===start-group=== "REMOVE"
 	--test-- "remove-blk-1"
 		a: [1 2 3]