From ce73c17c1d350a2743b1b3a96fea255aa9535c3b Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Fri, 3 Apr 2009 17:28:55 -0500
Subject: [PATCH] add sorting.functor
---
basis/sorting/functor/authors.txt | 1 +
basis/sorting/functor/functor.factor | 24 ++++++++++++++++++++++++
2 files changed, 25 insertions(+)
create mode 100644 basis/sorting/functor/authors.txt
create mode 100644 basis/sorting/functor/functor.factor
diff --git a/basis/sorting/functor/authors.txt b/basis/sorting/functor/authors.txt
new file mode 100644
index 0000000000..b4bd0e7b35
--- /dev/null
+++ b/basis/sorting/functor/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/basis/sorting/functor/functor.factor b/basis/sorting/functor/functor.factor
new file mode 100644
index 0000000000..022ef3fb0d
--- /dev/null
+++ b/basis/sorting/functor/functor.factor
@@ -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