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

nip most uses of tuck from extra

db4
Joe Groff 2009-11-05 22:22:21 -06:00
parent dbadab67ef
commit a5957b188d
38 changed files with 113 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
extra/benchmark/knucleotide/knucleotide.factor
View File

@ -1,4 +1,4 @@
USING: kernel io io.files splitting strings io.encodings.ascii
USING: kernel locals io io.files splitting strings io.encodings.ascii
hashtables sequences assocs math namespaces prettyprint
math.parser combinators arrays sorting unicode.case ;
@ -21,10 +21,7 @@ IN: benchmark.knucleotide
CHAR: \n swap remove >upper ;
: tally ( x exemplar -- b )
clone tuck
[
[ [ 1 + ] [ 1 ] if* ] change-at
] curry each ;
clone [ [ inc-at ] curry each ] keep ;
: small-groups ( x n -- b )
swap
@ -42,10 +39,10 @@ IN: benchmark.knucleotide
] each
drop ;
: handle-n ( inputs x -- )
tuck length
small-groups H{ } tally
at [ 0 ] unless*
:: handle-n ( inputs x -- )
inputs x length small-groups :> groups
groups H{ } tally :> b
x b at [ 0 ] unless*
number>string 8 CHAR: \s pad-tail write ;
: process-input ( input -- )

6
extra/curses/curses.factor
View File

@ -123,8 +123,10 @@ PRIVATE>
: curses-writef ( window string -- )
[ window-ptr dup ] dip (curses-wprint) (curses-window-refresh) ;
: (curses-read) ( window-ptr n encoding -- string )
[ [ <byte-array> tuck ] keep wgetnstr curses-error ] dip alien>string ;
:: (curses-read) ( window-ptr n encoding -- string )
n <byte-array> :> buf
window-ptr buf n wgetnstr curses-error
buf encoding alien>string ;
: curses-read ( window n -- string )
utf8 [ window-ptr ] 2dip (curses-read) ;

2
extra/decimals/decimals.factor
View File

@ -37,7 +37,7 @@ SYNTAX: D: parse-decimal suffix! ;
] 2bi ;
: scale-decimals ( D1 D2 -- D1' D2' )
scale-mantissas tuck [ <decimal> ] 2dip <decimal> ;
scale-mantissas [ <decimal> ] curry bi@ ;
ERROR: decimal-types-expected d1 d2 ;

2
extra/ecdsa/ecdsa.factor
View File

@ -50,7 +50,7 @@ PRIVATE>
: get-private-key ( -- bin/f )
ec-key-handle EC_KEY_get0_private_key
dup [ dup BN_num_bits bits>bytes <byte-array> tuck BN_bn2bin drop ] when ;
dup [ dup BN_num_bits bits>bytes <byte-array> [ BN_bn2bin drop ] keep ] when ;
:: get-public-key ( -- bin/f )
ec-key-handle :> KEY

3
extra/io/serial/windows/windows.factor
View File

@ -11,8 +11,7 @@ IN: io.serial.windows
: get-comm-state ( duplex -- dcb )
in>> handle>>
DCB <struct> tuck
GetCommState win32-error=0/f ;
DCB <struct> [ GetCommState win32-error=0/f ] keep ;
: set-comm-state ( duplex dcb -- )
[ in>> handle>> ] dip

7
extra/jamshred/gl/gl.factor
View File

