mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-01 23:30:28 +02:00
Code Activity

Get fractions off scm_double_cell

Browse source 
* libguile/numbers.h (scm_t_double, scm_t_complex): Change type and pad
to scm_t_bits.
(struct scm_fraction): New type.
(scm_is_fraction, scm_to_fraction, scm_from_fraction)
(scm_fraction_numerator, scm_fraction_denominator): New helpers.
(SCM_FRACTIONP, SCM_FRACTION_NUMERATOR, SCM_FRACTION_DENOMINATOR): Use
new helpers.
* libguile/numbers.c (scm_i_make_ratio_already_reduced): Allocate using
scm_allocate_tagged.
This commit is contained in:
Andy Wingo 2025-06-20 16:41:47 +02:00
parent 7a749ef79c
commit 9fd851da65
2 changed files with 56 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

10
libguile/numbers.c
View file

@ -234,9 +234,12 @@ scm_i_make_ratio_already_reduced (SCM numerator, SCM denominator)
if (scm_is_eq (denominator, SCM_INUM1)) if (scm_is_eq (denominator, SCM_INUM1))
return numerator; return numerator;
return scm_double_cell (scm_tc16_fraction, struct scm_fraction *f = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
SCM_UNPACK (numerator), sizeof (*f));
SCM_UNPACK (denominator), 0); f->tag = scm_tc16_fraction;
f->numerator = numerator;
f->denominator = denominator;
return scm_from_fraction (f);
} }
static SCM scm_exact_integer_quotient (SCM x, SCM y); static SCM scm_exact_integer_quotient (SCM x, SCM y);
@ -3571,7 +3574,6 @@ scm_i_print_double (double val, SCM port)
int int
scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
char num_buf[FLOBUFLEN]; char num_buf[FLOBUFLEN];
scm_lfwrite (num_buf, iflo2str (sexp, num_buf, 10), port); scm_lfwrite (num_buf, iflo2str (sexp, num_buf, 10), port);

59
libguile/numbers.h
View file

@ -1,7 +1,7 @@
#ifndef SCM_NUMBERS_H #ifndef SCM_NUMBERS_H
#define SCM_NUMBERS_H #define SCM_NUMBERS_H
/* Copyright 1995-1996,1998,2000-2006,2008-2011,2013-2014,2016-2018,2021-2022 /* Copyright 1995-1996,1998,2000-2006,2008-2011,2013-2014,2016-2018,2021-2022,2025
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of Guile. This file is part of Guile.
@ -171,31 +171,72 @@ typedef long scm_t_inum;
#define SCM_NUMBERP(x) (SCM_I_INUMP(x) || SCM_NUMP(x)) #define SCM_NUMBERP(x) (SCM_I_INUMP(x) || SCM_NUMP(x))
#define SCM_NUMP(x) (SCM_HAS_TYP7 (x, scm_tc7_number)) #define SCM_NUMP(x) (SCM_HAS_TYP7 (x, scm_tc7_number))
#define SCM_FRACTIONP(x) (SCM_HAS_TYP16 (x, scm_tc16_fraction))
#define SCM_FRACTION_NUMERATOR(x) (SCM_CELL_OBJECT_1 (x))
#define SCM_FRACTION_DENOMINATOR(x) (SCM_CELL_OBJECT_2 (x))
typedef struct scm_t_double typedef struct scm_t_double
{ {
SCM type; scm_t_bits type;
#if SCM_SIZEOF_UINTPTR_T != 8 #if SCM_SIZEOF_UINTPTR_T != 8
SCM pad; scm_t_bits pad;
#endif #endif
double real; double real;
} scm_t_double; } scm_t_double;
typedef struct scm_t_complex typedef struct scm_t_complex
{ {
SCM type; scm_t_bits type;
#if SCM_SIZEOF_UINTPTR_T != 8 #if SCM_SIZEOF_UINTPTR_T != 8
SCM pad; scm_t_bits pad;
#endif #endif
double real; double real;
double imag; double imag;
} scm_t_complex; } scm_t_complex;
struct scm_fraction
{
scm_t_bits tag;
SCM numerator;
SCM denominator;
};
static inline int
scm_is_fraction (SCM x)
{
return SCM_HAS_TYP16 (x, scm_tc16_fraction);
}
static inline struct scm_fraction *
scm_to_fraction (SCM x)
{
if (!scm_is_fraction (x))
abort ();
return (struct scm_fraction *) SCM_UNPACK_POINTER (x);
}
static inline SCM
scm_from_fraction (struct scm_fraction *f)
{
return SCM_PACK_POINTER (f);
}
static inline SCM
scm_fraction_numerator (struct scm_fraction *f)
{
return f->numerator;
}
static inline SCM
scm_fraction_denominator (struct scm_fraction *f)
{
return f->denominator;
}
#define SCM_FRACTIONP(x) (scm_is_fraction (x))
#define SCM_FRACTION_NUMERATOR(x) (scm_fraction_numerator (scm_to_fraction (x)))
#define SCM_FRACTION_DENOMINATOR(x) (scm_fraction_denominator (scm_to_fraction (x)))
SCM_API SCM scm_exact_p (SCM x); SCM_API SCM scm_exact_p (SCM x);