From f0f20708cd647949155e2a461b35ca7c3e789b19 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 2 Aug 2009 19:52:33 -0500 Subject: [PATCH 1/7] gpu.render: remove gpu-data-ptr slot specialization on index-elements. it prevents using specialized-arrays or other byte-array wrappers with index-elements --- extra/gpu/render/render.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index 8f1679bfa8..35e137a235 100644 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -73,7 +73,7 @@ TUPLE: multi-index-range C: multi-index-range TUPLE: index-elements - { ptr gpu-data-ptr read-only } + { ptr read-only } { count integer read-only } { index-type index-type read-only } ; From cdf964579d822938c36713aa99ad52bde93b0788 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 2 Aug 2009 20:01:54 -0500 Subject: [PATCH 2/7] sorting: sort-with and inv-sort-with combinators to simplify common [ [ ... ] compare ] sort idiom --- core/sorting/sorting-docs.factor | 18 ++++++++++++++---- core/sorting/sorting.factor | 5 +++++ 2 files changed, 19 insertions(+), 4 deletions(-) diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor index 290ca1470c..c30c06a989 100644 --- a/core/sorting/sorting-docs.factor +++ b/core/sorting/sorting-docs.factor @@ -12,6 +12,8 @@ $nl "Sorting a sequence with a custom comparator:" { $subsection sort } "Sorting a sequence with common comparators:" +{ $subsection sort-with } +{ $subsection inv-sort-with } { $subsection natural-sort } { $subsection sort-keys } { $subsection sort-values } ; @@ -20,16 +22,24 @@ ABOUT: "sequences-sorting" HELP: sort { $values { "seq" "a sequence" } { "quot" { $quotation "( obj1 obj2 -- <=> )" } } { "sortedseq" "a new sorted sequence" } } -{ $description "Sorts the elements into a new array using a stable sort." } +{ $description "Sorts the elements of " { $snippet "seq" } " into a new array using a stable sort." } { $notes "The algorithm used is the merge sort." } ; +HELP: sort-with +{ $values { "seq" "a sequence" } { "quot" { $quotation "( object -- key )" } } { "sortedseq" "a new sorted sequence" } } +{ $description "Sorts the elements of " { $snippet "seq" } " by applying " { $link compare } " with " { $snippet "quot" } " to each pair of elements in the sequence." } ; + +HELP: inv-sort-with +{ $values { "seq" "a sequence" } { "quot" { $quotation "( object -- key )" } } { "sortedseq" "a new sorted sequence" } } +{ $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 comparing first elements of pairs using the " { $link <=> } " word." } ; +{ $description "Sorts the elements of " { $snippet "seq" } " 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 comparing second elements of pairs using the " { $link <=> } " word." } ; +{ $description "Sorts the elements of " { $snippet "seq" } " comparing second elements of pairs using the " { $link <=> } " word." } ; HELP: natural-sort { $values { "seq" "a sequence of real numbers" } { "sortedseq" "a new sorted sequence" } } @@ -43,4 +53,4 @@ HELP: midpoint@ { $values { "seq" "a sequence" } { "n" integer } } { $description "Outputs the index of the midpoint of " { $snippet "seq" } "." } ; -{ <=> compare natural-sort sort-keys sort-values } related-words +{ <=> compare natural-sort sort-with inv-sort-with sort-keys sort-values } related-words diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index 0c0951bbce..312ddcd9be 100644 --- a/core/sorting/sorting.factor +++ b/core/sorting/sorting.factor @@ -155,6 +155,11 @@ PRIVATE> : natural-sort ( seq -- sortedseq ) [ <=> ] sort ; +: sort-with ( seq quot -- sortedseq ) + [ compare ] curry sort ; inline +: inv-sort-with ( seq quot -- sortedseq ) + [ compare invert-comparison ] curry sort ; inline + : sort-keys ( seq -- sortedseq ) [ [ first ] compare ] sort ; : sort-values ( seq -- sortedseq ) [ [ second ] compare ] sort ; From 7c5ef08aabdbf4033b24b5b28464bed82240200f Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 2 Aug 2009 20:09:23 -0500 Subject: [PATCH 3/7] [ [ ... ] compare ] sort => [ ... ] sort-with --- basis/compiler/cfg/ssa/interference/interference.factor | 2 +- basis/heaps/heaps-tests.factor | 2 +- basis/help/html/html.factor | 2 +- basis/interval-maps/interval-maps.factor | 2 +- basis/splitting/monotonic/monotonic.factor | 2 +- basis/ui/gadgets/menus/menus.factor | 2 +- basis/ui/tools/inspector/inspector.factor | 2 +- basis/vocabs/prettyprint/prettyprint.factor | 2 +- core/classes/algebra/algebra.factor | 2 +- core/sorting/sorting.factor | 4 ++-- core/source-files/errors/errors.factor | 2 +- extra/dns/util/util.factor | 2 +- extra/webapps/pastebin/pastebin.factor | 2 +- extra/webapps/planet/planet.factor | 2 +- extra/webapps/wiki/wiki.factor | 2 +- 15 files changed, 16 insertions(+), 16 deletions(-) diff --git a/basis/compiler/cfg/ssa/interference/interference.factor b/basis/compiler/cfg/ssa/interference/interference.factor index f8553ec9de..dd002ec977 100644 --- a/basis/compiler/cfg/ssa/interference/interference.factor +++ b/basis/compiler/cfg/ssa/interference/interference.factor @@ -58,7 +58,7 @@ PRIVATE> : sort-vregs-by-bb ( vregs -- alist ) defs get '[ dup _ at ] { } map>assoc - [ [ second pre-of ] compare ] sort ; + [ second pre-of ] sort-with ; : ?last ( seq -- elt/f ) [ f ] [ last ] if-empty ; inline diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor index b476107562..c1985c516f 100644 --- a/basis/heaps/heaps-tests.factor +++ b/basis/heaps/heaps-tests.factor @@ -52,7 +52,7 @@ IN: heaps.tests ] each : sort-entries ( entries -- entries' ) - [ [ key>> ] compare ] sort ; + [ key>> ] sort-with ; : delete-test ( n -- obj1 obj2 ) [ diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 84f708a687..6f87549619 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -115,7 +115,7 @@ TUPLE: result title href ; load-index swap >lower '[ [ drop _ ] dip >lower subseq? ] assoc-filter [ swap result boa ] { } assoc>map - [ [ title>> ] compare ] sort ; + [ title>> ] sort-with ; : article-apropos ( string -- results ) "articles.idx" offline-apropos ; diff --git a/basis/interval-maps/interval-maps.factor b/basis/interval-maps/interval-maps.factor index 22283deecb..b94266282c 100644 --- a/basis/interval-maps/interval-maps.factor +++ b/basis/interval-maps/interval-maps.factor @@ -46,7 +46,7 @@ PRIVATE> array>> [ value ] map ; : ( specification -- map ) - all-intervals [ [ first second ] compare ] sort + all-intervals [ first second ] sort-with >intervals ensure-disjoint interval-map boa ; : ( specification -- map ) diff --git a/basis/splitting/monotonic/monotonic.factor b/basis/splitting/monotonic/monotonic.factor index 088de52766..3dec6130de 100644 --- a/basis/splitting/monotonic/monotonic.factor +++ b/basis/splitting/monotonic/monotonic.factor @@ -64,6 +64,6 @@ TUPLE: upward-slice < slice ; drop [ downward-slices ] [ stable-slices ] - [ upward-slices ] tri 3append [ [ from>> ] compare ] sort + [ upward-slices ] tri 3append [ from>> ] sort-with ] } case ; diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor index 159da59be5..70818262c5 100644 --- a/basis/ui/gadgets/menus/menus.factor +++ b/basis/ui/gadgets/menus/menus.factor @@ -65,7 +65,7 @@ M: ---- : ( target hook -- menu ) over object-operations [ primary-operation? ] partition - [ reverse ] [ [ [ command-name ] compare ] sort ] bi* + [ reverse ] [ [ command-name ] sort-with ] bi* { ---- } glue ; : show-operations-menu ( gadget target hook -- ) diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index 35fa5e3c17..b4a772dca5 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -57,7 +57,7 @@ M: object make-slot-descriptions make-mirror [ ] { } assoc>map ; M: hashtable make-slot-descriptions - call-next-method [ [ key-string>> ] compare ] sort ; + call-next-method [ key-string>> ] sort-with ; : ( model -- table ) [ make-slot-descriptions ] inspector-renderer diff --git a/basis/vocabs/prettyprint/prettyprint.factor b/basis/vocabs/prettyprint/prettyprint.factor index 0e150ef07a..66bc277ef7 100644 --- a/basis/vocabs/prettyprint/prettyprint.factor +++ b/basis/vocabs/prettyprint/prettyprint.factor @@ -14,7 +14,7 @@ IN: vocabs.prettyprint > ] compare ] sort >vector + [ name>> ] sort-with >vector [ dup empty? not ] [ dup largest-class [ over delete-nth ] dip ] produce nip ; diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index 312ddcd9be..b8258b239b 100644 --- a/core/sorting/sorting.factor +++ b/core/sorting/sorting.factor @@ -160,8 +160,8 @@ PRIVATE> : inv-sort-with ( seq quot -- sortedseq ) [ compare invert-comparison ] curry sort ; inline -: sort-keys ( seq -- sortedseq ) [ [ first ] compare ] sort ; +: sort-keys ( seq -- sortedseq ) [ first ] sort-with ; -: sort-values ( seq -- sortedseq ) [ [ second ] compare ] sort ; +: sort-values ( seq -- sortedseq ) [ second ] sort-with ; : sort-pair ( a b -- c d ) 2dup after? [ swap ] when ; diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index f6f4f4825a..86a8354071 100644 --- a/core/source-files/errors/errors.factor +++ b/core/source-files/errors/errors.factor @@ -7,7 +7,7 @@ IN: source-files.errors TUPLE: source-file-error error asset file line# ; : sort-errors ( errors -- alist ) - [ [ [ line#>> ] compare ] sort ] { } assoc-map-as sort-keys ; + [ [ line#>> ] sort-with ] { } assoc-map-as sort-keys ; : group-by-source-file ( errors -- assoc ) H{ } clone [ [ push-at ] curry [ dup file>> ] prepose each ] keep ; diff --git a/extra/dns/util/util.factor b/extra/dns/util/util.factor index f47eb7010c..6934d3bbd9 100644 --- a/extra/dns/util/util.factor +++ b/extra/dns/util/util.factor @@ -10,7 +10,7 @@ MACRO: 1if ( test then else -- ) '[ dup @ _ _ if ] ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: sort-largest-first ( seq -- seq ) [ [ length ] compare ] sort reverse ; +: sort-largest-first ( seq -- seq ) [ length ] sort-with reverse ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index 6a52d02009..2c51d41aa0 100644 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -59,7 +59,7 @@ TUPLE: paste < entity annotations ; : pastes ( -- pastes ) f select-tuples - [ [ date>> ] compare ] sort + [ date>> ] sort-with reverse ; TUPLE: annotation < entity parent ; diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 12b7ccda24..8ada4be638 100755 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -56,7 +56,7 @@ posting "POSTINGS" : blogroll ( -- seq ) f select-tuples - [ [ name>> ] compare ] sort ; + [ name>> ] sort-with ; : postings ( -- seq ) posting new select-tuples diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor index 5689f23d4e..118f92061b 100644 --- a/extra/webapps/wiki/wiki.factor +++ b/extra/webapps/wiki/wiki.factor @@ -307,7 +307,7 @@ M: revision feed-entry-url id>> revision-url ; [ f
select-tuples - [ [ title>> ] compare ] sort + [ title>> ] sort-with "articles" set-value ] >>init From 2a6045110714ed39776570ac93079f30bca54888 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 2 Aug 2009 20:10:58 -0500 Subject: [PATCH 4/7] [ [ ... ] compare invert-comparison ] sort => [ ... ] inv-sort-with --- extra/webapps/blogs/blogs.factor | 2 +- extra/webapps/planet/planet.factor | 4 ++-- extra/webapps/wiki/wiki.factor | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/webapps/blogs/blogs.factor b/extra/webapps/blogs/blogs.factor index c16450bb25..f098bb9f09 100644 --- a/extra/webapps/blogs/blogs.factor +++ b/extra/webapps/blogs/blogs.factor @@ -83,7 +83,7 @@ M: comment entity-url >>comments ; : reverse-chronological-order ( seq -- sorted ) - [ [ date>> ] compare invert-comparison ] sort ; + [ date>> ] inv-sort-with ; : validate-author ( -- ) { { "author" [ v-username ] } } validate-params ; diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 8ada4be638..eb51acbe1a 100755 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -60,7 +60,7 @@ posting "POSTINGS" : postings ( -- seq ) posting new select-tuples - [ [ date>> ] compare invert-comparison ] sort ; + [ date>> ] inv-sort-with ; : ( -- action ) @@ -99,7 +99,7 @@ posting "POSTINGS" [ '[ _ ] map ] 2map concat ; : sort-entries ( entries -- entries' ) - [ [ date>> ] compare invert-comparison ] sort ; + [ date>> ] inv-sort-with ; : update-cached-postings ( -- ) blogroll fetch-blogroll sort-entries 8 short head [ diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor index 118f92061b..f3a3784465 100644 --- a/extra/webapps/wiki/wiki.factor +++ b/extra/webapps/wiki/wiki.factor @@ -66,7 +66,7 @@ M: revision feed-entry-date date>> ; M: revision feed-entry-url id>> revision-url ; : reverse-chronological-order ( seq -- sorted ) - [ [ date>> ] compare invert-comparison ] sort ; + [ date>> ] inv-sort-with ; : ( id -- revision ) revision new swap >>id ; From a2fe9f1952f882b1ee2a227af229d56e1e1eb5d3 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 2 Aug 2009 20:13:59 -0500 Subject: [PATCH 5/7] [ [ ... ] bi@ <=> ] sort => [ ... ] sort-with --- basis/alien/fortran/fortran.factor | 2 +- extra/gpu/render/render.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index 54b799f675..15840dfd66 100644 --- a/basis/alien/fortran/fortran.factor +++ b/basis/alien/fortran/fortran.factor @@ -365,7 +365,7 @@ M: character-type () ] bi* ; : (fortran-in-shuffle) ( ret par -- seq ) - [ [ second ] bi@ <=> ] sort append ; + [ second ] sort-with append ; : (fortran-out-shuffle) ( ret par -- seq ) append ; diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index 35e137a235..2f920645ed 100644 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -422,7 +422,7 @@ SYNTAX: UNIFORM-TUPLE: [ [ length ] [ >int-array ] bi glDrawBuffers ] if ; : bind-named-output-attachments ( program-instance framebuffer attachments -- ) - rot '[ [ first _ swap output-index ] bi@ <=> ] sort [ second ] map + rot '[ first _ swap output-index ] sort-with [ second ] map bind-unnamed-output-attachments ; : bind-output-attachments ( program-instance framebuffer attachments -- ) From 97a515c04e39018e96bcd468e9d1eca2eb172c49 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 2 Aug 2009 20:14:56 -0500 Subject: [PATCH 6/7] [ [ ... ] bi@ >=< ] sort => [ ... ] inv-sort-with --- extra/pair-methods/pair-methods.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/pair-methods/pair-methods.factor b/extra/pair-methods/pair-methods.factor index d44d5bce78..131f9f5465 100644 --- a/extra/pair-methods/pair-methods.factor +++ b/extra/pair-methods/pair-methods.factor @@ -21,7 +21,7 @@ ERROR: no-pair-method a b generic ; : sorted-pair-methods ( word -- alist ) "pair-generic-methods" word-prop >alist - [ [ first method-sort-key ] bi@ >=< ] sort ; + [ first method-sort-key ] inv-sort-with ; : pair-generic-definition ( word -- def ) [ sorted-pair-methods [ first2 pair-method-cond ] map ] From f5edb8629f4919452384459a5847a3a0a56df5a6 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sun, 2 Aug 2009 20:17:25 -0500 Subject: [PATCH 7/7] one last sort-with-able straggler in fuel.xref --- extra/fuel/xref/xref.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor index 86aa215e21..cfd036e625 100644 --- a/extra/fuel/xref/xref.factor +++ b/extra/fuel/xref/xref.factor @@ -23,7 +23,7 @@ IN: fuel.xref dup dup >vocab-link where normalize-loc 4array ; : sort-xrefs ( seq -- seq' ) - [ [ first ] dip first <=> ] sort ; + [ first ] sort-with ; : format-xrefs ( seq -- seq' ) [ word? ] filter [ word>xref ] map ;