Generics blog example

gistfile1.rkt

#lang racket

;; Examples from the Racket blog post on generics

(require racket/generic
         rackunit
         srfi/41)

(provide gen:queue
         queue/c
         queue?

         (contract-out
          ;; could provide more interesting contracts, e.g.,
          ;; polymorphic contracts
          [queue-enqueue (-> queue? any/c queue?)]
          [queue-dequeue (-> non-empty-queue/c queue?)]
          [queue-head (-> non-empty-queue/c any/c)]
          [queue-empty? (-> queue? boolean?)]
          [queue-length (-> queue? integer?)]))

;; The generic interface. Defines
;;   - gen:queue
;;   - queue/c
;;   - queue?
;; and all of the generic functions
(define-generics queue
  [queue-enqueue queue elem]
  [queue-dequeue queue]
  [queue-head queue]
  [queue-empty? queue]
  [queue-length queue])

;; Simple functional queues with two lists
(struct simple-queue (front back)
  #:methods gen:queue
  [; helper function to balance lists
   (define (check-front queue)
     (match queue
       [(simple-queue '() back)
        (simple-queue (reverse back) '())]
       [_ queue]))
   ; enqueue an element
   (define (queue-enqueue queue elem)
     (match queue
       [(simple-queue front back)
        (check-front (simple-queue front (cons elem back)))]))
   ; dequeue an element
   (define (queue-dequeue queue)
     (match queue
       [(simple-queue (cons x xs) back)
        (check-front (simple-queue xs back))]))
   ; get the head of the queue
   (define (queue-head queue)
     (match queue
       [(simple-queue (cons x xs) back) x]))
   ; check if the queue is empty
   (define (queue-empty? queue)
     (empty? (simple-queue-front queue)))
   ; get the queue's length
   (define (queue-length queue)
     (+ (length (simple-queue-front queue))
        (length (simple-queue-back queue))))])

(define empty-queue
  (simple-queue '() '()))

;; Lazy persistent queue
(struct persistent-queue (front-len front back-len back)
  #:methods gen:queue
  [; helper function to balance lists
   (define (check queue)
     (match queue
       [(persistent-queue front-len front back-len back)
        (if (<= back-len front-len)
            queue
            (persistent-queue
             (+ front-len back-len)
             (stream-append front (stream-reverse back))
             0 stream-null))]))
   ; enqueue an element
   (define (queue-enqueue queue elem)
     (match queue
       [(persistent-queue front-len front back-len back)
        (check (persistent-queue
                front-len front
                (+ 1 back-len) (stream-cons elem back)))]))
   ; dequeue an element
   (define (queue-dequeue queue)
     (match queue
       [(persistent-queue front-len front back-len back)
        (check (persistent-queue
                (- front-len 1) (stream-rest front)
                back-len back))]))
   ; get the head of the queue
   (define (queue-head queue)
     (match queue
       [(persistent-queue front-len front back-len back)
        (stream-first front)]))
   ; check if the queue is empty
   (define (queue-empty? queue)
     (= 0 (persistent-queue-front-len queue)))
   ; get the queue's length
   (define (queue-length queue)
     (+ (persistent-queue-front-len queue)
        (persistent-queue-back-len queue)))])

(define empty-persistent-queue
  (persistent-queue 0 stream-null 0 stream-null))

;; Contracts
(define int-queue/c
  (recursive-contract
   (queue/c [queue-enqueue (-> int-queue/c integer? int-queue/c)]
            [queue-dequeue (-> int-queue/c int-queue/c)]
            [queue-head    (-> int-queue/c integer?)]
            [queue-empty?  (-> int-queue/c boolean?)]
            [queue-length  (-> int-queue/c integer?)])
   ;; if we want to be picky, it's better to ensure that
   ;; the recursive contract is a chaperone
   ;; (the contract system can't infer this)
   #:chaperone))

(define non-empty-queue/c
  (flat-named-contract
   'non-empty-queue
   (λ (q) (and (queue? q) (not (queue-empty? q))))))

;; A bunch of tests
(module+ test
  (check-equal? (queue-head (queue-enqueue empty-queue 5)) 5)
  (check-true (queue-empty? empty-queue))
  (check-equal? (queue-length 
                 (queue-enqueue (queue-enqueue empty-queue 7) 5)) 2)

  (check-equal? (queue-head (queue-enqueue empty-persistent-queue 5)) 5)
  (check-true (queue-empty? empty-persistent-queue))
  (check-equal? (queue-length 
                 (queue-enqueue (queue-enqueue empty-persistent-queue 7) 5))
                2))