combinators.extras: trying to figure out a combinator that does `[ predicate? ] ...

diff --git a/extra/combinators/extras/extras-tests.factor b/extra/combinators/extras/extras-tests.factor
index 6a10620c8515b9f11123c3e1930c85321e9bf41b..9e96a3a64b374834c832e2b2459d41eb73e857ed 100644 (file)
--- a/extra/combinators/extras/extras-tests.factor
+++ b/extra/combinators/extras/extras-tests.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2013 Doug Coleman.
 ! See https://factorcode.org/license.txt for BSD license.
-USING: arrays assocs combinators.extras io.files kernel math
-modern.slices sequences splitting tools.test ;
+USING: alien.c-types arrays assocs combinators.extras io.files
+kernel math modern.slices sequences splitting tools.test ;
 IN: combinators.extras.tests
 
 
@@ -186,3 +186,5 @@ IN: combinators.extras.tests
 
 { 103 203 { { 1 1 } { 2 2 } { 3 3 } } }
 [ 100 200 { { 1 1 } { 2 2 } { 3 3 } } [ [ 1 + ] bi@ ] 2temp2d assoc-map ] unit-test
+
+{ t } [ int [ c-type-name? ] [ lookup-c-type ] 1check-when c-type? ] unit-test
\ No newline at end of file

diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor
index 8e1f312042cd58a6da971fa4bde81685883b078e..0e4338ce834be1e3c6cf856492f7645ef6ec12e4 100644 (file)
--- a/extra/combinators/extras/extras.factor
+++ b/extra/combinators/extras/extras.factor
@@ -209,3 +209,11 @@ MACRO: 4keep-under ( quot -- quot' )
 
 : closure-limit ( vertex quot: ( vertex -- edges ) n -- set )
     HS{ } closure-limit-as ; inline
+
+: 1check ( obj quot -- obj ? ) over [ call ] dip swap ; inline
+: 2check ( obj1 obj2 quot -- obj ? ) 2over [ call ] 2dip rot ; inline
+
+: 1check-when ( ..a obj cond: ( ..a obj -- obj/f ) true: ( ..a obj cond -- ..b ) -- ..b )
+    [ 1check ] dip when ; inline
+: 2check-when ( ..a obj1 obj2 cond: ( ..a obj1 obj2 -- obj/f ) true: ( ..a obj1 obj2 cond -- ..b ) -- ..b )
+    [ 2check ] dip when ; inline