use more macros in sorting, fix test
parent
a4f4abe19e
commit
5fd9f446e7
|
@ -1,6 +1,4 @@
|
||||||
USING: sorting.human tools.test sorting.slots ;
|
USING: sorting.human tools.test sorting.slots ;
|
||||||
IN: sorting.human.tests
|
IN: sorting.human.tests
|
||||||
|
|
||||||
\ human-sort must-infer
|
|
||||||
|
|
||||||
[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test
|
[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test
|
||||||
|
|
|
@ -8,7 +8,7 @@ IN: sorting.slots
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: short-circuit-comparator ( obj1 obj2 word -- comparator/? )
|
: short-circuit-comparator ( obj1 obj2 word -- comparator/? )
|
||||||
execute dup +eq+ eq? [ drop f ] when ;
|
execute dup +eq+ eq? [ drop f ] when ; inline
|
||||||
|
|
||||||
: slot-comparator ( seq -- quot )
|
: slot-comparator ( seq -- quot )
|
||||||
[
|
[
|
||||||
|
@ -25,19 +25,19 @@ MACRO: compare-slots ( sort-specs -- <=> )
|
||||||
#! sort-spec: { accessors comparator }
|
#! sort-spec: { accessors comparator }
|
||||||
[ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
|
[ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
|
||||||
|
|
||||||
: sort-by-slots ( seq sort-specs -- sortedseq )
|
MACRO: sort-by-slots ( sort-specs -- quot )
|
||||||
'[ _ compare-slots ] sort ;
|
'[ [ _ compare-slots ] sort ] ;
|
||||||
|
|
||||||
MACRO: compare-seq ( seq -- quot )
|
MACRO: compare-seq ( seq -- quot )
|
||||||
[ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ;
|
[ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ;
|
||||||
|
|
||||||
: sort-by ( seq sort-seq -- sortedseq )
|
MACRO: sort-by ( sort-seq -- quot )
|
||||||
'[ _ compare-seq ] sort ;
|
'[ [ _ compare-seq ] sort ] ;
|
||||||
|
|
||||||
: sort-keys-by ( seq sort-seq -- sortedseq )
|
MACRO: sort-keys-by ( sort-seq -- quot )
|
||||||
'[ [ first ] bi@ _ compare-seq ] sort ;
|
'[ [ first ] bi@ _ compare-seq ] sort ;
|
||||||
|
|
||||||
: sort-values-by ( seq sort-seq -- sortedseq )
|
MACRO: sort-values-by ( sort-seq -- quot )
|
||||||
'[ [ second ] bi@ _ compare-seq ] sort ;
|
'[ [ second ] bi@ _ compare-seq ] sort ;
|
||||||
|
|
||||||
MACRO: split-by-slots ( accessor-seqs -- quot )
|
MACRO: split-by-slots ( accessor-seqs -- quot )
|
||||||
|
|
Loading…
Reference in New Issue