Skip to content

Commit

Permalink
revise based on Da's comments
Browse files Browse the repository at this point in the history
  • Loading branch information
@JackYansongLi
JackYansongLi committed Feb 4, 2025
1 parent 84df56a commit a5322a9
Show file tree
Hide file tree
Showing 3 changed files with 76 additions and 85 deletions.
98 changes: 45 additions & 53 deletions GoldfishLang.tmu
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2011,6 +2011,8 @@
\ \ \ \ \ \ \ \ result

\ \ \ \ \ \ \ \ (apply result xs))))\

\;
</goldfish-chunk>

<\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
Expand All @@ -2035,102 +2037,92 @@
(check-catch 'wrong-number-of-args ("hello":strip-suffix "llo"))

(check-catch 'unbound-variable (123:strip-suffix 1))

\;
</goldfish-chunk>

<subsection|其余函数>

<paragraph|rich-string%split>

<\goldfish-chunk|goldfish/liii/lang.scm|true|true>
(define (%split sep)\

\ \ (rich-vector (list-\>vector (string-split data sep))))

\;
</goldfish-chunk>

<\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
\;
(define (%split sep)

(check ((box "da@liii.pro") :split "@") =\<gtr\> (box (vector "da" "liii.pro")))
\ \ ;; 在 %split 内部定义 string-split 作为子函数

(check ((box "da@liii.pro") :split ".") =\<gtr\> (box (vector "da@liii" "pro")))

(check (((box "da@liii.pro") :split "@") :collect) =\<gtr\> (vector "da" "liii.pro")) ;Test for chaining
\ \ (define (string-split str sep)

\;
</goldfish-chunk>
\ \ \ \ (let ((sep-len (string-length sep))

<subsection|结尾>
\ \ \ \ \ \ \ \ \ \ (str-len (string-length str)))

<\scm-chunk|goldfish/liii/lang.scm|true|true>
)

\;
</scm-chunk>
\ \ \ \ \ \ (cond

<subsection|帮助函数>
\ \ \ \ \ \ \ ;; 处理分隔符长度为0的特殊情况

<\scm-chunk|goldfish/liii/lang.scm|true|true>
(define (string-split str sep)
\ \ \ \ \ \ \ ((= sep-len 0)

\ \ (let ((sep-len (string-length sep))
\ \ \ \ \ \ \ \ (map string (string-\<gtr\>list str)))

\ \ \ \ \ \ \ \ (str-len (string-length str)))
\ \ \ \ \ \ \ (else

\ \ \ \ ;; Helper function to compare substrings
\ \ \ \ \ \ \ \ (let loop ((start 0) (result '()))

\ \ \ \ (define (substring= str1 start1 str2 start2 len)
\ \ \ \ \ \ \ \ \ \ (if (\<gtr\>= start str-len)

\ \ \ \ \ \ (let loop ((i 0))
\ \ \ \ \ \ \ \ \ \ \ \ \ \ (reverse result)

\ \ \ \ \ \ \ \ (cond
\ \ \ \ \ \ \ \ \ \ \ \ \ \ (let ((found-at

\ \ \ \ \ \ \ \ \ ((= i len) #t)
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (let search ((i start))

\ \ \ \ \ \ \ \ \ ((char=? (string-ref str1 (+ start1 i))\
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (and (\<less\>= (+ i sep-len) str-len)

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (string-ref str2 (+ start2 i)))
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (or (and (string-starts? (substring str i (+ i sep-len)) sep)

\ \ \ \ \ \ \ \ \ \ (loop (+ i 1)))
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ i)

\ \ \ \ \ \ \ \ \ (else #f))))
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (search (+ i 1)))))))

\ \ \ \
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (if found-at

\ \ \ \ (cond
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ found-at sep-len)

\ \ \ \ \ ((= sep-len 0) (list str)) \ ;; Handle empty separator
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (substring str start found-at) result))

\ \ \ \ \ (else
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (reverse (cons (substring str start str-len) result))))))))))

\ \ \ \ \ \ (let loop ((start 0) (result '()))
\ \ ;; 利用(liii string)定义的 string-split 来处理 data

\ \ \ \ \ \ \ \ (if (\<gtr\>= start str-len)
\ \ (rich-vector (list-\<gtr\>vector (string-split data sep))))

\ \ \ \ \ \ \ \ \ \ \ \ (reverse result)
\;
</goldfish-chunk>

\ \ \ \ \ \ \ \ \ \ \ \ (let ((found-at #f))
<\goldfish-chunk|tests/goldfish/liii/lang-test.scm|true|true>
\;

\ \ \ \ \ \ \ \ \ \ \ \ \ \ ;; Manual search for the separator
(check ((box "da@liii.pro") :split "@") =\<gtr\> (box (vector "da" "liii.pro")))

\ \ \ \ \ \ \ \ \ \ \ \ \ \ (do ((i start (+ i 1)))
(check ((box "da@liii.pro") :split ".") =\<gtr\> (box (vector "da@liii" "pro")))

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ((or found-at (\<gtr\> i (- str-len sep-len))))
(check (((box "da@liii.pro") :split "@") :collect) =\<gtr\> (vector "da" "liii.pro")) ;Test for chaining

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (when (and (\<less\>= (+ i sep-len) str-len)
(check ((box "test") :split "") =\<gtr\> (box (vector "t" "e" "s" "t")))

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (substring= str i sep 0 sep-len))
(check ((box "aXXbXXcXX") :split "XX") =\<gtr\> (box (vector "a" "b" "c")))

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (set! found-at i)))
(check ((box "a\|\|b\|\|c") :split "\|\|") =\<gtr\> (box (vector "a" "b" "c")))

\ \ \ \ \ \ \ \ \ \ \ \ \ \ (if found-at
(check ((box "XXaXXb") :split "XX") =\<gtr\> (box (vector "" "a" "b"))) ;分隔符出现在开头

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (loop (+ found-at sep-len)
\;
</goldfish-chunk>

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (cons (substring str start found-at) result))
<subsection|结尾>

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ (reverse (cons (substring str start str-len) result))))))))))
<\scm-chunk|goldfish/liii/lang.scm|true|true>
)

\;
</scm-chunk>
Expand Down
58 changes: 26 additions & 32 deletions goldfish/liii/lang.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -424,40 +424,34 @@
(if (null? xs)
result
(apply result xs))))
(define (%split sep)

(define (%split sep)
;; 在 %split 内部定义 string-split 作为子函数
(define (string-split str sep)
(let ((sep-len (string-length sep))
(str-len (string-length str)))
(cond
;; 处理分隔符长度为0的特殊情况
((= sep-len 0)
(map string (string->list str)))
(else
(let loop ((start 0) (result '()))
(if (>= start str-len)
(reverse result)
(let ((found-at
(let search ((i start))
(and (<= (+ i sep-len) str-len)
(or (and (string-starts? (substring str i (+ i sep-len)) sep)
i)
(search (+ i 1)))))))
(if found-at
(loop (+ found-at sep-len)
(cons (substring str start found-at) result))
(reverse (cons (substring str start str-len) result))))))))))
;; 利用(liii string)定义的 string-split 来处理 data
(rich-vector (list->vector (string-split data sep))))
)

(define (string-split str sep)
(let ((sep-len (string-length sep))
(str-len (string-length str)))
;; Helper function to compare substrings
(define (substring= str1 start1 str2 start2 len)
(let loop ((i 0))
(cond
((= i len) #t)
((char=? (string-ref str1 (+ start1 i))
(string-ref str2 (+ start2 i)))
(loop (+ i 1)))
(else #f))))

(cond
((= sep-len 0) (list str)) ;; Handle empty separator
(else
(let loop ((start 0) (result '()))
(if (>= start str-len)
(reverse result)
(let ((found-at #f))
;; Manual search for the separator
(do ((i start (+ i 1)))
((or found-at (> i (- str-len sep-len))))
(when (and (<= (+ i sep-len) str-len)
(substring= str i sep 0 sep-len))
(set! found-at i)))
(if found-at
(loop (+ found-at sep-len)
(cons (substring str start found-at) result))
(reverse (cons (substring str start str-len) result))))))))))
)

(define-case-class rich-list ((data list?))

Expand Down
5 changes: 5 additions & 0 deletions tests/goldfish/liii/lang-test.scm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -296,9 +296,14 @@
(check-catch 'wrong-number-of-args ("hello":strip-suffix "llo"))
(check-catch 'unbound-variable (123:strip-suffix 1))


(check ((box "da@liii.pro") :split "@") => (box (vector "da" "liii.pro")))
(check ((box "da@liii.pro") :split ".") => (box (vector "da@liii" "pro")))
(check (((box "da@liii.pro") :split "@") :collect) => (vector "da" "liii.pro")) ;Test for chaining
(check ((box "test") :split "") => (box (vector "t" "e" "s" "t")))
(check ((box "aXXbXXcXX") :split "XX") => (box (vector "a" "b" "c")))
(check ((box "a||b||c") :split "||") => (box (vector "a" "b" "c")))
(check ((box "XXaXXb") :split "XX") => (box (vector "" "a" "b"))) ;分隔符出现在开头

(check (rich-list :range 1 5) => (box (list 1 2 3 4)))
(check (rich-list :range 1 5 2) => (box (list 1 3)))
Expand Down

0 comments on commit a5322a9

Please sign in to comment.