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]"