diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | eval.c | 31 | ||||
| -rw-r--r-- | match.h | 2 | ||||
| -rw-r--r-- | txr.1 | 36 |
4 files changed, 78 insertions, 2 deletions
@@ -1,3 +1,14 @@ +2015-02-10 Kaz Kylheku <kaz@kylheku.com> + + * eval.c (symacro_k, fun_k): New keyword variables. + (lexical_lisp1_binding): New static function. + (eval_init): Initialize symacro_k and fun_k; register + new intrinsic function lexical-lisp1-binding. + + * match.h (var_k): Existing external name declared. + + * txr.1: Documented lexical-lisp1-binding. + 2015-02-09 Kaz Kylheku <kaz@kylheku.com> * Makefile: Add dependency froml $(EXTRA_OBJS-y) to header @@ -85,7 +85,7 @@ val defsymacro_s, symacrolet_s, prof_s; val fbind_s, lbind_s, flet_s, labels_s; val opip_s, oand_s, chain_s, chand_s; -val special_s, whole_k; +val special_s, whole_k, symacro_k, fun_k; val last_form_evaled; @@ -335,6 +335,31 @@ static val lexical_fun_p(val menv, val sym) } } +static val lexical_lisp1_binding(val menv, val sym) +{ + if (nilp(menv)) { + return nil; + } else { + type_check(menv, ENV); + + { + val binding = assoc(sym, menv->e.vbindings); + + if (binding) /* special_s: see make_var_shadowing_env */ + return if3(cdr(binding) == special_s, + var_k, symacro_k); + } + + { + val binding = assoc(sym, menv->e.fbindings); + + if (binding && cdr(binding) == special_s) + return fun_k; + return lexical_lisp1_binding(menv->e.up_env, sym); + } + } +} + static void mark_special(val sym) { sethash(special, sym, t); @@ -3659,6 +3684,8 @@ void eval_init(void) with_saved_vars_s = intern(lit("with-saved-vars"), system_package); whole_k = intern(lit("whole"), keyword_package); special_s = intern(lit("special"), system_package); + symacro_k = intern(lit("symacro"), keyword_package); + fun_k = intern(lit("fun"), keyword_package); prof_s = intern(lit("prof"), user_package); opip_s = intern(lit("opip"), user_package); oand_s = intern(lit("oand"), user_package); @@ -3971,6 +3998,8 @@ void eval_init(void) reg_fun(intern(lit("env-vbind"), user_package), func_n3(env_vbind)); reg_fun(intern(lit("lexical-var-p"), user_package), func_n2(lexical_var_p)); reg_fun(intern(lit("lexical-fun-p"), user_package), func_n2(lexical_fun_p)); + reg_fun(intern(lit("lexical-lisp1-binding"), user_package), + func_n2(lexical_lisp1_binding)); reg_fun(chain_s, func_n0v(chainv)); reg_fun(chand_s, func_n0v(chandv)); reg_fun(intern(lit("juxt"), user_package), func_n0v(juxtv)); @@ -26,7 +26,7 @@ extern val text_s, choose_s, gather_s, do_s, require_s; extern val close_s, load_s, include_s, mod_s, modlast_s, line_s; -extern val counter_k, env_k; +extern val counter_k, env_k, var_k; val format_field(val string_or_list, val modifier, val filter, val eval_fun); val match_filter(val name, val arg, val other_args); val match_fun(val name, val args, val input, val files); @@ -26151,6 +26151,42 @@ However, it can be macro-expanded to .code x which is a lexical variable. +.coNP Function @ lexical-lisp1-binding +.synb +.mets (lexical-lisp1-binding < env << symbol) +.syne +.desc +The +.code lexical-lisp1-binding +function inspects the macro-time environment +.meta env +to determine what kind of binding, if any, does +.meta symbol +have in that environment, from a Lisp-1 perspective. + +That is to say, it considers function bindings, variable bindings +and symbol macro bindings to be in a single name space and finds +the innermost binding of one of these types for +.metn symbol . + +If such a binding is found, then the function returns one of +the three keyword symbols +.codn :var , +.codn :fun , +or +.codn :symacro . + +If no such lexical binding is found, then the function +returns +.codn nil . + +Note that a +.code nil +return doesn't mean that the symbol doesn't have a lexical binding. It could +have an operator macro lexical binding (a macro binding in the function +namespace established by +.codn macrolet ). + .coNP Operator @ defsymacro .synb .mets (defsymacro < sym << form ) |