Skip to content

[200_27] 从s7.c迁移 string-upcase, string-downcase, string-set!, string-ref 至 s7_liii_string.c #468

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
da-liii merged 3 commits into from
Feb 25, 2026
Merged

[200_27] 从s7.c迁移 string-upcase, string-downcase, string-set!, string-ref 至 s7_liii_string.c #468

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
1dfd8ee
wip
da-liii Feb 25, 2026
7b3117c
[200_27] 迁移 string-ref 和 string-set! 到 s7_liii_string.c
da-liii Feb 25, 2026
4d435aa
[200_27] 简化开发文档
da-liii Feb 25, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 28 additions & 0 deletions devel/200_27.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
# [200_27] 从 s7.c 拆分出 s7_liii_string.c 和 s7_liii_string.h

## 任务相关的代码文件
- src/s7.c
- src/s7_liii_string.c（新增）
- src/s7_liii_string.h（新增）
- xmake.lua
- devel/200_27.md

## 如何测试
```
xmake b goldfish
bin/goldfish tests/goldfish/liii/string-test.scm
```

### 验证结果
所有迁移函数均通过验证：
- ✅ 编译成功：`xmake b goldfish`
- ✅ 测试通过：`bin/goldfish tests/goldfish/liii/string-test.scm`（1560 个测试全部通过）

## 2026/02/25 将字符串函数从 s7.c 迁移到 s7_liii_string.c

### What
将以下 4 个字符串函数的实现从 `s7.c` 迁移到 `s7_liii_string.c`：
1. `string-upcase` (`g_string_upcase`)
2. `string-downcase` (`g_string_downcase`)
3. `string-ref` (`g_string_ref`, `string_ref_1`)
4. `string-set!` (`g_string_set`)
143 changes: 24 additions & 119 deletions src/s7.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -412,6 +412,7 @@
#include "s7_scheme_inexact.h"
#include "s7_scheme_complex.h"
#include "s7_liii_bitwise.h"
#include "s7_liii_string.h"

/* there is also apparently __STDC_NO_COMPLEX__ */
#if WITH_CLANG_PP
Expand Down Expand Up @@ -15736,7 +15737,7 @@ static void resize_strbuf(s7_scheme *sc, s7_int needed_size)
for (s7_int i = old_size; i < sc->strbuf_size; i++) sc->strbuf[i] = '\0';
}

static s7_pointer *chars;
s7_pointer *chars;

static s7_pointer unknown_sharp_constant(s7_scheme *sc, const char *name, s7_pointer port)
{
Expand Down Expand Up @@ -24717,7 +24718,7 @@ static s7_pointer integer_to_char_p_i(s7_scheme *sc, s7_int ind)
}


static uint8_t uppers[256], lowers[256];
uint8_t uppers[256], lowers[256];
static void init_uppers(void)
{
for (int32_t i = 0; i < 256; i++)
Expand Down Expand Up @@ -25669,92 +25670,7 @@ static s7_int string_length_i_7p(s7_scheme *sc, s7_pointer str)
#endif


/* -------------------------------- string-up|downcase -------------------------------- */
static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args)
{
#define H_string_downcase "(string-downcase str) returns the lower case version of str."
#define Q_string_downcase sc->pcl_s

const s7_pointer str = car(args);
if (!is_string(str))
return(method_or_bust_p(sc, str, sc->string_downcase_symbol, sc->type_names[T_STRING]));
{
const s7_int len = string_length(str);
const s7_pointer newstr = make_empty_string(sc, len, '\0');
const uint8_t *ostr = (const uint8_t *)string_value(str);
uint8_t *nstr = (uint8_t *)string_value(newstr);

if (len >= 128)
{
s7_int i = len - 1;
while (i >= 8)
LOOP_8(nstr[i] = lowers[(uint8_t)ostr[i]]; i--);
while (i >= 0) {nstr[i] = lowers[(uint8_t)ostr[i]]; i--;}
}
else
for (s7_int i = 0; i < len; i++) nstr[i] = lowers[(uint8_t)ostr[i]];
return(newstr);
}
}

