diff --git a/extra/benchmark/knucleotide/knucleotide.factor b/extra/benchmark/knucleotide/knucleotide.factor index fb4f17cca5..a28a676b90 100644 --- a/extra/benchmark/knucleotide/knucleotide.factor +++ b/extra/benchmark/knucleotide/knucleotide.factor @@ -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 -- ) diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index 4d6c77fd23..23adf31700 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -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 ) - [ [ tuck ] keep wgetnstr curses-error ] dip alien>string ; +:: (curses-read) ( window-ptr n encoding -- string ) + n :> buf + window-ptr buf n wgetnstr curses-error + buf encoding alien>string ; : curses-read ( window n -- string ) utf8 [ window-ptr ] 2dip (curses-read) ; diff --git a/extra/decimals/decimals.factor b/extra/decimals/decimals.factor index cc12b4fed1..d5c62fee5e 100644 --- a/extra/decimals/decimals.factor +++ b/extra/decimals/decimals.factor @@ -37,7 +37,7 @@ SYNTAX: D: parse-decimal suffix! ; ] 2bi ; : scale-decimals ( D1 D2 -- D1' D2' ) - scale-mantissas tuck [ ] 2dip ; + scale-mantissas [ ] curry bi@ ; ERROR: decimal-types-expected d1 d2 ; diff --git a/extra/ecdsa/ecdsa.factor b/extra/ecdsa/ecdsa.factor index c4d889991e..8e285a0904 100644 --- a/extra/ecdsa/ecdsa.factor +++ b/extra/ecdsa/ecdsa.factor @@ -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 tuck BN_bn2bin drop ] when ; + dup [ dup BN_num_bits bits>bytes [ BN_bn2bin drop ] keep ] when ; :: get-public-key ( -- bin/f ) ec-key-handle :> KEY diff --git a/extra/io/serial/windows/windows.factor b/extra/io/serial/windows/windows.factor index 551fd16b33..645e4939de 100755 --- a/extra/io/serial/windows/windows.factor +++ b/extra/io/serial/windows/windows.factor @@ -11,8 +11,7 @@ IN: io.serial.windows : get-comm-state ( duplex -- dcb ) in>> handle>> - DCB tuck - GetCommState win32-error=0/f ; + DCB [ GetCommState win32-error=0/f ] keep ; : set-comm-state ( duplex dcb -- ) [ in>> handle>> ] dip diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor index 60e9e39d9f..48bf2b693a 100644 --- a/extra/jamshred/gl/gl.factor +++ b/extra/jamshred/gl/gl.factor @@ -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 [ diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor index ae72bd847c..b1644ef443 100644 --- a/extra/jamshred/oint/oint.factor +++ b/extra/jamshred/oint/oint.factor @@ -53,13 +53,13 @@ C: 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' ) diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index baeacd750b..ecce29180c 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -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 ; diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index e7285dcbbc..7f8646b778 100644 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -63,9 +63,10 @@ CONSTANT: default-segment-radius 1 #! valid values [ '[ _ clamp-length ] bi@ ] keep ; -: 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 diff --git a/extra/joystick-demo/joystick-demo.factor b/extra/joystick-demo/joystick-demo.factor index 90e28594e7..6ea1dc5633 100755 --- a/extra/joystick-demo/joystick-demo.factor +++ b/extra/joystick-demo/joystick-demo.factor @@ -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