combinators.extras, generalizations:: Add experimental combinators for 1res, 1arg.

diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 91b42d5a833611f2d7ee7ad411a9349f3607e862..1513c3d5802c7c7c018cfcd4c3fcf89e43445368 100644 (file)
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -127,3 +127,6 @@ MACRO: nweave ( n -- quot )
 
 : nbi-curry ( n -- )
     [ bi-curry ] swap call-n ; inline
+
+MACRO: map-compose ( quots quot -- quot' )
+    '[ _ compose ] map '[ _ ] ;
\ No newline at end of file

diff --git a/extra/combinators/extras/extras-tests.factor b/extra/combinators/extras/extras-tests.factor
index 2d24a901cd4eb360d56748fc2efb16e694bd4b7a..51019a4b7ef782c3d4549809574ef7647cfc2d4c 100644 (file)
--- a/extra/combinators/extras/extras-tests.factor
+++ b/extra/combinators/extras/extras-tests.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2013 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math tools.test combinators.extras sequences ;
+USING: combinators.extras io.files kernel math sequences
+tools.test ;
 IN: combinators.extras.tests
 
 { "a b" }
@@ -32,3 +33,20 @@ IN: combinators.extras.tests
 
 { "1" "123" } [ "1" "123" [ length ] [ > ] swap-when ] unit-test
 { "123" "1" } [ "1" "123" [ length ] [ < ] swap-when ] unit-test
+
+
+{ t } [ "resource:" [ exists? ] 1arg >boolean ] unit-test
+{ f } [ f [ exists? ] 1arg ] unit-test
+{ f } [ "/homeasdfasdf123123" [ exists? ] 1arg ] unit-test
+
+
+
+
+{ f f } [ f f 2 n-falsify ] unit-test
+{ f f } [ 100 200 2 n-falsify ] unit-test
+
+{ f f } [ 100 f f  2 n-falsify-unless ] unit-test
+{ f f } [ 100 200 f  2 n-falsify-unless ] unit-test
+
+{ 100 f } [ 100 f t  2 n-falsify-unless ] unit-test
+{ 100 200 } [ 100 200 t  2 n-falsify-unless ] unit-test
\ No newline at end of file

diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor
index afc7296f7eb2c7982b64b278d2f2b52fe658bdc8..4cb162e439d94f89d88fbb241648df6a20d05fe1 100644 (file)
--- a/extra/combinators/extras/extras.factor
+++ b/extra/combinators/extras/extras.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2013 Doug Coleman, John Benediktsson.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays combinators combinators.smart fry generalizations
-kernel macros math quotations sequences
+kernel macros math quotations sequences locals math.order
 sequences.generalizations sequences.private system ;
 IN: combinators.extras
 
@@ -57,3 +57,34 @@ MACRO: smart-plox ( true -- quot )
 
 : swap-when ( x y quot: ( x -- n ) quot: ( n n -- ? ) -- x' y' )
     '[ _ _ 2dup _ bi@ @ [ swap ] when ] call ; inline
+
+
+! ?1arg-result-falsify
+
+: 1falsify ( obj/f -- obj/f ) ; inline
+: 2falsify ( obj1 obj2 -- obj1/f obj2/f ) 2dup and [ 2drop f f ] unless ; inline
+: 3falsify ( obj1 obj2 obj3 -- obj1/f obj2/f obj3/f ) 3dup and and [ 3drop f f f ] unless ; inline
+
+MACRO: n-and ( n -- quot )
+    1 [-] [ and ] n*quot ;
+
+MACRO: n*obj ( n obj -- quot )
+    1quotation n*quot ;
+
+MACRO:: n-falsify ( n -- quot )
+    [ n ndup n n-and [ n ndrop n f n*obj ] unless ] ;
+
+! plox
+: ?1res ( ..a obj/f quot -- ..b )
+    dupd when ; inline
+
+! when both args are true, call quot. otherwise dont
+: ?2res ( ..a obj1 obj2 quot: ( obj1 obj2 -- ? ) -- ..b )
+    [ 2dup and ] dip [ 2drop f ] if ; inline
+
+! try the quot, keep the original arg if quot is true
+: ?1arg ( obj quot: ( obj -- ? ) -- obj/f )
+    [ ?1res ] 2keep drop '[ _ ] [ f ] if ; inline
+
+: ?2arg ( obj1 obj2 quot: ( obj1 obj2 -- ? ) -- obj1/f obj2/f )
+    [ ?2res ] 3keep drop '[ _ _ ] [ f f ] if ; inline