Eliminating usages of combinators/sequences/etc.lib
parent
2c9ec65acf
commit
8a66947527
|
@ -15,7 +15,7 @@ USING: kernel namespaces math quotations arrays hashtables sequences threads
|
||||||
ui.gadgets.theme
|
ui.gadgets.theme
|
||||||
ui.gadgets.handler
|
ui.gadgets.handler
|
||||||
accessors
|
accessors
|
||||||
namespaces.lib assocs.lib vars
|
vars fry
|
||||||
rewrite-closures automata math.geometry.rect newfx ;
|
rewrite-closures automata math.geometry.rect newfx ;
|
||||||
|
|
||||||
IN: automata.ui
|
IN: automata.ui
|
||||||
|
@ -24,9 +24,9 @@ IN: automata.ui
|
||||||
|
|
||||||
: draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ;
|
: draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ;
|
||||||
|
|
||||||
: draw-line ( y line -- ) 0 swap [ >r 2dup r> draw-point 1+ ] each 2drop ;
|
: draw-line ( y line -- ) 0 swap [ [ 2dup ] dip draw-point 1+ ] each 2drop ;
|
||||||
|
|
||||||
: (draw-bitmap) ( bitmap -- ) 0 swap [ >r dup r> draw-line 1+ ] each drop ;
|
: (draw-bitmap) ( bitmap -- ) 0 swap [ [ dup ] dip draw-line 1+ ] each drop ;
|
||||||
|
|
||||||
: draw-bitmap ( bitmap -- ) GL_POINTS glBegin (draw-bitmap) glEnd ;
|
: draw-bitmap ( bitmap -- ) GL_POINTS glBegin (draw-bitmap) glEnd ;
|
||||||
|
|
||||||
|
@ -46,9 +46,9 @@ VAR: slate
|
||||||
|
|
||||||
! Create a quotation that is appropriate for buttons and gesture handler.
|
! Create a quotation that is appropriate for buttons and gesture handler.
|
||||||
|
|
||||||
: view-action ( quot -- quot ) [ drop [ ] with-view ] make* closed-quot ;
|
: view-action ( quot -- quot ) '[ drop _ with-view ] closed-quot ;
|
||||||
|
|
||||||
: view-button ( label quot -- ) >r <label> r> view-action <bevel-button> ;
|
: view-button ( label quot -- button ) [ <label> ] dip view-action <bevel-button> ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
|
|
||||||
USING: kernel parser namespaces sequences quotations arrays vectors splitting
|
USING: kernel parser namespaces sequences quotations arrays vectors splitting
|
||||||
strings words math generalizations
|
strings words math generalizations
|
||||||
macros combinators.lib combinators.conditional newfx ;
|
macros combinators.conditional newfx ;
|
||||||
|
|
||||||
IN: bake
|
IN: bake
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel alien.c-types combinators namespaces make arrays
|
USING: kernel alien.c-types combinators namespaces make arrays
|
||||||
sequences sequences.lib namespaces.lib splitting
|
sequences splitting
|
||||||
math math.functions math.vectors math.trig
|
math math.functions math.vectors math.trig
|
||||||
opengl.gl opengl.glu opengl ui ui.gadgets.slate
|
opengl.gl opengl.glu opengl ui ui.gadgets.slate
|
||||||
vars colors self self.slots
|
vars colors self self.slots
|
||||||
|
@ -60,7 +60,7 @@ VAR: color-stack
|
||||||
: double-nth* ( c-array indices -- seq )
|
: double-nth* ( c-array indices -- seq )
|
||||||
swap byte-array>double-array [ nth ] curry map ;
|
swap byte-array>double-array [ nth ] curry map ;
|
||||||
|
|
||||||
: check-size ( modelview -- num ) { 0 1 4 5 } double-nth* [ abs ] map biggest ;
|
: check-size ( modelview -- num ) { 0 1 4 5 } double-nth* [ abs ] map supremum ;
|
||||||
|
|
||||||
VAR: threshold
|
VAR: threshold
|
||||||
|
|
||||||
|
|
|
@ -413,11 +413,12 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
[ 6 + get-double ]
|
[ 6 + get-double ]
|
||||||
}
|
}
|
||||||
2cleave
|
2cleave
|
||||||
>r >r >r
|
{
|
||||||
get-question-section r>
|
[ get-question-section ]
|
||||||
get-rr-section r>
|
[ get-rr-section ]
|
||||||
get-rr-section r>
|
[ get-rr-section ]
|
||||||
get-rr-section
|
[ get-rr-section ]
|
||||||
|
} spread
|
||||||
2drop
|
2drop
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
@ -425,7 +426,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
|
||||||
|
|
||||||
: ba->message ( ba -- message ) parse-message ;
|
: ba->message ( ba -- message ) parse-message ;
|
||||||
|
|
||||||
: with-message-bytes ( ba quot -- ) >r ba->message r> call message->ba ; inline
|
: with-message-bytes ( ba quot -- ) [ ba->message ] dip call message->ba ; inline
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
|
|
||||||
USING: kernel combinators sequences sets math threads namespaces continuations
|
USING: kernel combinators sequences sets math threads namespaces continuations
|
||||||
debugger io io.sockets unicode.case accessors destructors
|
debugger io io.sockets unicode.case accessors destructors
|
||||||
combinators.cleave combinators.lib combinators.short-circuit
|
combinators.cleave combinators.short-circuit
|
||||||
newfx bake bake.fry
|
newfx fry
|
||||||
dns dns.util dns.misc ;
|
dns dns.util dns.misc ;
|
||||||
|
|
||||||
IN: dns.server
|
IN: dns.server
|
||||||
|
@ -204,5 +204,5 @@ DEFER: query->rrs
|
||||||
[ receive-packet handle-request ] [ receive-loop ] bi ;
|
[ receive-packet handle-request ] [ receive-loop ] bi ;
|
||||||
|
|
||||||
: loop ( addr-spec -- )
|
: loop ( addr-spec -- )
|
||||||
[ <datagram> '[ , [ receive-loop ] with-disposal ] try ] [ loop ] bi ;
|
[ <datagram> '[ _ [ receive-loop ] with-disposal ] try ] [ loop ] bi ;
|
||||||
|
|
||||||
|
|
|
@ -1,14 +1,12 @@
|
||||||
|
|
||||||
USING: kernel sequences sorting math math.order macros bake bake.fry ;
|
USING: kernel sequences sorting math math.order macros fry ;
|
||||||
|
|
||||||
IN: dns.util
|
IN: dns.util
|
||||||
|
|
||||||
: tri-chain ( obj p q r -- x y z )
|
: tri-chain ( obj p q r -- x y z )
|
||||||
>r >r call dup r> call dup r> call ; inline
|
[ [ call dup ] dip call dup ] dip call ; inline
|
||||||
|
|
||||||
MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ;
|
MACRO: 1if ( test then else -- ) '[ dup @ _ _ if ] ;
|
||||||
|
|
||||||
! : 1if ( test then else -- ) >r >r >r dup r> call r> r> if ; inline ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (c) 2008 Reginald Keith Ford II.
|
! Copyright (c) 2008 Reginald Keith Ford II.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel math arrays sequences sequences.lib ;
|
USING: kernel math arrays sequences ;
|
||||||
IN: math.function-tools
|
IN: math.function-tools
|
||||||
|
|
||||||
! Tools for quickly comparing, transforming, and evaluating mathematical functions
|
! Tools for quickly comparing, transforming, and evaluating mathematical functions
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
USING: kernel sequences assocs circular sets fry sequences.lib ;
|
USING: kernel sequences assocs circular sets fry ;
|
||||||
|
|
||||||
USING: math multi-methods ;
|
USING: math multi-methods ;
|
||||||
|
|
||||||
|
@ -62,8 +62,8 @@ METHOD: as { sequence object number } pick set-nth ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
METHOD: is-of { number object sequence } dup >r swapd set-nth r> ;
|
METHOD: is-of { number object sequence } dup [ swapd set-nth ] dip ;
|
||||||
METHOD: as-of { object number sequence } dup >r set-nth r> ;
|
METHOD: as-of { object number sequence } dup [ set-nth ] dip ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -93,8 +93,8 @@ METHOD: as { assoc object object } pick set-at ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
METHOD: is-of { object object assoc } dup >r swapd set-at r> ;
|
METHOD: is-of { object object assoc } dup [ swapd set-at ] dip ;
|
||||||
METHOD: as-of { object object assoc } dup >r set-at r> ;
|
METHOD: as-of { object object assoc } dup [ set-at ] dip ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -213,7 +213,7 @@ METHOD: as-mutate { object object assoc } set-at ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: snip ( seq a b -- seq ) >r over r> [ head ] [ tail ] 2bi* append ;
|
: snip ( seq a b -- seq ) [ over ] dip [ head ] [ tail ] 2bi* append ;
|
||||||
: snip-this ( a b seq -- seq ) -rot snip ;
|
: snip-this ( a b seq -- seq ) -rot snip ;
|
||||||
: snip! ( seq a b -- seq ) pick delete-slice ;
|
: snip! ( seq a b -- seq ) pick delete-slice ;
|
||||||
: snip-this! ( a b seq -- seq ) -rot pick delete-slice ;
|
: snip-this! ( a b seq -- seq ) -rot pick delete-slice ;
|
||||||
|
@ -222,7 +222,7 @@ METHOD: as-mutate { object object assoc } set-at ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: invert-index ( seq i -- seq i ) >r dup length 1 - r> - ;
|
: invert-index ( seq i -- seq i ) [ dup length 1 - ] dip - ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -236,9 +236,9 @@ METHOD: as-mutate { object object assoc } set-at ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: insert ( seq i obj -- seq ) >r cut r> prefix append ;
|
: insert ( seq i obj -- seq ) [ cut ] dip prefix append ;
|
||||||
|
|
||||||
: splice ( seq i seq -- seq ) >r cut r> prepend append ;
|
: splice ( seq i seq -- seq ) [ cut ] dip prepend append ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel namespaces arrays quotations sequences assocs combinators
|
USING: kernel namespaces arrays quotations sequences assocs combinators
|
||||||
mirrors math math.vectors random macros bake bake.fry ;
|
mirrors math math.vectors random macros fry ;
|
||||||
|
|
||||||
IN: random-weighted
|
IN: random-weighted
|
||||||
|
|
||||||
|
@ -17,4 +17,4 @@ dup [ second ] map swap [ first ] map random-weighted swap nth ;
|
||||||
|
|
||||||
MACRO: call-random-weighted ( exp -- )
|
MACRO: call-random-weighted ( exp -- )
|
||||||
[ keys ] [ values <enum> >alist ] bi
|
[ keys ] [ values <enum> >alist ] bi
|
||||||
'[ , random-weighted , case ] ;
|
'[ _ random-weighted _ case ] ;
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
|
|
||||||
USING: kernel parser math quotations namespaces sequences macros
|
USING: kernel parser math quotations namespaces sequences macros fry ;
|
||||||
bake bake.fry ;
|
|
||||||
|
|
||||||
IN: rewrite-closures
|
IN: rewrite-closures
|
||||||
|
|
||||||
|
@ -12,12 +11,12 @@ MACRO: set-parameters ( seq -- quot ) [set-parameters] ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: parametric-quot ( parameters quot -- quot ) '[ , set-parameters , call ] ;
|
: parametric-quot ( parameters quot -- quot ) '[ _ set-parameters _ call ] ;
|
||||||
|
|
||||||
: scoped-quot ( quot -- quot ) '[ , with-scope ] ;
|
: scoped-quot ( quot -- quot ) '[ _ with-scope ] ;
|
||||||
|
|
||||||
: closed-quot ( quot -- quot )
|
: closed-quot ( quot -- quot )
|
||||||
namestack swap '[ namestack [ , set-namestack @ ] dip set-namestack ] ;
|
namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -7,6 +7,4 @@ VAR: self
|
||||||
|
|
||||||
: with-self ( quot obj -- ) [ >self call ] with-scope ;
|
: with-self ( quot obj -- ) [ >self call ] with-scope ;
|
||||||
|
|
||||||
: save-self ( quot -- ) self> >r self> clone >self call r> >self ;
|
: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;
|
||||||
|
|
||||||
! : save-self ( quot -- ) [ self> clone >self call ] with-scope ;
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
USING: kernel accessors locals namespaces sequences sequences.lib threads
|
USING: kernel accessors locals namespaces sequences threads
|
||||||
math math.order math.vectors
|
math math.order math.vectors
|
||||||
calendar
|
calendar
|
||||||
colors opengl ui ui.gadgets ui.gestures ui.render
|
colors opengl ui ui.gadgets ui.gestures ui.render
|
||||||
|
@ -65,6 +65,16 @@ M: <trails-gadget> pref-dim* ( <trails-gadget> -- dim ) drop { 500 500 } ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: each-percent ( seq quot -- )
|
||||||
|
[
|
||||||
|
dup length
|
||||||
|
dup [ / ] curry
|
||||||
|
[ 1+ ] prepose
|
||||||
|
] dip compose
|
||||||
|
2each ; inline
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
M:: <trails-gadget> draw-gadget* ( GADGET -- )
|
M:: <trails-gadget> draw-gadget* ( GADGET -- )
|
||||||
origin get
|
origin get
|
||||||
[
|
[
|
||||||
|
|
Loading…
Reference in New Issue