diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | catbird/pushdown.scm | 42 |
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)))) |