[0055] 将 s7.c 中的 complex 相关内置函数迁移到 s7_scheme_complex.c

devel/0055.md

@@ -0,0 +1,91 @@
+# [0055] 将 s7.c 中的 complex 相关内置函数迁移到 s7_scheme_complex.c
+
+## 相关文档
+- [dddd.md](dddd.md) - 任务文档模板
+
+## 任务相关的代码文件
+- src/s7.c
+- src/s7_scheme_complex.c
+- src/s7_scheme_complex.h
+- src/s7_internal_helpers.h
+- src/s7_scheme_inexact.c
+
+## 如何测试
+
+### 确定性测试（单元测试）
+```bash
+xmake b goldfish
+
+# complex? 类型判断测试
+bin/gf tests/scheme/base/complex-p-test.scm
+
+# scheme complex 库函数测试
+bin/gf tests/scheme/complex/angle-test.scm
+bin/gf tests/scheme/complex/imag-part-test.scm
+bin/gf tests/scheme/complex/magnitude-test.scm
+bin/gf tests/scheme/complex/make-polar-test.scm
+bin/gf tests/scheme/complex/make-rectangular-test.scm
+bin/gf tests/scheme/complex/real-part-test.scm
+
+# 复数向量测试
+bin/gf tests/liii/vector/complex-vector-test.scm
+bin/gf tests/liii/vector/complex-vector-p-test.scm
+bin/gf tests/liii/vector/complex-vector-ref-test.scm
+bin/gf tests/liii/vector/complex-vector-set-bang-test.scm
+bin/gf tests/liii/vector/make-complex-vector-test.scm
+
+# inexact 数学函数测试（依赖复数辅助函数）
+bin/gf tests/scheme/inexact/acos-test.scm
+bin/gf tests/scheme/inexact/asin-test.scm
+bin/gf tests/scheme/inexact/cos-test.scm
+bin/gf tests/scheme/inexact/exp-test.scm
+bin/gf tests/scheme/inexact/log-test.scm
+bin/gf tests/scheme/inexact/sin-test.scm
+bin/gf tests/scheme/inexact/sqrt-test.scm
+bin/gf tests/scheme/inexact/tan-test.scm
+```
+
+## 2026-05-29 迁移 complex 相关内置函数到 s7_scheme_complex.c
+
+### What
+1. 迁移 `g_is_complex`（`complex?` 内置函数）到 `s7_scheme_complex.c`
+2. 暴露 `s7i_apply_boolean_method` 和 `s7i_is_complex_symbol` 到 `s7_internal_helpers.h`，以支持 `g_is_complex` 的跨文件实现
+3. 迁移 OpenBSD/NetBSD 复数反双曲函数备用实现 `casinh_1`、`cacosh_1`、`catanh_1` 到 `s7_scheme_complex.c`，并暴露为 `s7i_casinh_1`、`s7i_cacosh_1`、`s7i_catanh_1`
+4. 更新 `s7_scheme_inexact.c` 使用 `s7i_casinh_1` 等函数，修复潜在的跨文件链接问题
+5. 迁移 C 复数数学辅助函数备用实现（`clog`、`cpow`、`cexp`、`csin`、`ccos`、`csinh`、`ccosh` 等）到 `s7_scheme_complex.c`
+
+### Why
+- 将 complex 相关代码集中到 `s7_scheme_complex.c`，减少 `s7.c` 的体积
+- 解决 OpenBSD/NetBSD 下 `casinh_1` 等 static 函数无法被 `s7_scheme_inexact.c` 链接的潜在问题
+- 与已有的 `s7_scheme_inexact.c`、`s7_scheme_base.c` 等拆分文件保持一致风格
+
+### How
+- `g_is_complex` 原实现依赖 `check_boolean_method` 宏和 `apply_boolean_method` static 函数，迁移后重写为直接使用公开 API（`s7_is_number`、`s7_t`、`s7_f`）和暴露的内部辅助函数
+- `casinh_1` 等非标准 C 函数使用 `s7i_` 前缀暴露，避免与 libm 的标准复数函数命名冲突
+- 标准 C 复数数学辅助函数（`clog`、`cpow` 等）作为 static 备用实现保留在 `s7_scheme_complex.c` 中，仅在 `!HAVE_COMPLEX_TRIG` 平台下编译
+- 复数标量函数（`complex?`、`magnitude`、`angle`、`make-polar`、`real-part`、`imag-part`、`make-rectangular`）已全部迁移到 `s7_scheme_complex.c` 或 `s7_liii_vector.c`
+
+### 未迁移的复数向量函数
+
+以下函数因深度耦合 `s7.c` 的共享向量基础设施，保留在 `s7.c` 中：
+
+1. **`g_complex_vector_ref`、`g_complex_vector_set`**
+   - 依赖 `univect_ref` / `univect_set`，这两个函数是 `s7.c` 内部静态函数，处理所有专用向量类型（float/int/byte/complex）的多维索引、越界检查、子向量生成和方法分派
+   - 若迁移需将 `univect_ref` / `univect_set` 暴露为跨文件符号，影响所有向量类型
+
+2. **`g_cv_ref_2`、`g_cv_set_3` 及优化变体（`complex_vector_ref_p_pp`、`complex_vector_set_p_pip` 等）**
+   - 深度集成在 `s7.c` 的优化器（`opt_info` 体系）中，作为直接函数指针被赋值给 opcode
+   - 若迁移需暴露大量优化器内部类型和静态函数
+
+3. **`g_make_complex_vector`**
+   - 直接调用 `mallocate_vector`、`new_cell`、`make_vector_1`、`complex_vector_fill`、`make_multivector`、`add_vector` 等内存分配和向量管理内部函数
+   - 若迁移需暴露整个向量内存分配子系统
+
+4. **内部辅助函数（`complex_vector_getter`、`complex_vector_setter`、`complex_vector_fill`）**
+   - 作为函数指针直接赋值给向量对象的 `vector_getter` / `vector_setter` 字段
+   - 与 `s7.c` 的向量创建流程强绑定
+
+5. **`complex_vector_equal`、`complex_vector_to_port`、`complex_vector_iterate_*`**
+   - 分别耦合 `vector_equal` / `base_vector_equal`、端口输出系统、迭代器状态机
+
+**结论**：复数向量的 `ref`/`set`/`make` 等内置函数与 `float-vector-ref`、`int-vector-ref`、`byte-vector-ref` 遵循相同的架构模式，均保留在 `s7.c` 中。已迁移的复数向量相关函数仅包括 `g_is_complex_vector` 和 `g_complex_vector`（构造函数），二者已位于 `s7_liii_vector.c`。