static s7_pointer g_string_upcase(s7_scheme *sc, s7_pointer args)
{
#define H_string_upcase "(string-upcase str) returns the upper case version of str."
#define Q_string_upcase sc->pcl_s

const s7_pointer str = car(args);
if (!is_string(str))
return(method_or_bust_p(sc, str, sc->string_upcase_symbol, sc->type_names[T_STRING]));

{
const s7_int len = string_length(str);
const s7_pointer newstr = make_empty_string(sc, len, '\0');
const uint8_t *ostr = (const uint8_t *)string_value(str);
uint8_t *nstr = (uint8_t *)string_value(newstr);

if (len >= 128)
{
s7_int i = len - 1;
while (i >= 8)
LOOP_8(nstr[i] = uppers[(uint8_t)ostr[i]]; i--);
while (i >= 0) {nstr[i] = uppers[(uint8_t)ostr[i]]; i--;}
}
else
for (s7_int i = 0; i < len; i++) nstr[i] = uppers[(uint8_t)ostr[i]];
return(newstr);
}
}


/* -------------------------------- string-ref -------------------------------- */
static s7_pointer string_ref_1(s7_scheme *sc, s7_pointer strng, s7_pointer index)
{
char *str;
s7_int ind;

if (!s7_is_integer(index))
return(method_or_bust_pp(sc, index, sc->string_ref_symbol, strng, index, sc->type_names[T_INTEGER], 2));
ind = s7_integer_clamped_if_gmp(sc, index);
if (ind < 0)
out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, index, it_is_negative_string);
if (ind >= string_length(strng))
out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, index, it_is_too_large_string);

str = string_value(strng);
return(chars[((uint8_t *)str)[ind]]);
}

static s7_pointer g_string_ref(s7_scheme *sc, s7_pointer args)
{
#define H_string_ref "(string-ref str index) returns the character at the index-th element of the string str"
#define Q_string_ref s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol)

s7_pointer str = car(args);
if (!is_string(str))
return(method_or_bust(sc, str, sc->string_ref_symbol, args, sc->type_names[T_STRING], 1));
return(string_ref_1(sc, str, cadr(args)));
}

static s7_pointer string_ref_p_pi(s7_scheme *sc, s7_pointer str, s7_int index)
{
if (!is_string(str))
Expand All @@ -25766,9 +25682,17 @@ static s7_pointer string_ref_p_pi(s7_scheme *sc, s7_pointer str, s7_int index)

static s7_pointer string_ref_p_pp(s7_scheme *sc, s7_pointer str, s7_pointer index)
{
s7_int ind;
if (!is_string(str))
return(method_or_bust_pp(sc, str, sc->string_ref_symbol, str, index, sc->type_names[T_STRING], 1));
return(string_ref_1(sc, str, index));
if (!s7_is_integer(index))
return(method_or_bust_pp(sc, index, sc->string_ref_symbol, str, index, sc->type_names[T_INTEGER], 2));
ind = s7_integer_clamped_if_gmp(sc, index);
if (ind < 0)
out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, index, it_is_negative_string);
if (ind >= string_length(str))
out_of_range_error_nr(sc, sc->string_ref_symbol, int_two, index, it_is_too_large_string);
return(chars[((uint8_t *)string_value(str))[ind]]);
}

