; -*- Scheme -*-
;
; $Id: string03.scm,v 1.1 1998/03/16 07:59:31 foner Exp $
;

; The code is based on :-
;
; FILE		"substr.scm"
; IMPLEMENTS	Substring search
; AUTHOR	Ken Dickey
; DATE		1991 August 6
; LAST UPDATED
;
; Which is available from the Scheme repository as
;
;   pub/scheme/scm/substr.scm:nexus.yorku.ca


;-----------

(define string:find-by-sunday:char-set-size 256)

; Update this, e.g. for ISO Latin 1
    
;-----------

; procedure: string:find-by-sunday:build-shift-map
; arguments: pattern pattern-size
; signature: string x integer -> vector

(define string:find-by-sunday:build-shift-map
  (lambda (p ps)
    (let ((m (make-vector string:find-by-sunday:char-set-size (+ ps 1)))
	  (pe (- ps 1)))
      (let loop ((i 0))
	(vector-set! m (char->integer (string-ref p i)) (- ps i))
	(if (< i pe) (loop (+ i 1)) m)))))
    
;-----------

;+doc
; procedure: substring:find-by-sunday
; signature: substring-searcher

; Find the position of the start of a pattern in a string using an
; algorithm devised by Daniel M. Sunday, see :-
;
;   A Very Fast Substring Search Algorithm
;   Daniel M. Sunday
;   Communications of the ACM 33(8), August 1990.
;
; See SUBSTRING:FIND-STRING for information on arguments ... etc.
;-doc
    
(define substring:find-by-sunday
  (lambda (p)
    (let* ((pl (string-length p))
	   (shift-map (string:find-by-sunday:build-shift-map p pl)))
      (lambda (s start end if-found if-not-found r)
	(let ((se (- end 1))
	      (pe (- pl 1)))
	  (let outer ((si start) (r r))
	    (if (> (+ pl si) end)
		(if-not-found r)
		(let inner ((pj 0) (sj si))
		  (cond ((> pj pe) (if-not-found r))
			((char=? (string-ref p pj) (string-ref s sj))
			 (if (= pj pe)
			     (if-found si (lambda (r) (outer (+ si pl) r)) r)
			     (inner (+ pj 1) (+ sj 1))))
			((> (+ pl si) se) (if-not-found r))
			(else
			 (let* ((x (string-ref s (+ si pl)))
				(y (vector-ref shift-map (char->integer x))))
			   (outer (+ si y) r))))))))))))

; eof
