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:
parent
60c418b20e
commit
87a53159dd
24
collects/tests/typed-racket/optimizer/tests/case-arrow.rkt
Normal file
24
collects/tests/typed-racket/optimizer/tests/case-arrow.rkt
Normal 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))
|
|
@ -4,7 +4,7 @@
|
|||
"../utils/utils.rkt"
|
||||
(contract-req)
|
||||
(rep type-rep object-rep)
|
||||
(only-in (types utils) tc-results?)
|
||||
(types utils union)
|
||||
(utils tc-utils)
|
||||
(env init-envs))
|
||||
|
||||
|
@ -15,7 +15,23 @@
|
|||
|
||||
(define (add-typeof-expr e t)
|
||||
(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)
|
||||
(hash-ref table e
|
||||
|
|
Loading…
Reference in New Issue
Block a user