ctc2.rkt

#lang racket/base

(module s racket/base
  (require racket/contract/base)
  
  (provide (contract-out [f (-> integer? integer?)])
           g)
  (define (f x) x)

  ;; Simulate the expansion of `contract-out`:
  (define (f2 x) x)
  (define (i? integer? blame x) (if (integer? x)
                                    x
                                    (error "bad")))
  (set! i? i?)
  (set! f2 f2)
  (define (indirect v f) (f))
  (set! indirect indirect)
  (define g
    (lambda (blame x)
      (define-values (bad? r)
        (call-with-values (lambda ()
                            (with-continuation-mark
                              'something 'else
                              (f2 (with-continuation-mark
                                    'something2 'else
                                    (i? integer? 'blame x)))))
          (case-lambda
            [(r)
             (values #f r)]
            [args (values #t args)])))
      (if bad?
          (error "bad")
          (with-continuation-mark
            'something 'else
            (i? integer? 'blame r))))))

(require (submod "." s))

;; Actual contract
(time
 (for ([x (in-range 10000000)])
   (f x)))

;; Simulated contract
(time
 (for ([x (in-range 10000000)])
   (g 'blame x)))