src/s7.c

@@ -436,16 +436,6 @@
   #endif
 #endif
 
-#if WITH_CLANG_PP
-  #define s7_complex_i ((double)1.0i)
-#else
-#if (defined(__GNUC__))
-  #define s7_complex_i 1.0i
-#else
-  #define s7_complex_i (s7_complex)_Complex_I /* a float, but we want a double */
-#endif
-#endif
-
 #ifndef M_PI
   #define M_PI 3.1415926535897932384626433832795029L
 #endif
@@ -6499,6 +6489,16 @@ static s7_pointer apply_boolean_method(s7_scheme *sc, s7_pointer obj, s7_pointer
   return(s7_apply_function(sc, func, set_mlist_1(sc, obj))); /* plist here and below will probably not work (_pp case known bad) */
 }
 
+s7_pointer s7i_apply_boolean_method(s7_scheme *sc, s7_pointer obj, s7_pointer method)
+{
+  return(apply_boolean_method(sc, obj, method));
+}
+
+s7_pointer s7i_is_complex_symbol(s7_scheme *sc)
+{
+  return(sc->is_complex_symbol);
+}
+
 /* this is a macro mainly to simplify the Checker handling */
 #define check_boolean_method(Sc, Checker, Method, Args)	       \
   {							       \
@@ -13204,113 +13204,6 @@ static s7_pointer g_nan_payload(s7_scheme *sc, s7_pointer args)
 /* for g_log, we also need round. this version is from stackoverflow, see also r5rs_round below */
 static double s7_round(double number) {return((number < 0.0) ? ceil(number - 0.5) : floor(number + 0.5));}
 
-#if HAVE_COMPLEX_NUMBERS
-#if __cplusplus
-  #define _Complex_I (complex<s7_double>(0.0, 1.0))
-  #define creal(x) Real(x)
-  #define cimag(x) Imag(x)
-  #define carg(x) arg(x)
-  #define cabs(x) abs(x)
-  #define csqrt(x) sqrt(x)
-  #define cpow(x, y) pow(x, y)
-  #define clog(x) log(x)
-  #define cexp(x) exp(x)
-  #define csin(x) sin(x)
-  #define ccos(x) cos(x)
-  #define ctan(x) tan(x)
-  #define csinh(x) sinh(x)
-  #define ccosh(x) cosh(x)
-  #define ctanh(x) tanh(x)
-  #define casin(x) asin(x)
-  #define cacos(x) acos(x)
-  #define catan(x) atan(x)
-  #define casinh(x) asinh(x)
-  #define cacosh(x) acosh(x)
-  #define catanh(x) atanh(x)
-#endif
-
-
-#if !HAVE_COMPLEX_TRIG
-#if __cplusplus
-
-  static s7_complex ctan(s7_complex z)   {return(csin(z) / ccos(z));}
-  static s7_complex ctanh(s7_complex z)  {return(csinh(z) / ccosh(z));}
-  static s7_complex casin(s7_complex z)  {return(-s7_complex_i * clog(s7_complex_i * z + csqrt(1.0 - z * z)));}
-  static s7_complex cacos(s7_complex z)  {return(-s7_complex_i * clog(z + s7_complex_i * csqrt(1.0 - z * z)));}
-  static s7_complex catan(s7_complex z)  {return(s7_complex_i * clog((s7_complex_i + z) / (s7_complex_i - z)) / 2.0);}
-  static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
-  static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
-  static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
-#else
-
-#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 12)
-static s7_complex clog(s7_complex z) {return(log(fabs(cabs(z))) + carg(z) * s7_complex_i);}
-static s7_complex cpow(s7_complex x, s7_complex y)
-{
-  s7_double r = cabs(x);
-  s7_double theta = carg(x);
-  s7_double yre = creal(y);
-  s7_double yim = cimag(y);
-  s7_double nr = exp(yre * log(r) - yim * theta);
-  s7_double ntheta = yre * theta + yim * log(r);
-  return(nr * cos(ntheta) + (nr * sin(ntheta)) * s7_complex_i);
-}
-#endif
-#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 9) /* untested -- this orignally looked at __FreeBSD_version which apparently no longer exists */
-  static s7_complex cexp(s7_complex z) {return(exp(creal(z)) * cos(cimag(z)) + (exp(creal(z)) * sin(cimag(z))) * s7_complex_i);}
-#endif
-
-#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 10)
-  static s7_complex csin(s7_complex z)   {return(sin(creal(z)) * cosh(cimag(z)) + (cos(creal(z)) * sinh(cimag(z))) * s7_complex_i);}
-  static s7_complex ccos(s7_complex z)   {return(cos(creal(z)) * cosh(cimag(z)) + (-sin(creal(z)) * sinh(cimag(z))) * s7_complex_i);}
-  static s7_complex csinh(s7_complex z)  {return(sinh(creal(z)) * cos(cimag(z)) + (cosh(creal(z)) * sin(cimag(z))) * s7_complex_i);}
-  static s7_complex ccosh(s7_complex z)  {return(cosh(creal(z)) * cos(cimag(z)) + (sinh(creal(z)) * sin(cimag(z))) * s7_complex_i);}
-  static s7_complex ctan(s7_complex z)   {return(csin(z) / ccos(z));}
-  static s7_complex ctanh(s7_complex z)  {return(csinh(z) / ccosh(z));}
-  static s7_complex casin(s7_complex z)  {return(-s7_complex_i * clog(s7_complex_i * z + csqrt(1.0 - z * z)));}
-  static s7_complex cacos(s7_complex z)  {return(-s7_complex_i * clog(z + s7_complex_i * csqrt(1.0 - z * z)));}
-  static s7_complex catan(s7_complex z)  {return(s7_complex_i * clog((s7_complex_i + z) / (s7_complex_i - z)) / 2.0);}
-  static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
-  static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
-  static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
-#endif /* not FreeBSD 10 */
-#endif /* not c++ */
-#endif /* not HAVE_COMPLEX_TRIG */
-
-#else  /* not HAVE_COMPLEX_NUMBERS */
-  #define _Complex_I 1.0
-  #define creal(x) 0.0
-  #define cimag(x) 0.0
-  #define csin(x) sin(x)
-  #define casin(x) x
-  #define ccos(x) cos(x)
-  #define cacos(x) x
-  #define ctan(x) x
-  #define catan(x) x
-  #define csinh(x) x
-  #define casinh(x) x
-  #define ccosh(x) x
-  #define cacosh(x) x
-  #define ctanh(x) x
-  #define catanh(x) x
-  #define cexp(x) exp(x)
-  #define cpow(x, y) pow(x, y)
-  #define clog(x) log(x)
-  #define csqrt(x) sqrt(x)
-  #define conj(x) x
-#endif
-
-#ifdef __OpenBSD__
-  /* openbsd's builtin versions of these functions are not usable */
-  static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
-  static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
-  static s7_complex cacosh_1(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
-#endif
-#ifdef __NetBSD__
-  static s7_complex catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
-  static s7_complex casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
-#endif
-
 bool s7_is_number(s7_pointer p)   {return(is_number(p));}
 bool s7_is_complex(s7_pointer p)  {return(is_number(p));}
 bool s7_is_real(s7_pointer p)     {return(is_real(p));}
@@ -18829,12 +18722,9 @@ static s7_pointer g_is_real(s7_scheme *sc, s7_pointer args)
   check_boolean_method(sc, is_real, sc->is_real_symbol, args);
 }
 
-static s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args)
-{
-  #define H_is_complex "(complex? obj) returns #t if obj is a number"
-  #define Q_is_complex sc->pl_bt
-  check_boolean_method(sc, is_number, sc->is_complex_symbol, args);
-}
+#define H_is_complex "(complex? obj) returns #t if obj is a number"
+#define Q_is_complex sc->pl_bt
+
 
 static s7_pointer g_is_rational(s7_scheme *sc, s7_pointer args)
 {

src/s7_internal_helpers.h

@@ -28,6 +28,8 @@ bool s7i_sequence_is_empty(s7_scheme *sc, s7_pointer seq);
 s7_int s7i_sequence_length(s7_scheme *sc, s7_pointer seq);
 s7_pointer s7i_find_method_with_let(s7_scheme *sc, s7_pointer obj, s7_pointer method);
 bool s7i_has_active_methods(s7_scheme *sc, s7_pointer obj);
+s7_pointer s7i_apply_boolean_method(s7_scheme *sc, s7_pointer obj, s7_pointer method);
+s7_pointer s7i_is_complex_symbol(s7_scheme *sc);
 void s7i_wrong_type_error_nr(s7_scheme *sc, s7_pointer caller, s7_int arg_num, s7_pointer arg, s7_pointer typ);
 s7_pointer s7i_copy_1(s7_scheme *sc, s7_pointer caller, s7_pointer args);
 s7_pointer s7i_copy_proper_list(s7_scheme *sc, s7_pointer lst);

src/s7_scheme_complex.c

@@ -7,8 +7,17 @@
  */
 
 #include "s7_scheme_complex.h"
+#include "s7_internal_helpers.h"
 #include <math.h>
 
+#ifndef HAVE_COMPLEX_NUMBERS
+  #if __TINYC__ || (__clang__ && __cplusplus)
+    #define HAVE_COMPLEX_NUMBERS 0
+  #else
+    #define HAVE_COMPLEX_NUMBERS 1
+  #endif
+#endif
+
 #ifndef M_PI
   #define M_PI 3.1415926535897932384626433832795029L
 #endif
@@ -172,3 +181,103 @@ s7_pointer g_imag_part(s7_scheme *sc, s7_pointer args)
   s7_pointer x = s7_car(args);
   return imag_part_p_p(sc, x);
 }
