numbers.h 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779
  1. #ifndef SCM_NUMBERS_H
  2. #define SCM_NUMBERS_H
  3. /* Copyright 1995-1996,1998,2000-2006,2008-2011,2013-2014,2016-2019
  4. Free Software Foundation, Inc.
  5. This file is part of Guile.
  6. Guile is free software: you can redistribute it and/or modify it
  7. under the terms of the GNU Lesser General Public License as published
  8. by the Free Software Foundation, either version 3 of the License, or
  9. (at your option) any later version.
  10. Guile is distributed in the hope that it will be useful, but WITHOUT
  11. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  12. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  13. License for more details.
  14. You should have received a copy of the GNU Lesser General Public
  15. License along with Guile. If not, see
  16. <https://www.gnu.org/licenses/>. */
  17. #include <gmp.h>
  18. #include "libguile/error.h"
  19. #include "libguile/gc.h"
  20. #include "libguile/print.h"
  21. /* Immediate Numbers, also known as fixnums
  22. *
  23. * Inums are exact integers that fit within an SCM word
  24. * (along with two tagging bits).
  25. *
  26. * In the current implementation, Inums must also fit within a long
  27. * because that's what GMP's mpz_*_si functions accept. */
  28. typedef long scm_t_inum;
  29. #define SCM_I_FIXNUM_BIT (SCM_SIZEOF_UINTPTR_T * 8 - scm_fixnum_tag_size)
  30. #define SCM_MOST_NEGATIVE_FIXNUM (-1L << (SCM_I_FIXNUM_BIT - 1))
  31. #define SCM_MOST_POSITIVE_FIXNUM (- (SCM_MOST_NEGATIVE_FIXNUM + 1))
  32. /* SCM_SRS (X, Y) is signed right shift, defined as floor (X / 2^Y),
  33. where Y must be non-negative and less than the width in bits of X.
  34. It's common for >> to do this, but the C standards do not specify
  35. what happens when X is negative.
  36. NOTE: X must not perform side effects. */
  37. #if (-1 >> 2 == -1) && (-4 >> 2 == -1) && (-5 >> 2 == -2) && (-8 >> 2 == -2)
  38. # define SCM_SRS(x, y) ((x) >> (y))
  39. #else
  40. # define SCM_SRS(x, y) \
  41. ((x) < 0 \
  42. ? -1 - (scm_t_signed_bits) (~(scm_t_bits)(x) >> (y)) \
  43. : ((x) >> (y)))
  44. #endif
  45. /* The first implementation of SCM_I_INUM below depends on behavior that
  46. is specified by GNU C but not by C standards, namely that when
  47. casting to a signed integer of width N, the value is reduced modulo
  48. 2^N to be within range of the type. The second implementation below
  49. should be portable to all conforming C implementations, but may be
  50. less efficient if the compiler is not sufficiently clever.
  51. NOTE: X must not perform side effects. */
  52. #ifdef __GNUC__
  53. # define SCM_I_INUM(x) (SCM_SRS ((scm_t_inum) SCM_UNPACK (x), scm_fixnum_tag_size))
  54. #else
  55. # define SCM_I_INUM(x) \
  56. (SCM_UNPACK (x) > SCM_T_SIGNED_BITS_MAX \
  57. ? -1 - (scm_t_inum) (~SCM_UNPACK (x) >> scm_fixnum_tag_size) \
  58. : (scm_t_inum) (SCM_UNPACK (x) >> scm_fixnum_tag_size))
  59. #endif
  60. #define SCM_I_INUMP(x) ((SCM_UNPACK (x) & scm_fixnum_tag_mask) == scm_fixnum_tag)
  61. #define SCM_I_NINUMP(x) (!SCM_I_INUMP (x))
  62. #define SCM_I_MAKINUM(x) \
  63. (SCM_PACK ((((scm_t_bits) (x)) << scm_fixnum_tag_size) + scm_fixnum_tag))
  64. /* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */
  65. #define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)
  66. #define SCM_NEGFIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM)
  67. #define SCM_FIXABLE(n) (SCM_POSFIXABLE (n) && SCM_NEGFIXABLE (n))
  68. /* Immediate doubles with exponent <= 255 */
  69. #define SCM_I_IFLO(x) \
  70. ((const union { double _f; uint64_t _u; }) \
  71. { ._u = (((SCM_UNPACK (x) >> 4) | (SCM_UNPACK (x) << 60)) \
  72. - 0x1010000000000000) } ._f)
  73. #define SCM_I_IFLO_P(x) (((SCM_UNPACK (x) + 2) & 7) > 2)
  74. #define SCM_MOST_POSITIVE_IFLO 0x1.fffffffffffffp255 /* 1.1579208923731618e77 */
  75. #define SCM_MOST_NEGATIVE_IFLO (-SCM_MOST_POSITIVE_IFLO)
  76. #define SCM_INUM0 (SCM_I_MAKINUM (0)) /* A name for 0 */
  77. #define SCM_INUM1 (SCM_I_MAKINUM (1)) /* A name for 1 */
  78. /* SCM_MAXEXP is the maximum double precision exponent
  79. * SCM_FLTMAX is less than or scm_equal the largest single precision float
  80. */
  81. #if SCM_HAVE_STDC_HEADERS
  82. # ifndef GO32
  83. # include <float.h>
  84. # ifdef __MINGW32__
  85. # define copysign _copysign
  86. # define finite _finite
  87. # endif /* __MINGW32__ */
  88. # endif /* ndef GO32 */
  89. #endif /* def STDC_HEADERS */
  90. #ifdef DBL_MAX_10_EXP
  91. # define SCM_MAXEXP DBL_MAX_10_EXP
  92. #else
  93. # define SCM_MAXEXP 308 /* IEEE doubles */
  94. #endif /* def DBL_MAX_10_EXP */
  95. #ifdef FLT_MAX
  96. # define SCM_FLTMAX FLT_MAX
  97. #else
  98. # define SCM_FLTMAX 1e+23
  99. #endif /* def FLT_MAX */
  100. /* SCM_INTBUFLEN is the maximum number of characters neccessary for
  101. * the printed or scm_string representation of an intmax_t in
  102. * radix 2. The buffer passed to scm_iint2str and scm_iuint2str must
  103. * be of this size, for example.
  104. */
  105. #define SCM_INTBUFLEN (5 + SCM_CHAR_BIT*sizeof(intmax_t))
  106. /* Numbers
  107. */
  108. /* Note that scm_tc16_double and scm_tc16_complex are given tc16-codes that
  109. * only differ in one bit: This way, checking if an object is an inexact
  110. * number can be done quickly. */
  111. /* Number subtype 1 to 4 (note the dependency on SCM_INEXACTP) */
  112. #define scm_tc16_big (scm_tc11_number + (1 << 12))
  113. #define scm_tc16_real (scm_tc11_number + (2 << 12))
  114. #define scm_tc16_complex (scm_tc11_number + (3 << 12))
  115. #define scm_tc16_fraction (scm_tc11_number + (4 << 12))
  116. #define SCM_INEXACTP(x) \
  117. (SCM_IMP (x) \
  118. ? SCM_I_IFLO_P (x) \
  119. : ((SCM_TYP16 (x) & ~(scm_tc16_real ^ scm_tc16_complex)) \
  120. == (scm_tc16_real & scm_tc16_complex)))
  121. #define SCM_REALP(x) \
  122. (SCM_IMP (x) ? SCM_I_IFLO_P (x) : SCM_HAS_TYP16 (x, scm_tc16_real))
  123. #define SCM_COMPLEXP(x) (SCM_HAS_TYP16 (x, scm_tc16_complex))
  124. #define SCM_REAL_VALUE(x) \
  125. (SCM_IMP (x) ? SCM_I_IFLO(x) : (((scm_t_double *) SCM2PTR (x))->real))
  126. #define SCM_COMPLEX_REAL(x) (((scm_t_complex *) SCM2PTR (x))->real)
  127. #define SCM_COMPLEX_IMAG(x) (((scm_t_complex *) SCM2PTR (x))->imag)
  128. /* Each bignum is just an mpz_t stored in a double cell starting at word 1. */
  129. #define SCM_I_BIG_MPZ(x) (*((mpz_t *) (SCM_CELL_OBJECT_LOC((x),1))))
  130. #define SCM_BIGP(x) (SCM_HAS_TYP16 (x, scm_tc16_big))
  131. #define SCM_I_FIXRAT_P(x) \
  132. ((SCM_UNPACK (x) & scm_fixrat_tag_mask) == scm_fixrat_tag)
  133. #define SCM_I_FIXRAT_RANK(x) \
  134. ((SCM_UNPACK (x) >> (SCM_SIZEOF_UINTPTR_T * 8 \
  135. - 1 - scm_fixrat_rank_size)) \
  136. & ~((scm_t_bits) -1 << scm_fixrat_rank_size))
  137. /* XXX Assumes that any fixrat numerator is an inum, and that doubles
  138. are in IEEE-754 binary-64 format. Verify this. */
  139. /* XXX Assumes 64-bit word size. */
  140. #define SCM_I_FIXRAT_DENOMINATOR(x) \
  141. ((scm_t_inum) \
  142. ((const union { double f; uint64_t u; }) \
  143. { .u = (((SCM_UNPACK (x) >> 5) \
  144. & 0x3ffffffffffffff) \
  145. | 0x4000000000000000) } .f))
  146. #define SCM_I_FIXRAT_NUMERATOR(x) \
  147. ((SCM_UNPACK (x) >> 63) \
  148. ? -(scm_t_inum) ((SCM_UNPACK (x) \
  149. & ((scm_t_bits) -1 \
  150. >> (scm_fixrat_rank_size + 2 \
  151. + SCM_I_FIXRAT_RANK(x)))) \
  152. >> scm_fixrat_tag_size) \
  153. : (scm_t_inum) ((SCM_UNPACK (x) \
  154. & ((scm_t_bits) -1 \
  155. >> (scm_fixrat_rank_size + 2 \
  156. + SCM_I_FIXRAT_RANK(x)))) \
  157. >> scm_fixrat_tag_size))
  158. #define SCM_NUMBERP(x) \
  159. (SCM_IMP (x) \
  160. ? SCM_I_INUMP(x) || SCM_I_IFLO_P (x) || SCM_I_FIXRAT_P(x) \
  161. : SCM_NUMP(x))
  162. #define SCM_NUMP(x) (SCM_HAS_TYP11 (x, scm_tc11_number))
  163. #define SCM_FRACTIONP(x) \
  164. (SCM_IMP (x) \
  165. ? SCM_I_FIXRAT_P (x) \
  166. : SCM_HAS_TYP16 (x, scm_tc16_fraction))
  167. #define SCM_FRACTION_NUMERATOR(x) \
  168. (SCM_IMP (x) \
  169. ? SCM_I_MAKINUM (SCM_I_FIXRAT_NUMERATOR (x)) \
  170. : SCM_CELL_OBJECT_1 (x))
  171. #define SCM_FRACTION_DENOMINATOR(x) \
  172. (SCM_IMP (x) \
  173. ? SCM_I_MAKINUM (SCM_I_FIXRAT_DENOMINATOR (x)) \
  174. : SCM_CELL_OBJECT_2 (x))
  175. typedef struct scm_t_double
  176. {
  177. SCM type;
  178. #if SCM_SIZEOF_UINTPTR_T != 8
  179. SCM pad;
  180. #endif
  181. double real;
  182. } scm_t_double;
  183. typedef struct scm_t_complex
  184. {
  185. SCM type;
  186. #if SCM_SIZEOF_UINTPTR_T != 8
  187. SCM pad;
  188. #endif
  189. double real;
  190. double imag;
  191. } scm_t_complex;
  192. SCM_API SCM scm_exact_p (SCM x);
  193. SCM_API int scm_is_exact (SCM x);
  194. SCM_API SCM scm_odd_p (SCM n);
  195. SCM_API SCM scm_even_p (SCM n);
  196. SCM_API SCM scm_finite_p (SCM x);
  197. SCM_API SCM scm_inf_p (SCM x);
  198. SCM_API SCM scm_nan_p (SCM x);
  199. SCM_API SCM scm_inf (void);
  200. SCM_API SCM scm_nan (void);
  201. SCM_API SCM scm_abs (SCM x);
  202. SCM_API SCM scm_quotient (SCM x, SCM y);
  203. SCM_API SCM scm_remainder (SCM x, SCM y);
  204. SCM_API SCM scm_modulo (SCM x, SCM y);
  205. SCM_API void scm_euclidean_divide (SCM x, SCM y, SCM *q, SCM *r);
  206. SCM_API SCM scm_euclidean_quotient (SCM x, SCM y);
  207. SCM_API SCM scm_euclidean_remainder (SCM x, SCM y);
  208. SCM_API void scm_floor_divide (SCM x, SCM y, SCM *q, SCM *r);
  209. SCM_API SCM scm_floor_quotient (SCM x, SCM y);
  210. SCM_API SCM scm_floor_remainder (SCM x, SCM y);
  211. SCM_API void scm_ceiling_divide (SCM x, SCM y, SCM *q, SCM *r);
  212. SCM_API SCM scm_ceiling_quotient (SCM x, SCM y);
  213. SCM_API SCM scm_ceiling_remainder (SCM x, SCM y);
  214. SCM_API void scm_truncate_divide (SCM x, SCM y, SCM *q, SCM *r);
  215. SCM_API SCM scm_truncate_quotient (SCM x, SCM y);
  216. SCM_API SCM scm_truncate_remainder (SCM x, SCM y);
  217. SCM_API void scm_centered_divide (SCM x, SCM y, SCM *q, SCM *r);
  218. SCM_API SCM scm_centered_quotient (SCM x, SCM y);
  219. SCM_API SCM scm_centered_remainder (SCM x, SCM y);
  220. SCM_API void scm_round_divide (SCM x, SCM y, SCM *q, SCM *r);
  221. SCM_API SCM scm_round_quotient (SCM x, SCM y);
  222. SCM_API SCM scm_round_remainder (SCM x, SCM y);
  223. SCM_API SCM scm_gcd (SCM x, SCM y);
  224. SCM_API SCM scm_lcm (SCM n1, SCM n2);
  225. SCM_API SCM scm_logand (SCM n1, SCM n2);
  226. SCM_API SCM scm_logior (SCM n1, SCM n2);
  227. SCM_API SCM scm_logxor (SCM n1, SCM n2);
  228. SCM_API SCM scm_logtest (SCM n1, SCM n2);
  229. SCM_API SCM scm_logbit_p (SCM n1, SCM n2);
  230. SCM_API SCM scm_lognot (SCM n);
  231. SCM_API SCM scm_modulo_expt (SCM n, SCM k, SCM m);
  232. SCM_API SCM scm_integer_expt (SCM z1, SCM z2);
  233. SCM_API SCM scm_ash (SCM n, SCM count);
  234. SCM_API SCM scm_round_ash (SCM n, SCM count);
  235. SCM_API SCM scm_bit_extract (SCM n, SCM start, SCM end);
  236. SCM_API SCM scm_logcount (SCM n);
  237. SCM_API SCM scm_integer_length (SCM n);
  238. SCM_INTERNAL SCM scm_i_euclidean_divide (SCM x, SCM y);
  239. SCM_INTERNAL SCM scm_i_floor_divide (SCM x, SCM y);
  240. SCM_INTERNAL SCM scm_i_ceiling_divide (SCM x, SCM y);
  241. SCM_INTERNAL SCM scm_i_truncate_divide (SCM x, SCM y);
  242. SCM_INTERNAL SCM scm_i_centered_divide (SCM x, SCM y);
  243. SCM_INTERNAL SCM scm_i_round_divide (SCM x, SCM y);
  244. SCM_INTERNAL SCM scm_i_gcd (SCM x, SCM y, SCM rest);
  245. SCM_INTERNAL SCM scm_i_lcm (SCM x, SCM y, SCM rest);
  246. SCM_INTERNAL SCM scm_i_logand (SCM x, SCM y, SCM rest);
  247. SCM_INTERNAL SCM scm_i_logior (SCM x, SCM y, SCM rest);
  248. SCM_INTERNAL SCM scm_i_logxor (SCM x, SCM y, SCM rest);
  249. SCM_API size_t scm_iint2str (intmax_t num, int rad, char *p);
  250. SCM_API size_t scm_iuint2str (uintmax_t num, int rad, char *p);
  251. SCM_API SCM scm_number_to_string (SCM x, SCM radix);
  252. SCM_API int scm_print_real (SCM sexp, SCM port, scm_print_state *pstate);
  253. SCM_API int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
  254. SCM_API int scm_bigprint (SCM exp, SCM port, scm_print_state *pstate);
  255. SCM_API SCM scm_c_locale_stringn_to_number (const char *mem, size_t len,
  256. unsigned int radix);
  257. SCM_INTERNAL SCM scm_i_string_to_number (SCM str, unsigned int radix);
  258. SCM_API SCM scm_string_to_number (SCM str, SCM radix);
  259. SCM_API SCM scm_bigequal (SCM x, SCM y);
  260. SCM_API SCM scm_real_equalp (SCM x, SCM y);
  261. SCM_API SCM scm_complex_equalp (SCM x, SCM y);
  262. SCM_INTERNAL int scm_i_heap_numbers_equal_p (SCM x, SCM y);
  263. SCM_API SCM scm_number_p (SCM x);
  264. SCM_API SCM scm_complex_p (SCM x);
  265. SCM_API SCM scm_real_p (SCM x);
  266. SCM_API SCM scm_rational_p (SCM z);
  267. SCM_API SCM scm_integer_p (SCM x);
  268. SCM_API SCM scm_exact_integer_p (SCM x);
  269. SCM_API SCM scm_inexact_p (SCM x);
  270. SCM_API int scm_is_inexact (SCM x);
  271. SCM_API SCM scm_num_eq_p (SCM x, SCM y);
  272. SCM_API SCM scm_less_p (SCM x, SCM y);
  273. SCM_API SCM scm_gr_p (SCM x, SCM y);
  274. SCM_API SCM scm_leq_p (SCM x, SCM y);
  275. SCM_API SCM scm_geq_p (SCM x, SCM y);
  276. SCM_API SCM scm_zero_p (SCM z);
  277. SCM_API SCM scm_positive_p (SCM x);
  278. SCM_API SCM scm_negative_p (SCM x);
  279. SCM_API SCM scm_max (SCM x, SCM y);
  280. SCM_API SCM scm_min (SCM x, SCM y);
  281. SCM_API SCM scm_sum (SCM x, SCM y);
  282. SCM_API SCM scm_oneplus (SCM x);
  283. SCM_API SCM scm_difference (SCM x, SCM y);
  284. SCM_API SCM scm_oneminus (SCM x);
  285. SCM_API SCM scm_product (SCM x, SCM y);
  286. SCM_API SCM scm_divide (SCM x, SCM y);
  287. SCM_API SCM scm_floor (SCM x);
  288. SCM_API SCM scm_ceiling (SCM x);
  289. SCM_API double scm_c_truncate (double x);
  290. SCM_API double scm_c_round (double x);
  291. SCM_API SCM scm_truncate_number (SCM x);
  292. SCM_API SCM scm_round_number (SCM x);
  293. SCM_API SCM scm_expt (SCM z1, SCM z2);
  294. SCM_API SCM scm_sin (SCM z);
  295. SCM_API SCM scm_cos (SCM z);
  296. SCM_API SCM scm_tan (SCM z);
  297. SCM_API SCM scm_sinh (SCM z);
  298. SCM_API SCM scm_cosh (SCM z);
  299. SCM_API SCM scm_tanh (SCM z);
  300. SCM_API SCM scm_asin (SCM z);
  301. SCM_API SCM scm_acos (SCM z);
  302. SCM_API SCM scm_atan (SCM x, SCM y);
  303. SCM_API SCM scm_sys_asinh (SCM z);
  304. SCM_API SCM scm_sys_acosh (SCM z);
  305. SCM_API SCM scm_sys_atanh (SCM z);
  306. SCM_API SCM scm_make_rectangular (SCM z1, SCM z2);
  307. SCM_API SCM scm_make_polar (SCM z1, SCM z2);
  308. SCM_API SCM scm_real_part (SCM z);
  309. SCM_API SCM scm_imag_part (SCM z);
  310. SCM_API SCM scm_magnitude (SCM z);
  311. SCM_API SCM scm_angle (SCM z);
  312. SCM_API SCM scm_exact_to_inexact (SCM z);
  313. SCM_API SCM scm_inexact_to_exact (SCM z);
  314. SCM_API SCM scm_trunc (SCM x);
  315. SCM_API SCM scm_log (SCM z);
  316. SCM_API SCM scm_log10 (SCM z);
  317. SCM_API SCM scm_exp (SCM z);
  318. SCM_API SCM scm_sqrt (SCM z);
  319. SCM_API void scm_exact_integer_sqrt (SCM k, SCM *s, SCM *r);
  320. SCM_INTERNAL SCM scm_i_min (SCM x, SCM y, SCM rest);
  321. SCM_INTERNAL SCM scm_i_max (SCM x, SCM y, SCM rest);
  322. SCM_INTERNAL SCM scm_i_sum (SCM x, SCM y, SCM rest);
  323. SCM_INTERNAL SCM scm_i_difference (SCM x, SCM y, SCM rest);
  324. SCM_INTERNAL SCM scm_i_product (SCM x, SCM y, SCM rest);
  325. SCM_INTERNAL SCM scm_i_divide (SCM x, SCM y, SCM rest);
  326. SCM_INTERNAL SCM scm_i_exact_integer_sqrt (SCM k);
  327. /* bignum internal functions */
  328. SCM_INTERNAL SCM scm_i_mkbig (void);
  329. SCM_API /* FIXME: not internal */ SCM scm_i_normbig (SCM x);
  330. SCM_INTERNAL int scm_i_bigcmp (SCM a, SCM b);
  331. SCM_INTERNAL SCM scm_i_dbl2big (double d);
  332. SCM_INTERNAL SCM scm_i_dbl2num (double d);
  333. SCM_API /* FIXME: not internal */ double scm_i_big2dbl (SCM b);
  334. SCM_API /* FIXME: not internal */ SCM scm_i_long2big (long n);
  335. SCM_API /* FIXME: not internal */ SCM scm_i_ulong2big (unsigned long n);
  336. SCM_API /* FIXME: not internal */ SCM scm_i_clonebig (SCM src_big, int same_sign_p);
  337. /* ratio functions */
  338. SCM_API SCM scm_rationalize (SCM x, SCM err);
  339. SCM_API SCM scm_numerator (SCM z);
  340. SCM_API SCM scm_denominator (SCM z);
  341. /* fraction internal functions */
  342. SCM_INTERNAL double scm_i_fraction2double (SCM z);
  343. SCM_INTERNAL SCM scm_i_fraction_equalp (SCM x, SCM y);
  344. SCM_INTERNAL int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate);
  345. /* general internal functions */
  346. SCM_INTERNAL void scm_i_print_double (double val, SCM port);
  347. SCM_INTERNAL void scm_i_print_complex (double real, double imag, SCM port);
  348. /* conversion functions for integers */
  349. SCM_API int scm_is_integer (SCM val);
  350. SCM_API int scm_is_exact_integer (SCM val);
  351. SCM_API int scm_is_signed_integer (SCM val,
  352. intmax_t min, intmax_t max);
  353. SCM_API int scm_is_unsigned_integer (SCM val,
  354. uintmax_t min, uintmax_t max);
  355. SCM_API SCM scm_from_signed_integer (intmax_t val);
  356. SCM_API SCM scm_from_unsigned_integer (uintmax_t val);
  357. SCM_API intmax_t scm_to_signed_integer (SCM val,
  358. intmax_t min,
  359. intmax_t max);
  360. SCM_API uintmax_t scm_to_unsigned_integer (SCM val,
  361. uintmax_t min,
  362. uintmax_t max);
  363. SCM_API int8_t scm_to_int8 (SCM x);
  364. SCM_API SCM scm_from_int8 (int8_t x);
  365. SCM_API uint8_t scm_to_uint8 (SCM x);
  366. SCM_API SCM scm_from_uint8 (uint8_t x);
  367. SCM_API int16_t scm_to_int16 (SCM x);
  368. SCM_API SCM scm_from_int16 (int16_t x);
  369. SCM_API uint16_t scm_to_uint16 (SCM x);
  370. SCM_API SCM scm_from_uint16 (uint16_t x);
  371. SCM_API int32_t scm_to_int32 (SCM x);
  372. SCM_API SCM scm_from_int32 (int32_t x);
  373. SCM_API uint32_t scm_to_uint32 (SCM x);
  374. SCM_API SCM scm_from_uint32 (uint32_t x);
  375. SCM_API scm_t_wchar scm_to_wchar (SCM x);
  376. SCM_API SCM scm_from_wchar (scm_t_wchar x);
  377. SCM_API int64_t scm_to_int64 (SCM x);
  378. SCM_API SCM scm_from_int64 (int64_t x);
  379. SCM_API uint64_t scm_to_uint64 (SCM x);
  380. SCM_API SCM scm_from_uint64 (uint64_t x);
  381. SCM_API void scm_to_mpz (SCM x, mpz_t rop);
  382. SCM_API SCM scm_from_mpz (mpz_t rop);
  383. /* The conversion functions for other types are aliased to the
  384. appropriate ones from above. We pick the right one based on the
  385. size of the type.
  386. Not each and every possibility is covered by the code below, and
  387. while it is trivial to complete the tests, it might be better to
  388. just test for the 'sane' possibilities. When one of the tests
  389. below fails, chances are good that some silent assumption somewhere
  390. else will also fail.
  391. */
  392. #if SCM_SIZEOF_CHAR == 1
  393. #define scm_to_schar scm_to_int8
  394. #define scm_from_schar scm_from_int8
  395. #define scm_to_uchar scm_to_uint8
  396. #define scm_from_uchar scm_from_uint8
  397. #if CHAR_MIN == 0
  398. #define scm_to_char scm_to_uint8
  399. #define scm_from_char scm_from_uint8
  400. #else
  401. #define scm_to_char scm_to_int8
  402. #define scm_from_char scm_from_int8
  403. #endif
  404. #else
  405. #error sizeof(char) is not 1.
  406. #endif
  407. #if SCM_SIZEOF_SHORT == 1
  408. #define scm_to_short scm_to_int8
  409. #define scm_from_short scm_from_int8
  410. #define scm_to_ushort scm_to_uint8
  411. #define scm_from_ushort scm_from_uint8
  412. #else
  413. #if SCM_SIZEOF_SHORT == 2
  414. #define scm_to_short scm_to_int16
  415. #define scm_from_short scm_from_int16
  416. #define scm_to_ushort scm_to_uint16
  417. #define scm_from_ushort scm_from_uint16
  418. #else
  419. #if SCM_SIZEOF_SHORT == 4
  420. #define scm_to_short scm_to_int32
  421. #define scm_from_short scm_from_int32
  422. #define scm_to_ushort scm_to_uint32
  423. #define scm_from_ushort scm_from_uint32
  424. #else
  425. #error sizeof(short) is not 1, 2, or 4.
  426. #endif
  427. #endif
  428. #endif
  429. #if SCM_SIZEOF_INT == 4
  430. #define scm_to_int scm_to_int32
  431. #define scm_from_int scm_from_int32
  432. #define scm_to_uint scm_to_uint32
  433. #define scm_from_uint scm_from_uint32
  434. #else
  435. #if SCM_SIZEOF_INT == 8
  436. #define scm_to_int scm_to_int64
  437. #define scm_from_int scm_from_int64
  438. #define scm_to_uint scm_to_uint64
  439. #define scm_from_uint scm_from_uint64
  440. #else
  441. #error sizeof(int) is not 4 or 8.
  442. #endif
  443. #endif
  444. #if SCM_SIZEOF_LONG == 4
  445. #define scm_to_long scm_to_int32
  446. #define scm_from_long scm_from_int32
  447. #define scm_to_ulong scm_to_uint32
  448. #define scm_from_ulong scm_from_uint32
  449. #else
  450. #if SCM_SIZEOF_LONG == 8
  451. #define scm_to_long scm_to_int64
  452. #define scm_from_long scm_from_int64
  453. #define scm_to_ulong scm_to_uint64
  454. #define scm_from_ulong scm_from_uint64
  455. #else
  456. #error sizeof(long) is not 4 or 8.
  457. #endif
  458. #endif
  459. #if SCM_SIZEOF_INTMAX == 4
  460. #define scm_to_intmax scm_to_int32
  461. #define scm_from_intmax scm_from_int32
  462. #define scm_to_uintmax scm_to_uint32
  463. #define scm_from_uintmax scm_from_uint32
  464. #else
  465. #if SCM_SIZEOF_INTMAX == 8
  466. #define scm_to_intmax scm_to_int64
  467. #define scm_from_intmax scm_from_int64
  468. #define scm_to_uintmax scm_to_uint64
  469. #define scm_from_uintmax scm_from_uint64
  470. #else
  471. #error sizeof(intmax_t) is not 4 or 8.
  472. #endif
  473. #endif
  474. #if SCM_SIZEOF_LONG_LONG == 0
  475. #else
  476. #if SCM_SIZEOF_LONG_LONG == 8
  477. #define scm_to_long_long scm_to_int64
  478. #define scm_from_long_long scm_from_int64
  479. #define scm_to_ulong_long scm_to_uint64
  480. #define scm_from_ulong_long scm_from_uint64
  481. #else
  482. #error sizeof(long long) is not 8.
  483. #endif
  484. #endif
  485. #if SCM_SIZEOF_SIZE_T == 4
  486. #define scm_to_ssize_t scm_to_int32
  487. #define scm_from_ssize_t scm_from_int32
  488. #define scm_to_size_t scm_to_uint32
  489. #define scm_from_size_t scm_from_uint32
  490. #else
  491. #if SCM_SIZEOF_SIZE_T == 8
  492. #define scm_to_ssize_t scm_to_int64
  493. #define scm_from_ssize_t scm_from_int64
  494. #define scm_to_size_t scm_to_uint64
  495. #define scm_from_size_t scm_from_uint64
  496. #else
  497. #error sizeof(size_t) is not 4 or 8.
  498. #endif
  499. #endif
  500. #if SCM_SIZEOF_SCM_T_PTRDIFF == 4
  501. #define scm_to_ptrdiff_t scm_to_int32
  502. #define scm_from_ptrdiff_t scm_from_int32
  503. #else
  504. #if SCM_SIZEOF_SCM_T_PTRDIFF == 8
  505. #define scm_to_ptrdiff_t scm_to_int64
  506. #define scm_from_ptrdiff_t scm_from_int64
  507. #else
  508. #error sizeof(ptrdiff_t) is not 4 or 8.
  509. #endif
  510. #endif
  511. #if SCM_SIZEOF_INTPTR_T == 0
  512. /* No intptr_t; use size_t functions. */
  513. #define scm_to_intptr_t scm_to_ssize_t
  514. #define scm_from_intptr_t scm_from_ssize_t
  515. #elif SCM_SIZEOF_INTPTR_T == 4
  516. #define scm_to_intptr_t scm_to_int32
  517. #define scm_from_intptr_t scm_from_int32
  518. #elif SCM_SIZEOF_INTPTR_T == 8
  519. #define scm_to_intptr_t scm_to_int64
  520. #define scm_from_intptr_t scm_from_int64
  521. #else
  522. #error sizeof(intptr_t) is not 4 or 8.
  523. #endif
  524. #if SCM_SIZEOF_UINTPTR_T == 0
  525. /* No uintptr_t; use size_t functions. */
  526. #define scm_to_uintptr_t scm_to_size_t
  527. #define scm_from_uintptr_t scm_from_size_t
  528. #elif SCM_SIZEOF_UINTPTR_T == 4
  529. #define scm_to_uintptr_t scm_to_uint32
  530. #define scm_from_uintptr_t scm_from_uint32
  531. #elif SCM_SIZEOF_UINTPTR_T == 8
  532. #define scm_to_uintptr_t scm_to_uint64
  533. #define scm_from_uintptr_t scm_from_uint64
  534. #else
  535. #error sizeof(uintptr_t) is not 4 or 8.
  536. #endif
  537. /* conversion functions for double */
  538. SCM_API int scm_is_real (SCM val);
  539. SCM_API int scm_is_rational (SCM val);
  540. SCM_API double scm_to_double (SCM val);
  541. SCM_API SCM scm_from_double (double val);
  542. /* conversion functions for complex */
  543. SCM_API int scm_is_complex (SCM val);
  544. SCM_API SCM scm_c_make_rectangular (double re, double im);
  545. SCM_API SCM scm_c_make_polar (double mag, double ang);
  546. SCM_API double scm_c_real_part (SCM z);
  547. SCM_API double scm_c_imag_part (SCM z);
  548. SCM_API double scm_c_magnitude (SCM z);
  549. SCM_API double scm_c_angle (SCM z);
  550. SCM_API int scm_is_number (SCM val);
  551. /* If nonzero, tell gmp to use GC_malloc for its allocations. */
  552. SCM_API int scm_install_gmp_memory_functions;
  553. SCM_INTERNAL void scm_init_numbers (void);
  554. #define SCM_NUM2SIZE(pos, arg) (scm_to_size_t (arg))
  555. #define SCM_NUM2SIZE_DEF(pos, arg, def) \
  556. (SCM_UNBNDP (arg) ? def : scm_to_size_t (arg))
  557. #define SCM_NUM2PTRDIFF(pos, arg) (scm_to_ssize_t (arg))
  558. #define SCM_NUM2PTRDIFF_DEF(pos, arg, def) \
  559. (SCM_UNBNDP (arg) ? def : scm_to_ssize_t (arg))
  560. #define SCM_NUM2SHORT(pos, arg) (scm_to_short (arg))
  561. #define SCM_NUM2SHORT_DEF(pos, arg, def) \
  562. (SCM_UNBNDP (arg) ? def : scm_to_short (arg))
  563. #define SCM_NUM2USHORT(pos, arg) (scm_to_ushort (arg))
  564. #define SCM_NUM2USHORT_DEF(pos, arg, def) \
  565. (SCM_UNBNDP (arg) ? def : scm_to_ushort (arg))
  566. #define SCM_NUM2INT(pos, arg) (scm_to_int (arg))
  567. #define SCM_NUM2INT_DEF(pos, arg, def) \
  568. (SCM_UNBNDP (arg) ? def : scm_to_int (arg))
  569. #define SCM_NUM2UINT(pos, arg) (scm_to_uint (arg))
  570. #define SCM_NUM2UINT_DEF(pos, arg, def) \
  571. (SCM_UNBNDP (arg) ? def : scm_to_uint (arg))
  572. #define SCM_NUM2ULONG(pos, arg) (scm_to_ulong (arg))
  573. #define SCM_NUM2ULONG_DEF(pos, arg, def) \
  574. (SCM_UNBNDP (arg) ? def : scm_to_ulong (arg))
  575. #define SCM_NUM2LONG(pos, arg) (scm_to_long (arg))
  576. #define SCM_NUM2LONG_DEF(pos, arg, def) \
  577. (SCM_UNBNDP (arg) ? def : scm_to_long (arg))
  578. #define SCM_NUM2LONG_LONG(pos, arg) (scm_to_long_long (arg))
  579. #define SCM_NUM2LONG_LONG_DEF(pos, arg, def) \
  580. (SCM_UNBNDP (arg) ? def : scm_to_long_long (arg))
  581. #define SCM_NUM2ULONG_LONG(pos, arg) (scm_to_ulong_long (arg))
  582. #define SCM_NUM2ULONG_LONG_DEF(pos, arg, def) \
  583. (SCM_UNBNDP (arg) ? def : scm_to_ulong_long (arg))
  584. #define SCM_NUM2SIZE(pos, arg) (scm_to_size_t (arg))
  585. #define SCM_NUM2FLOAT(pos, arg) ((float) scm_to_double (arg))
  586. #define SCM_NUM2DOUBLE(pos, arg) (scm_to_double (arg))
  587. #define SCM_OUT_OF_RANGE(pos, arg) \
  588. do { scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } while (0)
  589. #define SCM_ASSERT_RANGE(pos, arg, f) \
  590. do { if (SCM_UNLIKELY (!(f))) \
  591. scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } \
  592. while (0)
  593. #define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, REALP, "real")
  594. #define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, NUMBERP, "number")
  595. #define SCM_VALIDATE_USHORT_COPY(pos, k, cvar) \
  596. do { \
  597. cvar = SCM_NUM2USHORT (pos, k); \
  598. } while (0)
  599. #define SCM_VALIDATE_SHORT_COPY(pos, k, cvar) \
  600. do { \
  601. cvar = SCM_NUM2SHORT (pos, k); \
  602. } while (0)
  603. #define SCM_VALIDATE_UINT_COPY(pos, k, cvar) \
  604. do { \
  605. cvar = SCM_NUM2UINT (pos, k); \
  606. } while (0)
  607. #define SCM_VALIDATE_INT_COPY(pos, k, cvar) \
  608. do { \
  609. cvar = SCM_NUM2INT (pos, k); \
  610. } while (0)
  611. #define SCM_VALIDATE_ULONG_COPY(pos, k, cvar) \
  612. do { \
  613. cvar = SCM_NUM2ULONG (pos, k); \
  614. } while (0)
  615. #define SCM_VALIDATE_LONG_COPY(pos, k, cvar) \
  616. do { \
  617. cvar = SCM_NUM2LONG (pos, k); \
  618. } while (0)
  619. #define SCM_VALIDATE_SIZE_COPY(pos, k, cvar) \
  620. do { \
  621. cvar = SCM_NUM2SIZE (pos, k); \
  622. } while (0)
  623. #define SCM_VALIDATE_FLOAT_COPY(pos, k, cvar) \
  624. do { \
  625. cvar = SCM_NUM2FLOAT (pos, k); \
  626. } while (0)
  627. #define SCM_VALIDATE_DOUBLE_COPY(pos, k, cvar) \
  628. do { \
  629. cvar = SCM_NUM2DOUBLE (pos, k); \
  630. } while (0)
  631. #define SCM_VALIDATE_DOUBLE_DEF_COPY(pos, k, default, cvar) \
  632. do { \
  633. if (SCM_UNBNDP (k)) \
  634. { \
  635. k = scm_make_real (default); \
  636. cvar = default; \
  637. } \
  638. else \
  639. { \
  640. cvar = SCM_NUM2DOUBLE (pos, k); \
  641. } \
  642. } while (0)
  643. #endif /* SCM_NUMBERS_H */