Skip to content

Commit 5d9af51

Browse files
OldesOldes
committed
FEAT: dynamic function refinements
1 parent 3fa4a0b commit 5d9af51

File tree

3 files changed

+147
-13
lines changed

3 files changed

+147
-13
lines changed

‎src/core/c-do.c

+40-13
Original file line numberDiff line numberDiff line change
@@ -668,6 +668,7 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
668668
REBINT dsf = dsp - DSF_BIAS;
669669
REBVAL *tos;
670670
REBVAL *func;
671+
REBOOL useArgs = TRUE; // can be used by get-word function refinements to ignore values
671672

672673
if ((dsp + 100) > (REBINT)SERIES_REST(DS_Series)) {
673674
Expand_Stack(STACK_MIN);
@@ -716,7 +717,7 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
716717
index = Do_Next(block, index, IS_OP(func));
717718
// THROWN is handled after the switch.
718719
if (index == END_FLAG) Trap2(RE_NO_ARG, Func_Word(dsf), args);
719-
DS_Base[ds] = *DS_POP;
720+
if (useArgs) DS_Base[ds] = *DS_POP; else DS_DROP;
720721
break;
721722

722723
case REB_LIT_WORD: // 'WORD - Just get next value
@@ -725,34 +726,30 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
725726
if (IS_PAREN(value) || IS_GET_WORD(value) || IS_GET_PATH(value)) {
726727
index = Do_Next(block, index, IS_OP(func));
727728
// THROWN is handled after the switch.
728-
DS_Base[ds] = *DS_POP;
729+
if (useArgs) DS_Base[ds] = *DS_POP; else DS_DROP;
729730
}
730731
else {
731732
index++;
732-
DS_Base[ds] = *value;
733+
if (useArgs) DS_Base[ds] = *value;
733734
}
734735
} else
735736
SET_UNSET(&DS_Base[ds]); // allowed to be none
736737
break;
737738

