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

Compute type tooltips better for macro expansions

Browse Source 
Macros often expand into forms where the subforms have
the same syntax location as the entire form, which means
a naive approach gives confusing type tooltips on macro
expressions.

Instead, only keep the latest (outermost) type tooltip
for a given expression.

We could instead compute whether a given piece of syntax
is a subform of another at a given location or not, but
that check is expensive and we don't want to do that on
every update of the type table.
This commit is contained in:
Asumu Takikawa 2014-11-17 19:40:31 -05:00
parent a64dadc78c
commit c2abbc700d
1 changed files with 54 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -34,13 +34,29 @@
(provide ;; Syntax class for is-ignored? (provide ;; Syntax class for is-ignored?
ignore-table^) ignore-table^)
(define table (make-hasheq)) (define type-table (make-hasheq))
(define (reset-type-table) (set! table (make-hasheq))) ;; This table keeps track of the same types as the type table
;; but indexed on source location for tooltips and only retaining the
;; last type for a given location.
(define tooltip-table (make-hash))
(define (reset-type-table) (set! type-table (make-hasheq)))
(define (add-typeof-expr e t) (define (add-typeof-expr e t)
(when (and (syntax-position e) (syntax-span e))
;; Only keep the latest type for a given location, which means that
;; since typechecking proceeds inside-out we will only record the most
;; relevant type for the expansion of macros (which often have misleading
;; syntax locations on the subexpressions). A limitation of this approach
;; is that for function bodies we may not retain all the types from case->
;; branches.
(hash-set!
tooltip-table
(list (syntax-position e) (syntax-span e))
(list e t)))
(when (optimize?) (when (optimize?)
(hash-update! table e (hash-update! type-table e
;; when typechecking a case-> type, types get added for ;; when typechecking a case-> type, types get added for
;; the same subexpression multiple times, combine them ;; the same subexpression multiple times, combine them
(lambda (old) (lambda (old)
@ -59,7 +75,7 @@
t))) t)))
(define (type-of e) (define (type-of e)
(hash-ref table e (hash-ref type-table e
(lambda () (int-err (format "no type for ~a at: ~a line ~a col ~a" (lambda () (int-err (format "no type for ~a at: ~a line ~a col ~a"
(syntax->datum e) (syntax->datum e)
(syntax-source e) (syntax-source e)
@ -77,10 +93,10 @@
(define (type-table->tooltips) (define (type-table->tooltips)
(define type-names (current-type-names)) (define type-names (current-type-names))
(for/fold ([tooltips '()]) (for/fold ([tooltips '()])
([(stx results) (in-hash table)] ([(pos+span stx+results) (in-hash tooltip-table)]
#:when (and (syntax-position stx) #:unless (error-at-stx-loc? (car stx+results)))
(syntax-span stx)) (match-define (list pos span) pos+span)
#:unless (error-at-stx-loc? stx)) (match-define (list 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
@ -103,7 +119,14 @@
#:indent 2)))))] #:indent 2)))))]
[(tc-any-results: _) "AnyValues"])) [(tc-any-results: _) "AnyValues"]))
(cond [(not printed-type-thunks) tooltips] (cond [(not printed-type-thunks) tooltips]
;; Put the tooltip only on the parens for compound expressions [else
(append (make-tooltip-vector stx printed-type-thunks pos span)
tooltips)])))
;; make-tooltip-vector : Syntax Thunk Int Int -> (Listof Vector)
;; Compute the tooltip info to put in syntax properties
(define (make-tooltip-vector stx type-thunk position span)
(cond ;; Put the tooltip only on the parens for compound expressions
;; but put them on the whole expression for literals. This avoids ;; but put them on the whole expression for literals. This avoids
;; overlapping tooltips. ;; overlapping tooltips.
[(or (not (pair? (syntax-e stx))) [(or (not (pair? (syntax-e stx)))
@ -113,23 +136,21 @@
(let ([fst (car (syntax-e stx))]) (let ([fst (car (syntax-e stx))])
(and (identifier? fst) (and (identifier? fst)
(free-identifier=? fst #'quote)))) (free-identifier=? fst #'quote))))
(cons (vector stx (list (vector stx
(sub1 (syntax-position stx)) (sub1 (syntax-position stx))
(+ (sub1 (syntax-position stx)) (syntax-span stx)) (+ (sub1 (syntax-position stx)) (syntax-span stx))
printed-type-thunks) type-thunk))]
tooltips)]
[else [else
(list* (vector stx (list (vector stx
(sub1 (syntax-position stx)) (sub1 (syntax-position stx))
(syntax-position stx) (syntax-position stx)
printed-type-thunks) type-thunk)
(vector stx (vector stx
(sub1 (+ (sub1 (syntax-position stx)) (sub1 (+ (sub1 (syntax-position stx))
(syntax-span stx))) (syntax-span stx)))
(+ (sub1 (syntax-position stx)) (+ (sub1 (syntax-position stx))
(syntax-span stx)) (syntax-span stx))
printed-type-thunks) type-thunk))]))
tooltips)])))
;; For expressions in test position keep track of if it evaluates to true/false ;; For expressions in test position keep track of if it evaluates to true/false
(define test-position-table/true (make-hasheq)) (define test-position-table/true (make-hasheq))