A little further investigation -- the problem is in the C versions of `impersonate-procedure` and `procedure-rename`, not the keyword-handling ones.
#lang racket (require (prefix-in k: '#%kernel)) (define-values (prop:wrapped wrapped? prop-wrapped-accessor) (make-impersonator-property 'wrapped)) (define (wrap value) (k:impersonate-procedure value #f prop:wrapped #t)) (wrapped? (k:procedure-rename (wrap +) 'x)) On Mon, Mar 9, 2015 at 5:14 PM, Robby Findler <[email protected]> wrote: > The contract system (at a layer slight lower than define/contract or > provide/contract) call procedure-rename. And that appears not to > propogate the impersonator properties. > > (wrapped? (procedure-rename (wrap (λ () 4)) 'hi)) ;; => #f > > This PR is also relevant: > > http://bugs.racket-lang.org/query/?debug=&database=default&cmd=view+audit-trail&cmd=view&pr=11222 > > On Mon, Mar 9, 2015 at 3:26 PM, Scott Moore <[email protected]> wrote: >> Hi all, >> >> The racket program below exhibits behavior that I think is a bug. When using >> define/contract (and I believe with-contract), contracts seem to get applied >> to values later than expected. In particular, in the following example I >> expect all uses of the variable “test” to see the wrapper added by the >> contract. Instead, applications see the projection but inspecting the value >> without invoking it does not. >> >> Thanks, >> Scott >> >> #lang racket >> >> (require rackunit) >> >> (module test racket >> (provide wrapped? (contract-out (test2 coerce-to-wrapped)) test) >> >> (define-values (prop:wrapped wrapped? prop-wrapped-accessor) >> (make-impersonator-property 'wrapped)) >> >> (define (wrap value) >> (let* ([wrapped (λ () (printf "Unwrapping ~a~n" value) value)]) >> (impersonate-procedure >> wrapped >> #f >> prop:wrapped >> #t))) >> >> (define coerce-to-wrapped >> (make-contract #:name "wrap" >> #:projection >> (λ (blame) >> (λ (value) >> (wrap value))))) >> >> (define/contract (test) >> coerce-to-wrapped >> 5) >> >> (define (test2) >> 42)) >> >> (require 'test) >> >> (check-true (wrapped? test)) ; Should return true! >> (check-true (wrapped? test2)) ; Should return true! >> (check-equal? ((test)) 5) ; test is in fact wrapped, must invoke twice to >> use the original procedure >> (check-true (procedure? (test))) ; result of (test) is the unwrapped >> procedure >> >> -- >> You received this message because you are subscribed to the Google Groups >> "Racket Developers" group. >> To unsubscribe from this group and stop receiving emails from it, send an >> email to [email protected]. >> To post to this group, send email to [email protected]. >> To view this discussion on the web visit >> https://groups.google.com/d/msgid/racket-dev/452027A2-62FD-4D03-B700-89D04D3479A7%40fas.harvard.edu. >> For more options, visit https://groups.google.com/d/optout. > > -- > You received this message because you are subscribed to the Google Groups > "Racket Developers" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to [email protected]. > To post to this group, send email to [email protected]. > To view this discussion on the web visit > https://groups.google.com/d/msgid/racket-dev/CAL3TdON7pRgO%3Dc5AzSWV6AWb51BEb5CCv22JryhE2X%2Bd-Oh7ow%40mail.gmail.com. > For more options, visit https://groups.google.com/d/optout. -- You received this message because you are subscribed to the Google Groups "Racket Developers" group. To unsubscribe from this group and stop receiving emails from it, send an email to [email protected]. To post to this group, send email to [email protected]. To view this discussion on the web visit https://groups.google.com/d/msgid/racket-dev/CAK%3DHD%2BZc2QcLbcDJTnCfySFGA9AfwipDhKkOiNGCkrfy9Qxupw%40mail.gmail.com. For more options, visit https://groups.google.com/d/optout.
