Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fixing string-contains-right

Browse source
This commit is contained in:
Alex Shinn 2016-05-11 08:07:32 +09:00
parent 1621d481f3
commit 0113e1e5d5
2 changed files with 26 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lib/srfi/130.scm
View file

@ -158,22 +158,30 @@
(and res (string-cursor<=? res end1) res))))
(define (string-contains-right s1 s2 . o)
(let* ((s1 (string-arg s1 o))
(let* ((start1
(cursor-arg s1 (if (pair? o) (car o) (string-cursor-start s1))))
(end1 (cursor-arg s1 (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(string-cursor-end s1))))
(s2 (if (and (pair? o) (pair? (cdr o))) (string-arg s2 (cddr o)) s2))
(start1 (string-cursor-start s1))
(start2 (string-cursor-start s2)))
(let lp ((c1 (string-cursor-end s1))
(c2 (string-cursor-end s2))
(c3 (string-cursor-end s2)))
(start2 (string-cursor-start s2))
(end2 (string-cursor-end s2)))
(let lp ((sc1-base end1)
(sc1 end1)
(sc2-base end2)
(sc2 end2))
(cond
((string-cursor=? c3 start2)
c1)
((string-cursor=? c1 start1)
((string-cursor=? sc2 start2)
sc1)
((string-cursor=? sc1 start1)
#f)
((eqv? (string-cursor-ref s1 c1) (string-cursor-ref s2 c3))
(lp (string-cursor-prev s1 c2) c2 (string-cursor-prev s2 c3)))
(else
(lp (string-cursor-prev s1 c2) c2 c2))))))
(let ((sc1 (string-cursor-prev s1 sc1))
(sc2 (string-cursor-prev s2 sc2)))
(if (eqv? (string-cursor-ref s1 sc1) (string-cursor-ref s2 sc2))
(lp sc1-base sc1 sc2-base sc2)
(let ((sc1-base (string-cursor-prev s1 sc1-base)))
(lp sc1-base sc1-base sc2-base sc2-base)))))))))
(define (string-reverse str . o)
(list->string (reverse (string->list/cursors (string-arg str o)))))

6
lib/srfi/130/test.sld
View file

@ -151,6 +151,12 @@
(string-contains "Ma mere l'oye" "mer"))
(test "string-contains" #f
(string-contains "Ma mere l'oye" "Mer"))
(let ((s "eek -- it's a geek."))
(test 15 (string-cursor->index s (string-contains-right s "ee")))
(test 15 (string-cursor->index s (string-contains-right s "ee" 12 18)))
(test 19 (string-cursor->index s (string-contains-right s "")))
(test 0 (string-cursor->index "" (string-contains-right "" "")))
(test #f (string-contains-right s "kee" 12 18)))
(test "string-reverse" "nomel on nolem on"
(string-reverse "no melon no lemon"))