]> gitweb.factorcode.org Git - factor.git/blobdiff - core/sequences/sequences.factor
Move match to basis since compiler.tree.debugger uses it, fix conflict
[factor.git] / core / sequences / sequences.factor
index 5ab3e59284e3dbf45a4e3dabb60701546d66d43f..32671fc7f00a5991db9b778612a5c25be0136a83 100755 (executable)
@@ -28,6 +28,14 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ;
 M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
 
 : empty? ( seq -- ? ) length zero? ; inline
+
+: if-empty ( seq quot1 quot2 -- )
+    [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline
+
+: when-empty ( seq quot1 -- ) [ ] if-empty ; inline
+
+: unless-empty ( seq quot1 -- ) [ ] swap if-empty ; inline
+
 : delete-all ( seq -- ) 0 swap set-length ;
 
 : first ( seq -- first ) 0 swap nth ; inline
@@ -418,6 +426,15 @@ PRIVATE>
 : filter ( seq quot -- subseq )
     over >r pusher >r each r> r> like ; inline
 
+: push-either ( elt quot accum1 accum2 -- )
+    >r >r keep swap r> r> ? push ; inline
+
+: 2pusher ( quot -- quot accum1 accum2 )
+    V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline
+
+: partition ( seq quot -- trueseq falseseq )
+    over >r 2pusher >r >r each r> r> r> tuck [ like ] 2bi@ ; inline
+
 : monotonic? ( seq quot -- ? )
     >r dup length 1- swap r> (monotonic) all? ; inline
 
@@ -582,6 +599,9 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
     [ >r >r dup pick length + r> - over r> open-slice ] keep
     copy ;
 
+: remove-nth ( n seq -- seq' )
+    [ swap head-slice ] [ swap 1+ tail-slice ] 2bi append ;
+
 : pop ( seq -- elt )
     [ length 1- ] [ [ nth ] [ shorten ] 2bi ] bi ;
 
@@ -659,6 +679,9 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
 : cut-slice ( seq n -- before after )
     [ head-slice ] [ tail-slice ] 2bi ;
 
+: insert-nth ( elt n seq -- seq' )
+    swap cut-slice [ swap suffix ] dip append ;
+
 : midpoint@ ( seq -- n ) length 2/ ; inline
 
 : halves ( seq -- first second )