!1019 [216_55] 在 (liii base) 中导出更多 s7 内置函数

Author: da-liii

goldfish/liii/base.scm

@@ -30,6 +30,9 @@
     procedure-arglist
     arity
     defined?
+    object->string
+    eval-string
+    signature
     ; Keywords
     keyword?
     string->keyword

tests/liii/base-test.scm

@@ -23,6 +23,9 @@
 ;;   procedure-arglist    - 获取过程的参数列表
 ;;   arity                - 获取过程可接受的参数数量范围
 ;;   defined?             - 检查符号是否已定义
+;;   object->string      - 将对象转换为字符串表示
+;;   eval-string          - 将字符串作为 Scheme 代码求值
+;;   signature            - 获取函数的类型签名
 ;;   keyword?             - 判断是否为关键字
 ;;   string->keyword      - 字符串转关键字
 ;;   symbol->keyword      - 符号转关键字

tests/liii/base/defined-test.scm tests/liii/base/defined-p-test.scmtests/liii/base/defined-test.scm renamed to tests/liii/base/defined-p-test.scm

@@ -0,0 +1,53 @@
+(import (liii check))
+(import (liii base))
+
+(check-set-mode! 'report-failed)
+
+;; eval-string
+;; 将字符串作为 Scheme 代码进行求值。
+;;
+;; 语法
+;; ----
+;; (eval-string str)
+;; (eval-string str env)
+;;
+;; 参数
+;; ----
+;; str : string?
+;; 包含 Scheme 代码的字符串。
+;;
+;; env : let?，可选，默认为 (rootlet)
+;; 要在其中求值代码的环境。
+;;
+;; 返回值
+;; ------
+;; 字符串中最后一个表达式的求值结果。
+
+;; 测试基本表达式
+(check (eval-string "42") => 42)
+(check (eval-string "(+ 1 2 3)") => 6)
+
+;; 测试字符串
+(check (eval-string "\"hello\"") => "hello")
+
+;; 测试符号
+(check (eval-string "'symbol") => 'symbol)
+
+;; 测试列表
+(check (eval-string "'(1 2 3)") => '(1 2 3))
+
+;; 测试 lambda 和调用
+(check (eval-string "((lambda (x) (* x x)) 5)") => 25)
+
+;; 测试复杂表达式
+(check (eval-string "(let ((a 3) (b 4)) (+ a b))") => 7)
+
+;; 测试 if 表达式
+(check (eval-string "(if #t 1 2)") => 1)
+(check (eval-string "(if #f 1 2)") => 2)
+
+;; 测试比较操作
+(check (eval-string "(> 5 3)") => #t)
+(check (eval-string "(< 5 3)") => #f)
+
+(check-report)

tests/liii/base/eval-string-test.scm

@@ -0,0 +1,38 @@
+(import (liii check))
+(import (liii base))
+
+(check-set-mode! 'report-failed)
+
+;; loose-car
+;; 宽松地获取列表的第一个元素（car）。
+;; 与标准 car 不同，当传入空列表时返回空列表而不是报错。
+;;
+;; 语法
+;; ----
+;; (loose-car pair-or-empty)
+;;
+;; 参数
+;; ----
+;; pair-or-empty : pair? 或 null?
+;; 一个配对（非空列表）或空列表。
+;;
+;; 返回值
+;; ------
+;; 如果参数是非空列表，返回其第一个元素；
+;; 如果参数是空列表，返回空列表。
+
+;; 测试非空列表
+(check (loose-car '(1 2 3)) => 1)
+(check (loose-car '(a b c)) => 'a)
+(check (loose-car '("hello" "world")) => "hello")
+
+;; 测试空列表（这是 loose-car 的主要用途）
+(check (loose-car '()) => '())
+
+;; 测试嵌套列表
+(check (loose-car '((1 2) 3 4)) => '(1 2))
+
+;; 测试单元素列表
+(check (loose-car '(only)) => 'only)
+
+(check-report)

tests/liii/base/loose-car-test.scm

@@ -0,0 +1,41 @@
+(import (liii check))
+(import (liii base))
+
+(check-set-mode! 'report-failed)
+
+;; loose-cdr
+;; 宽松地获取列表的剩余部分（cdr）。
+;; 与标准 cdr 不同，当传入空列表时返回空列表而不是报错。
+;;
+;; 语法
+;; ----
+;; (loose-cdr pair-or-empty)
+;;
+;; 参数
+;; ----
+;; pair-or-empty : pair? 或 null?
+;; 一个配对（非空列表）或空列表。
+;;
+;; 返回值
+;; ------
+;; 如果参数是非空列表，返回除第一个元素外的剩余部分；
+;; 如果参数是空列表，返回空列表。
+
+;; 测试非空列表
+(check (loose-cdr '(1 2 3)) => '(2 3))
+(check (loose-cdr '(a b c)) => '(b c))
+(check (loose-cdr '("hello" "world")) => '("world"))
+
+;; 测试空列表（这是 loose-cdr 的主要用途）
+(check (loose-cdr '()) => '())
+
+;; 测试嵌套列表
+(check (loose-cdr '((1 2) 3 4)) => '(3 4))
+
+;; 测试单元素列表
+(check (loose-cdr '(only)) => '())
+
+;; 测试双元素列表
+(check (loose-cdr '(first second)) => '(second))
+
+(check-report)

tests/liii/base/loose-cdr-test.scm

@@ -0,0 +1,56 @@
+(import (liii check))
+(import (liii base))
+
+(check-set-mode! 'report-failed)
+
+;; object->string
+;; 将对象转换为字符串表示。
+;;
+;; 语法
+;; ----
+;; (object->string obj)
+;; (object->string obj write)
+;; (object->string obj write max-len)
+;;
+;; 参数
+;; ----
+;; obj : any?
+;; 要转换为字符串的对象。
+;;
+;; write : boolean? 或 :readable，可选，默认为 #t
+;; 如果为 #t，使用 write 风格（可被 read 解析）；
+;; 如果为 :readable，生成可读的字符串表示。
+;;
+;; max-len : integer?，可选，默认为很大的数
+;; 输出字符串的最大长度。
+;;
+;; 返回值
+;; ------
+;; string?
+;; 对象的字符串表示。
+
+;; 测试基本类型
+(check (object->string 42) => "42")
+(check (object->string "hello") => "\"hello\"")
+(check (object->string 'symbol) => "symbol")
+(check (object->string #t) => "#t")
+(check (object->string #f) => "#f")
+
+;; 测试列表
+(check (object->string '(1 2 3)) => "(1 2 3)")
+(check (object->string '()) => "()")
+
+;; 测试向量
+(check (object->string #(1 2 3)) => "#(1 2 3)")
+
+;; 测试过程
+(check (string? (object->string (lambda (x) x))) => #t)
+
+;; 测试 write 参数为 #f（使用 display 风格）
+(check (object->string "hello" #f) => "hello")
+(check (object->string 42 #f) => "42")
+
+;; 测试嵌套结构
+(check (object->string '(1 (2 3) 4)) => "(1 (2 3) 4)")
+
+(check-report)

tests/liii/base/object-to-string-test.scm

@@ -0,0 +1,53 @@
+(import (liii check))
+(import (liii base))
+
+(check-set-mode! 'report-failed)
+
+;; signature
+;; 获取函数的类型签名（参数类型和返回值类型的约束）。
+;;
+;; 语法
+;; ----
+;; (signature func)
+;;
+;; 参数
+;; ----
+;; func : procedure?
+;; 要获取类型签名的函数。
+;;
+;; 返回值
+;; ------
+;; pair? 或 #f
+;; 返回一个点对，表示函数的签名 (return-type . arg-types)；
+;; 如果函数没有签名信息，返回 #f。
+;;
+;; 说明
+;; ----
+;; 签名可能包含循环结构（用 #1=... 表示），表示接受可变数量的参数。
+;; 例如 #1=(number? . #1#) 表示返回 number? 并接受任意数量的 number? 参数。
+
+;; 测试 car/cdr 的完整签名（返回任意类型，需要 pair? 参数）
+(check (signature car) => '(#t pair?))
+(check (signature cdr) => '(#t pair?))
+
+;; 测试 cons 函数签名（返回 pair?，接受两个任意类型参数）
+(check (signature cons) => '(pair? #t #t))
+
+;; 测试基本算术函数（返回 number?，接受可变 number? 参数）
+(check (car (signature +)) => 'number?)
+(check (car (signature -)) => 'number?)
+(check (car (signature *)) => 'number?)
+(check (car (signature /)) => 'number?)
+
+;; 测试比较函数（返回 boolean?，接受可变 real? 参数）
+(check (car (signature =)) => 'boolean?)
+(check (car (signature <)) => 'boolean?)
+(check (car (signature >)) => 'boolean?)
+
+;; 测试 string-append 函数（返回 string?，接受可变 string? 参数）
+(check (car (signature string-append)) => 'string?)
+
+;; 测试自定义函数（没有签名）
+(check (let ((f (lambda (x) (+ x 1)))) (signature f)) => #f)
+
+(check-report)