diff options
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/values.c | 25 | ||||
-rw-r--r-- | libguile/values.h | 1 |
2 files changed, 26 insertions, 0 deletions
diff --git a/libguile/values.c b/libguile/values.c index ab7773141..9c9e5ff6d 100644 --- a/libguile/values.c +++ b/libguile/values.c @@ -67,6 +67,31 @@ print_values (SCM obj, SCM pwps) return SCM_UNSPECIFIED; } +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_unsigned_integer (idx)), + scm_list_1 (scm_from_unsigned_integer (idx))); +} + SCM_DEFINE (scm_values, "values", 0, 0, 1, (SCM args), "Delivers all of its arguments to its continuation. Except for\n" diff --git a/libguile/values.h b/libguile/values.h index 65ad8a119..5f79855be 100644 --- a/libguile/values.h +++ b/libguile/values.h @@ -33,6 +33,7 @@ SCM_API SCM scm_values_vtable; SCM_INTERNAL void scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2); SCM_API SCM scm_values (SCM args); +SCM_API SCM scm_c_value_ref (SCM values, size_t idx); SCM_INTERNAL void scm_init_values (void); #endif /* SCM_VALUES_H */ |