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

inline map', for-each', andmap', and ormap'

Browse Source 
More generally, support a
 (define _id (begin 'compiler-hint:cross-module-inline _proc-expr))
hint, which is how the compiler determines that `map', etc., are
candidates for inlining.
This commit is contained in:
Matthew Flatt 2011-11-30 17:09:28 -07:00
parent 1ca79003f1
commit 99032a75d0
11 changed files with 655 additions and 261 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/racket/private/kw.rkt
View File

@ -796,19 +796,19 @@
(define-syntax (new-define stx) (define-syntax (new-define stx)
(let-values ([(id rhs) (let-values ([(id rhs)
(normalize-definition stx #'new-lambda #t #t)]) (normalize-definition stx #'new-lambda #t #t)])
(let ([plain (lambda (rhs) (let* ([plain (lambda (rhs)
(quasisyntax/loc stx (quasisyntax/loc stx
(define #,id #,rhs)))]) (define #,id #,rhs)))]
(syntax-case rhs () [can-opt? (lambda (lam-id)
[(lam-id . _) (and (identifier? lam-id)
(and (let ([ctx (syntax-local-context)]) (or (free-identifier=? lam-id #'new-lambda)
(free-identifier=? lam-id #'new-λ))
(let ([ctx (syntax-local-context)])
(or (and (memq ctx '(module module-begin)) (or (and (memq ctx '(module module-begin))
(compile-enforce-module-constants)) (compile-enforce-module-constants))
(and (list? ctx) (and (list? ctx)
(andmap liberal-define-context? ctx)))) (andmap liberal-define-context? ctx))))))]
(identifier? #'lam-id) [opt (lambda (rhs core-wrap plain)
(or (free-identifier=? #'lam-id #'new-lambda)
(free-identifier=? #'lam-id #'new-λ)))
(parse-lambda rhs (parse-lambda rhs
id id
plain plain
@ -827,11 +827,25 @@
#,n-req #,n-opt #,rest? #,n-req #,n-opt #,rest?
'#,req-kws '#,all-kws))) '#,req-kws '#,all-kws)))
#,(quasisyntax/loc stx #,(quasisyntax/loc stx
(define #,core-id #,impl)) (define #,core-id #,(core-wrap impl)))
#,(quasisyntax/loc stx #,(quasisyntax/loc stx
(define #,unpack-id #,kwimpl)) (define #,unpack-id #,kwimpl))
#,(quasisyntax/loc stx #,(quasisyntax/loc stx
(define proc #,wrap))))))))] (define proc #,wrap)))))))))])
(syntax-case rhs (begin quote)
[(lam-id . _)
(can-opt? #'lam-id)
(opt rhs values plain)]
[(begin (quote sym) (lam-id . _))
;; looks like a compiler hint
(and (can-opt? #'lam-id)
(identifier? #'sym))
(syntax-case rhs ()
[(_ _ sub-rhs)
(let ([wrap (lambda (stx) #`(begin (quote sym) #,stx))])
(opt #'sub-rhs
wrap
(lambda (rhs) (plain (wrap rhs)))))])]
[_ (plain rhs)])))) [_ (plain rhs)]))))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -14,6 +14,8 @@
;; ------------------------------------------------------------------------- ;; -------------------------------------------------------------------------
(define map2 (define map2
(begin
'compiler-hint:cross-module-inline
(let ([map (let ([map
(case-lambda (case-lambda
[(f l) [(f l)
@ -38,9 +40,11 @@
(loop (cdr l1) (cdr l2)))])) (loop (cdr l1) (cdr l2)))]))
(map f l1 l2))] (map f l1 l2))]
[(f . args) (apply map f args)])]) [(f . args) (apply map f args)])])
map)) map)))
(define for-each2 (define for-each2
(begin
'compiler-hint:cross-module-inline
(let ([for-each (let ([for-each
(case-lambda (case-lambda
[(f l) [(f l)
@ -65,9 +69,11 @@
(loop (cdr l1) (cdr l2)))])) (loop (cdr l1) (cdr l2)))]))
(for-each f l1 l2))] (for-each f l1 l2))]
[(f . args) (apply for-each f args)])]) [(f . args) (apply for-each f args)])])
for-each)) for-each)))
(define andmap2 (define andmap2
(begin
'compiler-hint:cross-module-inline
(let ([andmap (let ([andmap
(case-lambda (case-lambda
[(f l) [(f l)
@ -96,9 +102,11 @@
(loop (cdr l1) (cdr l2)))]))) (loop (cdr l1) (cdr l2)))])))
(andmap f l1 l2))] (andmap f l1 l2))]
[(f . args) (apply andmap f args)])]) [(f . args) (apply andmap f args)])])
andmap)) andmap)))
(define ormap2 (define ormap2
(begin
'compiler-hint:cross-module-inline
(let ([ormap (let ([ormap
(case-lambda (case-lambda
[(f l) [(f l)
@ -127,4 +135,4 @@
(loop (cdr l1) (cdr l2)))]))) (loop (cdr l1) (cdr l2)))])))
(ormap f l1 l2))] (ormap f l1 l2))]
[(f . args) (apply ormap f args)])]) [(f . args) (apply ormap f args)])])
ormap))) ormap))))

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

