The Scheme Programming Language

Description

Source Code

;; Gambit-specific compile options

;(##declare
;  (ieee-scheme)
;  (standard-bindings)
;  (lambda-lift)
;  (block)
;  (fixnum))

(define (SUBSTRING-SEARCH-MAKER pattern-string)

  (define NUM-CHARS-IN-CHARSET 256)  ;; Update this, e.g. for ISO Latin 1


  (define (BUILD-SHIFT-VECTOR pattern-string)
    (let* ( (pat-len (string-length pattern-string))
             (shift-vec (make-vector num-chars-in-charset (+ pat-len 1)))
             (max-pat-index (- pat-len 1))
          )
      (let loop ( (index 0) )
        (vector-set! shift-vec
                      (char->integer (string-ref pattern-string index))
                      (- pat-len index)
        )
         (if (< index max-pat-index)
             (loop (+ index 1))
             shift-vec)
  ) ) )


  (let ( (shift-vec (build-shift-vector pattern-string))
          (pat-len   (string-length pattern-string))
       )

   (lambda (target-string)

      (let* ( (tar-len (string-length target-string))
               (max-tar-index (- tar-len 1))
               (max-pat-index (- pat-len 1))
            )
         (let outer ( (start-index 0) )
           (if (> (+ pat-len start-index) tar-len)
                #f
                (let inner ( (p-ind 0) (t-ind start-index) )
                   (cond
                    ((> p-ind max-pat-index)  ; nothing left to check
                     #f                       ; fail
                    )
                    ((char=? (string-ref pattern-string p-ind)
                             (string-ref target-string  t-ind))
                     (if (= p-ind max-pat-index)
                         start-index  ;; success -- return start index of match
                         (inner (+ p-ind 1) (+ t-ind 1)) ; keep checking
                    )
                   )
                   ((> (+ pat-len start-index) max-tar-index) #f) ; fail
                    (else
                      (outer (+ start-index
                                (vector-ref shift-vec
                                            (char->integer
                                                 (string-ref target-string
                                                             (+ start-index pat-len)
                   ) )      )  )           )    )
                  ) ; end-cond
          ) ) )
   )  ) ; end-lambda
) )

Program Notes