diff --git a/.gitignore b/.gitignore index ccefbafd..1032db97 100644 --- a/.gitignore +++ b/.gitignore @@ -26,3 +26,4 @@ node_modules/ result* .envrc .direnv/ +tests/resources/hashlib-test-large-local.txt diff --git a/devel/200_21.md b/devel/200_21.md index a83b1cfc..ae437b9f 100644 --- a/devel/200_21.md +++ b/devel/200_21.md @@ -13,6 +13,8 @@ xmake build bin/goldfish tests/test_all.scm ``` +## 2026/02/14 将 nan? 从 s7.c 迁移至 s7_r7rs.c + ## 2026/02/14 将 sqrt 从 s7.c 迁移至 s7_r7rs.c ## 2026/02/13 移除 file-exists? 在 s7.c 中的相关代码 diff --git a/src/s7.c b/src/s7.c index 6749c882..e9d08cc1 100644 --- a/src/s7.c +++ b/src/s7.c @@ -25528,30 +25528,7 @@ static bool is_float_b(s7_pointer x) {return(is_t_real(x));} /* ---------------------------------------- nan? ---------------------------------------- */ static bool is_nan_b_7p(s7_scheme *sc, s7_pointer x) { - if (is_t_real(x)) return(is_NaN(real(x))); - switch (type(x)) - { - case T_INTEGER: - case T_RATIO: return(false); - case T_COMPLEX: return((is_NaN(real_part(x))) || (is_NaN(imag_part(x)))); -#if WITH_GMP - case T_BIG_INTEGER: - case T_BIG_RATIO: return(false); - case T_BIG_REAL: return(mpfr_nan_p(big_real(x)) != 0); - case T_BIG_COMPLEX: return((mpfr_nan_p(mpc_realref(big_complex(x))) != 0) || (mpfr_nan_p(mpc_imagref(big_complex(x))) != 0)); -#endif - default: - if (is_number(x)) - return(method_or_bust_p(sc, x, sc->is_nan_symbol, a_number_string) != sc->F); - } - return(false); -} - -static s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args) -{ - #define H_is_nan "(nan? obj) returns #t if obj is a NaN" - #define Q_is_nan sc->pl_bt - return(make_boolean(sc, is_nan_b_7p(sc, car(args)))); + return s7_is_nan(sc, x); } @@ -100427,7 +100404,7 @@ static void init_rootlet(s7_scheme *sc) sc->is_positive_symbol = defun("positive?", is_positive, 1, 0, false); sc->is_negative_symbol = defun("negative?", is_negative, 1, 0, false); sc->is_infinite_symbol = defun("infinite?", is_infinite, 1, 0, false); - sc->is_nan_symbol = defun("nan?", is_nan, 1, 0, false); + sc->is_nan_symbol = s7_define_typed_function(sc, "nan?", g_is_nan, 1, 0, false, "(nan? obj) returns #t if obj is a NaN", sc->pl_bt); sc->complex_symbol = defun("complex", complex, 2, 0, false); sc->add_symbol = defun("+", add, 0, 0, true); set_all_integer_and_float(sc->add_symbol); diff --git a/src/s7_r7rs.c b/src/s7_r7rs.c index 83d59b71..2bc4f56c 100644 --- a/src/s7_r7rs.c +++ b/src/s7_r7rs.c @@ -117,3 +117,24 @@ s7_pointer g_sqrt(s7_scheme *sc, s7_pointer args) #define Q_sqrt sc->pl_nn return(sqrt_p_p(sc, s7_car(args))); } + +/* ---------------------------------------- nan? ---------------------------------------- */ +bool s7_is_nan(s7_scheme *sc, s7_pointer x) +{ + if (s7_is_real(x)) + { + if (s7_is_integer(x) || s7_is_rational(x)) + return false; + return is_NaN(s7_real(x)); + } + if (s7_is_complex(x)) + return is_NaN(s7_real_part(x)) || is_NaN(s7_imag_part(x)); + return false; +} + +s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args) +{ + #define H_is_nan "(nan? obj) returns #t if obj is a NaN" + #define Q_is_nan sc->pl_bt + return s7_make_boolean(sc, s7_is_nan(sc, s7_car(args))); +} diff --git a/src/s7_r7rs.h b/src/s7_r7rs.h index 7b5e44e2..01fbd0eb 100644 --- a/src/s7_r7rs.h +++ b/src/s7_r7rs.h @@ -22,6 +22,10 @@ bool is_NaN(s7_double x); s7_pointer sqrt_p_p(s7_scheme *sc, s7_pointer num); s7_pointer g_sqrt(s7_scheme *sc, s7_pointer args); +/* nan? function */ +bool s7_is_nan(s7_scheme *sc, s7_pointer x); +s7_pointer g_is_nan(s7_scheme *sc, s7_pointer args); + /* R7RS Scheme code string */ extern const char r7rs_scm[];