combinators.extras: add quad, 2quad

diff --git a/extra/combinators/extras/extras-tests.factor b/extra/combinators/extras/extras-tests.factor
index 9e96a3a64b374834c832e2b2459d41eb73e857ed..34c7ede3643c8c1e716d53ddd53732e7291884c4 100644 (file)
--- a/extra/combinators/extras/extras-tests.factor
+++ b/extra/combinators/extras/extras-tests.factor
@@ -187,4 +187,6 @@ 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
+{ t } [ int [ c-type-name? ] [ lookup-c-type ] 1check-when c-type? ] unit-test
+
+{ 111 112 113 114 } [ 10 100 [ 1 + + ] [ 2  + + ] [ 3 + + ] [ 4 + + ] 2quad ] unit-test

diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor
index e0b81ccefabb91692a69cfb0de56604e90070793..32d3c1987a051f1ff9d0946e8fb1979f2e7504e4 100644 (file)
--- a/extra/combinators/extras/extras.factor
+++ b/extra/combinators/extras/extras.factor
@@ -54,6 +54,10 @@ MACRO: cleave-array ( quots -- quot )
 : 4quad ( w x y z  p q r s -- )
     [ [ [ 4keep ] dip 4keep ] dip 4keep ] dip call ; inline
 
+: quad ( x p q r s -- ) [ [ [ keep ] dip keep ] dip keep ] dip call ; inline
+
+: 2quad ( x y p q r s -- ) [ [ [ 2keep ] dip 2keep ] dip 2keep ] dip call ; inline
+
 : quad* ( w x y z p q r s -- ) [ [ [ 3dip ] dip 2dip ] dip dip ] dip call ; inline
 
 : quad@ ( w x y z quot -- ) dup dup dup quad* ; inline