From c09f20c88c35833c9e18be82b59fdd7c26e379bd Mon Sep 17 00:00:00 2001
From: "Tom Breton (Tehom)" <tehom@panix.com>
Date: Wed, 18 May 2011 18:11:47 -0400
Subject: [PATCH] New C functions destr_result_fill_array, destr_result_to_vec

---
 klink.c | 40 +++++++++++++++++++++++++++++++++++++---
 1 file changed, 37 insertions(+), 3 deletions(-)

diff --git a/klink.c b/klink.c
index 3ceb3a7..06964d2 100644
--- a/klink.c
+++ b/klink.c
@@ -2113,6 +2113,7 @@ DEF_APPLICATIVE_W_DESTR (ps0a1, mk_destructurer, REF_OPER(is_finite_list),T_NO_K
   return mk_basvector_w_args(sc, arg1, T_DESTRUCTURE | T_NO_K);
 }
 /*_     , Destructurer Result state */
+/* Really a mixed vector/list */
 /*_      . mk_destr_result */
 pko
 mk_destr_result
@@ -2136,6 +2137,40 @@ mk_destr_result_add
 		 unsafe_v2car (old),
 		 val_list);
 }
+/*_      . destr_result_fill_array */
+void
+destr_result_fill_array (pko dr, int max_len, pko * array)
+{
+  /* Assume errors are due to C code. */
+  WITH_REPORTER (0);
+  WITH_UNBOXED_UNSAFE (p_destr_result, kt_destr_result, dr);
+  int vec_len =
+    basvector_len (p_destr_result->_car);
+  basvector_fill_array(p_destr_result->_car, vec_len, array);
+  /* Account for elements already used in initialization */
+  int i = vec_len;
+  pko args;
+  for (args = p_destr_result->_cdr; args != K_NIL; args = cdr (args), i++)
+    {
+      assert (i < max_len);
+      array [i] = car (args);
+    }  
+}
+
+/*_     , destr_result_to_vec */
+pko
+destr_result_to_vec (pko destr_result)
+{
+  WITH_UNBOXED_UNSAFE (p_destr_result, kt_destr_result, destr_result);
+  int len =
+    basvector_len (p_destr_result->_car) +
+    list_length (p_destr_result->_cdr);
+  pko vec = mk_vector (len, K_NIL);
+  WITH_UNBOXED_UNSAFE (p_vec, kt_vector, vec);
+  destr_result_fill_array (destr_result, len, p_vec->els);
+  return vec;
+}
+
 /*_    . Particular typechecks */
 /*_     , Any singleton */
 pko _K_ARRAY_any_singleton[] = { K_ANY, };
@@ -2841,7 +2876,6 @@ DEF_SIMPLE_CFUNC (ps0a4, destructure_resume, 0)
       errx (7, "Unrecognized enumeration");
     }
 }
-
 /*_     , do-destructure */
 /* We don't have a typecheck typecheck predicate yet, so accept
    anything for arg2. Really it can be what typecheck accepts or
@@ -2867,8 +2901,7 @@ DEF_SIMPLE_APPLICATIVE (ps0a2, do_destructure,T_NO_K,unsafe,"do-destructure")
 		     err);
       /* NOTREACHED */
     default:
-      /* $$IMPROVE ME  Handle continuing. */
-      KERNEL_ERROR_0 (sc, "do_destructure: argobject is the wrong type");
+      errx (7, "Unrecognized enumeration");
     }
 
   return vec;
@@ -7603,6 +7636,7 @@ k_resume_to_cfunc (klink * sc, pko functor, pko value)
   {
     /** Fill arg_array **/
     WITH_REPORTER (sc);
+    /* $$IMPROVE ME  Use destr_result_fill_array */
     WITH_UNBOXED_UNSAFE (p_destr_result, kt_destr_result, value);
     basvector_fill_array(p_destr_result->_car, max_args, arg_array);
     /* Account for elements already used in initialization */
-- 
2.11.4.GIT