Add string-contains?.

From Ben Greenman.
This commit is contained in:
Vincent St-Amour 2015-09-16 11:15:47 -05:00
parent 3fc4a64759
commit ae5b980e07
2 changed files with 29 additions and 1 deletions

View File

@ -510,4 +510,17 @@
(test #f string-suffix? "racket" "r")
(test #f string-suffix? "racket" "kat"))
;; ---------- string-contains? ----------
(let ()
(test #t string-contains? "racket" "racket")
(test #t string-contains? "racket" "cket")
(test #t string-contains? "racket" "acke")
(test #t string-contains? "racket" "t")
(test #t string-contains? "racket" "")
(test #f string-contains? "racket" "b")
(test #f string-contains? "racket" "R")
(test #f string-contains? "racket" "kc")
(test #f string-contains? "racket" "racketr"))
(report-errs)

View File

@ -8,7 +8,8 @@
string-replace
non-empty-string?
string-prefix?
string-suffix?)
string-suffix?
string-contains?)
(define string-append*
(case-lambda [(strs) (apply string-append strs)] ; optimize common cases
@ -159,3 +160,17 @@
(or (= i l2)
(and (char=? (string-ref str i+o) (string-ref suffix i))
(loop (add1 i+o) (add1 i)))))))
(define (string-contains? str sub)
(define L1 (string-length str))
(define L2 (string-length sub))
(define d (- L1 L2))
(or (zero? L2)
(let loop ([start 0])
(and (<= start d)
(or (let loop2 ([offset 0])
(or (= offset L2)
(and (char=? (string-ref str (+ start offset))
(string-ref sub offset))
(loop2 (add1 offset)))))
(loop (add1 start)))))))