Rename curry* to with
parent
c738dee88e
commit
c8360f5ae5
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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? ;
|
||||
|
|
|
@ -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* ;
|
||||
|
|
|
@ -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 [
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 )
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
] [
|
||||
|
|
|
@ -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? [
|
||||
|
|
|
@ -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 -- ? )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 [
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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!
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ( -- )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ( -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -55,7 +55,7 @@ SYMBOL: validation-errors
|
|||
] [
|
||||
nip
|
||||
] if*
|
||||
] curry* map ;
|
||||
] with map ;
|
||||
|
||||
: expire-sessions ( -- )
|
||||
sessions get-global
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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." }
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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' )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -7,7 +7,7 @@ IN: lisp
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: && ( obj seq -- ? ) [ call ] curry* all? ;
|
||||
: && ( obj seq -- ? ) [ call ] with all? ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
@ -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+
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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? [
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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? ;
|
||||
|
||||
|
|
|
@ -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 -- ? )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
[
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 [
|
||||
|
|
|
@ -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+ ;
|
||||
|
|
|
@ -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
Loading…
Reference in New Issue