From b593d7fa1a3d918bf0ba69d6c98bfd38f9152106 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 18 Apr 2023 07:35:24 -0400
Subject: Add <pushdown-state> class.

---
 Makefile.am          |  1 +
 catbird/pushdown.scm | 42 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+)
 create mode 100644 catbird/pushdown.scm

diff --git a/Makefile.am b/Makefile.am
index baf499c..046439f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -43,6 +43,7 @@ SOURCES = 					\
   catbird/inotify.scm				\
   catbird/ring-buffer.scm			\
   catbird/mixins.scm				\
+  catbird/pushdown.scm				\
   catbird/cached-slots.scm			\
   catbird/observer.scm				\
   catbird/asset.scm				\
diff --git a/catbird/pushdown.scm b/catbird/pushdown.scm
new file mode 100644
index 0000000..3d68157
--- /dev/null
+++ b/catbird/pushdown.scm
@@ -0,0 +1,42 @@
+(define-module (catbird pushdown)
+  #:use-module (chickadee data array-list)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:export (<pushdown-state>
+            make-pushdown-state
+            state-current
+            state-previous
+            state-push!
+            state-pop!
+            state-replace!))
+
+(define-class <pushdown-state> ()
+  (state-stack #:accessor state-stack #:init-form (make-array-list 2)))
+
+(define (make-pushdown-state)
+  (make <pushdown-state>))
+
+(define-method (state-current (state <pushdown-state>))
+  (let ((stack (state-stack state)))
+    (if (array-list-empty? stack)
+        #f
+        (array-list-ref stack (- (array-list-size stack) 1)))))
+
+(define-method (state-previous (state <pushdown-state>))
+  (let* ((stack (state-stack state))
+         (n (array-list-size stack)))
+    (if (< n 2)
+        #f
+        (array-list-ref stack (- n 2)))))
+
+(define-method (state-push! (state <pushdown-state>) obj)
+  (array-list-push! (state-stack state) obj))
+
+(define-method (state-pop! (state <pushdown-state>))
+  (array-list-pop! (state-stack state)))
+
+(define-method (state-replace! (state <pushdown-state>) obj)
+  (let ((stack (state-stack state)))
+    (if (array-list-empty? stack)
+        (array-list-push! stack obj)
+        (array-list-set! stack (- (array-list-size stack) 1) obj))))
-- 
cgit v1.2.3