Adding contracts to data/enumerate

This commit is contained in:
Jay McCarthy 2014-11-17 20:04:09 -05:00
parent 981a68bba6
commit 1b2c8ef2ef
2 changed files with 196 additions and 80 deletions

View File

@ -17,63 +17,182 @@
integer-root integer-root
factorize)) factorize))
(provide enum (define nat? exact-nonnegative-integer?)
enum? (define (extended-nat? x)
size (or (nat? x) (= x +inf.0)))
(contract-out
[encode (-> enum? any/c exact-nonnegative-integer?)]
[decode (-> enum? exact-nonnegative-integer? any/c)])
empty/e
const/e
from-list/e
fin/e
disj-sum/e
disj-append/e
cons/e
elegant-cons/e
dep/e
dep2/e ;; requires size (eventually should replace dep/e with this)
map/e
filter/e ;; very bad, only use for small enums
except/e
thunk/e
fix/e
many/e
many1/e
list/e
vec/e
cantor-vec/e (provide
cantor-list/e (contract-out
[enum
box-vec/e (-> extended-nat? (-> nat? any/c) (-> any/c nat?)
box-list/e enum?)]
[enum?
traverse/e (-> any/c
hash-traverse/e boolean?)]
[size
fail/e (-> enum?
extended-nat?)]
approximate [decode
to-list (-> enum? nat?
to-stream any/c)]
take/e [encode
fold-enum (-> enum? any/c
nat?)]
nat/e [map/e
range/e (->* (procedure? procedure? enum?)
slice/e #:rest (listof enum?)
nat+/e enum?)]
;; very bad, only use for small enums
;; Base type enumerators [filter/e
any/e (-> enum? (-> any/c boolean?)
var/e enum?)]
var-prefix/e [except/e
num/e (->* (enum?)
integer/e #:rest list?
bool/e enum?)]
real/e [to-stream
string/e) (-> enum?
stream?)]
[approximate
(-> enum? nat?
list?)]
[to-list
(-> enum?
list?)]
[take/e
(-> enum? nat?
enum?)]
[slice/e
(-> enum? nat? nat?
enum?)]
[below/e
(-> nat?
enum?)]
[empty/e enum?]
[const/e
(-> any/c
enum?)]
[from-list/e
(-> list?
enum?)]
[fin/e
(-> list?
enum?)]
[nat/e enum?]
[int/e enum?]
[disj-sum/e
(->* () #:rest (listof (cons/c enum? (-> any/c boolean?)))
enum?)]
[disj-append/e
(->* (enum?) #:rest (listof (cons/c enum? (-> any/c boolean?)))
enum?)]
[fin-cons/e
(-> enum? enum?
enum?)]
[cons/e
(-> enum? enum?
enum?)]
[elegant-cons/e
(-> enum? enum?
enum?)]
[traverse/e
(-> (-> any/c enum?)
(listof any/c)
enum?)]
[hash-traverse/e
(-> (-> any/c enum?) hash?
enum?)]
[dep/e
(-> enum? (-> any/c enum?)
enum?)]
[dep2/e
(-> nat? enum? (-> any/c enum?)
enum?)]
[fold-enum
(-> (-> list? any/c enum?)
list?
enum?)]
[flip-dep/e
(-> enum? (-> any/c enum?)
enum?)]
[range/e
(-> nat? nat?
enum?)]
[thunk/e
(-> extended-nat? (-> enum?)
enum?)]
[fix/e
(case->
(-> (-> enum? enum?)
enum?)
(-> extended-nat? (-> enum? enum?)
enum?))]
[many/e
(case->
(-> enum?
enum?)
(-> enum? nat?
enum?))]
[many1/e
(-> enum?
enum?)]
[cantor-vec/e
(->* () #:rest (listof enum?)
enum?)]
[vec/e
(->* () #:rest (listof enum?)
enum?)]
[box-vec/e
(->* () #:rest (listof enum?)
enum?)]
[inf-fin-fair-list/e
(->* () #:rest (listof enum?)
enum?)]
[mixed-box-tuples/e
(-> (listof enum?)
enum?)]
[inf-fin-cons/e
(-> enum? enum?
enum?)]
[list/e
(->* () #:rest (listof enum?)
enum?)]
[nested-cons-list/e
(->* () #:rest (listof enum?)
enum?)]
[cantor-list/e
(->* () #:rest (listof enum?)
enum?)]
[box-list/e
(->* () #:rest (listof enum?)
enum?)]
[prime-length-box-list/e
(-> (listof enum?)
enum?)]
[box-tuples/e
(-> nat?
enum?)]
[bounded-list/e
(-> nat? nat?
enum?)]
[nat+/e
(-> nat?
enum?)]
[fail/e
(-> exn?
enum?)]
[char/e enum?]
[string/e enum?]
[from-1/e enum?]
[integer/e enum?]
[float/e enum?]
[real/e enum?]
[non-real/e enum?]
[num/e enum?]
[bool/e enum?]
[symbol/e enum?]
[base/e enum?]
[any/e enum?]))
;; an enum a is a struct of < Nat or +Inf, Nat -> a, a -> Nat > ;; an enum a is a struct of < Nat or +Inf, Nat -> a, a -> Nat >
(struct enum (struct enum
@ -208,12 +327,6 @@
(define (below/e n) (define (below/e n)
(take/e nat/e n)) (take/e nat/e n))
;; display-enum : enum a, Nat -> void
(define (display-enum e n)
(for ([i (range n)])
(display (decode e i))
(newline) (newline)))
(define empty/e (define empty/e
(enum 0 (enum 0
(λ (n) (λ (n)
@ -1551,7 +1664,7 @@
(define bool/e (define bool/e
(from-list/e '(#t #f))) (from-list/e '(#t #f)))
(define var/e (define symbol/e
(map/e (map/e
(compose string->symbol list->string) (compose string->symbol list->string)
(compose string->list symbol->string) (compose string->list symbol->string)
@ -1562,25 +1675,10 @@
(cons num/e number?) (cons num/e number?)
(cons string/e string?) (cons string/e string?)
(cons bool/e boolean?) (cons bool/e boolean?)
(cons var/e symbol?))) (cons symbol/e symbol?)))
(define any/e (define any/e
(fix/e +inf.0 (fix/e +inf.0
(λ (any/e) (λ (any/e)
(disj-sum/e (cons base/e (negate pair?)) (disj-sum/e (cons base/e (negate pair?))
(cons (cons/e any/e any/e) pair?))))) (cons (cons/e any/e any/e) pair?)))))
(define (var-prefix/e s)
(define as-str (symbol->string s))
(map/e (compose string->symbol
(curry string-append as-str)
symbol->string)
(compose string->symbol
list->string
(curry (flip drop) (string-length as-str))
string->list
symbol->string)
var/e))
(define (flip f)
(λ (x y)
(f y x)))

View File

@ -1,5 +1,7 @@
#lang racket/base #lang racket/base
(require data/enumerate (require data/enumerate
racket/function
racket/list
racket/contract/base) racket/contract/base)
(provide enum (provide enum
enum? enum?
@ -51,10 +53,26 @@
;; Base type enumerators ;; Base type enumerators
any/e any/e
var/e (rename-out [symbol/e var/e])
var-prefix/e var-prefix/e
num/e num/e
integer/e integer/e
bool/e bool/e
real/e real/e
string/e) string/e)
(define (var-prefix/e s)
(define as-str (symbol->string s))
(map/e (compose string->symbol
(curry string-append as-str)
symbol->string)
(compose string->symbol
list->string
(curry (flip drop) (string-length as-str))
string->list
symbol->string)
symbol/e))
(define (flip f)
(λ (x y)
(f y x)))