summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-04-18 07:35:24 -0400
committerDavid Thompson <dthompson2@worcester.edu>2023-04-18 07:35:24 -0400
commitb593d7fa1a3d918bf0ba69d6c98bfd38f9152106 (patch)
tree4164830c28197b02b955eb59570946aa6df05511
parentbf197407cb485f0887b017b1c897c228afc22b8b (diff)
Add <pushdown-state> class.
-rw-r--r--Makefile.am1
-rw-r--r--catbird/pushdown.scm42
2 files changed, 43 insertions, 0 deletions
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))))