1 665c255d 2023-08-04 jrmu (defun make-deque ()
 2 665c255d 2023-08-04 jrmu   (cons '() '()))
 3 665c255d 2023-08-04 jrmu (defun front-ptr (deque)
 4 665c255d 2023-08-04 jrmu   (car deque))
 5 665c255d 2023-08-04 jrmu (defun rear-ptr (deque)
 6 665c255d 2023-08-04 jrmu   (cdr deque))
 7 665c255d 2023-08-04 jrmu (defun set-front-ptr! (deque item)
 8 665c255d 2023-08-04 jrmu   (setf (car deque) item))
 9 665c255d 2023-08-04 jrmu (defun set-rear-ptr! (deque item)
10 665c255d 2023-08-04 jrmu   (setf (cdr deque) item))
11 665c255d 2023-08-04 jrmu (defun empty-deque? (deque)
12 665c255d 2023-08-04 jrmu   (null (front-ptr deque)))
13 665c255d 2023-08-04 jrmu (defun front-deque (deque)
14 665c255d 2023-08-04 jrmu   (if (empty-deque? deque)
15 665c255d 2023-08-04 jrmu       (error "FRONT on empty deque")
16 665c255d 2023-08-04 jrmu       (caar (front-ptr deque))))
17 665c255d 2023-08-04 jrmu (defun rear-deque (deque)
18 665c255d 2023-08-04 jrmu   (if (empty-deque? deque)
19 665c255d 2023-08-04 jrmu       (error "REAR on empty deque")
20 665c255d 2023-08-04 jrmu       (caar (rear-ptr deque))))
21 665c255d 2023-08-04 jrmu (defun front-insert-deque! (deque item)
22 665c255d 2023-08-04 jrmu   (let ((new-pair (cons (cons item '()) '())))
23 665c255d 2023-08-04 jrmu     (cond ((empty-deque? deque)
24 665c255d 2023-08-04 jrmu 	   (set-front-ptr! deque new-pair)
25 665c255d 2023-08-04 jrmu 	   (set-rear-ptr! deque new-pair)
26 665c255d 2023-08-04 jrmu 	   deque)
27 665c255d 2023-08-04 jrmu 	  (t
28 665c255d 2023-08-04 jrmu 	   (setf (cdr new-pair) (front-ptr deque))
29 665c255d 2023-08-04 jrmu 	   (setf (cdar (front-ptr deque)) new-pair)
30 665c255d 2023-08-04 jrmu 	   (set-front-ptr! deque new-pair)
31 665c255d 2023-08-04 jrmu 	   deque))))
32 665c255d 2023-08-04 jrmu (defun rear-insert-deque! (deque item)
33 665c255d 2023-08-04 jrmu   (let ((new-pair (cons (cons item (rear-ptr deque)) '())))
34 665c255d 2023-08-04 jrmu     (cond ((empty-deque? deque)
35 665c255d 2023-08-04 jrmu 	   (set-front-ptr! deque new-pair)
36 665c255d 2023-08-04 jrmu 	   (set-rear-ptr! deque new-pair)
37 665c255d 2023-08-04 jrmu 	   deque)
38 665c255d 2023-08-04 jrmu 	  (t
39 665c255d 2023-08-04 jrmu 	   (setf (cdr (rear-ptr deque)) new-pair)
40 665c255d 2023-08-04 jrmu 	   (set-rear-ptr! deque new-pair)
41 665c255d 2023-08-04 jrmu 	   deque))))
42 665c255d 2023-08-04 jrmu (defun front-delete-deque! (deque)
43 665c255d 2023-08-04 jrmu   (cond ((empty-deque? deque)
44 665c255d 2023-08-04 jrmu 	 (error "FRONT-DELETE on empty deque"))
45 665c255d 2023-08-04 jrmu 	(t
46 665c255d 2023-08-04 jrmu 	 (set-front-ptr!
47 665c255d 2023-08-04 jrmu 	  deque
48 665c255d 2023-08-04 jrmu 	  (cdr (front-ptr deque)))
49 665c255d 2023-08-04 jrmu 	 deque)))
50 665c255d 2023-08-04 jrmu (defun rear-delete-deque! (deque)
51 665c255d 2023-08-04 jrmu   (cond ((empty-deque? deque)
52 665c255d 2023-08-04 jrmu 	 (error "REAR-DELETE on empty deque"))
53 665c255d 2023-08-04 jrmu 	(t
54 665c255d 2023-08-04 jrmu 	 (set-rear-ptr! deque (cdar (rear-ptr deque)))
55 665c255d 2023-08-04 jrmu 	 (setf (cdr (rear-ptr deque)) '())
56 665c255d 2023-08-04 jrmu 	 deque)))
57 665c255d 2023-08-04 jrmu (defun print-deque (deque)
58 665c255d 2023-08-04 jrmu   (format t "(")
59 665c255d 2023-08-04 jrmu   (mapcar (lambda (e)
60 665c255d 2023-08-04 jrmu 	    (format t "~a " (car e)))
61 665c255d 2023-08-04 jrmu 	  (front-ptr deque))
62 665c255d 2023-08-04 jrmu   (format t ")"))