[Chicken-hackers] [PATCH] smash "list"/"list-of" types

[Felix]

The attached patch fixes a bug in the specialization machinery where
"list" and "list-of" types are incorrectly retained for local bindings,
even when a procedure call may potentially convert a proper list into
an improper one. Found by Peter, fixes bug #803.


cheers,
felix

>From fe17c647988d8e4e3238d01f90781859cbd1dfe8 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Sat, 21 Apr 2012 15:51:38 +0200
Subject: [PATCH] when calling a possibly mutating procedure, invalidate 
list-of/list types by converting them to type pair (fixes #803)

---
 scrutinizer.scm                 |   14 ++++++++++----
 tests/specialization-test-1.scm |    5 +++++
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 782cd60..3492a88 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -829,7 +829,9 @@
       rn)))
       
 
-;;; replace pair/vector types with components to component-less variants in 
env or blist
+;;; replace pair/vector types with components to variants with undetermined
+;;  component types (used for env or blist); also convert "list[-of]" types
+;;  into "pair", since mutation may take place
 
 (define (smash-component-types! lst where)
   (do ((lst lst (cdr lst)))
@@ -838,11 +840,15 @@
               (change! (cute set-cdr! (car lst) <>)))
       (when (pair? t)
        (case (car t)
-         ((list-of vector-of)
+         ((vector-of)
           (dd "  smashing `~s' in ~a" (caar lst) where)
-          (change! (if (eq? 'list-of (car t)) 'list 'vector))
+          (change! 'vector)
           (car t))
-         ((pair vector list)
+         ((list-of list)
+          (dd "  smashing `~s' in ~a" (caar lst) where)
+          (change! 'pair)
+          (car t))
+         ((pair vector)
           (dd "  smashing `~s' in ~a" (caar lst) where)
           (change! (car t))
           (car t))
diff --git a/tests/specialization-test-1.scm b/tests/specialization-test-1.scm
index 9d380fc..0157420 100644
--- a/tests/specialization-test-1.scm
+++ b/tests/specialization-test-1.scm
@@ -36,4 +36,9 @@ return n;}
 
 (assert (= 2 (spec 1)))
 
+;; "smash-component-types!" had to convert "list[-of]" types to "pair" (#803)
+(let ((x (list 'a)))
+  (set-cdr! x x)
+  (assert (not (list? x))))
+
 )
-- 
1.6.0.4