; Fast STRING-LOCATE procedure
  By    , 2009,2010
; Placed in the Public Domain
;
  ( string - locate   )      = = >   offset | # f
  ( string - ci - locate   )   = = >   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   ( 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)))))))))))))

 Fast STRING-LOCATE procedure
 Placed in the Public Domain


 (load-from-library "string-locate.scm")



            (string-locate "TEST" "This is a test string")     ==>  #f
  By    , 2009,2010
  ( string - locate   )      = = >   offset | # f
  ( string - ci - locate   )   = = >   offset | # f
  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   ( 1990 ) .
  Example :    ( string - locate " test " " This is a test string " )      = = >   10

(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)))))))))))))
