/usr/lib/s9fes/string-locate.scm is in scheme9 2010.11.13-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | ; Fast STRING-LOCATE procedure
; By Nils M Holm, 2009,2010
; See the LICENSE file of the S9fES package for terms of use
;
; (string-locate string1 string2) ==> offset | #f
; (string-ci-locate string1 string2) ==> offset | #f
;
; (load-from-library "string-locate.scm")
;
; Attempt to locate the pattern STRING1 in the text STRING2. Return
; the offset of the first occurrence of STRING1 in STRING2 or #F,
; if STRING2 does not contain STRING1.
;
; This program is based on "A Very Fast Substring Search Algorithm",
; Daniel M. Sunday, CACM v33, #8, August 1990 and the
; SUBSTRING-SEARCH-MAKER procedure by Ken Dickey (1990).
;
; Example: (string-locate "test" "This is a test string") ==> 10
; (string-locate "TEST" "This is a test string") ==> #f
(define (string-locate pattern text)
(letrec
((charset-len 256)
(make-shift-table
(lambda (pattern k)
(let* ((shift-table (make-vector charset-len (+ 1 k)))
(max (- k 1)))
(let loop ((i 0))
(vector-set! shift-table
(char->integer (string-ref pattern i))
(- k i))
(if (< i max)
(loop (+ 1 i))
shift-table)))))
(lookup-offset
(lambda (tbl n)
(vector-ref tbl (char->integer (string-ref text n))))))
(let ((kp (string-length pattern))
(kt (string-length text)))
(let ((shift-table (make-shift-table pattern kp))
(p_max (- kp 1))
(t_max (- kt 1)))
(let locate ((i 0))
(if (> (+ kp i) kt)
#f
(let compare ((pi 0)
(ti i))
(cond
((> pi p_max)
#f)
((char=? (string-ref pattern pi)
(string-ref text ti))
(if (= pi p_max)
i
(compare (+ pi 1) (+ ti 1))))
((> (+ kp i) t_max)
#f)
(else
(locate (+ i (lookup-offset shift-table
(+ i kp)))))))))))))
|