From 8ada076ead3f3a9cb1183ff40285de30b9e283b5 Mon Sep 17 00:00:00 2001 From: Da Shen Date: Sun, 21 Sep 2025 20:49:48 +0800 Subject: [PATCH 1/4] wip --- goldfish/liii/pp.scm | 28 +---------------------- goldfish/liii/pretty-print.scm | 13 ++++++++++- tests/goldfish/liii/pretty-print-test.scm | 15 ++++++++++++ 3 files changed, 28 insertions(+), 28 deletions(-) diff --git a/goldfish/liii/pp.scm b/goldfish/liii/pp.scm index d7acb4f2..a686b858 100644 --- a/goldfish/liii/pp.scm +++ b/goldfish/liii/pp.scm @@ -200,34 +200,11 @@ (values 'normal pos result)) -(define (is-pp-single-comment? str pos) - (and (< (+ pos 20) (string-length str)) ; "(*PP_SINGLE_COMMENT*" 长度 - (string=? (substring str pos (+ pos 20)) "(*PP_SINGLE_COMMENT*"))) - -(define (next-state-from-single-comment-post str pos result) - (let* ((start-pos (+ pos 20)) ; 跳过 "(*PP_SINGLE_COMMENT*" - (end-pos (find-matched-right-paren str pos))) ; 找到匹配的右括号 - (if (>= end-pos 0) - (let* ((full-expr (substring str pos (+ end-pos 1))) ; 提取完整表达式 - (expr (with-input-from-string full-expr read)) ; 用 read 解析 - (comment-text (cadr expr))) ; 获取注释内容 - ;; 注意：换行符已经在解析阶段被保留，这里不需要额外添加 - ;; 对于空注释（如版权头的纯;），不添加空格；对于有内容的注释，添加空格 - (let* ((trimmed-text (string-trim comment-text)) - (comment-prefix (if (string-null? trimmed-text) ";" "; "))) - (values 'normal (+ end-pos 1) (string-append result comment-prefix trimmed-text)))) - (values 'normal (string-length str) result)))) ; 未找到右括号，直接结束 - (define (next-state-from-normal-post str pos result) (if (>= pos (string-length str)) (values 'end pos result) - (cond ((is-pp-single-comment? str pos) - ;; normal -> single-comment 状态转换 - (values 'single-comment pos result)) - (else - ;; 正常处理字符，直接按原样输出 - (values 'normal (+ pos 1) (string-append result (string (str pos)))))))) + (values 'normal (+ pos 1) (string-append result (string (str pos)))))) (define (clean-empty-lines str) ;; 清理空行中的空白字符：将只包含空格和制表符的行转换为纯换行 @@ -283,9 +260,6 @@ ((start) (receive (next-state next-pos next-result) (next-state-from-start-post str pos result) (loop next-state next-pos next-result))) - ((single-comment) (receive (next-state next-pos next-result) - (next-state-from-single-comment-post str pos result) - (loop next-state next-pos next-result))) ((normal) (receive (next-state next-pos next-result) (next-state-from-normal-post str pos result) (loop next-state next-pos next-result))) diff --git a/goldfish/liii/pretty-print.scm b/goldfish/liii/pretty-print.scm index bf62eba5..be393e60 100644 --- a/goldfish/liii/pretty-print.scm +++ b/goldfish/liii/pretty-print.scm @@ -1,5 +1,5 @@ (define-library (liii pretty-print) -(export pretty-print pp pp-post pp-multi-comment) +(export pretty-print pp pp-post pp-multi-comment pp-single-comment) (import (liii string)) (begin @@ -529,6 +529,17 @@ (display "|#" port))) (hash-table-set! h '*PP_MULTI_COMMENT* w-pp-multi-comment) + ;; -------- PP_SINGLE_COMMENT + (define (w-pp-single-comment obj port column) + (let ((comment-text (cadr obj))) ; 获取注释内容 + (newline port) ; 前面换行 + (display ";" port) + (if (not (string-null? comment-text)) + (begin + (display " " port) + (display comment-text port))))) + (hash-table-set! h '*PP_SINGLE_COMMENT* w-pp-single-comment) + h))) ;; pretty-print-1 diff --git a/tests/goldfish/liii/pretty-print-test.scm b/tests/goldfish/liii/pretty-print-test.scm index da82d35b..19abb564 100644 --- a/tests/goldfish/liii/pretty-print-test.scm +++ b/tests/goldfish/liii/pretty-print-test.scm @@ -167,4 +167,19 @@ (display 2))))) (check (string-contains result "\n") => #t)) ; 确保结果中包含换行符 +; 测试 PP_SINGLE_COMMENT 功能 +(check (pp '(*PP_SINGLE_COMMENT* "test comment")) => "\n; test comment") + +; 测试 PP_SINGLE_COMMENT 空内容 +(check (pp '(*PP_SINGLE_COMMENT* "")) => "\n;") + +; 测试 PP_SINGLE_COMMENT 有内容 +(check (pp '(*PP_SINGLE_COMMENT* "hello world")) => "\n; hello world") + +; 测试 PP_SINGLE_COMMENT 在复杂表达式中的使用 +(check (pp '(begin + (display 1) + (*PP_SINGLE_COMMENT* "中间注释") + (display 2))) => "(begin\n (display 1)\n \n; 中间注释\n (display 2))") + (check-report) -- Gitee From 97144af72deb26b0fd8468a0f585a5b6648df46a Mon Sep 17 00:00:00 2001 From: Da Shen Date: Sun, 21 Sep 2025 20:54:36 +0800 Subject: [PATCH 2/4] wip --- goldfish/liii/pretty-print.scm | 1 - tests/goldfish/liii/pretty-print-test.scm | 17 ++++++++++------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/goldfish/liii/pretty-print.scm b/goldfish/liii/pretty-print.scm index be393e60..77cc35f5 100644 --- a/goldfish/liii/pretty-print.scm +++ b/goldfish/liii/pretty-print.scm @@ -532,7 +532,6 @@ ;; -------- PP_SINGLE_COMMENT (define (w-pp-single-comment obj port column) (let ((comment-text (cadr obj))) ; 获取注释内容 - (newline port) ; 前面换行 (display ";" port) (if (not (string-null? comment-text)) (begin diff --git a/tests/goldfish/liii/pretty-print-test.scm b/tests/goldfish/liii/pretty-print-test.scm index 19abb564..c3198dda 100644 --- a/tests/goldfish/liii/pretty-print-test.scm +++ b/tests/goldfish/liii/pretty-print-test.scm @@ -168,18 +168,21 @@ (check (string-contains result "\n") => #t)) ; 确保结果中包含换行符 ; 测试 PP_SINGLE_COMMENT 功能 -(check (pp '(*PP_SINGLE_COMMENT* "test comment")) => "\n; test comment") +(check (pp '(*PP_SINGLE_COMMENT* "test comment")) => "; test comment") ; 测试 PP_SINGLE_COMMENT 空内容 -(check (pp '(*PP_SINGLE_COMMENT* "")) => "\n;") +(check (pp '(*PP_SINGLE_COMMENT* "")) => ";") ; 测试 PP_SINGLE_COMMENT 有内容 -(check (pp '(*PP_SINGLE_COMMENT* "hello world")) => "\n; hello world") +(check (pp '(*PP_SINGLE_COMMENT* "hello world")) => "; hello world") ; 测试 PP_SINGLE_COMMENT 在复杂表达式中的使用 -(check (pp '(begin - (display 1) - (*PP_SINGLE_COMMENT* "中间注释") - (display 2))) => "(begin\n (display 1)\n \n; 中间注释\n (display 2))") +(let ((result (pp '(begin + (display 1) + (*PP_SINGLE_COMMENT* "中间注释") + (display 2))))) + (display "Complex expression result:\n") + (display result) + (newline)) (check-report) -- Gitee From 56798bd8953eb06932add351152a60fe86836526 Mon Sep 17 00:00:00 2001 From: Da Shen Date: Sun, 21 Sep 2025 21:44:03 +0800 Subject: [PATCH 3/4] wip --- goldfish/liii/pretty-print.scm | 6 ++++- tests/goldfish/liii/pretty-print-test.scm | 28 +++++++++++++++++++++++ 2 files changed, 33 insertions(+), 1 deletion(-) diff --git a/goldfish/liii/pretty-print.scm b/goldfish/liii/pretty-print.scm index 77cc35f5..9b0db210 100644 --- a/goldfish/liii/pretty-print.scm +++ b/goldfish/liii/pretty-print.scm @@ -57,6 +57,8 @@ (set! p (cdr p)) (set! obj (car p))) ; pair? cdr p above + ;; 处理 PP_SINGLE_COMMENT 的特殊逻辑 + (cond ((or (hash-table? obj) (let? obj)) (pretty-print-1 obj port col)) @@ -64,7 +66,8 @@ ((and (pair? obj) (pair? (cdr obj)) (null? (cddr obj)) - (> len (/ *pretty-print-length* 2))) + (> len (/ *pretty-print-length* 2)) + (not (eq? (car obj) '*PP_SINGLE_COMMENT*))) ; PP_SINGLE_COMMENT 不应该应用长对格式化 (if (eq? (car obj) 'quote) (write-char #\' port) (begin @@ -659,6 +662,7 @@ (else (let* ((objstr (object->string obj)) (strlen (length objstr))) + ;; 处理对象字符串 (if (< (+ column strlen) *pretty-print-length*) (display objstr port) diff --git a/tests/goldfish/liii/pretty-print-test.scm b/tests/goldfish/liii/pretty-print-test.scm index c3198dda..b93184d3 100644 --- a/tests/goldfish/liii/pretty-print-test.scm +++ b/tests/goldfish/liii/pretty-print-test.scm @@ -185,4 +185,32 @@ (display result) (newline)) +; 测试 PP_SINGLE_COMMENT 长内容（超过 pretty-print-length） +(check (pp '(*PP_SINGLE_COMMENT* "This is a very long comment that should be handled properly by the pretty printer without any issues related to length constraints")) => "; This is a very long comment that should be handled properly by the pretty printer without any issues related to length constraints") + +; 测试多个 PP_SINGLE_COMMENT 连续出现（模拟多行注释） +(check (pp '(begin + (*PP_SINGLE_COMMENT* "First comment line") + (*PP_SINGLE_COMMENT* "Second comment line") + (*PP_SINGLE_COMMENT* "Third comment line") + (define test 123))) => "(begin\n ; First comment line\n ; Second comment line\n ; Third comment line\n (define test 123))") + +; 测试 PP_SINGLE_COMMENT 包含特殊字符 +(check (pp '(*PP_SINGLE_COMMENT* "Comment with special chars: ()[]{}!@#$%^&*")) => "; Comment with special chars: ()[]{}!@#$%^&*") + +; 测试具体的长内容注释：guenchi (c) 2018 - 2019 ddd ddd +(check (pp '(*PP_SINGLE_COMMENT* "guenchi (c) 2018 - 2019 ddd ddd")) => "; guenchi (c) 2018 - 2019 ddd ddd") + +; 测试包含括号和年份的长注释内容 +(check (pp '(*PP_SINGLE_COMMENT* "Copyright (c) 2018 - 2019 guenchi project, all rights reserved")) => "; Copyright (c) 2018 - 2019 guenchi project, all rights reserved") + +; 测试混合内容的长注释 +(check (pp '(*PP_SINGLE_COMMENT* "guenchi (c) 2018 - 2019 ddd ddd (with additional text) and more content")) => "; guenchi (c) 2018 - 2019 ddd ddd (with additional text) and more content") + +; 测试在复杂表达式中的长注释 +(check (pp '(begin + (*PP_SINGLE_COMMENT* "guenchi (c) 2018 - 2019 ddd ddd") + (define copyright-holder "guenchi") + (*PP_SINGLE_COMMENT* "Additional copyright notice for the project"))) => "(begin\n ; guenchi (c) 2018 - 2019 ddd ddd\n (define copyright-holder \"guenchi\")\n ; Additional copyright notice for the project)") + (check-report) -- Gitee From 328bda54626139b2ec3e3ac5fa2c09af702b3eaa Mon Sep 17 00:00:00 2001 From: Da Shen Date: Sun, 21 Sep 2025 21:47:41 +0800 Subject: [PATCH 4/4] wip --- goldfish/liii/pp.scm | 50 +++----------------------------------------- 1 file changed, 3 insertions(+), 47 deletions(-) diff --git a/goldfish/liii/pp.scm b/goldfish/liii/pp.scm index a686b858..2d5b8c5c 100644 --- a/goldfish/liii/pp.scm +++ b/goldfish/liii/pp.scm @@ -173,38 +173,7 @@ (next-state-from-normal str pos result) (loop next-state next-pos next-result))))))) -(define (find-matched-right-paren str pos) - (let ((len (string-length str))) - (if (or (< pos 0) (>= pos len) (not (char=? (string-ref str pos) #\())) - -1 ; 无效起始位置或不是左括号 - (let loop ((p (+ pos 1)) (in-string? #f)) - (cond - ((>= p len) -1) ; 到达字符串末尾未找到 - ;; 找到右括号且不在字符串内 - ((and (not in-string?) (char=? (string-ref str p) #\))) - p) - ;; 进入/退出字符串 - ((char=? (string-ref str p) #\") - (loop (+ p 1) (not in-string?))) - ;; 其他情况继续扫描 - (else - (loop (+ p 1) in-string?))))))) - -; start状态 -; 含义：位置在代码的第一行第一列 -; 转移：直接进入normal状态即可 -(define (next-state-from-start-post str pos result) - (values 'normal pos result)) - -(define (next-state-from-newline-post str pos result) - (values 'normal pos result)) - - - -(define (next-state-from-normal-post str pos result) - (if (>= pos (string-length str)) - (values 'end pos result) - (values 'normal (+ pos 1) (string-append result (string (str pos)))))) +; 格式化文件相关函数 (define (clean-empty-lines str) ;; 清理空行中的空白字符：将只包含空格和制表符的行转换为纯换行 @@ -253,21 +222,8 @@ (substring str (+ end-pos 1) (string-length str))))) (define (pp-post str) - (let loop ((state 'start) (pos 0) (result "")) - (if (>= pos (string-length str)) - (clean-empty-lines result) ;; 清理空行中的空白字符 - (case state - ((start) (receive (next-state next-pos next-result) - (next-state-from-start-post str pos result) - (loop next-state next-pos next-result))) - ((normal) (receive (next-state next-pos next-result) - (next-state-from-normal-post str pos result) - (loop next-state next-pos next-result))) - ((end) result) - (else - (receive (next-state next-pos next-result) - (next-state-from-normal-post str pos result) - (loop next-state next-pos next-result))))))) + ;; 后处理只保留清理空行的功能 + (clean-empty-lines str)) (define (format-file filename) (let* ((content (path-read-text filename)) -- Gitee