mes: Add string-contains.

* module/srfi/srfi-13.mes (string-contains): New function.
* tests/srfi-13.test ("string-contains"): Test it.
  ("string-contains not"):
This commit is contained in:
Jan Nieuwenhuizen 2018-04-29 18:21:52 +02:00
parent 1f216444f6
commit 3c9b5f433d
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 18 additions and 0 deletions

View file

@ -120,3 +120,15 @@
(let loop ((lst (reverse (string->list s))) (prev nil')) (let loop ((lst (reverse (string->list s))) (prev nil'))
(if (null? lst) prev (if (null? lst) prev
(loop (cdr lst) (cons' (car lst) prev)))))) (loop (cdr lst) (cons' (car lst) prev))))))
(define (string-contains string needle)
(let ((needle (string->list needle)))
(let loop ((string (string->list string)) (i 0))
(and (pair? string)
(let match ((start string) (needle needle) (n i))
(if (null? needle) i
(and (pair? start)
(if (eq? (car start) (car needle))
(or (match (cdr start) (cdr needle) (1+ n))
(loop (cdr string) (1+ i)))
(loop (cdr string) (1+ i))))))))))

View file

@ -62,4 +62,10 @@ exit $?
(pass-if-equal "string-drop-right" "foo" (pass-if-equal "string-drop-right" "foo"
(string-drop-right "foobar" 3)) (string-drop-right "foobar" 3))
(pass-if-equal "string-contains" 3
(string-contains "foobar" "bar"))
(pass-if-not "string-contains not"
(string-contains "fuba" "bar"))
(result 'report) (result 'report)