From cd8cf4f8fd827e428c53f2e6d7fcce5cd9727e7f Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 1 Jun 2016 07:05:35 -0700
Subject: Methods for turning objects into sequences.

Struct objects can now define methods car, cdr and nullify.
With these, they can participate in operations on sequences.

* eval.h (car_s, cdr_s): Declared.

* lib.c (nullify_s): New symbol variable.
(car, cdr): Implement for struct objects via, respectively,
their car and cdr methods.
(tolist): Handle objects by mapping through identity.
(nullify): Implement for objects optionally: if an object
is a struct with a nullify method, use it, otherwise go
through default case of just returning the object.
(empty): Implement for objects that have nullify method.
(obj_init): Initialize nullify_s.

* struct.c (maybe_slot): New function.

* struct.h (maybe_slot): Declared.

* txr.1: Documented car, cdr and nullify method
convention.
---
 eval.h   |  1 +
 lib.c    | 22 ++++++++++++++++++++--
 struct.c | 14 ++++++++++++++
 struct.h |  1 +
 txr.1    | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 85 insertions(+), 2 deletions(-)

diff --git a/eval.h b/eval.h
index 7af95058..fb9c34f4 100644
--- a/eval.h
+++ b/eval.h
@@ -28,6 +28,7 @@ extern val dwim_s, lambda_s, vector_lit_s, vec_list_s, list_s;
 extern val hash_lit_s, hash_construct_s, struct_lit_s, qref_s;
 extern val eval_error_s, if_s, call_s;
 extern val eq_s, eql_s, equal_s;
+extern val car_s, cdr_s;
 extern val last_form_evaled, last_form_expanded;
 extern val self_load_path_s;
 
diff --git a/lib.c b/lib.c
index 31301b6d..92d218a6 100644
--- a/lib.c
+++ b/lib.c
@@ -101,7 +101,7 @@ val error_s, type_error_s, internal_error_s, panic_s;
 val numeric_error_s, range_error_s;
 val query_error_s, file_error_s, process_error_s, syntax_error_s;
 val timeout_error_s, system_error_s;
-val gensym_counter_s;
+val gensym_counter_s, nullify_s;
 
 val nothrow_k, args_k, colon_k, auto_k, fun_k;
 val wrap_k, reflect_k;
@@ -305,6 +305,9 @@ val car(val cons)
     if (zerop(length_str(cons)))
       return nil;
     return chr_str(cons, zero);
+  case COBJ:
+    if (structp(cons))
+      return funcall1(slot(cons, car_s), cons);
   default:
     type_mismatch(lit("~s is not a cons"), cons, nao);
   }
@@ -333,6 +336,9 @@ val cdr(val cons)
     if (le(length(cons), one))
       return nil;
     return sub(cons, one, t);
+  case COBJ:
+    if (structp(cons))
+      return funcall1(slot(cons, cdr_s), cons);
   default:
     type_mismatch(lit("~s is not a cons"), cons, nao);
   }
@@ -692,6 +698,8 @@ val tolist(val seq)
   case LIT:
   case LSTR:
     return list_str(seq);
+  case COBJ:
+    return mapcar(identity_f, seq);
   case NIL:
   case CONS:
   case LCONS:
@@ -715,6 +723,12 @@ val nullify(val seq)
     return if3(length_str_gt(seq, zero), seq, nil);
   case VEC:
     return if3(length_vec(seq) != zero, seq, nil);
+  case COBJ:
+    if (structp(seq)) {
+      val nullify_meth = maybe_slot(seq, nullify_s);
+      if (nullify_meth)
+        return funcall1(nullify_meth, seq);
+    }
   default:
     return seq;
   }
@@ -8041,7 +8055,10 @@ val empty(val seq)
   case COBJ:
     if (seq->co.cls == hash_s)
       return eq(hash_count(seq), zero);
-    /* fallthrough */
+    if (structp(seq)) {
+      val nullify_meth = maybe_slot(seq, nullify_s);
+      return if3(nullify_meth && funcall1(nullify_meth, seq), nil, seq);
+    }
   default:
     type_mismatch(lit("empty: ~s is not a sequence"), seq, nao);
   }
@@ -8635,6 +8652,7 @@ static void obj_init(void)
   timeout_error_s = intern(lit("timeout-error"), user_package);
   assert_s = intern(lit("assert"), user_package);
   name_s = intern(lit("name"), user_package);
+  nullify_s = intern(lit("nullify"), user_package);
 
   args_k = intern(lit("args"), keyword_package);
   nothrow_k = intern(lit("nothrow"), keyword_package);
diff --git a/struct.c b/struct.c
index 21a3a18a..2075b42f 100644
--- a/struct.c
+++ b/struct.c
@@ -759,6 +759,20 @@ val slot(val strct, val sym)
   no_such_slot(self, si->type->self, sym);
 }
 
+val maybe_slot(val strct, val sym)
+{
+  const val self = lit("slot");
+  struct struct_inst *si = struct_handle(strct, self);
+
+  if (symbolp(sym)) {
+    loc ptr = lookup_slot_load(strct, si, sym);
+    if (!nullocp(ptr))
+      return deref(ptr);
+  }
+
+  return nil;
+}
+
 val slotset(val strct, val sym, val newval)
 {
   const val self = lit("slotset");
diff --git a/struct.h b/struct.h
index e71f717b..46dc6542 100644
--- a/struct.h
+++ b/struct.h
@@ -39,6 +39,7 @@ val replace_struct(val target, val source);
 val reset_struct(val strct);
 val find_struct_type(val sym);
 val slot(val strct, val sym);
+val maybe_slot(val strct, val sym);
 val slotset(val strct, val sym, val newval);
 val static_slot(val stype, val sym);
 val static_slot_set(val stype, val sym, val newval);
diff --git a/txr.1 b/txr.1
index e79ec1d7..6ba20ac0 100644
--- a/txr.1
+++ b/txr.1
@@ -10300,6 +10300,13 @@ are made to work with strings and vectors:
   (car #(1 2 3)) -> 1
 .cble
 
+Moreover, structure types which define the methods
+.codn car ,
+.code cdr
+and
+.code nullify
+can also be treated in the same way.
+
 The
 .code ldiff
 function is also extended in a special way. When the right parameter
@@ -19288,6 +19295,48 @@ is defined for a structure type, then it is used for pretty-printing instances
 of that type. The method takes one argument (in addition to the object), which
 specifies the output stream.
 
+.NP* Sequence Operations on Structures
+
+Structures may be treated as sequences if they define methods named
+by the symbols
+.codn car ,
+.codn cdr ,
+and
+.codn nullify .
+
+If a structure supports these methods, then these methods are used
+by the functions
+.codn car ,
+.codn cdr ,
+.codn nullify ,
+.code empty
+and various other sequence manipulating functions derived from them, when those
+functions are applied to that object.
+
+An object which implements these three methods can be considered to denote
+an abstract sequence. The object's
+.code car
+method should return the first value in that abstract sequence, or else
+.code nil
+if that sequence is empty.
+
+The object's
+.code cdr
+method should return an object denoting the remainder of the sequence,
+or else
+.code nil
+if the sequence is empty or contains only one value.  This returned object can
+be of any type: it may be of the same structure type as that object, a
+different structure type, a list, or whatever else.  If a non-sequence object
+is returned.
+
+The
+.code nullify
+method should return
+.code nil
+if the object is considered to denote an empty sequence. Otherwise it
+should return that object itself.
+
 .coNP Macro @ defstruct
 .synb
 .mets (defstruct >> { name | >> ( name << arg *)} < super
-- 
cgit v1.2.3