sorting.specification: add quot to sort specs for working with json etc

diff --git a/basis/sorting/specification/specification-docs.factor b/basis/sorting/specification/specification-docs.factor
index fb87d2667a032eabf75fb36002c7c4ff25aa3979..643227283f71347ed0e2599b034c0df038383d9e 100644 (file)
--- a/basis/sorting/specification/specification-docs.factor
+++ b/basis/sorting/specification/specification-docs.factor
@@ -8,7 +8,7 @@ HELP: compare-with-spec
 { $values
   { "obj1" object }
   { "obj2" object }
-  { "sort-spec" "a sequence of sequences of accessors and a comparator" }
+  { "sort-spec" "a sequence of sequences of accessors/quotations and a comparator" }
   { "<=>" { $link +lt+ } ", " { $link +eq+ } " or " { $link +gt+ } }
 }
 { $description "Compares two objects using a chain of intrinsic linear orders such that if two objects are " { $link +eq+ } ", then the next ordering is tried." } ;

diff --git a/basis/sorting/specification/specification-tests.factor b/basis/sorting/specification/specification-tests.factor
index 05fdbb8ff8576b4a353a8755939028cc5ca5aa24..84edff50866ad5bc58cc9242eb9d329ff72c6382 100644 (file)
--- a/basis/sorting/specification/specification-tests.factor
+++ b/basis/sorting/specification/specification-tests.factor
@@ -4,6 +4,7 @@ USING: accessors math.order sorting.specification tools.test
 arrays sequences kernel assocs multiline sorting.functor ;
 IN: sorting.specification.tests
 
+
 TUPLE: sort-test a b c tuple2 ;
 
 TUPLE: tuple2 d ;
@@ -44,6 +45,25 @@ TUPLE: tuple2 d ;
     } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-with-spec
 ] unit-test
 
+! Test with quotations too even though it's basically the same
+{
+    {
+        T{ sort-test { a 1 } { b 3 } { c 9 } }
+        T{ sort-test { a 1 } { b 1 } { c 10 } }
+        T{ sort-test { a 1 } { b 1 } { c 11 } }
+        T{ sort-test { a 2 } { b 5 } { c 2 } }
+        T{ sort-test { a 2 } { b 5 } { c 3 } }
+    }
+} [
+    {
+        T{ sort-test f 1 3 9 }
+        T{ sort-test f 1 1 10 }
+        T{ sort-test f 1 1 11 }
+        T{ sort-test f 2 5 3 }
+        T{ sort-test f 2 5 2 }
+    } { { [ a>> ] <=> } { [ b>> ] >=< } { [ c>> ] <=> } } sort-with-spec
+] unit-test
+
 { { } } [
     { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-with-spec
 ] unit-test

diff --git a/basis/sorting/specification/specification.factor b/basis/sorting/specification/specification.factor
index 6132da38b12416132cd0937dd0c4a7949accfdf0..71c0b3c5490a5e991f433e90c8188bff3218051e 100644 (file)
--- a/basis/sorting/specification/specification.factor
+++ b/basis/sorting/specification/specification.factor
@@ -1,11 +1,15 @@
 ! Copyright (C) 2009 Slava Pestov, Doug Coleman.
 ! See https://factorcode.org/license.txt for BSD license.
-USING: arrays assocs kernel math.order sequences sorting ;
+USING: arrays assocs kernel math.order quotations sequences
+sorting ;
 IN: sorting.specification
 
 : execute-comparator ( obj1 obj2 word -- <=>/f )
     execute( obj1 obj2 -- <=> ) dup +eq+ eq? [ drop f ] when ;
 
+: call-accessor ( obj1 obj2 quot -- obj1' obj2' )
+    '[ _ call( obj -- value ) ] bi@ ;
+
 : execute-accessor ( obj1 obj2 word -- obj1' obj2' )
     '[ _ execute( tuple -- value ) ] bi@ ;
 
@@ -14,7 +18,7 @@ IN: sorting.specification
     [
         dup array? [
             unclip-last-slice
-            [ [ execute-accessor ] each ] dip
+            [ [ dup quotation? [ call-accessor ] [ execute-accessor ] if ] each ] dip
         ] when execute-comparator
     ] 2with map-find drop +eq+ or ;