guile-data-structures/queue/implementation-00-mutation.scm

;; WARNING: This implementation makes use of mutation. It uses the trick of
;; storing members in the environment of a returned closure and mutating these
;; members inside the closure.

;;; Queue obect

;; Implemented operations:

;; 'push x: push x onto the rear of the queue
;; 'pop: remove the head of the queue and return it
;; 'peek: return the head of the queue
;; 'show: show the queue's contents
;; 'fb: show the front and back parts of the queue (for debugging)

(define make-queue
  ;; make-queue takes no arguments. the queue will be empty initially.
  (lambda ()
    ;; a queue is a procedure
    (let ((front '()) (back '()))
      ;; in this procedure front and back are 2 stacks which are bound in the
      ;; environment. the procedure takes 2 arguments: a desired operation and
      ;; the data on which to work on.
      (lambda (cmd . data)
        ;; ???
        (define exchange
          (lambda ()
            ;; WARNING: mutation here
            (set! front (reverse back))
            (set! back '())))

        (define pop
          (lambda (stack)
            (let ([res (car stack)])
               (set! front (cdr stack))
               res)))
        ;; match on cmd.
        (case cmd
           ;; We push new elements on top of the back stack, because they are
           ;; the ones we want to retrieve last (FIFO - first in first
           ;; out). When the front stack is empty, the back stack will be
           ;; reversed and thus the last pushed element will be the one at the
           ;; bottom of the stack, making it the last one we will pop.
          [(push)
           (set! back (cons (car data) back))]
          [(pop)
           (cond
            [(null? front)
             (exchange)
             (pop front)]
            [else
             (pop front)])]

          ;; If we are trying to access the head of the queue, but there is no
          ;; element stored in the front stack, perform the exchange operation
          ;; and only then return the head of the mutated front stack. If there
          ;; is an element at the head of the front stack in the first place,
          ;; return that instead.
          [(peek)
           (unless (pair? front)
             (exchange))
           (car front)]

          ;; show is displaying the queue's contents
          [(show)
           (display
            (simple-format
             #f "~s\n"
             (append front (reverse back))))]

          ;; fb = front / back
          [(fb)
           (display
            (simple-format
             #f "front: ~s, back: ~s\n"
             front back))]

          ;; Otherwise signal an error.
          [else
           (error "Illegal cmd to queue object" cmd)])))))