blob: 71f7c0ec7ab134d2f0a27a34712b22991bb989f6 (
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
43
44
45
46
47
48
49
50
51
52
|
;;;; Simple stack&queue Abstraction
(declare (usual-integrations))
(define-record-type <stack&queue>
(%make-stack&queue front back)
stack&queue?
(front stack&queue-front set-stack&queue-front!)
(back stack&queue-back set-stack&queue-back!))
(define (make-stack&queue)
(%make-stack&queue '() '()))
(define (stack&queue-empty? stq)
(not (pair? (stack&queue-front stq))))
(define (stack&queued? stq item)
(memq item (stack&queue-front stq)))
(define (push! stq object)
(if (pair? (stack&queue-front stq))
(set-stack&queue-front! stq
(cons object (stack&queue-front stq)))
(begin
(set-stack&queue-front! stq
(cons object (stack&queue-front stq)))
(set-stack&queue-back! stq
(stack&queue-front stq))))
unspecific)
(define (add-to-end! stq object)
(let ((new (cons object '())))
(if (pair? (stack&queue-back stq))
(set-cdr! (stack&queue-back stq) new)
(set-stack&queue-front! stq new))
(set-stack&queue-back! stq new)
unspecific))
(define (pop! stq)
(let ((next (stack&queue-front stq)))
(if (not (pair? next))
(error "Empty stack&queue -- POP"))
(if (pair? (cdr next))
(set-stack&queue-front! stq (cdr next))
(begin
(set-stack&queue-front! stq '())
(set-stack&queue-back! stq '())))
(car next)))
|
