Union types instead of clobbering them in the type table.

This fixes a bug where only the last branch of a case-> type would get stored.
This commit is contained in:
Vincent St-Amour 2012-01-11 18:24:03 -05:00
parent 60c418b20e
commit 87a53159dd
2 changed files with 42 additions and 2 deletions

View File

@ -0,0 +1,24 @@
#;
(
TR missed opt: case-arrow.rkt 21:2 (+ min (/ (* (- max min) x) p)) -- exact ops inside float expr -- caused by: 21:15 (- max min) (3 times)
TR missed opt: case-arrow.rkt 21:2 (+ min (/ (* (- max min) x) p)) -- all args float-arg-expr, result not Float -- caused by: 21:5 min, 21:18 max, 21:22 min, 21:27 x, 21:30 p (4 times)
)
#lang typed/racket
;; Typechecking functions with case-> types causes the body to be typechecked
;; multiple times, which is fine, except that it used to cause the type table
;; to only have information for the last branch (clobbering). This would cause
;; this program to be optimized, which is not safe.
(define p (- (expt 2 31) 1))
(define A (expt 7 5))
(define x 42)
(: gen-random : (case-> (Integer Integer Exact-Rational)
(Float Float Float)))
(define (gen-random min max)
(set! x (modulo (* A x) p))
(+ min (/ (* (- max min) x) p)))
(void (gen-random 2.3 7.4))
(void (gen-random 2 7))

View File

@ -4,7 +4,7 @@
"../utils/utils.rkt" "../utils/utils.rkt"
(contract-req) (contract-req)
(rep type-rep object-rep) (rep type-rep object-rep)
(only-in (types utils) tc-results?) (types utils union)
(utils tc-utils) (utils tc-utils)
(env init-envs)) (env init-envs))
@ -15,7 +15,23 @@
(define (add-typeof-expr e t) (define (add-typeof-expr e t)
(when (optimize?) (when (optimize?)
(hash-set! table e t))) (hash-update! table e
;; when typechecking a case-> type, types get added for
;; the same subexpression multiple times, combine them
(lambda (old)
(match* (old t)
[((tc-result1: old-t) (tc-result1: t-t))
(ret (Un old-t t-t))]
[((tc-results: old-ts) (tc-results: t-ts))
;; filters don't matter at this point, since only
;; the optimizer reads this table
(unless (= (length old-ts) (length t-ts))
(int-err
"type table: number of values don't agree ~a ~a"
old-ts t-ts))
(ret (map Un old-ts t-ts))]
[(_ _) t])) ; irrelevant to the optimizer, just clobber
t)))
(define (type-of e) (define (type-of e)
(hash-ref table e (hash-ref table e