From 397d6041823497a639c09660eca2f0573a58c62e Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Fri, 1 Jul 2016 23:46:44 -0300 Subject: [PATCH] optimizer: add types for something->immutable-something --- .../tests/racket/optimize.rktl | 54 ++++++++++++++----- racket/src/racket/src/optimize.c | 17 ++++-- 2 files changed, 55 insertions(+), 16 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index f39f5982b6..aa6e667a30 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -219,6 +219,7 @@ (un #t 'keyword? '#:ok) (un #f 'keyword? #f) (un #t 'vector? (vector 1 2 3)) + (un #t 'vector? (vector-immutable 1 2 3)) (un #f 'vector? #f) (un #t 'box? (box 10)) (un #f 'box? #f) @@ -1287,6 +1288,8 @@ '(lambda (w z) (random) (read) #t)) (test-comp '(lambda (w z) (vector? (vector w z))) '(lambda (w z) #t)) +(test-comp '(lambda (w z) (vector? (vector-immutable w z))) + '(lambda (w z) #t)) (test-comp '(lambda (w z) (vector? (list 1))) '(lambda (w z) #f)) (test-comp '(lambda (w z) (mpair? (mcons 1 2))) @@ -1326,10 +1329,6 @@ '(lambda (x) (cdr x) (pair? x))) (test-comp '(lambda (x) (cadr x) #t) '(lambda (x) (cadr x) (pair? x))) -(test-comp '(lambda (x) (vector-ref x 0) #t) - '(lambda (x) (vector-ref x 0) (vector? x))) -(test-comp '(lambda (x) (vector-set! x 0 #t) #t) - '(lambda (x) (vector-set! x 0 #t) (vector? x))) (test-comp '(lambda (f) (procedure-arity-includes? f 5) #t) '(lambda (f) (procedure-arity-includes? f 5) (procedure? f))) (test-comp '(lambda (f l) (f l) #t) @@ -1372,20 +1371,14 @@ #;(display (primitive? map)) (display (lambda (f l) (map f l) (procedure? f))))) -(test-comp '(lambda (w z) (vector? (list->vector w))) - '(lambda (w z) (list->vector w) #t)) -(test-comp '(lambda (w z) (vector? (struct->vector w))) - '(lambda (w z) (struct->vector w) #t)) -(test-comp '(lambda (w z) (vector? (struct->vector w z))) - '(lambda (w z) (struct->vector w z) #t)) - +;Test special cases of make-vector (test-comp '(lambda (w z) (vector? (make-vector (w) (z)))) '(lambda (w z) (make-vector (w) (z)) #t)) (test-comp '(lambda (w z) (vector? (make-vector (w)))) '(lambda (w z) (make-vector (w)) #t)) (test-comp '(lambda (w z) (vector? (make-vector 5 (z)))) '(lambda (w z) (values (z)) #t)) -#;(test-comp '(lambda (w z) (vector? (make-vector 5 w))) +(test-comp '(lambda (w z) (vector? (make-vector 5 w))) '(lambda (w z) #t)) (test-comp '(lambda (w z) (vector? (make-vector 5))) '(lambda (w z) #t)) @@ -1396,6 +1389,34 @@ '(lambda (w z) #t) #f) +;Test types inference for vector? +(test-comp '(lambda (v) (fixnum? (vector-length v))) + '(lambda (v) (vector-length v) #t)) +(test-comp '(lambda (v) (vector-length v) (vector? v)) + '(lambda (v) (vector-length v) #t)) +(test-comp '(lambda (v) (vector->values v) (vector? v)) + '(lambda (v) (vector->values v) #t)) +(test-comp '(lambda (v x) (vector-ref v x) #t) + '(lambda (v x) (vector-ref v x) (vector? v))) +(test-comp '(lambda (v x) (vector-set! v x #t) #t) + '(lambda (v x) (vector-set! v x #t) (vector? v))) +(test-comp '(lambda (l) (vector? (list->vector l))) + '(lambda (l) (list->vector l) #t)) +(test-comp '(lambda (l) (list->vector l) (list? l)) + '(lambda (l) (list->vector l) #t)) +(test-comp '(lambda (v) (list? (vector->list v))) + '(lambda (v) (vector->list v) #t)) +(test-comp '(lambda (v) (vector->list v) (vector? v)) + '(lambda (v) (vector->list v) #t)) +(test-comp '(lambda (s) (vector? (struct->vector s))) + '(lambda (s) (struct->vector s) #t)) +(test-comp '(lambda (s x) (vector? (struct->vector s x))) + '(lambda (s x) (struct->vector s x) #t)) +(test-comp '(lambda (v) (vector? (vector->immutable-vector v))) + '(lambda (v) (vector->immutable-vector v) #t)) +(test-comp '(lambda (v) (vector->immutable-vector v) (vector? v)) + '(lambda (v) (vector->immutable-vector v) #t)) + ;Test types inference for string? (test-comp '(lambda (s) (fixnum? (string-length s))) '(lambda (s) (string-length s) #t)) @@ -1417,6 +1438,10 @@ '(lambda (s1 s2) (string-append s1 s2) #t)) (test-comp '(lambda (s1 s2 s3) (string? (string-append s1 s2 s3))) '(lambda (s1 s2 s3) (string-append s1 s2 s3) #t)) +(test-comp '(lambda (s) (string? (string->immutable-string s))) + '(lambda (s) (string->immutable-string s) #t)) +(test-comp '(lambda (s) (string->immutable-string s) (string? s)) + '(lambda (s) (string->immutable-string s) #t)) ;Test types inference for bytes? (test-comp '(lambda (s) (fixnum? (bytes-length s))) @@ -1439,6 +1464,10 @@ '(lambda (s1 s2) (bytes-append s1 s2) #t)) (test-comp '(lambda (s1 s2 s3) (bytes? (bytes-append s1 s2 s3))) '(lambda (s1 s2 s3) (bytes-append s1 s2 s3) #t)) +(test-comp '(lambda (s) (bytes? (bytes->immutable-bytes s))) + '(lambda (s) (bytes->immutable-bytes s) #t)) +(test-comp '(lambda (s) (bytes->immutable-bytes s) (bytes? s)) + '(lambda (s) (bytes->immutable-bytes s) #t)) (test-comp '(lambda (w z) (let ([x (list* w z)] @@ -2974,6 +3003,7 @@ (test-pred 'mpair?) (test-pred 'list?) (test-pred 'k:list-pair?) + (test-pred 'vector?) (test-pred 'box?) (test-pred 'number?) (test-pred 'real?) diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 5635fdc548..a35e4dd8f3 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -2644,15 +2644,20 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, int argc) } else if (SAME_OBJ(rator, scheme_list_star_proc)) { if (argc > 2) return scheme_pair_p_proc; - } else if (IS_NAMED_PRIM(rator, "string-append")) { + } else if (IS_NAMED_PRIM(rator, "vector->list")) { + return scheme_list_p_proc; + } else if (IS_NAMED_PRIM(rator, "string-append") + || IS_NAMED_PRIM(rator, "string->immutable-string")) { return scheme_string_p_proc; - } else if (IS_NAMED_PRIM(rator, "bytes-append")) { + } else if (IS_NAMED_PRIM(rator, "bytes-append") + || IS_NAMED_PRIM(rator, "bytes->immutable-bytes")) { return scheme_byte_string_p_proc; } else if (SAME_OBJ(rator, scheme_vector_proc) || SAME_OBJ(rator, scheme_vector_immutable_proc) || SAME_OBJ(rator, scheme_make_vector_proc) || SAME_OBJ(rator, scheme_list_to_vector_proc) - || SAME_OBJ(rator, scheme_struct_to_vector_proc)) + || SAME_OBJ(rator, scheme_struct_to_vector_proc) + || IS_NAMED_PRIM(rator, "vector->immutable-vector")) return scheme_vector_p_proc; else if (SAME_OBJ(rator, scheme_box_proc) || SAME_OBJ(rator, scheme_box_immutable_proc)) @@ -3184,7 +3189,7 @@ static int check_known_variant(Optimize_Info *info, Scheme_Object *app, rator implies a check, so add type information for subsequent expressions: the argument is consistent with `implies_pred` (which must be itself implied by `expected_pred`, but might be weaker). If - the rand has alredy an incompatible type, mark that this will + the rand has already an incompatible type, mark that this will generate an error. If unsafe is NULL then rator has no unsafe version, so only check the type. */ { @@ -3827,6 +3832,8 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz check_known(info, app_o, rator, rand, "string-append", scheme_string_p_proc, scheme_true); check_known(info, app_o, rator, rand, "bytes-append", scheme_byte_string_p_proc, scheme_true); + check_known(info, app_o, rator, rand, "string->immutable-string", scheme_string_p_proc, scheme_true); + check_known(info, app_o, rator, rand, "bytes->immutable-bytes", scheme_byte_string_p_proc, scheme_true); if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_WANTS_REAL) check_known(info, app_o, rator, rand, NULL, scheme_real_p_proc, @@ -3846,8 +3853,10 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz check_known(info, app_o, rator, rand, "cadddr", scheme_pair_p_proc, NULL); check_known(info, app_o, rator, rand, "cddddr", scheme_pair_p_proc, NULL); + check_known(info, app_o, rator, rand, "list->vector", scheme_list_p_proc, NULL); check_known(info, app_o, rator, rand, "vector->list", scheme_vector_p_proc, NULL); check_known(info, app_o, rator, rand, "vector->values", scheme_vector_p_proc, NULL); + check_known(info, app_o, rator, rand, "vector->immutable-vector", scheme_vector_p_proc, NULL); /* Some of these may have changed app->rator. */ rator = app->rator;