finish (-> void?) optimization
This commit is contained in:
parent
bd2f889251
commit
8df0d6bba3
|
@ -485,6 +485,36 @@
|
||||||
((impersonate-procedure s? (λ (x) (values (λ (r) "") x))) 11))
|
((impersonate-procedure s? (λ (x) (values (λ (r) "") x))) 11))
|
||||||
'pos 'neg))
|
'pos 'neg))
|
||||||
|
|
||||||
|
(test/spec-passed/result
|
||||||
|
'->void.1
|
||||||
|
'(void? ((contract (-> void?) void 'pos 'neg)))
|
||||||
|
#t)
|
||||||
|
(test/spec-passed/result
|
||||||
|
'->void.2
|
||||||
|
'(void? ((contract (-> void?) (λ () (void)) 'pos 'neg)))
|
||||||
|
#t)
|
||||||
|
(test/spec-passed/result
|
||||||
|
'->void.3
|
||||||
|
'(void? ((contract (-> void?) (λ args void) 'pos 'neg)))
|
||||||
|
#t)
|
||||||
|
(test/pos-blame
|
||||||
|
'->void.4
|
||||||
|
'((contract (-> void?) (λ args 11) 'pos 'neg))
|
||||||
|
#t)
|
||||||
|
(test/pos-blame
|
||||||
|
'->void.5
|
||||||
|
'((contract (-> void?) (λ args (values (void) (void))) 'pos 'neg))
|
||||||
|
#t)
|
||||||
|
(test/pos-blame
|
||||||
|
'->void.6
|
||||||
|
'(contract (-> void?) 'not-a-function 'pos 'neg)
|
||||||
|
#t)
|
||||||
|
(test/pos-blame
|
||||||
|
'->void.7
|
||||||
|
'(contract (-> void?) (λ (x) 1) 'pos 'neg)
|
||||||
|
#t)
|
||||||
|
|
||||||
|
|
||||||
(test/spec-passed
|
(test/spec-passed
|
||||||
'any/c-in-domain1
|
'any/c-in-domain1
|
||||||
'((contract (-> any/c real?)
|
'((contract (-> any/c real?)
|
||||||
|
|
|
@ -1080,6 +1080,122 @@
|
||||||
(define f 1)))
|
(define f 1)))
|
||||||
(eval '(dynamic-require ''provide/contract56-m1 #f)))
|
(eval '(dynamic-require ''provide/contract56-m1 #f)))
|
||||||
"provide/contract56-m1")
|
"provide/contract56-m1")
|
||||||
|
|
||||||
|
(test/spec-failed
|
||||||
|
'provide/contract57
|
||||||
|
'(let ()
|
||||||
|
(eval '(module provide/contract57-m1 racket/base
|
||||||
|
(require racket/contract/base)
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[f (-> any/c boolean?)]))
|
||||||
|
(define f 1)))
|
||||||
|
(eval '(dynamic-require ''provide/contract57-m1 #f)))
|
||||||
|
"provide/contract57-m1")
|
||||||
|
|
||||||
|
(test/spec-passed/result
|
||||||
|
'provide/contract58
|
||||||
|
'(let ()
|
||||||
|
(eval '(module provide/contract58-m1 racket/base
|
||||||
|
(require racket/contract/base)
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[f (-> any/c boolean?)]))
|
||||||
|
(define (f x) #t)))
|
||||||
|
(eval '(module provide/contract58-m2 racket/base
|
||||||
|
(require 'provide/contract58-m1)
|
||||||
|
(provide a)
|
||||||
|
(define a (f 1))))
|
||||||
|
(eval '(dynamic-require ''provide/contract58-m2 'a)))
|
||||||
|
#t)
|
||||||
|
|
||||||
|
(test/spec-failed
|
||||||
|
'provide/contract59
|
||||||
|
'(let ()
|
||||||
|
(eval '(module provide/contract59-m1 racket/base
|
||||||
|
(require racket/contract/base)
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[f (-> any/c boolean?)]))
|
||||||
|
(define (f x) 11)))
|
||||||
|
(eval '(module provide/contract59-m2 racket/base
|
||||||
|
(require 'provide/contract59-m1)
|
||||||
|
(f 1)))
|
||||||
|
(eval '(dynamic-require ''provide/contract59-m2 #f)))
|
||||||
|
"provide/contract59-m1")
|
||||||
|
|
||||||
|
(test/spec-failed
|
||||||
|
'provide/contract60
|
||||||
|
'(let ()
|
||||||
|
(eval '(module provide/contract60-m1 racket/base
|
||||||
|
(require racket/contract/base)
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[f (-> any/c boolean?)]))
|
||||||
|
(define (f x) (values #t #t))))
|
||||||
|
(eval '(module provide/contract60-m2 racket/base
|
||||||
|
(require 'provide/contract60-m1)
|
||||||
|
(f 1)))
|
||||||
|
(eval '(dynamic-require ''provide/contract60-m2 #f)))
|
||||||
|
"provide/contract60-m1")
|
||||||
|
|
||||||
|
(test/spec-passed/result
|
||||||
|
'provide/contract61
|
||||||
|
'(let ()
|
||||||
|
(eval '(module provide/contract61-m1 racket/base
|
||||||
|
(require racket/contract/base)
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[f (-> void?)]))
|
||||||
|
(define (f) (void))))
|
||||||
|
(eval '(module provide/contract61-m2 racket/base
|
||||||
|
(require 'provide/contract61-m1)
|
||||||
|
(provide a)
|
||||||
|
(define a (f))))
|
||||||
|
(eval '(void? (dynamic-require ''provide/contract61-m2 'a))))
|
||||||
|
#t)
|
||||||
|
|
||||||
|
(test/spec-failed
|
||||||
|
'provide/contract62
|
||||||
|
'(let ()
|
||||||
|
(eval '(module provide/contract62-m1 racket/base
|
||||||
|
(require racket/contract/base)
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[f (-> void?)]))
|
||||||
|
(define f 1)))
|
||||||
|
(eval '(dynamic-require ''provide/contract62-m1 #f)))
|
||||||
|
"provide/contract62-m1")
|
||||||
|
|
||||||
|
(test/spec-failed
|
||||||
|
'provide/contract63
|
||||||
|
'(let ()
|
||||||
|
(eval '(module provide/contract63-m1 racket/base
|
||||||
|
(require racket/contract/base)
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[f (-> void?)]))
|
||||||
|
(define (f) 11)))
|
||||||
|
(eval '(module provide/contract63-m2 racket/base
|
||||||
|
(require 'provide/contract63-m1)
|
||||||
|
(f)))
|
||||||
|
(eval '(dynamic-require ''provide/contract63-m2 #f)))
|
||||||
|
"provide/contract63-m1")
|
||||||
|
|
||||||
|
(test/spec-failed
|
||||||
|
'provide/contract64
|
||||||
|
'(let ()
|
||||||
|
(eval '(module provide/contract64-m1 racket/base
|
||||||
|
(require racket/contract/base)
|
||||||
|
(provide
|
||||||
|
(contract-out
|
||||||
|
[f (-> void?)]))
|
||||||
|
(define (f) (values #t #t))))
|
||||||
|
(eval '(module provide/contract64-m2 racket/base
|
||||||
|
(require 'provide/contract64-m1)
|
||||||
|
(f)))
|
||||||
|
(eval '(dynamic-require ''provide/contract64-m2 #f)))
|
||||||
|
"provide/contract64-m1")
|
||||||
|
|
||||||
|
|
||||||
(contract-error-test
|
(contract-error-test
|
||||||
|
|
|
@ -69,6 +69,9 @@
|
||||||
(test-name 'predicate/c predicate/c)
|
(test-name 'predicate/c predicate/c)
|
||||||
|
|
||||||
(test-name '(-> integer? any/c ... boolean? any) (-> integer? any/c ... boolean? any))
|
(test-name '(-> integer? any/c ... boolean? any) (-> integer? any/c ... boolean? any))
|
||||||
|
|
||||||
|
(test-name '(-> boolean?) (-> boolean?))
|
||||||
|
(test-name '(-> void?) (-> void?))
|
||||||
|
|
||||||
(test-name '(->* (integer?) (string?) #:rest any/c (values char? any/c))
|
(test-name '(->* (integer?) (string?) #:rest any/c (values char? any/c))
|
||||||
(->* (integer?) (string?) #:rest any/c (values char? any/c)))
|
(->* (integer?) (string?) #:rest any/c (values char? any/c)))
|
||||||
|
|
|
@ -954,10 +954,6 @@
|
||||||
(for/list ([rng (in-list raw-rngs)])
|
(for/list ([rng (in-list raw-rngs)])
|
||||||
(coerce-contract who rng))))
|
(coerce-contract who rng))))
|
||||||
(cond
|
(cond
|
||||||
;; uncomment this to specialize (-> void) contract to a
|
|
||||||
;; more efficient wrapper (but there are no test cases for
|
|
||||||
;; that code, so add them before pushing this)
|
|
||||||
#;
|
|
||||||
[(and (null? regular-doms)
|
[(and (null? regular-doms)
|
||||||
(null? kwd-infos)
|
(null? kwd-infos)
|
||||||
(not rest-ctc)
|
(not rest-ctc)
|
||||||
|
@ -1447,7 +1443,7 @@
|
||||||
(make--> 0 '() '() #f #f
|
(make--> 0 '() '() #f #f
|
||||||
(list (coerce-contract 'whatever void?))
|
(list (coerce-contract 'whatever void?))
|
||||||
#f
|
#f
|
||||||
(λ (blame f _ignored-rng-ctcs _ignored-rng-proj)
|
(λ (blame f _ignored)
|
||||||
(values
|
(values
|
||||||
(λ (neg-party)
|
(λ (neg-party)
|
||||||
(call-with-values/check-range
|
(call-with-values/check-range
|
||||||
|
|
Loading…
Reference in New Issue
Block a user