static s7_pointer string_ref_p_p0(s7_scheme *sc, s7_pointer str, s7_pointer unused_index)
Expand Down Expand Up @@ -25806,33 +25730,6 @@ static s7_pointer string_ref_p_pi_direct(s7_scheme *unused_sc, s7_pointer str, s


/* -------------------------------- string-set! -------------------------------- */
static s7_pointer g_string_set(s7_scheme *sc, s7_pointer args)
{
#define H_string_set "(string-set! str index chr) sets the index-th element of the string str to the character chr"
#define Q_string_set s7_make_signature(sc, 4, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol, sc->is_char_symbol)

const s7_pointer strng = car(args), index = cadr(args);
s7_int ind;

if (!is_mutable_string(strng))
return(mutable_method_or_bust(sc, strng, sc->string_set_symbol, args, sc->type_names[T_STRING], 1));
if (!s7_is_integer(index))
return(method_or_bust(sc, index, sc->string_set_symbol, args, sc->type_names[T_INTEGER], 2));
ind = s7_integer_clamped_if_gmp(sc, index);
if (ind < 0)
out_of_range_error_nr(sc, sc->string_set_symbol, int_two, index, a_non_negative_integer_string);
if (ind >= string_length(strng))
out_of_range_error_nr(sc, sc->string_set_symbol, int_two, index, it_is_too_large_string);
{
char *str = string_value(strng);
s7_pointer c = caddr(args);
if (!is_character(c))
return(method_or_bust(sc, c, sc->string_set_symbol, args, sc->type_names[T_CHARACTER], 3));
str[ind] = (char)s7_character(c);
return(c);
}
}

static s7_pointer string_set_p_pip(s7_scheme *sc, s7_pointer str, s7_int index, s7_pointer chr)
{
if (!is_string(str))
Expand Down Expand Up @@ -98299,8 +98196,12 @@ static void init_rootlet(s7_scheme *sc)
sc->string_position_symbol = defun("string-position", string_position, 2, 1, false);

sc->make_string_symbol = defun("make-string", make_string, 1, 1, false);
sc->string_ref_symbol = defun("string-ref", string_ref, 2, 0, false);
sc->string_set_symbol = defun("string-set!", string_set, 3, 0, false);
sc->string_ref_symbol = s7_define_typed_function(sc, "string-ref", g_string_ref, 2, 0, false,
"(string-ref str index) returns the character at the index-th element of the string str",
s7_make_signature(sc, 3, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol));
sc->string_set_symbol = s7_define_typed_function(sc, "string-set!", g_string_set, 3, 0, false,
"(string-set! str index chr) sets the index-th element of the string str to the character chr",
s7_make_signature(sc, 4, sc->is_char_symbol, sc->is_string_symbol, sc->is_integer_symbol, sc->is_char_symbol));

sc->string_eq_symbol = defun("string=?", strings_are_equal, 2, 0, true);
sc->string_lt_symbol = defun("string<?", strings_are_less, 2, 0, true);
Expand All @@ -98326,8 +98227,12 @@ static void init_rootlet(s7_scheme *sc)
#endif
sc->string_copy_symbol = defun("string-copy", string_copy, 1, 3, false);

sc->string_downcase_symbol = defun("string-downcase", string_downcase, 1, 0, false);
sc->string_upcase_symbol = defun("string-upcase", string_upcase, 1, 0, false);
sc->string_downcase_symbol = s7_define_typed_function(sc, "string-downcase", g_string_downcase, 1, 0, false,
"(string-downcase str) returns the lower case version of str.",
s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_string_symbol));
sc->string_upcase_symbol = s7_define_typed_function(sc, "string-upcase", g_string_upcase, 1, 0, false,
"(string-upcase str) returns the upper case version of str.",
s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_string_symbol));
sc->string_append_symbol = defun("string-append", string_append, 0, 0, true);
sc->substring_symbol = defun("substring", substring, 1, 2, false);
sc->substring_uncopied_symbol = defun("substring-uncopied",substring_uncopied, 1, 2, false);
Expand Down
154 changes: 154 additions & 0 deletions src/s7_liii_string.c
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,154 @@
/* s7_liii_string.c - string utility implementations for s7 Scheme interpreter
*
* derived from s7, a Scheme interpreter
* SPDX-License-Identifier: 0BSD
*
* Bill Schottstaedt, bil@ccrma.stanford.edu
*/

#include "s7_liii_string.h"
#include <stdlib.h>
#include <string.h>
#include <ctype.h>

/* Externally defined in s7.c - upper/lower case conversion tables */
extern uint8_t uppers[256];
extern uint8_t lowers[256];

/* Externally defined in s7.c - character cache */
extern s7_pointer *chars;

#define LOOP_8(Code) do {Code; Code; Code; Code; Code; Code; Code; Code;} while (0)

/* Helper function for out-of-range errors */
static s7_pointer string_ref_out_of_range(s7_scheme *sc, s7_int index, bool is_negative)
{
return s7_out_of_range_error(sc, "string-ref", 2, s7_make_integer(sc, index),
is_negative ? "it is negative" : "it is too large");
}

static s7_pointer method_or_bust(s7_scheme *sc, s7_pointer obj, const char *name, const char *type_name)
{
s7_pointer sym = s7_make_symbol(sc, name);
s7_pointer func = s7_method(sc, obj, sym);
if (func != s7_undefined(sc))
return(s7_apply_function(sc, func, s7_cons(sc, obj, s7_nil(sc))));
return(s7_wrong_type_arg_error(sc, name, 1, obj, type_name));
}

