Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Polymorphic contracts and generics
#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-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
;; generic functions have polymorphic contracts
[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)
(list-stack (cdr lst))))
(define (stack-peek stack)
(car (list-stack-l stack)))])
;; 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment