Merge branch 'master' of git://factorcode.org/git/factor
commit
a67a424644
basis
alien/fortran
compiler/cfg/ssa/interference
heaps
help/html
interval-maps
splitting/monotonic
ui
gadgets/menus
tools/inspector
vocabs/prettyprint
core
classes/algebra
source-files/errors
extra
dns/util
fuel/xref
gpu/render
pair-methods
webapps
|
@ -365,7 +365,7 @@ M: character-type (<fortran-result>)
|
|||
] bi* ;
|
||||
|
||||
: (fortran-in-shuffle) ( ret par -- seq )
|
||||
[ [ second ] bi@ <=> ] sort append ;
|
||||
[ second ] sort-with append ;
|
||||
|
||||
: (fortran-out-shuffle) ( ret par -- seq )
|
||||
append ;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -52,7 +52,7 @@ IN: heaps.tests
|
|||
] each
|
||||
|
||||
: sort-entries ( entries -- entries' )
|
||||
[ [ key>> ] compare ] sort ;
|
||||
[ key>> ] sort-with ;
|
||||
|
||||
: delete-test ( n -- obj1 obj2 )
|
||||
[
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -46,7 +46,7 @@ PRIVATE>
|
|||
array>> [ value ] map ;
|
||||
|
||||
: <interval-map> ( specification -- map )
|
||||
all-intervals [ [ first second ] compare ] sort
|
||||
all-intervals [ first second ] sort-with
|
||||
>intervals ensure-disjoint interval-map boa ;
|
||||
|
||||
: <interval-set> ( specification -- map )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -65,7 +65,7 @@ M: ---- <menu-item>
|
|||
: <operations-menu> ( target hook -- menu )
|
||||
over object-operations
|
||||
[ primary-operation? ] partition
|
||||
[ reverse ] [ [ [ command-name ] compare ] sort ] bi*
|
||||
[ reverse ] [ [ command-name ] sort-with ] bi*
|
||||
{ ---- } glue <commands-menu> ;
|
||||
|
||||
: show-operations-menu ( gadget target hook -- )
|
||||
|
|
|
@ -57,7 +57,7 @@ M: object make-slot-descriptions
|
|||
make-mirror [ <slot-description> ] { } assoc>map ;
|
||||
|
||||
M: hashtable make-slot-descriptions
|
||||
call-next-method [ [ key-string>> ] compare ] sort ;
|
||||
call-next-method [ key-string>> ] sort-with ;
|
||||
|
||||
: <inspector-table> ( model -- table )
|
||||
[ make-slot-descriptions ] <arrow> inspector-renderer <table>
|
||||
|
|
|
@ -14,7 +14,7 @@ IN: vocabs.prettyprint
|
|||
<PRIVATE
|
||||
|
||||
: sort-vocabs ( seq -- seq' )
|
||||
[ [ vocab-name ] compare ] sort ;
|
||||
[ vocab-name ] sort-with ;
|
||||
|
||||
: pprint-using ( seq -- )
|
||||
[ "syntax" vocab = not ] filter
|
||||
|
|
|
@ -207,7 +207,7 @@ M: anonymous-complement (classes-intersect?)
|
|||
[ "Topological sort failed" throw ] unless* ;
|
||||
|
||||
: sort-classes ( seq -- newseq )
|
||||
[ [ name>> ] compare ] sort >vector
|
||||
[ name>> ] sort-with >vector
|
||||
[ dup empty? not ]
|
||||
[ dup largest-class [ over delete-nth ] dip ]
|
||||
produce nip ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -155,8 +155,13 @@ PRIVATE>
|
|||
|
||||
: natural-sort ( seq -- sortedseq ) [ <=> ] sort ;
|
||||
|
||||
: sort-keys ( seq -- sortedseq ) [ [ first ] compare ] sort ;
|
||||
: sort-with ( seq quot -- sortedseq )
|
||||
[ compare ] curry sort ; inline
|
||||
: inv-sort-with ( seq quot -- sortedseq )
|
||||
[ compare invert-comparison ] curry sort ; inline
|
||||
|
||||
: sort-values ( seq -- sortedseq ) [ [ second ] compare ] sort ;
|
||||
: sort-keys ( seq -- sortedseq ) [ first ] sort-with ;
|
||||
|
||||
: sort-values ( seq -- sortedseq ) [ second ] sort-with ;
|
||||
|
||||
: sort-pair ( a b -- c d ) 2dup after? [ swap ] when ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -73,7 +73,7 @@ TUPLE: multi-index-range
|
|||
C: <multi-index-range> 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 } ;
|
||||
|
||||
|
@ -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 -- )
|
||||
|
|
|
@ -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 ]
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -59,7 +59,7 @@ TUPLE: paste < entity annotations ;
|
|||
|
||||
: pastes ( -- pastes )
|
||||
f <paste> select-tuples
|
||||
[ [ date>> ] compare ] sort
|
||||
[ date>> ] sort-with
|
||||
reverse ;
|
||||
|
||||
TUPLE: annotation < entity parent ;
|
||||
|
|
|
@ -56,11 +56,11 @@ posting "POSTINGS"
|
|||
|
||||
: blogroll ( -- seq )
|
||||
f <blog> select-tuples
|
||||
[ [ name>> ] compare ] sort ;
|
||||
[ name>> ] sort-with ;
|
||||
|
||||
: postings ( -- seq )
|
||||
posting new select-tuples
|
||||
[ [ date>> ] compare invert-comparison ] sort ;
|
||||
[ date>> ] inv-sort-with ;
|
||||
|
||||
: <edit-blogroll-action> ( -- action )
|
||||
<page-action>
|
||||
|
@ -99,7 +99,7 @@ posting "POSTINGS"
|
|||
[ '[ _ <posting> ] 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 [
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
: <revision> ( id -- revision )
|
||||
revision new swap >>id ;
|
||||
|
@ -307,7 +307,7 @@ M: revision feed-entry-url id>> revision-url ;
|
|||
|
||||
[
|
||||
f <article> select-tuples
|
||||
[ [ title>> ] compare ] sort
|
||||
[ title>> ] sort-with
|
||||
"articles" set-value
|
||||
] >>init
|
||||
|
||||
|
|
Loading…
Reference in New Issue