Rename curry* to with

db4
Slava Pestov 2008-01-09 17:36:30 -05:00
parent c738dee88e
commit c8360f5ae5
122 changed files with 231 additions and 231 deletions

View File

@ -143,7 +143,7 @@ M: assoc >alist [ 2array ] { } assoc>map ;
swap [ = nip ] curry assoc-find 2drop ;
: search-alist ( key alist -- pair i )
[ first = ] curry* find swap ; inline
[ first = ] with find swap ; inline
M: sequence at*
search-alist [ second t ] [ f ] if ;

View File

@ -97,7 +97,7 @@ DEFER: (class<)
: union-class< ( cls1 cls2 -- ? )
[ flatten-union-class ] 2apply keys
[ nip [ (class<) ] curry* contains? ] curry assoc-all? ;
[ nip [ (class<) ] with contains? ] curry assoc-all? ;
: (class<) ( class1 class2 -- ? )
{
@ -123,7 +123,7 @@ DEFER: (class<)
: largest-class ( seq -- n elt )
dup [
[ 2dup class< >r swap class< not r> and ]
curry* subset empty?
with subset empty?
] curry find [ "Topological sort failed" throw ] unless* ;
PRIVATE>
@ -156,7 +156,7 @@ PRIVATE>
[ dupd classes-intersect? ] subset dup empty? [
2drop f
] [
tuck [ class< ] curry* all? [ peek ] [ drop f ] if
tuck [ class< ] with all? [ peek ] [ drop f ] if
] if ;
GENERIC: reset-class ( class -- )
@ -167,7 +167,7 @@ M: word reset-class drop ;
! class<map
: bigger-classes ( class -- seq )
classes [ (class<) ] curry* subset ;
classes [ (class<) ] with subset ;
: bigger-classes+ ( class -- )
[ bigger-classes [ dup ] H{ } map>assoc ] keep

View File

@ -69,7 +69,7 @@ M: sequence hashcode*
: hash-case-table ( default assoc -- array )
V{ } [ 1array ] distribute-buckets
[ case>quot ] curry* map ;
[ case>quot ] with map ;
: hash-dispatch-quot ( table -- quot )
[ length 1- [ fixnum-bitand ] curry ] keep

View File

@ -54,7 +54,7 @@ GENERIC: definitions-changed ( assoc obj -- )
: notify-definition-observers ( assoc -- )
definition-observers get
[ definitions-changed ] curry* each ;
[ definitions-changed ] with each ;
: changed-vocabs ( assoc -- vocabs )
[ drop word? ] assoc-subset

View File

@ -525,7 +525,7 @@ M: loc lazy-store
: clash? ( seq -- ? )
phantoms append [
dup cached? [ cached-vreg ] when swap member?
] curry* contains? ;
] with contains? ;
: outputs-clash? ( -- ? )
output-vregs append clash? ;

View File

@ -91,7 +91,7 @@ M: method-spec forget* first2 [ delete-at ] with-methods ;
all-words [
"methods" word-prop keys
swap [ key? ] curry contains?
] curry* subset ;
] with subset ;
: implementors ( class -- seq )
dup associate implementors* ;

View File

@ -96,7 +96,7 @@ TUPLE: no-method object generic ;
num-tags get [
vtable-class
[ swap first classes-intersect? ] curry subset
] curry* map ;
] with map ;
: build-type-vtable ( alist-seq -- alist-seq )
dup length [

View File

@ -14,10 +14,10 @@ SYMBOL: graph
graph get [ drop H{ } clone ] cache ;
: add-vertex ( vertex edges graph -- )
[ [ dupd nest set-at ] curry* each ] if-graph ; inline
[ [ dupd nest set-at ] with each ] if-graph ; inline
: remove-vertex ( vertex edges graph -- )
[ [ graph get at delete-at ] curry* each ] if-graph ; inline
[ [ graph get at delete-at ] with each ] if-graph ; inline
SYMBOL: previous

View File

@ -18,7 +18,7 @@ IN: inference.backend
local-recursive-state at ;
: recursive-quotation? ( quot -- ? )
local-recursive-state [ first eq? ] curry* contains? ;
local-recursive-state [ first eq? ] with contains? ;
TUPLE: inference-error rstate major? ;
@ -318,7 +318,7 @@ TUPLE: unbalanced-branches-error quots in out ;
] H{ } make-assoc ; inline
: (infer-branches) ( last branches -- list )
[ infer-branch ] curry* map
[ infer-branch ] with map
dup unify-effects unify-dataflow ; inline
: infer-branches ( last branches node -- )

View File

@ -14,7 +14,7 @@ slots.private combinators definitions ;
: inlined? ( quot word -- ? )
swap dataflow optimize
[ node-param eq? ] curry* node-exists? not ;
[ node-param eq? ] with node-exists? not ;
GENERIC: mynot ( x -- y )

View File

@ -217,7 +217,7 @@ M: node calls-label* 2drop f ;
M: #call-label calls-label* node-param eq? ;
: calls-label? ( label node -- ? )
[ calls-label* ] curry* node-exists? ;
[ calls-label* ] with node-exists? ;
: recursive-label? ( node -- ? )
dup node-param swap calls-label? ;
@ -270,10 +270,10 @@ SYMBOL: node-stack
swap node-classes at object or ;
: node-input-classes ( node -- seq )
dup node-in-d [ node-class ] curry* map ;
dup node-in-d [ node-class ] with map ;
: node-input-intervals ( node -- seq )
dup node-in-d [ node-interval ] curry* map ;
dup node-in-d [ node-interval ] with map ;
: node-class-first ( node -- class )
dup node-in-d first node-class ;

View File

@ -10,7 +10,7 @@ IN: io.binary
: nth-byte ( x n -- b ) -8 * shift mask-byte ; inline
: >le ( x n -- str ) [ nth-byte ] curry* "" map-as ;
: >le ( x n -- str ) [ nth-byte ] with "" map-as ;
: >be ( x n -- str ) >le dup reverse-here ;
: d>w/w ( d -- w1 w2 )

View File

@ -46,7 +46,7 @@ M: object root-directory? ( path -- ? ) path-separator? ;
[
dup string?
[ tuck path+ directory? 2array ] [ nip ] if
] curry* map
] with map
[ first special-directory? not ] subset ;
: directory ( path -- seq )
@ -143,7 +143,7 @@ HOOK: binary-roots io-backend ( -- seq )
<PRIVATE
: append-path ( path files -- paths )
[ path+ ] curry* map ;
[ path+ ] with map ;
: get-paths ( dir -- paths )
dup directory keys append-path ;

View File

