0. #lang racket/base
1. (require racket/contract/base
2.          racket/contract/combinator)
3.  
4. (define (gen->/c in/c in->out/c)
5.   (define b->inp (contract-projection in/c))
6.   (make-contract
7.    #:first-order procedure?
8.    #:projection
9.    (lambda (b)
10.      (define inp (b->inp (blame-swap b)))
11.      (lambda (x)
12.        (lambda args
13.          (define args/c (inp args))
14.          (call-with-values (lambda () (apply x args/c))
15.            (lambda res
16.              (define out/c (in->out/c args/c))
17.              (define b->outp (contract-projection out/c))
18.              (define outp (b->outp b))
19.              (apply values (outp res)))))))))
20.  
21.   (require racket/list
22.            rackunit)
23.  
24.   (define (f x)
25.     (if (= x 7)
26.       17
27.       (apply values
28.              (for/list ([i (in-range x)])
29.                i))))
30.  
31.   (define f/c
32.     (contract
33.      (gen->/c (list/c number?)
34.               (λ (l)
35.                 (λ (out) (and (list? out)
36.                               (= (length out) (first l))
37.                               (andmap number? out)))))
38.      f
39.      'f
40.      'test))
41.  
42.   (displayln "Example 1")
43.   (f/c 5)
44.   (displayln "Example 2")
45.   (thread-wait (thread (λ () (f/c "foo"))))
46.   (displayln "Example 3")
47.   (thread-wait (thread (λ () (f/c 7))))

=>

Example 1

0 1 2 3 4

Example 2

f/c: contract violation   expected: number?   given: "foo"   in: the 1st element of       ...       anonymous-contract   contract from: f   blaming: test   context...:    /home/stchang/plt601/racket/collects/racket/contract/private/blame.rkt:143:0: raise-blame-error16    /home/stchang/plt601/racket/collects/racket/contract/private/misc.rkt:733:7    /home/stchang/plt601/racket/collects/racket/contract/private/prop.rkt:257:10

Example 3

f/c: broke its contract   promised: ???   produced: '(17)   in: anonymous-contract   contract from: f   blaming: f   context...:    /home/stchang/plt601/racket/collects/racket/contract/private/blame.rkt:143:0: raise-blame-error16