diff --git a/src/boot/actions.reb b/src/boot/actions.reb index 850c85ee4d..fdf79d60e2 100644 --- a/src/boot/actions.reb +++ b/src/boot/actions.reb @@ -375,8 +375,8 @@ sort: action [ /case {Case sensitive sort} /skip {Treat the series as records of fixed size} size [integer!] {Size of each record} - /compare {Comparator offset, block or function} - comparator [integer! block! any-function!] + /compare {Comparator offset or function} + comparator [integer! any-function!] /part {Limits the sorting to a given length or position} range [number! series!] /all {Compare all fields} diff --git a/src/core/t-block.c b/src/core/t-block.c index 85601c03c8..8b85dc30c3 100644 --- a/src/core/t-block.c +++ b/src/core/t-block.c @@ -449,33 +449,21 @@ static void No_Nones_Or_Logic(REBVAL *arg) { return; } -// WARNING! Not re-entrant. !!! Must find a way to push it on stack? -static struct { - REBFLG cased; - REBFLG reverse; - REBCNT offset; - REBVAL *compare; -} sort_flags = {0}; - /*********************************************************************** ** */ static int Compare_Val(const void *v1, const void *v2) /* ***********************************************************************/ { - // !!!! BE SURE that 64 bit large difference comparisons work + REBVAL *val = DS_GET(DSP - 1); + REBU64 flags = VAL_UNT64(DS_TOP); + REBINT offset = 0; + if (IS_INTEGER(val)) offset = VAL_INT64(val) - 1; - if (sort_flags.reverse) - return Cmp_Value((REBVAL*)v2+sort_flags.offset, (REBVAL*)v1+sort_flags.offset, sort_flags.cased); + if (GET_FLAG(flags, SORT_FLAG_REVERSE)) + return Cmp_Value((REBVAL*)v2+offset, (REBVAL*)v1+offset, GET_FLAG(flags, SORT_FLAG_CASE)); else - return Cmp_Value((REBVAL*)v1+sort_flags.offset, (REBVAL*)v2+sort_flags.offset, sort_flags.cased); - -/* - REBI64 n = VAL_INT64((REBVAL*)v1) - VAL_INT64((REBVAL*)v2); - if (n > 0) return 1; - if (n < 0) return -1; - return 0; -*/ + return Cmp_Value((REBVAL*)v1+offset, (REBVAL*)v2+offset, GET_FLAG(flags, SORT_FLAG_CASE)); } @@ -485,14 +473,19 @@ static struct { /* ***********************************************************************/ { - REBVAL *v1 = (REBVAL*)p1; - REBVAL *v2 = (REBVAL*)p2; + REBVAL *v1 = (REBVAL*)p2; + REBVAL *v2 = (REBVAL*)p1; REBVAL *val; - REBVAL *tmp; REBSER *args; + REBVAL *func; + REBU64 flags; + + func = DS_GET(DSP - 1); + if (!ANY_FUNC(func)) abort(); + flags = VAL_UNT64(DS_TOP); - if (!sort_flags.reverse) { + if (GET_FLAG(flags, SORT_FLAG_REVERSE)) { tmp = v1; v1 = v2; v2 = tmp; @@ -502,27 +495,24 @@ static struct { // TODO: The below results in an error message such as "op! does not allow // unset! for its value1 argument". A better message would be more like // "compare handler does not allow error! for its value1 argument." - args = VAL_FUNC_ARGS(sort_flags.compare); + args = VAL_FUNC_ARGS(func); if (BLK_LEN(args) > 1 && !TYPE_CHECK(BLK_SKIP(args, 1), VAL_TYPE(v1))) - Trap3(RE_EXPECT_ARG, Of_Type(sort_flags.compare), BLK_SKIP(args, 1), Of_Type(v1)); + Trap3(RE_EXPECT_ARG, Of_Type(func), BLK_SKIP(args, 1), Of_Type(v1)); if (BLK_LEN(args) > 2 && !TYPE_CHECK(BLK_SKIP(args, 2), VAL_TYPE(v2))) - Trap3(RE_EXPECT_ARG, Of_Type(sort_flags.compare), BLK_SKIP(args, 2), Of_Type(v2)); + Trap3(RE_EXPECT_ARG, Of_Type(func), BLK_SKIP(args, 2), Of_Type(v2)); - val = Apply_Func(0, sort_flags.compare, v1, v2, 0); + val = Apply_Func(0, func, v1, v2, 0); if (IS_LOGIC(val)) { if (IS_TRUE(val)) return 1; - return -1; } - if (IS_INTEGER(val)) { + else if (IS_INTEGER(val)) { if (VAL_INT64(val) < 0) return 1; if (VAL_INT64(val) == 0) return 0; - return -1; } - if (IS_DECIMAL(val)) { + else if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) < 0) return 1; if (VAL_DECIMAL(val) == 0) return 0; - return -1; } return -1; } @@ -550,13 +540,12 @@ static struct { REBCNT size = sizeof(REBVAL); // int (*sfunc)(const void *v1, const void *v2); - sort_flags.cased = ccase; - sort_flags.reverse = rev; - sort_flags.compare = 0; - sort_flags.offset = 0; + REBU64 flags = 0; + if (ccase) SET_FLAG(flags, SORT_FLAG_CASE); + if (rev) SET_FLAG(flags, SORT_FLAG_REVERSE); - if (IS_INTEGER(compv)) sort_flags.offset = Int32(compv)-1; - if (ANY_FUNC(compv)) sort_flags.compare = compv; + DS_PUSH(compv); + DS_PUSH_INTEGER(flags); // Determine length of sort: len = Partial1(block, part); @@ -572,11 +561,14 @@ static struct { // Use fast quicksort library function: if (skip > 1) len /= skip, size *= skip; - if (sort_flags.compare) + if (ANY_FUNC(compv)) reb_qsort((void *)VAL_BLK_DATA(block), len, size, Compare_Call); else reb_qsort((void *)VAL_BLK_DATA(block), len, size, Compare_Val); + // Stored comparator and flags are not needed anymore + DS_DROP; + DS_DROP; } diff --git a/src/core/t-string.c b/src/core/t-string.c index 007c65d548..9cfdb020cc 100644 --- a/src/core/t-string.c +++ b/src/core/t-string.c @@ -439,7 +439,7 @@ static REBSER *make_binary(REBVAL *arg, REBOOL make) if (rev) SET_FLAG(flags, SORT_FLAG_REVERSE); if (1 < SERIES_WIDE(VAL_SERIES(string))) SET_FLAG(flags, SORT_FLAG_WIDE); - // Store flags and the comparator function on the stack + // Store the comparator function and flags on the stack DS_PUSH(compv); DS_PUSH_INTEGER(flags); sfunc = Compare_Call; @@ -452,6 +452,12 @@ static REBSER *make_binary(REBVAL *arg, REBOOL make) //!!uni - needs to compare wide chars too reb_qsort((void *)VAL_DATA(string), len, size * SERIES_WIDE(VAL_SERIES(string)), sfunc); + + if (ANY_FUNC(compv)) { + // Stored comparator and flags are not needed anymore + DS_DROP; + DS_DROP; + } } diff --git a/src/include/reb-defs.h b/src/include/reb-defs.h index 127b807dcd..11406cdb49 100644 --- a/src/include/reb-defs.h +++ b/src/include/reb-defs.h @@ -53,6 +53,7 @@ typedef int cmp_t(const void *, const void *); void reb_qsort(void *a, size_t n, size_t es, cmp_t *cmp); #define SORT_FLAG_REVERSE 1 #define SORT_FLAG_WIDE 2 +#define SORT_FLAG_CASE 3 // Encoding_opts was originally in sys-core.h, but I moved it here so it can diff --git a/src/tests/units/series-test.r3 b/src/tests/units/series-test.r3 index 46cb098cfc..4e351e0832 100644 --- a/src/tests/units/series-test.r3 +++ b/src/tests/units/series-test.r3 @@ -1717,6 +1717,22 @@ Rebol [ --assert s1 == "aabbccdd" --assert s2 == "íííéééááá" +--test-- "SORT/compare block! (nested)" + ;@@ https://github.com/Oldes/Rebol-issues/issues/2622 + s1: sort/compare ["a" "b" "c" "d"] func[a b][s2: sort/compare/reverse [1 2 3 4] func[a b][a < b] a < b] + --assert s1 == ["a" "b" "c" "d"] + --assert s2 == [4 3 2 1] + s1: sort/compare/reverse ["a" "A" "B" "b"] func[a b][s2: sort/compare [1 2 3 4] :greater? a < b] + --assert s1 == ["B" "b" "a" "A"] + --assert s2 == [4 3 2 1] + s1: sort/compare [1 4 2 3] func[a b][s2: sort/case ["a" "B" "b" "a"] a < b] + --assert s1 == [1 2 3 4] + --assert s2 == ["B" "a" "a" "b"] + s1: sort/compare/reverse [1 4 2 3] func[a b][s2: sort ["a" "B" "b" "a"] a < b] + --assert s1 == [4 3 2 1] + --assert s2 == ["a" "a" "B" "b"] + + --test-- "SORT/skip/compare" ;@@ https://github.com/Oldes/Rebol-issues/issues/1152 --assert ["A" "a"] = sort/compare ["A" "a"] func [a b] [a < b]