From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 26 Jan 2017 20:05:09 +0000 (-0800)
Subject: sequences.extras: experimenting with take-while and drop-while.
X-Git-Tag: unmaintained~220
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=a8a94c3960c3d40ce49bba6663782ebe5b5b75c4

sequences.extras: experimenting with take-while and drop-while.
---

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 28db9fb03f..8539c2ffce 100644
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -245,3 +245,8 @@ IN: sequences.extras.tests
 { }
 [ "test:" all-words [ name>> over prepend ] map-zip 2drop ] unit-test
 
+{ { 0 1 2 3 } } [ 8 iota [ 4 < ] take-while ] unit-test
+{ { } } [ { 15 16 } [ 4 < ] take-while ] unit-test
+
+{ { 4 5 6 7 } } [ 8 iota [ 4 < ] drop-while ] unit-test
+{ { 15 16 } } [ { 15 16 } [ 4 < ] drop-while ] unit-test
diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 8d2805473c..1092be46b7 100644
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -602,3 +602,9 @@ PRIVATE>
 
 : map-values ( assoc quot: ( value -- value' ) -- assoc )
     '[ swap _ dip swap ] assoc-map ; inline
+
+: take-while ( ... seq quot: ( ... elt -- ... ? ) -- head-slice )
+    [ '[ @ not ] find drop ] 2keep drop swap 0 or head-slice ; inline
+
+: drop-while ( ... seq quot: ( ... elt -- ... ? ) -- tail-slice )
+    [ '[ @ not ] find drop ] 2keep drop swap 0 or tail-slice ; inline