@ -69,7 +69,7 @@ $nl
{ $subsection curry }
{ $subsection 2curry }
{ $subsection 3curry }
{ $subsection curry* }
{ $subsection with }
{ $subsection compose }
{ $subsection 3compose }
"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "."
@ -509,16 +509,16 @@ HELP: 3curry
{ $description "Outputs a " { $link callable } " which pushes " { $snippet "obj1" } ", " { $snippet "obj2" } " and " { $snippet "obj3" } ", and then calls " { $snippet "quot" } "." }
{ $notes "This operation is efficient and does not copy the quotation." } ;
HELP: curry*
HELP: with
{ $values { "param" object } { "obj" object } { "quot" "a quotation with stack effect " { $snippet "( param elt -- ... )" } } { "obj" object } { "curry" curry } }
{ $description "Partial application on the left. The following two lines are equivalent:"
{ $code "swap [ swap A ] curry B" }
{ $code "[ A ] curry* B" }
{ $code "[ A ] with B" }
}
{ $notes "This operation is efficient and does not copy the quotation." }
{ $examples
{ $example "2 { 1 2 3 } [ - ] curry* map ." "{ 1 0 -1 }" }
{ $example "2 { 1 2 3 } [ - ] with map ." "{ 1 0 -1 }" }
} ;
HELP: compose

View File

@ -75,7 +75,7 @@ DEFER: if
: 3curry ( obj1 obj2 obj3 quot -- curry )
curry curry curry ; inline
: curry* ( param obj quot -- obj curry )
: with ( param obj quot -- obj curry )
swapd [ swapd call ] 2curry ; inline
: compose ( quot1 quot2 -- curry )

View File

@ -41,7 +41,7 @@ M: mirror delete-at ( key mirror -- )
M: mirror >alist ( mirror -- alist )
>mirror<
[ [ slot-spec-offset slot ] curry* map ] keep
[ [ slot-spec-offset slot ] with map ] keep
[ slot-spec-reader ] map swap 2array flip ;
M: mirror assoc-size mirror-slots length ;

View File

@ -325,13 +325,13 @@ M: #dispatch optimize-node*
: partial-eval? ( #call -- ? )
dup node-param "foldable" word-prop [
dup node-in-d [ node-literal? ] curry* all?
dup node-in-d [ node-literal? ] with all?
] [
drop f
] if ;
: literal-in-d ( #call -- inputs )
dup node-in-d [ node-literal ] curry* map ;
dup node-in-d [ node-literal ] with map ;
: partial-eval ( #call -- node )
dup literal-in-d over node-param 1quotation

View File

@ -73,10 +73,10 @@ namespaces assocs kernel sequences math tools.test words ;
: p3 drop 3 ;
: regression-0
[ 2drop ] curry* assoc-find ;
[ 2drop ] with assoc-find ;
[ t ] [
[ [ 2drop ] curry* assoc-find ] kill-set
[ [ 2drop ] with assoc-find ] kill-set
[ 2drop ] swap member?
] unit-test
@ -104,7 +104,7 @@ namespaces assocs kernel sequences math tools.test words ;
rot
[ 2swap [ swapd * -rot p2 +@ ] 2keep ]
assoc-each 2drop
] curry* assoc-each
] with assoc-each
] H{ } make-assoc p3 ;
[ { t t t t t } ] [
@ -122,7 +122,7 @@ namespaces assocs kernel sequences math tools.test words ;
rot
[ 2swap [ swapd * -rot p2 +@ ] 2keep ]
assoc-each 2drop
] curry* assoc-each
] with assoc-each
]
}
\ regression-2 word-def kill-set

View File

@ -12,7 +12,7 @@ SYMBOL: def-use
used-by empty? ;
: uses-values ( node seq -- )
[ def-use get [ ?push ] change-at ] curry* each ;
[ def-use get [ ?push ] change-at ] with each ;
: defs-values ( seq -- )
#! If there is no value, set it to a new empty vector,

View File

@ -89,7 +89,7 @@ optimizer.def-use generic.standard ;
: math-closure ( class -- newclass )
{ fixnum integer rational real }
[ class< ] curry* find nip number or ;
[ class< ] with find nip number or ;
: fits? ( interval class -- ? )
"interval" word-prop dup

View File

@ -242,7 +242,7 @@ M: no-word summary
dup forward-reference? [
drop
dup use get
[ at ] curry* map [ ] subset
[ at ] with map [ ] subset
[ forward-reference? not ] find nip
[ ] [ forward-error ] ?if
] [

View File

@ -207,7 +207,7 @@ M: word declarations.
POSTPONE: delimiter
POSTPONE: inline
POSTPONE: foldable
} [ declaration. ] curry* each ;
} [ declaration. ] with each ;
: pprint-; \ ; pprint-word ;
@ -233,7 +233,7 @@ M: mixin-class see-class*
dup members [
hard line-break
\ INSTANCE: pprint-word pprint-word pprint-word
] curry* each block> block> ;
] with each block> block> ;
M: predicate-class see-class*
<colon \ PREDICATE: pprint-word
@ -258,7 +258,7 @@ M: builtin-class see-class*
natural-sort [ nl see ] each ;
: see-implementors ( class -- seq )
dup implementors [ 2array ] curry* map ;
dup implementors [ 2array ] with map ;
: see-class ( class -- )
dup class? [

View File

@ -173,7 +173,7 @@ M: block section-fits? ( section -- ? )
swap block-sections [ line-break? not ] subset
unclip pprint-section [
dup rot call pprint-section
] curry* each ; inline
] with each ; inline
M: block short-section ( block -- )
[ advance ] pprint-sections ;
@ -311,7 +311,7 @@ M: f section-end-group? drop f ;
2dup 1- swap ?nth prev set
2dup 1+ swap ?nth next set
swap nth dup split-before dup , split-after
] curry* each
] with each
] { } make { t } split [ empty? not ] subset ;
: break-group? ( seq -- ? )

View File

@ -421,13 +421,13 @@ PRIVATE>
] keep { } like ; inline
: index ( obj seq -- n )
[ = ] curry* find drop ;
[ = ] with find drop ;
: index* ( obj i seq -- n )
rot [ = ] curry find* drop ;
: last-index ( obj seq -- n )
[ = ] curry* find-last drop ;
[ = ] with find-last drop ;
: last-index* ( obj i seq -- n )
rot [ = ] curry find-last* drop ;
@ -436,13 +436,13 @@ PRIVATE>
find drop >boolean ; inline
: member? ( obj seq -- ? )
[ = ] curry* contains? ;
[ = ] with contains? ;
: memq? ( obj seq -- ? )
[ eq? ] curry* contains? ;
[ eq? ] with contains? ;
: remove ( obj seq -- newseq )
[ = not ] curry* subset ;
[ = not ] with subset ;
: cache-nth ( i seq quot -- elt )
pick pick ?nth dup [
@ -666,7 +666,7 @@ PRIVATE>
: flip ( matrix -- newmatrix )
dup empty? [
dup [ length ] map infimum
[ <column> dup like ] curry* map
[ <column> dup like ] with map
] unless ;
: sequence-hashcode-step ( oldhash newpart -- newhash )
@ -678,4 +678,4 @@ PRIVATE>
: sequence-hashcode ( n seq -- x )
0 -rot [
hashcode* >fixnum sequence-hashcode-step
] curry* each ; inline
] with each ; inline

View File

