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)))
(provide
(contract-out (contract-out
[encode (-> enum? any/c exact-nonnegative-integer?)] [enum
[decode (-> enum? exact-nonnegative-integer? any/c)]) (-> extended-nat? (-> nat? any/c) (-> any/c nat?)
empty/e enum?)]
const/e [enum?
from-list/e (-> any/c
fin/e boolean?)]
disj-sum/e [size
disj-append/e (-> enum?
cons/e extended-nat?)]
elegant-cons/e [decode
dep/e (-> enum? nat?
dep2/e ;; requires size (eventually should replace dep/e with this) any/c)]
map/e [encode
filter/e ;; very bad, only use for small enums (-> enum? any/c
except/e nat?)]
thunk/e [map/e
fix/e (->* (procedure? procedure? enum?)
many/e #:rest (listof enum?)
many1/e enum?)]
list/e ;; very bad, only use for small enums
vec/e [filter/e
(-> enum? (-> any/c boolean?)
cantor-vec/e enum?)]
cantor-list/e [except/e
(->* (enum?)
box-vec/e #:rest list?
box-list/e enum?)]
[to-stream
traverse/e (-> enum?
hash-traverse/e stream?)]
[approximate
fail/e (-> enum? nat?
list?)]
approximate [to-list
to-list (-> enum?
to-stream list?)]
take/e [take/e
fold-enum (-> enum? nat?
enum?)]
nat/e [slice/e
range/e (-> enum? nat? nat?
slice/e enum?)]
nat+/e [below/e
(-> nat?
;; Base type enumerators enum?)]
any/e [empty/e enum?]
var/e [const/e
var-prefix/e (-> any/c
num/e enum?)]
integer/e [from-list/e
bool/e (-> list?
real/e enum?)]
string/e) [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)))