suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust contract system to use (listof any) when it sees

Browse Source 
the list? predicate

(so that random generation and contract stronger work better)
This commit is contained in:
Robby Findler 2014-11-27 14:51:07 -06:00
parent 3eebc4995e
commit 9ee9f6767d
2 changed files with 25 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
racket/collects/racket/contract/private/guts.rkt
View File

@ -50,7 +50,9 @@
(struct-out wrapped-extra-arg-arrow) (struct-out wrapped-extra-arg-arrow)
contract-custom-write-property-proc contract-custom-write-property-proc
(rename-out [contract-custom-write-property-proc custom-write-property-proc])) (rename-out [contract-custom-write-property-proc custom-write-property-proc])
set-listof-any!)
(define (contract-custom-write-property-proc stct port display?) (define (contract-custom-write-property-proc stct port display?)
(write-string "#<" port) (write-string "#<" port)
@ -210,17 +212,29 @@
(let () (let ()
(struct name-default ()) (struct name-default ())
(values (name-default) name-default?))) (values (name-default) name-default?)))
;; these two definitions work around a cyclic
;; dependency. When we coerce a value to a contract,
;; we want to use (listof any/c) for list?, but
;; the files are not set up for that, so we just
;; bang it in here and use it only after it's been banged in.
(define listof-any #f)
(define (set-listof-any! c) (set! listof-any c))
(define (coerce-contract/f x [name name-default]) (define (coerce-contract/f x [name name-default])
(define (coerce-simple-value x) (define (coerce-simple-value x)
(cond (cond
[(contract-struct? x) #f] ;; this has to come first, since some of these are procedure?. [(contract-struct? x) #f] ;; this has to come first, since some of these are procedure?.
[(and (procedure? x) (procedure-arity-includes? x 1)) [(and (procedure? x) (procedure-arity-includes? x 1))
(make-predicate-contract (if (name-default? name) (cond
(or (object-name x) '???) [(and (eq? x list?) listof-any) listof-any]
name) [else
x (make-predicate-contract (if (name-default? name)
#f (or (object-name x) '???)
(memq x the-known-good-contracts))] name)
x
#f
(memq x the-known-good-contracts))])]
[(or (symbol? x) (boolean? x) (char? x) (null? x) (keyword? x)) [(or (symbol? x) (boolean? x) (char? x) (null? x) (keyword? x))
(make-eq-contract x (make-eq-contract x
(if (name-default? name) (if (name-default? name)

4
racket/collects/racket/contract/private/misc.rkt
View File

@ -1957,3 +1957,7 @@
[(2) "nd"] [(2) "nd"]
[(3) "rd"] [(3) "rd"]
[else "th"]))) [else "th"])))
;; this is a hack to work around cyclic linking issues;
;; see definition of set-listof-any!
(set-listof-any! (listof any/c))