mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00
Code Activity

Give reified value objects a proper data type

Browse source 
* libguile/values.h (struct scm_values): New build-time definition.
(scm_to_values):
(scm_from_values):
(scm_values_count):
(scm_values_ref): New helpers.
* libguile/vm.c:
* libguile/values.c:
* libguile/print.c:
* libguile/numbers.c:
* libguile/eval.c: Adapt all callers.
This commit is contained in:
Andy Wingo 2025-05-30 09:57:08 +02:00
parent aa73d31ded
commit 224fb82a39
6 changed files with 83 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

83
libguile/values.c
View file

@ -1,4 +1,4 @@
/* Copyright 2000-2001,2006,2008-2009,2011-2013,2016-2019
/* Copyright 2000-2001,2006,2008-2009,2011-2013,2016-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -32,26 +32,27 @@
/* OBJ must be a values object containing exactly two values.
scm_i_extract_values_2 puts those two values into *p1 and *p2. */
scm_values_extract_2 puts those two values into *p1 and *p2. */
void
scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2)
scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2)
{
SCM_ASSERT_TYPE (scm_is_values (obj), obj, SCM_ARG1,
"scm_i_extract_values_2", "values");
if (scm_i_nvalues (obj) != 2)
"scm_values_extract_2", "values");
struct scm_values *values = scm_to_values (obj);
if (scm_values_count (values) != 2)
scm_wrong_type_arg_msg
("scm_i_extract_values_2", SCM_ARG1, obj,
("scm_values_extract_2", SCM_ARG1, obj,
"a values object containing exactly two values");
*p1 = scm_i_value_ref (obj, 0);
*p2 = scm_i_value_ref (obj, 1);
*p1 = scm_values_ref (values, 0);
*p2 = scm_values_ref (values, 1);
}
size_t
scm_c_nvalues (SCM obj)
{
if (SCM_LIKELY (scm_is_values (obj)))
return scm_i_nvalues (obj);
return scm_values_count (scm_to_values (obj));
else
return 1;
}
@ -61,8 +62,9 @@ scm_c_value_ref (SCM obj, size_t idx)
{
if (scm_is_values (obj))
{
if (idx < scm_i_nvalues (obj))
return scm_i_value_ref (obj, idx);
struct scm_values *values = scm_to_values (obj);
if (idx < scm_values_count (values))
return scm_values_ref (values, idx);
}
else
{
@ -87,32 +89,30 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
#define FUNC_NAME s_scm_values
{
long n;
SCM result;
SCM_VALIDATE_LIST_COPYLEN (1, args, n);
if (n == 1)
result = SCM_CAR (args);
else
{
size_t i;
return SCM_CAR (args);
if ((size_t) n > (size_t) (UINTPTR_MAX >> 8))
scm_error (scm_out_of_range_key, FUNC_NAME, "Too many values",
SCM_EOL, SCM_EOL);
size_t i;
result = scm_words ((((scm_t_bits) n) << 8) | scm_tc7_values, n + 1);
for (i = 0; i < n; i++, args = SCM_CDR (args))
SCM_SET_CELL_OBJECT (result, i + 1, SCM_CAR (args));
}
if ((size_t) n > (size_t) (UINTPTR_MAX >> 8))
scm_error (scm_out_of_range_key, FUNC_NAME, "Too many values",
SCM_EOL, SCM_EOL);
return result;
struct scm_values *values =
scm_gc_malloc (sizeof (struct scm_values) + n * sizeof (SCM), "values");
values->tag_and_count = scm_tc7_values | (n << 8);
for (i = 0; i < n; i++, args = SCM_CDR (args))
values->values[i] = SCM_CAR (args);
return scm_from_values (values);
}
#undef FUNC_NAME
SCM
scm_c_values (SCM *base, size_t nvalues)
{
SCM ret;
size_t i;
if (nvalues == 1)
@ -122,37 +122,42 @@ scm_c_values (SCM *base, size_t nvalues)
scm_error (scm_out_of_range_key, "scm_c_values", "Too many values",
SCM_EOL, SCM_EOL);
ret = scm_words ((((scm_t_bits) nvalues) << 8) | scm_tc7_values, nvalues + 1);
struct scm_values *values =
scm_gc_malloc (sizeof (struct scm_values) + nvalues * sizeof (SCM), "values");
values->tag_and_count = scm_tc7_values | (nvalues << 8);
for (i = 0; i < nvalues; i++)
SCM_SET_CELL_OBJECT (ret, i + 1, base[i]);
values->values[i] = base[i];
return ret;
return scm_from_values (values);
}
SCM
scm_values_2 (SCM a, SCM b)
{
SCM ret;
struct scm_values *values =
scm_gc_malloc (sizeof (struct scm_values) + 2 * sizeof (SCM), "values");
ret = scm_words ((2 << 8) | scm_tc7_values, 3);
SCM_SET_CELL_OBJECT_1 (ret, a);
SCM_SET_CELL_OBJECT_2 (ret, b);
values->tag_and_count = scm_tc7_values | (2 << 8);
values->values[0] = a;
values->values[1] = b;
return ret;
return scm_from_values (values);
}
SCM
scm_values_3 (SCM a, SCM b, SCM c)
{
SCM ret;
struct scm_values *values =
scm_gc_malloc (sizeof (struct scm_values) + 3 * sizeof (SCM), "values");
ret = scm_words ((3 << 8) | scm_tc7_values, 4);
SCM_SET_CELL_OBJECT_1 (ret, a);
SCM_SET_CELL_OBJECT_2 (ret, b);
SCM_SET_CELL_OBJECT_3 (ret, c);
values->tag_and_count = scm_tc7_values | (3 << 8);
values->values[0] = a;
values->values[1] = b;
values->values[2] = c;
return ret;
return scm_from_values (values);
}
void