Can't we do better than a memo table?<span></span><br><br>On Thursday, June 6, 2013, wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">stamourv has updated `master' from 5ea3a1ce6d to 6e8c9ed15a.<br>
<a href="http://git.racket-lang.org/plt/5ea3a1ce6d..6e8c9ed15a" target="_blank">http://git.racket-lang.org/plt/5ea3a1ce6d..6e8c9ed15a</a><br>
<br>
=====[ 2 Commits ]======================================================<br>
Directory summary:<br>
82.9% collects/racket/contract/private/<br>
17.0% collects/scribblings/reference/<br>
<br>
~~~~~~~~~~<br>
<br>
d1df869 Vincent St-Amour <<a href="javascript:;" onclick="_e(event, 'cvml', 'stamourv@racket-lang.org')">stamourv@racket-lang.org</a>> 2013-06-06 18:02<br>
:<br>
| Document procedure-closure-contents-eq?.<br>
:<br>
M collects/scribblings/reference/procedures.scrbl | 5 +++++<br>
<br>
~~~~~~~~~~<br>
<br>
6e8c9ed Vincent St-Amour <<a href="javascript:;" onclick="_e(event, 'cvml', 'stamourv@racket-lang.org')">stamourv@racket-lang.org</a>> 2013-06-06 18:31<br>
:<br>
| Memoize wrapped case-> range contracts.<br>
|<br>
| Fixes failing contract tests.<br>
:<br>
M collects/racket/contract/private/arrow.rkt | 21 +++++++++++++++------<br>
<br>
=====[ Overall Diff ]===================================================<br>
<br>
collects/racket/contract/private/arrow.rkt<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- OLD/collects/racket/contract/private/arrow.rkt<br>
+++ NEW/collects/racket/contract/private/arrow.rkt<br>
@@ -1712,12 +1712,21 @@ v4 todo:<br>
"the domain of"<br>
#:swap? #t)))<br>
dom-ctcs+case-nums)<br>
- (map (λ (f)<br>
- (define p (f rng-blame))<br>
- (lambda args<br>
- (with-continuation-mark<br>
- contract-continuation-mark-key blame<br>
- (apply p args))))<br>
+ (map (let ([memo '()])<br>
+ ;; to preserve procedure-closure-contents-eq?ness of the<br>
+ ;; wrapped procedures, memoize with f as the key.<br>
+ (λ (f)<br>
+ (define target<br>
+ (assoc f memo procedure-closure-contents-eq?))<br>
+ (if target<br>
+ (cdr target)<br>
+ (let* ([p (f rng-blame)]<br>
+ [new (lambda args<br>
+ (with-continuation-mark<br>
+ contract-continuation-mark-key blame<br>
+ (apply p args)))])<br>
+ (set! memo (cons (cons f new) memo))<br>
+ new))))<br>
rng-ctcs)))<br>
(define (chk val mtd?)<br>
(cond<br>
<br>
collects/scribblings/reference/procedures.scrbl<br>
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
--- OLD/collects/scribblings/reference/procedures.scrbl<br>
+++ NEW/collects/scribblings/reference/procedures.scrbl<br>
@@ -88,6 +88,11 @@ to the wrong number of arguments, the resulting error hides the first<br>
argument as if the procedure had been compiled with the<br>
@indexed-racket['method-arity-error] syntax property.}<br>
<br>
+@defproc[(procedure-closure-contents-eq? [proc1 procedure?]<br>
+ [proc2 procedure?]) boolean?]{<br>
+Compares the contents of the closures of @racket[proc1] and @racket[proc2]<br>
+for equality by comparing closure elements pointwise using @racket[eq?]}<br>
+<br>
@; ----------------------------------------<br>
@section{Keywords and Arity}<br>
<br>
</blockquote>