blob: 3d68157ff5c929a309e5cd8409bce053ab0dc33b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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))))
|
