add sorting.functor
parent
32954b75ad
commit
ce73c17c1d
|
@ -0,0 +1 @@
|
||||||
|
Doug Coleman
|
|
@ -0,0 +1,24 @@
|
||||||
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: functors kernel math.order sequences sorting ;
|
||||||
|
IN: sorting.functor
|
||||||
|
|
||||||
|
FUNCTOR: define-sorting ( NAME QUOT -- )
|
||||||
|
|
||||||
|
NAME<=> DEFINES ${NAME}<=>
|
||||||
|
NAME>=< DEFINES ${NAME}>=<
|
||||||
|
NAME-compare DEFINES ${NAME}-compare
|
||||||
|
NAME-sort DEFINES ${NAME}-sort
|
||||||
|
NAME-sort-keys DEFINES ${NAME}-sort-keys
|
||||||
|
NAME-sort-values DEFINES ${NAME}-sort-values
|
||||||
|
|
||||||
|
WHERE
|
||||||
|
|
||||||
|
: NAME<=> ( obj1 obj2 -- <=> ) QUOT bi@ <=> ;
|
||||||
|
: NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ;
|
||||||
|
: NAME-compare ( obj1 obj2 quot -- <=> ) bi@ NAME<=> ; inline
|
||||||
|
: NAME-sort ( seq -- sortedseq ) [ NAME<=> ] sort ;
|
||||||
|
: NAME-sort-keys ( seq -- sortedseq ) [ [ first ] NAME-compare ] sort ;
|
||||||
|
: NAME-sort-values ( seq -- sortedseq ) [ [ second ] NAME-compare ] sort ;
|
||||||
|
|
||||||
|
;FUNCTOR
|
Loading…
Reference in New Issue