[200_21] 将 nan? 相关代码迁移到 s7_r7rs.c

.gitignore

@@ -26,3 +26,4 @@ node_modules/
 result*
 .envrc
 .direnv/
+tests/resources/hashlib-test-large-local.txt

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 中的相关代码

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);

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)));
+}

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[];