From 34cd1e2a2b097d3175eb20bfd7210756d9909a50 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 8 Jun 2019 11:33:21 -0600 Subject: [PATCH] optimizer: don't discard potential `hash` errors If `hasheq` is given an odd number of arguments or if `make-hasheq` is given a bad argument, then the error should be preserved. Related to #2685 --- .../tests/racket/optimize.rktl | 39 ++++++++++++ racket/src/racket/src/letrec_check.c | 11 ++-- racket/src/racket/src/linklet.c | 7 ++- racket/src/racket/src/list.c | 25 ++++---- racket/src/racket/src/optimize.c | 60 +++++++++++++------ racket/src/racket/src/schpriv.h | 45 +++++++------- 6 files changed, 125 insertions(+), 62 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index 7fabaa0b49..487a7f7171 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -3291,6 +3291,45 @@ 'UNEXPECTED!)) #f) +(let () + (define (check-empty-allocation hash-sym) + (test-comp `(lambda () (,hash-sym) 5) + '(lambda () 5)) + (test-comp `(lambda (x) (,hash-sym x) 5) ; x may not have the right shape + '(lambda (x) 5) + #f)) + (check-empty-allocation 'hash) + (check-empty-allocation 'hasheqv) + (check-empty-allocation 'hasheq) + (check-empty-allocation 'make-hash) + (check-empty-allocation 'make-hasheqv) + (check-empty-allocation 'make-hasheq) + (check-empty-allocation 'make-weak-hash) + (check-empty-allocation 'make-weak-hasheqv) + (check-empty-allocation 'make-weak-hasheq) + (check-empty-allocation 'make-immutable-hash) + (check-empty-allocation 'make-immutable-hasheqv) + (check-empty-allocation 'make-immutable-hasheq) + + (test-comp `(lambda (x y) (hash x y) 5) ; can trigger equal callbacks + '(lambda () 5) + #f) + (test-comp `(lambda (x y) (hasheqv x y) 5) + '(lambda (x y) 5)) + (test-comp `(lambda (x y) (hasheq x y) 5) + '(lambda (x y) 5)) + + ;; Wrong arity + (test-comp `(lambda (x y) (hash x) 5) + '(lambda (x) 5) + #f) + (test-comp `(lambda (x) (hasheqv x) 5) + '(lambda (x) 5) + #f) + (test-comp `(lambda (x) (hasheq x) 5) + '(lambda (x) 5) + #f)) + ;; Check elimination of ignored structure predicate ;; and constructor applications: diff --git a/racket/src/racket/src/letrec_check.c b/racket/src/racket/src/letrec_check.c index ff667c345d..3040bfed24 100644 --- a/racket/src/racket/src/letrec_check.c +++ b/racket/src/racket/src/letrec_check.c @@ -411,10 +411,9 @@ static Scheme_Object *letrec_check_local(Scheme_Object *o, Letrec_Check_Frame *f return o; } -static int is_effect_free_prim(Scheme_Object *rator) +static int is_effect_free_prim(Scheme_Object *rator, int argc) { - if (SCHEME_PRIMP(rator) - && (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_OMITABLE_ANY)) + if (SCHEME_PRIMP(rator) && scheme_is_omitable_primitive(rator, argc)) return 1; return 0; @@ -431,7 +430,7 @@ static Scheme_Object *letrec_check_application(Scheme_Object *o, Letrec_Check_Fr /* we'll have to check the rator and all the arguments */ n = 1 + app->num_args; - if (is_effect_free_prim(app->args[0])) { + if (is_effect_free_prim(app->args[0], app->num_args)) { /* an immediate prim cannot call anything among its arguments */ } else { /* argument might get applied */ @@ -453,7 +452,7 @@ static Scheme_Object *letrec_check_application2(Scheme_Object *o, Letrec_Check_F app = (Scheme_App2_Rec *)o; - if (is_effect_free_prim(app->rator)) { + if (is_effect_free_prim(app->rator, 1)) { /* an immediate prim cannot call anything among its arguments */ } else { /* argument might get applied */ @@ -475,7 +474,7 @@ static Scheme_Object *letrec_check_application3(Scheme_Object *o, Letrec_Check_F app = (Scheme_App3_Rec *)o; - if (is_effect_free_prim(app->rator)) { + if (is_effect_free_prim(app->rator, 2)) { /* an immediate prim cannot call anything among its arguments */ } else { /* argument might get applied */ diff --git a/racket/src/racket/src/linklet.c b/racket/src/racket/src/linklet.c index 03e55ad46d..5147fc971c 100644 --- a/racket/src/racket/src/linklet.c +++ b/racket/src/racket/src/linklet.c @@ -295,9 +295,10 @@ static Scheme_Object *primitive_in_category_p(int argc, Scheme_Object **argv) else if (SAME_OBJ(cat, folding_symbol)) r = (opt >= SCHEME_PRIM_OPT_FOLDING); else if (SAME_OBJ(cat, omitable_symbol)) - r = (SCHEME_PRIM_PROC_OPT_FLAGS(v) & (SCHEME_PRIM_IS_OMITABLE_ANY - | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL - | SCHEME_PRIM_IS_UNSAFE_OMITABLE)); + r = (SCHEME_PRIM_PROC_OPT_FLAGS(v) & (SCHEME_PRIM_IS_OMITABLE + | SCHEME_PRIM_IS_OMITABLE_ALLOCATION + | SCHEME_PRIM_IS_UNSAFE_OMITABLE + | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL)); else r = 0; } else diff --git a/racket/src/racket/src/list.c b/racket/src/racket/src/list.c index 49dfb77e9f..1d037eb7f8 100644 --- a/racket/src/racket/src/list.c +++ b/racket/src/racket/src/list.c @@ -536,57 +536,58 @@ scheme_init_list (Scheme_Startup_Env *env) p = scheme_make_immed_prim(make_hash, "make-hash", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-hash", p, env); p = scheme_make_immed_prim(make_hasheq, "make-hasheq", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-hasheq", p, env); p = scheme_make_immed_prim(make_hasheqv, "make-hasheqv", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-hasheqv", p, env); p = scheme_make_immed_prim(make_weak_hash, "make-weak-hash", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-weak-hash", p, env); p = scheme_make_immed_prim(make_weak_hasheq, "make-weak-hasheq", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-weak-hasheq", p, env); p = scheme_make_immed_prim(make_weak_hasheqv, "make-weak-hasheqv", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-weak-hasheqv", p, env); p = scheme_make_immed_prim(scheme_make_immutable_hash, "make-immutable-hash", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-immutable-hash", p, env); p = scheme_make_immed_prim(scheme_make_immutable_hasheq, "make-immutable-hasheq", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-immutable-hasheq", p, env); p = scheme_make_immed_prim(scheme_make_immutable_hasheqv, "make-immutable-hasheqv", 0, 1); - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("make-immutable-hasheqv", p, env); REGISTER_SO(scheme_hash_proc); p = scheme_make_immed_prim(direct_hash, "hash", 0, -1); scheme_hash_proc = p; - /* not SCHEME_PRIM_IS_OMITABLE_ALLOCATION, because `equal?`-hashing functions are called */ + /* not SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION, because `equal?`-hashing functions are called */ + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION); scheme_addto_prim_instance("hash", p, env); REGISTER_SO(scheme_hasheq_proc); p = scheme_make_immed_prim(direct_hasheq, "hasheq", 0, -1); scheme_hasheq_proc = p; - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION); scheme_addto_prim_instance("hasheq", p, env); REGISTER_SO(scheme_hasheqv_proc); p = scheme_make_immed_prim(direct_hasheqv, "hasheqv", 0, -1); scheme_hasheqv_proc = p; - SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION); scheme_addto_prim_instance("hasheqv", p, env); p = scheme_make_folding_prim(hash_p, "hash?", 1, 1, 1); diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c index bb7cc87b1e..795a4aea7d 100644 --- a/racket/src/racket/src/optimize.c +++ b/racket/src/racket/src/optimize.c @@ -120,7 +120,7 @@ static int lambda_has_top_level(Scheme_Lambda *lam); static Scheme_Object *make_sequence_2(Scheme_Object *a, Scheme_Object *b); -static int wants_local_type_arguments(Scheme_Object *rator, int argpos); +XFORM_NONGCING static int wants_local_type_arguments(Scheme_Object *rator, int argpos); static void add_types_for_f_branch(Scheme_Object *t, Optimize_Info *info, int fuel); @@ -357,7 +357,8 @@ int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args Return 2 => true, and results are a constant when arguments are constants. */ { if (SCHEME_PRIMP(rator) - && (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE_ANY | SCHEME_PRIM_IS_UNSAFE_NONMUTATING)) + && ((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_UNSAFE_NONMUTATING) + || scheme_is_omitable_primitive(rator, num_args)) && (num_args >= ((Scheme_Primitive_Proc *)rator)->mina) && (num_args <= ((Scheme_Primitive_Proc *)rator)->mu.maxa) && ((expected_vals < 0) @@ -371,6 +372,24 @@ int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args return 0; } +int scheme_is_omitable_primitive(Scheme_Object *rator, int num_args) +{ + if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE + | SCHEME_PRIM_IS_OMITABLE_ALLOCATION + | SCHEME_PRIM_IS_UNSAFE_OMITABLE)) + return 1; + + if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION) + return (num_args == 0); + + if ((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION)) + return !(num_args & 0x1); + + return 0; +} + +int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals); + static Scheme_Object *get_defn_shape(Optimize_Info *info, Scheme_IR_Toplevel *var) { Scheme_Object *v; @@ -3127,31 +3146,34 @@ static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rat return optimize_expr(orig_rator, info, context); } -static int is_nonmutating_nondependant_primitive(Scheme_Object *rator, int n) +XFORM_NONGCING static int is_primitive_allocating(Scheme_Object *rator, int argc) +{ + if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE_ALLOCATION + | SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION + | SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION)) + return scheme_is_omitable_primitive(rator, argc); + + return 0; +} + +XFORM_NONGCING static int is_nonmutating_nondependant_primitive(Scheme_Object *rator, int argc) /* Does not include SCHEME_PRIM_IS_UNSAFE_OMITABLE, because those can depend on earlier tests (explicit or implicit) for whether the unsafe operation is defined */ { if (SCHEME_PRIMP(rator) - && ((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE | SCHEME_PRIM_IS_OMITABLE_ALLOCATION)) + && (((SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_IS_OMITABLE) + || is_primitive_allocating(rator, argc)) && !(SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_UNSAFE_OMITABLE)) - && !((SAME_OBJ(scheme_values_proc, rator) && (n != 1)))) - && (n >= ((Scheme_Primitive_Proc *)rator)->mina) - && (n <= ((Scheme_Primitive_Proc *)rator)->mu.maxa)) + && !((SAME_OBJ(scheme_values_proc, rator) && (argc != 1)))) + && (argc >= ((Scheme_Primitive_Proc *)rator)->mina) + && (argc <= ((Scheme_Primitive_Proc *)rator)->mu.maxa)) return 1; return 0; } -static int is_primitive_allocating(Scheme_Object *rator, int n) -{ - if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE_ALLOCATION)) - return 1; - - return 0; -} - -static int is_noncapturing_primitive(Scheme_Object *rator, int n) +XFORM_NONGCING static int is_noncapturing_primitive(Scheme_Object *rator, int n) { if (SCHEME_PRIMP(rator)) { int opt, t; @@ -3174,7 +3196,7 @@ static int is_noncapturing_primitive(Scheme_Object *rator, int n) return 0; } -static int is_nonsaving_primitive(Scheme_Object *rator, int n) +XFORM_NONGCING static int is_nonsaving_primitive(Scheme_Object *rator, int n) { if (SCHEME_PRIMP(rator)) { int opt; @@ -3188,7 +3210,7 @@ static int is_nonsaving_primitive(Scheme_Object *rator, int n) return 0; } -static int is_always_escaping_primitive(Scheme_Object *rator) +XFORM_NONGCING static int is_always_escaping_primitive(Scheme_Object *rator) { if (SCHEME_PRIMP(rator) && (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_ALWAYS_ESCAPES)) { @@ -3199,7 +3221,7 @@ static int is_always_escaping_primitive(Scheme_Object *rator) #define IS_NAMED_PRIM(p, nm) (!strcmp(((Scheme_Primitive_Proc *)p)->name, nm)) -static int wants_local_type_arguments(Scheme_Object *rator, int argpos) +XFORM_NONGCING static int wants_local_type_arguments(Scheme_Object *rator, int argpos) { if (SCHEME_PRIMP(rator)) { int flags; diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index ede70cd2f2..f89e01cfe5 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -77,51 +77,51 @@ /* indicates that a primitive call can be dropped, but it allocates, so it's not as reorderable as it might be otherwise: */ #define SCHEME_PRIM_IS_OMITABLE_ALLOCATION (1 << 5) +#define SCHEME_PRIM_IS_ARITY_0_OMITABLE_ALLOCATION (1 << 6) +#define SCHEME_PRIM_IS_EVEN_ARITY_OMITABLE_ALLOCATION (1 << 7) /* indicates that a primitive call will produce the same results for the same inputs; note that UNSAFE_FUNCTIONAL is stronger than UNSAFE_OMITABLE: */ -#define SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL (1 << 6) +#define SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL (1 << 8) /* the SCHEME_PRIMT_WANTS_... flags indicate a primitive that expects certain kinds of arguments and can encourage unboxing: */ -#define SCHEME_PRIM_WANTS_FLONUM_FIRST (1 << 7) -#define SCHEME_PRIM_WANTS_FLONUM_SECOND (1 << 8) -#define SCHEME_PRIM_WANTS_FLONUM_THIRD (1 << 9) -#define SCHEME_PRIM_WANTS_EXTFLONUM_FIRST (1 << 10) -#define SCHEME_PRIM_WANTS_EXTFLONUM_SECOND (1 << 11) -#define SCHEME_PRIM_WANTS_EXTFLONUM_THIRD (1 << 12) +#define SCHEME_PRIM_WANTS_FLONUM_FIRST (1 << 9) +#define SCHEME_PRIM_WANTS_FLONUM_SECOND (1 << 10) +#define SCHEME_PRIM_WANTS_FLONUM_THIRD (1 << 11) +#define SCHEME_PRIM_WANTS_EXTFLONUM_FIRST (1 << 12) +#define SCHEME_PRIM_WANTS_EXTFLONUM_SECOND (1 << 13) +#define SCHEME_PRIM_WANTS_EXTFLONUM_THIRD (1 << 14) /* indicates an unsafe operation that does not allocate: */ -#define SCHEME_PRIM_IS_UNSAFE_NONALLOCATE (1 << 13) +#define SCHEME_PRIM_IS_UNSAFE_NONALLOCATE (1 << 15) /* indicates a primitive that always raises an exception or otherwise escapes from the current continuation: */ -#define SCHEME_PRIM_ALWAYS_ESCAPES (1 << 14) +#define SCHEME_PRIM_ALWAYS_ESCAPES (1 << 16) /* indicates a primitive that is JIT-inlined on some platforms, but not the current one: */ -#define SCHEME_PRIM_SOMETIMES_INLINED (1 << 15) +#define SCHEME_PRIM_SOMETIMES_INLINED (1 << 17) /* indicates a primitive that produces a real or number (or errors): */ -#define SCHEME_PRIM_PRODUCES_REAL (1 << 16) -#define SCHEME_PRIM_PRODUCES_NUMBER (1 << 17) +#define SCHEME_PRIM_PRODUCES_REAL (1 << 18) +#define SCHEME_PRIM_PRODUCES_NUMBER (1 << 19) /* indicates a primitive that requires certain argument types (all the same type): */ -#define SCHEME_PRIM_WANTS_REAL (1 << 18) -#define SCHEME_PRIM_WANTS_NUMBER (1 << 19) +#define SCHEME_PRIM_WANTS_REAL (1 << 20) +#define SCHEME_PRIM_WANTS_NUMBER (1 << 21) /* indicates a primitive that always succeed when given arguments of the expected type: */ -#define SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS (1 << 20) +#define SCHEME_PRIM_OMITTABLE_ON_GOOD_ARGS (1 << 22) /* indicates a primitive that produces a real number when given real-number arguments: */ -#define SCHEME_PRIM_CLOSED_ON_REALS (1 << 21) +#define SCHEME_PRIM_CLOSED_ON_REALS (1 << 23) /* indicates the presence of an ad-hoc optimization in one of the application optimization passes */ -#define SCHEME_PRIM_AD_HOC_OPT (1 << 22) +#define SCHEME_PRIM_AD_HOC_OPT (1 << 24) /* a primitive that produces a booeal or errors: */ -#define SCHEME_PRIM_PRODUCES_BOOL (1 << 23) +#define SCHEME_PRIM_PRODUCES_BOOL (1 << 25) -#define SCHEME_PRIM_OPT_TYPE_SHIFT 24 +#define SCHEME_PRIM_OPT_TYPE_SHIFT 26 #define SCHEME_PRIM_OPT_TYPE_MASK (SCHEME_MAX_LOCAL_TYPE_MASK << SCHEME_PRIM_OPT_TYPE_SHIFT) #define SCHEME_PRIM_OPT_TYPE(x) ((x & SCHEME_PRIM_OPT_TYPE_MASK) >> SCHEME_PRIM_OPT_TYPE_SHIFT) -#define SCHEME_PRIM_IS_OMITABLE_ANY (SCHEME_PRIM_IS_OMITABLE | SCHEME_PRIM_IS_OMITABLE_ALLOCATION | SCHEME_PRIM_IS_UNSAFE_OMITABLE) - #define SCHEME_PRIM_PRODUCES_FLONUM (SCHEME_LOCAL_TYPE_FLONUM << SCHEME_PRIM_OPT_TYPE_SHIFT) #define SCHEME_PRIM_PRODUCES_FIXNUM (SCHEME_LOCAL_TYPE_FIXNUM << SCHEME_PRIM_OPT_TYPE_SHIFT) @@ -3061,7 +3061,8 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags, int scheme_might_invoke_call_cc(Scheme_Object *value); int scheme_is_liftable(Scheme_Object *o, Scheme_Hash_Tree *exclude_vars, int fuel, int as_rator, int or_escape); -int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals); +XFORM_NONGCING int scheme_is_functional_nonfailing_primitive(Scheme_Object *rator, int num_args, int expected_vals); +XFORM_NONGCING int scheme_is_omitable_primitive(Scheme_Object *rator, int num_args); typedef struct { int uses_super;