Skip to content

Instantly share code, notes, and snippets.

@takikawa

takikawa/gist:3995200

Created November 1, 2012 17:29
Download ZIP

Revisions

  1. takikawa revised this gist Nov 1, 2012. 1 changed file with 5 additions and 1 deletion.
    6 changes: 5 additions & 1 deletion gistfile1.rkt
    View file
    Original file line number Diff line number Diff line change
    @@ -115,7 +115,11 @@
    [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?)])))
    [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
  2. takikawa created this gist Nov 1, 2012.
    136 changes: 136 additions & 0 deletions gistfile1.rkt
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,136 @@
    #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?)])))

    (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))