s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args)
{
#define H_string_downcase "(string-downcase str) returns the lower case version of str."
#define Q_string_downcase s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_string_symbol)

s7_pointer str = s7_car(args);
if (!s7_is_string(str))
return(method_or_bust(sc, str, "string-downcase", "a string"));
{
s7_int len = s7_string_length(str);
const char *ostr = s7_string(str);
char *nstr = (char *)malloc(len);
if (!nstr)
return(s7_out_of_range_error(sc, "string-downcase", 0, str, "memory allocation failed"));

if (len >= 128)
{
s7_int i = len - 1;
while (i >= 8)
LOOP_8(nstr[i] = lowers[(uint8_t)ostr[i]]; i--);
while (i >= 0) {nstr[i] = lowers[(uint8_t)ostr[i]]; i--;}
}
else
for (s7_int i = 0; i < len; i++) nstr[i] = lowers[(uint8_t)ostr[i]];

s7_pointer result = s7_make_string_with_length(sc, nstr, len);
free(nstr);
return(result);
}
}

s7_pointer g_string_upcase(s7_scheme *sc, s7_pointer args)
{
#define H_string_upcase "(string-upcase str) returns the upper case version of str."
#define Q_string_upcase s7_make_signature(sc, 2, sc->is_string_symbol, sc->is_string_symbol)

s7_pointer str = s7_car(args);
if (!s7_is_string(str))
return(method_or_bust(sc, str, "string-upcase", "a string"));

{
s7_int len = s7_string_length(str);
const char *ostr = s7_string(str);
char *nstr = (char *)malloc(len);
if (!nstr)
return(s7_out_of_range_error(sc, "string-upcase", 0, str, "memory allocation failed"));

if (len >= 128)
{
s7_int i = len - 1;
while (i >= 8)
LOOP_8(nstr[i] = uppers[(uint8_t)ostr[i]]; i--);
while (i >= 0) {nstr[i] = uppers[(uint8_t)ostr[i]]; i--;}
}
else
for (s7_int i = 0; i < len; i++) nstr[i] = uppers[(uint8_t)ostr[i]];

s7_pointer result = s7_make_string_with_length(sc, nstr, len);
free(nstr);
return(result);
}
}

/* -------------------------------- string-ref -------------------------------- */

s7_pointer string_ref_1(s7_scheme *sc, s7_pointer strng, s7_pointer index)
{
if (!s7_is_integer(index))
return s7_wrong_type_arg_error(sc, "string-ref", 2, index, "an integer");

s7_int ind = s7_integer(index);
if (ind < 0)
return string_ref_out_of_range(sc, ind, true);
if (ind >= s7_string_length(strng))
return string_ref_out_of_range(sc, ind, false);

const char *str = s7_string(strng);
return chars[((uint8_t *)str)[ind]];
}

s7_pointer g_string_ref(s7_scheme *sc, s7_pointer args)
{
s7_pointer str = s7_car(args);
if (!s7_is_string(str))
return method_or_bust(sc, str, "string-ref", "a string");
return string_ref_1(sc, str, s7_cadr(args));
}

/* -------------------------------- string-set! -------------------------------- */

s7_pointer g_string_set(s7_scheme *sc, s7_pointer args)
{
s7_pointer strng = s7_car(args);
s7_pointer index = s7_cadr(args);

if (!s7_is_string(strng))
return method_or_bust(sc, strng, "string-set!", "a string");
if (s7_is_immutable(strng))
return s7_wrong_type_arg_error(sc, "string-set!", 1, strng, "a mutable string");
if (!s7_is_integer(index))
return s7_wrong_type_arg_error(sc, "string-set!", 2, index, "an integer");

s7_int ind = s7_integer(index);
if (ind < 0)
return s7_out_of_range_error(sc, "string-set!", 2, index, "it is negative");
if (ind >= s7_string_length(strng))
return s7_out_of_range_error(sc, "string-set!", 2, index, "it is too large");

s7_pointer c = s7_caddr(args);
if (!s7_is_character(c))
return s7_wrong_type_arg_error(sc, "string-set!", 3, c, "a character");

char *str = (char *)s7_string(strng);
str[ind] = (char)s7_character(c);
return c;
}
Loading