steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
extra/automata/ui/ui.factor
View File

@ -15,7 +15,7 @@ USING: kernel namespaces math quotations arrays hashtables sequences threads
ui.gadgets.theme
ui.gadgets.handler
accessors
namespaces.lib assocs.lib vars
vars fry
rewrite-closures automata math.geometry.rect newfx ;
IN: automata.ui
@ -24,9 +24,9 @@ IN: automata.ui
: 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 ;
@ -46,9 +46,9 @@ VAR: slate
! 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> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

2
extra/bake/bake.factor
View File

@ -1,7 +1,7 @@
USING: kernel parser namespaces sequences quotations arrays vectors splitting
strings words math generalizations
macros combinators.lib combinators.conditional newfx ;
macros combinators.conditional newfx ;
IN: bake

4
extra/cfdg/cfdg.factor
View File

@ -1,6 +1,6 @@
USING: kernel alien.c-types combinators namespaces make arrays
sequences sequences.lib namespaces.lib splitting
sequences splitting
math math.functions math.vectors math.trig
opengl.gl opengl.glu opengl ui ui.gadgets.slate
vars colors self self.slots
@ -60,7 +60,7 @@ VAR: color-stack
: double-nth* ( c-array indices -- seq )
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

13
extra/dns/dns.factor
View File

@ -413,11 +413,12 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
[ 6 + get-double ]
}
2cleave
>r >r >r
get-question-section r>
get-rr-section r>
get-rr-section r>
get-rr-section
{
[ get-question-section ]
[ get-rr-section ]
[ get-rr-section ]
[ get-rr-section ]
} spread
2drop
]
}
@ -425,7 +426,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
: 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
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

6
extra/dns/server/server.factor
View File

@ -1,8 +1,8 @@
USING: kernel combinators sequences sets math threads namespaces continuations
debugger io io.sockets unicode.case accessors destructors
combinators.cleave combinators.lib combinators.short-circuit
newfx bake bake.fry
combinators.cleave combinators.short-circuit
newfx fry
dns dns.util dns.misc ;
IN: dns.server
@ -204,5 +204,5 @@ DEFER: query->rrs
[ receive-packet handle-request ] [ receive-loop ] bi ;
: loop ( addr-spec -- )
[ <datagram> '[ , [ receive-loop ] with-disposal ] try ] [ loop ] bi ;
[ <datagram> '[ _ [ receive-loop ] with-disposal ] try ] [ loop ] bi ;

8
extra/dns/util/util.factor
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
: 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 ] ;
! : 1if ( test then else -- ) >r >r >r dup r> call r> r> if ; inline ;
MACRO: 1if ( test then else -- ) '[ dup @ _ _ if ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

2
extra/math/function-tools/function-tools.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2008 Reginald Keith Ford II.
! 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
! Tools for quickly comparing, transforming, and evaluating mathematical functions

18
extra/newfx/newfx.factor
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 ;
@ -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: as-of { object number sequence } dup >r set-nth r> ;
METHOD: is-of { number object sequence } dup [ swapd set-nth ] dip ;
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: as-of { object object assoc } dup >r set-at r> ;
METHOD: is-of { object object assoc } dup [ swapd set-at ] dip ;
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! ( seq a b -- seq ) 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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

4
extra/random-weighted/random-weighted.factor
View File

@ -1,6 +1,6 @@
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
@ -17,4 +17,4 @@ dup [ second ] map swap [ first ] map random-weighted swap nth ;
MACRO: call-random-weighted ( exp -- )
[ keys ] [ values <enum> >alist ] bi
'[ , random-weighted , case ] ;
'[ _ random-weighted _ case ] ;

9
extra/rewrite-closures/rewrite-closures.factor
View File

@ -1,6 +1,5 @@
USING: kernel parser math quotations namespaces sequences macros
bake bake.fry ;
USING: kernel parser math quotations namespaces sequences macros fry ;
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 )
namestack swap '[ namestack [ , set-namestack @ ] dip set-namestack ] ;
namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

4
extra/self/self.factor
View File

@ -7,6 +7,4 @@ VAR: self
: with-self ( quot obj -- ) [ >self call ] with-scope ;
: save-self ( quot -- ) self> >r self> clone >self call r> >self ;
! : save-self ( quot -- ) [ self> clone >self call ] with-scope ;
: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;

12
extra/trails/trails.factor
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
calendar
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 -- )
origin get
[