[ [ ... ] compare ] sort => [ ... ] sort-with
							parent
							
								
									cdf964579d
								
							
						
					
					
						commit
						7c5ef08aab
					
				| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
 | 
			
		||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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,7 +56,7 @@ posting "POSTINGS"
 | 
			
		|||
 | 
			
		||||
: blogroll ( -- seq )
 | 
			
		||||
    f <blog> select-tuples
 | 
			
		||||
    [ [ name>> ] compare ] sort ;
 | 
			
		||||
    [ name>> ] sort-with ;
 | 
			
		||||
 | 
			
		||||
: postings ( -- seq )
 | 
			
		||||
    posting new select-tuples
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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