5d4477d08d
New strategy for compiling the (-> Any Boolean) type to a contract. When possible, uses `struct-predicate-procedure?` instead of wrapping in `(-> any-wrap/c boolean?)`. Makes exceptions for untyped chaperones/impersonators over struct predicates; those are always wrapped with `(-> any-wrap/c boolean?)`. This change also affects (require/typed ... [#:struct ...]), but not #:opaque
26 lines
543 B
Racket
26 lines
543 B
Racket
#lang typed/racket
|
|
|
|
;; Untyped should not be able to pass arbitrary code in
|
|
;; in place of a struct predicate.
|
|
|
|
(module untyped racket
|
|
(struct s ())
|
|
(define (s?? x)
|
|
(when (box? x)
|
|
(set-box! x (void)))
|
|
#t)
|
|
(provide s struct:s (rename-out [s?? s?])))
|
|
|
|
(require/typed 'untyped
|
|
[#:struct s ()])
|
|
|
|
(: suitcase (Boxof '$$$))
|
|
(define suitcase (box '$$$))
|
|
|
|
(with-handlers ([exn:fail:contract? (lambda (x) (void))])
|
|
(s? suitcase)
|
|
(void))
|
|
|
|
(unless (and (eq? '$$$ (unbox suitcase)))
|
|
(error 'pr226 "THEY SLIPPED US A RINGER"))
|