Hi, here's a POC tool I've been using for a year. It prints the types known to scrutinizer in the current scope.
I repeat, this is NOT a patch supposed to be added to core as is. Some issues: - It uses a dirty hack: prints the info whenever '(##core#type-hole ...) is seen. - The usage is not pretty (I just use a editor macro to insert the form) A nice addition would be if it told what is the expected type: (+ <hole>) would tell that number is expected.
>From 89e2a655d9ba53b64d3d5186c1a4902883feaca7 Mon Sep 17 00:00:00 2001 From: megane <megan...@gmail.com> Date: Mon, 2 Sep 2019 10:36:04 +0300 Subject: [PATCH] * scrutinizer.scm (r-type-hole) : Add helper for inspecting types in scope (define (foo l) (let* ([x (cons '(1) 1)] [y 'a] [z (vector 1)] [foo (the (list --> fixnum) length)]) (the * '(##core#type-hole before-smash)) (length l) (set-cdr! x 1) (the * '(##core#type-hole after-smash)))) --> Type hole encountered: l : * x : (pair (list fixnum) fixnum) y : symbol z : (vector fixnum) foo : (list -> fixnum) ---------------------------------------- before-smash Type hole encountered: l : list x : pair y : symbol z : (vector *) foo : (list -> fixnum) ---------------------------------------- after-smash --- scrutinizer.scm | 43 +++++++++++++++++++++++ support.scm | 7 +++- tests/scrutinizer-message-format.expected | 6 ++++ tests/test-scrutinizer-message-format.scm | 5 +++ 4 files changed, 60 insertions(+), 1 deletion(-) diff --git a/scrutinizer.scm b/scrutinizer.scm index 75cbeb15..618fa5e3 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -439,6 +439,16 @@ class params loc dest flow) #;(dd "walk: ~a ~s (loc: ~a, dest: ~a, flow: ~a, blist: ~a, e: ~a)" class params loc dest flow blist e) + + ;; Type hole + ;; '(##core#type-hole symbol-or-name) + (and-let* (((eq? 'quote class)) + (p1 (and (pair? (first params)) (first params))) + ((eq? '##core#type-hole (car p1))) + (name (and (pair? (cdr p1)) (cadr p1))) + ((or (symbol? name) (string? name)))) + (r-type-hole name e (lambda (id) (car (variable-result id e loc n flow))))) + (set! d-depth (add1 d-depth)) (let ((results (case class @@ -3010,4 +3020,37 @@ (sprintf "~%~%The suggested alternative is ~a." (variable-from-module suggestion)) ""))) + +(define (r-type-hole hole-name e get-type) + (let* ((ids (reverse + (filter (lambda (x) (not (variable-mark x '##compiler#temp-var))) + (map car e)))) + (entries (map (lambda (id) (cons id (get-type id))) ids))) + (define (name-str id) + (symbol->string (if (##sys#debug-mode?) id (strip-syntax id)))) + + (flush-output) + (with-output-to-port (current-error-port) + (lambda () + (print "\nType hole encountered:") + (let* ((max-len (apply max 0 (map (o string-length name-str car) entries))) + (ind (+ 5 max-len)) + (seen '())) + (for-each + (lambda (id.t) + (let* ((id (car id.t)) + (type (cdr id.t)) + (name (name-str id))) + (unless (member name seen) + (set! seen (cons name seen)) + (printf " ~a~a : ~a\n" + (make-string (- max-len (string-length name)) #\ ) + name + (substring (string-add-indent (type->pp-string type) + (make-string ind #\ )) + (+ 2 ind)))))) + entries)) + (print " ----------------------------------------") + (printf " ~s\n" hole-name) + (flush-output))))) ) diff --git a/support.scm b/support.scm index b93fb8ef..bb1af4e9 100644 --- a/support.scm +++ b/support.scm @@ -218,6 +218,11 @@ (cond ((or (zero? n) (null? vars)) (or rest '())) (else (cons (car vars) (loop (cdr vars) (sub1 n)))) ) ) ) +(define (gentmp prefix) + (let ((s (gensym prefix))) + (mark-variable s '##compiler#temp-var #t) + s)) + ;; XXX: Put this too in c-platform or c-backend? (define (c-ify-string str) (list->string @@ -336,7 +341,7 @@ (constant? h) (equal? h '(##sys#void)) ) ) (loop (cdr xs)) ) - (else `(let ((,(gensym 't) ,(car xs))) + (else `(let ((,(gentmp 't) ,(car xs))) ,(loop (cdr xs))) ) ) ) ) ;; Only used in batch-driver: move it there? diff --git a/tests/scrutinizer-message-format.expected b/tests/scrutinizer-message-format.expected index 7688ca1f..b7d8f3d5 100644 --- a/tests/scrutinizer-message-format.expected +++ b/tests/scrutinizer-message-format.expected @@ -338,6 +338,12 @@ Warning: Negative vector index Procedure `vector-ref' from module `scheme' is called with a negative index -1. +Type hole encountered: + x : list + y : fixnum + ---------------------------------------- + test-type-hole + Warning: Wrong number of arguments In file `test-scrutinizer-message-format.scm:XXX', In module `m', diff --git a/tests/test-scrutinizer-message-format.scm b/tests/test-scrutinizer-message-format.scm index 38f3e7a3..d9d19b59 100644 --- a/tests/test-scrutinizer-message-format.scm +++ b/tests/test-scrutinizer-message-format.scm @@ -46,6 +46,11 @@ (: deprecated-foo2 (deprecated foo)) (define deprecated-foo2 2) + (define (r-type-hole x) + (length x) + (let ((y 1)) + '(##core#type-hole test-type-hole))) + (define (toplevel-foo) (define (local-bar) (define (r-proc-call-argument-count-mismatch) (cons '())) -- 2.17.1