Skip to content

Commit 82682e1

Browse files
committed
FEAT: enhanced ajoin native function for merging values into a string types
resolves: Oldes/Rebol-issues#2558 related to: Oldes/Rebol-issues#2100 related to: Oldes/Rebol-wishes#19
1 parent 8115be7 commit 82682e1

File tree

4 files changed

+124
-11
lines changed

4 files changed

+124
-11
lines changed

src/boot/natives.reb

+3-1
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,10 @@ REBOL [
2020
;-- Control Natives - nat_control.c
2121

2222
ajoin: native [
23-
{Reduces and joins a block of values into a new string.}
23+
{Reduces and joins a block of values into a new string. Ignores none and unset values.}
2424
block [block!]
25+
/with delimiter [any-type!]
26+
/all "Do not ignore none and unset values"
2527
]
2628

2729
also: native [

src/core/n-strings.c

+11-2
Original file line numberDiff line numberDiff line change
@@ -129,11 +129,20 @@ static struct digest {
129129
***********************************************************************/
130130
{
131131
REBSER *str;
132+
REBCNT type = VAL_TYPE(VAL_BLK_DATA(D_ARG(1)));
133+
REBVAL *delimiter = D_REF(2) ? D_ARG(3) : NULL;
132134

133-
str = Form_Reduce(VAL_SERIES(D_ARG(1)), VAL_INDEX(D_ARG(1)));
135+
str = Form_Reduce(VAL_SERIES(D_ARG(1)), VAL_INDEX(D_ARG(1)), delimiter, D_REF(4));
134136
if (!str) return R_TOS;
135137

136-
Set_String(DS_RETURN, str); // not D_RET (stack modified)
138+
// Use result string-like type based on first value, except tag!
139+
if (type < REB_STRING || type >= REB_TAG) type = REB_STRING;
140+
141+
// Using DS_RETURN not D_RET (stack modified)
142+
VAL_SET(DS_RETURN, type);
143+
VAL_SERIES(DS_RETURN) = str;
144+
VAL_INDEX(DS_RETURN) = 0;
145+
VAL_SERIES_SIDE(DS_RETURN) = 0;
137146

138147
return R_RET;
139148
}

src/core/s-mold.c

+26-8
Original file line numberDiff line numberDiff line change
@@ -1462,7 +1462,7 @@ STOID Mold_Error(REBVAL *value, REB_MOLD *mold, REBFLG molded)
14621462

14631463
/***********************************************************************
14641464
**
1465-
*/ REBSER *Form_Reduce(REBSER *block, REBCNT index)
1465+
*/ REBSER *Form_Reduce(REBSER *block, REBCNT index, REBVAL *delimiter, REBOOL all)
14661466
/*
14671467
** Reduce a block and then form each value into a string. Return the
14681468
** string or NULL if an unwind triggered while reducing.
@@ -1472,13 +1472,31 @@ STOID Mold_Error(REBVAL *value, REB_MOLD *mold, REBFLG molded)
14721472
REBINT start = DSP + 1;
14731473
REBINT n;
14741474
REB_MOLD mo = {0};
1475-
1476-
while (index < BLK_LEN(block)) {
1477-
index = Do_Next(block, index, 0);
1478-
if (THROWN(DS_TOP)) {
1479-
*DS_VALUE(start) = *DS_TOP;
1480-
DSP = start;
1481-
return NULL;
1475+
if (delimiter) {
1476+
while (index < BLK_LEN(block)) {
1477+
index = Do_Next(block, index, 0);
1478+
if (VAL_TYPE(DS_TOP) <= REB_NONE && !all) {
1479+
DS_DROP;
1480+
continue;
1481+
}
1482+
if (THROWN(DS_TOP)) {
1483+
*DS_VALUE(start) = *DS_TOP;
1484+
DSP = start;
1485+
return NULL;
1486+
}
1487+
DS_PUSH(delimiter);
1488+
}
1489+
if (DSP >= start) DS_DROP;
1490+
}
1491+
else {
1492+
while (index < BLK_LEN(block)) {
1493+
index = Do_Next(block, index, 0);
1494+
if (VAL_TYPE(DS_TOP) <= REB_NONE && !all) DS_DROP;
1495+
else if (THROWN(DS_TOP)) {
1496+
*DS_VALUE(start) = *DS_TOP;
1497+
DSP = start;
1498+
return NULL;
1499+
}
14821500
}
14831501
}
14841502

src/tests/units/series-test.r3

+84
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,90 @@ Rebol [
88

99
~~~start-file~~~ "Series"
1010

11+
===start-group=== "Merging series"
12+
--test-- "JOIN"
13+
--assert "ab" == join 'a 'b
14+
--assert "ab" == join "a" "b"
15+
--assert %ab == join %a "b"
16+
--assert "ab" == join #"a" "b"
17+
--assert <ab> == join <a> "b"
18+
--assert "ab3" == join 'a ['b 3]
19+
--assert "ab3" == join "a" ["b" 3]
20+
--assert %ab3 == join %a ["b" 3]
21+
--assert "ab3" == join #"a" ["b" 3]
22+
--assert <ab3> == join <a> ["b" 3]
23+
--assert "anone" == join "a" none
24+
--assert %anone == join %a none
25+
--assert "anone" == join #"a" none
26+
--assert error? try [join "a" #[unset]]
27+
--assert error? try [join %a #[unset]]
28+
--assert error? try [join #"a" #[unset]]
29+
30+
;@@ https://github.com/Oldes/Rebol-issues/issues/2558
31+
--test-- "AJOIN"
32+
--assert "ab3" == ajoin [ 'a 'b 3]
33+
--assert "ab3" == ajoin [ "a" "b" 3]
34+
--assert %ab3 == ajoin [ %a "b" 3]
35+
--assert "ab3" == ajoin [#"a" "b" 3]
36+
--assert "<a>b3" == ajoin [ <a> "b" 3] ;; by design not a tag!
37+
--assert "a3" == ajoin [ "a" #[none] 3]
38+
--assert %a3 == ajoin [ %a #[none] 3]
39+
--assert "a3" == ajoin [#"a" #[none] 3]
40+
--assert "a3" == ajoin [ "a" #[unset] 3]
41+
--assert %a3 == ajoin [ %a #[unset] 3]
42+
--assert "a3" == ajoin [#"a" #[unset] 3]
43+
;; when first value is not a string, result is always string
44+
--assert "a3" == ajoin [#[none] "a" 3]
45+
--assert "a3" == ajoin [#[none] %a 3]
46+
--assert "a3" == ajoin [#[none] #"a" 3]
47+
;; nested ajoin
48+
--assert "1234" == ajoin [1 2 ajoin [3 4]]
49+
50+
--test-- "AJOIN/all"
51+
--assert "ab3" == ajoin/all [ 'a 'b 3]
52+
--assert "ab3" == ajoin/all [ "a" "b" 3]
53+
--assert %ab3 == ajoin/all [ %a "b" 3]
54+
--assert "ab3" == ajoin/all [#"a" "b" 3]
55+
--assert "anone3" == ajoin/all [ "a" #[none] 3]
56+
--assert %anone3 == ajoin/all [ %a #[none] 3]
57+
--assert "anone3" == ajoin/all [#"a" #[none] 3]
58+
--assert "a3" == ajoin/all [ "a" #[unset] 3]
59+
--assert %a3 == ajoin/all [ %a #[unset] 3]
60+
--assert "a3" == ajoin/all [#"a" #[unset] 3]
61+
;; when first value is not a string, result is always string
62+
--assert "nonea3" == ajoin/all [#[none] "a" 3]
63+
--assert "nonea3" == ajoin/all [#[none] %a 3]
64+
--assert "nonea3" == ajoin/all [#[none] #"a" 3]
65+
66+
--test-- "AJOIN/with"
67+
--assert "a/b/3" == ajoin/with [ 'a 'b 3] #"/"
68+
--assert "a/b/3" == ajoin/with [ "a" "b" 3] #"/"
69+
--assert %a/b/3 == ajoin/with [ %a "b" 3] #"/"
70+
--assert "a/b/3" == ajoin/with [#"a" "b" 3] #"/"
71+
--assert "<a>/b/3" == ajoin/with [ <a> "b" 3] #"/" ;; by design not a tag!
72+
--assert "a/3" == ajoin/with [ "a" #[none] 3] #"/"
73+
--assert %a/3 == ajoin/with [ %a #[none] 3] #"/"
74+
--assert "a/3" == ajoin/with [#"a" #[none] 3] #"/"
75+
--assert "a/3" == ajoin/with [ "a" #[unset] 3] #"/"
76+
--assert %a/3 == ajoin/with [ %a #[unset] 3] #"/"
77+
--assert "a/3" == ajoin/with [#"a" #[unset] 3] #"/"
78+
79+
--test-- "AJOIN/all/with"
80+
--assert "a/b/3" == ajoin/all/with [ 'a 'b 3] #"/"
81+
--assert "a/b/3" == ajoin/all/with [ "a" "b" 3] #"/"
82+
--assert %a/b/3 == ajoin/all/with [ %a "b" 3] #"/"
83+
--assert "a/b/3" == ajoin/all/with [#"a" "b" 3] #"/"
84+
--assert "a/none/3" == ajoin/all/with [ "a" #[none] 3] #"/"
85+
--assert %a/none/3 == ajoin/all/with [ %a #[none] 3] #"/"
86+
--assert "a/none/3" == ajoin/all/with [#"a" #[none] 3] #"/"
87+
--assert "a//3" == ajoin/all/with [ "a" #[unset] 3] #"/"
88+
--assert %a//3 == ajoin/all/with [ %a #[unset] 3] #"/"
89+
--assert "a//3" == ajoin/all/with [#"a" #[unset] 3] #"/"
90+
91+
===end-group===
92+
93+
94+
1195
===start-group=== "FIND & SELECT"
1296

1397
--test-- "SELECT or FIND NONE! anything == none - #473"

0 commit comments

Comments
 (0)