advent-of-code-2022/day-11/queue.scm

;;; This is a purely functional FIFO (first in first out) queue data structure
;;; in GNU Guile. This queue implementation makes use of a front stack and back
;;; stack, which are exchanged, when the front stack is empty and one tries to
;;; access the head of the queue.

;;; Adapted from https://programmingpraxis.com/2013/11/08/two-stacks-make-a-queue/

;;; Changes I made to adapt the code to GNU Guile:
;;; - translation to GNU Guile (Scheme)
;;; - binding renamings for better readability,
;;; - imports of required modules
;;; - bug fixes (endless loop in case of dequeue-ing from empty queue)
;;; - some error handling
;;; - comments (there were none)
;;; - docstrings (there were none)


(library (queue)
  (export empty-queue
          enqueue
          dequeue
          queue-empty?)
  (import
   (except (rnrs base) let-values map error)
   (only (guile)
         lambda* λ)
   (ice-9 match)
   ;; receive form
   (srfi srfi-8))


  ;; A stack is implemented using a list.
  (define empty-stack '())


  (define (push stack x)
    "Push an element onto the stack by cons-ing it to the list,
which is used as stack."
    (cons x stack))


  (define (pop stack)
    "Pop the top element of the stack, returning both, the top
element and the updated stack."
    (values (car stack) (cdr stack)))


  ;; Checking whether a stack is empty is simply checking
  ;; whether a list is empty.
  (define empty-stack? null?)


  (define (transfer src dst)
    "Transfer all element of one stack to the other stack, reversing their order,
as we can only pop elements, which are on top of a stack and
only push elements onto elements of a stack."
    (cond [(empty-stack? src) dst]
          [else
           (receive (x xs) (pop src)
             ;; Transfer the rest of the elements. Recur.
             (transfer xs (push dst x)))]))


  ;; Creating an empty queue means creating an empty front
  ;; stack and empty back stack.
  (define empty-queue (cons empty-stack empty-stack))


  (define (enqueue queue elem)
    "Enqueue an element x into the given queue."
    ;; First, via match, separate the front stack and back
    ;; stack of the queue, so that we can push the new
    ;; element onto one of the stacks.
    (match queue
      ;; A queue is the pair of back stack and front
      ;; stack. Push the element onto the back stack and
      ;; make a new queue.
      [(back-stack . front-stack)
       (cons (push back-stack elem)
             front-stack)]
      [_
       (error "enqueue got something else than a queue:" queue)]))


  (define (dequeue queue)
    "Dequeue the head of the queue."
    ;; First, via match, separate the front stack and back
    ;; stack of the queue.
    (cond
     [(queue-empty? queue)
      (error "cannot dequeue from empty queue")]
     [else
      (match queue
        [(back-stack . front-stack)
         (cond
          ;; If the front stack is empty, transfer all
          ;; elements from the back stack to the front stack
          ;; and then dequeue.
          [(empty-stack? front-stack)
           (dequeue
            (cons empty-stack
                  (transfer back-stack front-stack)))]
          ;; Otherwise pop an element from the front stack
          ;; and return both, the element and the updated
          ;; queue.
          [else
           (receive (elem updated-front-stack) (pop front-stack)
             (values elem (cons back-stack updated-front-stack)))])]
        [_
         (error "dequeue got something else than a queue:" queue)])]))


  (define (queue-empty? queue)
    "Check whether a queue is empty, by checking whether both
stacks are empty."
    (and (null? (car queue))
         (null? (cdr queue)))))