738739
case REB_GET_WORD: // :WORD - Get value
739740
if (index < BLK_LEN(block)) {
740-
DS_Base[ds] = *BLK_SKIP(block, index);
741+
if (useArgs) DS_Base[ds] = *BLK_SKIP(block, index);
741742
index++;
742743
} else
743744
SET_UNSET(&DS_Base[ds]); // allowed to be none
744745
break;
745-
/*
746-
value = BLK_SKIP(block, index);
747-
index++;
748-
if (IS_WORD(value) && VAL_WORD_FRAME(value)) value = Get_Var(value);
749-
DS_Base[ds] = *value;
750-
*/
746+
751747
case REB_REFINEMENT: // /WORD - Function refinement
752748
if (!path || IS_END(path)) return index;
753749
if (IS_WORD(path)) {
754750
// Optimize, if the refinement is the next arg:
755751
if (SAME_SYM(path, args)) {
752+
useArgs = TRUE;
756753
SET_TRUE(DS_VALUE(ds)); // set refinement stack value true
757754
path++; // remove processed refinement
758755
continue;
@@ -763,6 +760,7 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
763760
args = BLK_SKIP(words, 1);
764761
for (; NOT_END(args); args++, ds++) {
765762
if (IS_REFINEMENT(args) && VAL_WORD_CANON(args) == VAL_WORD_CANON(path)) {
763+
useArgs = TRUE;
766764
SET_TRUE(DS_VALUE(ds)); // set refinement stack value true
767765
path++; // remove processed refinement
768766
break;
@@ -772,6 +770,34 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
772770
if (IS_END(args)) Trap2(RE_NO_REFINE, Func_Word(dsf), path);
773771
continue;
774772
}
773+
else if (IS_GET_WORD(path)) {
774+
// This branch is almost same like the above one, but better to have it
775+
// separated not to slow down regular refinements.
776+
// Optimize, if the refinement is the next arg:
777+
if (SAME_SYM(path, args)) {
778+
value = Get_Var(path);
779+
useArgs = IS_TRUE(value);
780+
SET_LOGIC(DS_VALUE(ds), useArgs);
781+
path++; // remove processed refinement
782+
continue;
783+
}
784+
// Refinement out of sequence, resequence arg order:
785+
more_get_path:
786+
ds = dsp;
787+
args = BLK_SKIP(words, 1);
788+
for (; NOT_END(args); args++, ds++) {
789+
if (IS_REFINEMENT(args) && VAL_WORD_CANON(args) == VAL_WORD_CANON(path)) {
790+
value = Get_Var(path);
791+
useArgs = IS_TRUE(value);
792+
SET_LOGIC(DS_VALUE(ds), useArgs);
793+
path++; // remove processed refinement
794+
break;
795+
}
796+
}
797+
// Was refinement found? If not, error:
798+
if (IS_END(args)) Trap2(RE_NO_REFINE, Func_Word(dsf), path);
799+
continue;
800+
}
775801
else Trap1(RE_BAD_REFINE, path);
776802
break;
777803

@@ -789,14 +815,15 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
789815
}
790816

791817
// If word is typed, verify correct argument datatype:
792-
if (!TYPE_CHECK(args, VAL_TYPE(DS_VALUE(ds))))
818+
if (!TYPE_CHECK(args, VAL_TYPE(DS_VALUE(ds))) && useArgs)
793819
Trap3(RE_EXPECT_ARG, Func_Word(dsf), args, Of_Type(DS_VALUE(ds)));
794820
}
795821

796822
// Hack to process remaining path:
797823
if (path && NOT_END(path)) {
798-
if (!IS_WORD(path)) Trap1(RE_BAD_REFINE, path);
799-
goto more_path;
824+
if (IS_WORD(path)) goto more_path;
825+
if (IS_GET_WORD(path)) goto more_get_path;
826+
Trap1(RE_BAD_REFINE, path);
800827
}
801828

802829
return index;

‎src/tests/units/evaluation-test.r3

+69
Original file line numberDiff line numberDiff line change
@@ -1128,4 +1128,73 @@ Rebol [
11281128

11291129
===end-group===
11301130

1131+
1132+
===start-group=== "Dynamic refinements"
1133+
;@@ https://github.com/red/red/blob/c69d4763173/tests/source/units/evaluation-test.red#L1210
1134+
dyn-ref-fun: func [i [integer!] b /ref c1 /ref2 /ref3 c3 c4][
1135+
reduce [i b ref c1 ref2 ref3 c3 c4]
1136+
]
1137+
1138+
--test-- "dyn-ref-1"
1139+
only: yes
1140+
repend/:only s: [] [1 + 2 3 * 4]
1141+
--assert s == [[3 12]]
1142+
1143+
--test-- "dyn-ref-2"
1144+
only: no
1145+
repend/:only s: [] [4 + 5 6 * 7]
1146+
--assert s == [9 42]
1147+
1148+
--test-- "dyn-ref-3"
1149+
part: no length: 10
1150+
--assert "def" == find/:part "abcdef" "d" length
1151+
1152+
--test-- "dyn-ref-4"
1153+
part: yes length: 2
1154+
--assert none? find/:part "abcdef" "d" length
1155+
1156+
--test-- "dyn-ref-7"
1157+
ref: yes
1158+
--assert (dyn-ref-fun/:ref 10 * 9 "hello" 789)
1159+
== [90 "hello" #[true] 789 #[none] #[none] #[none] #[none]]
1160+
1161+
--test-- "dyn-ref-8"
1162+
ref: no
1163+
--assert (dyn-ref-fun/:ref 10 * 9 "hello" 789)
1164+
== [90 "hello" #[false] #[none] #[none] #[none] #[none] #[none]]
1165+
1166+
--test-- "dyn-ref-9"
1167+
ref: ref2: yes
1168+
--assert (dyn-ref-fun/:ref/:ref2 10 * 9 "hello" 789)
1169+
== [90 "hello" #[true] 789 #[true] #[none] #[none] #[none]]
1170+
1171+
--test-- "dyn-ref-10"
1172+
ref: no ref2: yes
1173+
--assert (dyn-ref-fun/:ref/:ref2 10 * 9 "hello" 789)
1174+
== [90 "hello" #[false] #[none] #[true] #[none] #[none] #[none]]
1175+
1176+
--test-- "dyn-ref-11"
1177+
ref: no ref2: ref3: yes
1178+
--assert (dyn-ref-fun/:ref/:ref2/:ref3 10 * 9 "hello" 789 6 7)
1179+
== [90 "hello" #[false] #[none] #[true] #[true] 6 7]
1180+
1181+
--test-- "dyn-ref-12"
1182+
dyn-ref-12-obj: context [
1183+
foo: func [i [integer!] b /ref c1 /ref2 /ref3 c3 c4][
1184+
reduce [i b ref c1 ref2 ref3 c3 c4]
1185+
]
1186+
bar: func [/local ref][
1187+
ref: no
1188+
--assert (foo/:ref 10 * 9 "hello" 789)
1189+
== [90 "hello" #[false] #[none] #[none] #[none] #[none] #[none]]
1190+
1191+
ref: yes
1192+
--assert (foo/:ref 10 * 9 "hello" 789)
1193+
== [90 "hello" #[true] 789 #[none] #[none] #[none] #[none]]
1194+
1195+
]
1196+
]
1197+
dyn-ref-12-obj/bar
1198+
===end-group===
1199+
11311200
~~~end-file~~~

‎src/tests/units/func-test.r3

+38
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,44 @@ Rebol [
88

99
~~~start-file~~~ "Function"
1010

11+
===start-group=== "Function refinements"
12+
fce: func[a [string!] /ref1 b [integer!] /ref2 :c 'd][
13+
reduce [a ref1 b ref2 c d]
14+
]
15+
--test-- "no refinements"
16+
--assert all [error? e: try [fce ] e/id = 'no-arg]
17+
--assert all [error? e: try [fce 1] e/id = 'expect-arg]
18+
--assert (fce "a") == ["a" #[none] #[none] #[none] #[none] #[none]]
19+
20+
--test-- "simple refinements"
21+
--assert all [error? e: try [fce/ref1 "a" ] e/id = 'no-arg]
22+
--assert all [error? e: try [fce/ref1 "a" ""] e/id = 'expect-arg]
23+
--assert (fce/ref1 "a" 1) == ["a" #[true] 1 #[none] #[none] #[none]]
24+
--assert (fce/ref1 "a" 1 + 1) == ["a" #[true] 2 #[none] #[none] #[none]]
25+
--assert (fce/ref1/ref2 "a" 1 x y) == ["a" #[true] 1 #[true] x y]
26+
--assert (fce/ref2/ref1 "a" x y 1 + 1) == ["a" #[true] 2 #[true] x y]
27+
28+
--test-- "dynamic refinements"
29+
ref1: yes --assert all [error? e: try [fce/:ref1 "a" ] e/id = 'no-arg]
30+
ref1: off --assert all [error? e: try [fce/:ref1 "a" ] e/id = 'no-arg]
31+
ref1: yes --assert all [error? e: try [fce/:ref1 "a" ""] e/id = 'expect-arg]
32+
ref1: off --assert (fce/:ref1 "a" "") == ["a" #[false] #[none] #[none] #[none] #[none]]
33+
ref1: yes --assert (fce/:ref1 "a" 1) == ["a" #[true] 1 #[none] #[none] #[none]]
34+
ref1: off --assert (fce/:ref1 "a" 1) == ["a" #[false] #[none] #[none] #[none] #[none]]
35+
ref1: yes --assert all [(fce/:ref1 "a" x: 1 + 1) == ["a" #[true] 2 #[none] #[none] #[none]] x == 2]
36+
ref1: off --assert all [(fce/:ref1 "a" x: 1 + 1) == ["a" #[false] #[none] #[none] #[none] #[none]] x == 2]
37+
ref1: yes ref2: yes --assert (fce/:ref1/:ref2 "a" 1 + 1 x y) == ["a" #[true] 2 #[true] x y]
38+
ref1: yes ref2: yes --assert (fce/:ref2/:ref1 "a" x y 1 + 1) == ["a" #[true] 2 #[true] x y]
39+
ref1: yes ref2: off --assert (fce/:ref1/:ref2 "a" 1 + 1 x y) == ["a" #[true] 2 #[false] #[none] #[none]]
40+
ref1: yes ref2: off --assert (fce/:ref2/:ref1 "a" x y 1 + 1) == ["a" #[true] 2 #[false] #[none] #[none]]
41+
ref1: off ref2: yes --assert (fce/:ref1/:ref2 "a" 1 + 1 x y) == ["a" #[false] #[none] #[true] x y]
42+
ref1: off ref2: yes --assert (fce/:ref2/:ref1 "a" x y 1 + 1) == ["a" #[false] #[none] #[true] x y]
43+
ref1: off ref2: off --assert (fce/:ref1/:ref2 "a" 1 + 1 x y) == ["a" #[false] #[none] #[false] #[none] #[none]]
44+
ref1: off ref2: off --assert (fce/:ref2/:ref1 "a" x y 1 + 1) == ["a" #[false] #[none] #[false] #[none] #[none]]
45+
46+
===end-group===
47+
48+
1149
===start-group=== "Apply"
1250

1351
--test-- "apply :do [:func]"

0 commit comments

Comments
 (0)