diff options
Diffstat (limited to 'catbird/pushdown.scm')
-rw-r--r-- | catbird/pushdown.scm | 42 |
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)))) |