core: push-if -> push-when, refactoring sequence words

diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor
index 5ec3d0a5f3720c7388a189d6af7b66e4b7deae60..fb0c4609852af66db2a37f55ad2269151a0de6d5 100644 (file)
--- a/basis/base64/base64.factor
+++ b/basis/base64/base64.factor
@@ -82,7 +82,7 @@ PRIVATE>
 
 : read-ignoring ( n ignoring stream -- accum )
     pick <sbuf> [
-        '[ _ _ read1-ignoring [ ] _ push-if ] times
+        '[ _ _ read1-ignoring [ ] _ push-when ] times
     ] keep ;
 
 : decode4 ( a b c d -- x y z )

diff --git a/basis/bit-sets/bit-sets.factor b/basis/bit-sets/bit-sets.factor
index 341f81b10b660dd0124f9c645997f36f16bcd59f..5e3d39d8c73adfee576f4d2f14fdca70945211bc 100644 (file)
--- a/basis/bit-sets/bit-sets.factor
+++ b/basis/bit-sets/bit-sets.factor
@@ -35,7 +35,7 @@ ERROR: check-bit-set-failed ;
     dup bit-set? [ check-bit-set-failed ] unless ; inline
 
 : bit-set-map ( seq1 seq2 quot -- seq )
-    [ drop [ length ] bi@ [ assert= ] keep ]
+    [ drop 2length [ assert= ] keep ]
     [ [ [ underlying>> ] bi@ ] dip 2map ] 3bi
     bit-array boa ; inline
 

diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor
index 20273006c8155ccb6b154b5ac4a1cf5fb19fba0e..8b597a58b4b76c23e5247862084153fd3b016c4d 100644 (file)
--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@@ -14,7 +14,7 @@ GENERIC: infer-known* ( known -- effect )
     ] [ infer-known* ] if ;
 
 IDENTITY-MEMO: inputs/outputs ( quot -- in out )
-    infer [ in>> ] [ out>> ] bi [ length ] bi@ ;
+    infer [ in>> ] [ out>> ] bi 2length ;
 
 : inputs ( quot -- n ) inputs/outputs drop ; inline
 

diff --git a/basis/io/crlf/crlf.factor b/basis/io/crlf/crlf.factor
index 013cbbc19fcc9b65af49496b7c9116af0900750a..e173a80173fca920a73325d768edbc36922c14d5 100644 (file)
--- a/basis/io/crlf/crlf.factor
+++ b/basis/io/crlf/crlf.factor
@@ -38,7 +38,7 @@ IN: io.crlf
     input-stream get stream-read1-ignoring-crlf ;
 
 : push-ignoring-crlf ( elt seq -- )
-    [ "\r\n" member? not ] swap push-if ;
+    [ "\r\n" member? not ] swap push-when ;
 
 : push-all-ignoring-crlf ( src dst -- )
     [ push-ignoring-crlf ] curry each ;

diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor
index ade3cf9434dadb58ce52b9b85bfc9f8ddaa3b592..dcad9fb99b4410cdfec18035c4f32a0e3128297e 100644 (file)
--- a/basis/math/primes/primes.factor
+++ b/basis/math/primes/primes.factor
@@ -57,7 +57,7 @@ PRIVATE>
 
 : (primes-between) ( low high -- seq )
     [ <primes-range> ] [ <primes-vector> ] 2bi
