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

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 '[ _ ] ;

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

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