copy-fun: duplicate a function, with own environment.

* eval.c (deep_copy_env): New function.
(eval_init): Register copy-fun intrinsic.

* eval.h (deep_copy_env): Declared.

* lib.c (copy_fun): New function.

* lib.h (copy_fun): Declared.

* vm.c (vm_copy_closure): New function.

* vm.h (vm_copy_closure): Declared.

* txr.1: Documented copy-fun.

1 files changed, 26 insertions, 0 deletions

diff --git a/vm.c b/vm.c
index c5a0ed17..9322cba8 100644
--- a/vm.c
+++ b/vm.c
@@ -292,6 +292,32 @@ static val vm_make_closure(struct vm *vm, int frsz)
   return closure;
 }
 
+val vm_copy_closure(val oclosure)
+{
+  struct vm_closure *ovc = coerce(struct vm_closure *, oclosure->co.handle);
+  const size_t hdr_sz = offsetof (struct vm_closure, dspl);
+  size_t dspl_sz = ovc->nlvl * sizeof (struct vm_env);
+  struct vm_closure *nvc = coerce(struct vm_closure *,
+                                  chk_malloc(hdr_sz + dspl_sz));
+  val nclosure;
+  int i;
+
+  memcpy(nvc, ovc, hdr_sz + dspl_sz);
+
+  nclosure = cobj(coerce(mem_t *, nvc), vm_closure_s, &vm_closure_ops);
+
+  for (i = 2; i < nvc->nlvl; i++) {
+    struct vm_env *ndi = &nvc->dspl[i];
+
+    if (ndi->vec != nil) {
+      ndi->vec = copy_vec(ndi->vec);
+      ndi->mem = ndi->vec->v.vec;
+    }
+  }
+
+  return nclosure;
+}
+
 static void vm_closure_mark(val obj)
 {
   struct vm_closure *vc = coerce(struct vm_closure *, obj->co.handle);