mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-06 12:10:28 +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

10
libguile/eval.c
View file

@ -228,8 +228,9 @@ truncate_values (SCM x)
return x;
else
{
if (SCM_LIKELY (scm_i_nvalues (x) > 0))
return scm_i_value_ref (x, 0);
struct scm_values *values = scm_to_values (x);
if (SCM_LIKELY (scm_values_count (values) > 0))
return scm_values_ref (values, 0);
else
{
scm_ithrow (scm_from_utf8_symbol ("vm-run"),
@ -369,10 +370,11 @@ eval (SCM x, SCM env)
v = scm_call_0 (producer);
if (scm_is_values (v))
{
size_t i = scm_i_nvalues (v);
struct scm_values *values = scm_to_values (v);
size_t i = scm_values_count (values);
args = SCM_EOL;
while (i--)
args = scm_cons (scm_i_value_ref (v, i), args);
args = scm_cons (scm_values_ref (values, i), args);
}
else
args = scm_list_1 (v);

2
libguile/numbers.c
View file

@ -788,7 +788,7 @@ two_valued_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos,
{
SCM vals = scm_wta_dispatch_2 (gf, a1, a2, pos, subr);
scm_i_extract_values_2 (vals, rp1, rp2);
scm_values_extract_2 (vals, rp1, rp2);
}
SCM_DEFINE (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0,

4
libguile/print.c
View file

@ -707,8 +707,8 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
break;
case scm_tc7_values:
scm_puts ("#<values (", port);
print_vector (exp, scm_i_nvalues (exp), scm_c_value_ref, port,
pstate);
print_vector (exp, scm_values_count (scm_to_values (exp)),
scm_c_value_ref, port, pstate);
scm_puts (">", port);
break;
case scm_tc7_program:

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

34
libguile/values.h
View file

@ -1,7 +1,7 @@
#ifndef SCM_VALUES_H
#define SCM_VALUES_H
/* Copyright 2000-2001,2006,2008,2012,2018
/* Copyright 2000-2001,2006,2008,2012,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -31,22 +31,42 @@ scm_is_values (SCM x)
}
#ifdef BUILDING_LIBGUILE
static inline size_t
scm_i_nvalues (SCM x)
struct scm_values
{
return SCM_CELL_WORD_0 (x) >> 8;
scm_t_bits tag_and_count;
SCM values[];
};
static inline struct scm_values*
scm_to_values (SCM x)
{
if (!scm_is_values (x))
abort ();
return (struct scm_values*) SCM_UNPACK_POINTER (x);
}
static inline SCM
scm_i_value_ref (SCM x, size_t n)
scm_from_values (struct scm_values *values)
{
return SCM_CELL_OBJECT (x, n+1);
return SCM_PACK_POINTER (values);
}
static inline size_t
scm_values_count (struct scm_values *x)
{
return x->tag_and_count >> 8;
}
static inline SCM
scm_values_ref (struct scm_values *values, size_t n)
{
return values->values[n];
}
#endif
#define SCM_VALUESP(x) (scm_is_values (x))
SCM_INTERNAL void scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2);
SCM_INTERNAL void scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2);
SCM_API SCM scm_values (SCM args);
SCM_API SCM scm_c_values (SCM *base, size_t n);

5
libguile/vm.c
View file

@ -1228,10 +1228,11 @@ expand_apply_argument (scm_thread *thread)
static void
unpack_values_object (scm_thread *thread, SCM obj)
{
size_t n, nvals = scm_i_nvalues (obj);
struct scm_values *values = scm_to_values (obj);
size_t n, nvals = scm_values_count (values);
alloc_frame (thread, nvals);
for (n = 0; n < nvals; n++)
SCM_FRAME_LOCAL (thread->vm.fp, n) = scm_i_value_ref (obj, n);
SCM_FRAME_LOCAL (thread->vm.fp, n) = scm_values_ref (values, n);
}
static void