From 04794fe71513c81e8f9a00dd0fdae2b22cfc2d89 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 6 Aug 2012 08:52:45 -0700 Subject: [PATCH] sequences.extras: adding "none?" and "one?". --- extra/sequences/extras/extras-tests.factor | 8 ++++++++ extra/sequences/extras/extras.factor | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor index 70c23a1896..47e8dc8709 100644 --- a/extra/sequences/extras/extras-tests.factor +++ b/extra/sequences/extras/extras-tests.factor @@ -100,3 +100,11 @@ IN: sequences.extras.tests { "" } [ "" "" "" unsurround ] unit-test { "" } [ " " " " " " unsurround ] unit-test { "foo.com" } [ "http://foo.com" "http://" "/" unsurround ] unit-test + +{ t } [ { 1 3 5 7 } [ even? ] none? ] unit-test +{ f } [ { 1 2 3 4 } [ even? ] none? ] unit-test +{ t } [ { } [ even? ] none? ] unit-test + +{ f } [ { 1 2 3 4 } [ even? ] one? ] unit-test +{ t } [ { 1 2 3 } [ even? ] one? ] unit-test +{ f } [ { } [ even? ] one? ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 9c2ab19083..6833ceed38 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -216,3 +216,11 @@ PRIVATE> : unsurround ( newseq seq2 seq3 -- seq1 ) [ ?head drop ] [ ?tail drop ] bi* ; + +: none? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? ) + any? not ; inline + +: one? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? ) + [ find ] 2keep rot [ + [ 1 + ] 2dip find-from drop not + ] [ 3drop f ] if ; inline