133 lines
3.8 KiB
Racket
133 lines
3.8 KiB
Racket
#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)))
|
|
)
|