@ -70,7 +70,7 @@ PREDICATE: word slot-writer "writing" word-prop >boolean ;
2dup define-reader define-writer ;
: define-slots ( class specs -- )
[ define-slot ] curry* each ;
[ define-slot ] with each ;
: reader-word ( class name vocab -- word )
>r >r "-" r> 3append r> create ;
@ -93,11 +93,11 @@ PREDICATE: word slot-writer "writing" word-prop >boolean ;
rot rot simple-writer-word over set-slot-spec-writer ;
: simple-slots ( class slots base -- specs )
over length [ + ] curry* map
over length [ + ] with map
[ >r >r dup r> r> simple-slot ] 2map nip ;
: slot-of-reader ( reader specs -- spec/f )
[ slot-spec-reader eq? ] curry* find nip ;
[ slot-spec-reader eq? ] with find nip ;
: slot-of-writer ( writer specs -- spec/f )
[ slot-spec-writer eq? ] curry* find nip ;
[ slot-spec-writer eq? ] with find nip ;

View File

@ -31,7 +31,7 @@ M: tuple class class-of-tuple ;
: reshape-tuple ( oldtuple permutation -- newtuple )
>r tuple>array 2 cut r>
[ [ swap ?nth ] [ drop f ] if* ] curry* map
[ [ swap ?nth ] [ drop f ] if* ] with map
append (>tuple) ;
: reshape-tuples ( class newslots -- )
@ -41,14 +41,14 @@ M: tuple class class-of-tuple ;
: old-slots ( class newslots -- seq )
swap "slots" word-prop 1 tail-slice
[ slot-spec-name swap member? not ] curry* subset ;
[ slot-spec-name swap member? not ] with subset ;
: forget-slots ( class newslots -- )
dupd old-slots [
2dup
slot-spec-reader 2array forget
slot-spec-writer 2array forget
] curry* each ;
] with each ;
: check-shape ( class newslots -- )
over tuple-class? [
@ -131,7 +131,7 @@ M: tuple-class reset-class
} reset-props ;
M: object get-slots ( obj slots -- ... )
[ execute ] curry* each ;
[ execute ] with each ;
M: object set-slots ( ... obj slots -- )
<reversed> get-slots ;

View File

@ -73,7 +73,7 @@ SYMBOL: load-vocab-hook
: words-named ( str -- seq )
dictionary get values
[ vocab-words at ] curry* map
[ vocab-words at ] with map
[ ] subset ;
: child-vocab? ( prefix name -- ? )
@ -81,7 +81,7 @@ SYMBOL: load-vocab-hook
[ 2drop t ] [ swap CHAR: . add head? ] if ;
: child-vocabs ( vocab -- seq )
vocab-name vocabs [ child-vocab? ] curry* subset ;
vocab-name vocabs [ child-vocab? ] with subset ;
TUPLE: vocab-link name root ;

View File

@ -50,7 +50,7 @@ M: primitive definition drop f ;
[ pick word-props ?set-at swap set-word-props ]
[ nip remove-word-prop ] if ;
: reset-props ( word seq -- ) [ remove-word-prop ] curry* each ;
: reset-props ( word seq -- ) [ remove-word-prop ] with each ;
: lookup ( name vocab -- word ) vocab-words at ;

View File

@ -19,7 +19,7 @@ SYMBOL: alarm-looper
alarms get-global push ;
: remove-alarm ( alarm -- )
alarms get-global remove alarms set-global ;
alarms get-global delete ;
: handle-alarm ( alarm -- )
dup delegate {
@ -29,11 +29,11 @@ SYMBOL: alarm-looper
: expired-alarms ( -- seq )
now alarms get-global
[ alarm-time <=> 0 > ] curry* subset ;
[ alarm-time <=> 0 > ] with subset ;
: unexpired-alarms ( -- seq )
now alarms get-global
[ alarm-time <=> 0 <= ] curry* subset ;
[ alarm-time <=> 0 <= ] with subset ;
: call-alarm ( alarm -- )
alarm-quot spawn drop ;

View File

@ -69,7 +69,7 @@ VARS: width height ;
: center-i ( -- i ) width> 2 / >fixnum ;
: center-line ( -- line ) center-i width> [ = 1 0 ? ] curry* map ;
: center-line ( -- line ) center-i width> [ = 1 0 ? ] with map ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -20,7 +20,7 @@ IN: base64
} nth ;
: encode3 ( seq -- seq )
be> 4 [ 3 swap - -6 * shift HEX: 3f bitand ch>base64 ] curry* map ;
be> 4 [ 3 swap - -6 * shift HEX: 3f bitand ch>base64 ] with map ;
: decode4 ( str -- str )
[ base64>ch ] map 0 [ swap 6 shift bitor ] reduce 3 >be ;

View File

@ -21,7 +21,7 @@ math.functions math.parser io.files colors.hsv ;
dup [
360 * swap 1+ / sat val
3array hsv>rgb first3 scale-rgb
] curry* map ;
] with map ;
: iter ( c z nb-iter -- x )
over absq 4.0 >= over zero? or

View File

@ -54,7 +54,7 @@ HINTS: gregory fixnum ;
standard-table-style [
functions [
[ tuck execute pprint-cell pprint-cell ] with-row
] curry* each
] with each
] tabular-output ;
: partial-sums-main 2500000 partial-sums ;

View File

@ -136,23 +136,23 @@ DEFER: create ( level c r -- scene )
[ oversampling /f ] 2apply 0.0 3float-array ;
: ss-grid ( -- ss-grid )
oversampling [ oversampling [ ss-point ] curry* map ] map ;
oversampling [ oversampling [ ss-point ] with map ] map ;
: ray-grid ( point ss-grid -- ray-grid )
[
[ v+ normalize { 0.0 0.0 -4.0 } swap <ray> ] curry* map
] curry* map ;
[ v+ normalize { 0.0 0.0 -4.0 } swap <ray> ] with map
] with map ;
: ray-pixel ( scene point -- n )
ss-grid ray-grid 0.0 -rot
[ [ swap cast-ray + ] curry* each ] curry* each ;
[ [ swap cast-ray + ] with each ] with each ;
: pixel-grid ( -- grid )
size reverse [
size [
[ size 0.5 * - ] 2apply swap size
3float-array
] curry* map
] with map
] map ;
: pgm-header ( w h -- )
@ -161,7 +161,7 @@ DEFER: create ( level c r -- scene )
: pgm-pixel ( n -- ) 255 * 0.5 + >fixnum , ;
: ray-trace ( scene -- pixels )
pixel-grid [ [ ray-pixel ] curry* map ] curry* map ;
pixel-grid [ [ ray-pixel ] with map ] with map ;
: run ( -- string )
levels { 0.0 -1.0 0.0 } 1.0 create ray-trace [

View File

@ -80,7 +80,7 @@ M: check< summary drop "Number exceeds upper bound" ;
[ ":" split1 string>number [ dup length ] unless* ] { } map>assoc ;
: define-slots ( prefix names quots -- )
>r [ "-" swap 3append create-in ] curry* map r>
>r [ "-" swap 3append create-in ] with map r>
[ define-compound ] 2each ;
: define-accessors ( classname slots -- )

View File

@ -117,7 +117,7 @@ over boid-vel -rot relative-position angle-between ;
<--&& ;
: cohesion-neighborhood ( self -- boids )
boids> [ within-cohesion-neighborhood? ] curry* subset ;
boids> [ within-cohesion-neighborhood? ] with subset ;
: cohesion-force ( self -- force )
dup cohesion-neighborhood
@ -137,7 +137,7 @@ over boid-vel -rot relative-position angle-between ;
<--&& ;
: separation-neighborhood ( self -- boids )
boids> [ within-separation-neighborhood? ] curry* subset ;
boids> [ within-separation-neighborhood? ] with subset ;
: separation-force ( self -- force )
dup separation-neighborhood
@ -157,7 +157,7 @@ over boid-vel -rot relative-position angle-between ;
<--&& ;
: alignment-neighborhood ( self -- boids )
boids> [ within-alignment-neighborhood? ] curry* subset ;
boids> [ within-alignment-neighborhood? ] with subset ;
: alignment-force ( self -- force )
alignment-neighborhood

View File

@ -278,10 +278,10 @@ M: timestamp <=> ( ts1 ts2 -- n )
[
[ 1+ print-day ] keep
1+ + 7 mod zero? [ nl ] [ bl ] if
] curry* each nl ;
] with each nl ;
: print-year ( year -- )
12 [ 1+ print-month nl ] curry* each ;
12 [ 1+ print-month nl ] with each ;
: pad-00 number>string 2 CHAR: 0 pad-left write ;

