From 9efa64831f78ff1b94c91e8a7cdd082b31450aae Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 7 Apr 2011 08:57:26 -0700
Subject: [PATCH 1/2] sorting: change sort-keys and sort-values to generics.
---
core/sorting/sorting-docs.factor | 8 ++++----
core/sorting/sorting.factor | 14 +++++++++++---
2 files changed, 15 insertions(+), 7 deletions(-)
diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor
index 5b013f95fb..4877cdf410 100644
--- a/core/sorting/sorting-docs.factor
+++ b/core/sorting/sorting-docs.factor
@@ -36,12 +36,12 @@ HELP: inv-sort-with
{ $description "Sorts the elements of " { $snippet "seq" } " by applying " { $link compare } " with " { $snippet "quot" } " to each pair of elements in the sequence and inverting the results." } ;
HELP: sort-keys
-{ $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } }
-{ $description "Sorts the elements of " { $snippet "seq" } " comparing first elements of pairs using the " { $link <=> } " word." } ;
+{ $values { "obj" "an object" } { "sortedseq" "a new sorted sequence" } }
+{ $description "Sorts the elements of " { $snippet "obj" } " (converting to an alist first if not a sequence), comparing first elements of pairs using the " { $link <=> } " word." } ;
HELP: sort-values
-{ $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } }
-{ $description "Sorts the elements of " { $snippet "seq" } " comparing second elements of pairs using the " { $link <=> } " word." } ;
+{ $values { "obj" "an object" } { "sortedseq" "a new sorted sequence" } }
+{ $description "Sorts the elements of " { $snippet "obj" } " (converting to an alist first if not a sequence), comparing second elements of pairs using the " { $link <=> } " word." } ;
HELP: natural-sort
{ $values { "seq" "a sequence of real numbers" } { "sortedseq" "a new sorted sequence" } }
diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index b8258b239b..b26a34b41e 100644
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math vectors math.order
+USING: accessors arrays assocs kernel math vectors math.order
sequences sequences.private ;
IN: sorting
@@ -160,8 +160,16 @@ PRIVATE>
: inv-sort-with ( seq quot -- sortedseq )
[ compare invert-comparison ] curry sort ; inline
-: sort-keys ( seq -- sortedseq ) [ first ] sort-with ;
+GENERIC: sort-keys ( obj -- sortedseq )
-: sort-values ( seq -- sortedseq ) [ second ] sort-with ;
+M: object sort-keys >alist sort-keys ;
+
+M: sequence sort-keys [ first ] sort-with ;
+
+GENERIC: sort-values ( obj -- sortedseq )
+
+M: object sort-values >alist sort-values ;
+
+M: sequence sort-values [ second ] sort-with ;
: sort-pair ( a b -- c d ) 2dup after? [ swap ] when ;
From d58bc08aa08980ccf23d930a464d3d830ec9b9a1 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 7 Apr 2011 09:01:21 -0700
Subject: [PATCH 2/2] Update code that did ">alist sort-" to just "sort-".
---
basis/heaps/heaps-tests.factor | 2 +-
basis/help/markup/markup.factor | 2 +-
basis/http/http.factor | 2 +-
basis/logging/analysis/analysis.factor | 2 +-
basis/math/combinatorics/combinatorics.factor | 2 +-
basis/math/statistics/statistics.factor | 2 +-
basis/regexp/minimize/minimize.factor | 2 +-
basis/tools/threads/threads.factor | 2 +-
basis/ui/tools/error-list/error-list.factor | 2 +-
basis/unicode/data/data.factor | 2 +-
basis/xml/syntax/inverse/inverse.factor | 2 +-
core/assocs/assocs-docs.factor | 2 +-
extra/benchmark/knucleotide/knucleotide.factor | 2 +-
extra/oauth/oauth.factor | 2 +-
14 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor
index 703cf53080..f0eed42418 100644
--- a/basis/heaps/heaps-tests.factor
+++ b/basis/heaps/heaps-tests.factor
@@ -36,7 +36,7 @@ IN: heaps.tests
] H{ } map>assoc ;
: test-heap-sort ( n -- ? )
- random-alist dup >alist sort-keys swap heap-sort = ;
+ random-alist dup sort-keys swap heap-sort = ;
14 [
[ t ] swap [ 2^ test-heap-sort ] curry unit-test
diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor
index 8e0c423b59..abc57118a3 100644
--- a/basis/help/markup/markup.factor
+++ b/basis/help/markup/markup.factor
@@ -452,7 +452,7 @@ M: array elements*
: $definition-icons ( element -- )
drop
- icons get >alist sort-keys
+ icons get sort-keys
[ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map
{ "" "Definition class" } prefix
$table ;
diff --git a/basis/http/http.factor b/basis/http/http.factor
index 2030b0d825..4efec50876 100644
--- a/basis/http/http.factor
+++ b/basis/http/http.factor
@@ -37,7 +37,7 @@ CONSTANT: max-redirects 10
[ "Header injection attack" throw ] when ;
: write-header ( assoc -- )
- >alist sort-keys [
+ sort-keys [
[ check-header-string write ": " write ]
[ header-value>string check-header-string write crlf ] bi*
] assoc-each crlf ;
diff --git a/basis/logging/analysis/analysis.factor b/basis/logging/analysis/analysis.factor
index 786aa77c52..b58001100d 100644
--- a/basis/logging/analysis/analysis.factor
+++ b/basis/logging/analysis/analysis.factor
@@ -21,7 +21,7 @@ SYMBOL: message-histogram
drop ;
: recent-histogram ( assoc n -- alist )
- [ >alist sort-values <reversed> ] dip short head ;
+ [ sort-values <reversed> ] dip short head ;
: analyze-entries ( entries word-names -- errors word-histogram message-histogram )
[
diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor
index 1d67f4870b..1cc7d1462a 100644
--- a/basis/math/combinatorics/combinatorics.factor
+++ b/basis/math/combinatorics/combinatorics.factor
@@ -59,7 +59,7 @@ PRIVATE>
swapd each-permutation ; inline
: inverse-permutation ( seq -- permutation )
- <enum> >alist sort-values keys ;
+ <enum> sort-values keys ;
! Combinadic-based combination methodology
diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index e5b5fb0872..47090fa8b8 100644
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -80,7 +80,7 @@ PRIVATE>
[ inc-at ] sequence>hashtable ;
: sorted-histogram ( seq -- alist )
- histogram >alist sort-values ;
+ histogram sort-values ;
: collect-values ( seq quot: ( obj hashtable -- ) -- hash )
'[ [ dup @ ] dip push-at ] sequence>hashtable ; inline
diff --git a/basis/regexp/minimize/minimize.factor b/basis/regexp/minimize/minimize.factor
index 7991efb047..e454a99c8b 100644
--- a/basis/regexp/minimize/minimize.factor
+++ b/basis/regexp/minimize/minimize.factor
@@ -47,7 +47,7 @@ IN: regexp.minimize
over '[ drop first2 _ _ stay-same? ] assoc-filter ;
: partition>classes ( partitions -- synonyms ) ! old-state => new-state
- >alist sort-keys
+ sort-keys
[ drop first2 swap ] assoc-map
<reversed>
>hashtable ;
diff --git a/basis/tools/threads/threads.factor b/basis/tools/threads/threads.factor
index 1bb0918b82..71deb3f42a 100644
--- a/basis/tools/threads/threads.factor
+++ b/basis/tools/threads/threads.factor
@@ -28,7 +28,7 @@ IN: tools.threads
[ [ write ] with-cell ] each
] with-row
- threads >alist sort-keys values [
+ threads sort-keys values [
[ thread. ] with-row
] each
] tabular-output nl ;
diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor
index 13c849ddf1..5ae094b0bf 100644
--- a/basis/ui/tools/error-list/error-list.factor
+++ b/basis/ui/tools/error-list/error-list.factor
@@ -59,7 +59,7 @@ M: source-file-renderer column-alignment drop { 0 0 1 } ;
M: source-file-renderer filled-column drop 1 ;
: <source-file-model> ( model -- model' )
- [ group-by-source-file >alist sort-keys ] <arrow> ;
+ [ group-by-source-file sort-keys ] <arrow> ;
:: <source-file-table> ( error-list -- table )
error-list model>> <source-file-model>
diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor
index b2cb4d205d..dc6c4bfd99 100644
--- a/basis/unicode/data/data.factor
+++ b/basis/unicode/data/data.factor
@@ -141,7 +141,7 @@ PRIVATE>
2dup bounds-check? [ set-nth ] [ 3drop ] if ;
:: fill-ranges ( table -- table )
- name-map >alist sort-values keys
+ name-map sort-values keys
[ { [ "first>" tail? ] [ "last>" tail? ] } 1|| ] filter
2 group [
[ name>char ] bi@ [ [a,b] ] [ table ?nth ] bi
diff --git a/basis/xml/syntax/inverse/inverse.factor b/basis/xml/syntax/inverse/inverse.factor
index 1d37a8dedb..0d757b378c 100644
--- a/basis/xml/syntax/inverse/inverse.factor
+++ b/basis/xml/syntax/inverse/inverse.factor
@@ -67,7 +67,7 @@ M: interpolated [undo-xml]
: >enum ( assoc -- enum )
! Assumes keys are 0..n
- >alist sort-keys values <enum> ;
+ sort-keys values <enum> ;
: undo-xml ( xml -- quot )
[undo-xml] '[ H{ } clone [ _ bind ] keep >enum ] ;
diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor
index f4c27776e2..883952296f 100644
--- a/core/assocs/assocs-docs.factor
+++ b/core/assocs/assocs-docs.factor
@@ -24,7 +24,7 @@ ARTICLE: "enums" "Enumerations"
<enum>
}
"Inverting a permutation using enumerations:"
-{ $example "IN: scratchpad" ": invert ( perm -- perm' )" " <enum> >alist sort-values keys ;" "{ 2 0 4 1 3 } invert ." "{ 1 3 0 4 2 }" } ;
+{ $example "IN: scratchpad" ": invert ( perm -- perm' )" " <enum> sort-values keys ;" "{ 2 0 4 1 3 } invert ." "{ 1 3 0 4 2 }" } ;
HELP: enum
{ $class-description "An associative structure which wraps a sequence and maps integers to the corresponding elements of the sequence."
diff --git a/extra/benchmark/knucleotide/knucleotide.factor b/extra/benchmark/knucleotide/knucleotide.factor
index a161635ffe..2419322152 100644
--- a/extra/benchmark/knucleotide/knucleotide.factor
+++ b/extra/benchmark/knucleotide/knucleotide.factor
@@ -19,7 +19,7 @@ CONSTANT: knucleotide-in "vocab:benchmark/knucleotide/knucleotide-input.txt"
: handle-table ( inputs n -- )
<clumps>
- [ histogram >alist sort-values reverse ] [ length ] bi
+ [ histogram sort-values reverse ] [ length ] bi
'[
[ first write bl ]
[ second 100 * _ /f "%.3f" printf nl ] bi
diff --git a/extra/oauth/oauth.factor b/extra/oauth/oauth.factor
index 0b00e9b875..3d9c2f7ed6 100644
--- a/extra/oauth/oauth.factor
+++ b/extra/oauth/oauth.factor
@@ -53,7 +53,7 @@ nonce ;
] H{ } make-assoc ; inline
:: sign-params ( url request-method consumer-token request-token params -- signed-params )
- params >alist sort-keys :> params
+ params sort-keys :> params
url request-method params signature-base-string :> sbs
consumer-token secret>> request-token dup [ secret>> ] when hmac-key :> key
sbs key sha1 hmac-bytes >base64 >string :> signature