[200_26] 将 (scheme file) 相关代码从 s7.c 迁移到 s7_scheme_file.c

devel/200_26.md

@@ -0,0 +1,51 @@
+# [200_26] 将 (scheme file) 相关代码从 s7.c 迁移到 s7_scheme_file.c
+
+## 任务目标
+根据 Issue #457，完成以下任务：
+1. 移除 s7.c 中 delete-file 的实现（已经通过 tbox 重新实现了）
+2. file-exists? 在 s7.c 中的相关函数已经移除，可能需要清理一下 s7.c
+3. 剩余函数的迁移
+4. tests/goldfish/scheme/file-test.scm 的测试用例补充和文档补充
+
+## 任务相关的代码文件
+- src/s7.c
+- src/s7_scheme_file.c (新建)
+- src/s7_scheme_file.h (新建)
+- xmake.lua
+- goldfish/scheme/file.scm
+- tests/goldfish/scheme/file-test.scm
+- devel/200_26.md
+
+## 如何测试
+```
+xmake b goldfish
+bin/goldfish -m r7rs tests/goldfish/scheme/file-test.scm
+```
+
+## 执行记录
+
+### 2026/03/05 任务开始
+- 创建分支: gatsby/200_26/migrate_scheme_file
+- 分析 s7.c 中的 file 相关代码
+- 发现 delete-file 实现在 s7.c 第 35373 行
+- file-exists? 的实现可能已被移除，但 file_probe 函数仍存在
+
+### 2026/03/05 代码迁移
+- 创建 `src/s7_scheme_file.h` - 导出 g_delete_file, g_access, g_file_mtime, g_unlink
+- 创建 `src/s7_scheme_file.c` - 实现上述函数（使用 s7 公共 API）
+- 修改 `src/s7.c`:
+  - 添加 `#include "s7_scheme_file.h"`
+  - 移除 `file_probe` 函数（未使用）
+  - 移除 `g_delete_file` 函数
+  - 移除 `g_file_mtime` 函数
+  - 移除 `g_unlink` 函数
+  - 移除 `g_access` 函数
+- 修改 `xmake.lua` - 添加 `src/s7_scheme_file.c` 编译
+
+### 2026/03/05 验证
+- ✅ 编译成功: `xmake b goldfish`
+- ✅ 测试通过: `bin/goldfish -m r7rs tests/goldfish/scheme/file-test.scm` (28 correct, 0 failed)
+
+### 待办
+- [ ] 补充 file-test.scm 的测试用例和文档
+- [ ] Git 提交并推送到 GitHub

src/s7.c

@@ -414,6 +414,7 @@
 #include "s7_scheme_char.h"
 #include "s7_liii_bitwise.h"
 #include "s7_liii_string.h"
+#include "s7_scheme_file.h"
 
 /* there is also apparently __STDC_NO_COMPLEX__ */
 #if WITH_CLANG_PP
@@ -1456,7 +1457,7 @@ struct s7_scheme {
              sequence_symbol, size_symbol, source_symbol, weak_symbol;
 
 #if WITH_SYSTEM_EXTRAS
-  s7_pointer is_directory_symbol, delete_file_symbol, system_symbol, directory_to_list_symbol, file_mtime_symbol;
+  s7_pointer is_directory_symbol, system_symbol, directory_to_list_symbol, file_mtime_symbol;
 #endif
   s7_pointer open_input_function_choices[S7_NUM_READ_CHOICES];
   s7_pointer closed_input_function, closed_output_function;
@@ -35357,47 +35358,7 @@ static s7_pointer g_is_directory(s7_scheme *sc, s7_pointer args)
   return(make_boolean(sc, is_directory_b_7p(sc, car(args))));
 }
 
-/* -------------------------------- file-exists? -------------------------------- */
-static bool file_probe(const char *arg)
-{
-#if !MS_WINDOWS
-  return(access(arg, F_OK) == 0);
-#else
-  int32_t fd = open(arg, O_RDONLY, 0);
-  if (fd == -1) return(false);
-  close(fd);
-  return(true);
-#endif
-}
-
 /* -------------------------------- delete-file -------------------------------- */
