tisp

commit 7dede16ec434289726bade845f1e10b2ae681a9f
parent 9999dbbba7e3594c099d442834d4a2b38aa4fc9f
Author: Ed van Bruggen <edvb@uw.edu>
Date:   Sat, 26 Oct 2019 13:53:54 -0700

Add functional stacks procedures

Diffstat:
test.c
 | 
9
+++++++++
tibs/lib.tsp
 | 
13
+++++++++++++

2 files changed, 22 insertions(+), 0 deletions(-)
diff --git a/test.c b/test.c
@@ -301,6 +301,15 @@ char *tests[][2] = {
 	{ "(member \"quux\" (list 4.2 3 'quux))",           "()"                             },
 	{ "(member 'qux '(foo bar baz))",                   "()"                             },
 
+	{ "stack",                                   NULL                   },
+	{ "(peek '(1 2 3 4 5 6))",                   "1"                    },
+	{ "(peek (list 'a 'b 'c))",                  "a"                    },
+	{ "(pop (list 1/2 1/4))",                    "(1/4)"                },
+	{ "(pop '(\"foo\" \"bar\" \"baz\"))",        "(\"bar\" \"baz\")"    },
+	{ "(push '(6 3 5/3 .38) .5)",                "(0.5 6 3 5/3 0.38)"   },
+	{ "(push (list \"ni\" 'shrubbery) (* 3 2))", "(6 \"ni\" shrubbery)" },
+	{ "(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)"   },
 
 	{ "numbers",            NULL   },
 	{ "(decimal 1/2)",      "0.5"  },
diff --git a/tibs/lib.tsp b/tibs/lib.tsp
@@ -152,6 +152,19 @@
 (define (member mem lst)
   (memp (lambda (x) (= mem x)) lst))
 
+;;; Stacks
+(define (push stack val)
+  (cons val stack))
+
+(define pop cdr)
+
+(define peek car)
+
+(define (swap stack)
+  (let ((x (peek stack))
+        (y (peek (pop stack))))
+    (push (push (pop (pop stack)) x) y)))
+
 ;;; Math
 (define pi (* 4 (arctan 1.)))
 (define tau (* 2 pi))