@ -110,9 +110,11 @@ disables the @tech{JIT} compiler's assumptions about module
definitions when interactive exploration is more important. See definitions when interactive exploration is more important. See
@secref["module-set"] for more information. @secref["module-set"] for more information.
Currently, the compiler does not attempt to inline or propagate The compiler may inline functions or propagate constants across module
constants across module boundaries, except for exports of the built-in boundaries. To avoid generating too much code in the case of function
modules (such as the one that originally provides @racket[+]). inlining, the compiler is conservative when choosing candidates for
cross-module inlining; see @secref["func-call-performance"] for
information on providing inlining hints to the compiler.
The later section @secref["letrec-performance"] provides some The later section @secref["letrec-performance"] provides some
additional caveats concerning inlining of module bindings. additional caveats concerning inlining of module bindings.
@ -152,6 +154,25 @@ therefore permit call optimizations, so
within a module would perform the same as the @racket[letrec] version. within a module would perform the same as the @racket[letrec] version.
For direct calls to functions with keyword arguments, the compiler can
typically check keyword arguments statically and generate a direct
call to a non-keyword variant of the function, which reduces the
run-time overhead of keyword checking. This optimization applies only
for keyword-accepting procedures that are bound with @racket[define].
For immediate calls to functions that are small enough, the compiler
may inline the function call by replacing the call with the body of
the function. In addition to the size of the target function's body,
the compiler's heuristics take into account the amount of inlining
already performed at the call site and whether the called function
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.
Primitive operations like @racket[pair?], @racket[car], and Primitive operations like @racket[pair?], @racket[car], and
@racket[cdr] are inlined at the machine-code level by the @tech{JIT} @racket[cdr] are inlined at the machine-code level by the @tech{JIT}
compiler. See also the later section @secref["fixnums+flonums"] for compiler. See also the later section @secref["fixnums+flonums"] for

35
collects/tests/racket/optimize.rktl
View File

@ -1372,6 +1372,41 @@
(require racket/bool) (require racket/bool)
(list #t))) (list #t)))
(test-comp `(module m racket/base
(require racket/list)
empty?
(empty? 10))
`(module m racket/base
(require racket/list)
empty? ; so that it counts as imported
(null? 10)))
(module check-inline-request racket/base
(provide loop)
(define loop
(begin
'compiler-hint:cross-module-inline
;; large enough that the compiler wouldn't infer inlining:
(lambda (f n)
(let loop ([i n])
(if (zero? i)
10
(cons (f i) (loop (sub1 n)))))))))
(test-comp `(module m racket/base
(require 'check-inline-request)
loop
(loop list 1)) ; 1 is small enough to fully unroll
`(module m racket/base
(require 'check-inline-request)
loop ; so that it counts as imported
(let ([f list]
[n 1])
(let loop ([i n])
(if (zero? i)
10
(cons (f i) (loop (sub1 n))))))))
;; check omit & reorder possibilities for unsafe ;; check omit & reorder possibilities for unsafe
;; operations on mutable values: ;; operations on mutable values:
(let () (let ()

3
doc/release-notes/racket/HISTORY.txt
View File

@ -1,5 +1,6 @@
Version 5.2.0.5 Version 5.2.0.5
Cross-module inlining of trivial functions Cross-module inlining of trivial functions, plus map, for-each,
andmap, and ormap; 'compiler-hint:cross-module-inline hint
compiler/zo-structs: added inline-variant compiler/zo-structs: added inline-variant
Version 5.2.0.4 Version 5.2.0.4

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

@ -2780,7 +2780,7 @@ Scheme_Object *scheme_compile_sequence(Scheme_Object *forms,
} else { } else {
Scheme_Object *body; Scheme_Object *body;
body = compile_block(forms, env, rec, drec); body = compile_block(forms, env, rec, drec);
return scheme_make_sequence_compilation(body, 1); return scheme_make_sequence_compilation(body, 2);
} }
} }
@ -2852,7 +2852,7 @@ do_begin_syntax(char *name,
body = scheme_compile_list(forms, env, rec, drec); body = scheme_compile_list(forms, env, rec, drec);
} }
forms = scheme_make_sequence_compilation(body, zero ? -1 : 1); forms = scheme_make_sequence_compilation(body, zero ? -1 : 2);
if (!zero if (!zero
&& SAME_TYPE(SCHEME_TYPE(forms), scheme_sequence_type) && SAME_TYPE(SCHEME_TYPE(forms), scheme_sequence_type)
@ -2883,6 +2883,15 @@ Scheme_Sequence *scheme_malloc_sequence(int count)
* sizeof(Scheme_Object *)); * 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) Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
{ {
/* We have to be defensive in processing `seq'; it might be bad due /* We have to be defensive in processing `seq'; it might be bad due
@ -2911,7 +2920,8 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
total++; total++;
} else if (opt } else if (opt
&& (((opt > 0) && !last) || ((opt < 0) && !first)) && (((opt > 0) && !last) || ((opt < 0) && !first))
&& scheme_omittable_expr(v, -1, -1, 0, NULL, -1)) { && scheme_omittable_expr(v, -1, -1, 0, NULL, -1)
&& !scheme_is_compiler_hint(v, opt)) {
/* A value that is not the result. We'll drop it. */ /* A value that is not the result. We'll drop it. */
total++; total++;
} else { } else {
@ -2971,7 +2981,8 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
} else if (opt } else if (opt
&& (((opt > 0) && (k < total)) && (((opt > 0) && (k < total))
|| ((opt < 0) && k)) || ((opt < 0) && k))
&& scheme_omittable_expr(v, -1, -1, 0, NULL, -1)) { && scheme_omittable_expr(v, -1, -1, 0, NULL, -1)
&& !scheme_is_compiler_hint(v, opt)) {
/* Value not the result. Do nothing. */ /* Value not the result. Do nothing. */
} else } else
o->array[i++] = v; o->array[i++] = v;

2
src/racket/src/mzmark_resolve.inc
View File