@ -3,7 +3,7 @@
USING: accessors alien.c-types jamshred.game jamshred.oint
jamshred.player jamshred.tunnel kernel math math.constants
math.functions math.vectors opengl opengl.gl opengl.glu
opengl.demo-support sequences specialized-arrays ;
opengl.demo-support sequences specialized-arrays locals ;
FROM: alien.c-types => float ;
SPECIALIZED-ARRAY: float
IN: jamshred.gl
@ -50,8 +50,9 @@ CONSTANT: wall-drawing-offset 0.15
over color>> gl-color segment-vertex-and-normal
gl-normal gl-vertex ;
: draw-vertex-pair ( theta next-segment segment -- )
rot tuck draw-segment-vertex draw-segment-vertex ;
:: draw-vertex-pair ( theta next-segment segment -- )
segment theta draw-segment-vertex
next-segment theta draw-segment-vertex ;
: draw-segment ( next-segment segment -- )
GL_QUAD_STRIP [

4
extra/jamshred/oint/oint.factor
View File

@ -53,13 +53,13 @@ C: <oint> oint
: scalar-projection ( v1 v2 -- n )
#! the scalar projection of v1 onto v2
tuck v. swap norm / ;
[ v. ] [ norm ] bi / ;
: proj-perp ( u v -- w )
dupd proj v- ;
: perpendicular-distance ( oint oint -- distance )
tuck distance-vector swap 2dup left>> scalar-projection abs
[ distance-vector ] keep 2dup left>> scalar-projection abs
-rot up>> scalar-projection abs + ;
:: reflect ( v n -- v' )

5
extra/jamshred/player/player.factor
View File

@ -31,8 +31,9 @@ CONSTANT: max-speed 30.0
forward-pivot ;
: to-tunnel-start ( player -- )
[ tunnel>> first dup location>> ]
[ tuck (>>location) (>>nearest-segment) ] bi ;
dup tunnel>> first
[ >>nearest-segment ]
[ location>> >>location ] bi drop ;
: play-in-tunnel ( player segments -- )
>>tunnel to-tunnel-start ;

7
extra/jamshred/tunnel/tunnel.factor
View File

@ -63,9 +63,10 @@ CONSTANT: default-segment-radius 1
#! valid values
[ '[ _ clamp-length ] bi@ ] keep <slice> ;
: nearer-segment ( segment segment oint -- segment )
#! return whichever of the two segments is nearer to the oint
[ 2dup ] dip tuck distance [ distance ] dip < -rot ? ;
:: nearer-segment ( seg-a seg-b oint -- segment )
seg-a oint distance
seg-b oint distance <
seg-a seg-b ? ;
: (find-nearest-segment) ( nearest next oint -- nearest ? )
#! find the nearest of 'next' and 'nearest' to 'oint', and return

12
extra/joystick-demo/joystick-demo.factor
View File

@ -50,10 +50,10 @@ CONSTANT: pov-polygons
[ [ 0.0 ] unless* ] tri@
[ (xy>loc) ] dip (z>loc) ;
: move-axis ( gadget x y z -- )
(xyz>loc) rot tuck
[ indicator>> (>>loc) ]
[ z-indicator>> (>>loc) ] 2bi* ;
:: move-axis ( gadget x y z -- )
x y z (xyz>loc) :> ( xy z )
xy gadget indicator>> (>>loc)
z gadget z-indicator>> (>>loc) ;
: move-pov ( gadget pov -- )
swap pov>> [ interior>> -rot = COLOR: gray COLOR: white ? >>color drop ]
@ -82,10 +82,10 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
[ >>controller ] [ product-string <label> add-gadget ] bi ;
: add-axis-gadget ( gadget shelf -- gadget shelf )
<axis-gadget> tuck [ >>axis ] [ add-gadget-with-border ] 2bi* ;
<axis-gadget> [ >>axis ] [ add-gadget-with-border ] bi-curry bi* ;
: add-raxis-gadget ( gadget shelf -- gadget shelf )
<axis-gadget> tuck [ >>raxis ] [ add-gadget-with-border ] 2bi* ;
<axis-gadget> [ >>raxis ] [ add-gadget-with-border ] bi-curry bi* ;
:: (add-button-gadgets) ( gadget shelf -- )
gadget controller>> read-controller buttons>> length [

2
extra/key-handlers/key-handlers.factor
View File

@ -7,4 +7,4 @@ TUPLE: key-handler < border handlers ;
: <keys> ( gadget -- key-handler ) key-handler new-border { 0 0 } >>size ;
M: key-handler handle-gesture
tuck handlers>> at [ call( gadget -- ) f ] [ drop t ] if* ;
[ handlers>> at ] keep swap [ call( gadget -- ) f ] [ drop t ] if* ;

14
extra/koszul/koszul.factor
View File

@ -229,14 +229,12 @@ DEFER: (d)
: laplacian-betti ( basis1 basis2 basis3 -- n )
laplacian-matrix null/rank drop ;
: laplacian-kernel ( basis1 basis2 basis3 -- basis )
[ tuck ] dip
laplacian-matrix dup empty-matrix? [
2drop f
] [
nullspace [
[ [ wedge (alt+) ] 2each ] with-terms
] with map
:: laplacian-kernel ( basis1 basis2 basis3 -- basis )
basis1 basis2 basis3 laplacian-matrix :> lap
lap empty-matrix? [ f ] [
lap nullspace [| x |
basis2 x [ [ wedge (alt+) ] 2each ] with-terms
] map
] if ;
: graded-triple ( seq n -- triple )

2
extra/math/affine-transforms/affine-transforms.factor
View File

@ -41,7 +41,7 @@ CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0
[ [ y>> second ] [ x>> second neg ] bi 2array ]
[ [ y>> first neg ] [ x>> first ] bi 2array ]
[ |a| ] tri
tuck [ v/n ] 2bi@ ;
[ v/n ] curry bi@ ;
: inverse-axes ( a -- a^-1 )
(inverted-axes) { 0.0 0.0 } <affine-transform> ;

12
extra/math/binpack/binpack.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: sequences kernel arrays vectors accessors assocs sorting math math.functions ;
USING: sequences kernel arrays vectors accessors assocs shuffle sorting locals math math.functions ;
IN: math.binpack
@ -9,10 +9,12 @@ IN: math.binpack
[ [ values sum ] map ] keep
zip sort-keys values first push ;
: binpack ( assoc n -- bins )
[ sort-values <reversed> dup length ] dip
tuck / ceiling <array> [ <vector> ] map
tuck [ (binpack) ] curry each ;
:: binpack ( assoc n -- bins )
assoc sort-values <reversed> :> values
values length :> #values
n #values n / ceiling <array> [ <vector> ] map :> bins
values [ bins (binpack) ] each
bins ;
: binpack* ( items n -- bins )
[ dup zip ] dip binpack [ keys ] map ;

2
extra/math/finance/finance.factor
View File

@ -7,7 +7,7 @@ IN: math.finance
<PRIVATE
: weighted ( x y a -- z )
tuck [ * ] [ 1 - neg * ] 2bi* + ;
[ * ] [ 1 - neg * ] bi-curry bi* + ;
: a ( n -- a )
1 + 2 swap / ;

4
extra/math/quadratic/quadratic.factor
View File

@ -3,9 +3,9 @@
USING: kernel locals math math.functions ;
IN: math.quadratic
: monic ( c b a -- c' b' ) tuck [ / ] 2bi@ ;
: monic ( c b a -- c' b' ) [ / ] curry bi@ ;
: discriminant ( c b -- b d ) tuck sq 4 / swap - sqrt ;
: discriminant ( c b -- b d ) [ nip ] [ sq 4 / swap - sqrt ] 2bi ;
: critical ( b d -- -b/2 d ) [ -2 / ] dip ;

2
extra/models/combinators/combinators.factor
View File

@ -1,5 +1,5 @@
USING: accessors arrays kernel models models.product monads
sequences sequences.extras ;
sequences sequences.extras shuffle ;
FROM: syntax => >> ;
IN: models.combinators

2
extra/mongodb/msg/msg.factor
View File

@ -94,7 +94,7 @@ M: sequence <mdb-insert-msg> ( collection sequence -- mdb-insert-msg )
M: assoc <mdb-insert-msg> ( collection assoc -- mdb-insert-msg )
[ mdb-insert-msg new ] 2dip
[ >>collection ] dip
V{ } clone tuck push
[ V{ } clone ] dip suffix!
>>objects OP_Insert >>opcode ;

2
extra/mongodb/tuple/state/state.factor
View File

@ -10,7 +10,7 @@ CONSTANT: MDB_TUPLE_INFO "_mfd_t_info"
PRIVATE>
: <tuple-info> ( tuple -- tuple-info )
class V{ } clone tuck
class [ V{ } clone ] dip over
[ [ name>> ] dip push ]
[ [ vocabulary>> ] dip push ] 2bi ; inline

12
extra/parser-combinators/parser-combinators.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: lists lists.lazy promises kernel sequences strings math
arrays splitting quotations combinators namespaces
arrays splitting quotations combinators namespaces locals
unicode.case unicode.categories sequences.deep accessors ;
IN: parser-combinators
@ -58,9 +58,11 @@ C: <token-parser> token-parser
: case-insensitive-token ( string -- parser ) t <token-parser> ;
M: token-parser parse ( input parser -- list )
[ string>> ] [ ignore-case?>> ] bi
[ tuck ] dip ?string-head
M:: token-parser parse ( input parser -- list )
parser string>> :> str
parser ignore-case?>> :> case?
str input str case? ?string-head
[ <parse-results> ] [ 2drop nil ] if ;
: 1token ( n -- parser ) 1string token ;
@ -319,7 +321,7 @@ LAZY: <(+)> ( parser -- parser )
<& &> ;
: nonempty-list-of ( items separator -- parser )
[ over &> <*> <&:> ] keep <?> tuck pack ;
[ over &> <*> <&:> ] keep <?> [ nip ] 2keep pack ;
: list-of ( items separator -- parser )
#! Given a parser for the separator and for the

8
extra/project-euler/002/002.factor
View File

@ -31,7 +31,7 @@ PRIVATE>
V{ 0 } clone 1 rot (fib-upto) ;
: euler002 ( -- answer )
4000000 fib-upto [ even? ] filter sum ;
4,000,000 fib-upto [ even? ] filter sum ;
! [ euler002 ] 100 ave-time
! 0 ms ave run time - 0.22 SD (100 trials)
@ -41,11 +41,11 @@ PRIVATE>
! -------------------
: fib-upto* ( n -- seq )
0 1 [ pick over >= ] [ tuck + dup ] produce [ 3drop ] dip
0 1 [ pick over >= ] [ [ nip ] 2keep + dup ] produce [ 3drop ] dip
but-last-slice { 0 1 } prepend ;
: euler002a ( -- answer )
4000000 fib-upto* [ even? ] filter sum ;
4,000,000 fib-upto* [ even? ] filter sum ;
! [ euler002a ] 100 ave-time
! 0 ms ave run time - 0.2 SD (100 trials)
@ -54,7 +54,7 @@ PRIVATE>
<PRIVATE
: next-fibs ( x y -- y x+y )
tuck + ;
[ nip ] [ + ] 2bi ;
: ?retotal ( total fib- fib+ -- retotal fib- fib+ )
dup even? [ [ nip + ] 2keep ] when ;

15
extra/project-euler/100/100.factor
View File

@ -5,19 +5,18 @@ IN: project-euler.100
! http://projecteuler.net/index.php?section=problems&id=100
! DESCRIPTION
! -----------
! DESCRIPTION ! -----------
! If a box contains twenty-one coloured discs, composed of fifteen blue discs
! and six red discs, and two discs were taken at random, it can be seen that
! the probability of taking two blue discs, P(BB) = (15/21)*(14/20) = 1/2.
! and six red discs, and two discs were taken at random, it can be seen that
! the probability of taking two blue discs, P(BB) = (15/21)*(14/20) = 1/2.
! The next such arrangement, for which there is exactly 50% chance of taking
! two blue discs at random, is a box containing eighty-five blue discs and
! thirty-five red discs.
! two blue discs at random, is a box containing eighty-five blue discs and
! thirty-five red discs.
! By finding the first arrangement to contain over 10^12 = 1,000,000,000,000
! discs in total, determine the number of blue discs that the box would contain.
! discs in total, determine the number of blue discs that the box would contain.
! SOLUTION
@ -26,7 +25,7 @@ IN: project-euler.100
: euler100 ( -- answer )
1 1
[ dup dup 1 - * 2 * 10 24 ^ <= ]
[ tuck 6 * swap - 2 - ] while nip ;
[ [ 6 * swap - 2 - ] keep swap ] while nip ;
! TODO: solution needs generalization

2
extra/project-euler/117/117.factor
View File

@ -31,7 +31,7 @@ IN: project-euler.117
[ 4 short tail* sum ] keep push ;
: (euler117) ( n -- m )
V{ 1 } clone tuck [ next ] curry times last ;
[ V{ 1 } clone ] dip over [ next ] curry times last ;
PRIVATE>

4
extra/project-euler/ave-time/ave-time.factor
View File

@ -11,8 +11,8 @@ IN: project-euler.ave-time
[
[ datastack ]
[
'[ _ gc benchmark 1000 / , ] tuck
'[ _ _ with-datastack drop ]
'[ _ gc benchmark 1000 / , ]
[ '[ _ _ with-datastack drop ] ] keep swap
]
[ 1 - ] tri* swap times call
] { } make ; inline

17
extra/quadtrees/quadtrees.factor
View File

@ -1,5 +1,5 @@
! (c) 2009 Joe Groff, see BSD license
USING: assocs kernel math.rectangles combinators accessors
USING: assocs kernel math.rectangles combinators accessors locals
math.vectors vectors sequences math combinators.short-circuit arrays fry ;
IN: quadtrees
@ -89,8 +89,9 @@ DEFER: in-rect*
: insert ( value point tree -- )
dup leaf?>> [ leaf-insert ] [ node-insert ] if ;
: leaf-at-point ( point leaf -- value/f ? )
tuck point>> = [ value>> t ] [ drop f f ] if ;
:: leaf-at-point ( point leaf -- value/f ? )
point leaf point>> =
[ leaf value>> t ] [ f f ] if ;
: node-at-point ( point node -- value/f ? )
descend at-point ;
@ -103,15 +104,15 @@ DEFER: in-rect*
: node-in-rect* ( values rect node -- values )
[ (node-in-rect*) ] with each-quadrant ;
: leaf-in-rect* ( values rect leaf -- values )
tuck { [ nip point>> ] [ point>> swap contains-point? ] } 2&&
[ value>> over push ] [ drop ] if ;
:: leaf-in-rect* ( values rect leaf -- values )
{ [ leaf point>> ] [ leaf point>> rect contains-point? ] } 0&&
[ values leaf value>> suffix! ] [ values ] if ;
: in-rect* ( values rect tree -- values )
dup leaf?>> [ leaf-in-rect* ] [ node-in-rect* ] if ;
: leaf-erase ( point leaf -- )
tuck point>> = [ f >>point f >>value ] when drop ;
:: leaf-erase ( point leaf -- )
point leaf point>> = [ leaf f >>point f >>value drop ] when ;
: node-erase ( point node -- )
descend erase ;

2
extra/random/blum-blum-shub/blum-blum-shub-tests.factor
View File

@ -22,7 +22,7 @@ IN: blum-blum-shub.tests
[ 3716213681 ]
[
100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [
T{ blum-blum-shub f 200352954495 846054538649 } clone 100 over [
random-32* drop
] curry times
random-32*

2
extra/rot13/rot13.factor
View File

@ -3,7 +3,7 @@
USING: kernel math sequences strings io combinators ascii ;
IN: rot13
: rotate ( ch base -- ch ) tuck - 13 + 26 mod + ;
: rotate ( ch base -- ch ) [ - 13 + 26 mod ] [ + ] bi ;
: rot-letter ( ch -- ch )
{

2
extra/sequences/abbrev/abbrev.factor
View File

@ -12,7 +12,7 @@ IN: sequences.abbrev
[ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
: assoc-merge ( assoc1 assoc2 -- assoc3 )
tuck '[ over _ at dup [ append ] [ drop ] if ] assoc-map assoc-union ;
[ '[ over _ at dup [ append ] [ drop ] if ] assoc-map ] keep swap assoc-union ;
PRIVATE>

10
extra/sequences/modified/modified.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel math math.order
USING: accessors arrays kernel locals math math.order
sequences sequences.private shuffle ;
IN: sequences.modified
@ -32,9 +32,9 @@ C: <scaled> scaled
M: scaled modified-nth ( n seq -- elt )
[ seq>> nth ] [ c>> * ] bi ;
M: scaled modified-set-nth ( elt n seq -- elt )
M:: scaled modified-set-nth ( elt n seq -- elt )
! don't set c to 0!
tuck [ c>> / ] 2dip seq>> set-nth ;
elt seq c>> / n seq seq>> set-nth ;
TUPLE: offset < 1modified n ;
C: <offset> offset
@ -45,8 +45,8 @@ C: <offset> offset
M: offset modified-nth ( n seq -- elt )
[ seq>> nth ] [ n>> + ] bi ;
M: offset modified-set-nth ( elt n seq -- )
tuck [ n>> - ] 2dip seq>> set-nth ;
M:: offset modified-set-nth ( elt n seq -- )
elt seq n>> - n seq seq>> set-nth ;
TUPLE: summed < modified seqs ;
C: <summed> summed

20
extra/space-invaders/space-invaders.factor
View File

@ -14,7 +14,9 @@ USING:
io.files
io.pathnames
kernel
locals
math
math.order
openal
opengl.gl
sequences
@ -41,9 +43,7 @@ CONSTANT: game-height 256
first2 game-width 3 * * swap 3 * + ;
:: set-bitmap-pixel ( bitmap point color -- )
color point bitmap
point color :> index
point bitmap-index :> index
color first index bitmap set-nth
color second index 1 + bitmap set-nth
color third index 2 + bitmap set-nth ;
@ -140,8 +140,8 @@ M: space-invaders read-port ( port cpu -- byte )
#! Setting this value affects the value read from port 3
(>>port2o) ;
: bit-newly-set? ( old-value new-value bit -- bool )
tuck bit? [ bit? not ] dip and ;
:: bit-newly-set? ( old-value new-value bit -- bool )
new-value bit bit? [ old-value bit bit? not ] dip and ;
: port3-newly-set? ( new-value cpu bit -- bool )
[ port3o>> swap ] dip bit-newly-set? ;
@ -320,17 +320,13 @@ CONSTANT: red { 255 0 0 }
#! point is a {x y}. color is a {r g b}.
set-bitmap-pixel ;
: within ( n a b -- bool )
#! n >= a and n <= b
rot tuck swap <= [ swap >= ] dip and ;
: get-point-color ( point -- color )
#! Return the color to use for the given x/y position.
first2
{
{ [ dup 184 238 within pick 0 223 within and ] [ 2drop green ] }
{ [ dup 240 247 within pick 16 133 within and ] [ 2drop green ] }
{ [ dup 247 215 - 247 184 - within pick 0 223 within and ] [ 2drop red ] }
{ [ dup 184 238 between? pick 0 223 between? and ] [ 2drop green ] }
{ [ dup 240 247 between? pick 16 133 between? and ] [ 2drop green ] }
{ [ dup 247 215 - 247 184 - between? pick 0 223 between? and ] [ 2drop red ] }
[ 2drop white ]
} cond ;

2
extra/spider/spider.factor
View File

@ -57,7 +57,7 @@ fetched-in parsed-html links processed-in fetched-at ;
[ filter-base-links ] 2keep
depth>> 1 + swap
[ add-nonmatching ]
[ tuck [ apply-filters ] 2dip add-todo ] 2bi ;
[ dup '[ _ apply-filters ] curry 2dip add-todo ] 2bi ;
: normalize-hrefs ( base links -- links' )
[ derive-url ] with map ;

2
extra/tetris/piece/piece.factor
View File

@ -37,7 +37,7 @@ TUPLE: piece
: modulo ( n m -- n )
#! -2 7 mod => -2, -2 7 modulo => 5
tuck mod over + swap mod ;
[ mod ] [ + ] [ mod ] tri ;
: (rotate-piece) ( rotation inc n-states -- rotation' )
[ + ] dip modulo ;

2
extra/trees/avl/avl.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
USING: combinators kernel generic math math.functions
math.parser namespaces io sequences trees
math.parser namespaces io sequences trees shuffle
assocs parser accessors math.order prettyprint.custom ;
IN: trees.avl

2
extra/trees/splay/splay.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2005 Mackenzie Straight.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math namespaces sequences assocs parser
trees generic math.order accessors prettyprint.custom ;
trees generic math.order accessors prettyprint.custom shuffle ;
IN: trees.splay
TUPLE: splay < tree ;

3
extra/trees/trees.factor
View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel generic math sequences arrays io namespaces
prettyprint.private kernel.private assocs random combinators
parser math.order accessors deques make prettyprint.custom ;
parser math.order accessors deques make prettyprint.custom
shuffle ;
IN: trees
TUPLE: tree root count ;

10
extra/ui/gadgets/lists/lists.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors math.vectors classes.tuple math.rectangles colors
kernel sequences models opengl math math.order namespaces
kernel locals sequences models opengl math math.order namespaces
ui.commands ui.gestures ui.render ui.gadgets ui.gadgets.labels
ui.gadgets.scrollers ui.gadgets.presentations ui.gadgets.viewports
ui.gadgets.packs ;
@ -78,7 +78,7 @@ M: list focusable-child* drop t ;
dup list-empty? [
2drop
] [
tuck control-value length rem >>index
[ control-value length rem ] [ (>>index) ] [ ] tri
[ relayout-1 ] [ scroll>selected ] bi
] if ;
@ -95,9 +95,9 @@ M: list focusable-child* drop t ;
[ index>> ] keep nth-gadget invoke-secondary
] if ;
: select-gadget ( gadget list -- )
tuck children>> index
[ swap select-index ] [ drop ] if* ;
:: select-gadget ( gadget list -- )
gadget list children>> index
[ list select-index ] when* ;
: clamp-loc ( point max -- point )
vmin { 0 0 } vmax ;

2
extra/units/units-tests.factor
View File

@ -10,7 +10,7 @@ IN: units.tests
[ t ] [ 5 m 1 m d- 4 m = ] unit-test
[ t ] [ 5 m 2 m d* 10 m^2 = ] unit-test
[ t ] [ 5 m 2 m d/ 5/2 { } { } <dimensioned> = ] unit-test
[ t ] [ 5 m 2 m tuck d/ drop 2 m = ] unit-test
[ t ] [ 2 m 5 m 2 m d/ drop 2 m = ] unit-test
[ t ] [ 1 m 2 m 3 m 3array d-product 6 m^3 = ] unit-test
[ t ] [ 3 m d-recip 1/3 { } { m } <dimensioned> = ] unit-test

2
extra/usa-cities/usa-cities.factor
View File

@ -48,7 +48,7 @@ MEMO: cities-named ( name -- cities )
MEMO: cities-named-in ( name state -- cities )
cities [
tuck [ name>> = ] [ state>> = ] 2bi* and
[ name>> = ] [ state>> = ] bi-curry bi* and
] with with filter ;
: find-zip-code ( code -- city )