Maybe. I'll see if I can think of a better solution. Vincent
At Thu, 6 Jun 2013 17:35:50 -0500, Robby Findler wrote: > > Can't we do better than a memo table? > > On Thursday, June 6, 2013, wrote: > > > stamourv has updated `master' from 5ea3a1ce6d to 6e8c9ed15a. > > http://git.racket-lang.org/plt/5ea3a1ce6d..6e8c9ed15a > > > > =====[ 2 Commits ]====================================================== > > Directory summary: > > 82.9% collects/racket/contract/private/ > > 17.0% collects/scribblings/reference/ > > > > ~~~~~~~~~~ > > > > d1df869 Vincent St-Amour <stamo...@racket-lang.org <javascript:;>> > > 2013-06-06 18:02 > > : > > | Document procedure-closure-contents-eq?. > > : > > M collects/scribblings/reference/procedures.scrbl | 5 +++++ > > > > ~~~~~~~~~~ > > > > 6e8c9ed Vincent St-Amour <stamo...@racket-lang.org <javascript:;>> > > 2013-06-06 18:31 > > : > > | Memoize wrapped case-> range contracts. > > | > > | Fixes failing contract tests. > > : > > M collects/racket/contract/private/arrow.rkt | 21 +++++++++++++++------ > > > > =====[ Overall Diff ]=================================================== > > > > collects/racket/contract/private/arrow.rkt > > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > > --- OLD/collects/racket/contract/private/arrow.rkt > > +++ NEW/collects/racket/contract/private/arrow.rkt > > @@ -1712,12 +1712,21 @@ v4 todo: > > "the domain of" > > #:swap? #t))) > > dom-ctcs+case-nums) > > - (map (λ (f) > > - (define p (f rng-blame)) > > - (lambda args > > - (with-continuation-mark > > - contract-continuation-mark-key blame > > - (apply p args)))) > > + (map (let ([memo '()]) > > + ;; to preserve > > procedure-closure-contents-eq?ness of the > > + ;; wrapped procedures, memoize with f > > as the key. > > + (λ (f) > > + (define target > > + (assoc f memo > > procedure-closure-contents-eq?)) > > + (if target > > + (cdr target) > > + (let* ([p (f rng-blame)] > > + [new (lambda args > > + > > (with-continuation-mark > > + > > contract-continuation-mark-key blame > > + (apply p args)))]) > > + (set! memo (cons (cons f new) > > memo)) > > + new)))) > > rng-ctcs))) > > (define (chk val mtd?) > > (cond > > > > collects/scribblings/reference/procedures.scrbl > > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > > --- OLD/collects/scribblings/reference/procedures.scrbl > > +++ NEW/collects/scribblings/reference/procedures.scrbl > > @@ -88,6 +88,11 @@ to the wrong number of arguments, the resulting error > > hides the first > > argument as if the procedure had been compiled with the > > @indexed-racket['method-arity-error] syntax property.} > > > > +@defproc[(procedure-closure-contents-eq? [proc1 procedure?] > > + [proc2 procedure?]) boolean?]{ > > +Compares the contents of the closures of @racket[proc1] and @racket[proc2] > > +for equality by comparing closure elements pointwise using @racket[eq?]} > > + > > @; ---------------------------------------- > > @section{Keywords and Arity} > > > > _________________________ Racket Developers list: http://lists.racket-lang.org/dev
