X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/252acfe8e70ac4c7d325588ffea1905fcf6f86b2..08c5d888d4634669634937d9f7b57145fefc848a:/libguile/values.c

diff --git a/libguile/values.c b/libguile/values.c
index fdd93599a..670e22294 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2000, 2001, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 2000, 2001, 2006, 2008, 2009, 2011, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -67,6 +67,15 @@ print_values (SCM obj, SCM pwps)
   return SCM_UNSPECIFIED;
 }
 
+size_t
+scm_c_nvalues (SCM obj)
+{
+  if (SCM_LIKELY (SCM_VALUESP (obj)))
+    return scm_ilength (scm_struct_ref (obj, SCM_INUM0));
+  else
+    return 1;
+}
+
 SCM
 scm_c_value_ref (SCM obj, size_t idx)
 {
@@ -88,8 +97,8 @@ scm_c_value_ref (SCM obj, size_t idx)
   scm_error (scm_out_of_range_key,
 	     "scm_c_value_ref",
 	     "Too few values in ~S to access index ~S",
-             scm_list_2 (obj, scm_from_unsigned_integer (idx)),
-             scm_list_1 (scm_from_unsigned_integer (idx)));
+             scm_list_2 (obj, scm_from_size_t (idx)),
+             scm_list_1 (scm_from_size_t (idx)));
 }
 
 SCM_DEFINE (scm_values, "values", 0, 0, 1,
@@ -108,14 +117,26 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
   if (n == 1)
     result = SCM_CAR (args);
   else
-    {
-      result = scm_c_make_struct (scm_values_vtable, 0, 1, SCM_UNPACK (args));
-    }
+    result = scm_c_make_struct (scm_values_vtable, 0, 1, SCM_UNPACK (args));
 
   return result;
 }
 #undef FUNC_NAME
 
+SCM
+scm_c_values (SCM *base, size_t nvalues)
+{
+  SCM ret, *walk;
+
+  if (nvalues == 1)
+    return *base;
+
+  for (ret = SCM_EOL, walk = base + nvalues - 1; walk >= base; walk--)
+    ret = scm_cons (*walk, ret);
+
+  return scm_values (ret);
+}
+
 void
 scm_init_values (void)
 {