@ -56,6 +56,7 @@ static int mark_unresolve_info_MARK(void *p, struct NewGC *gc) {
gcMARK2(i->flags, gc); gcMARK2(i->flags, gc);
gcMARK2(i->depths, gc); gcMARK2(i->depths, gc);
gcMARK2(i->prefix, gc); gcMARK2(i->prefix, gc);
gcMARK2(i->closures, gc);
return return
gcBYTES_TO_WORDS(sizeof(Unresolve_Info)); gcBYTES_TO_WORDS(sizeof(Unresolve_Info));
@ -67,6 +68,7 @@ static int mark_unresolve_info_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(i->flags, gc); gcFIXUP2(i->flags, gc);
gcFIXUP2(i->depths, gc); gcFIXUP2(i->depths, gc);
gcFIXUP2(i->prefix, gc); gcFIXUP2(i->prefix, gc);
gcFIXUP2(i->closures, gc);
return return
gcBYTES_TO_WORDS(sizeof(Unresolve_Info)); gcBYTES_TO_WORDS(sizeof(Unresolve_Info));

1
src/racket/src/mzmarksrc.c
View File

@ -1240,6 +1240,7 @@ mark_unresolve_info {
gcMARK2(i->flags, gc); gcMARK2(i->flags, gc);
gcMARK2(i->depths, gc); gcMARK2(i->depths, gc);
gcMARK2(i->prefix, gc); gcMARK2(i->prefix, gc);
gcMARK2(i->closures, gc);
size: size:
gcBYTES_TO_WORDS(sizeof(Unresolve_Info)); gcBYTES_TO_WORDS(sizeof(Unresolve_Info));

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

@ -904,6 +904,23 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
return p; return p;
} }
int scheme_check_leaf_rator(Scheme_Object *le, int *_flags)
{
if (le && SCHEME_PRIMP(le)) {
int opt;
opt = ((Scheme_Prim_Proc_Header *)le)->flags & SCHEME_PRIM_OPT_MASK;
if (opt >= SCHEME_PRIM_OPT_NONCM) {
if (_flags)
*_flags = (CLOS_PRESERVES_MARKS | CLOS_SINGLE_RESULT);
if (opt >= SCHEME_PRIM_OPT_IMMEDIATE) {
return 1;
}
}
}
return 0;
}
#if 0 #if 0
# define LOG_INLINE(x) x # define LOG_INLINE(x) x
#else #else
@ -964,8 +981,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
iv = scheme_hash_get(info->cp->inline_variants, scheme_make_integer(pos)); iv = scheme_hash_get(info->cp->inline_variants, scheme_make_integer(pos));
if (iv) { if (iv) {
if (SAME_TYPE(SCHEME_TYPE(iv), scheme_inline_variant_type)) { if (SAME_TYPE(SCHEME_TYPE(iv), scheme_inline_variant_type)) {
iv = scheme_unresolve(iv); iv = scheme_unresolve(iv, argc);
// printf("un: %p\n", iv);
scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), iv); scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), iv);
} }
if (iv) { if (iv) {
@ -1083,16 +1099,8 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
} }
} }
if (le && SCHEME_PRIMP(le)) { if (scheme_check_leaf_rator(le, _flags))
int opt;
opt = ((Scheme_Prim_Proc_Header *)le)->flags & SCHEME_PRIM_OPT_MASK;
if (opt >= SCHEME_PRIM_OPT_NONCM) {
*_flags = (CLOS_PRESERVES_MARKS | CLOS_SINGLE_RESULT);
if (opt >= SCHEME_PRIM_OPT_IMMEDIATE) {
nonleaf = 0; nonleaf = 0;
}
}
}
if (le && SCHEME_PROCP(le) && (app || app2 || app3)) { if (le && SCHEME_PROCP(le) && (app || app2 || app3)) {
Scheme_Object *a[1]; Scheme_Object *a[1];
@ -4577,16 +4585,53 @@ static int set_code_closure_flags(Scheme_Object *clones,
return flags; return flags;
} }
static Scheme_Object *is_cross_module_inline_candidiate(Scheme_Object *e, Optimize_Info *info) static Scheme_Object *is_cross_module_inline_candidiate(Scheme_Object *e, Optimize_Info *info,
int size_override)
{ {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_compiled_unclosed_procedure_type)) { if (IS_COMPILED_PROC(e)) {
if (compiled_proc_body_size(e, 1) < CROSS_MODULE_INLINE_SIZE) if (size_override || (compiled_proc_body_size(e, 1) < CROSS_MODULE_INLINE_SIZE))
return scheme_optimize_clone(0, e, info, 0, 0); return scheme_optimize_clone(0, e, info, 0, 0);
} }
return NULL; return NULL;
} }
static int is_general_compiled_proc(Scheme_Object *e)
{
/* recognize (begin <omitable>* <proc>) */
if (SCHEME_TYPE(e) == scheme_sequence_type) {
Scheme_Sequence *seq = (Scheme_Sequence *)e;
if (seq->count > 0) {
int i;
for (i = seq->count - 1; i--; ) {
if (!scheme_omittable_expr(seq->array[i], -1, 20, 0, NULL, -1))
return 0;
}
}
e = seq->array[seq->count - 1];
}
/* recognize (let ([x <proc>]) x) */
if (SCHEME_TYPE(e) == scheme_compiled_let_void_type) {
Scheme_Let_Header *lh = (Scheme_Let_Header *)e;
if (!(SCHEME_LET_FLAGS(lh) & SCHEME_LET_RECURSIVE)
&& (lh->count == 1)
&& (lh->num_clauses == 1)
&& SAME_TYPE(SCHEME_TYPE(lh->body), scheme_compiled_let_value_type)) {
Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body;
if (IS_COMPILED_PROC(lv->value)) {
if (SAME_TYPE(SCHEME_TYPE(lv->body), scheme_local_type))
return (SCHEME_LOCAL_POS(lv->body) == 0);
}
}
}
if (IS_COMPILED_PROC(e))
return 1;
return 0;
}
static Scheme_Object * static Scheme_Object *
module_optimize(Scheme_Object *data, Optimize_Info *info, int context) module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
{ {
@ -4594,7 +4639,8 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
Scheme_Object *e, *vars, *old_context; Scheme_Object *e, *vars, *old_context;
int start_simltaneous = 0, i_m, cnt; int start_simltaneous = 0, i_m, cnt;
Scheme_Object *cl_first = NULL, *cl_last = NULL; Scheme_Object *cl_first = NULL, *cl_last = NULL;
Scheme_Hash_Table *consts = NULL, *fixed_table = NULL, *re_consts = NULL, *originals = NULL; Scheme_Hash_Table *consts = NULL, *fixed_table = NULL, *re_consts = NULL;
Scheme_Hash_Table *originals = NULL, *size_overrides = NULL;
int cont, next_pos_ready = -1, inline_fuel, is_proc_def; int cont, next_pos_ready = -1, inline_fuel, is_proc_def;
Comp_Prefix *prev_cp; Comp_Prefix *prev_cp;
@ -4651,13 +4697,31 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->bodies[0])[i_m]; 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; is_proc_def = 0;
if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) { if (OPT_DISCOURAGE_EARLY_INLINE && info->enforce_const) {
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) { if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
Scheme_Object *e2; Scheme_Object *e2;
e2 = (Scheme_Object *)e; e2 = SCHEME_VEC_ELS(e)[1];
e2 = SCHEME_VEC_ELS(e2)[1]; if (is_general_compiled_proc(e2))
if (IS_COMPILED_PROC(e2))
is_proc_def = 1; is_proc_def = 1;
} }
} }
@ -4901,20 +4965,29 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
/* For functions that are potentially inlineable, perhaps /* For functions that are potentially inlineable, perhaps
before optimization, insert inline_variant records: */ before optimization, insert inline_variant records: */
if (info->enforce_const) {
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->bodies[0])[i_m]; e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) { if (SAME_TYPE(SCHEME_TYPE(e), scheme_define_values_type)) {
vars = SCHEME_VEC_ELS(e)[0];
if (SCHEME_PAIRP(vars) && SCHEME_NULLP(SCHEME_CDR(vars))) {
Scheme_Object *sub_e, *alt_e; Scheme_Object *sub_e, *alt_e;
sub_e = SCHEME_VEC_ELS(e)[1]; sub_e = SCHEME_VEC_ELS(e)[1];
if (IS_COMPILED_PROC(sub_e)) { alt_e = is_cross_module_inline_candidiate(sub_e, info, 0);
alt_e = is_cross_module_inline_candidiate(sub_e, info); alt_e = NULL;
if (!alt_e && originals) { if (!alt_e && originals) {
alt_e = scheme_hash_get(originals, scheme_make_integer(i_m)); alt_e = scheme_hash_get(originals, scheme_make_integer(i_m));
if (SAME_OBJ(alt_e, sub_e)) if (SAME_OBJ(alt_e, sub_e) && !size_overrides)
alt_e = NULL; alt_e = NULL;
else if (alt_e) else if (alt_e) {
alt_e = is_cross_module_inline_candidiate(alt_e, info); int size_override;
if (size_overrides && scheme_hash_get(size_overrides, scheme_make_integer(i_m)))
size_override = 1;
else
size_override = 0;
alt_e = is_cross_module_inline_candidiate(alt_e, info, size_override);
}
} }
if (alt_e) { if (alt_e) {
Scheme_Object *iv; Scheme_Object *iv;
@ -4927,6 +5000,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
} }
} }
} }
}
/* Check one more time for expressions that we can omit: */ /* Check one more time for expressions that we can omit: */
{ {

355
src/racket/src/resolve.c
View File

@ -40,7 +40,7 @@
struct Resolve_Info struct Resolve_Info
{ {
MZTAG_IF_REQUIRED MZTAG_IF_REQUIRED
char use_jit, in_module, in_proc, enforce_const; char use_jit, in_module, in_proc, enforce_const, no_lift;
int size, oldsize, count, pos; int size, oldsize, count, pos;
int max_let_depth; /* filled in by sub-expressions */ int max_let_depth; /* filled in by sub-expressions */
Resolve_Prefix *prefix; Resolve_Prefix *prefix;
@ -626,13 +626,20 @@ static Scheme_Object *
inline_variant_resolve(Scheme_Object *data, Resolve_Info *rslv) inline_variant_resolve(Scheme_Object *data, Resolve_Info *rslv)
{ {
Scheme_Object *a; Scheme_Object *a;
char no_lift;
a = SCHEME_VEC_ELS(data)[0]; a = SCHEME_VEC_ELS(data)[0];
a = scheme_resolve_expr(a, rslv); a = scheme_resolve_expr(a, rslv);
SCHEME_VEC_ELS(data)[0] = a; SCHEME_VEC_ELS(data)[0] = a;
/* Don't lift closures in the inline variant, since that
just creates lifted bindings and closure cycles that we
don't want to deal with when inlining. */
a = SCHEME_VEC_ELS(data)[1]; a = SCHEME_VEC_ELS(data)[1];
no_lift = rslv->no_lift;
rslv->no_lift = 1;
a = scheme_resolve_expr(a, rslv); a = scheme_resolve_expr(a, rslv);
rslv->no_lift = no_lift;
SCHEME_VEC_ELS(data)[1] = a; SCHEME_VEC_ELS(data)[1] = a;
return data; return data;
@ -1252,7 +1259,9 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
Then fall back to assuming no lifts. */ Then fall back to assuming no lifts. */
linfo = 0; linfo = 0;
for (resolve_phase = ((num_rec_procs && !rec_proc_nonapply) ? 0 : 2); resolve_phase < 3; resolve_phase++) { for (resolve_phase = ((num_rec_procs && !rec_proc_nonapply && !info->no_lift) ? 0 : 2);
resolve_phase < 3;
resolve_phase++) {
/* Don't try plain lifting if we're not inside a proc: */ /* Don't try plain lifting if we're not inside a proc: */
if ((resolve_phase == 1) && !resolve_is_inside_proc(info)) if ((resolve_phase == 1) && !resolve_is_inside_proc(info))
@ -2584,6 +2593,7 @@ static Resolve_Info *resolve_info_extend(Resolve_Info *info, int size, int oldsi
naya->pos = 0; naya->pos = 0;
naya->toplevel_pos = -1; naya->toplevel_pos = -1;
naya->lifts = info->lifts; naya->lifts = info->lifts;
naya->no_lift = info->no_lift;
if (mapc) { if (mapc) {
int i, *ia; int i, *ia;
@ -3005,6 +3015,12 @@ static int resolving_in_procedure(Resolve_Info *info)
/* uresolve */ /* uresolve */
/*========================================================================*/ /*========================================================================*/
#if 0
# define return_NULL return (printf("%d\n", __LINE__), NULL)
#else
# define return_NULL return NULL
#endif
typedef struct Unresolve_Info { typedef struct Unresolve_Info {
MZTAG_IF_REQUIRED MZTAG_IF_REQUIRED
int stack_pos; /* stack in resolved coordinates */ int stack_pos; /* stack in resolved coordinates */
@ -3013,10 +3029,11 @@ typedef struct Unresolve_Info {
int *flags; int *flags;
mzshort *depths; mzshort *depths;
Scheme_Prefix *prefix; Scheme_Prefix *prefix;
int fail_after_all; Scheme_Hash_Table *closures; /* handle cycles */
int has_non_leaf, body_size;
} Unresolve_Info; } Unresolve_Info;
static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui); static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui, int as_rator);
static Unresolve_Info *new_unresolve_info(Scheme_Prefix *prefix) static Unresolve_Info *new_unresolve_info(Scheme_Prefix *prefix)
{ {
@ -3080,15 +3097,48 @@ static int *unresolve_stack_pop(Unresolve_Info *ui, int pos, int n)
return f; return f;
} }
XFORM_NONGCING static int combine_flags(int a, int b)
{
int ac, bc;
/* We don't currently try to support SCHEME_WAS_APPLIED_EXCEPT_ONCE,
since that's to detect ((letrec ([f ....]) f) ....) patterns
that would have been converted away already for code to inline
across a module boundary. We do need to track SCHEME_WAS_ONLY_APPLIED,
so that the resolver can ultimately lift expressions. */
if ((b & SCHEME_WAS_ONLY_APPLIED) && !(a & SCHEME_WAS_ONLY_APPLIED)) {
bc = b;
b = a;
a = bc;
}
if (a & SCHEME_WAS_ONLY_APPLIED) {
if ((b & SCHEME_WAS_USED) && !(b & SCHEME_WAS_ONLY_APPLIED))
a -= SCHEME_WAS_ONLY_APPLIED;
}
ac = (a & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT;
bc = (b & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT;
ac += bc;
if (ac > SCHEME_USE_COUNT_INF)
ac = SCHEME_USE_COUNT_INF;
a |= b;
a = (a - (a & SCHEME_USE_COUNT_MASK)) | (ac << SCHEME_USE_COUNT_SHIFT);
return a;
}
static int unresolve_set_flag(Unresolve_Info *ui, int pos, int flag) static int unresolve_set_flag(Unresolve_Info *ui, int pos, int flag)
{ {
int i = ui->stack_pos - pos - 1; int old_flag, i = ui->stack_pos - pos - 1;
if (pos >= ui->stack_pos) scheme_signal_error("internal error: unresolve too far"); if (pos >= ui->stack_pos) scheme_signal_error("internal error: unresolve too far");
flag |= ui->flags[i]; old_flag = ui->flags[i];
if (((flag & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT) < SCHEME_USE_COUNT_INF) flag = combine_flags(flag | (1 << SCHEME_USE_COUNT_SHIFT), old_flag);
flag += (1 << SCHEME_USE_COUNT_SHIFT);
ui->flags[i] = flag; ui->flags[i] = flag;
return ui->depth - ui->depths[i] - 1; return ui->depth - ui->depths[i] - 1;
@ -3099,12 +3149,16 @@ Scheme_Object *unresolve_closure(Scheme_Closure_Data *rdata, Unresolve_Info *ui)
Scheme_Closure_Data *data; Scheme_Closure_Data *data;
Scheme_Object *body; Scheme_Object *body;
Closure_Info *cl; Closure_Info *cl;
int pos, data_pos, *flags; int i, pos, data_pos, *flags, init_size, has_non_leaf;
scheme_delay_load_closure(rdata); scheme_delay_load_closure(rdata);
if (rdata->closure_size) if (rdata->closure_size) {
return 0; /* won't work, yet */ for (i = rdata->closure_size; i--; ) {
if (rdata->closure_map[i] > ui->stack_pos)
return_NULL; /* needs something (perhaps prefix) beyond known stack */
}
}
data = MALLOC_ONE_TAGGED(Scheme_Closure_Data); data = MALLOC_ONE_TAGGED(Scheme_Closure_Data);
@ -3118,11 +3172,22 @@ Scheme_Object *unresolve_closure(Scheme_Closure_Data *rdata, Unresolve_Info *ui)
pos = unresolve_stack_push(ui, data->num_params, 0); pos = unresolve_stack_push(ui, data->num_params, 0);
if (rdata->closure_size) if (rdata->closure_size) {
data_pos = unresolve_stack_push(ui, data->closure_size, 0); data_pos = unresolve_stack_push(ui, rdata->closure_size, 1);
/* remap closure slots: */
for (i = rdata->closure_size; i--; ) {
int mp;
mp = ui->depths[pos - rdata->closure_map[i] - 1];
ui->depths[ui->stack_pos - i - 1] = mp;
}
}
body = unresolve_expr(rdata->code, ui); init_size = ui->body_size;
if (!body) return NULL; has_non_leaf = ui->has_non_leaf;
ui->has_non_leaf = 0;
body = unresolve_expr(rdata->code, ui, 0);
if (!body) return_NULL;
data->code = body; data->code = body;
@ -3130,8 +3195,22 @@ Scheme_Object *unresolve_closure(Scheme_Closure_Data *rdata, Unresolve_Info *ui)
SET_REQUIRED_TAG(cl->type = scheme_rt_closure_info); SET_REQUIRED_TAG(cl->type = scheme_rt_closure_info);
data->closure_map = (mzshort *)cl; data->closure_map = (mzshort *)cl;
if (rdata->closure_size) cl->body_size = (ui->body_size - init_size);
cl->has_nonleaf = ui->has_non_leaf;
ui->has_non_leaf = has_non_leaf;
if (rdata->closure_size) {
/* copy flags from unpacked closure to original slots */
for (i = rdata->closure_size; i--; ) {
int a, b;
a = ui->flags[pos - rdata->closure_map[i] - 1];
b = ui->flags[ui->stack_pos - i - 1];
a = combine_flags(a, b);
ui->flags[pos - rdata->closure_map[i] - 1] = a;
}
(void)unresolve_stack_pop(ui, data_pos, 0); (void)unresolve_stack_pop(ui, data_pos, 0);
}
flags = unresolve_stack_pop(ui, pos, data->num_params); flags = unresolve_stack_pop(ui, pos, data->num_params);
cl->local_flags = flags; cl->local_flags = flags;
@ -3148,11 +3227,17 @@ static Scheme_Object *unresolve_expr_k(void)
p->ku.k.p1 = NULL; p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL; p->ku.k.p2 = NULL;
return unresolve_expr(e, ui); return unresolve_expr(e, ui, p->ku.k.i1);
}
static void check_nonleaf_rator(Scheme_Object *rator, Unresolve_Info *ui)
{
if (!scheme_check_leaf_rator(rator, NULL))
ui->has_non_leaf = 1;
} }
static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui) static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui, int as_rator)
{ {
#ifdef DO_STACK_CHECK #ifdef DO_STACK_CHECK
{ {
@ -3162,35 +3247,63 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui)
p->ku.k.p1 = (void *)e; p->ku.k.p1 = (void *)e;
p->ku.k.p2 = (void *)ui; p->ku.k.p2 = (void *)ui;
p->ku.k.i1 = as_rator;
return scheme_handle_stack_overflow(unresolve_expr_k); return scheme_handle_stack_overflow(unresolve_expr_k);
} }
} }
#endif #endif
ui->body_size++;
switch (SCHEME_TYPE(e)) { switch (SCHEME_TYPE(e)) {
case scheme_local_type: case scheme_local_type:
return scheme_make_local(scheme_local_type, return scheme_make_local(scheme_local_type,
unresolve_set_flag(ui, SCHEME_LOCAL_POS(e), SCHEME_WAS_USED), unresolve_set_flag(ui,
SCHEME_LOCAL_POS(e),
(SCHEME_WAS_USED
| (as_rator
? SCHEME_WAS_ONLY_APPLIED
: 0))),
0); 0);
case scheme_local_unbox_type: case scheme_local_unbox_type:
return scheme_make_local(scheme_local_type, return scheme_make_local(scheme_local_type,
unresolve_set_flag(ui, SCHEME_LOCAL_POS(e), unresolve_set_flag(ui, SCHEME_LOCAL_POS(e),
(SCHEME_WAS_SET_BANGED | SCHEME_WAS_USED)), (SCHEME_WAS_SET_BANGED | SCHEME_WAS_USED)),
0); 0);
case scheme_sequence_type:
{
Scheme_Sequence *seq = (Scheme_Sequence *)e, *seq2;
int i;
seq2 = scheme_malloc_sequence(seq->count);
seq2->so.type = scheme_sequence_type;
seq2->count = seq->count;
for (i = seq->count; i--; ) {
e = unresolve_expr(seq->array[i], ui, 0);
if (!e) return_NULL;
seq2->array[i] = e;
}
return (Scheme_Object *)seq2;
}
break;
case scheme_application_type: case scheme_application_type:
{ {
Scheme_App_Rec *app = (Scheme_App_Rec *)e, *app2; Scheme_App_Rec *app = (Scheme_App_Rec *)e, *app2;
Scheme_Object *a; Scheme_Object *a;
int pos, i; int pos, i;
ui->body_size += app->num_args;
check_nonleaf_rator(app->args[0], ui);
pos = unresolve_stack_push(ui, app->num_args, 1); pos = unresolve_stack_push(ui, app->num_args, 1);
app2 = scheme_malloc_application(app->num_args+1); app2 = scheme_malloc_application(app->num_args+1);
for (i = app->num_args + 1; i--; ) { for (i = app->num_args + 1; i--; ) {
a = unresolve_expr(app->args[i], ui); a = unresolve_expr(app->args[i], ui, !i);
if (!a) return NULL; if (!a) return_NULL;
app2->args[i] = a; app2->args[i] = a;
} }
@ -3204,12 +3317,15 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui)
Scheme_Object *rator, *rand; Scheme_Object *rator, *rand;
int pos; int pos;
ui->body_size += 1;
check_nonleaf_rator(app->rator, ui);
pos = unresolve_stack_push(ui, 1, 1); pos = unresolve_stack_push(ui, 1, 1);
rator = unresolve_expr(app->rator, ui); rator = unresolve_expr(app->rator, ui, 1);
if (!rator) return NULL; if (!rator) return_NULL;
rand = unresolve_expr(app->rand, ui); rand = unresolve_expr(app->rand, ui, 0);
if (!rand) return NULL; if (!rand) return_NULL;
(void)unresolve_stack_pop(ui, pos, 0); (void)unresolve_stack_pop(ui, pos, 0);
@ -3226,14 +3342,17 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui)
Scheme_Object *rator, *rand1, *rand2; Scheme_Object *rator, *rand1, *rand2;
int pos; int pos;
ui->body_size += 2;
check_nonleaf_rator(app->rator, ui);
pos = unresolve_stack_push(ui, 2, 1); pos = unresolve_stack_push(ui, 2, 1);
rator = unresolve_expr(app->rator, ui); rator = unresolve_expr(app->rator, ui, 1);
if (!rator) return NULL; if (!rator) return_NULL;
rand1 = unresolve_expr(app->rand1, ui); rand1 = unresolve_expr(app->rand1, ui, 0);
if (!rand1) return NULL; if (!rand1) return_NULL;
rand2 = unresolve_expr(app->rand2, ui); rand2 = unresolve_expr(app->rand2, ui, 0);
if (!rand2) return NULL; if (!rand2) return_NULL;
(void)unresolve_stack_pop(ui, pos, 0); (void)unresolve_stack_pop(ui, pos, 0);
@ -3250,12 +3369,12 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui)
Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)e, *b2; Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)e, *b2;
Scheme_Object *tst, *thn, *els; Scheme_Object *tst, *thn, *els;
tst = unresolve_expr(b->test, ui); tst = unresolve_expr(b->test, ui, 0);
if (!tst) return NULL; if (!tst) return_NULL;
thn = unresolve_expr(b->tbranch, ui); thn = unresolve_expr(b->tbranch, ui, 0);
if (!thn) return NULL; if (!thn) return_NULL;
els = unresolve_expr(b->fbranch, ui); els = unresolve_expr(b->fbranch, ui, 0);
if (!els) return NULL; if (!els) return_NULL;
b2 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec); b2 = MALLOC_ONE_TAGGED(Scheme_Branch_Rec);
b2->so.type = scheme_branch_type; b2->so.type = scheme_branch_type;
@ -3265,24 +3384,83 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui)
return (Scheme_Object *)b2; return (Scheme_Object *)b2;
} }
case scheme_let_void_type:
{
Scheme_Let_Void *lv = (Scheme_Let_Void *)e;
if (SAME_TYPE(SCHEME_TYPE(lv->body), scheme_letrec_type)) {
Scheme_Letrec *lr = (Scheme_Letrec *)lv->body;
if (lv->count == lr->count) {
Scheme_Let_Header *lh;
Scheme_Compiled_Let_Value *clv, *prev = NULL;
Scheme_Object *rhs, *body;
int i, pos, *all_flags, *flags;
lh = MALLOC_ONE_TAGGED(Scheme_Let_Header);
lh->iso.so.type = scheme_compiled_let_void_type;
lh->count = lv->count;
lh->num_clauses = lv->count;
SCHEME_LET_FLAGS(lh) += SCHEME_LET_RECURSIVE;
pos = unresolve_stack_push(ui, lv->count, 0);
for (i = lv->count; i--; ) {
rhs = unresolve_expr(lr->procs[i], ui, 0);
if (!rhs) return_NULL;
clv = MALLOC_ONE_TAGGED(Scheme_Compiled_Let_Value);
clv->iso.so.type = scheme_compiled_let_value_type;
clv->count = 1;
clv->position = i;
clv->value = rhs;
if (prev)
prev->body = (Scheme_Object *)clv;
else
lh->body = (Scheme_Object *)clv;
prev = clv;
}
body = unresolve_expr(lr->body, ui, 0);
if (!body) return_NULL;
if (prev)
prev->body = body;
else
lh->body = body;
all_flags = unresolve_stack_pop(ui, pos, lv->count);
clv = (Scheme_Compiled_Let_Value *)lh->body;
for (i = lv->count; i--; ) {
flags = (int *)scheme_malloc_atomic(sizeof(int));
flags[0] = all_flags[i];
clv->flags = flags;
clv = (Scheme_Compiled_Let_Value *)clv->body;
}
return (Scheme_Object *)lh;
}
}
return_NULL;
}
case scheme_let_one_type: case scheme_let_one_type:
{ {
Scheme_Let_One *lo = (Scheme_Let_One *)e; Scheme_Let_One *lo = (Scheme_Let_One *)e;
Scheme_Object *rhs, *body; Scheme_Object *rhs, *body;
Scheme_Let_Header *lh; Scheme_Let_Header *lh;
Scheme_Compiled_Let_Value *lv; Scheme_Compiled_Let_Value *clv;
int *flags, pos; int *flags, pos;
ui->fail_after_all = 1; pos = unresolve_stack_push(ui, 1, 1 /* => post-bind RHS */);
rhs = unresolve_expr(lo->value, ui, 0);
pos = unresolve_stack_push(ui, 1, 1 /* => pre-bind RHS */); if (!rhs) return_NULL;
rhs = unresolve_expr(lo->value, ui);
if (!rhs) return NULL;
(void)unresolve_stack_pop(ui, pos, 0); (void)unresolve_stack_pop(ui, pos, 0);
pos = unresolve_stack_push(ui, 1, 0); pos = unresolve_stack_push(ui, 1, 0);
body = unresolve_expr(lo->body, ui); body = unresolve_expr(lo->body, ui, 0);
if (!body) return NULL; if (!body) return_NULL;
flags = unresolve_stack_pop(ui, pos, 1); flags = unresolve_stack_pop(ui, pos, 1);
lh = MALLOC_ONE_TAGGED(Scheme_Let_Header); lh = MALLOC_ONE_TAGGED(Scheme_Let_Header);
@ -3290,49 +3468,96 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui)
lh->count = 1; lh->count = 1;
lh->num_clauses = 1; lh->num_clauses = 1;
lv = MALLOC_ONE_TAGGED(Scheme_Compiled_Let_Value); clv = MALLOC_ONE_TAGGED(Scheme_Compiled_Let_Value);
lv->iso.so.type = scheme_compiled_let_value_type; clv->iso.so.type = scheme_compiled_let_value_type;
lv->count = 1; clv->count = 1;
lv->position = 0; clv->position = 0;
lv->value = rhs; clv->value = rhs;
lv->flags = flags; clv->flags = flags;
lv->body = body; clv->body = body;
lh->body = (Scheme_Object *)lv; lh->body = (Scheme_Object *)clv;
return (Scheme_Object *)lh; return (Scheme_Object *)lh;
} }
case scheme_closure_type:
{
Scheme_Object *r;
if (!ui->closures) {
Scheme_Hash_Table *ht;
ht = scheme_make_hash_table(SCHEME_hash_ptr);
ui->closures = ht;
}
if (scheme_hash_get(ui->closures, e))
return_NULL; /* can't handle cyclic closures */
scheme_hash_set(ui->closures, e, scheme_true);
r = unresolve_closure(SCHEME_COMPILED_CLOS_CODE(e), ui);
scheme_hash_set(ui->closures, e, NULL);
return r;
}
case scheme_unclosed_procedure_type:
{
return unresolve_closure((Scheme_Closure_Data *)e, ui);
}
default: default:
if (SCHEME_TYPE(e) > _scheme_values_types_) { if (SCHEME_TYPE(e) > _scheme_values_types_) {
if (scheme_compiled_duplicate_ok(e, 1)) if (scheme_compiled_duplicate_ok(e, 1))
return e; return e;
} }
// printf("no %d\n", SCHEME_TYPE(e)); return_NULL;
return NULL;
} }
} }
Scheme_Object *scheme_unresolve(Scheme_Object *iv) Scheme_Object *scheme_unresolve(Scheme_Object *iv, int argc)
{ {
Scheme_Object *o; Scheme_Object *o;
Scheme_Closure_Data *data = NULL;
o = SCHEME_VEC_ELS(iv)[1]; o = SCHEME_VEC_ELS(iv)[1];
if (SAME_TYPE(SCHEME_TYPE(o), scheme_closure_type)) { if (SAME_TYPE(SCHEME_TYPE(o), scheme_closure_type))
o = (Scheme_Object *)((Scheme_Closure *)o)->code; data = ((Scheme_Closure *)o)->code;
if (((Scheme_Closure_Data *)o)->closure_size) else if (SAME_TYPE(SCHEME_TYPE(o), scheme_unclosed_procedure_type))
return NULL; data = (Scheme_Closure_Data *)o;
else if (SAME_TYPE(SCHEME_TYPE(o), scheme_case_lambda_sequence_type)
|| SAME_TYPE(SCHEME_TYPE(o), scheme_case_closure_type)) {
Scheme_Case_Lambda *seqin = (Scheme_Case_Lambda *)o;
int i, cnt;
cnt = seqin->count;
for (i = 0; i < cnt; i++) {
if (SAME_TYPE(SCHEME_TYPE(seqin->array[i]), scheme_closure_type)) {
/* An empty closure, created at compile time */
data = ((Scheme_Closure *)seqin->array[i])->code;
} else {
data = (Scheme_Closure_Data *)seqin->array[i];
} }
if ((!(SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)
&& (data->num_params == argc))
|| ((SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)
&& (data->num_params - 1 <= argc)))
break;
else
data = NULL;
}
} else
data = NULL;
if (!data)
return_NULL;
if (data->closure_size)
return_NULL;
if (SAME_TYPE(SCHEME_TYPE(o), scheme_unclosed_procedure_type)) {
/* convert an optimized & resolved closure back to compiled form: */ /* convert an optimized & resolved closure back to compiled form: */
return unresolve_closure((Scheme_Closure_Data *)o, return unresolve_closure(data,
new_unresolve_info((Scheme_Prefix *)SCHEME_VEC_ELS(iv)[2])); new_unresolve_info((Scheme_Prefix *)SCHEME_VEC_ELS(iv)[2]));
} }
return NULL;
}
/*========================================================================*/ /*========================================================================*/
/* precise GC traversers */ /* precise GC traversers */
/*========================================================================*/ /*========================================================================*/

4
src/racket/src/schpriv.h
View File

@ -2606,7 +2606,9 @@ Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e);
Scheme_Object *scheme_resolve_expr(Scheme_Object *, Resolve_Info *); Scheme_Object *scheme_resolve_expr(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_resolve_list(Scheme_Object *, Resolve_Info *); Scheme_Object *scheme_resolve_list(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_unresolve(Scheme_Object *); Scheme_Object *scheme_unresolve(Scheme_Object *, int argv);
int scheme_check_leaf_rator(Scheme_Object *le, int *_flags);
int scheme_is_compiled_procedure(Scheme_Object *o, int can_be_closed, int can_be_liftable); int scheme_is_compiled_procedure(Scheme_Object *o, int can_be_closed, int can_be_liftable);