-    [ '[ [ prime? ] _ push-if ] each ] keep ;
+    [ '[ [ prime? ] _ push-when ] each ] keep ;
 
 PRIVATE>
 

diff --git a/core/effects/effects.factor b/core/effects/effects.factor
index 97955390a1aa08c9bf885fd10bd46fc561c3c67a..a79516932588d6f0821e3885b197780d8315b5de 100644 (file)
--- a/core/effects/effects.factor
+++ b/core/effects/effects.factor
@@ -11,6 +11,8 @@ TUPLE: effect
 { in-var read-only }
 { out-var read-only } ;
 
+: in-out ( effect -- in out ) [ in>> ] [ out>> ] bi ; inline
+
 : ?terminated ( out -- out terminated? )
     dup { "*" } = [ drop { } t ] [ f ] if ;
 

diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 8cebd36ec3b2763c716c2ea5984fa5e2b3c4b032..ce5291fe9cbd5602e736ee9c447e65661aab8e60 100644 (file)
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -568,7 +568,7 @@ HELP: all?
 { $values { "seq" sequence } { "quot" { $quotation ( ... elt -- ... ? ) } } { "?" boolean } }
 { $description "Tests if all elements in the sequence satisfy the predicate by checking each element in turn. Given an empty sequence, vacuously outputs " { $link t } "." } ;
 
-HELP: push-if
+HELP: push-when
 { $values { "elt" object } { "quot" { $quotation ( ..a elt -- ..b ? ) } } { "accum" "a resizable mutable sequence" } }
 { $description "Adds the element at the end of the sequence if the quotation yields a true value." }
 { $notes "This word is a factor of " { $link filter } "." } ;
@@ -696,7 +696,7 @@ HELP: replace-slice
 { $description "Replaces a range of elements beginning at index " { $snippet "from" } " and ending before index " { $snippet "to" } " with a new sequence." }
 { $errors "Throws an error if " { $snippet "new" } " contains elements whose types are not permissible in " { $snippet "seq" } "." } ;
 
-{ push push-either push-if pop pop* prefix suffix suffix! } related-words
+{ push push-either push-when pop pop* prefix suffix suffix! } related-words
 
 HELP: suffix
 { $values { "seq" sequence } { "elt" object } { "newseq" sequence } }

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index d7d7904745c26e0766614eca0b104a48bade4a8d..9610d4cd33c094810de0c2d6ad5487713111bcb7 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -15,6 +15,12 @@ GENERIC: new-resizable ( len seq -- newseq ) flushable
 GENERIC: like ( seq exemplar -- newseq ) flushable
 GENERIC: clone-like ( seq exemplar -- newseq ) flushable
 
+: new-sequence-like ( len-exemplar type-exemplar -- newseq )
+    [ length ] dip new-sequence ; inline
+
+: new-resizable-like ( len-exemplar type-exemplar -- newseq )
+    [ length ] dip new-resizable ; inline
+
 : new-like ( len exemplar quot -- seq )
     over [ [ new-sequence ] dip call ] dip like ; inline
 
@@ -26,6 +32,9 @@ GENERIC: shorten ( n seq -- )
 M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; inline
 M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline
 
+: 2length ( seq1 seq2 -- n1 n2 ) [ length ] bi@ ; inline
+: 3length ( seq1 seq2 seq3 -- n1 n2 n3 ) [ length ] tri@ ; inline
+
 : empty? ( seq -- ? ) length 0 = ; inline
 
 : if-empty ( ..a seq quot1: ( ..a -- ..b ) quot2: ( ..a seq -- ..b ) -- ..b )
@@ -355,7 +364,7 @@ PRIVATE>
 : copy ( src i dst -- ) check-copy copy-unsafe ; inline
 
 M: sequence clone-like
-    [ dup length ] dip new-sequence [ 0 swap copy-unsafe ] keep ; inline
+    dupd new-sequence-like [ 0 swap copy-unsafe ] keep ; inline
 
 M: immutable-sequence clone-like like ; inline
 
@@ -371,7 +380,7 @@ M: immutable-sequence clone-like like ; inline
 PRIVATE>
 
 : append-as ( seq1 seq2 exemplar -- newseq )
-    [ 2dup [ length ] bi@ + ] dip
+    [ 2dup 2length + ] dip
     [ (append) ] new-like ; inline
 
 : append ( seq1 seq2 -- newseq ) over append-as ;
@@ -381,8 +390,8 @@ PRIVATE>
 : prepend ( seq1 seq2 -- newseq ) over prepend-as ;
 
 : 3append-as ( seq1 seq2 seq3 exemplar -- newseq )
-    [ 3dup [ length ] tri@ + + ] dip [
-        [ [ 2over [ length ] bi@ + ] dip copy-unsafe ]
+    [ 3dup 3length + + ] dip [
+        [ [ 2over 2length + ] dip copy-unsafe ]
         [ (append) ] bi
     ] new-like ; inline
 
@@ -587,13 +596,19 @@ PRIVATE>
 : all? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? )
     sequence-operator all-integers-from? ; inline
 
-: push-if ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
+: push-when ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
     [ keep ] dip rot [ push ] [ 2drop ] if ; inline
 
+: keep-push-when ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
+    [ keep ] dip rot [ push ] [ 2drop ] if ; inline
+
+: call-push-when ( ..a elt quot: ( ..a elt -- ..b elt' ? ) accum -- ..b )
+    [ call ] dip swap [ push ] [ 2drop ] if ; inline
+
 <PRIVATE
 
 : (selector-as) ( quot length exemplar -- selector accum )
-    new-resizable [ [ push-if ] 2curry ] keep ; inline
+    new-resizable [ [ push-when ] 2curry ] keep ; inline
 
 PRIVATE>
 
@@ -625,10 +640,10 @@ PRIVATE>
     over [ 2selector [ each ] 2dip ] dip [ like ] curry bi@ ; inline
 
 : collector-for-as ( seq quot exemplar -- seq quot' vec )
-    [ over length ] dip new-resizable [ [ push ] curry compose ] keep ; inline
+    overd new-resizable-like [ [ push ] curry compose ] keep ; inline
 
 : collector-as ( quot exemplar -- quot' vec )
-    [ length ] keep new-resizable [ [ push ] curry compose ] keep ; inline
+    dup new-resizable-like [ [ push ] curry compose ] keep ; inline
 
 : collector-for ( seq quot -- seq quot' vec )
     V{ } collector-for-as ; inline

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 770a3aafff8b46cb1e2c4340ef726159b7c9e159..d447e30374a8e38e8cdfb6215bce25ea1b456fc5 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -725,7 +725,7 @@ PRIVATE>
 
 : extract! ( ... seq quot: ( ... elt -- ... ? ) -- ... seq )
     [ dup ] compose over [ length ] keep new-resizable
-    [ [ push-if ] 2curry reject! ] keep swap like ; inline
+    [ [ push-when ] 2curry reject! ] keep swap like ; inline
 
 : find-pred-loop ( ... i n seq quot: ( ... elt -- ... calc ? ) -- ... calc/f i/f elt/f )
     2pick < [