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

Handle case-> types better for tooltips

Browse Source 
The use of case-> can cause an expression to get
typechecked multiple times, so the tooltips should reflect
all of the passes.
This commit is contained in:
Asumu Takikawa 2014-11-18 16:25:28 -05:00
parent c2abbc700d
commit c170b8288c
1 changed files with 37 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt
View File

@ -36,6 +36,12 @@
(define type-table (make-hasheq)) (define type-table (make-hasheq))
;; A struct that helps track tooltip types for a given location
;; seen - (Listof Syntax)
;; results - a TC-Result
(struct tooltip (seen results) #:transparent)
;; tooltip-table : (Hash (List Int Int) tooltip)
;; This table keeps track of the same types as the type table ;; This table keeps track of the same types as the type table
;; but indexed on source location for tooltips and only retaining the ;; but indexed on source location for tooltips and only retaining the
;; last type for a given location. ;; last type for a given location.
@ -48,19 +54,27 @@
;; Only keep the latest type for a given location, which means that ;; Only keep the latest type for a given location, which means that
;; since typechecking proceeds inside-out we will only record the most ;; since typechecking proceeds inside-out we will only record the most
;; relevant type for the expansion of macros (which often have misleading ;; relevant type for the expansion of macros (which often have misleading
;; syntax locations on the subexpressions). A limitation of this approach ;; syntax locations on the subexpressions).
;; is that for function bodies we may not retain all the types from case-> (hash-update!
;; branches.
(hash-set!
tooltip-table tooltip-table
(list (syntax-position e) (syntax-span e)) (list (syntax-position e) (syntax-span e))
(list e t))) (λ (old)
(match-define (tooltip seen results) old)
(if (member e seen)
;; the car should be the latest stx for the location
(if (equal? e (car seen))
;; combine types seen at the latest
(tooltip seen ((combine t) results))
old)
(tooltip (cons e seen) t)))
(tooltip (list e) t)))
(when (optimize?) (when (optimize?)
(hash-update! type-table e (hash-update! type-table e (combine t) t)))
;; when typechecking a case-> type, types get added for
;; the same subexpression multiple times, combine them ;; when typechecking a case-> type, types get added for
(lambda (old) ;; the same subexpression multiple times, combine them
(match* (old t) (define ((combine new) old)
(match* (old new)
[((tc-result1: old-t) (tc-result1: t-t)) [((tc-result1: old-t) (tc-result1: t-t))
(ret (Un old-t t-t))] (ret (Un old-t t-t))]
[((tc-results: old-ts) (tc-results: t-ts)) [((tc-results: old-ts) (tc-results: t-ts))
@ -71,8 +85,7 @@
"type table: number of values don't agree ~a ~a" "type table: number of values don't agree ~a ~a"
old-ts t-ts)) old-ts t-ts))
(ret (map Un old-ts t-ts))] (ret (map Un old-ts t-ts))]
[(_ _) t])) ; irrelevant to the optimizer, just clobber [(_ _) new])) ; irrelevant to the optimizer, just clobber
t)))
(define (type-of e) (define (type-of e)
(hash-ref type-table e (hash-ref type-table e
@ -94,9 +107,9 @@
(define type-names (current-type-names)) (define type-names (current-type-names))
(for/fold ([tooltips '()]) (for/fold ([tooltips '()])
([(pos+span stx+results) (in-hash tooltip-table)] ([(pos+span stx+results) (in-hash tooltip-table)]
#:unless (error-at-stx-loc? (car stx+results))) #:unless (error-at-stx-loc? (car (tooltip-seen stx+results))))
(match-define (list pos span) pos+span) (match-define (list pos span) pos+span)
(match-define (list stx results) stx+results) (match-define (tooltip (cons stx _) results) stx+results)
;; `printed-type-thunks` is #f if we should skip the type because it's ;; `printed-type-thunks` is #f if we should skip the type because it's
;; something not worth printing like Bottom or Error. ;; something not worth printing like Bottom or Error.
(define printed-type-thunks (define printed-type-thunks