Skip to content

Commit

Permalink
cleanup "over push" is "suffix!".
Browse files Browse the repository at this point in the history
  • Loading branch information
mrjbq7 committed Nov 30, 2014
1 parent a5e7176 commit 818f337
Show file tree
Hide file tree
Showing 11 changed files with 15 additions and 17 deletions.
2 changes: 1 addition & 1 deletion basis/base64/base64.factor
Expand Up @@ -14,7 +14,7 @@ ERROR: malformed-base64 ;
[ drop read1-ignoring ] [ 2nip ] if ; inline recursive

: push-ignoring ( accum ch -- accum )
dup { f 0 } member-eq? [ drop ] [ over push ] if ; inline
dup { f 0 } member-eq? [ drop ] [ suffix! ] if ; inline

: read-ignoring ( n ignoring stream -- str/f )
[ [ <sbuf> ] keep ] 2dip
Expand Down
2 changes: 1 addition & 1 deletion basis/math/matrices/matrices.factor
Expand Up @@ -162,7 +162,7 @@ IN: math.matrices
[ dupd proj v- ] each ;

: gram-schmidt ( seq -- orthogonal )
V{ } clone [ over (gram-schmidt) over push ] reduce ;
V{ } clone [ over (gram-schmidt) suffix! ] reduce ;

: norm-gram-schmidt ( seq -- orthonormal )
gram-schmidt [ normalize ] map ;
Expand Down
4 changes: 2 additions & 2 deletions basis/specialized-vectors/specialized-vectors-tests.factor
Expand Up @@ -4,6 +4,6 @@ tools.test kernel sequences alien.c-types ;
SPECIALIZED-ARRAY: float
SPECIALIZED-VECTORS: float double ;

[ 3 ] [ double-vector{ 1 2 } 3 over push length ] unit-test
[ 3 ] [ double-vector{ 1 2 } 3 suffix! length ] unit-test

[ t ] [ 10 float-array{ } new-resizable float-vector? ] unit-test
[ t ] [ 10 float-array{ } new-resizable float-vector? ] unit-test
6 changes: 3 additions & 3 deletions basis/splitting/monotonic/monotonic.factor
Expand Up @@ -9,9 +9,9 @@ IN: splitting.monotonic

: (monotonic-split) ( seq quot -- newseq )
[ V{ } clone V{ } clone ] 2dip [ ] swap '[
[ [ over push ] keep ] dip
[ @ [ over push V{ } clone ] unless ] keep
] map-reduce over push over push { } like ; inline
[ [ suffix! ] keep ] dip
[ @ [ suffix! V{ } clone ] unless ] keep
] map-reduce suffix! suffix! { } like ; inline

PRIVATE>

Expand Down
2 changes: 1 addition & 1 deletion basis/vlists/vlists-tests.factor
Expand Up @@ -20,7 +20,7 @@ IN: vlists.tests
dup "v" get [ vector>> ] bi@ eq?
] unit-test

[ VL{ } 3 over push ] must-fail
[ VL{ } 3 suffix! ] must-fail

[ 4 VL{ "hi" } set-first ] must-fail

Expand Down
2 changes: 1 addition & 1 deletion core/byte-vectors/byte-vectors-tests.factor
Expand Up @@ -5,7 +5,7 @@ IN: byte-vectors.tests
[ 0 ] [ 123 <byte-vector> length ] unit-test

: do-it ( seq -- seq )
123 [ over push ] each-integer ;
123 [ suffix! ] each-integer ;

[ t ] [
3 <byte-vector> do-it
Expand Down
Expand Up @@ -16,7 +16,7 @@ TR: trans-map ch>upper "ACGTUMRYKVHDB" "TGCAAKYRMBDHV" ;

: do-line ( seq line -- seq )
dup first ">;" member-eq?
[ over show-seq print dup delete-all ] [ over push ] if ;
[ over show-seq print dup delete-all ] [ suffix! ] if ;

HINTS: do-line vector string ;

Expand Down
4 changes: 2 additions & 2 deletions extra/jamshred/jamshred.factor
Expand Up @@ -26,7 +26,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
] [
[ jamshred>> jamshred-update ]
[ relayout-1 ]
[ 100 milliseconds sleep jamshred-loop ] tri
[ 100 milliseconds sleep jamshred-loop ] tri
] if ;

M: jamshred-gadget graft* ( gadget -- )
Expand Down Expand Up @@ -57,7 +57,7 @@ M: jamshred-gadget ungraft* ( gadget -- )
: handle-mouse-motion ( jamshred-gadget -- )
hand-loc get [
over last-hand-loc>> [
v- (handle-mouse-motion)
v- (handle-mouse-motion)
] [ 2drop ] if*
] 2keep >>last-hand-loc drop ;

Expand Down
4 changes: 1 addition & 3 deletions extra/jamshred/tunnel/tunnel.factor
Expand Up @@ -32,9 +32,7 @@ CONSTANT: random-rotation-angle $[ pi 20 / ]
random-color >>color dup segment-number++ ;

: (random-segments) ( segments n -- segments )
dup 0 > [
[ dup last random-segment over push ] dip 1 - (random-segments)
] [ drop ] if ;
[ dup last random-segment suffix! ] times ;

CONSTANT: default-segment-radius 1

Expand Down
2 changes: 1 addition & 1 deletion extra/project-euler/002/002.factor
Expand Up @@ -23,7 +23,7 @@ IN: project-euler.002
<PRIVATE

: (fib-upto) ( seq n limit -- seq )
2dup <= [ [ over push dup 2 tail* sum ] dip (fib-upto) ] [ 2drop ] if ;
2dup <= [ [ suffix! dup 2 tail* sum ] dip (fib-upto) ] [ 2drop ] if ;

PRIVATE>

Expand Down
2 changes: 1 addition & 1 deletion unmaintained/semantic-db/semantic-db.factor
Expand Up @@ -259,7 +259,7 @@ C: <node-tree> node-tree

: (get-node-chain) ( node next-selector seq -- seq )
pick [
over push >r [ call ] keep r> (get-node-chain)
suffix! >r [ call ] keep r> (get-node-chain)
] [
2nip
] if* ;
Expand Down

0 comments on commit 818f337

Please sign in to comment.