-static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args)
-{
-  #define H_delete_file "(delete-file filename) deletes the file filename."
-  #define Q_delete_file s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
-
-  const s7_pointer name = car(args);
-  if (!is_string(name))
-    return(sole_arg_method_or_bust(sc, name, sc->delete_file_symbol, args, sc->type_names[T_STRING]));
-  if (string_length(name) > 2)
-    {
-      block_t *b = expand_filename(sc, string_value(name));
-      if (b)
-	{
-	  s7_int result = unlink((char *)block_data(b));
-	  liberate(sc, b);
-	  if ((result == -1) && (sc->scheme_version == sc->r7rs_symbol))
-	    file_error_nr(sc, "delete-file", strerror(errno), string_value(name));
-	  return(make_integer(sc, result));
-	}}
-  {
-    s7_int result = unlink(string_value(name));
-    if ((result == -1) && (sc->scheme_version == sc->r7rs_symbol))
-      file_error_nr(sc, "delete-file", strerror(errno), string_value(name));
-    return(make_integer(sc, result));
-  }
-}
-
 /* -------------------------------- system -------------------------------- */
 static s7_pointer g_system(s7_scheme *sc, s7_pointer args)
 {
@@ -35491,33 +35452,6 @@ static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args)
 }
 
 /* -------------------------------- file-mtime -------------------------------- */
-static s7_pointer g_file_mtime(s7_scheme *sc, s7_pointer args)
-{
-  #define H_file_mtime "(file-mtime file): return the write date of file"
-  #define Q_file_mtime s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
-
-  struct stat statbuf;
-  int32_t err;
-  const s7_pointer name = car(args);
-
-  if (!is_string(name))
-    return(sole_arg_method_or_bust(sc, name, sc->file_mtime_symbol, args, sc->type_names[T_STRING]));
-  if (string_length(name) >= 2)
-    {
-      block_t *b = expand_filename(sc, string_value(name));
-      if (b)
-	{
-	  err = stat((char *)block_data(b), &statbuf);
-	  liberate(sc, b);
-	  if (err < 0)
-	    file_error_nr(sc, "file-mtime", strerror(errno), string_value(name));
-	  return(make_integer(sc, (s7_int)(statbuf.st_mtime)));
-	}}
-  err = stat(string_value(name), &statbuf);
-  if (err < 0)
-    file_error_nr(sc, "file-mtime", strerror(errno), string_value(name));
-  return(make_integer(sc, (s7_int)(statbuf.st_mtime)));
-}
 #endif /* !ms_windows */
 #endif /* with_system_extras */
 
@@ -35536,26 +35470,6 @@ static s7_pointer g_time(s7_scheme *sc, s7_pointer args)
   return(minus_one);
 #endif
 }
-
-/* -------------------------------- unlink -------------------------------- */
-static s7_pointer g_unlink(s7_scheme *sc, s7_pointer args)
-{
-  s7_pointer arg = car(args);
-  if (!s7_is_string(arg))
-    sole_arg_wrong_type_error_nr(sc, sc->unlink_symbol, arg, sc->type_names[T_STRING]);
-  return(make_integer(sc, (s7_int)unlink((char*)string_value(arg))));
-}
-
-/* -------------------------------- access -------------------------------- */
-static s7_pointer g_access(s7_scheme *sc, s7_pointer args)
-{
-  s7_pointer path = car(args), mode = cadr(args);
-  if (!s7_is_string(path))
-    wrong_type_error_nr(sc, sc->access_symbol, 1, path, sc->type_names[T_STRING]);
-  if (!s7_is_integer(mode))
-    wrong_type_error_nr(sc, sc->access_symbol, 2, mode, sc->type_names[T_INTEGER]);
-  return(make_integer(sc, (s7_int)access((char *)string_value(path), (int)integer(mode))));
-}
 #endif
 
 
