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

Change make-predicate/define-predicate to use flat-contract-predicate.

Browse Source 
Closes PR 14610.
This commit is contained in:
Eric Dobson 2014-06-29 15:16:08 -07:00
parent 6ecbf2c542
commit b10cb6d089
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
View File

@ -289,9 +289,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
(syntax-parse stx
[(_ name:id ty:expr)
#`(begin
#,(ignore (if (eq? (syntax-local-context) 'top-level)
#'(define name (procedure-rename (make-predicate ty) 'name))
(flat-contract-def-property #'(define name #f) #'ty)))
#,(ignore #'(define name (procedure-rename (make-predicate ty) 'name)))
;; not a require, this is just the unchecked declaration syntax
#,(internal #'(require/typed-internal name (Any -> Boolean : ty))))]))
@ -311,20 +309,21 @@ This file defines two sorts of primitives. All of them are provided into any mod
type)))
#`(#,(external-check-property #'#%expression check-valid-type)
#,(ignore-some/expr name #'(Any -> Boolean : ty))))
#,(ignore-some/expr #`(flat-contract-predicate #,name) #'(Any -> Boolean : ty))))
(let ([typ (parse-type #'ty)])
(if (Error? typ)
;; This code should never get run, typechecking will have an error earlier
#`(error 'make-predicate "Couldn't parse type")
#`(#%expression
#,(ignore-some/expr
(type->contract
typ
;; must be a flat contract
#:kind 'flat
;; the value is not from the typed side
#:typed-side #f
(type->contract-fail typ #'ty #:ctc-str "predicate"))
#`(flat-contract-predicate
#,(type->contract
typ
;; must be a flat contract
#:kind 'flat
;; the value is not from the typed side
#:typed-side #f
(type->contract-fail typ #'ty #:ctc-str "predicate")))
#'(Any -> Boolean : ty))))))]))
(define-syntax (cast stx)