diff --git a/collects/racket/contract/private/arrow.rkt b/collects/racket/contract/private/arrow.rkt index 740ad78f61..abffd8c719 100644 --- a/collects/racket/contract/private/arrow.rkt +++ b/collects/racket/contract/private/arrow.rkt @@ -74,9 +74,15 @@ v4 todo: #,(call-gen #'())] [else #,(call-gen rng-checkers)])))) -(define tail-marks-match? - (begin - 'compiler-hint:cross-module-inline +(define-syntax (cross-module-inline stx) + (syntax-case stx () + [(_ defn) + (syntax-property #'defn + 'compiler-hint:cross-module-inline + #t)])) + +(cross-module-inline + (define tail-marks-match? (case-lambda [(m) (and m (null? m))] [(m rng-ctc) (and m diff --git a/collects/racket/private/map.rkt b/collects/racket/private/map.rkt index 79ee8f55c8..7e1bef220b 100644 --- a/collects/racket/private/map.rkt +++ b/collects/racket/private/map.rkt @@ -4,7 +4,8 @@ (module map '#%kernel (#%require '#%utils ; built into mzscheme - "small-scheme.rkt" "define.rkt") + "small-scheme.rkt" "define.rkt" + (for-syntax '#%kernel)) (#%provide (rename map2 map) (rename for-each2 for-each) @@ -13,9 +14,18 @@ ;; ------------------------------------------------------------------------- - (define map2 - (begin - 'compiler-hint:cross-module-inline + ;; Attach a property to encourage the bytecode compiler to inline + ;; `map', etc.: + (define-syntax hint-inline + (lambda (stx) + (syntax-property (cadr (syntax->list stx)) + 'compiler-hint:cross-module-inline + #t))) + + ;; ------------------------------------------------------------------------- + + (hint-inline + (define map2 (let ([map (case-lambda [(f l) @@ -42,9 +52,8 @@ [(f . args) (apply map f args)])]) map))) - (define for-each2 - (begin - 'compiler-hint:cross-module-inline + (hint-inline + (define for-each2 (let ([for-each (case-lambda [(f l) @@ -71,9 +80,8 @@ [(f . args) (apply for-each f args)])]) for-each))) - (define andmap2 - (begin - 'compiler-hint:cross-module-inline + (hint-inline + (define andmap2 (let ([andmap (case-lambda [(f l) @@ -104,9 +112,8 @@ [(f . args) (apply andmap f args)])]) andmap))) - (define ormap2 - (begin - 'compiler-hint:cross-module-inline + (hint-inline + (define ormap2 (let ([ormap (case-lambda [(f l) diff --git a/collects/scribblings/guide/performance.scrbl b/collects/scribblings/guide/performance.scrbl index 3352a0670a..ec71674402 100644 --- a/collects/scribblings/guide/performance.scrbl +++ b/collects/scribblings/guide/performance.scrbl @@ -169,9 +169,11 @@ itself calls functions other than simple primitive operations. When a module is compiled, some functions defined at the module level are determined to be candidates for inlining into other modules; normally, only trivial functions are considered candidates for cross-module -inlining, but a programmer can use the pattern @racket[(define _id -(begin @#,indexed-racket['compiler-hint:cross-module-inline] -_proc-expr))] to encourage the compiler to inline larger functions. +inlining, but a programmer can attach a +@indexed-racket['compiler-hint:cross-module-inline] @tech[#:doc '(lib +"scribblings/reference/reference.scrbl")]{syntax property} (with a +true value) to a function's definition form to encourage inlining +of the function. Primitive operations like @racket[pair?], @racket[car], and @racket[cdr] are inlined at the machine-code level by the @tech{JIT} diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index 9ee754dadc..f68413923e 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -2080,7 +2080,13 @@ the binding at the same time. (define-values (x y z) (values 1 2 3)) z ] -} + +If a @racket[define-values] form for a function definition in a module +body has a @indexed-racket['compiler-hint:cross-module-inline] +@tech{syntax property} with a true value, then the Racket treats the +property as a performance hint. See +@guidesecref["func-call-performance"] in @|Guide| for more +information.} @defform*[[(define-syntax id expr) diff --git a/src/racket/src/compile.c b/src/racket/src/compile.c index 825b3ba88d..c57062667a 100644 --- a/src/racket/src/compile.c +++ b/src/racket/src/compile.c @@ -54,6 +54,7 @@ ROSYM static Scheme_Object *let_star_values_symbol; ROSYM static Scheme_Object *let_values_symbol; ROSYM static Scheme_Object *begin_symbol; ROSYM static Scheme_Object *disappeared_binding_symbol; +ROSYM static Scheme_Object *compiler_inline_hint_symbol; ROSYM static Scheme_Object *app_symbol; ROSYM static Scheme_Object *datum_symbol; ROSYM static Scheme_Object *top_symbol; @@ -164,6 +165,7 @@ void scheme_init_compile (Scheme_Env *env) REGISTER_SO(let_values_symbol); REGISTER_SO(begin_symbol); REGISTER_SO(disappeared_binding_symbol); + REGISTER_SO(compiler_inline_hint_symbol); scheme_undefined->type = scheme_undefined_type; @@ -176,6 +178,7 @@ void scheme_init_compile (Scheme_Env *env) begin_symbol = scheme_intern_symbol("begin"); disappeared_binding_symbol = scheme_intern_symbol("disappeared-binding"); + compiler_inline_hint_symbol = scheme_intern_symbol("compiler-hint:cross-module-inline"); scheme_define_values_syntax = scheme_make_compiled_syntax(define_values_syntax, define_values_expand); @@ -796,6 +799,11 @@ define_values_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_ SCHEME_VEC_ELS(vec)[1] = val; vec->type = scheme_define_values_type; + if (SCHEME_TRUEP(scheme_stx_property(form, compiler_inline_hint_symbol, NULL))) { + /* use "immutable" bit to mark compiler-inline hint: */ + SCHEME_SET_IMMUTABLE(vec); + } + return vec; } @@ -2780,7 +2788,7 @@ Scheme_Object *scheme_compile_sequence(Scheme_Object *forms, } else { Scheme_Object *body; body = compile_block(forms, env, rec, drec); - return scheme_make_sequence_compilation(body, 2); + return scheme_make_sequence_compilation(body, 1); } } @@ -2852,7 +2860,7 @@ do_begin_syntax(char *name, body = scheme_compile_list(forms, env, rec, drec); } - forms = scheme_make_sequence_compilation(body, zero ? -1 : 2); + forms = scheme_make_sequence_compilation(body, zero ? -1 : 1); if (!zero && SAME_TYPE(SCHEME_TYPE(forms), scheme_sequence_type) @@ -2883,15 +2891,6 @@ Scheme_Sequence *scheme_malloc_sequence(int count) * sizeof(Scheme_Object *)); } -static int scheme_is_compiler_hint(Scheme_Object *v, int opt) -{ - /* Yes, this is a hack! */ - return ((opt == 2) - && SCHEME_SYMBOLP(v) - && !scheme_strncmp(SCHEME_SYM_VAL(v), "compiler-hint:", 14)); -} - - Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt) { /* We have to be defensive in processing `seq'; it might be bad due @@ -2920,8 +2919,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt) total++; } else if (opt && (((opt > 0) && !last) || ((opt < 0) && !first)) - && scheme_omittable_expr(v, -1, -1, 0, NULL, -1) - && !scheme_is_compiler_hint(v, opt)) { + && scheme_omittable_expr(v, -1, -1, 0, NULL, -1)) { /* A value that is not the result. We'll drop it. */ total++; } else { @@ -2981,8 +2979,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt) } else if (opt && (((opt > 0) && (k < total)) || ((opt < 0) && k)) - && scheme_omittable_expr(v, -1, -1, 0, NULL, -1) - && !scheme_is_compiler_hint(v, opt)) { + && scheme_omittable_expr(v, -1, -1, 0, NULL, -1)) { /* Value not the result. Do nothing. */ } else o->array[i++] = v; diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c index 2461f5a991..6fb6f5f994 100644 --- a/src/racket/src/optimize.c +++ b/src/racket/src/optimize.c @@ -4640,7 +4640,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) int start_simltaneous = 0, i_m, cnt; Scheme_Object *cl_first = NULL, *cl_last = NULL; Scheme_Hash_Table *consts = NULL, *fixed_table = NULL, *re_consts = NULL; - Scheme_Hash_Table *originals = NULL, *size_overrides = NULL; + Scheme_Hash_Table *originals = NULL; int cont, next_pos_ready = -1, inline_fuel, is_proc_def; Comp_Prefix *prev_cp; @@ -4697,25 +4697,6 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) /* Optimize this expression: */ e = SCHEME_VEC_ELS(m->bodies[0])[i_m]; - /* detect (define-values ... (begin 'compiler-hint:cross-module-inline )) */ - if (info->enforce_const - && SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) { - Scheme_Object *e2; - e2 = SCHEME_VEC_ELS(e)[1]; - if (SAME_TYPE(SCHEME_TYPE(e2), scheme_sequence_type)) { - Scheme_Sequence *seq = (Scheme_Sequence *)e2; - if (seq->count == 2) { - if (SCHEME_SYMBOLP(seq->array[0]) - && !SCHEME_SYM_WEIRDP(seq->array[0]) - && !strcmp(SCHEME_SYM_VAL(seq->array[0]), "compiler-hint:cross-module-inline")) { - if (!size_overrides) - size_overrides = scheme_make_hash_table(SCHEME_hash_ptr); - scheme_hash_set(size_overrides, scheme_make_integer(i_m), scheme_true); - } - } - } - } - is_proc_def = 0; if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) { if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) { @@ -4970,24 +4951,19 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context) /* Optimize this expression: */ e = SCHEME_VEC_ELS(m->bodies[0])[i_m]; if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) { + int size_override; + size_override = SCHEME_IMMUTABLEP(e); vars = SCHEME_VEC_ELS(e)[0]; if (SCHEME_PAIRP(vars) && SCHEME_NULLP(SCHEME_CDR(vars))) { Scheme_Object *sub_e, *alt_e; sub_e = SCHEME_VEC_ELS(e)[1]; alt_e = is_cross_module_inline_candidiate(sub_e, info, 0); - alt_e = NULL; if (!alt_e && originals) { alt_e = scheme_hash_get(originals, scheme_make_integer(i_m)); - if (SAME_OBJ(alt_e, sub_e) && !size_overrides) + if (SAME_OBJ(alt_e, sub_e) && !size_override) alt_e = NULL; - else if (alt_e) { - int size_override; - if (size_overrides && scheme_hash_get(size_overrides, scheme_make_integer(i_m))) - size_override = 1; - else - size_override = 0; + else if (alt_e) alt_e = is_cross_module_inline_candidiate(alt_e, info, size_override); - } } if (alt_e) { Scheme_Object *iv;