batched-deque.scm
```;;; batched-dequeue.scm  --  Jens Axel Søgaard

;;; DOUBLE ENDED BATCHED QUEUE

; Reference: Exercise 5.1 in [Oka]. (Hoogerwoord 92)

(module batched-deque mzscheme
(require (only (lib "list.ss") foldl)
(lib "42.ss" "srfi"))

(define-struct deque  (front rear))

; Invariants
;   1.  q empty         <=>  (null? (deque-front q))
;   2.  (size q) >= 2   <=>  (and (not (null? (deque-front q)))
;                                 (not (null? (deque-rear q)))
;   3.  elements of q  =  (append (deque-front q) (reverse (deque-rear q)))

(define empty (make-deque '() '()))

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

(define (split l)
(define (take n f r)
(if (= n 0)
(list (reverse f) r)
(take (sub1 n) (cons (car r) f) (cdr r))))
(let ([n (length l)])
(take (quotient n 2) '() l)))

(define (check-invariant q)
(let ([f (deque-front q)]
[r (deque-rear q)])
(cond
[(and (or (null? f)
(null? (cdr f)))
(null? r))            q]
[(null? f)                  (let* ([h  (split r)]
[fh (car h)]
(make-deque (reverse sh)  fh))]
; TODO: This brach is not covered by the test suite !!!
[(null? r)                  (let* ([h  (split f)]
[fh (car h)]
(make-deque fh  (reverse sh)))]
[else q])))

(define (insert-first x q)
(check-invariant (make-deque (cons x (deque-front q))
(deque-rear q))))

(define (insert-last x q)
(check-invariant (make-deque (deque-front q)
(cons x (deque-rear q)))))

(define insert insert-last)

(define (insert* xs q)
(foldl insert q xs))

(define (remove-first q)
(if (null? (deque-front q))
(error "remove-first: can't remove element from empty deque; given " q)
(check-invariant (make-deque (cdr (deque-front q)) (deque-rear q)))))

(define (remove-last q)
(if (null? (deque-rear q))
(remove-first q)
(check-invariant (make-deque (deque-front q) (cdr (deque-rear q))))))

(define (last q)
(if (empty? q)
(error "last: There is no last element in an empty deque; given " q))
(cond
[(null? (deque-rear q))  (first q)]
[else                    (car (deque-rear q))]))

(define remove remove-first)

(define (first q)
(if (empty? q)
(error "first: There is no first element in an empty deque; given " q))
(car (deque-front q)))

(define (first+remove q)
(let ([front (deque-front q)])
(if (null? front)
(error 'remove-first "can't remove element from empty deque; given " q)
(values (car front)
(check-invariant (make-deque (cdr (deque-front q)) (deque-rear q)))))))

(define (elements q)
(append (deque-front q) (reverse (deque-rear q))))

(define (fold f init q)
(foldl f
(foldl f init (deque-front q))
(reverse (deque-rear q))))

; a deque is also a queue
(define (queue? o)
(deque? o))

(define (size d)
(+ (length (deque-front d))
(length (deque-rear d))))

;; support for srfi-42
; TODO: remove intermediary list in :queue-dispatch

(define-syntax queue-ec
(syntax-rules ()
[(_ etc1 etc ...)
(fold-ec empty etc1 etc ... insert)]))

(define (:queue-dispatch args)
(cond
[(null? args)
'queue]
[(and (= (length args) 1)
(queue? (car args)))
(:generator-proc (:list (elements (car args))))]
[else
#f]))

(define-syntax :queue
(syntax-rules (index)
((:queue cc var (index i) arg1 arg ...)
(:dispatched cc var (index i) :queue-dispatch arg1 arg ...) )
((:queue cc var arg1 arg ...)
(:dispatched cc var :queue-dispatch arg1 arg ...) )))

(:-dispatch-set!
(dispatch-union (:-dispatch-ref) :queue-dispatch))

(define-syntax deque-ec (syntax-rules () ((_ more ...)  (queue-ec more ...))))
(define-syntax :deque (syntax-rules () ((_ more ...)  (:queue more ...))))

(require "signatures/queue-signature.scm")
(provide-deque)
)
```