From 5d9af51c244900b6187d3c3e408b069deb19368a Mon Sep 17 00:00:00 2001
From: Oldes <oldes.huhuman@gmail.com>
Date: Thu, 29 Jun 2023 15:45:51 +0200
Subject: [PATCH] FEAT: dynamic function refinements

---
 src/core/c-do.c                    | 53 +++++++++++++++++------
 src/tests/units/evaluation-test.r3 | 69 ++++++++++++++++++++++++++++++
 src/tests/units/func-test.r3       | 38 ++++++++++++++++
 3 files changed, 147 insertions(+), 13 deletions(-)

diff --git a/src/core/c-do.c b/src/core/c-do.c
index 628c3c8ebe..bfad561375 100644
--- a/src/core/c-do.c
+++ b/src/core/c-do.c
@@ -668,6 +668,7 @@ x*/	static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
 	REBINT dsf = dsp - DSF_BIAS;
 	REBVAL *tos;
 	REBVAL *func;
+	REBOOL useArgs = TRUE;  // can be used by get-word function refinements to ignore values
 
 	if ((dsp + 100) > (REBINT)SERIES_REST(DS_Series)) {
 		Expand_Stack(STACK_MIN);
@@ -716,7 +717,7 @@ x*/	static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
 			index = Do_Next(block, index, IS_OP(func));
 			// THROWN is handled after the switch.
 			if (index == END_FLAG) Trap2(RE_NO_ARG, Func_Word(dsf), args);
-			DS_Base[ds] = *DS_POP;
+			if (useArgs) DS_Base[ds] = *DS_POP; else DS_DROP;
 			break;
 
 		case REB_LIT_WORD:	// 'WORD - Just get next value
@@ -725,11 +726,11 @@ x*/	static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
 				if (IS_PAREN(value) || IS_GET_WORD(value) || IS_GET_PATH(value)) {
 					index = Do_Next(block, index, IS_OP(func));
 					// THROWN is handled after the switch.
-					DS_Base[ds] = *DS_POP;
+					if (useArgs) DS_Base[ds] = *DS_POP; else DS_DROP;
 				}
 				else {
 					index++;
-					DS_Base[ds] = *value;
+					if (useArgs) DS_Base[ds] = *value;
 				}
 			} else
 				SET_UNSET(&DS_Base[ds]); // allowed to be none
@@ -737,22 +738,18 @@ x*/	static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
 
 		case REB_GET_WORD:	// :WORD - Get value
 			if (index < BLK_LEN(block)) {
-				DS_Base[ds] = *BLK_SKIP(block, index);
+				if (useArgs) DS_Base[ds] = *BLK_SKIP(block, index);
 				index++;
 			} else
 				SET_UNSET(&DS_Base[ds]); // allowed to be none
 			break;
