>From 7e0e92083192ff75bdda28882e428bdece32d448 Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Mon, 10 Dec 2018 18:27:12 +1300
Subject: [PATCH 2/2] Restore typevar (un)renaming via real name table

Use the real name table to register type variables aliases as they're
assigned, and to subsequently unalias them when they are displayed to
the user. This preserves pretty scrutiny messages while avoiding
expansion-related issues like #1563.
---
 scrutinizer.scm         | 17 +++++++++++------
 support.scm             |  2 +-
 tests/scrutiny.expected |  2 +-
 3 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index a8c8b3de..191c245e 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -153,11 +153,14 @@
 (define-inline (value-type? t)
   (or (struct-type? t) (memq t value-types)))
 
-(define (type-name x)
-  (let ((t (strip-syntax x)))
-    (if (refinement-type? t)
-	(sprintf "~a-~a" (string-intersperse (map conc (second t)) "/") (third t))
-	(sprintf "~a" t))))
+(define (type-name t)
+  (let ((t* (let loop ((t t)) ; unrename typevars
+	      (cond ((symbol? t) (or (get-real-name t) t))
+		    ((pair? t) (cons (loop (car t)) (loop (cdr t))))
+		    (else t)))))
+    (if (refinement-type? t*)
+	(sprintf "~a-~a" (string-intersperse (map conc (cadr t*)) "/") (caddr t*))
+	(sprintf "~a" t*))))
 
 (define specialization-statistics '())
 (define trail '())
@@ -1224,7 +1227,9 @@
 		     (set! typeenv
 		       (append (map (lambda (v)
 				      (let ((v (if (symbol? v) v (first v))))
-					(cons v (gensym v))))
+					(let ((v* (gensym v)))
+					  (set-real-name! v* v)
+					  (cons v v*))))
 				    typevars)
 			       typeenv))
 		     (set! constraints 
diff --git a/support.scm b/support.scm
index fbf8e4f9..80384afe 100644
--- a/support.scm
+++ b/support.scm
@@ -1415,7 +1415,7 @@
 (define (clear-real-name-table!)
   (set! real-name-table (make-vector real-name-table-size '())))
 
-(define (set-real-name! name rname)	; Used only in compiler.scm
+(define (set-real-name! name rname)
   (hash-table-set! real-name-table name rname))
 
 ;; TODO: Find out why there are so many lookup functions for this and
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index e445ebbb..665d7008 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -40,7 +40,7 @@ Warning: at toplevel:
   (scrutiny-tests.scm:29) in procedure call to `scheme#+', expected argument #2 of type `number' but was given an argument of type `symbol'
 
 Warning: at toplevel:
-  assignment of value of type `fixnum' to toplevel variable `scheme#car' does not match declared type `(forall (a335) (procedure scheme#car ((pair a335 *)) a335))'
+  assignment of value of type `fixnum' to toplevel variable `scheme#car' does not match declared type `(forall (a) (procedure scheme#car ((pair a *)) a))'
 
 Warning: at toplevel:
   expected a single result in `let' binding of `g19', but received 2 results
-- 
2.11.0