View File

@ -40,7 +40,7 @@ IN: catalyst-talk
: strip-tease ( data -- seq )
dup third length 1 - [
2 + (strip-tease)
] curry* map ;
] with map ;
: STRIP-TEASE:
parse-definition strip-tease [ parsed ] each ; parsing

View File

@ -161,7 +161,7 @@ H{
: method-arg-types ( method -- args )
dup method_getNumberOfArguments
[ method-arg-type parse-objc-type ] curry* map ;
[ method-arg-type parse-objc-type ] with map ;
: method-return-type ( method -- ctype )
#! Undocumented hack! Apple does not support this feature!

View File

@ -35,7 +35,7 @@ MACRO: nkeep ( n -- )
MACRO: ncurry ( n -- ) [ curry ] n*quot ;
MACRO: ncurry* ( quot n -- )
MACRO: nwith ( quot n -- )
tuck 1+ dup
[ , -nrot [ , nrot , call ] , ncurry ]
bake ;
@ -53,17 +53,17 @@ MACRO: napply ( n -- )
! each-with
: each-withn ( seq quot n -- ) ncurry* each ; inline
: each-withn ( seq quot n -- ) nwith each ; inline
: each-with ( seq quot -- ) curry* each ; inline
: each-with ( seq quot -- ) with each ; inline
: each-with2 ( obj obj list quot -- ) 2 each-withn ; inline
! map-with
: map-withn ( seq quot n -- newseq ) ncurry* map ; inline
: map-withn ( seq quot n -- newseq ) nwith map ; inline
: map-with ( seq quot -- ) curry* map ; inline
: map-with ( seq quot -- ) with map ; inline
: map-with2 ( obj obj list quot -- newseq ) 2 map-withn ; inline

View File

@ -10,7 +10,7 @@ IN: contributors
: patch-counts ( authors -- assoc )
dup prune
[ dup rot [ = ] curry* count ] curry*
[ dup rot [ = ] with count ] with
{ } map>assoc ;
: contributors ( -- )

View File

@ -34,7 +34,7 @@ FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ;
FUNCTION: void CFRelease ( void* cf ) ;
: CF>array ( alien -- array )
dup CFArrayGetCount [ CFArrayGetValueAtIndex ] curry* map ;
dup CFArrayGetCount [ CFArrayGetValueAtIndex ] with map ;
: <CFArray> ( seq -- alien )
[ f swap length f CFArrayCreateMutable ] keep

View File

@ -59,7 +59,7 @@ SYMBOL: K
: make-w ( str -- )
#! compute w, steps a-b of RFC 3174, section 6.1
16 [ nth-int-be w get push ] curry* each
16 [ nth-int-be w get push ] with each
16 80 dup <slice> [ sha1-W w get push ] each ;
: init-letters ( -- )

View File

@ -71,7 +71,7 @@ SYMBOL: >word
word-size get group [ be> ] map block-size get 0 pad-right
dup 16 64 dup <slice> [
process-M-256
] curry* each ;
] with each ;
: ch ( x y z -- x' )
[ bitxor bitand ] keep bitxor ;
@ -115,7 +115,7 @@ SYMBOL: >word
H get clone vars set
prepare-message-schedule block-size get [
T1 T2 update-vars
] curry* each vars get H get [ w+ ] 2map H set ;
] with each vars get H get [ w+ ] 2map H set ;
: seq>string ( n seq -- string )
[ swap [ >be % ] curry each ] "" make ;

View File

@ -25,7 +25,7 @@ TUPLE: document locs ;
: remove-loc document-locs delete ;
: update-locs ( loc document -- )
document-locs [ set-model ] curry* each ;
document-locs [ set-model ] with each ;
: doc-line ( n document -- string ) model-value nth ;

View File

@ -68,7 +68,7 @@ TUPLE: faq header lists ;
C: <faq> faq
: html>faq ( div -- faq )
unclip swap { "h3" "ol" } [ tags-named ] curry* map
unclip swap { "h3" "ol" } [ tags-named ] with map
first2 >r f add* r> [ html>question-list ] 2map <faq> ;
: header, ( faq -- )

View File

@ -12,7 +12,7 @@ TUPLE: test-tuple m n ;
{ 3 }
] [
H{ { "n" "3" } } { { "n" v-number } }
[ action-param drop ] curry* map
[ action-param drop ] with map
] unit-test
: foo ;

View File

@ -55,7 +55,7 @@ SYMBOL: validation-errors
] [
nip
] if*
] curry* map ;
] with map ;
: expire-sessions ( -- )
sessions get-global

View File

@ -42,7 +42,7 @@ dup color gl-color dup radius swap center disk ;
: dot ( quadric i -- ) 2dup rim inner ;
: golden-section ( quadric -- ) 720 [ dot ] curry* each ;
: golden-section ( quadric -- ) 720 [ dot ] with each ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -16,4 +16,4 @@ IN: hashtables.lib
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: set-hash-stack ( value key seq -- )
dupd [ key? ] curry* find-last nip set-at ;
dupd [ key? ] with find-last nip set-at ;

View File

@ -17,7 +17,7 @@ M: link uses
[ dup ] [ [ article-parent ] keep ] [ ] unfold nip 1 tail ;
: set-article-parents ( parent article -- )
article-children [ set-article-parent ] curry* each ;
article-children [ set-article-parent ] with each ;
: xref-article ( topic -- )
dup >link xref dup set-article-parents ;

View File

