We need a length-< special method.

Structure objects can be used to implement lazy structures
such as sequences. It is undesirable to take the length of
a lazy sequence because it forces all of its elements to
exist. Moreover, if the sequence is infinite, it is
impossible. There are situations in which it is only necessary
to know whether the length is less than a certain bound,
and for that we have the length-< function. That works on
infinite sequence such as lazy lists, requiring them to be
forced only so far as to determine the truth value of the
test. We need objects that implement lazy sequences to work
with this function.

* struct.h (enum special_slot): New member length_lt_m.

* lib.h (length_lt_s): Symbol variable declared.

* struct.c (special_sym): New entry in this table, associating
the length_lt_m enum with the length_lt_s symbol variable.

* lib.c (length_lt_s): Symbol variable defined.
(length_lt): Handle COBJ objects that are structures.
we test whether they have a length-< method, or else length
method. If they don't have either, we throw. We don't
fall back on the default case for objects that don't have
a length-< method, because the diagnostic won't be good
if they don't have a length method either; the programmer
will be informed that the length function couldn't find
a length method, without mentioning that it was actually
length-< that is being used.

* eval.c (eval_init): Register length-< using the length_lt_s
symbol variable rather than using intern.

* txr.1: Documented.

* tests/012/oop-seq.tl: New tests.

1 files changed, 19 insertions, 1 deletions

diff --git a/lib.c b/lib.c
index c0fc6a8c..c5722241 100644
--- a/lib.c
+++ b/lib.c
@@ -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);