Allow invoking thunks on the untyped side of an Any.

2012-10-05 16:46:52 -04:00 · 2012-10-05 16:46:52 -04:00 · 6fde63007e
commit 6fde63007e
parent f38bd159d2
1 changed files with 5 additions and 1 deletions
--- a/collects/typed-racket/utils/any-wrap.rkt
+++ b/collects/typed-racket/utils/any-wrap.rkt
@ -60,7 +60,11 @@
                                 (lambda (h k) (t k)))] ;; key
      [(? evt?) (chaperone-evt v (lambda (e) (values e t)))]
      [(? struct?) (wrap-struct v)]
-      [(? procedure?) (chaperone-procedure v (lambda _ (fail v)))]
+      [(? procedure?) 
+       (if (procedure-arity-includes? v 0)
+           (chaperone-procedure v (case-lambda [() (values)]
+                                               [_ (fail v)]))
+           (chaperone-procedure v (lambda args (fail v))))]
      [_ (fail v)]))
  t)