suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

optimizer: add types for something->immutable-something

Browse Source
This commit is contained in:
Gustavo Massaccesi 2016-07-01 23:46:44 -03:00
parent f8b3ba8253
commit 397d604182
2 changed files with 55 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -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?)

17
racket/src/racket/src/optimize.c
View File

@ -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;