suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed tautology/contradiction recording to work with case-lambda.

Browse Source 
original commit: 5395dbca122c534db3d70139c871e0bc4b91515f
This commit is contained in:
Vincent St-Amour 2010-10-06 16:20:57 -04:00
parent 9e13c1a6d9
commit 105b82fb70
2 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/typed-scheme/typecheck/tc-if.rkt
View File

@ -58,10 +58,22 @@
;(printf "new-els-props: ~a\n" new-els-props)
;; record reachability
(when (not (unbox flag+))
(add-contradiction tst))
(when (not (unbox flag-))
(add-tautology tst))
;; since we may typecheck a given piece of code multiple times in different
;; contexts, we need to take previous results into account
(cond [(and (not (unbox flag+)) ; maybe contradiction
;; to be an actual contradiction, we must have either previously
;; recorded this test as a contradiction, or have never seen it
;; before
(not (tautology? tst))
(not (neither? tst)))
(add-contradiction tst)]
[(and (not (unbox flag-)) ; maybe tautology
;; mirror case
(not (contradiction? tst))
(not (neither? tst)))
(add-tautology tst)]
[else
(add-neither tst)])
;; if we have the same number of values in both cases
(cond [(= (length ts) (length us))

13
collects/typed-scheme/types/type-table.rkt
View File

@ -55,19 +55,20 @@
;; keeps track of expressions that always evaluate to true or always evaluate
;; to false, so that the optimizer can eliminate dead code
;; 3 possible values: 'tautology 'contradiction 'neither
(define tautology-contradiction-table (make-hasheq))
(define-values (add-tautology add-contradiction)
(define-values (add-tautology add-contradiction add-neither)
(let ()
(define ((mk t?) e)
(when (optimize?)
(hash-set! tautology-contradiction-table e t?)))
(values (mk #t) (mk #f))))
(define-values (tautology? contradiction?)
(values (mk 'tautology) (mk 'contradiction) (mk 'neither))))
(define-values (tautology? contradiction? neither?)
(let ()
(define ((mk t?) e)
(eq? t? (hash-ref tautology-contradiction-table e 'not-there)))
(values (mk #t) (mk #f))))
(values (mk 'tautology) (mk 'contradiction) (mk 'neither))))
(p/c [add-typeof-expr (syntax? tc-results? . -> . any/c)]
[type-of (syntax? . -> . tc-results?)]
@ -79,5 +80,7 @@
[make-struct-table-code (-> syntax?)]
[add-tautology (syntax? . -> . any/c)]
[add-contradiction (syntax? . -> . any/c)]
[add-neither (syntax? . -> . any/c)]
[tautology? (syntax? . -> . boolean?)]
[contradiction? (syntax? . -> . boolean?)])
[contradiction? (syntax? . -> . boolean?)]
[neither? (syntax? . -> . boolean?)])