-/*
-				value = BLK_SKIP(block, index);
-				index++;
-				if (IS_WORD(value) && VAL_WORD_FRAME(value)) value = Get_Var(value);
-				DS_Base[ds] = *value;
-*/
+
 		case REB_REFINEMENT: // /WORD - Function refinement
 			if (!path || IS_END(path)) return index;
 			if (IS_WORD(path)) {
 				// Optimize, if the refinement is the next arg:
 				if (SAME_SYM(path, args)) {
+					useArgs = TRUE;
 					SET_TRUE(DS_VALUE(ds)); // set refinement stack value true
 					path++;				// remove processed refinement
 					continue;
@@ -763,6 +760,7 @@ x*/	static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
 				args = BLK_SKIP(words, 1);
 				for (; NOT_END(args); args++, ds++) {
 					if (IS_REFINEMENT(args) && VAL_WORD_CANON(args) == VAL_WORD_CANON(path)) {
+						useArgs = TRUE;
 						SET_TRUE(DS_VALUE(ds)); // set refinement stack value true
 						path++;				// remove processed refinement
 						break;
@@ -772,6 +770,34 @@ x*/	static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
 				if (IS_END(args)) Trap2(RE_NO_REFINE, Func_Word(dsf), path);
 				continue;
 			}
+			else if (IS_GET_WORD(path)) {
+				// This branch is almost same like the above one, but better to have it
+				// separated not to slow down regular refinements.
+				// Optimize, if the refinement is the next arg:
+				if (SAME_SYM(path, args)) {
+					value = Get_Var(path);
+					useArgs = IS_TRUE(value);
+					SET_LOGIC(DS_VALUE(ds), useArgs);
+					path++;				// remove processed refinement
+					continue;
+				}
+				// Refinement out of sequence, resequence arg order:
+more_get_path:
+				ds = dsp;
+				args = BLK_SKIP(words, 1);
+				for (; NOT_END(args); args++, ds++) {
+					if (IS_REFINEMENT(args) && VAL_WORD_CANON(args) == VAL_WORD_CANON(path)) {
+						value = Get_Var(path);
+						useArgs = IS_TRUE(value);
+						SET_LOGIC(DS_VALUE(ds), useArgs);
+						path++;				// remove processed refinement
+						break;
+					}
+				}
+				// Was refinement found? If not, error:
+				if (IS_END(args)) Trap2(RE_NO_REFINE, Func_Word(dsf), path);
+				continue;
+			}
 			else Trap1(RE_BAD_REFINE, path);
 			break;
 
@@ -789,14 +815,15 @@ x*/	static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
 		}
 
 		// If word is typed, verify correct argument datatype:
-		if (!TYPE_CHECK(args, VAL_TYPE(DS_VALUE(ds))))
+		if (!TYPE_CHECK(args, VAL_TYPE(DS_VALUE(ds))) && useArgs)
 			Trap3(RE_EXPECT_ARG, Func_Word(dsf), args, Of_Type(DS_VALUE(ds)));
 	}
 
 	// Hack to process remaining path:
 	if (path && NOT_END(path)) {
-		if (!IS_WORD(path)) Trap1(RE_BAD_REFINE, path);
-		goto more_path;
+		if (IS_WORD(path)) goto more_path; 
+		if (IS_GET_WORD(path)) goto more_get_path;
+		Trap1(RE_BAD_REFINE, path);
 	}
 
 	return index;
diff --git a/src/tests/units/evaluation-test.r3 b/src/tests/units/evaluation-test.r3
index 88bc40b5e7..e19b9a1a1b 100644
--- a/src/tests/units/evaluation-test.r3
+++ b/src/tests/units/evaluation-test.r3
@@ -1128,4 +1128,73 @@ Rebol [
 
 ===end-group===
 
+
+===start-group=== "Dynamic refinements"
+	;@@ https://github.com/red/red/blob/c69d4763173/tests/source/units/evaluation-test.red#L1210
+	dyn-ref-fun: func [i [integer!] b /ref c1 /ref2 /ref3 c3 c4][
+	    reduce [i b ref c1 ref2 ref3 c3 c4]
+	]
+
+	--test-- "dyn-ref-1"
+		only: yes
+		repend/:only s: [] [1 + 2 3 * 4]
+		--assert s == [[3 12]]
+	
+	--test-- "dyn-ref-2"
+		only: no
+		repend/:only s: [] [4 + 5 6 * 7]
+		--assert s == [9 42]
+	
+	--test-- "dyn-ref-3"
+		part: no length: 10 
+		--assert "def" == find/:part "abcdef" "d" length
+		
+	--test-- "dyn-ref-4"
+		part: yes length: 2
+		--assert none? find/:part "abcdef" "d" length
+
+	--test-- "dyn-ref-7"
+		ref: yes
+		--assert (dyn-ref-fun/:ref 10 * 9 "hello" 789)
+			== [90 "hello" #[true] 789 #[none] #[none] #[none] #[none]]
+		
+	--test-- "dyn-ref-8"
+		ref: no
+		--assert (dyn-ref-fun/:ref 10 * 9 "hello" 789)
+			== [90 "hello" #[false] #[none] #[none] #[none] #[none] #[none]]
+
+	--test-- "dyn-ref-9"
+		ref: ref2: yes
+		--assert (dyn-ref-fun/:ref/:ref2 10 * 9 "hello" 789)
+			== [90 "hello" #[true] 789 #[true] #[none] #[none] #[none]]		
+
+	--test-- "dyn-ref-10"
+		ref: no ref2: yes
+		--assert (dyn-ref-fun/:ref/:ref2 10 * 9 "hello" 789)
+			== [90 "hello" #[false] #[none] #[true] #[none] #[none] #[none]]
+
+	--test-- "dyn-ref-11"
+		ref: no ref2: ref3: yes
+		--assert (dyn-ref-fun/:ref/:ref2/:ref3 10 * 9 "hello" 789 6 7)
+			== [90 "hello" #[false] #[none] #[true] #[true] 6 7]
+	
+	--test-- "dyn-ref-12"		
+		dyn-ref-12-obj: context [
+		    foo: func [i [integer!] b /ref c1 /ref2 /ref3 c3 c4][
+		    	reduce [i b ref c1 ref2 ref3 c3 c4]
+		    ]
+		    bar: func [/local ref][
+		        ref: no
+				--assert (foo/:ref 10 * 9 "hello" 789)
+				== [90 "hello" #[false] #[none] #[none] #[none] #[none] #[none]]
+
+		        ref: yes
+				--assert (foo/:ref 10 * 9 "hello" 789)
+				== [90 "hello" #[true] 789 #[none] #[none] #[none] #[none]]
+
+		    ]
+		]
+		dyn-ref-12-obj/bar
+===end-group===
+
 ~~~end-file~~~
diff --git a/src/tests/units/func-test.r3 b/src/tests/units/func-test.r3
index e209cefd7d..c1c146302b 100644
--- a/src/tests/units/func-test.r3
+++ b/src/tests/units/func-test.r3
@@ -8,6 +8,44 @@ Rebol [
 
 ~~~start-file~~~ "Function"
 
+===start-group=== "Function refinements"
+	fce: func[a [string!] /ref1 b [integer!] /ref2 :c 'd][
+		reduce [a ref1 b ref2 c d]
+	]
+	--test-- "no refinements"
+	--assert all [error? e: try [fce  ] e/id = 'no-arg]
+	--assert all [error? e: try [fce 1] e/id = 'expect-arg]
+	--assert (fce "a") == ["a" #[none] #[none] #[none] #[none] #[none]]
+
+	--test-- "simple refinements"
+	--assert all [error? e: try [fce/ref1 "a"   ] e/id = 'no-arg]
+	--assert all [error? e: try [fce/ref1 "a" ""] e/id = 'expect-arg]
+	--assert (fce/ref1 "a" 1)     == ["a" #[true] 1 #[none] #[none] #[none]]
+	--assert (fce/ref1 "a" 1 + 1) == ["a" #[true] 2 #[none] #[none] #[none]]
+	--assert (fce/ref1/ref2 "a" 1 x y)     == ["a" #[true] 1 #[true] x y]
+	--assert (fce/ref2/ref1 "a" x y 1 + 1) == ["a" #[true] 2 #[true] x y]
+
+	--test-- "dynamic refinements"
+	ref1: yes --assert all [error? e: try [fce/:ref1 "a"   ] e/id = 'no-arg]
+	ref1: off --assert all [error? e: try [fce/:ref1 "a"   ] e/id = 'no-arg]
+	ref1: yes --assert all [error? e: try [fce/:ref1 "a" ""] e/id = 'expect-arg]
+	ref1: off --assert (fce/:ref1 "a" "")    == ["a" #[false] #[none] #[none] #[none] #[none]]
+	ref1: yes --assert (fce/:ref1 "a" 1)     == ["a" #[true]  1       #[none] #[none] #[none]]
+	ref1: off --assert (fce/:ref1 "a" 1)     == ["a" #[false] #[none] #[none] #[none] #[none]]
+	ref1: yes --assert all [(fce/:ref1 "a" x: 1 + 1) == ["a" #[true]  2       #[none] #[none] #[none]] x == 2]
+	ref1: off --assert all [(fce/:ref1 "a" x: 1 + 1) == ["a" #[false] #[none] #[none] #[none] #[none]] x == 2]
+	ref1: yes ref2: yes --assert (fce/:ref1/:ref2 "a" 1 + 1 x y) == ["a" #[true] 2 #[true] x y]
+	ref1: yes ref2: yes --assert (fce/:ref2/:ref1 "a" x y 1 + 1) == ["a" #[true] 2 #[true] x y]
+	ref1: yes ref2: off --assert (fce/:ref1/:ref2 "a" 1 + 1 x y) == ["a" #[true] 2 #[false] #[none] #[none]]
+	ref1: yes ref2: off --assert (fce/:ref2/:ref1 "a" x y 1 + 1) == ["a" #[true] 2 #[false] #[none] #[none]]
+	ref1: off ref2: yes --assert (fce/:ref1/:ref2 "a" 1 + 1 x y) == ["a" #[false] #[none] #[true] x y]
+	ref1: off ref2: yes --assert (fce/:ref2/:ref1 "a" x y 1 + 1) == ["a" #[false] #[none] #[true] x y]
+	ref1: off ref2: off --assert (fce/:ref1/:ref2 "a" 1 + 1 x y) == ["a" #[false] #[none] #[false] #[none] #[none]]
+	ref1: off ref2: off --assert (fce/:ref2/:ref1 "a" x y 1 + 1) == ["a" #[false] #[none] #[false] #[none] #[none]]
+
+===end-group===
+
+
 ===start-group=== "Apply"
 
 --test-- "apply :do [:func]"