Use keys/values where appropriate
parent
6b24617bac
commit
bdecd564a3
|
@ -75,7 +75,7 @@ PRIVATE>
|
||||||
ERROR: no-slots-named class seq ;
|
ERROR: no-slots-named class seq ;
|
||||||
: check-columns ( class columns -- )
|
: check-columns ( class columns -- )
|
||||||
[ nip ] [
|
[ nip ] [
|
||||||
[ [ first ] map ]
|
[ keys ]
|
||||||
[ all-slots [ name>> ] map ] bi* diff
|
[ all-slots [ name>> ] map ] bi* diff
|
||||||
] 2bi
|
] 2bi
|
||||||
[ drop ] [ no-slots-named ] if-empty ;
|
[ drop ] [ no-slots-named ] if-empty ;
|
||||||
|
|
|
@ -77,7 +77,7 @@ M: linux x>hid-bit-order
|
||||||
} ; inline
|
} ; inline
|
||||||
|
|
||||||
: x-bits>hid-bits ( bit-array -- bit-array )
|
: x-bits>hid-bits ( bit-array -- bit-array )
|
||||||
256 iota [ 2array ] { } 2map-as [ first ] filter [ second ] map
|
256 iota [ 2array ] { } 2map-as [ first ] filter values
|
||||||
x>hid-bit-order [ nth ] curry map
|
x>hid-bit-order [ nth ] curry map
|
||||||
256 <bit-array> swap [ t swap pick set-nth ] each ;
|
256 <bit-array> swap [ t swap pick set-nth ] each ;
|
||||||
|
|
||||||
|
|
|
@ -32,8 +32,8 @@ ARTICLE: "grouping" "Groups and clumps"
|
||||||
"{ 1 2 3 4 } 2 clump ." "{ { 1 2 } { 2 3 } { 3 4 } }"
|
"{ 1 2 3 4 } 2 clump ." "{ { 1 2 } { 2 3 } { 3 4 } }"
|
||||||
}
|
}
|
||||||
{ $unchecked-example
|
{ $unchecked-example
|
||||||
"USING: grouping ;"
|
"USING: grouping assocs sequences ;"
|
||||||
"{ 1 2 3 4 } dup" "2 <clumps> unclip-last [ [ first ] map ] dip append sequence= ." "t"
|
"{ 1 2 3 4 } dup" "2 <clumps> unclip-last [ keys ] dip append sequence= ." "t"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
{ "With circular clumps, collecting the first element of each subsequence yields the original sequence. Collecting the " { $snippet "n" } "th element of each subsequence would rotate the original sequence " { $snippet "n" } " elements rightward:"
|
{ "With circular clumps, collecting the first element of each subsequence yields the original sequence. Collecting the " { $snippet "n" } "th element of each subsequence would rotate the original sequence " { $snippet "n" } " elements rightward:"
|
||||||
|
@ -42,8 +42,8 @@ ARTICLE: "grouping" "Groups and clumps"
|
||||||
"{ 1 2 3 4 } 2 circular-clump ." "{ { 1 2 } { 2 3 } { 3 4 } { 4 1 } }"
|
"{ 1 2 3 4 } 2 circular-clump ." "{ { 1 2 } { 2 3 } { 3 4 } { 4 1 } }"
|
||||||
}
|
}
|
||||||
{ $unchecked-example
|
{ $unchecked-example
|
||||||
"USING: grouping ;"
|
"USING: grouping assocs sequences ;"
|
||||||
"{ 1 2 3 4 } dup" "2 <circular-clumps> [ first ] map sequence= ." "t"
|
"{ 1 2 3 4 } dup" "2 <circular-clumps> keys sequence= ." "t"
|
||||||
}
|
}
|
||||||
{ $unchecked-example
|
{ $unchecked-example
|
||||||
"USING: grouping ;"
|
"USING: grouping ;"
|
||||||
|
|
|
@ -34,7 +34,7 @@ SYMBOL: vocab-articles
|
||||||
|
|
||||||
: extract-values ( element -- seq )
|
: extract-values ( element -- seq )
|
||||||
\ $values swap elements dup empty? [
|
\ $values swap elements dup empty? [
|
||||||
first rest [ first ] map
|
first rest keys
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
: extract-value-effects ( element -- seq )
|
: extract-value-effects ( element -- seq )
|
||||||
|
|
|
@ -22,7 +22,7 @@ PRIVATE>
|
||||||
utf8 file-lines { "" } split [
|
utf8 file-lines { "" } split [
|
||||||
[ " " split ] map
|
[ " " split ] map
|
||||||
[ first { "Name:" "Alias:" } member? ] filter
|
[ first { "Name:" "Alias:" } member? ] filter
|
||||||
[ second ] map { "None" } diff
|
values { "None" } diff
|
||||||
] map harvest ;
|
] map harvest ;
|
||||||
|
|
||||||
: make-aliases ( file -- n>e )
|
: make-aliases ( file -- n>e )
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2007-2009 Samuel Tardieu.
|
! Copyright (C) 2007-2009 Samuel Tardieu.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays combinators kernel make math math.functions
|
USING: arrays assocs combinators kernel make math math.functions
|
||||||
math.primes math.ranges sequences sequences.product sorting
|
math.primes math.ranges sequences sequences.product sorting
|
||||||
io math.parser ;
|
io math.parser ;
|
||||||
IN: math.primes.factors
|
IN: math.primes.factors
|
||||||
|
@ -32,7 +32,7 @@ PRIVATE>
|
||||||
: group-factors ( n -- seq )
|
: group-factors ( n -- seq )
|
||||||
dup prime? [ 1 2array 1array ] [ (group-factors) ] if ; flushable
|
dup prime? [ 1 2array 1array ] [ (group-factors) ] if ; flushable
|
||||||
|
|
||||||
: unique-factors ( n -- seq ) group-factors [ first ] map ; flushable
|
: unique-factors ( n -- seq ) group-factors keys ; flushable
|
||||||
|
|
||||||
: factors ( n -- seq )
|
: factors ( n -- seq )
|
||||||
group-factors [ first2 swap <array> ] map concat ; flushable
|
group-factors [ first2 swap <array> ] map concat ; flushable
|
||||||
|
|
|
@ -54,7 +54,7 @@ IN: tools.completion
|
||||||
sort-keys <reversed>
|
sort-keys <reversed>
|
||||||
[ 0 [ first max ] reduce 3 /f ] keep
|
[ 0 [ first max ] reduce 3 /f ] keep
|
||||||
[ first < ] with filter
|
[ first < ] with filter
|
||||||
[ second ] map ;
|
values ;
|
||||||
|
|
||||||
: complete ( full short -- score )
|
: complete ( full short -- score )
|
||||||
[ dupd fuzzy score ] 2keep
|
[ dupd fuzzy score ] 2keep
|
||||||
|
|
|
@ -209,7 +209,7 @@ load-data {
|
||||||
} cleave
|
} cleave
|
||||||
|
|
||||||
: postprocess-class ( -- )
|
: postprocess-class ( -- )
|
||||||
combine-map [ [ second ] map ] map concat
|
combine-map [ values ] map concat
|
||||||
[ combining-class not ] filter
|
[ combining-class not ] filter
|
||||||
[ 0 swap class-map set-at ] each ;
|
[ 0 swap class-map set-at ] each ;
|
||||||
|
|
||||||
|
|
|
@ -118,7 +118,7 @@ unless
|
||||||
] 2map ;
|
] 2map ;
|
||||||
|
|
||||||
: (make-callbacks) ( implementations -- sequence )
|
: (make-callbacks) ( implementations -- sequence )
|
||||||
dup [ first ] map (make-iunknown-methods)
|
dup keys (make-iunknown-methods)
|
||||||
[ [ first2 ] 2dip swap (make-interface-callbacks) ]
|
[ [ first2 ] 2dip swap (make-interface-callbacks) ]
|
||||||
curry map-index ;
|
curry map-index ;
|
||||||
|
|
||||||
|
|
|
@ -55,7 +55,7 @@ IN: xml.elements
|
||||||
">" expect ;
|
">" expect ;
|
||||||
|
|
||||||
: assure-no-extra ( seq -- )
|
: assure-no-extra ( seq -- )
|
||||||
[ first ] map {
|
keys {
|
||||||
T{ name f "" "version" f }
|
T{ name f "" "version" f }
|
||||||
T{ name f "" "encoding" f }
|
T{ name f "" "encoding" f }
|
||||||
T{ name f "" "standalone" f }
|
T{ name f "" "standalone" f }
|
||||||
|
|
|
@ -3,7 +3,7 @@ ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.borders
|
||||||
ui.gadgets.scrollers ui.tools.listener accessors ;
|
ui.gadgets.scrollers ui.tools.listener accessors ;
|
||||||
IN: demos
|
IN: demos
|
||||||
|
|
||||||
: demo-vocabs ( -- seq ) "demos" tagged [ second ] map concat [ name>> ] map ;
|
: demo-vocabs ( -- seq ) "demos" tagged values concat [ name>> ] map ;
|
||||||
|
|
||||||
: <run-vocab-button> ( vocab-name -- button )
|
: <run-vocab-button> ( vocab-name -- button )
|
||||||
dup '[ drop [ _ run ] \ run call-listener ] <border-button> ;
|
dup '[ drop [ _ run ] \ run call-listener ] <border-button> ;
|
||||||
|
|
|
@ -499,7 +499,7 @@ TYPED:: elf-segment-sections ( segment: Elf32/64_Phdr sections: Elf32/64_Shdr-ar
|
||||||
segment [ p_offset>> dup ] [ p_filesz>> + ] bi [a,b) :> segment-interval
|
segment [ p_offset>> dup ] [ p_filesz>> + ] bi [a,b) :> segment-interval
|
||||||
sections [ dup [ sh_offset>> dup ] [ sh_size>> + ] bi [a,b) 2array ] { } map-as :> section-intervals
|
sections [ dup [ sh_offset>> dup ] [ sh_size>> + ] bi [a,b) 2array ] { } map-as :> section-intervals
|
||||||
section-intervals [ second segment-interval interval-intersect empty-interval = not ]
|
section-intervals [ second segment-interval interval-intersect empty-interval = not ]
|
||||||
filter [ first ] map ;
|
filter keys ;
|
||||||
|
|
||||||
TYPED:: virtual-address-segment ( elf: Elf32/64_Ehdr address -- program-header/f )
|
TYPED:: virtual-address-segment ( elf: Elf32/64_Ehdr address -- program-header/f )
|
||||||
elf elf-program-headers elf-loadable-segments [
|
elf elf-program-headers elf-loadable-segments [
|
||||||
|
|
|
@ -40,7 +40,7 @@ MEMO: ip-db ( -- seq )
|
||||||
: filter-overlaps ( alist -- alist' )
|
: filter-overlaps ( alist -- alist' )
|
||||||
2 clump
|
2 clump
|
||||||
[ first2 [ first second ] [ first first ] bi* < ] filter
|
[ first2 [ first second ] [ first first ] bi* < ] filter
|
||||||
[ first ] map ;
|
keys ;
|
||||||
|
|
||||||
MEMO: ip-intervals ( -- interval-map )
|
MEMO: ip-intervals ( -- interval-map )
|
||||||
ip-db [ [ [ from>> ] [ to>> ] bi 2array ] keep ] { } map>assoc
|
ip-db [ [ [ from>> ] [ to>> ] bi 2array ] keep ] { } map>assoc
|
||||||
|
|
|
@ -552,7 +552,7 @@ SYNTAX: UNIFORM-TUPLE:
|
||||||
[ [ length ] [ >int-array ] bi glDrawBuffers ] if ;
|
[ [ length ] [ >int-array ] bi glDrawBuffers ] if ;
|
||||||
|
|
||||||
: bind-named-output-attachments ( program-instance framebuffer attachments -- )
|
: bind-named-output-attachments ( program-instance framebuffer attachments -- )
|
||||||
rot '[ first _ swap output-index ] sort-with [ second ] map
|
rot '[ first _ swap output-index ] sort-with values
|
||||||
bind-unnamed-output-attachments ;
|
bind-unnamed-output-attachments ;
|
||||||
|
|
||||||
: bind-output-attachments ( program-instance framebuffer attachments -- )
|
: bind-output-attachments ( program-instance framebuffer attachments -- )
|
||||||
|
|
|
@ -198,8 +198,8 @@ DEFER: (d)
|
||||||
|
|
||||||
: bigraded-betti ( u-generators z-generators -- seq )
|
: bigraded-betti ( u-generators z-generators -- seq )
|
||||||
[ basis graded ] bi@ tensor bigraded-ker/im-d
|
[ basis graded ] bi@ tensor bigraded-ker/im-d
|
||||||
[ [ [ first ] map ] map ] keep
|
[ [ keys ] map ] keep
|
||||||
[ [ second ] map 2 head* { 0 0 } prepend ] map
|
[ values 2 head* { 0 0 } prepend ] map
|
||||||
rest dup first length 0 <array> suffix
|
rest dup first length 0 <array> suffix
|
||||||
[ v- ] 2map ;
|
[ v- ] 2map ;
|
||||||
|
|
||||||
|
|
|
@ -32,7 +32,7 @@ TUPLE: function name alien return params ;
|
||||||
LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
|
LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
|
||||||
|
|
||||||
: function-effect ( function -- effect )
|
: function-effect ( function -- effect )
|
||||||
[ params>> [ first ] map ] [ return>> void? 0 1 ? ] bi <effect> ;
|
[ params>> keys ] [ return>> void? 0 1 ? ] bi <effect> ;
|
||||||
|
|
||||||
: install-function ( function -- )
|
: install-function ( function -- )
|
||||||
dup name>> "alien.llvm" create-vocab drop
|
dup name>> "alien.llvm" create-vocab drop
|
||||||
|
|
|
@ -30,7 +30,7 @@ CONSTANT: lo 1010101030
|
||||||
CONSTANT: hi 1389026570
|
CONSTANT: hi 1389026570
|
||||||
|
|
||||||
: form-fitting? ( n -- ? )
|
: form-fitting? ( n -- ? )
|
||||||
number>digits 2 group [ first ] map
|
number>digits 2 group keys
|
||||||
{ 1 2 3 4 5 6 7 8 9 0 } = ;
|
{ 1 2 3 4 5 6 7 8 9 0 } = ;
|
||||||
|
|
||||||
: candidates ( -- seq )
|
: candidates ( -- seq )
|
||||||
|
|
Loading…
Reference in New Issue