Remove unused macros in goops.c

[bpt/guile.git] / libguile / values.c

diff --git a/libguile/values.c b/libguile/values.c
index 005be50..670e222 100644 (file)
--- 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,40 @@ 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)
+{
+  if (SCM_LIKELY (SCM_VALUESP (obj)))
+    {
+      SCM values = scm_struct_ref (obj, SCM_INUM0);
+      size_t i = idx;
+      while (SCM_LIKELY (scm_is_pair (values)))
+        {
+          if (i == 0)
+            return SCM_CAR (values);
+          values = SCM_CDR (values);
+          i--;
+        }
+    }
+  else if (idx == 0)
+    return obj;
+
+  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_size_t (idx)),
+             scm_list_1 (scm_from_size_t (idx)));
+}
+
 SCM_DEFINE (scm_values, "values", 0, 0, 1,
            (SCM args),
            "Delivers all of its arguments to its continuation.  Except for\n"
@@ -83,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)
 {