From daf1594390d4af28cd5c391f594bf5cb23ebc819 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Tue, 26 May 2009 10:05:55 -0500
Subject: [PATCH] fix human sort -- wrap all elements so that integers dont get
 compared against strings directly

---
 basis/sorting/human/human-tests.factor | 14 ++++++++++++--
 basis/sorting/human/human.factor       | 13 ++++++++++++-
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/basis/sorting/human/human-tests.factor b/basis/sorting/human/human-tests.factor
index 20a607188c..68ddf8c3c9 100644
--- a/basis/sorting/human/human-tests.factor
+++ b/basis/sorting/human/human-tests.factor
@@ -1,4 +1,14 @@
-USING: sorting.human tools.test sorting.slots ;
+USING: sorting.human tools.test sorting.slots sorting ;
 IN: sorting.human.tests
 
-[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test
+[ { "x1y" "x2" "x10y" } ]
+[ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test
+
+[ { "4dup" "nip" } ]
+[ { "4dup" "nip" } [ human<=> ] sort ] unit-test
+
+[ { "4dup" "nip" } ]
+[ { "nip" "4dup" } [ human<=> ] sort ] unit-test
+
+[ { "4dup" "4nip" "5drop" "nip" "nip2" "nipd" } ]
+[ { "nip" "4dup" "4nip" "5drop" "nip2" "nipd" } [ human<=> ] sort ] unit-test
diff --git a/basis/sorting/human/human.factor b/basis/sorting/human/human.factor
index b3dae45a9b..56de7f2f48 100644
--- a/basis/sorting/human/human.factor
+++ b/basis/sorting/human/human.factor
@@ -6,4 +6,15 @@ IN: sorting.human
 : find-numbers ( string -- seq )
     [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
 
-<< "human" [ find-numbers ] define-sorting >>
+! For comparing integers or sequences
+TUPLE: hybrid obj ;
+
+M: hybrid <=>
+    [ obj>> ] bi@
+    2dup [ integer? ] bi@ xor [
+        drop integer? [ +lt+ ] [ +gt+ ] if
+    ] [
+        <=>
+    ] if ;
+
+<< "human" [ find-numbers [ hybrid boa ] map ] define-sorting >>