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

[Felix]

From: Mario Domenech Goulart <address@hidden>
Subject: Re: [Chicken-hackers] [PATCH] handle runaway union types in scrutinizer
Date: Mon, 31 Oct 2011 12:05:43 -0400

> Hi Felix,
> 
> On Mon, 31 Oct 2011 10:28:19 +0100 (CET) Felix <address@hidden> wrote:
> 
>> 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.
> 
> Does this patch depend on another one?  I can't apply it directly on the
> master HEAD.
> 

Here it is again. Please try this one.


cheers,
felix

>From 6952d9c5e145d6d7bd5e34c52f1c72077cd50ab1 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Tue, 1 Nov 2011 12:42:06 +0100
Subject: [PATCH] cut of union types above a certain length

---
 scrutinizer.scm |    9 +++++++--
 1 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index a04220a..967f82e 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,9 +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