+
+s7_pointer g_is_complex(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer p = s7_car(args);
+  if (s7_is_number(p)) return(s7_t(sc));
+  if (!s7i_has_active_methods(sc, p)) return(s7_f(sc));
+  return(s7i_apply_boolean_method(sc, p, s7i_is_complex_symbol(sc)));
+}
+
+#if HAVE_COMPLEX_NUMBERS
+
+#ifndef s7_complex_i
+  #define s7_complex_i (s7_complex)_Complex_I
+#endif
+
+/* OpenBSD/NetBSD fallbacks for complex inverse hyperbolic functions */
+s7_complex s7i_catanh_1(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+s7_complex s7i_casinh_1(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+s7_complex s7i_cacosh_1(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+
+/* Platform-specific fallback implementations for complex trig functions */
+#ifndef HAVE_COMPLEX_TRIG
+  #if __cplusplus || __TINYC__
+    #define HAVE_COMPLEX_TRIG 0
+  #else
+    #define HAVE_COMPLEX_TRIG 1
+  #endif
+#endif
+
+#if !HAVE_COMPLEX_TRIG
+#if __cplusplus
+
+  static s7_complex ctan(s7_complex z)   {return(csin(z) / ccos(z));}
+  static s7_complex ctanh(s7_complex z)  {return(csinh(z) / ccosh(z));}
+  static s7_complex casin(s7_complex z)  {return(-s7_complex_i * clog(s7_complex_i * z + csqrt(1.0 - z * z)));}
+  static s7_complex cacos(s7_complex z)  {return(-s7_complex_i * clog(z + s7_complex_i * csqrt(1.0 - z * z)));}
+  static s7_complex catan(s7_complex z)  {return(s7_complex_i * clog((s7_complex_i + z) / (s7_complex_i - z)) / 2.0);}
+  static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+  static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+  static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+#else
+
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 12)
+static s7_complex clog(s7_complex z) {return(log(fabs(cabs(z))) + carg(z) * s7_complex_i);}
+static s7_complex cpow(s7_complex x, s7_complex y)
+{
+  s7_double r = cabs(x);
+  s7_double theta = carg(x);
+  s7_double yre = creal(y);
+  s7_double yim = cimag(y);
+  s7_double nr = exp(yre * log(r) - yim * theta);
+  s7_double ntheta = yre * theta + yim * log(r);
+  return(nr * cos(ntheta) + (nr * sin(ntheta)) * s7_complex_i);
+}
+#endif
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 9)
+  static s7_complex cexp(s7_complex z) {return(exp(creal(z)) * cos(cimag(z)) + (exp(creal(z)) * sin(cimag(z))) * s7_complex_i);}
+#endif
+
+#if (!defined(__FreeBSD__)) || (__FreeBSD__ < 10)
+  static s7_complex csin(s7_complex z)   {return(sin(creal(z)) * cosh(cimag(z)) + (cos(creal(z)) * sinh(cimag(z))) * s7_complex_i);}
+  static s7_complex ccos(s7_complex z)   {return(cos(creal(z)) * cosh(cimag(z)) + (-sin(creal(z)) * sinh(cimag(z))) * s7_complex_i);}
+  static s7_complex csinh(s7_complex z)  {return(sinh(creal(z)) * cos(cimag(z)) + (cosh(creal(z)) * sin(cimag(z))) * s7_complex_i);}
+  static s7_complex ccosh(s7_complex z)  {return(cosh(creal(z)) * cos(cimag(z)) + (sinh(creal(z)) * sin(cimag(z))) * s7_complex_i);}
+  static s7_complex ctan(s7_complex z)   {return(csin(z) / ccos(z));}
+  static s7_complex ctanh(s7_complex z)  {return(csinh(z) / ccosh(z));}
+  static s7_complex casin(s7_complex z)  {return(-s7_complex_i * clog(s7_complex_i * z + csqrt(1.0 - z * z)));}
+  static s7_complex cacos(s7_complex z)  {return(-s7_complex_i * clog(z + s7_complex_i * csqrt(1.0 - z * z)));}
+  static s7_complex catan(s7_complex z)  {return(s7_complex_i * clog((s7_complex_i + z) / (s7_complex_i - z)) / 2.0);}
+  static s7_complex catanh(s7_complex z) {return(clog((1.0 + z) / (1.0 - z)) / 2.0);}
+  static s7_complex casinh(s7_complex z) {return(clog(z + csqrt(1.0 + z * z)));}
+  static s7_complex cacosh(s7_complex z) {return(clog(z + csqrt(z * z - 1.0)));}
+#endif /* not FreeBSD 10 */
+#endif /* not c++ */
+#endif /* not HAVE_COMPLEX_TRIG */
+
+#else  /* not HAVE_COMPLEX_NUMBERS */
+  #ifndef _Complex_I
+    #define _Complex_I 1.0
+  #endif
+  #define creal(x) 0.0
+  #define cimag(x) 0.0
+  #define csin(x) sin(x)
+  #define casin(x) x
+  #define ccos(x) cos(x)
+  #define cacos(x) x
+  #define ctan(x) x
+  #define catan(x) x
+  #define csinh(x) x
+  #define casinh(x) x
+  #define ccosh(x) x
+  #define cacosh(x) x
+  #define ctanh(x) x
+  #define catanh(x) x
+  #define cexp(x) exp(x)
+  #define cpow(x, y) pow(x, y)
+  #define clog(x) log(x)
+  #define csqrt(x) sqrt(x)
+  #define conj(x) x
+#endif /* HAVE_COMPLEX_NUMBERS */