diff options
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 20 | ||||
| -rw-r--r-- | lib.h | 2 | ||||
| -rw-r--r-- | struct.c | 2 | ||||
| -rw-r--r-- | struct.h | 2 | ||||
| -rw-r--r-- | tests/012/oop-seq.tl | 17 | ||||
| -rw-r--r-- | txr.1 | 27 |
7 files changed, 67 insertions, 5 deletions
@@ -7741,7 +7741,7 @@ void eval_init(void) reg_fun(intern(lit("str-seq"), user_package), func_n1(str_seq)); reg_fun(intern(lit("length"), user_package), length_f); reg_fun(intern(lit("len"), user_package), length_f); - reg_fun(intern(lit("length-<"), user_package), func_n2(length_lt)); + reg_fun(length_lt_s, func_n2(length_lt)); reg_fun(intern(lit("empty"), user_package), func_n1(empty)); reg_fun(intern(lit("copy"), user_package), func_n1(copy)); reg_fun(intern(lit("sub"), user_package), func_n3o(sub, 1)); @@ -121,7 +121,7 @@ val query_error_s, file_error_s, process_error_s, syntax_error_s; val timeout_error_s, system_error_s, alloc_error_s, stack_overflow_s; val path_not_found_s, path_exists_s, path_permission_s; val warning_s, defr_warning_s, restart_s, continue_s; -val gensym_counter_s, length_s; +val gensym_counter_s, length_s, length_lt_s; val rplaca_s, rplacd_s, seq_iter_s; val lazy_streams_s; @@ -13183,6 +13183,23 @@ val length_lt(val seq, val len) return length_list_lt(seq, len); case LSTR: return length_str_lt(seq, len); + case COBJ: + if (obj_struct_p(seq)) { + val length_lt_meth = get_special_slot(seq, length_lt_m); + + if (length_lt_meth) { + return funcall2(length_lt_meth, seq, len); + } else { + val length_meth = get_special_slot(seq, length_m); + + if (length_meth) + return lt(funcall1(length_meth, seq), len); + } + + type_mismatch(lit("~a: ~s has no ~a or ~a method"), length_lt_s, + seq, length_lt_s, length_s, nao); + } + /* fallthrough */ default: return lt(length(seq), len); } @@ -14167,6 +14184,7 @@ static void obj_init(void) continue_s = intern(lit("continue"), user_package); name_s = intern(lit("name"), user_package); length_s = intern(lit("length"), user_package); + length_lt_s = intern(lit("length-<"), user_package); rplaca_s = intern(lit("rplaca"), user_package); rplacd_s = intern(lit("rplacd"), user_package); seq_iter_s = intern(lit("seq-iter"), user_package); @@ -692,7 +692,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, stack_overflow_s; extern val path_not_found_s, path_exists_s, path_permission_s; extern val warning_s, defr_warning_s, restart_s, continue_s; -extern val gensym_counter_s, length_s; +extern val gensym_counter_s, length_s, length_lt_s; extern val rplaca_s, rplacd_s, seq_iter_s; extern val lazy_streams_s; extern val plus_s; @@ -113,7 +113,7 @@ val iter_begin_s, iter_more_s, iter_item_s, iter_step_s, iter_reset_s; static val *special_sym[num_special_slots] = { &equal_s, &nullify_s, &from_list_s, &lambda_s, &lambda_set_s, - &length_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s, + &length_s, &length_lt_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s, &iter_begin_s, &iter_more_s, &iter_item_s, &iter_step_s, &iter_reset_s, &plus_s }; @@ -37,7 +37,7 @@ extern struct cobj_class *struct_cls; enum special_slot { equal_m, nullify_m, from_list_m, lambda_m, lambda_set_m, - length_m, car_m, cdr_m, rplaca_m, rplacd_m, + length_m, length_lt_m, car_m, cdr_m, rplaca_m, rplacd_m, iter_begin_m, iter_more_m, iter_item_m, iter_step_m, iter_reset_m, plus_m, num_special_slots diff --git a/tests/012/oop-seq.tl b/tests/012/oop-seq.tl index e91564fc..17463e96 100644 --- a/tests/012/oop-seq.tl +++ b/tests/012/oop-seq.tl @@ -55,6 +55,23 @@ (test (list-seq (new counter-fast init 0 step 1 limit 0)) nil) +(defstruct integers () + item to next + (:method length-< (me len) + (cond + ((<= len 1) nil) + (me.next me.next.(length-< (pred len))) + (t))) + (:postinit (me) + (if (< me.item me.to) + (set me.next (lnew integers to me.to item (succ me.item)))))) + +(let ((ints (new integers item 1 to 10))) + (mtest + (length-< ints 11) t) + (length-< ints 10) nil + (length-< ints 9) nil) + ;; The following reproduced a segfault when the change was made to allow del to ;; work with structs that have lambda and lambda-set. @@ -33549,6 +33549,33 @@ preference is given to .codn length , which is likely to be much more efficient. +.coNP Method @ length-< +.synb +.mets << object .(length-< << len ) +.syne +.desc +If a structure has +.code length-< +method, then it can be used as the left argument to the +.code length-< +function. The +.meta len +argument receives the right argument. + +If an object doesn't implement the +.code length-< +method, but does implement the +.code length +it can also be used as an argument to the +.code length-< +function. In that situation, the +.code length-< +function will call the +.code length +method instead, and then compare the returned value against the +.meta len +parameter. + .coNP Methods @, car @ cdr and @ nullify .synb .mets << object .(car) |