diff options
| -rw-r--r-- | eval.c | 4 | ||||
| -rw-r--r-- | lib.c | 32 | ||||
| -rw-r--r-- | lib.h | 1 | ||||
| -rw-r--r-- | txr.1 | 66 |
4 files changed, 101 insertions, 2 deletions
@@ -5847,8 +5847,8 @@ void eval_init(void) reg_fun(intern(lit("lcons-fun"), user_package), func_n1(lcons_fun)); reg_fun(car_s, car_f); reg_fun(cdr_s, cdr_f); - reg_fun(intern(lit("rplaca"), user_package), func_n2(rplaca)); - reg_fun(intern(lit("rplacd"), user_package), func_n2(rplacd)); + reg_fun(rplaca_s, func_n2(rplaca)); + reg_fun(rplacd_s, func_n2(rplacd)); reg_fun(intern(lit("rplaca"), system_package), func_n2(sys_rplaca)); reg_fun(intern(lit("rplacd"), system_package), func_n2(sys_rplacd)); reg_fun(intern(lit("first"), user_package), func_n1(car)); @@ -109,6 +109,7 @@ val query_error_s, file_error_s, process_error_s, syntax_error_s; val timeout_error_s, system_error_s, alloc_error_s; val warning_s, defr_warning_s, restart_s, continue_s; val gensym_counter_s, nullify_s, from_list_s, lambda_set_s, length_s; +val rplaca_s, rplacd_s; val nothrow_k, args_k, colon_k, auto_k, fun_k; val wrap_k, reflect_k; @@ -432,6 +433,24 @@ val rplaca(val cons, val new_car) refset(cons, zero, new_car); return cons; default: + if (structp(cons)) { + { + val rplaca_meth = maybe_slot(cons, rplaca_s); + if (rplaca_meth) { + (void) funcall2(rplaca_meth, cons, new_car); + return cons; + } + } + { + val lambda_set_meth = maybe_slot(cons, lambda_set_s); + if (lambda_set_meth) { + (void) funcall3(lambda_set_meth, cons, zero, new_car); + return cons; + } + } + type_mismatch(lit("rplaca: ~s lacks ~s or ~s method"), + cons, rplaca_s, lambda_set_s, nao); + } type_mismatch(lit("rplaca: cannot modify ~s"), cons, nao); } } @@ -451,6 +470,17 @@ val rplacd(val cons, val new_cdr) replace(cons, new_cdr, one, t); return cons; default: + if (structp(cons)) { + { + val rplacd_meth = maybe_slot(cons, rplacd_s); + if (rplacd_meth) { + (void) funcall2(rplacd_meth, cons, new_cdr); + return cons; + } + } + replace(cons, new_cdr, one, t); + return cons; + } type_mismatch(lit("rplacd: cannot modify ~s"), cons, nao); } } @@ -10521,6 +10551,8 @@ static void obj_init(void) from_list_s = intern(lit("from-list"), user_package); lambda_set_s = intern(lit("lambda-set"), user_package); length_s = intern(lit("length"), user_package); + rplaca_s = intern(lit("rplaca"), user_package); + rplacd_s = intern(lit("rplacd"), user_package); args_k = intern(lit("args"), keyword_package); nothrow_k = intern(lit("nothrow"), keyword_package); @@ -470,6 +470,7 @@ extern val query_error_s, file_error_s, process_error_s, syntax_error_s; extern val timeout_error_s, system_error_s, alloc_error_s; extern val warning_s, defr_warning_s, restart_s, continue_s; extern val gensym_counter_s; +extern val rplaca_s, rplacd_s; #define gensym_counter (deref(lookup_var_l(nil, gensym_counter_s))) @@ -25477,6 +25477,14 @@ The return value of .code lambda-set is ignored. +Note: the +.code lambda-set +method is also used by the +.code rplaca +function, if no +.code rplaca +method exists. + .TP* Example The following defines a structure with a single instance @@ -25604,6 +25612,64 @@ if the object is considered to denote an empty sequence. Otherwise it should either return that object itself, or else return the sequence which that object represents. +.coNP Methods @ rplaca and @ rplacd +.synb +.mets << object .(rplaca << new-car-value ) +.mets << object .(rplacd << new-cdr-value ) +.syne +.desc +If a structure type defines the methods +.code rplaca +and +.code rplacd +then, respectively, the +.code rplaca +and +.code rplacd +functions will use these methods if they are applied to instances of that type. + +That is to say, when the function call +.cblk +.meti (rplaca < o << v ) +.cble +is evaluated, and +.meta o +is a structure type, the function inquires whether +.meta o +supports a +.code rplaca +method. If so, then, effectively, +.cblk +.meti << o . (rplaca << v) +.cble +is invoked. The return value of this method call is ignored; +.code rplaca +returns +.metn o . +The analogous requirements apply to +.code rplacd +in relation to the +.code rplacd +method. + +Note: if the +.code rplaca +method doesn't exist, the +.code rplaca +function falls back on trying to store +.meta new-car-value +by means of the structure type's +.code lambda-set +method, using an index of zero. That is to say, if the type has no +.code rplaca +method, but does have a +.code lambda-set +method, then +.cblk +.meti << o . (lambda-set 0 << v) +.cble +is invoked. + .coNP Function @ from-list .synb .mets << object .[from-list << list ] |