From 7c1cb1a2f0170ef684b9545bb54e76df4ef913ad Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Sun, 30 Oct 2016 22:10:46 -0300 Subject: [PATCH] optimizer: add symbol?, keyword? and char? to the relevant predicates Also, add a new primitive interned-char? that is hidden, but it's useful to track in the optimizer the the chars? with a value < 256 that are interned because they are treated specially, and if they are equal? then they are eq?. --- pkgs/base/info.rkt | 2 +- pkgs/racket-test-core/tests/racket/basic.rktl | 17 +++- .../tests/racket/optimize.rktl | 26 ++++-- racket/collects/racket/private/pre-base.rkt | 3 +- racket/src/racket/src/char.c | 20 ++++- racket/src/racket/src/cstartup.inc | 90 +++++++++---------- racket/src/racket/src/jitinline.c | 69 ++++++++++++++ racket/src/racket/src/optimize.c | 61 ++++++++++++- racket/src/racket/src/schpriv.h | 5 +- racket/src/racket/src/schvers.h | 4 +- racket/src/racket/src/symbol.c | 7 ++ 11 files changed, 242 insertions(+), 62 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 1beb5b62aa..3beced4387 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "6.7.0.2") +(define version "6.7.0.3") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-test-core/tests/racket/basic.rktl b/pkgs/racket-test-core/tests/racket/basic.rktl index acfea535c8..a84114b992 100644 --- a/pkgs/racket-test-core/tests/racket/basic.rktl +++ b/pkgs/racket-test-core/tests/racket/basic.rktl @@ -5,8 +5,7 @@ (require racket/flonum racket/function - (only-in '#%kernel (list-pair? k:list-pair?) - (true-object? k:true-object?))) + (prefix-in k: '#%kernel)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -457,7 +456,21 @@ (test #t char? #\() (test #t char? #\ ) (test #t char? '#\newline) + (test #t char? #\u100) + (test #f char? 7) + (test #f char? #t) + (test #f char? 'x) (arity-test char? 1 1) + (test #t k:interned-char? #\a) + (test #t k:interned-char? #\() + (test #t k:interned-char? #\ ) + (test #t k:interned-char? '#\newline) + (test #f k:interned-char? #\u100) + (test #f k:interned-char? 7) + (test #f k:interned-char? #t) + (test #f k:interned-char? #t) + (test #f k:interned-char? 'x) + (arity-test k:interned-char? 1 1) (test #f char=? #\A #\B) (test #f char=? #\A #\A #\B) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index a5e6389566..9bfdc23b01 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -1438,7 +1438,7 @@ (test-arg-types '(vector-length vector?) 'fixnum? 'may-omit) (test-arg-types '(vector->values vector?) #f) (test-arg-types '(vector-ref vector? fixnum?) #f) -(test-arg-types '(vector-set! vector? fixnum? #f) #f) +(test-arg-types '(vector-set! vector? fixnum? #f) 'void?) (test-arg-types '(vector->list vector?) 'list?) (test-arg-types '(list->vector list?) 'vector?) (test-arg-types '(struct->vector #f) 'vector?) @@ -1465,10 +1465,16 @@ '(lambda (w z) #t) #f) +;Test types inference for box? +(test-arg-types '(box #f) 'box?) +(test-arg-types '(box-immutable #f) 'box?) +(test-arg-types '(unbox box?) #f) +(test-arg-types '(set-box! box? #f) 'void?) + ;Test types inference for string? (test-arg-types '(string-length string?) 'fixnum? 'may-omit) -(test-arg-types '(string-ref string? fixnum?) #f) -(test-arg-types '(string-set! string? fixnum? #f) #f) +(test-arg-types '(string-ref string? fixnum?) 'char?) +(test-arg-types '(string-set! string? fixnum? char?) 'void?) (test-arg-types '(string->immutable-string string?) 'string? 'may-omit) (test-arg-types '(string-append) string? 'may-omit) (test-arg-types '(string-append string?) 'string? 'may-omit) @@ -1478,8 +1484,8 @@ ;Test types inference for bytes? (test-arg-types '(bytes-length bytes?) 'fixnum? 'may-omit) -(test-arg-types '(bytes-ref bytes? fixnum?) #f) -(test-arg-types '(bytes-set! bytes? fixnum? #f) #f) +(test-arg-types '(bytes-ref bytes? fixnum?) 'fixnum?) +(test-arg-types '(bytes-set! bytes? fixnum? fixnum?) 'void?) (test-arg-types '(bytes->immutable-bytes bytes?) 'bytes? 'may-omit) (test-arg-types '(bytes-append) bytes? 'may-omit) (test-arg-types '(bytes-append bytes?) 'bytes? 'may-omit) @@ -1500,6 +1506,14 @@ (test-arg-types '(append list? list? list?) list? 'may-omit 'dont-infer) (test-arg-types '(append list? list? list? list?) list? 'may-omit 'dont-infer) +;Test types inference for symbol? and keyword? +(test-arg-types '(symbol->string symbol?) 'string? 'may-omit) +(test-arg-types '(string->symbol string?) 'symbol? 'may-omit) +(test-arg-types '(keyword->string keyword?) 'string? 'may-omit) +(test-arg-types '(string->keyword string?) 'keyword? 'may-omit) +(test-arg-types '(gensym) 'symbol?) +(test-arg-types '(gensym #f) 'symbol?) + ;Test the map primitive and the map version defined in private/map.rkt ;The optimizer is not capable of figuring out that the result of map is a list? (test-arg-types '(k:map procedure? list?) 'list?) @@ -3080,6 +3094,7 @@ (test-pred 'bytes?) (test-pred 'path?) (test-pred 'char?) + (test-pred 'k:interned-char?) (test-pred 'boolean?) (test-pred 'chaperone?) (test-pred 'impersonator?) @@ -3128,6 +3143,7 @@ (test-implies 'k:list-pair? 'pair?) (test-implies 'k:list-pair? 'list?) (test-implies 'list? 'pair? '?) + (test-implies 'k:interned-char? 'char?) (test-implies 'not 'boolean?) (test-implies 'k:true-object? 'boolean?) ) diff --git a/racket/collects/racket/private/pre-base.rkt b/racket/collects/racket/private/pre-base.rkt index 11c715e5d8..a4892d9180 100644 --- a/racket/collects/racket/private/pre-base.rkt +++ b/racket/collects/racket/private/pre-base.rkt @@ -231,8 +231,7 @@ chaperone-procedure* impersonate-procedure* assq assv assoc prop:incomplete-arity prop:method-arity-error - list-pair? - true-object? + list-pair? interned-char? true-object? random) (all-from "reqprov.rkt") (all-from-except "for.rkt" diff --git a/racket/src/racket/src/char.c b/racket/src/racket/src/char.c index 0ad270afa3..6546b74ffe 100644 --- a/racket/src/racket/src/char.c +++ b/racket/src/racket/src/char.c @@ -31,8 +31,12 @@ READ_ONLY Scheme_Object **scheme_char_constants; READ_ONLY static Scheme_Object *general_category_symbols[NUM_GENERAL_CATEGORIES]; +READ_ONLY Scheme_Object *scheme_char_p_proc; +READ_ONLY Scheme_Object *scheme_interned_char_p_proc; + /* locals */ static Scheme_Object *char_p (int argc, Scheme_Object *argv[]); +static Scheme_Object *interned_char_p (int argc, Scheme_Object *argv[]); static Scheme_Object *char_eq (int argc, Scheme_Object *argv[]); static Scheme_Object *char_lt (int argc, Scheme_Object *argv[]); static Scheme_Object *char_gt (int argc, Scheme_Object *argv[]); @@ -98,11 +102,20 @@ void scheme_init_char (Scheme_Env *env) { Scheme_Object *p; + REGISTER_SO(scheme_char_p_proc); p = scheme_make_folding_prim(char_p, "char?", 1, 1, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED | SCHEME_PRIM_IS_OMITABLE); + scheme_char_p_proc = p; scheme_add_global_constant("char?", p, env); + REGISTER_SO(scheme_interned_char_p_proc); + p = scheme_make_folding_prim(interned_char_p, "interned-char?", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED + | SCHEME_PRIM_IS_OMITABLE); + scheme_interned_char_p_proc = p; + scheme_add_global_constant("interned-char?", p, env); + p = scheme_make_folding_prim(char_eq, "char=?", 2, -1, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED); scheme_add_global_constant("char=?", p, env); @@ -125,7 +138,6 @@ void scheme_init_char (Scheme_Env *env) GLOBAL_FOLDING_PRIM("char-iso-control?", char_control, 1, 1, 1, env); GLOBAL_FOLDING_PRIM("char-punctuation?", char_punctuation, 1, 1, 1, env); GLOBAL_FOLDING_PRIM("char-upper-case?", char_upper_case, 1, 1, 1, env); - GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env); GLOBAL_FOLDING_PRIM("char-lower-case?", char_lower_case, 1, 1, 1, env); GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env); @@ -177,6 +189,12 @@ char_p (int argc, Scheme_Object *argv[]) return (SCHEME_CHARP(argv[0]) ? scheme_true : scheme_false); } +static Scheme_Object * +interned_char_p (int argc, Scheme_Object *argv[]) +{ + return (SCHEME_CHARP(argv[0]) && SCHEME_CHAR_VAL(argv[0]) < 256) ? scheme_true : scheme_false; +} + #define charSTD_FOLDCASE(nl) nl; #define charNO_FOLDCASE(nl) /* empty */ diff --git a/racket/src/racket/src/cstartup.inc b/racket/src/racket/src/cstartup.inc index 9c64d4482a..94d3495aef 100644 --- a/racket/src/racket/src/cstartup.inc +++ b/racket/src/racket/src/cstartup.inc @@ -1,5 +1,5 @@ { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,54,0,0,0,1,0,0,8,0,18,0, 22,0,26,0,31,0,38,0,42,0,47,0,59,0,66,0,69,0,82,0,89, 0,94,0,103,0,109,0,123,0,137,0,140,0,146,0,157,0,159,0,173,0, @@ -102,7 +102,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 2090); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,184,0,0,0,1,0,0,8,0,16,0, 29,0,34,0,51,0,63,0,85,0,114,0,158,0,164,0,178,0,193,0,211, 0,223,0,239,0,253,0,19,1,39,1,73,1,90,1,107,1,130,1,145,1, @@ -1026,7 +1026,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 19329); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,15,0,0,0,1,0,0,8,0,23,0, 48,0,65,0,83,0,105,0,128,0,149,0,171,0,181,0,191,0,199,0,209, 0,217,0,0,0,253,1,0,0,3,1,5,105,110,115,112,48,76,35,37,112, @@ -1057,7 +1057,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 581); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,102,0,0,0,1,0,0,8,0,15,0, 26,0,53,0,59,0,73,0,86,0,112,0,129,0,151,0,159,0,171,0,186, 0,202,0,220,0,241,0,253,0,13,1,36,1,60,1,72,1,103,1,108,1, @@ -1238,55 +1238,55 @@ 9,32,58,88,149,8,38,42,54,11,2,30,39,223,48,33,73,32,59,88,149, 8,38,42,53,11,2,30,39,223,48,33,72,32,60,88,148,8,36,40,53,11, 2,31,222,33,71,32,61,88,149,8,38,42,53,11,2,30,39,223,48,33,62, -28,249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,145,9,7, +28,249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,146,9,7, 47,249,22,166,7,23,197,2,23,199,2,249,22,82,250,22,184,7,23,198,2, 39,23,200,2,248,2,60,249,22,184,7,23,198,1,248,22,187,3,23,201,1, 250,2,61,195,23,197,4,248,22,187,3,198,32,63,88,149,8,38,42,55,11, 2,30,39,223,48,33,70,32,64,88,149,8,38,42,54,11,2,30,39,223,48, 33,67,32,65,88,149,8,38,42,53,11,2,30,39,223,48,33,66,28,249,22, -134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,145,9,7,47,249,22, +134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,146,9,7,47,249,22, 166,7,23,197,2,23,199,2,249,22,82,250,22,184,7,23,198,2,39,23,200, 2,248,2,60,249,22,184,7,23,198,1,248,22,187,3,23,201,1,250,2,65, 195,23,197,4,248,22,187,3,198,28,249,22,134,4,23,197,2,23,196,4,248, -22,92,193,28,249,22,145,9,7,47,249,22,166,7,23,197,2,23,199,2,249, +22,92,193,28,249,22,146,9,7,47,249,22,166,7,23,197,2,23,199,2,249, 22,82,250,22,184,7,23,198,2,39,23,200,2,27,249,22,184,7,23,198,1, 248,22,187,3,23,201,1,19,248,22,165,7,23,195,2,250,2,65,23,197,1, 23,196,4,39,2,27,248,22,187,3,23,197,1,28,249,22,134,4,23,195,2, -23,197,4,248,22,92,194,28,249,22,145,9,7,47,249,22,166,7,23,198,2, +23,197,4,248,22,92,194,28,249,22,146,9,7,47,249,22,166,7,23,198,2, 23,197,2,249,22,82,250,22,184,7,23,199,2,39,23,198,2,248,2,60,249, 22,184,7,23,199,1,248,22,187,3,23,199,1,250,2,64,196,23,198,4,248, 22,187,3,196,32,68,88,149,8,38,42,53,11,2,30,39,223,48,33,69,28, -249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,145,9,7,47, +249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,146,9,7,47, 249,22,166,7,23,197,2,23,199,2,249,22,82,250,22,184,7,23,198,2,39, 23,200,2,248,2,60,249,22,184,7,23,198,1,248,22,187,3,23,201,1,250, 2,68,195,23,197,4,248,22,187,3,198,28,249,22,134,4,23,197,2,23,196, -4,248,22,92,193,28,249,22,145,9,7,47,249,22,166,7,23,197,2,23,199, +4,248,22,92,193,28,249,22,146,9,7,47,249,22,166,7,23,197,2,23,199, 2,249,22,82,250,22,184,7,23,198,2,39,23,200,2,27,249,22,184,7,23, 198,1,248,22,187,3,23,201,1,19,248,22,165,7,23,195,2,250,2,64,23, 197,1,23,196,4,39,2,27,248,22,187,3,23,197,1,28,249,22,134,4,23, -195,2,23,197,4,248,22,92,194,28,249,22,145,9,7,47,249,22,166,7,23, +195,2,23,197,4,248,22,92,194,28,249,22,146,9,7,47,249,22,166,7,23, 198,2,23,197,2,249,22,82,250,22,184,7,23,199,2,39,23,198,2,27,249, 22,184,7,23,199,1,248,22,187,3,23,199,1,19,248,22,165,7,23,195,2, 250,2,68,23,197,1,23,196,4,39,2,27,248,22,187,3,23,195,1,28,249, -22,134,4,23,195,2,23,198,4,248,22,92,195,28,249,22,145,9,7,47,249, +22,134,4,23,195,2,23,198,4,248,22,92,195,28,249,22,146,9,7,47,249, 22,166,7,23,199,2,23,197,2,249,22,82,250,22,184,7,23,200,2,39,23, 198,2,248,2,60,249,22,184,7,23,200,1,248,22,187,3,23,199,1,250,2, 63,197,23,199,4,248,22,187,3,196,19,248,22,165,7,23,195,2,28,249,22, -167,20,39,23,195,4,248,22,92,194,28,249,22,145,9,7,47,249,22,166,7, +167,20,39,23,195,4,248,22,92,194,28,249,22,146,9,7,47,249,22,166,7, 23,198,2,39,249,22,82,250,22,184,7,23,199,2,39,39,27,249,22,184,7, 23,199,1,40,19,248,22,165,7,23,195,2,250,2,61,23,197,1,23,196,4, -39,2,28,249,22,167,20,40,23,195,4,248,22,92,194,28,249,22,145,9,7, +39,2,28,249,22,167,20,40,23,195,4,248,22,92,194,28,249,22,146,9,7, 47,249,22,166,7,23,198,2,40,249,22,82,250,22,184,7,23,199,2,39,40, 248,2,60,249,22,184,7,23,199,1,41,250,2,63,196,23,196,4,41,2,28, -249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,145,9,7,47, +249,22,134,4,23,197,2,23,196,4,248,22,92,193,28,249,22,146,9,7,47, 249,22,166,7,23,197,2,23,199,2,249,22,82,250,22,184,7,23,198,2,39, 23,200,2,248,2,60,249,22,184,7,23,198,1,248,22,187,3,23,201,1,250, 2,59,195,23,197,4,248,22,187,3,198,28,249,22,134,4,23,197,2,23,196, -4,248,22,92,193,28,249,22,145,9,7,47,249,22,166,7,23,197,2,23,199, +4,248,22,92,193,28,249,22,146,9,7,47,249,22,166,7,23,197,2,23,199, 2,249,22,82,250,22,184,7,23,198,2,39,23,200,2,27,249,22,184,7,23, 198,1,248,22,187,3,23,201,1,19,248,22,165,7,23,195,2,250,2,59,23, 197,1,23,196,4,39,2,27,248,22,187,3,23,197,1,28,249,22,134,4,23, -195,2,23,197,4,248,22,92,194,28,249,22,145,9,7,47,249,22,166,7,23, +195,2,23,197,4,248,22,92,194,28,249,22,146,9,7,47,249,22,166,7,23, 198,2,23,197,2,249,22,82,250,22,184,7,23,199,2,39,23,198,2,248,2, 60,249,22,184,7,23,199,1,248,22,187,3,23,199,1,250,2,58,196,23,198, 4,248,22,187,3,196,32,74,88,148,39,40,58,11,2,31,222,33,75,28,248, @@ -1553,32 +1553,32 @@ EVAL_ONE_SIZED_STR((char *)expr, 10346); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,50,84,0,0,0,0,0,0,0,0,0,0, -0,0,0,0,0,0,0,0,0,0,17,0,0,0,1,0,0,8,0,18,0, -24,0,38,0,52,0,64,0,84,0,98,0,113,0,126,0,131,0,135,0,147, -0,231,0,238,0,8,1,0,0,214,1,0,0,3,1,5,105,110,115,112,48, -71,35,37,98,117,105,108,116,105,110,67,113,117,111,116,101,29,94,2,3,70, -35,37,107,101,114,110,101,108,11,29,94,2,3,70,35,37,101,120,112,111,98, -115,11,29,94,2,3,68,35,37,98,111,111,116,11,29,94,2,3,76,35,37, -112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,2,3,70,35,37,112, -97,114,97,109,122,11,29,94,2,3,71,35,37,110,101,116,119,111,114,107,11, -29,94,2,3,69,35,37,117,116,105,108,115,11,38,11,93,2,12,36,12,0, -39,38,13,93,143,16,3,39,2,14,2,2,39,36,14,1,150,40,143,2,15, -16,4,2,4,39,39,2,1,143,2,15,16,4,2,5,39,39,2,1,143,2, -15,16,4,2,6,39,39,2,1,143,2,15,16,4,2,7,39,39,2,1,143, -2,15,16,4,2,8,39,39,2,1,143,2,15,16,4,2,9,39,39,2,1, -143,2,15,16,4,2,10,39,39,2,1,16,0,38,15,143,2,14,2,11,18, -143,16,2,143,10,16,3,9,2,11,2,13,143,11,16,3,9,9,2,13,16, -3,9,9,9,145,40,9,20,122,145,2,1,39,16,1,11,16,0,20,27,15, -56,9,2,2,2,2,29,11,11,11,11,11,11,11,9,9,11,11,11,33,16, -40,80,143,39,39,20,122,145,2,1,39,16,0,16,0,40,42,39,16,0,39, -16,0,39,11,11,11,16,0,16,0,16,0,39,39,40,12,11,11,16,0,16, -0,16,0,39,39,11,12,11,11,16,0,16,0,16,0,39,39,16,0,105,2, -4,2,5,29,94,2,3,71,35,37,102,111,114,101,105,103,110,11,29,94,2, -3,70,35,37,117,110,115,97,102,101,11,29,94,2,3,71,35,37,102,108,102, -120,110,117,109,11,2,6,2,7,2,8,2,9,2,10,29,94,2,3,69,35, -37,112,108,97,99,101,11,29,94,2,3,71,35,37,102,117,116,117,114,101,115, -11,29,94,2,3,71,35,37,108,105,110,107,108,101,116,11,9,9,9,39,9, -0}; - EVAL_ONE_SIZED_STR((char *)expr, 546); + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,54,46,55,46,48,46,51,84,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,18,0,0,0,1,0,0,8,0,18,0, +22,0,28,0,42,0,56,0,68,0,88,0,102,0,117,0,130,0,135,0,139, +0,151,0,235,0,242,0,20,1,0,0,224,1,0,0,3,1,5,105,110,115, +112,48,71,35,37,98,117,105,108,116,105,110,29,11,11,11,67,113,117,111,116, +101,29,94,2,4,70,35,37,107,101,114,110,101,108,11,29,94,2,4,70,35, +37,101,120,112,111,98,115,11,29,94,2,4,68,35,37,98,111,111,116,11,29, +94,2,4,76,35,37,112,108,97,99,101,45,115,116,114,117,99,116,11,29,94, +2,4,70,35,37,112,97,114,97,109,122,11,29,94,2,4,71,35,37,110,101, +116,119,111,114,107,11,29,94,2,4,69,35,37,117,116,105,108,115,11,38,12, +93,2,13,36,13,0,39,38,14,93,143,16,3,39,2,15,2,2,39,36,15, +1,150,40,143,2,16,16,4,2,5,39,39,2,1,143,2,16,16,4,2,6, +39,39,2,1,143,2,16,16,4,2,7,39,39,2,1,143,2,16,16,4,2, +8,39,39,2,1,143,2,16,16,4,2,9,39,39,2,1,143,2,16,16,4, +2,10,39,39,2,1,143,2,16,16,4,2,11,39,39,2,1,16,0,38,16, +143,2,15,2,12,18,143,16,2,143,10,16,3,93,16,2,29,11,11,11,2, +3,2,12,2,14,143,11,16,3,9,9,2,14,16,3,9,9,9,145,40,9, +20,122,145,2,1,39,16,1,11,16,0,20,27,15,56,9,2,2,2,2,2, +3,11,11,11,11,9,9,11,11,11,33,17,40,80,143,39,39,20,122,145,2, +1,39,16,0,16,0,40,42,39,16,0,39,16,0,39,11,11,11,16,0,16, +0,16,0,39,39,40,12,11,11,16,0,16,0,16,0,39,39,11,12,11,11, +16,0,16,0,16,0,39,39,16,0,105,2,5,2,6,29,94,2,4,71,35, +37,102,111,114,101,105,103,110,11,29,94,2,4,70,35,37,117,110,115,97,102, +101,11,29,94,2,4,71,35,37,102,108,102,120,110,117,109,11,2,7,2,8, +2,9,2,10,2,11,29,94,2,4,69,35,37,112,108,97,99,101,11,29,94, +2,4,71,35,37,102,117,116,117,114,101,115,11,29,94,2,4,71,35,37,108, +105,110,107,108,101,116,11,9,9,9,39,9,0}; + EVAL_ONE_SIZED_STR((char *)expr, 558); } diff --git a/racket/src/racket/src/jitinline.c b/racket/src/racket/src/jitinline.c index 017cb37f08..9f758bce77 100644 --- a/racket/src/racket/src/jitinline.c +++ b/racket/src/racket/src/jitinline.c @@ -379,6 +379,72 @@ static int generate_inlined_type_test(mz_jit_state *jitter, Scheme_App2_Rec *app return 1; } +static int generate_inlined_interned_char_test(mz_jit_state *jitter, Scheme_App2_Rec *app, + Branch_Info *for_branch, int branch_short, + int dest) +{ + GC_CAN_IGNORE jit_insn *ref1, *ref2, *ref3; + int reg_valid; + + LOG_IT(("inlined interned-char?\n")); + + mz_runstack_skipped(jitter, 1); + + scheme_generate_non_tail(app->rand, jitter, 0, 1, 0); + CHECK_LIMIT(); + + mz_runstack_unskipped(jitter, 1); + + mz_rs_sync(); + + __START_SHORT_JUMPS__(branch_short); + + reg_valid = 0; + if (for_branch) { + reg_valid = mz_CURRENT_REG_STATUS_VALID(); + scheme_prepare_branch_jump(jitter, for_branch); + CHECK_LIMIT(); + } + + /* Test that it's not a fixnum */ + ref1 = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1); + /* Test that it's a char */ +#ifdef jit_bxnei_s + ref2 = jit_bxnei_s(jit_forward(), JIT_R0, scheme_char_type); +#else + jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type); + ref2 = jit_bnei_i(jit_forward(), JIT_R1, scheme_char_type); +#endif + /* Test that it's < 256 */ + jit_ldxi_s(JIT_R1, JIT_R0, &SCHEME_CHAR_VAL(0x0)); + ref3 = jit_blti_i(jit_forward(), JIT_R1, 256); + + if (for_branch) { + scheme_add_branch_false(for_branch, ref1); + scheme_add_branch_false(for_branch, ref2); + scheme_add_branch_false(for_branch, ref3); + + /* Note that the test didn't disturb R0: */ + mz_SET_R0_STATUS_VALID(reg_valid); + + scheme_branch_for_true(jitter, for_branch); + CHECK_LIMIT(); + } else { + GC_CAN_IGNORE jit_insn *ref_ucfinish; + (void)jit_movi_p(dest, scheme_true); + ref_ucfinish = jit_jmpi(jit_forward()); + mz_patch_branch(ref1); + mz_patch_branch(ref2); + mz_patch_branch(ref3); + (void)jit_movi_p(dest, scheme_false); + mz_patch_ucbranch(ref_ucfinish); + } + + __END_SHORT_JUMPS__(branch_short); + + return 1; +} + static int generate_inlined_immutable_test(mz_jit_state *jitter, Scheme_App2_Rec *app, Branch_Info *for_branch, int branch_short, int dest) @@ -1116,6 +1182,9 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in } else if (IS_NAMED_PRIM(rator, "char?")) { generate_inlined_type_test(jitter, app, scheme_char_type, scheme_char_type, 0, for_branch, branch_short, dest); return 1; + } else if (IS_NAMED_PRIM(rator, "interned-char?")) { + generate_inlined_interned_char_test(jitter, app, for_branch, branch_short, dest); + return 1; } else if (IS_NAMED_PRIM(rator, "boolean?")) { generate_inlined_constant_test(jitter, app, scheme_false, scheme_true, for_branch, branch_short, dest); return 1; diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index 520df0b5a5..43b261b29d 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -2926,8 +2926,12 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Inf } else if (IS_NAMED_PRIM(rator, "vector->list") || IS_NAMED_PRIM(rator, "map")) { return scheme_list_p_proc; + } else if (IS_NAMED_PRIM(rator, "string-ref")) { + return scheme_char_p_proc; } else if (IS_NAMED_PRIM(rator, "string-append") - || IS_NAMED_PRIM(rator, "string->immutable-string")) { + || IS_NAMED_PRIM(rator, "string->immutable-string") + || IS_NAMED_PRIM(rator, "symbol->string") + || IS_NAMED_PRIM(rator, "keyword->string")) { return scheme_string_p_proc; } else if (IS_NAMED_PRIM(rator, "bytes-append") || IS_NAMED_PRIM(rator, "bytes->immutable-bytes")) { @@ -2946,6 +2950,20 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Inf return scheme_void_p_proc; else if (SAME_OBJ(rator, scheme_procedure_specialize_proc)) return scheme_procedure_p_proc; + else if (IS_NAMED_PRIM(rator, "vector-set!") + || IS_NAMED_PRIM(rator, "string-set!") + || IS_NAMED_PRIM(rator, "bytes-set!") + || IS_NAMED_PRIM(rator, "set-box!")) + return scheme_void_p_proc; + else if (IS_NAMED_PRIM(rator, "vector-set!") + || IS_NAMED_PRIM(rator, "string-set!") + || IS_NAMED_PRIM(rator, "bytes-set!")) + return scheme_void_p_proc; + else if (IS_NAMED_PRIM(rator, "string->symbol") + || IS_NAMED_PRIM(rator, "gensym")) + return scheme_symbol_p_proc; + else if (IS_NAMED_PRIM(rator, "string->keyword")) + return scheme_keyword_p_proc; else if (IS_NAMED_PRIM(rator, "pair?") || IS_NAMED_PRIM(rator, "mpair?") || IS_NAMED_PRIM(rator, "list?") @@ -2972,6 +2990,7 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Inf || IS_NAMED_PRIM(rator, "bytes?") || IS_NAMED_PRIM(rator, "path?") || IS_NAMED_PRIM(rator, "char?") + || IS_NAMED_PRIM(rator, "interned-char?") || IS_NAMED_PRIM(rator, "boolean?") || IS_NAMED_PRIM(rator, "chaperone?") || IS_NAMED_PRIM(rator, "impersonator?") @@ -2988,6 +3007,7 @@ static Scheme_Object *rator_implies_predicate(Scheme_Object *rator, Optimize_Inf || IS_NAMED_PRIM(rator, "equal?") || IS_NAMED_PRIM(rator, "string=?") || IS_NAMED_PRIM(rator, "bytes=?") + || IS_NAMED_PRIM(rator, "char=?") || IS_NAMED_PRIM(rator, "free-identifier=?") || IS_NAMED_PRIM(rator, "bound-identifier=?") || IS_NAMED_PRIM(rator, "procedure-closure-contents-eq?")) { @@ -3266,7 +3286,14 @@ static Scheme_Object *do_expr_implies_predicate(Scheme_Object *expr, Optimize_In return scheme_void_p_proc; if (SCHEME_EOFP(expr)) return scheme_eof_object_p_proc; - + if (SCHEME_KEYWORDP(expr)) + return scheme_keyword_p_proc; + if (SCHEME_SYMBOLP(expr)) + return scheme_symbol_p_proc; + if (SCHEME_CHARP(expr) && SCHEME_CHAR_VAL(expr) < 256) + return scheme_interned_char_p_proc; + if (SCHEME_CHARP(expr)) + return scheme_char_p_proc; if (SAME_OBJ(expr, scheme_true)) return scheme_true_object_p_proc; if (SCHEME_FALSEP(expr)) @@ -3774,7 +3801,7 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_ && (app->num_args >= ((Scheme_Primitive_Proc *)app->args[0])->mina) && (app->num_args <= ((Scheme_Primitive_Proc *)app->args[0])->mu.maxa)) { Scheme_Object *app_o = (Scheme_Object *)app, *rator = app->args[0]; - Scheme_Object *rand1 = NULL, *rand2 = NULL; + Scheme_Object *rand1 = NULL, *rand2 = NULL, *rand3 = NULL; if (app->num_args >= 1) rand1 = app->args[1]; @@ -3782,6 +3809,9 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_ if (app->num_args >= 2) rand2 = app->args[2]; + if (app->num_args >= 3) + rand3 = app->args[3]; + check_known(info, app_o, rator, rand1, "vector-set!", scheme_vector_p_proc, NULL); check_known(info, app_o, rator, rand2, "vector-set!", scheme_fixnum_p_proc, NULL); @@ -3798,8 +3828,10 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_ check_known(info, app_o, rator, rand1, "string-set!", scheme_string_p_proc, NULL); check_known(info, app_o, rator, rand2, "string-set!", scheme_fixnum_p_proc, NULL); + check_known(info, app_o, rator, rand3, "string-set!", scheme_char_p_proc, NULL); check_known(info, app_o, rator, rand1, "bytes-set!", scheme_byte_string_p_proc, NULL); check_known(info, app_o, rator, rand2, "bytes-set!", scheme_fixnum_p_proc, NULL); + check_known(info, app_o, rator, rand3, "bytes-set!", scheme_fixnum_p_proc, NULL); check_known_all(info, app_o, 0, 0, "string-append", scheme_string_p_proc, scheme_true); check_known_all(info, app_o, 0, 0, "bytes-append", scheme_byte_string_p_proc, scheme_true); @@ -4238,6 +4270,11 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz 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); + check_known(info, app_o, rator, rand, "string->symbol", scheme_string_p_proc, scheme_true); + check_known(info, app_o, rator, rand, "symbol->string", scheme_symbol_p_proc, scheme_true); + check_known(info, app_o, rator, rand, "string->keyword", scheme_string_p_proc, scheme_true); + check_known(info, app_o, rator, rand, "keyword->string", scheme_keyword_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, (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS) ? scheme_true : NULL); @@ -4703,6 +4740,11 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz && SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_byte_string_type)) { return scheme_byte_string_eq_2(app->rand1, app->rand2); } + } else if (IS_NAMED_PRIM(app->rator, "char=?")) { + if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_char_type) + && SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_char_type)) { + return (SCHEME_CHAR_VAL(app->rand1) == SCHEME_CHAR_VAL(app->rand2)) ? scheme_true : scheme_false; + } } } @@ -4757,6 +4799,10 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz check_known(info, app_o, rator, rand2, "vector-ref", scheme_fixnum_p_proc, NULL); check_known(info, app_o, rator, rand1, "make-vector", scheme_fixnum_p_proc, NULL); + check_known(info, app_o, rator, rand1, "set-box!", scheme_box_p_proc, NULL); + check_known(info, app_o, rator, rand1, "unsafe-set-box!", scheme_box_p_proc, NULL); + check_known(info, app_o, rator, rand1, "unsafe-set-box*!", scheme_box_p_proc, NULL); + check_known(info, app_o, rator, rand1, "procedure-closure-contents-eq?", scheme_procedure_p_proc, NULL); check_known(info, app_o, rator, rand2, "procedure-closure-contents-eq?", scheme_procedure_p_proc, NULL); check_known(info, app_o, rator, rand1, "procedure-arity-includes?", scheme_procedure_p_proc, NULL); @@ -5249,6 +5295,8 @@ static int relevant_predicate(Scheme_Object *pred) || SAME_OBJ(pred, scheme_string_p_proc) || SAME_OBJ(pred, scheme_byte_string_p_proc) || SAME_OBJ(pred, scheme_vector_p_proc) + || SAME_OBJ(pred, scheme_symbol_p_proc) + || SAME_OBJ(pred, scheme_keyword_p_proc) || SAME_OBJ(pred, scheme_procedure_p_proc) || SAME_OBJ(pred, scheme_syntax_p_proc) || SAME_OBJ(pred, scheme_fixnum_p_proc) @@ -5256,6 +5304,8 @@ static int relevant_predicate(Scheme_Object *pred) || SAME_OBJ(pred, scheme_extflonum_p_proc) || SAME_OBJ(pred, scheme_number_p_proc) || SAME_OBJ(pred, scheme_real_p_proc) + || SAME_OBJ(pred, scheme_char_p_proc) + || SAME_OBJ(pred, scheme_interned_char_p_proc) || SAME_OBJ(pred, scheme_void_p_proc) || SAME_OBJ(pred, scheme_eof_object_p_proc) || SAME_OBJ(pred, scheme_boolean_p_proc) @@ -5288,6 +5338,11 @@ static int predicate_implies(Scheme_Object *pred1, Scheme_Object *pred2) && SAME_OBJ(pred1, scheme_list_pair_p_proc)) return 1; + /* interned-char? => char? */ + if (SAME_OBJ(pred2, scheme_char_p_proc) + && SAME_OBJ(pred1, scheme_interned_char_p_proc)) + return 1; + /* not, true-object? => boolean? */ if (SAME_OBJ(pred2, scheme_boolean_p_proc) && (SAME_OBJ(pred1, scheme_not_proc) diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 74a0498634..96eec67468 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -488,6 +488,10 @@ void scheme_done_os_thread(); /* constants */ /*========================================================================*/ +extern Scheme_Object *scheme_symbol_p_proc; +extern Scheme_Object *scheme_keyword_p_proc; +extern Scheme_Object *scheme_char_p_proc; +extern Scheme_Object *scheme_interned_char_p_proc; extern Scheme_Object *scheme_fixnum_p_proc; extern Scheme_Object *scheme_flonum_p_proc; extern Scheme_Object *scheme_extflonum_p_proc; @@ -3570,7 +3574,6 @@ int scheme_get_eval_type(Scheme_Object *obj); Scheme_Object *scheme_make_application(Scheme_Object *v, Optimize_Info *info); Scheme_Object *scheme_try_apply(Scheme_Object *f, Scheme_Object *args, Optimize_Info *info); int scheme_is_foldable_prim(Scheme_Object *f); -int scheme_eq_testable_constant(Scheme_Object *v); Scheme_Object *scheme_get_stop_expander(void); diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 76f6a7912a..6ba0ccdd72 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.7.0.2" +#define MZSCHEME_VERSION "6.7.0.3" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 7 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 2 +#define MZSCHEME_VERSION_W 3 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/racket/src/racket/src/symbol.c b/racket/src/racket/src/symbol.c index 5d31861bd2..0484f088ca 100644 --- a/racket/src/racket/src/symbol.c +++ b/racket/src/racket/src/symbol.c @@ -65,6 +65,9 @@ THREAD_LOCAL_DECL(static int gensym_counter); void scheme_set_case_sensitive(int v) { scheme_case_sensitive = v; } +READ_ONLY Scheme_Object *scheme_symbol_p_proc; +READ_ONLY Scheme_Object *scheme_keyword_p_proc; + /* locals */ static Scheme_Object *symbol_lt (int argc, Scheme_Object *argv[]); static Scheme_Object *symbol_p_prim (int argc, Scheme_Object *argv[]); @@ -330,9 +333,11 @@ scheme_init_symbol (Scheme_Env *env) { Scheme_Object *p; + REGISTER_SO(scheme_symbol_p_proc); p = scheme_make_folding_prim(symbol_p_prim, "symbol?", 1, 1, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED | SCHEME_PRIM_IS_OMITABLE); + scheme_symbol_p_proc = p; scheme_add_global_constant("symbol?", p, env); p = scheme_make_folding_prim(symbol_unreadable_p_prim, "symbol-unreadable?", 1, 1, 1); @@ -347,9 +352,11 @@ scheme_init_symbol (Scheme_Env *env) GLOBAL_IMMED_PRIM("string->unreadable-symbol", string_to_unreadable_symbol_prim, 1, 1, env); GLOBAL_IMMED_PRIM("symbol->string", symbol_to_string_prim, 1, 1, env); + REGISTER_SO(scheme_keyword_p_proc); p = scheme_make_folding_prim(keyword_p_prim, "keyword?", 1, 1, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED | SCHEME_PRIM_IS_OMITABLE); + scheme_keyword_p_proc = p; scheme_add_global_constant("keyword?", p, env); GLOBAL_FOLDING_PRIM("keyword