1 665c255d 2023-08-04 jrmu (define (front-ptr deque) (car deque))
 2 665c255d 2023-08-04 jrmu (define (rear-ptr deque) (cdr deque))
 3 665c255d 2023-08-04 jrmu (define (set-front-ptr! deque item) (set-car! deque item))
 4 665c255d 2023-08-04 jrmu (define (set-rear-ptr! deque item) (set-cdr! deque item))
 5 665c255d 2023-08-04 jrmu 
 6 665c255d 2023-08-04 jrmu (define (make-deque) (cons '() '()))
 7 665c255d 2023-08-04 jrmu (define (empty-deque? deque)
 8 665c255d 2023-08-04 jrmu   (and (null? (front-ptr deque))
 9 665c255d 2023-08-04 jrmu        (null? (rear-ptr deque))))
10 665c255d 2023-08-04 jrmu (define (print-deque deque)
11 665c255d 2023-08-04 jrmu   (define (make-printable-list q)
12 665c255d 2023-08-04 jrmu     (if (null? q)
13 665c255d 2023-08-04 jrmu 	'()
14 665c255d 2023-08-04 jrmu 	(cons (car q)
15 665c255d 2023-08-04 jrmu 	      (make-printable-list (cddr q)))))
16 665c255d 2023-08-04 jrmu   (newline)
17 665c255d 2023-08-04 jrmu   (display (make-printable-list (front-ptr deque))))
18 665c255d 2023-08-04 jrmu (define (rear-insert-deque! deque item)
19 665c255d 2023-08-04 jrmu   (let ((new-pair (cons item (cons '() '()))))
20 665c255d 2023-08-04 jrmu     (cond ((empty-deque? deque)
21 665c255d 2023-08-04 jrmu 	   (set-front-ptr! deque new-pair)
22 665c255d 2023-08-04 jrmu 	   (set-rear-ptr! deque new-pair))
23 665c255d 2023-08-04 jrmu 	  (else
24 665c255d 2023-08-04 jrmu 	   (set-car! (cdr new-pair) (rear-ptr deque))
25 665c255d 2023-08-04 jrmu 	   (set-cdr! (cdr (rear-ptr deque)) new-pair)
26 665c255d 2023-08-04 jrmu 	   (set-rear-ptr! deque new-pair)))))
27 665c255d 2023-08-04 jrmu (define (front-insert-deque! deque item)
28 665c255d 2023-08-04 jrmu   (let ((new-pair (cons item (cons '() '()))))
29 665c255d 2023-08-04 jrmu     (cond ((empty-deque? deque)
30 665c255d 2023-08-04 jrmu 	   (set-front-ptr! deque new-pair)
31 665c255d 2023-08-04 jrmu 	   (set-rear-ptr! deque new-pair))
32 665c255d 2023-08-04 jrmu 	  (else
33 665c255d 2023-08-04 jrmu 	   (set-cdr! (cdr new-pair) (front-ptr deque))
34 665c255d 2023-08-04 jrmu 	   (set-car! (cdr (front-ptr deque)) new-pair)
35 665c255d 2023-08-04 jrmu 	   (set-front-ptr! deque new-pair)))))
36 665c255d 2023-08-04 jrmu (define (front-deque deque)
37 665c255d 2023-08-04 jrmu   (if (empty-deque? deque)
38 665c255d 2023-08-04 jrmu       (error "FRONT called with an empty deque" deque)
39 665c255d 2023-08-04 jrmu       (car (front-ptr deque))))
40 665c255d 2023-08-04 jrmu (define (rear-deque deque)
41 665c255d 2023-08-04 jrmu   (if (empty-deque? deque)
42 665c255d 2023-08-04 jrmu       (error "REAR called with an empty deque" deque)
43 665c255d 2023-08-04 jrmu       (car (rear-ptr deque))))
44 665c255d 2023-08-04 jrmu (define (front-delete-deque! deque)
45 665c255d 2023-08-04 jrmu   (cond ((empty-deque? deque)
46 665c255d 2023-08-04 jrmu 	 (error "FRONT-DELETE! called with an empty deque" deque))
47 665c255d 2023-08-04 jrmu 	((eq? (front-ptr deque) (rear-ptr deque))
48 665c255d 2023-08-04 jrmu 	 (set-front-ptr! deque '())
49 665c255d 2023-08-04 jrmu 	 (set-rear-ptr! deque '()))
50 665c255d 2023-08-04 jrmu 	(else
51 665c255d 2023-08-04 jrmu 	 (set-front-ptr! deque (cddr (front-ptr deque)))
52 665c255d 2023-08-04 jrmu 	 (set-car! (cdr (front-ptr deque)) '()))))
53 665c255d 2023-08-04 jrmu (define (rear-delete-deque! deque)
54 665c255d 2023-08-04 jrmu   (cond ((empty-deque? deque)
55 665c255d 2023-08-04 jrmu 	 (error "REAR-DELETE! called with an empty deque" deque))
56 665c255d 2023-08-04 jrmu 	((eq? (front-ptr deque) (rear-ptr deque))
57 665c255d 2023-08-04 jrmu 	 (set-front-ptr! deque '())
58 665c255d 2023-08-04 jrmu 	 (set-rear-ptr! deque '()))
59 665c255d 2023-08-04 jrmu 	(else
60 665c255d 2023-08-04 jrmu 	 (set-rear-ptr! deque (cadr (rear-ptr deque)))
61 665c255d 2023-08-04 jrmu 	 (set-cdr! (cdr (rear-ptr deque)) '()))))
62 665c255d 2023-08-04 jrmu 
63 665c255d 2023-08-04 jrmu