steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

define a sort-by to take a sequence of comparators without slots

db4
Doug Coleman 2009-04-03 19:43:10 -05:00
parent 695b97e6e6
commit 8fdb3bb27a
2 changed files with 29 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/sorting/slots/slots-tests.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors math.order sorting.slots tools.test
sorting.human arrays sequences kernel assocs multiline ;
sorting.human arrays sequences kernel assocs multiline
sorting.functor ;
IN: sorting.literals.tests
TUPLE: sort-test a b c tuple2 ;
@ -76,6 +77,9 @@ TUPLE: tuple2 d ;
[ { } ]
[ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test
[ { } ]
[ { } { } sort-by-slots ] unit-test
[
{
T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
@ -143,3 +147,15 @@ TUPLE: tuple2 d ;
T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } }
} { { tuple2>> d>> } { a>> } } split-by-slots [ >array ] map
] unit-test
[ { "a" "b" "c" } ] [ { "b" "c" "a" } { <=> <=> } sort-by ] unit-test
[ { "b" "c" "a" } ] [ { "b" "c" "a" } { } sort-by ] unit-test
<< "length-test" [ length ] define-sorting >>
[ { { 1 } { 1 2 3 } { 1 3 2 } { 3 2 1 } } ]
[
{ { 3 2 1 } { 1 2 3 } { 1 3 2 } { 1 } }
{ length-test<=> <=> } sort-by
] unit-test

14
basis/sorting/slots/slots.factor
View File

@ -7,6 +7,9 @@ IN: sorting.slots
<PRIVATE
: short-circuit-comparator ( word -- quot )
'[ _ execute dup +eq+ eq? [ drop f ] when ] ; inline
: slot-comparator ( seq -- quot )
[
but-last-slice
@ -20,11 +23,18 @@ PRIVATE>
MACRO: compare-slots ( sort-specs -- <=> )
#! sort-spec: { accessors comparator }
'[ _ [ slot-comparator ] map 2|| +eq+ or ] ;
[ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
: sort-by-slots ( seq sort-specs -- seq' )
: sort-by-slots ( seq sort-specs -- sortedseq )
'[ _ compare-slots ] sort ;
MACRO: compare-seq ( seq -- quot )
[ short-circuit-comparator ] map '[ _ 2|| +eq+ or ] ;
: sort-by ( seq sort-seq -- sortedseq )
'[ _ compare-seq ] sort ;
MACRO: split-by-slots ( accessor-seqs -- quot )
[ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
'[ [ _ 2&& ] slice monotonic-slice ] ;