@ -334,7 +334,7 @@ ARTICLE: "changes" "Changes in the latest release"
}
{ $subheading "Performance" }
{ $list
{ "The " { $link curry } " word now runs in constant time, and curried quotations can be called from compiled code; this allows for abstractions and idioms which were previously impractical due to performance issues. In particular, words such as " { $snippet "each-with" } " and " { $snippet "map-with" } " are gone; " { $snippet "each-with" } " can now be written as " { $snippet "curry* each" } ", and similarly for other " { $snippet "-with" } " combinators." }
{ "The " { $link curry } " word now runs in constant time, and curried quotations can be called from compiled code; this allows for abstractions and idioms which were previously impractical due to performance issues. In particular, words such as " { $snippet "each-with" } " and " { $snippet "map-with" } " are gone; " { $snippet "each-with" } " can now be written as " { $snippet "with each" } ", and similarly for other " { $snippet "-with" } " combinators." }
"Improved generational promotion strategy in garbage collector reduces the amount of junk which makes its way into tenured space, which in turn reduces the frequency of full garbage collections."
"Faster generic word dispatch and union membership testing."
{ "Alien memory accessors (" { $link "reading-writing-memory" } ") are compiled as intrinsics where possible, which improves performance in code which iteroperates with C libraries." }

View File

@ -341,12 +341,12 @@ M: word slot-specs "slots" word-prop ;
GENERIC: elements* ( elt-type element -- )
M: simple-element elements* [ elements* ] curry* each ;
M: simple-element elements* [ elements* ] with each ;
M: object elements* 2drop ;
M: array elements*
[ [ elements* ] curry* each ] 2keep
[ [ elements* ] with each ] 2keep
[ first eq? ] keep swap [ , ] [ drop ] if ;
: elements ( elt-type element -- seq ) [ elements* ] { } make ;

View File

@ -170,8 +170,8 @@ M: html-stream stream-write-table ( grid style stream -- )
<td "top" =valign swap table-style =style td>
>string write-html
</td>
] curry* each </tr>
] curry* each </table>
] with each </tr>
] with each </table>
] with-stream* ;
M: html-stream make-cell-stream ( style stream -- stream' )

View File

@ -19,36 +19,36 @@ IN: html.parser.analyzer
] map ;
: find-by-id ( id vector -- vector )
[ tag-attributes "id" swap at = ] curry* subset ;
[ tag-attributes "id" swap at = ] with subset ;
: find-by-class ( id vector -- vector )
[ tag-attributes "class" swap at = ] curry* subset ;
[ tag-attributes "class" swap at = ] with subset ;
: find-by-name ( str vector -- vector )
>r >lower r>
[ tag-name = ] curry* subset ;
[ tag-name = ] with subset ;
: find-first-name ( str vector -- i/f tag/f )
>r >lower r>
[ tag-name = ] curry* find ;
[ tag-name = ] with find ;
: find-matching-close ( str vector -- i/f tag/f )
>r >lower r>
[ [ tag-name = ] keep tag-closing? and ] curry* find ;
[ [ tag-name = ] keep tag-closing? and ] with find ;
: find-by-attribute-key ( key vector -- vector )
>r >lower r>
[ tag-attributes at ] curry* subset
[ tag-attributes at ] with subset
[ ] subset ;
: find-by-attribute-key-value ( value key vector -- vector )
>r >lower r>
[ tag-attributes at over = ] curry* subset nip
[ tag-attributes at over = ] with subset nip
[ ] subset ;
: find-first-attribute-key-value ( value key vector -- i/f tag/f )
>r >lower r>
[ tag-attributes at over = ] curry* find rot drop ;
[ tag-attributes at over = ] with find rot drop ;
: find-between ( i/f tag/f vector -- vector )
pick integer? [
@ -69,7 +69,7 @@ IN: html.parser.analyzer
! : find-last-tag ( name vector -- index tag )
! [
! dup tag-matched? [ 2drop f ] [ tag-name = ] if
! ] curry* find-last ;
! ] with find-last ;
! : find-last-tag* ( name n vector -- tag )
! 0 -rot <slice> find-last-tag ;

View File

@ -8,7 +8,7 @@ IN: io.paths
<PRIVATE
: append-path ( path files -- paths )
[ path+ ] curry* map ;
[ path+ ] with map ;
: get-paths ( dir -- paths )
dup directory keys append-path ;

View File

@ -75,7 +75,7 @@ SYMBOL: terms
[ natural-sort ] keep [ index ] curry map ;
: (inversions) ( n seq -- n )
[ > ] curry* subset length ;
[ > ] with subset length ;
: inversions ( seq -- n )
0 swap [ length ] keep [
@ -155,15 +155,15 @@ DEFER: (d)
] map [ ] subset 2nip ;
: basis ( generators -- seq )
natural-sort dup length 2^ [ nth-basis-elt ] curry* map ;
natural-sort dup length 2^ [ nth-basis-elt ] with map ;
: (tensor) ( seq1 seq2 -- seq )
[
[ swap append natural-sort ] curry map
] curry* map concat ;
] with map concat ;
: tensor ( graded-basis1 graded-basis2 -- bigraded-basis )
[ [ swap (tensor) ] curry map ] curry* map ;
[ [ swap (tensor) ] curry map ] with map ;
! Computing cohomology
: (op-matrix) ( range quot basis-elt -- row )
@ -201,7 +201,7 @@ DEFER: (d)
over first length [
>r 2dup r> spin (bigraded-ker/im-d)
] map 2nip
] curry* map ;
] with map ;
: bigraded-betti ( u-generators z-generators -- seq )
[ basis graded ] 2apply tensor bigraded-ker/im-d
@ -241,14 +241,14 @@ DEFER: (d)
] [
nullspace [
[ [ wedge (alt+) ] 2each ] with-terms
] curry* map
] with map
] if ;
: graded-triple ( seq n -- triple )
3 [ 1- + ] curry* map swap [ ?nth ] curry map ;
3 [ 1- + ] with map swap [ ?nth ] curry map ;
: graded-triples ( seq -- triples )
dup length [ graded-triple ] curry* map ;
dup length [ graded-triple ] with map ;
: graded-laplacian ( generators quot -- seq )
>r basis graded graded-triples [ first3 ] r> compose map ;
@ -279,7 +279,7 @@ DEFER: (d)
over first length [
>r 2dup r> spin bigraded-triple
] map 2nip
] curry* map ;
] with map ;
: bigraded-laplacian ( u-generators z-generators quot -- seq )
>r [ basis graded ] 2apply tensor bigraded-triples r>

View File

@ -9,10 +9,10 @@ IN: lcd
} nth >r 4 * dup 4 + r> subseq ;
: lcd-row ( num row -- )
swap [ CHAR: 0 - swap lcd-digit write ] curry* each ;
swap [ CHAR: 0 - swap lcd-digit write ] with each ;
: lcd ( digit-str -- )
3 [ lcd-row nl ] curry* each ;
3 [ lcd-row nl ] with each ;
: lcd-demo ( -- ) "31337" lcd ;

View File

