summaryrefslogtreecommitdiff
path: root/catbird/pushdown.scm
diff options
context:
space:
mode:
Diffstat (limited to 'catbird/pushdown.scm')
-rw-r--r--catbird/pushdown.scm42
1 files changed, 42 insertions, 0 deletions
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))))