Eliminating usages of combinators/sequences/etc.lib

db4
Slava Pestov 2008-12-18 00:16:43 -06:00
parent 2c9ec65acf
commit 8a66947527
12 changed files with 49 additions and 43 deletions

View File

@ -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> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -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

View File

@ -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

View File

@ -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
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -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 ;

View File

@ -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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -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

View File

@ -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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -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 ] ;

View File

@ -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 ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -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 ;

View File

@ -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
[ [