Create a gist now

Instantly share code, notes, and snippets.

Generics blog example
#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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment