Implement 3.23 deque

ex-3_21-23.scm

@@ -99,12 +99,103 @@
 ; using pairs, and give implementations of the operations.23 All operations
 ; should be accomplished in (1) steps.
 
-; make-deque
+(define (front-ptr deque) (car deque))
-; empty-deque?
+(define (rear-ptr deque) (cdr deque))
-; front-deque
+(define (set-front-ptr! queue item) (set-car! queue item))
-; rear-deque
+(define (set-rear-ptr! queue item) (set-cdr! queue item))
-; front-insert-deque!
+
-; rear-insert-deque!
+(define (make-deque) (cons '() '()))
-; front-delete-deque!
+(define (empty-deque? deque) (null? (front-ptr deque)))
-; rear-delete-deque!
+
+(define (make-node item prev-ptr next-ptr)
+  (cons item (cons prev-ptr next-ptr)))
+
+(define (set-prev-node! node prev-ptr)
+  (set-car! (cdr node) prev-ptr))
+
+(define (set-next-node! node next-ptr)
+  (set-cdr! (cdr node) next-ptr))
+
+(define (prev-node node) (car (cdr node)))
+(define (next-node node) (cdr (cdr node)))
+
+(define (display-deque deque)
+  (define (iter-nodes node)
+    (if (null? node)
+      'done
+      (begin
+        (display (car node))
+        (if (null? (next-node node))
+          'do-nothing
+          (display ", "))
+        (iter-nodes (next-node node)))))
+  (display "[")
+  (iter-nodes (front-ptr deque))
+  (display "]\n"))
+
+(define (front-deque deque)
+  (if (empty-deque? deque)
+    (error "FRONT called with an empty deque")
+    (car (front-ptr deque))))
+
+(define (rear-deque deque)
+  (if (empty-deque? deque)
+    (error "REAR called with an empty deque")
+    (car (rear-ptr deque))))
+
+(define (front-insert-deque! deque item)
+  (let ((new-node (make-node item '() '())))
+    (cond ((empty-deque? deque)
+           (set-front-ptr! deque new-node)
+           (set-rear-ptr! deque new-node)
+           deque)
+          (else
+            (set-next-node! new-node (front-ptr deque))
+            (set-prev-node! (front-ptr deque) new-node)
+            (set-front-ptr! deque new-node)
+            deque))))
+
+(define (rear-insert-deque! deque item)
+  (let ((new-node (make-node item '() '())))
+    (cond ((empty-deque? deque)
+           (set-front-ptr! deque new-node)
+           (set-rear-ptr! deque new-node)
+           deque)
+          (else
+            (set-prev-node! new-node (rear-ptr deque))
+            (set-next-node! (rear-ptr deque) new-node)
+            (set-rear-ptr! deque new-node)
+            deque))))
+
+(define (front-delete-deque! deque)
+  (cond ((empty-deque? deque)
+         (error "DELETE! called with an empty deque" deque))
+        (else
+         (set-front-ptr! deque (next-node (front-ptr deque)))
+         (set-prev-node! (front-ptr deque) '())
+         deque)))
+
+(define (rear-delete-deque! deque)
+  (cond ((empty-deque? deque)
+         (error "DELETE! called with an empty deque" deque))
+        (else
+         (set-rear-ptr! deque (prev-node (rear-ptr deque)))
+         (set-next-node! (rear-ptr deque) '())
+         deque)))
+
+
+(define d (make-deque))
+(front-insert-deque! d 3)
+(rear-insert-deque! d 4)
+(front-insert-deque! d 2)
+(rear-insert-deque! d 5)
+(front-insert-deque! d 1)
+(rear-insert-deque! d 6)
+(display-deque d)
+
+(front-delete-deque! d)
+(rear-delete-deque! d)
+(front-delete-deque! d)
+(rear-delete-deque! d)
+(display-deque d)