[Chicken-hackers] [PATCH] handle runaway union types in scrutinizer

[Felix]

The attached patch cuts off union ("or") types beyond a certain
length.  This can happen in complex list literals and pattern matching
constructs and slows compilation down to a crawl since these types are
again and again walked during simplification. 

This fixes ticket #711.

>From bb412b1af68279fc86007bb09e9e6a79d94a3bc1 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Mon, 31 Oct 2011 10:22:36 +0100
Subject: [PATCH] 
=?utf-8?q?cut=20off=20union=20types=20above=20length=2020=20to=20catch=20overly=20complex=20types;=20handle=20case=20of=20two=20'(list=20...)'=20types=20in=20type<=3D=3F?=

---
 scrutinizer.scm |   11 ++++++++---
 1 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index a04220a..2deb68c 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -104,6 +104,7 @@
 
 (define-constant +fragment-max-length+ 6)
 (define-constant +fragment-max-depth+ 4)
+(define-constant +maximal-union-type-length+ 20)
 
 
 (define specialization-statistics '())
@@ -1239,10 +1240,13 @@
                               constraints))
                     (simplify (third t))))
                  ((or)
-                  (let ((ts (map simplify (cdr t))))
-                    (cond ((= 1 (length ts)) (car ts))
+                  (let* ((ts (map simplify (cdr t)))
+                         (tslen (length ts)))
+                    (cond ((= 1 tslen) (car ts))
                           ((null? ts) '*)
+                          ((> tslen +maximal-union-type-length+)
+                           (d "union-type cutoff! (~a): ~s" tslen ts)
+                           '*)
                           ((every procedure-type? ts)
                            (if (any (cut eq? 'procedure <>) ts)
                                'procedure
-- 
1.6.0.4