[Chicken-hackers] [PATCH] smash types in implicit global type declarations

[Felix]

The attached patch fixes a bug in the scrutinizer that may cause "implicit"
type declarations for global variables to be incorrect. An example:

(declare (block))       ; globals are known
(define foo (make-vector 100 #f))  ; foo is assumed to be "(vector-of boolean)"
(vector-set! foo 0 99)
(print (+ (vector-ref foo 0) 1))   ; triggers warning

The flow-analysis "smashes" known type information for variables holding
mutable data, but did not do so for globals with known values (compiling
in block- or local-mode or using modules). With this patch it does.


cheers,
felix

>From 6726880ceff7f50a0f25ebc8107f3e49a17db15e Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Tue, 19 Jun 2012 19:46:26 +0200
Subject: [PATCH] smash types in implicit global type-declarations; added test

---
 distribution/manifest      |    1 +
 scrutinizer.scm            |   16 ++++++++++------
 tests/runtests.sh          |    3 +++
 tests/scrutiny-tests-3.scm |   12 ++++++++++++
 4 files changed, 26 insertions(+), 6 deletions(-)
 create mode 100644 tests/scrutiny-tests-3.scm

diff --git a/distribution/manifest b/distribution/manifest
index 6c02c34..d4b641b 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -143,6 +143,7 @@ tests/module-tests-compiled.scm
 tests/scrutiny-tests.scm
 tests/typematch-tests.scm
 tests/scrutiny-tests-2.scm
+tests/scrutiny-tests-3.scm
 tests/scrutiny.expected
 tests/syntax-rule-stress-test.scm
 tests/syntax-tests.scm
diff --git a/scrutinizer.scm b/scrutinizer.scm
index dbf6481..8069ac6 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -614,12 +614,15 @@
                                   (or (not (variable-visible? var))
                                       (not (eq? (variable-mark var 
'##compiler#inline) 
                                                 'no))))
-                         (debugging '|I| (sprintf "(: ~s ~s)" var rt))
-                         ;; [2] sets property, but lambda has already been 
walked,
-                         ;; so no type-checks are generated (see also [1], 
above)
-                         ;; note that implicit declarations are not enforcing
-                         (mark-variable var '##compiler#declared-type)
-                         (mark-variable var '##compiler#type rt))))
+                         (let ((rtlst (list (cons #f (tree-copy rt)))))
+                           (smash-component-types! rtlst "global")
+                           (let ((rt (cdar rtlst)))
+                             (debugging '|I| (sprintf "(: ~s ~s)" var rt))
+                             ;; [2] sets property, but lambda has already been 
walked,
+                             ;; so no type-checks are generated (see also [1], 
above)
+                             ;; note that implicit declarations are not 
enforcing
+                             (mark-variable var '##compiler#declared-type)
+                             (mark-variable var '##compiler#type rt))))))
                    (when b
                      (cond ((eq? 'undefined (cdr b)) (set-cdr! b rt))
                            #;(strict-variable-types
@@ -834,6 +837,7 @@
 ;;  into "pair", since mutation may take place
 
 (define (smash-component-types! lst where)
+  ;; assumes list of the form "((_ . T1) ...)"
   (do ((lst lst (cdr lst)))
       ((null? lst))
     (let loop ((t (cdar lst))
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 9f9f7ee..d21b704 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -96,6 +96,9 @@ fi
 
 diff -bu scrutiny-2.expected scrutiny-2.out
 
+$compile scrutiny-tests-3.scm -specialize -block -ignore-repository -types 
$TYPESDB
+./a.out
+
 echo "======================================== specialization tests ..."
 rm -f foo.types foo.import.*
 $compile specialization-test-1.scm -emit-type-file foo.types -specialize \
diff --git a/tests/scrutiny-tests-3.scm b/tests/scrutiny-tests-3.scm
new file mode 100644
index 0000000..41b46fb
--- /dev/null
+++ b/tests/scrutiny-tests-3.scm
@@ -0,0 +1,12 @@
+;;;; scrutiny-tests-3.scm - scrutinizer-tests, compiled in block mode and 
executed
+
+
+;;; ensure implicit global type-declarations are "smashed" (i.e. have
+;;; their component types invalidated, due to possible mutation)
+
+(define vec (make-vector 10 #f))
+(vector-set! vec 0 99)
+(assert
+ (compiler-typecase vec
+   ((vector-of boolean) #f)
+   (vector #t)))
-- 
1.6.0.4