From 51629f8c3df0c6e1c0ac1e8e10331ab3fb2e9649 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Fri, 11 Jun 2010 16:58:07 -0400 Subject: [PATCH] Add new proxy property for contracted values. Change has-contract? and value-contract to check for either prop:contracted (the struct property) or proxy-prop:contracted (the proxy property). --- collects/racket/contract/private/guts.rkt | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/collects/racket/contract/private/guts.rkt b/collects/racket/contract/private/guts.rkt index c61d4fda11..7828b55ccc 100644 --- a/collects/racket/contract/private/guts.rkt +++ b/collects/racket/contract/private/guts.rkt @@ -44,6 +44,7 @@ contract-first-order-passes? prop:contracted + proxy-prop:contracted has-contract? value-contract @@ -56,7 +57,19 @@ define/final-prop define/subexpression-pos-prop) -(define-values (prop:contracted has-contract? value-contract) +(define (has-contract? v) + (or (has-prop:contracted? v) + (has-proxy-prop:contracted? v))) + +(define (value-contract v) + (cond + [(has-prop:contracted? v) + (get-prop:contracted v)] + [(has-proxy-prop:contracted? v) + (get-proxy-prop:contracted v)] + [else #f])) + +(define-values (prop:contracted has-prop:contracted? get-prop:contracted) (let-values ([(prop pred get) (make-struct-type-property 'prop:contracted @@ -65,7 +78,10 @@ (let ([ref (cadddr si)]) (lambda (s) (ref s v))) (lambda (s) v))))]) - (values prop pred (λ (v) (if (pred v) ((get v) v) #f))))) + (values prop pred (λ (v) ((get v) v))))) + +(define-values (proxy-prop:contracted has-proxy-prop:contracted? get-proxy-prop:contracted) + (make-proxy-property 'proxy-prop:contracted)) (define-syntax (any stx) (raise-syntax-error 'any "use of 'any' outside the range of an arrow contract" stx))