From d02b540d0bfac98f507bc2385e459084471856ba Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Mon, 17 Nov 2014 19:40:31 -0500 Subject: [PATCH] Compute type tooltips better for macro expansions 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. original commit: c2abbc700d6b8233e4a52f518d8056579d696b5f --- .../typed-racket/types/type-table.rkt | 87 ++++++++++++------- 1 file changed, 54 insertions(+), 33 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt index f7d3aa6b..f8607cfb 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt @@ -34,13 +34,29 @@ (provide ;; Syntax class for is-ignored? 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) + (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?) - (hash-update! table e + (hash-update! type-table e ;; when typechecking a case-> type, types get added for ;; the same subexpression multiple times, combine them (lambda (old) @@ -59,7 +75,7 @@ t))) (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" (syntax->datum e) (syntax-source e) @@ -77,10 +93,10 @@ (define (type-table->tooltips) (define type-names (current-type-names)) (for/fold ([tooltips '()]) - ([(stx results) (in-hash table)] - #:when (and (syntax-position stx) - (syntax-span stx)) - #:unless (error-at-stx-loc? stx)) + ([(pos+span stx+results) (in-hash tooltip-table)] + #:unless (error-at-stx-loc? (car stx+results))) + (match-define (list pos span) pos+span) + (match-define (list stx results) stx+results) ;; `printed-type-thunks` is #f if we should skip the type because it's ;; something not worth printing like Bottom or Error. (define printed-type-thunks @@ -103,34 +119,39 @@ #:indent 2)))))] [(tc-any-results: _) "AnyValues"])) (cond [(not printed-type-thunks) tooltips] - ;; Put the tooltip only on the parens for compound expressions - ;; but put them on the whole expression for literals. This avoids - ;; overlapping tooltips. - [(or (not (pair? (syntax-e stx))) - ;; special-case quote because there's no worry of overlap - ;; in a (quote ...) and because literals expand out to a - ;; use of quote. - (let ([fst (car (syntax-e stx))]) - (and (identifier? fst) - (free-identifier=? fst #'quote)))) - (cons (vector stx - (sub1 (syntax-position stx)) - (+ (sub1 (syntax-position stx)) (syntax-span stx)) - printed-type-thunks) - tooltips)] [else - (list* (vector stx - (sub1 (syntax-position stx)) - (syntax-position stx) - printed-type-thunks) - (vector stx - (sub1 (+ (sub1 (syntax-position stx)) - (syntax-span stx))) - (+ (sub1 (syntax-position stx)) - (syntax-span stx)) - printed-type-thunks) + (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 + ;; overlapping tooltips. + [(or (not (pair? (syntax-e stx))) + ;; special-case quote because there's no worry of overlap + ;; in a (quote ...) and because literals expand out to a + ;; use of quote. + (let ([fst (car (syntax-e stx))]) + (and (identifier? fst) + (free-identifier=? fst #'quote)))) + (list (vector stx + (sub1 (syntax-position stx)) + (+ (sub1 (syntax-position stx)) (syntax-span stx)) + type-thunk))] + [else + (list (vector stx + (sub1 (syntax-position stx)) + (syntax-position stx) + type-thunk) + (vector stx + (sub1 (+ (sub1 (syntax-position stx)) + (syntax-span stx))) + (+ (sub1 (syntax-position stx)) + (syntax-span stx)) + type-thunk))])) + ;; 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/false (make-hasheq))