#lang sicp

(define (front-ptr deque) (car deque))
(define (rear-ptr deque) (cdr deque))
(define (set-front-ptr! deque item) (set-car! deque item))
(define (set-rear-ptr! deque item) (set-cdr! deque item)) 

(define (make-deque-item prev data next)
  (list (lambda () prev) data next))
(define (item-prev item)
  ((car item)))
(define (item-data item)
  (cadr item))
(define (item-next item)
  (caddr item))
(define (item-set-prev! item prev)
  (set-car! item (lambda () prev)))
(define (item-set-next! item next)
  (set-cdr! (cdr item) (list next)))

(define (make-deque)
  (cons '() '()))

(define (empty-deque? deque) (null? (front-ptr deque)))

(define (deque->list d)
  (define (iter l)
    (if (null? l)
        '()
        (cons (item-data l)
              (iter (item-next l)))))
  (iter (front-ptr d)))

(define (front-deque deque)
  (if (empty-deque? deque)
      (error "FRONT called with an empty deque" deque)
      (item-data (front-ptr deque))))

(define (rear-deque deque)
  (if (empty-deque? deque)
      (error "REAR called with an empty deque" deque)
      (item-data (rear-ptr deque))))

(define (front-insert! deque data)
  (let* ((next (front-ptr deque))
         (item (make-deque-item
                '()
                data
                next)))
    (cond ((empty-deque? deque)
           (set-front-ptr! deque item)
           (set-rear-ptr! deque item))
          (else
           (set-front-ptr! deque item)
           (item-set-prev! next item)))))
           
(define (rear-insert! deque data)
  (let* ((prev (rear-ptr deque))
         (item (make-deque-item
                prev
                data
                '())))
    (cond ((empty-deque? deque)
           (set-front-ptr! deque item)
           (set-rear-ptr! deque item))
          (else
           (set-rear-ptr! deque item)
           (item-set-next! prev item)))))
           
;; When the front and rear-pointers are equal, the deque has one element.
;; This is a special case to prevent just one of the pointers being set to
;; null when deleting the last element.

(define (front-delete! deque)
  (cond ((empty-deque? deque)
         (error "FRONT-DELETE! called with an empty deque" deque))
        ((eq? (front-ptr deque) (rear-ptr deque))
         (set-front-ptr! deque '())
         (set-rear-ptr! deque '()))
        (else
         (let ((front-item (front-ptr deque)))
           (set-front-ptr! deque
                           (item-next front-item))
           (if (not (null? front-item))
             (item-set-prev! front-item '()))))))

(define (rear-delete! deque)
  (cond ((empty-deque? deque)
         (error "REAR-DELETE! called with an empty deque" deque))
        ((eq? (front-ptr deque) (rear-ptr deque))
         (set-front-ptr! deque '())
         (set-rear-ptr! deque '()))
        (else
         (set-rear-ptr! deque
                        (item-prev (rear-ptr deque)))
         (if (not (null? (rear-ptr deque)))
           (item-set-next! (rear-ptr deque) '())))))

(define (print-deque deque)
  (define (print-items items)
    (if (not (null? items))
      (begin
        (display (item-data items))
        (print-items (item-next items)))))
  (display "(")
  (print-items (front-ptr deque))
  (display ")")
  (newline))

(#%require (only racket/base module+))

(module+ test
  (#%require rackunit)

  (test-begin
    (define d (make-deque))
    (check-equal? (deque->list d) '())
    (front-insert! d 'a)
    (check-equal? (deque->list d) '(a))
    (rear-insert! d 'b)
    (check-equal? (deque->list d) '(a b))
    (rear-delete! d)
    (check-equal? (deque->list d) '(a))
    (rear-delete! d)
    (check-equal? (deque->list d) '())
    (rear-insert! d 'b)
    (check-equal? (deque->list d) '(b))
    (rear-insert! d 'b)
    (check-equal? (deque->list d) '(b b))
    (front-delete! d)
    (check-equal? (deque->list d) '(b)))
)