/
queue.scm
69 lines (56 loc) · 1.63 KB
/
queue.scm
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
;;; A very simple first-in-last-out queue library. Right now the
;;; implementation is list-based and relies on set-car!/set-cdr!. All
;;; operations are constant time.
;;;
;;; Copyright (c) 2008 Per Eckerdal
(declare (block)
(mostly-fixnum)
(standard-bindings)
(extended-bindings))
(export make-queue
(rename: (q-size queue-size)
(q? queue?))
queue-push!
queue-pop!
queue-empty?
queue-empty!
queue-front)
(define-type q
id: F71EB1A0-828C-48D5-80C3-1CF3628012F9
data
(end-cons unprintable:)
(size unprintable:))
(define (make-end-cons)
(cons 'end '()))
(define no-value (list 'no-value))
(define (make-queue)
(let ((end-cons (make-end-cons)))
(make-q end-cons end-cons 0)))
(define (queue-push! q elm)
(let ((new-end-cons (make-end-cons))
(old-end-cons (q-end-cons q)))
(set-car! old-end-cons elm)
(set-cdr! old-end-cons new-end-cons)
(q-size-set! q (+ 1 (q-size q)))
(q-end-cons-set! q new-end-cons)))
(define (queue-pop! q)
(if (queue-empty? q)
(error "Queue is empty")
(let ((data (q-data q)))
(q-data-set! q (cdr data))
(q-size-set! q (- (q-size q) 1))
(car data))))
(define queue-size q-size)
(define (queue-empty? q)
(= 0 (q-size q)))
(define (queue-empty! q)
(q-size-set! q 0)
(let ((end-cons (make-end-cons)))
(q-data-set! q end-cons)
(q-end-cons-set! q end-cons)))
(define (queue-front q #!optional (default no-value))
(if (queue-empty? q)
(if (eq? default no-value)
(error "Queue is empty")
default)
(car (q-data q))))