]> gitweb.factorcode.org Git - factor.git/commitdiff
stack-as-data: Add combinators that use the stack as a data structure.
authorDoug Coleman <doug.coleman@gmail.com>
Wed, 22 Jun 2022 19:57:50 +0000 (14:57 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Wed, 22 Jun 2022 20:04:59 +0000 (15:04 -0500)
extra/stack-as-data/authors.txt [new file with mode: 0644]
extra/stack-as-data/stack-as-data-tests.factor [new file with mode: 0644]
extra/stack-as-data/stack-as-data.factor [new file with mode: 0644]

diff --git a/extra/stack-as-data/authors.txt b/extra/stack-as-data/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/extra/stack-as-data/stack-as-data-tests.factor b/extra/stack-as-data/stack-as-data-tests.factor
new file mode 100644 (file)
index 0000000..b8bb3a7
--- /dev/null
@@ -0,0 +1,23 @@
+! Copyright (C) 2022 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: math stack-as-data tools.test ;
+IN: stack-as-data.tests
+
+{ V{ 6 8 } }
+[
+    5 6 7 8
+    4 [ even? ] stack-filter
+] unit-test
+
+
+{ 25 36 49 64 }
+[
+    5 6 7 8
+    4 [ sq ] stack-map
+] unit-test
+
+
+{ 10 20 30 50 40 } [ 10 20 30 40 50  0 1 stack-exchange ] unit-test
+{ 20 10 30 40 50 } [ 10 20 30 40 50  4 3 stack-exchange ] unit-test
+{ 20 10 30 40 50 } [ 10 20 30 40 50  3 4 stack-exchange ] unit-test
+{ 10 20 30 40 50 } [ 10 20 30 40 50  0 0 stack-exchange ] unit-test
\ No newline at end of file
diff --git a/extra/stack-as-data/stack-as-data.factor b/extra/stack-as-data/stack-as-data.factor
new file mode 100644 (file)
index 0000000..c933c51
--- /dev/null
@@ -0,0 +1,23 @@
+! Copyright (C) 2022 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators generalizations kernel math sequences ;
+IN: stack-as-data
+
+MACRO: stack-nth ( n -- quot )
+    [ '[ 1 _ ndupd ] ]
+    [ 1 + '[ _ nrot ] ] bi
+    '[ @ @ ] ;
+
+: stack-set-nth ( obj n -- quot )
+    [ '[ drop _ ] ] dip ndip ; inline
+
+: stack-exchange ( m n -- quot )
+    [ [ stack-nth ] [ '[ _ stack-nth ] dip ] bi* ] 2keep
+    swapd
+    [ stack-set-nth ] 2dip stack-set-nth ;
+
+: stack-filter ( n quot: ( obj -- ? ) -- quot' )
+    selector [ '[ _ ] replicate spread ] dip ; inline
+
+: stack-map ( n quot: ( obj -- obj' ) -- quot' )
+    '[ _ ] replicate spread ; inline