@ -4,7 +4,7 @@ USING: arrays help io kernel math namespaces sequences ;
IN: levenshtein
: <matrix> ( m n -- matrix )
[ drop 0 <array> ] curry* map ; inline
[ drop 0 <array> ] with map ; inline
: matrix-> nth nth ; inline
: ->matrix nth set-nth ; inline
@ -23,7 +23,7 @@ SYMBOL: costs
: compute-costs ( str1 str2 -- )
swap [
[ = 0 1 ? ] curry* { } map-as
[ = 0 1 ? ] with { } map-as
] curry { } map-as costs set ; inline
: levenshtein-step ( i j -- )
@ -41,6 +41,6 @@ SYMBOL: costs
2dup compute-costs
[ length ] 2apply [
[ levenshtein-step ] curry each
] curry* each
] with each
levenshtein-result
] with-scope ;

View File

@ -112,7 +112,7 @@ M: object lint ( obj -- seq )
M: callable lint ( quot -- seq )
def-hash-keys get [
swap subseq/member?
] curry* subset ;
] with subset ;
M: word lint ( word -- seq )
word-def dup callable? [ lint ] [ drop f ] if ;

View File

@ -7,7 +7,7 @@ IN: lisp
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: && ( obj seq -- ? ) [ call ] curry* all? ;
: && ( obj seq -- ? ) [ call ] with all? ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -57,7 +57,7 @@ C: <quote> quote
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: local-index ( obj args -- n )
[ dup quote? [ quote-local ] when eq? ] curry* find drop ;
[ dup quote? [ quote-local ] when eq? ] with find drop ;
: read-local ( obj args -- quot )
local-index 1+

View File

@ -16,7 +16,7 @@ IN: math.analysis
} ; inline
: gamma-z ( x n -- seq )
[ + recip ] curry* map 1.0 0 pick set-nth ;
[ + recip ] with map 1.0 0 pick set-nth ;
: (gamma-lanczos6) ( x -- log[gamma[x+1]] )
#! log(gamma(x+1)

View File

@ -39,5 +39,5 @@ PRIVATE>
dup 1000003 < [
0 primes-under-million seq>list swap [ <= ] curry lwhile
] [
<erato> 2 [ drop next-prime ] curry* lfrom-by [ ] lwhile
<erato> 2 [ drop next-prime ] with lfrom-by [ ] lwhile
] if ;

View File

@ -4,7 +4,7 @@ USING: arrays sequences math math.vectors math.constants
math.functions kernel splitting ;
IN: math.fft
: n^v ( n v -- w ) [ ^ ] curry* map ;
: n^v ( n v -- w ) [ ^ ] with map ;
: even ( seq -- seq ) 2 group 0 <column> ;
: odd ( seq -- seq ) 2 group 1 <column> ;
DEFER: fft

View File

@ -10,14 +10,14 @@ IN: math.matrices
: identity-matrix ( n -- matrix )
#! Make a nxn identity matrix.
dup [ [ = 1 0 ? ] curry* map ] curry map ;
dup [ [ = 1 0 ? ] with map ] curry map ;
! Matrix operations
: mneg ( m -- m ) [ vneg ] map ;
: n*m ( n m -- m ) [ n*v ] curry* map ;
: n*m ( n m -- m ) [ n*v ] with map ;
: m*n ( m n -- m ) [ v*n ] curry map ;
: n/m ( n m -- m ) [ n/v ] curry* map ;
: n/m ( n m -- m ) [ n/v ] with map ;
: m/n ( m n -- m ) [ v/n ] curry map ;
: m+ ( m m -- m ) [ v+ ] 2map ;
@ -25,7 +25,7 @@ IN: math.matrices
: m* ( m m -- m ) [ v* ] 2map ;
: m/ ( m m -- m ) [ v/ ] 2map ;
: v.m ( v m -- v ) flip [ v. ] curry* map ;
: v.m ( v m -- v ) flip [ v. ] with map ;
: m.v ( m v -- v ) [ v. ] curry map ;
: m. ( m m -- m ) flip [ swap m.v ] curry map ;

View File

@ -86,5 +86,5 @@ TUPLE: miller-rabin-bounds ;
: unique-primes ( numbits n -- seq )
#! generate two primes
over 5 < [ "not enough primes below 5 bits" throw ] when
[ [ drop random-prime ] curry* map ] [ all-unique? ] generate ;
[ [ drop random-prime ] with map ] [ all-unique? ] generate ;

View File

@ -32,7 +32,7 @@ IN: math.statistics
dup length 1 <= [
drop 0
] [
[ [ mean ] keep [ - sq ] curry* sigma ] keep
[ [ mean ] keep [ - sq ] with sigma ] keep
length 1- /
] if ;

View File

@ -7,9 +7,9 @@ IN: math.vectors
: vneg ( u -- v ) [ neg ] map ;
: v*n ( u n -- v ) [ * ] curry map ;
: n*v ( n u -- v ) [ * ] curry* map ;
: n*v ( n u -- v ) [ * ] with map ;
: v/n ( u n -- v ) [ / ] curry map ;
: n/v ( n u -- v ) [ / ] curry* map ;
: n/v ( n u -- v ) [ / ] with map ;
: v+ ( u v -- w ) [ + ] 2map ;
: v- ( u v -- w ) [ - ] 2map ;

View File

@ -16,7 +16,7 @@ SYMBOL: visited
: choices ( cell -- seq )
{ { -1 0 } { 1 0 } { 0 -1 } { 0 1 } }
[ v+ ] curry* map
[ v+ ] with map
[ unvisited? ] subset ;
: random-neighbour ( cell -- newcell ) choices random ;
@ -43,7 +43,7 @@ SYMBOL: visited
line-width 2 - glLineWidth
line-width 2 - glPointSize
1.0 1.0 1.0 1.0 glColor4d
dup [ drop t <array> ] curry* map visited set
dup [ drop t <array> ] with map visited set
GL_LINE_STRIP glBegin
{ 0 0 } dup vertex (draw-maze)
glEnd ;

View File

@ -44,7 +44,7 @@ DEFER: remove-connection
: deactivate-model ( model -- )
dup unref-model zero? [
dup model-dependencies
[ dup deactivate-model remove-connection ] curry* each
[ dup deactivate-model remove-connection ] with each
] [
drop
] if ;
@ -71,7 +71,7 @@ GENERIC: update-model ( model -- )
M: model update-model drop ;
: notify-connections ( model -- )
dup model-connections [ model-changed ] curry* each ;
dup model-connections [ model-changed ] with each ;
: set-model ( value model -- )
dup model-locked? [

View File

@ -180,7 +180,7 @@ empty-method-table empty-method-table 4array dup first set-global ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: add-methods ( class seq -- ) 2 group [ first2 add-method ] curry* each ;
: add-methods ( class seq -- ) 2 group [ first2 add-method ] with each ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -252,7 +252,7 @@ C: <field> field
[
dup odbc-number-of-columns [
1+ odbc-get-field field-value ,
] curry* each
] with each
] { } make ;
: (odbc-get-all-rows) ( statement -- )

View File

