public
Created

Polymorphic contracts and generics

  • 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
#lang racket
 
;; generics with parametric contracts
 
(module stack racket
(require racket/generic)
;; The following defines:
;; * gen:stack
;; * stack?
;; * stack/c
;; * stack-push
;; * stack-pop
;; * stack-peek
(define-generics stack
(stack-push stack elem)
(stack-pop stack)
(stack-peek stack))
(define (make-stack/c elem/c)
(define rec-stack/c (recursive-contract (make-stack/c elem/c)))
(stack/c
[stack-push (-> rec-stack/c elem/c rec-stack/c)]
[stack-pop (-> rec-stack/c rec-stack/c)]
[stack-peek (-> rec-stack/c elem/c)]))
 
(define elem/c (new-/c 'elem))
(define poly-stack/c (make-stack/c elem/c))
 
(provide gen:stack
stack?
make-stack/c
;; generic functions have polymorphic contracts
(contract-out
[stack-push (-> poly-stack/c elem/c poly-stack/c)]
[stack-pop (-> poly-stack/c poly-stack/c)]
[stack-peek (-> poly-stack/c elem/c)])))
(module instance racket
(require (submod ".." stack))
(define-struct list-stack (l)
#:methods gen:stack
[(define (stack-push stack elem)
(list-stack (cons elem (list-stack-l stack))))
(define (stack-pop stack)
(define lst (list-stack-l stack))
(if (empty? lst)
stack
(list-stack (cdr lst))))
(define (stack-peek stack)
(car (list-stack-l stack)))])
(provide
(contract-out
;; specific instantiation of contract
[list-stack (-> (listof symbol?) (make-stack/c symbol?))])))
 
(require 'stack 'instance)
 
(define stack (list-stack '(a b c)))
 
;; these work fine
(stack-pop stack)
(stack-peek stack)
(stack-pop (stack-push stack 'e))
 
;; contract violation
(stack-push stack 5)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.