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

switch to syntax property for 'compiler-hint:cross-module-inline

Browse Source
This commit is contained in:
Matthew Flatt 2011-12-01 09:36:58 -07:00
parent 903eb9ec32
commit 1bc2441b5a
6 changed files with 58 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/racket/contract/private/arrow.rkt
View File

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

33
collects/racket/private/map.rkt
View File

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

8
collects/scribblings/guide/performance.scrbl
View File

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

8
collects/scribblings/reference/syntax.scrbl
View File

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

27
src/racket/src/compile.c
View File

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

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

@ -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 <proc>)) */
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;