diff options
| -rw-r--r-- | eval.c | 21 | ||||
| -rw-r--r-- | tests/012/struct.tl | 8 | ||||
| -rw-r--r-- | txr.1 | 15 |
3 files changed, 38 insertions, 6 deletions
@@ -5088,12 +5088,31 @@ val expand(val form, val menv) return ret; } +static val muffle_unbound_warning(val exc, struct args *args) +{ + (void) exc; + + args_normalize_least(args, 2); + + if (args->fill >= 2) { + val tag = args->arg[1]; + + if (consp(tag)) { + val type = car(tag); + if (type == var_s || type == fun_s || type == sym_s) + uw_rthrow(continue_s, nil); + } + } + + return nil; +} + static val no_warn_expand(val form, val menv) { val ret; uw_frame_t uw_handler; uw_push_handler(&uw_handler, cons(defr_warning_s, nil), - func_n1v(uw_muffle_warning)); + func_n1v(muffle_unbound_warning)); ret = expand(form, menv); uw_pop_frame(&uw_handler); return ret; diff --git a/tests/012/struct.tl b/tests/012/struct.tl index 57234913..3f03552d 100644 --- a/tests/012/struct.tl +++ b/tests/012/struct.tl @@ -43,10 +43,10 @@ (stest (ignwarn (expand 's.(a b c))) "(call (slot s 'a)\n \ \ s b c)") -(test (expand 's.[a].d) - (slot [(slot s 'a) s] 'd)) -(test (expand 's.[a b c].d) - (slot [(slot s 'a) s b c] 'd)) +(test (expand 's.[a].b) + (slot [(slot s 'a) s] 'b)) +(test (expand 's.[a b c].b) + (slot [(slot s 'a) s b c] 'b)) (set *gensym-counter* 0) (stest (ignwarn (expand 's.(a).d)) "(slot (call (slot s 'a)\n \ @@ -36903,7 +36903,20 @@ and .code expand* is that .code expand -suppresses any warning exceptions that are issued during expansion. +suppresses expansion-time deferred warnings (exceptions of type +.codn defr-warning ), +issued for unbound variables or functions. +To suppress a warning means to intercept the warning exception with a handler +which throws a +.code continue +exception to resume processing. +What this requirement means is that if unbound functions or variables +occur in the +.meta form +being expanded by expand, the warning is effectively squelched. Rationale: +.code expand +is may be used by macros for expanding fragments which contain references to +variables or functions which are not defined in those fragments. .coNP Function @ expand-with-free-refs .synb |