From fe17c647988d8e4e3238d01f90781859cbd1dfe8 Mon Sep 17 00:00:00 2001
From: felix <felix@call-with-current-continuation.org>
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
|
b
|
|
829 | 829 | rn))) |
830 | 830 | |
831 | 831 | |
832 | | ;;; replace pair/vector types with components to component-less variants in env or blist |
| 832 | ;;; replace pair/vector types with components to variants with undetermined |
| 833 | ;; component types (used for env or blist); also convert "list[-of]" types |
| 834 | ;; into "pair", since mutation may take place |
833 | 835 | |
834 | 836 | (define (smash-component-types! lst where) |
835 | 837 | (do ((lst lst (cdr lst))) |
… |
… |
|
838 | 840 | (change! (cute set-cdr! (car lst) <>))) |
839 | 841 | (when (pair? t) |
840 | 842 | (case (car t) |
841 | | ((list-of vector-of) |
| 843 | ((vector-of) |
842 | 844 | (dd " smashing `~s' in ~a" (caar lst) where) |
843 | | (change! (if (eq? 'list-of (car t)) 'list 'vector)) |
| 845 | (change! 'vector) |
844 | 846 | (car t)) |
845 | | ((pair vector list) |
| 847 | ((list-of list) |
| 848 | (dd " smashing `~s' in ~a" (caar lst) where) |
| 849 | (change! 'pair) |
| 850 | (car t)) |
| 851 | ((pair vector) |
846 | 852 | (dd " smashing `~s' in ~a" (caar lst) where) |
847 | 853 | (change! (car t)) |
848 | 854 | (car t)) |
diff --git a/tests/specialization-test-1.scm b/tests/specialization-test-1.scm
index 9d380fc..0157420 100644
a
|
b
|
return n;} |
36 | 36 | |
37 | 37 | (assert (= 2 (spec 1))) |
38 | 38 | |
| 39 | ;; "smash-component-types!" had to convert "list[-of]" types to "pair" (#803) |
| 40 | (let ((x (list 'a))) |
| 41 | (set-cdr! x x) |
| 42 | (assert (not (list? x)))) |
| 43 | |
39 | 44 | ) |