The Deque exercise from SICP, Chapter 3, section 3.3

deque.scm

; This is the "Write a Deque" exercise from SICP, section 3.3.
; 
; It took me THREE DAYS to get this right, and in the end, you know what
; really made the difference?  Doing it on paper.  Once I'd written out
; all the actions and in text described what I intended to do, this took
; less than an hour to put together.
; 
; This is my lesson: ALWAYS, ALWAYS, ALWAYS describe the algorithm, no
; matter how simple, on paper first. ALWAYS explain it to your rubber
; duck first: https://selftaughtcoders.com/rubber-duck-debugging/
; 
; On the other hand, grief, how I wish I had types to help me along the
; way. Lisp is still SO 1959 in a lot of ways.
;
; If you run this, I recommend the following command line:
;
; cat deque.scm | mit-scheme --batch-mode
;
; The 'batch mode' flag is necessary, as the definition for a deque is
; highly circular, and sincemit-scheme prints each new definition by
; default that would result in a maximum recursion depth error.

; A deque header consists of two pointers, one to the head, one to the tail
(define (make-deque) (cons '() '()))

; getters
(define (deque-get-head deque) (car deque))
(define (deque-get-tail deque) (cdr deque))

; setters
(define (deque-set-head! deque item) (set-car! deque item))
(define (deque-set-tail! deque item) (set-cdr! deque item))

; The deque is empty when the head points at nothing.
(define (deque-empty? deque)
  (null? (deque-get-head deque)))

; A deque item is data and two pointers, one to <prev>, one to <next>
(define (deque-new-item item)
  (cons item (cons '() '())))

; Getting the data consists of getting the car of the item
(define deque-item-data car)

; Get the pointers to the next or previous items
(define (deque-item-next item) (cdr (cdr item)))
(define (deque-item-prev item) (car (cdr item)))

(define (deque-head deque)
  (if (deque-empty? deque)
      (error "head called on empty deque")
      (deque-item-data (deque-get-head deque))))

(define (deque-tail deque)
  (if (deque-empty? deque)
      (error "tail called on empty deque")
      (deque-item-data (deque-get-tail deque))))

(define (deque-set-item-prev! item ptr)
  (set-car! (cdr item) ptr))

(define (deque-set-item-next! item ptr)
  (set-cdr! (cdr item) ptr))

; Pushing an item onto the end.  If the deque is empty, create a new
; node and point the deque at it.  Otherwise, (1) set the item's
; <prev> pointed to the old tail, (2) set the old tail's <next> to the
; new item, and set the deque tail pointer to the new item.

(define (deque-tail-push! deque item)
  (let ((new-item (deque-new-item item)))
    (cond ((deque-empty? deque)
           (deque-set-head! deque new-item)
           (deque-set-tail! deque new-item))
          (else
           (deque-set-item-prev! new-item (deque-get-tail deque))
           (deque-set-item-next! (deque-get-tail deque) new-item)
           (deque-set-tail! deque new-item)))
    deque))

(define (deque-head-push! deque item)
  (let ((new-item (deque-new-item item)))
    (cond ((deque-empty? deque)
           (deque-set-head! deque new-item)
           (deque-set-tail! deque new-item))
          (else
           (deque-set-item-next! new-item (deque-get-head deque))
           (deque-set-item-prev! (deque-get-head deque) new-item)
           (deque-set-head! deque new-item)))
    deque))

(define (deque-head-pop! deque)
  (cond ((deque-empty? deque)
         (error "pop called on empty deque"))
        (else
         (deque-set-head! deque (deque-item-next (deque-get-head deque)))
         (deque-set-item-prev! (deque-get-head deque) '())))
  deque)

(define (deque-tail-pop! deque)
  (cond ((deque-empty? deque)
         (error "pop called on empty deque"))
        (else
         (deque-set-tail! deque (deque-item-prev (deque-get-tail deque)))
         (deque-set-item-next! (deque-get-tail deque) '())))
  deque)


(define (deque-print-deque deque)
  (define (deque-print-internal item)
    (display (deque-item-data item))
    (cond ((null? (deque-item-next item)) '())
          (else 
           (display " ")
           (deque-print-internal (deque-item-next item)))))
  (display "(")
  (deque-print-internal (deque-get-head deque))
  (display ")\n"))

; Some simple observable tests.

(define q1 (make-deque))
(set! q1 (deque-tail-push! q1 'a))
(deque-print-deque q1)
(set! q1 (deque-tail-push! q1 'b))
(deque-print-deque q1)
(set! q1 (deque-tail-push! q1 'c))
(deque-print-deque q1)
(set! q1 (deque-tail-push! q1 'd))
(deque-print-deque q1)
(deque-head-pop! q1)
(deque-print-deque q1)
(deque-tail-pop! q1)
(deque-print-deque q1)