@ -70,7 +70,7 @@ IN: opengl
: adjust-points [ [ 1 + 0.5 * ] map ] 2apply ;
: scale-points 2array flip [ v* ] curry* map [ v+ ] curry* map ;
: scale-points 2array flip [ v* ] with map [ v+ ] with map ;
: circle-points ( loc dim steps -- points )
circle-steps unit-circle adjust-points scale-points ;

View File

@ -54,7 +54,7 @@ SYMBOL: query-res
: result>seq ( -- seq )
query-res get [ PQnfields ] keep PQntuples
[ swap [ query-res get -rot PQgetvalue ] curry* map ] curry* map ;
[ swap [ query-res get -rot PQgetvalue ] with map ] with map ;
: print-table ( seq -- )
[ [ write bl ] each "\n" write ] each ;

View File

@ -7,7 +7,7 @@ IN: random-weighted
: probabilities ( weights -- probabilities ) dup sum [ / ] curry map ;
: layers ( probabilities -- layers )
dup length 1+ [ head ] curry* map 1 tail [ sum ] map ;
dup length 1+ [ head ] with map 1 tail [ sum ] map ;
: random-weighted ( weights -- elt )
probabilities layers [ 1000 * ] map 1000 random [ > ] curry find drop ;

View File

@ -65,7 +65,7 @@ SYMBOL: mt
: init-mt-rest ( seq -- )
mt-n 1 head* [
[ init-mt-formula ] 2keep 1+ swap set-nth
] curry* each ;
] with each ;
: mt-temper ( y -- yt )
dup -11 shift bitxor

View File

@ -10,7 +10,7 @@ USING: xml.utilities kernel assocs xml.generator
[ children>string ] [ f ] if* ;
: any-tag-named ( tag names -- tag-inside )
f -rot [ tag-named nip dup ] curry* find 2drop ;
f -rot [ tag-named nip dup ] with find 2drop ;
TUPLE: feed title link entries ;

View File

@ -84,16 +84,16 @@ IN: sequences.lib
<PRIVATE
: translate-string ( n alphabet out-len -- seq )
[ drop /mod ] curry* map nip ;
[ drop /mod ] with map nip ;
: map-alphabet ( alphabet seq[seq] -- seq[seq] )
[ [ swap nth ] curry* map ] curry* map ;
[ [ swap nth ] with map ] with map ;
: exact-number-strings ( n out-len -- seqs )
[ ^ ] 2keep [ translate-string ] 2curry map ;
: number-strings ( n max-length -- seqs )
1+ [ exact-number-strings ] curry* map concat ;
1+ [ exact-number-strings ] with map concat ;
PRIVATE>
: exact-strings ( alphabet length -- seqs )

View File

@ -22,7 +22,7 @@ SYMBOL: serialized
: object-id ( obj -- id )
#! Return the id of an already serialized object
serialized get [ eq? ] curry* find [ drop f ] unless ;
serialized get [ eq? ] with find [ drop f ] unless ;
USE: prettyprint

View File

@ -8,12 +8,12 @@ IN: shufflers
first2 "-" swap 3append >string ;
: make-shuffles ( max-out max-in -- shuffles )
[ 1+ dup rot strings [ 2array ] curry* map ]
curry* map concat ;
[ 1+ dup rot strings [ 2array ] with map ]
with map concat ;
: shuffle>quot ( shuffle -- quot )
[
first2 2dup [ - ] curry* map
first2 2dup [ - ] with map
reverse [ , \ npick , \ >r , ] each
swap , \ ndrop , length [ \ r> , ] times
] [ ] make ;
@ -30,7 +30,7 @@ IN: shufflers
in-shuffle over length make-shuffles [
[ shuffle>string create-in ] keep
shuffle>quot dupd define-compound put-effect
] curry* each out-shuffle ;
] with each out-shuffle ;
: SHUFFLE:
scan scan string>number define-shuffles ; parsing

View File

@ -212,8 +212,8 @@ gravity off
! Send the half of the snake in a random direction
nodes> 10 [ swap nth ] curry* map
nodes> 10 [ 19 + swap nth ] curry* map append
nodes> 10 [ swap nth ] with map
nodes> 10 [ 19 + swap nth ] with map append
100 random -50 + 100 random 100 + { -1 1 } random * 2array
[ swap set-node-vel ] curry
each ;

View File

@ -144,7 +144,7 @@ M: mapping select-sql ( tuple mapping -- select )
] [
drop f
] if
] curry* map [ ] subset dup length 0 > [
] with map [ ] subset dup length 0 > [
" where " %
" and " join %
] [
@ -173,7 +173,7 @@ M: mapping select-sql ( tuple mapping -- select )
[ db-field-slot slot ] keep ! statement value field
db-field-bind-name swap ! statement name value
>r dupd r> sqlite-bind-text-by-name
] curry* each drop ;
] with each drop ;
: bind-for-select ( statement tuple -- )
#! Bind the fields in the tuple to the fields in the
@ -186,7 +186,7 @@ M: mapping select-sql ( tuple mapping -- select )
] [
2drop
] if
] curry* each drop ;
] with each drop ;
: bind-for-update ( statement tuple -- )
#! Bind the fields in the tuple to the fields in the

View File

@ -6,7 +6,7 @@ IN: tetris.board
TUPLE: board width height rows ;
: make-rows ( width height -- rows )
[ drop f <array> ] curry* map ;
[ drop f <array> ] with map ;
: <board> ( width height -- board )
2dup make-rows board construct-boa ;
@ -31,7 +31,7 @@ TUPLE: board width height rows ;
2dup block-in-bounds? [ block-free? ] [ 2drop f ] if ;
: piece-valid? ( board piece -- ? )
piece-blocks [ location-valid? ] curry* all? ;
piece-blocks [ location-valid? ] with all? ;
: row-not-full? ( row -- ? ) f swap member? ;

View File

@ -68,7 +68,7 @@ TUPLE: tetris pieces last-update update-interval rows score game-state paused? r
over tetris-rows + swap set-tetris-rows ;
: lock-piece ( tetris -- )
[ dup tetris-current-piece piece-blocks [ add-block ] curry* each ] keep
[ dup tetris-current-piece piece-blocks [ add-block ] with each ] keep
dup new-current-piece dup check-rows score-rows ;
: can-rotate? ( tetris -- ? )

View File

@ -27,4 +27,4 @@ GENERIC: tick ( object -- )
[ [ advance-timer ] keep timer-object tick ] [ 2drop ] if ;
: do-timers ( -- )
millis timers values [ do-timer ] curry* each ;
millis timers values [ do-timer ] with each ;

View File

@ -70,14 +70,14 @@ M: vocab-link summary vocab-summary ;
dup empty? [
drop
] [
swap [ "." swap 3append ] curry* map
swap [ "." swap 3append ] with map
] if ;
: vocabs-in-dir ( root name -- )
dupd (all-child-vocabs) [
2dup vocab-dir? [ 2dup swap >vocab-link , ] when
vocabs-in-dir
] curry* each ;
] with each ;
: sane-vocab-roots "." vocab-roots get remove ;
@ -125,13 +125,13 @@ M: vocab-link summary vocab-summary ;
[ vocab-root not ] subset
[
vocab-name swap ?head CHAR: . rot member? not and
] curry* subset
] with subset
[ vocab ] map ;
: all-child-vocabs ( prefix -- assoc )
sane-vocab-roots [
dup pick dupd (all-child-vocabs)
[ swap >vocab-link ] curry* map
[ swap >vocab-link ] with map
] { } map>assoc
f rot unrooted-child-vocabs 2array add ;

