public
Created

Generics blog example

  • Download Gist
gistfile1.rkt
Racket
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
#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))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.