@@ -97537,7 +97451,6 @@ static void init_rootlet(s7_scheme *sc)
 
 #if WITH_SYSTEM_EXTRAS
   sc->is_directory_symbol =          defun("directory?",	is_directory,		1, 0, false);
-  sc->delete_file_symbol =           defun("delete-file",	delete_file,		1, 0, false);
   sc->system_symbol =                defun("system",		system,			1, 1, false);
 #if !MS_WINDOWS
   sc->directory_to_list_symbol =     defun("directory->list",   directory_to_list,	1, 0, false);

src/s7_scheme_file.c

@@ -0,0 +1,55 @@
+/* s7_scheme_file.c - file utility implementations for s7 Scheme interpreter
+ *
+ * derived from s7, a Scheme interpreter
+ * SPDX-License-Identifier: 0BSD
+ *
+ * Bill Schottstaedt, bil@ccrma.stanford.edu
+ */
+
+#include "s7_scheme_file.h"
+#include "s7.h"
+#include "s7_internal_helpers.h"
+#include <stdlib.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <errno.h>
+
+/* -------------------------------- access -------------------------------- */
+s7_pointer g_access(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer path = s7_car(args), mode = s7_cadr(args);
+  if (!s7_is_string(path))
+    return(s7_wrong_type_arg_error(sc, "access", 1, path, "a string"));
+  if (!s7_is_integer(mode))
+    return(s7_wrong_type_arg_error(sc, "access", 2, mode, "an integer"));
+  return(s7_make_integer(sc, (s7_int)access((char *)s7_string(path), (int)s7_integer(mode))));
+}
+
+/* -------------------------------- file-mtime -------------------------------- */
+s7_pointer g_file_mtime(s7_scheme *sc, s7_pointer args)
+{
+  #define H_file_mtime "(file-mtime file): return the write date of file"
+
+  struct stat statbuf;
+  int32_t err;
+  const s7_pointer name = s7_car(args);
+
+  if (!s7_is_string(name))
+    return(s7i_sole_arg_method_or_bust(sc, name, "file-mtime", args, "a string"));
+  {
+    err = stat(s7_string(name), &statbuf);
+    if (err < 0)
+      return(s7_make_integer(sc, -1));
+    return(s7_make_integer(sc, (s7_int)(statbuf.st_mtime)));
+  }
+}
+
+/* -------------------------------- unlink -------------------------------- */
+s7_pointer g_unlink(s7_scheme *sc, s7_pointer args)
+{
+  s7_pointer arg = s7_car(args);
+  if (!s7_is_string(arg))
+    return(s7_wrong_type_arg_error(sc, "unlink", 1, arg, "a string"));
+  return(s7_make_integer(sc, (s7_int)unlink((char*)s7_string(arg))));
+}

src/s7_scheme_file.h

@@ -0,0 +1,26 @@
+/* s7_scheme_file.h - file utility declarations for s7 Scheme interpreter
+ *
+ * derived from s7, a Scheme interpreter
+ * SPDX-License-Identifier: 0BSD
+ *
+ * Bill Schottstaedt, bil@ccrma.stanford.edu
+ */
+
+#ifndef S7_SCHEME_FILE_H
+#define S7_SCHEME_FILE_H
+
+#include "s7.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+s7_pointer g_access(s7_scheme *sc, s7_pointer args);
+s7_pointer g_file_mtime(s7_scheme *sc, s7_pointer args);
+s7_pointer g_unlink(s7_scheme *sc, s7_pointer args);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* S7_SCHEME_FILE_H */

xmake.lua

@@ -116,6 +116,7 @@ target ("goldfish") do
     add_files ("src/s7_liii_string.c", {languages = "c11"})
     add_files ("src/s7_scheme_inexact.c", {languages = "c11"})
     add_files ("src/s7_scheme_base.c", {languages = "c11"})
+    add_files ("src/s7_scheme_file.c", {languages = "c11"})
     add_packages("tbox")
     add_packages("argh")
     add_packages("nlohmann_json")