New function: replace-struct.

* struct.c (replace_struct): New function.
(struct_init): Register replace_struct intrinsic.

* struct.h (replace_struct): Declared.

* txr.1: documented replace-struct.

3 files changed, 60 insertions, 0 deletions

diff --git a/struct.c b/struct.c
index 43a30a65..064d0e21 100644
--- a/struct.c
+++ b/struct.c
@@ -111,6 +111,7 @@ void struct_init(void)
   reg_fun(intern(lit("super"), user_package), func_n1(super));
   reg_fun(intern(lit("make-struct"), user_package), func_n2v(make_struct));
   reg_fun(intern(lit("copy-struct"), user_package), func_n1(copy_struct));
+  reg_fun(intern(lit("replace-struct"), user_package), func_n2(replace_struct));
   reg_fun(intern(lit("clear-struct"), user_package), func_n2o(clear_struct, 1));
   reg_fun(intern(lit("slot"), user_package), func_n2(slot));
   reg_fun(intern(lit("slotset"), user_package), func_n3(slotset));
@@ -408,6 +409,22 @@ val clear_struct(val strct, val value)
   return strct;
 }
 
+val replace_struct(val target, val source)
+{
+  const val self = lit("replace-struct");
+  struct struct_inst *tsi = struct_handle(target, self);
+  struct struct_inst *ssi = struct_handle(source, self);
+  struct struct_type *sst = coerce(struct struct_type *, ssi->type->co.handle);
+  cnum nslots = sst->nslots;
+  size_t size = offsetof(struct struct_inst, slot) + sizeof (val) * nslots;
+  struct struct_inst *ssi_copy = coerce(struct struct_inst *, chk_malloc(size));
+  memcpy(ssi_copy, ssi, size);
+  free(tsi);
+  target->co.handle = coerce(mem_t *, ssi_copy);
+  target->co.cls = source->co.cls;
+  return target;
+}
+
 static int cache_set_lookup(slot_cache_entry_t *set, cnum id)
 {
   if (set[0].id == id)
diff --git a/struct.h b/struct.h
index 1b1543ba..dff375eb 100644
--- a/struct.h
+++ b/struct.h
@@ -33,6 +33,7 @@ val super(val type);
 val make_struct(val type, val plist, struct args *);
 val copy_struct(val strct);
 val clear_struct(val strct, val value);
+val replace_struct(val target, val source);
 val find_struct_type(val sym);
 val slot(val strct, val sym);
 val slotset(val strct, val sym, val newval);
diff --git a/txr.1 b/txr.1
index ba079edc..0259b8b3 100644
--- a/txr.1
+++ b/txr.1
@@ -18745,6 +18745,48 @@ if omitted.
 Note that finalizers are not executed prior to replacing
 the slot values.
 
+.coNP Function @ replace-struct
+.synb
+.mets (replace-struct < target-obj << source-obj )
+.syne
+.desc
+The
+.code replace-struct
+function causes
+.meta target-obj
+to take on the attributes of
+.meta source-obj
+without changing its identity.
+
+The type of
+.code target-obj
+is changed to that of
+.codn source-obj .
+
+All instance slots of
+.code target-obj
+are discarded, and it is given new slots,
+which are copies of the instance slots of
+.codn source-obj .
+
+Because of the type change,
+.code target-obj
+implicitly loses all of its original static slots,
+and acquires those of
+.codn source obj .
+
+Note that finalizers registered against
+.meta target-obj
+are not invoked, and remain registered.
+If
+.meta target-obj
+has state which is cleaned up by
+finalizers, it is advisable to invoke them using
+.code call-finalizers
+prior to using
+.codn replace-struct ,
+or to take other measures to handle the situation.
+
 .coNP Function @ method
 .synb
 .mets (method < struct-obj << slot-name )