From ca2e7519a0e39aace8ef5caf1a26241d275ee5b0 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Wed, 13 Jul 2016 22:27:20 +0200 Subject: [PATCH 4/4] Keep vector length when smashing component types. We just convert the slot types to '*, so we still know the length of the vector. --- NEWS | 2 ++ scrutinizer.scm | 7 ++++++- tests/scrutiny-tests.scm | 47 +++++++++++++++-------------------------------- tests/scrutiny.expected | 32 ++++++++++++++++---------------- 4 files changed, 39 insertions(+), 49 deletions(-) diff --git a/NEWS b/NEWS index 2bb671c..de54596 100644 --- a/NEWS +++ b/NEWS @@ -58,6 +58,8 @@ - Warnings are now emitted when using vector-{ref,set!} or one of take, drop, list-ref or list-tail with an out of range index for vectors and lists of a definitely known length. + - The scrutinizer will no longer drop knowledge of the length of a + vector. It still drops types of its contents (which may be mutated). - Runtime system: - C_locative_ref has been deprecated in favor of C_a_i_locative_ref, diff --git a/scrutinizer.scm b/scrutinizer.scm index b595292..fd0810f 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -912,11 +912,16 @@ (dd " smashing `~s' in ~a" (caar lst) where) (change! 'vector) (car t)) + ((vector) + (dd " smashing `~s' in ~a" (caar lst) where) + ;; (vector x y z) => (vector * * *) + (change! (cons 'vector (map (constantly '*) (cdr t)))) + (car t)) ((list-of list) (dd " smashing `~s' in ~a" (caar lst) where) (change! '(or pair null)) (car t)) - ((pair vector) + ((pair) (dd " smashing `~s' in ~a" (caar lst) where) (change! (car t)) (car t)) diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm index 92f7755..dadf2c6 100644 --- a/tests/scrutiny-tests.scm +++ b/tests/scrutiny-tests.scm @@ -210,41 +210,24 @@ ;; Indexing into vectors or lists of known size. -;; -;; TODO: The specific vector or list type will be smashed to just -;; "vector" or "(or pair null)" after the first operation. This is -;; why the let is repeated; otherwise we won't get the warnings for -;; subsequent references. For vectors this is overly pessimistic. -(let ((v1 (vector 'a 'b 'c))) - (define (vector-ref-warn1) (vector-ref v1 -1))) -(let ((v1 (vector 'a 'b 'c))) - (define (vector-ref-warn2) (vector-ref v1 3))) -(let ((v1 (vector 'a 'b 'c))) - (define (vector-ref-warn3) (vector-ref v1 4))) - -(let ((v1 (vector 'a 'b 'c))) - (define (vector-ref-nowarn1) (vector-ref v1 0))) -(let ((v1 (vector 'a 'b 'c))) - (define (vector-ref-nowarn2) (vector-ref v1 2))) - -(let ((v1 (vector 'a 'b 'c))) - (define (vector-ref-standard-warn1) (vector-ref v1 'bad))) - -(let ((v1 (vector 'a 'b 'c))) - (define (vector-set!-warn1) (vector-set! v1 -1 'whatever))) -(let ((v1 (vector 'a 'b 'c))) - (define (vector-set!-warn2) (vector-set! v1 3 'whatever))) -(let ((v1 (vector 'a 'b 'c))) - (define (vector-set!-warn3) (vector-set! v1 4 'whatever))) - -(let ((v1 (vector 'a 'b 'c))) - (define (vector-set!-nowarn1) (vector-set! v1 0 'whatever))) -(let ((v1 (vector 'a 'b 'c))) - (define (vector-set!-nowarn2) (vector-set! v1 2 'whatever))) - (let ((v1 (vector 'a 'b 'c))) + (define (vector-ref-warn1) (vector-ref v1 -1)) + ;; After the first expression, v1's type is smashed to (vector * * *)! + (define (vector-ref-warn2) (vector-ref v1 3)) + (define (vector-ref-warn3) (vector-ref v1 4)) + (define (vector-ref-nowarn1) (vector-ref v1 0)) + (define (vector-ref-nowarn2) (vector-ref v1 2)) + (define (vector-ref-standard-warn1) (vector-ref v1 'bad)) + (define (vector-set!-warn1) (vector-set! v1 -1 'whatever)) + (define (vector-set!-warn2) (vector-set! v1 3 'whatever)) + (define (vector-set!-warn3) (vector-set! v1 4 'whatever)) + (define (vector-set!-nowarn1) (vector-set! v1 0 'whatever)) + (define (vector-set!-nowarn2) (vector-set! v1 2 'whatever)) (define (vector-set!-standard-warn1) (vector-set! v1 'bad 'whatever))) +;; The specific list type will be smashed to just "(or pair null)" +;; after the first operation. This is why the let is repeated; +;; otherwise we won't get the warnings for subsequent references. (let ((l1 (list 'a 'b 'c))) (define (list-ref-warn1) (list-ref l1 -1))) (let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected index e685ac1..e21eb96 100644 --- a/tests/scrutiny.expected +++ b/tests/scrutiny.expected @@ -147,51 +147,51 @@ Warning: at toplevel: (scrutiny-tests.scm:208) in procedure call to `f', expected argument #1 of type `list' but was given an argument of type `(pair fixnum fixnum)' Warning: in toplevel procedure `vector-ref-warn1': - (scrutiny-tests.scm:219) in procedure call to `"vector-ref"', index -1 out of range for vector of length 3 + (scrutiny-tests.scm:214) in procedure call to `"vector-ref"', index -1 out of range for vector of length 3 Warning: in toplevel procedure `vector-ref-warn2': - (scrutiny-tests.scm:221) in procedure call to `"vector-ref"', index 3 out of range for vector of length 3 + (scrutiny-tests.scm:216) in procedure call to `"vector-ref"', index 3 out of range for vector of length 3 Warning: in toplevel procedure `vector-ref-warn3': - (scrutiny-tests.scm:223) in procedure call to `"vector-ref"', index 4 out of range for vector of length 3 + (scrutiny-tests.scm:217) in procedure call to `"vector-ref"', index 4 out of range for vector of length 3 Warning: in toplevel procedure `vector-ref-standard-warn1': - (scrutiny-tests.scm:231) in procedure call to `vector-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:220) in procedure call to `vector-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' Warning: in toplevel procedure `vector-set!-warn1': - (scrutiny-tests.scm:234) in procedure call to `"vector-set!"', index -1 out of range for vector of length 3 + (scrutiny-tests.scm:221) in procedure call to `"vector-set!"', index -1 out of range for vector of length 3 Warning: in toplevel procedure `vector-set!-warn2': - (scrutiny-tests.scm:236) in procedure call to `"vector-set!"', index 3 out of range for vector of length 3 + (scrutiny-tests.scm:222) in procedure call to `"vector-set!"', index 3 out of range for vector of length 3 Warning: in toplevel procedure `vector-set!-warn3': - (scrutiny-tests.scm:238) in procedure call to `"vector-set!"', index 4 out of range for vector of length 3 + (scrutiny-tests.scm:223) in procedure call to `"vector-set!"', index 4 out of range for vector of length 3 Warning: in toplevel procedure `vector-set!-standard-warn1': - (scrutiny-tests.scm:246) in procedure call to `vector-set!', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:226) in procedure call to `vector-set!', expected argument #2 of type `fixnum' but was given an argument of type `symbol' Warning: in toplevel procedure `list-ref-warn1': - (scrutiny-tests.scm:249) in procedure call to `"list-ref"', index -1 out of range for list of type (list symbol symbol symbol) + (scrutiny-tests.scm:232) in procedure call to `"list-ref"', index -1 out of range for list of type (list symbol symbol symbol) Warning: in toplevel procedure `list-ref-warn2': - (scrutiny-tests.scm:251) in procedure call to `"list-ref"', index -1 out of range for list of type (pair symbol (pair symbol (pair symbol *))) + (scrutiny-tests.scm:234) in procedure call to `"list-ref"', index -1 out of range for list of type (pair symbol (pair symbol (pair symbol *))) Warning: in toplevel procedure `list-ref-warn3': - (scrutiny-tests.scm:253) in procedure call to `"list-ref"', index 3 out of range for list of type (list symbol symbol symbol) + (scrutiny-tests.scm:236) in procedure call to `"list-ref"', index 3 out of range for list of type (list symbol symbol symbol) Warning: in toplevel procedure `list-ref-warn4': - (scrutiny-tests.scm:255) in procedure call to `"list-ref"', index 3 out of range for list of type (pair symbol (pair symbol (pair symbol *))) + (scrutiny-tests.scm:238) in procedure call to `"list-ref"', index 3 out of range for list of type (pair symbol (pair symbol (pair symbol *))) Warning: in toplevel procedure `list-ref-warn5': - (scrutiny-tests.scm:257) in procedure call to `"list-ref"', index 4 out of range for list of type (list symbol symbol symbol) + (scrutiny-tests.scm:240) in procedure call to `"list-ref"', index 4 out of range for list of type (list symbol symbol symbol) Warning: in toplevel procedure `list-ref-warn6': - (scrutiny-tests.scm:259) in procedure call to `"list-ref"', index 4 out of range for list of type (pair symbol (pair symbol (pair symbol *))) + (scrutiny-tests.scm:242) in procedure call to `"list-ref"', index 4 out of range for list of type (pair symbol (pair symbol (pair symbol *))) Warning: in toplevel procedure `list-ref-standard-warn1': - (scrutiny-tests.scm:271) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:254) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' Warning: in toplevel procedure `list-ref-standard-warn2': - (scrutiny-tests.scm:273) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:256) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' Warning: redefinition of standard binding: car -- 2.1.4