View File

@ -43,7 +43,7 @@ vectors words assocs combinators sorting ;
runs [
[ 0 [ pick score-1 max ] reduce nip ] keep
length * +
] curry* each
] with each
] [
2drop 0
] if ;
@ -51,7 +51,7 @@ vectors words assocs combinators sorting ;
: rank-completions ( results -- newresults )
sort-keys <reversed>
[ 0 [ first max ] reduce 3 /f ] keep
[ first < ] curry* subset
[ first < ] with subset
[ second ] map ;
: complete ( full short -- score )
@ -66,7 +66,7 @@ vectors words assocs combinators sorting ;
over empty? [
nip [ first ] map
] [
>r >lower r> [ completion ] curry* map rank-completions
>r >lower r> [ completion ] with map rank-completions
] if ;
: string-completions ( short strs -- seq )

View File

@ -14,12 +14,12 @@ IN: tools.crossref
: (method-usage) ( word generic -- methods )
tuck methods
[ second quot-uses key? ] curry* subset
[ second quot-uses key? ] with subset
0 <column>
swap [ 2array ] curry map ;
: method-usage ( word seq -- methods )
[ generic? ] subset [ (method-usage) ] curry* map concat ;
[ generic? ] subset [ (method-usage) ] with map concat ;
: compound-usage ( words -- seq )
[ generic? not ] subset ;

View File

@ -56,7 +56,7 @@ IN: tools.deploy.shaker
[
[ word-props strip-assoc f assoc-like ] keep
set-word-props
] curry* each ;
] with each ;
: retained-props ( -- seq )
[

View File

@ -19,7 +19,7 @@ IN: tools.deploy.windows
"factor-nt.dll"
} [
dup resource-path -rot path+ copy-file
] curry* each ;
] with each ;
: create-exe-dir ( vocab bundle-name -- vm )
dup copy-dlls

View File

@ -5,7 +5,7 @@ sequences random ;
IN: temporary
: randomize-numeric-splay-tree ( splay-tree -- )
100 [ drop 100 random swap at drop ] curry* each ;
100 [ drop 100 random swap at drop ] with each ;
: make-numeric-splay-tree ( n -- splay-tree )
<splay> [ [ dupd set-at ] curry each ] keep ;

View File

@ -10,7 +10,7 @@ IN: tuple-syntax
: parse-slot-writer ( tuple -- slot-setter )
scan dup "}" = [ 2drop f ] [
1 head* swap class "slots" word-prop
[ slot-spec-name = ] curry* find nip slot-spec-writer
[ slot-spec-name = ] with find nip slot-spec-writer
] if ;
: parse-slots ( accum tuple -- accum tuple )

View File

@ -109,7 +109,7 @@ M: freetype-renderer open-font ( font -- open-font )
] cache-nth nip ;
M: freetype-renderer string-width ( open-font string -- w )
0 -rot [ char-width + ] curry* each ;
0 -rot [ char-width + ] with each ;
M: freetype-renderer string-height ( open-font string -- h )
drop font-height ;
@ -179,11 +179,11 @@ M: freetype-renderer draw-string ( font string loc -- )
>r >r world get font-sprites first2 r> r> (draw-string) ;
: run-char-widths ( open-font string -- widths )
[ char-width ] curry* { } map-as
[ char-width ] with { } map-as
dup 0 [ + ] accumulate nip swap 2 v/n v+ ;
M: freetype-renderer x>offset ( x open-font string -- n )
dup >r run-char-widths [ <= ] curry* find drop
dup >r run-char-widths [ <= ] with find drop
[ r> drop ] [ r> length ] if* ;
T{ freetype-renderer } font-renderer set-global

View File

@ -23,6 +23,6 @@ M: book pref-dim* gadget-children pref-dims max-dim ;
M: book layout*
dup rect-dim swap gadget-children
[ set-layout-dim ] curry* each ;
[ set-layout-dim ] with each ;
M: book focusable-child* current-page ;

View File

@ -178,7 +178,7 @@ M: editor ungraft*
\ first-visible-line get [
editor get dup editor-color gl-color
dup visible-lines
[ draw-line 1 translate-lines ] curry* each
[ draw-line 1 translate-lines ] with each
] with-editor-translation ;
: selection-start/end ( editor -- start end )

View File

@ -119,7 +119,7 @@ M: gadget children-on nip gadget-children ;
dup gadget-visible? [ intersects? ] [ 2drop f ] if ;
: (pick-up) ( point gadget -- gadget )
dupd children-on [ inside? ] curry* find-last nip ;
dupd children-on [ inside? ] with find-last nip ;
: pick-up ( point gadget -- child/f )
2dup (pick-up) dup
@ -137,7 +137,7 @@ M: gadget children-on nip gadget-children ;
: set-gadget-delegate ( gadget tuple -- )
over [
dup pick [ set-gadget-parent ] curry* each-child
dup pick [ set-gadget-parent ] with each-child
] when set-delegate ;
: construct-control ( model gadget class -- control )

View File

@ -20,7 +20,7 @@ SYMBOL: grid-dim
: draw-grid-lines ( gaps orientation -- )
grid get rot grid-positions grid get rect-dim add [
grid-line-from/to gl-line
] curry* each ;
] with each ;
M: grid-lines draw-boundary
origin get [

View File

@ -36,10 +36,10 @@ TUPLE: grid children gap fill? ;
>r first r> second 2array ;
: pair-up ( horiz vert -- dims )
[ [ (pair-up) ] curry map ] curry* map ;
[ [ (pair-up) ] curry map ] with map ;
: add-gaps ( gap seq -- newseq )
[ v+ ] curry* map ;
[ v+ ] with map ;
: gap-sum ( gap seq -- newseq )
dupd add-gaps dim-sum v+ ;

View File

@ -7,7 +7,7 @@ IN: ui.gadgets.packs
TUPLE: pack align fill gap ;
: packed-dim-2 ( gadget sizes -- list )
[ over rect-dim over v- rot pack-fill v*n v+ ] curry* map ;
[ over rect-dim over v- rot pack-fill v*n v+ ] with map ;
: packed-dims ( gadget sizes -- seq )
2dup packed-dim-2 swap orient ;
@ -16,7 +16,7 @@ TUPLE: pack align fill gap ;
{ 0 0 } [ v+ over v+ ] accumulate 2nip ;
: aligned-locs ( gadget sizes -- seq )
[ >r dup pack-align swap rect-dim r> v- n*v ] curry* map ;
[ >r dup pack-align swap rect-dim r> v- n*v ] with map ;
: packed-locs ( gadget sizes -- seq )
over pack-gap over gap-locs >r dupd aligned-locs r> orient ;

Some files were not shown because too many files have changed in this diff Show More