Re: A facility for debugging type issues

[megane]

Evan Hanson  writes:

> Hey megane!
>
> On 2021-04-10 11:24, megane wrote:
>> here's a POC tool I've been using for a year. It prints the types known to
>> scrutinizer in the current scope.
>
> Finally having a look at this, and I have to say, it is very cool. It
> still applies cleanly too! :)
>
> What were you thinking ought to be done with it?

This patch was just for probing if there is interested for this kind of
tool.

I remember people asking for a tool which would show the types
scrutinizer knows. This is one way to show those types.

Was this the kind of thing people were looking for?

> Personally I think a
> facility like this would be very nice to add "for real", if it were
> guarded behind a debugging flag of some kind (maybe another "-debug"
> option?), or perhaps only enabled with DEBUGBUILD. So, normal
> compilation would just ignore these nodes, but we could still add the
> feature properly. Was that your thinking?

I would not hide this in any way. User can use it to

1. Debug issues with type related warnings in normal code

2. Build intuition about how the scrutinizer works on different kind of
   code.

I use it for the first purpose quite frequently, and have a keyboard
shortcut to insert the hole.

Here's an example of usage:

(let ((foo (lambda (x)
 (let loop ((y 0))
   (the * '(##core#type-hole "hole 1"))
   (if (= 10 y)
   (if (pair? x)
   (let ((f foo))
 (the * '(##core#type-hole "true branch"))
 x)
   (begin
 (the * '(##core#type-hole "false branch"))
 x))
   (cons y (loop (add1 y
  (the * '(##core#type-hole "hole 3")))

Output:
;; Type hole encountered:
;;  x : *
;;   loop : *
;;  y : *
;;   
;;   "hole 1"
;;
;; Type hole encountered:
;;   loop : *
;;  y : number
;;  x : pair
;;  f : *
;;   
;;   "true branch"
;;
;; Type hole encountered:
;;   loop : *
;;  y : number
;;  x : (not pair)
;;   
;;   "false branch"
;;
;; Type hole encountered:
;;   foo : (procedure foo (*) . *)
;;   
;;   "hole 3"

Before type-hole I used to use the more tedious pattern

  (compiler-typecase  ((not *) 1))

to inspect the types.

As for what the nodes should evaluate to, 3 ideas would be
1. To drop them completely from the output
2. To turn holes into calls to error
3. To stop the compilation with error after phase X

Re: A facility for debugging type issues

[Evan Hanson]

Hey megane!

On 2021-04-10 11:24, megane wrote:
> here's a POC tool I've been using for a year. It prints the types known to
> scrutinizer in the current scope.

Finally having a look at this, and I have to say, it is very cool. It
still applies cleanly too! :)

What were you thinking ought to be done with it? Personally I think a
facility like this would be very nice to add "for real", if it were
guarded behind a debugging flag of some kind (maybe another "-debug"
option?), or perhaps only enabled with DEBUGBUILD. So, normal
compilation would just ignore these nodes, but we could still add the
feature properly. Was that your thinking?

Cheers,

Evan

A facility for debugging type issues

[megane]

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:

  (+ )

would tell that number is expected.

>From 89e2a655d9ba53b64d3d5186c1a4902883feaca7 Mon Sep 17 00:00:00 2001
From: megane 
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: Nega