Heavy Contracts

fact.rkt

#lang scratch

(module u racket
  (define (fact t-fact x acc lookup mk)
    (if (= x 0)
        (lookup acc)
        (t-fact fact (- x 1) (mk (* (lookup acc) x)) lookup mk)))
  (provide fact))

(module t typed/racket
  (define-type (f T)
    (-> (-> f Number T (-> T Number) (-> Number T) Number)
        Number
        T
        (-> T Number)
        (-> Number T)
        Number))
  (: fact f)
  (define (fact u-fact x acc lookup mk)
    (if (= x 0)
        (lookup acc)
        (u-fact fact (- x 1) (mk (* (lookup acc) x)) lookup mk)))
  (provide fact))

(struct acc (num))
(require (rename-in 'u [fact u-fact])
         (rename-in 't [fact t-fact]))
(require feature-profile)

(feature-profile
 (u-fact t-fact 5000 (acc 1) acc-num acc))