From 78584910552d5cfd435d29700721e3d4dd1dfbae Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 26 Feb 2023 16:02:33 -0600 Subject: [PATCH] combinators.extras: add quad, 2quad --- extra/combinators/extras/extras-tests.factor | 4 +++- extra/combinators/extras/extras.factor | 4 ++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/combinators/extras/extras-tests.factor b/extra/combinators/extras/extras-tests.factor index 9e96a3a64b..34c7ede364 100644 --- 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 e0b81ccefa..32d3c1987a 100644 --- 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 -- 2.34.1