deque.rkt

#lang racket

(require compatibility/mlist)
(require test-engine/racket-tests)

(define (make-deque)
  (let ((front-ptr '())
        (rear-ptr '()))
    ;; selectors
    (define (empty?)
      (null? front-ptr))
    (define (front)
      (if (empty?)
          (error "FRONT called with an empty queue")
          (node-item front-ptr)))
    (define (rear)
      (if (empty?)
          (error "REAR called with an empty queue")
          (node-item rear-ptr)))
    (define (print)
      (define (iter node)
        (if (null? node)
          '()
          (cons (node-item node) (iter (node-next node)))))
      (iter front-ptr))
    ;; mutators
    (define (front-insert! item)
      (let ((new-elt (make-node item '() front-ptr)))
        (if (empty?)
            (begin
              (set! front-ptr new-elt)
              (set! rear-ptr new-elt))
            (begin
              (set-node-prev! front-ptr new-elt)
              (set! front-ptr new-elt))))
      (print))
    (define (rear-insert! item)
      (let ((new-elt (make-node item rear-ptr '())))
        (if (empty?)
            (begin
              (set! front-ptr new-elt)
              (set! rear-ptr new-elt))
            (begin
              (set-node-next! rear-ptr new-elt)
              (set! rear-ptr new-elt))))
      (print))
    (define (front-delete!)
      (cond
        ((empty?)
         (error "FRONT-DELETE! called with an empty queue"))
        ((eq? front-ptr rear-ptr)
         (clear!))
        (else
         (set! front-ptr (node-next front-ptr))
         (print))))
    (define (rear-delete!)
      (cond
        ((empty?) (error "REAR-DELETE! called with an empty queue"))
        ((eq? front-ptr rear-ptr)
         (clear!))
        (else
         (set! rear-ptr (node-prev rear-ptr))
         (print))))
    (define (clear!)
      (set! front-ptr '())
      (set! rear-ptr '())
      (print))
    ;; private helpers
    (define (make-node item prev next)
      (mlist item prev next))
    (define (node-item node)
      (mcar node))
    (define (node-prev node)
      (mcar (mcdr node)))
    (define (node-next node)
      (mcar (mcdr (mcdr node))))
    (define (set-node-next! node next)
      (set-mcar! (mcdr (mcdr node)) next))
    (define (set-node-prev! node prev)
      (set-mcar! (mcdr node) prev))
    ;; message passing interface
    (define (dispatch m)
      (cond
        ((eq? m 'empty?) empty?)
        ((eq? m 'front) front)
        ((eq? m 'rear) rear)
        ((eq? m 'print) print)
        ((eq? m 'front-insert!) front-insert!)
        ((eq? m 'rear-insert!) rear-insert!)
        ((eq? m 'front-delete!) front-delete!)
        ((eq? m 'rear-delete!) rear-delete!)
        ((eq? m 'clear) clear!)
        (else (error "DEQUE -- unrecognized operation" m))))
    dispatch))

(define (empty-deque? deque)
  ((deque 'empty?)))
(define (front-deque deque)
  ((deque 'front)))
(define (rear-deque deque)
  ((deque 'rear)))
(define (print-deque deque)
  ((deque 'print)))
(define (front-insert-deque! deque item)
  ((deque 'front-insert!) item))
(define (rear-insert-deque! deque item)
  ((deque 'rear-insert!) item))
(define (front-delete-deque! deque)
  ((deque 'front-delete!)))
(define (rear-delete-deque! deque)
  ((deque 'rear-delete!)))
(define (clear-deque! deque)
  ((deque 'clear)))

(define dq1 (make-deque))
(check-expect (empty-deque? dq1) #t)
(check-expect (front-insert-deque! dq1 'a) '(a))
(check-expect (front-insert-deque! dq1 'b) '(b a))
(check-expect (rear-insert-deque! dq1 'c) '(b a c))

(define dq2 (make-deque))
(check-expect (rear-insert-deque! dq2 'a) '(a))
(check-expect (rear-insert-deque! dq2 'b) '(a b))