cobj: clone method streamlines copy; structs get copy method.

* lib.h (struct cobj_ops): New function pointer, clone.
(cobj_ops_init, cobj_ops_init_ex): Add clone argument to macros.

* lib.c (seq_iter_cobj_ops): Use copy_iter as the clone operation.
(cptr_ops): Use copy_cptr as clone operation.
(copy): Replace if statements by check whether COBJ has a clone
operation. If so, we use it to copy the object.

* struct.h (enum special_slot): New member, copy_m.

* struct.c (copy_s): New symbol variable.
(special_sym): Associate copy_m enum value with copy symbol.
(struct_init): Initialize copy_s with interned symbol.
(struct_inst_clone): New static function.
(struct_type_ops): Specify no clone operation via null pointer.
(struct_inst_ops): Specify struct_inst_clone as clone
operation.

* arith.c (psq_ops): Indicate no clone operation via null pointer.

* buf.c (buf_strm_ops): Likewise.

* chksum.c (sha1_ops, sha256_ops, md5_ops): Likewise.

* ffi.c (ffi_type_builtin_ops, ffi_type_struct_ops,
ffi_type_ptr_ops, ffi_type_enum_ops, ffi_closure_ops,
union_ops): Likewise.
(carray_borrowed_ops, carry_owned_ops, carray_mmap_ops):
Specify copy_carray as clone operation.

* gc.c (prot_array_ops): Indicate no clone operation via
null pointer.

* gzip.c (gzio_ops_rd, gzip_ops_wr): Likewise.

* hash.c (hash_iter_ops): Likewise.
(hash_ops): Specify copy_hash as clone operation.

* parser.c (parser_ops): Indicate no clone operation via
null pointer.

* rand.c (random_state_clone): New static function.
(random_state_ops): Use random_state_clone as clone function.

* regex.c (char_set_obj_ops, regex_obj_ops): Indicate no clone
operation via null pointer.

* socket.c (dgram_strm_ops): Likewise.

* stream.c (null-ops, stdio_ops, tail_ops, pipe_ops,
dir_ops, string_in_ops, byte_in_ops, strlist_in_ops,
string_out_ops, strlist_out_ops, cat_stream_ops,
record_adapter_ops): Likewise.

* strudel.c (strudel_ops): Likewise.

* sysif.c (cptr_dl_ops, opendir_ops): Likewise.

* syslog.c (syslog_strm_ops): Likewise.

* unwind.c (cont_ops): Likewise.

* vm.c (vm_desc_ops, vm_closure_ops): Likewise.

* tree.c (tree_ops): Use copy_search_tree for clone
operation.
(tree_iter_ops): Use copy_tree_iter for clone operation.

* genchksum.txr: Changes in chksum.c specified in one
place here.

* tests/012/oop.tl: Couple of new tests.

* txr.1: Documented.

1 files changed, 15 insertions, 4 deletions

diff --git a/struct.c b/struct.c
index a2b1e79a..b421a265 100644
--- a/struct.c
+++ b/struct.c
@@ -107,12 +107,12 @@ val struct_type_s, meth_s, print_s, make_struct_lit_s;
 val init_k, postinit_k;
 val slot_s, derived_s;
 
-val nullify_s, from_list_s, lambda_set_s;
+val copy_s, nullify_s, from_list_s, lambda_set_s;
 
 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,
+  &equal_s, &copy_s, &nullify_s, &from_list_s, &lambda_s, &lambda_set_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
@@ -149,6 +149,7 @@ void struct_init(void)
   postinit_k = intern(lit("postinit"), keyword_package);
   slot_s = intern(lit("slot"), user_package);
   derived_s = intern(lit("derived"), user_package);
+  copy_s = intern(lit("copy"), user_package);
   nullify_s = intern(lit("nullify"), user_package);
   from_list_s = intern(lit("from-list"), user_package);
   lambda_set_s = intern(lit("lambda-set"), user_package);
@@ -1875,6 +1876,15 @@ static ucnum struct_inst_hash(val obj, int *count, ucnum seed)
   return out;
 }
 
+static val struct_inst_clone(val strct)
+{
+  val copy_meth = get_special_slot(strct, copy_m);
+
+  return if3(copy_meth,
+             funcall1(copy_meth, strct),
+             copy_struct(strct));
+}
+
 static val get_special_static_slot(struct struct_type *st,
                                    enum special_slot idx, val stslot)
 {
@@ -2038,9 +2048,10 @@ val get_special_slot_by_type(val stype, enum special_slot spidx)
 
 static_def(struct cobj_ops struct_type_ops =
            cobj_ops_init(eq, struct_type_print, struct_type_destroy,
-                         struct_type_mark, cobj_eq_hash_op));
+                         struct_type_mark, cobj_eq_hash_op, 0));
 
 struct cobj_ops struct_inst_ops =
   cobj_ops_init_ex(struct_inst_equal, struct_inst_print,
                    cobj_destroy_free_op, struct_inst_mark,
-                   struct_inst_hash, struct_inst_equalsub);
+                   struct_inst_hash, struct_inst_clone,
+                   struct_inst_equalsub);