tisp

commit bcb6d965aa4260f852e10921db1e989722a0f90e
parent 2d5a84c1edd7cb59198bd65723922c28e456072f
Author: Ed van Bruggen <edvb@uw.edu>
Date:   Mon, 28 Oct 2019 11:57:25 -0700

Add mutable stack functions

Diffstat:
test.c
 | 
16
++++++++++++++++
tibs/lib.tsp
 | 
19
+++++++++++++++++++

2 files changed, 35 insertions(+), 0 deletions(-)
diff --git a/test.c b/test.c
@@ -311,6 +311,22 @@ char *tests[][2] = {
 	{ "(swap '(1 2 3 5 7 11))",                  "(2 1 3 5 7 11)"       },
 	{ "(swap (list 1/2 1/4 1/9 1/16))",          "(1/4 1/2 1/9 1/16)"   },
 
+	{ "stack!",                  NULL               },
+	{ "(define s '(1 2 3 4 5))", ""                 },
+	{ "(peek s)",                "1"                },
+	{ "(pop! s)",                "1"                },
+	{ "s",                       "(2 3 4 5)"        },
+	{ "(pop! s)",                "2"                },
+	{ "s",                       "(3 4 5)"          },
+	{ "(push! s 3/2)",           "(3/2 3 4 5)"      },
+	{ "s",                       "(3/2 3 4 5)"      },
+	{ "(push! s (- (/ 2)))",     "(-1/2 3/2 3 4 5)" },
+	{ "s",                       "(-1/2 3/2 3 4 5)" },
+	{ "(swap! s)",               "(3/2 -1/2 3 4 5)" },
+	{ "s",                       "(3/2 -1/2 3 4 5)" },
+	{ "(swap! s)",               "(-1/2 3/2 3 4 5)" },
+	{ "s",                       "(-1/2 3/2 3 4 5)" },
+
 	{ "numbers",            NULL   },
 	{ "(decimal 1/2)",      "0.5"  },
 	{ "(decimal 3/-2)",     "-1.5" },
diff --git a/tibs/lib.tsp b/tibs/lib.tsp
@@ -158,8 +158,20 @@
 (define (push stack val)
   (cons val stack))
 
+(define push!
+  (macro (stack val)
+         (list do
+               (list set! stack (list push stack val))
+               stack)))
+
 (define pop cdr)
 
+(define pop!
+  (macro (stack)
+         (list do0
+               (list peek stack)
+               (list set! stack (list pop stack)))))
+
 (define peek car)
 
 (define (swap stack)
@@ -167,6 +179,13 @@
         (y (peek (pop stack))))
     (push (push (pop (pop stack)) x) y)))
 
+(define swap!
+  (macro (stack)
+         (list let (list (list 'x (list pop! stack))
+                         (list 'y (list pop! stack)))
+               (list set! stack (list push (list push stack 'x) 'y))
+               stack)))
+
 ;;; Math
 (define pi (* 4 (arctan 1.)))
 (define tau (* 2 pi))