1 files changed, 17 insertions, 15 deletions
diff --git a/strsrch.scm b/strsrch.scm
index a730234..53c6e4b 100644..100755
--- a/strsrch.scm
+++ b/strsrch.scm
@@ -2,9 +2,13 @@
 ; Written 1995, 1996 by Oleg Kiselyov (oleg@acm.org)
 ; Modified 1996, 1997, 1998, 2001 by A. Jaffer (agj@alum.mit.edu)
 ; Modified 2003 by Steve VanDevender (stevev@hexadecimal.uoregon.edu)
-;
+; 2013-01 A. Jaffer replaced the skip-vector with an alist
+
 ; This code is in the public domain.
 
+(require 'multiarg-apply)		; used in string-subst
+(require 'alist)
+
 ;;;@ Return the index of the first occurence of chr in str, or #f
 (define (string-index str chr)
   (define len (string-length str))
@@ -35,19 +39,19 @@
 	((>= patlen strlen) (and (= patlen strlen) (string=? pat str) 0))
 	;; use faster string-index to match a single-character pattern
 	((= 1 patlen) (string-index str (string-ref pat 0)))
-	((or (<= strlen (+ patlen patlen (quotient char-code-limit 2)))
-	     (<= patlen 4))
+	((or (<= strlen (* 2 patlen))
+	     (<= patlen 2))
 	 (subloop pat patlen str strlen char=?))
 	(else
 	 ;; compute skip values for search pattern characters
 	 ;; for all c not in pat, skip[c] = patlen + 1
 	 ;; for c in pat, skip[c] is distance of rightmost occurrence
 	 ;;  of c from end of str
-	 (let ((skip (make-vector char-code-limit (+ patlen 1))))
+	 (let ((skip '()))
+	   (define setprop (alist-associator char=?))
 	   (do ((i 0 (+ i 1)))
 	       ((= i patlen))
-	     (vector-set! skip (char->integer (string-ref pat i))
-			  (- patlen i)))
+	     (set! skip (setprop skip (string-ref pat i) (- patlen i))))
 	   (subskip skip pat patlen str strlen char=?)))))
 ;@
 (define (substring-ci? pat str)
@@ -56,23 +60,21 @@
   (cond ((zero? patlen) 0)		; trivial match
 	((>= patlen strlen) (and (= patlen strlen) (string-ci=? pat str) 0))
 	((= 1 patlen) (string-index-ci str (string-ref pat 0)))
-	((or (<= strlen (+ patlen patlen (quotient char-code-limit 2)))
-	     (<= patlen 4))
+	((or (<= strlen (* 2 patlen))
+	     (<= patlen 2))
 	 (subloop pat patlen str strlen char-ci=?))
 	(else
-	 (let ((skip (make-vector char-code-limit (+ patlen 1))))
+	 (let ((skip '()))
+	   (define setprop (alist-associator char-ci=?))
 	   (do ((i 0 (+ i 1)))
 	       ((= i patlen))
-	     (let ((c (string-ref pat i))
-		   (d (- patlen i)))
-	       ;; use same skip value for both upper- and lowercase characters
-	       (vector-set! skip (char->integer (char-upcase c)) d)
-	       (vector-set! skip (char->integer (char-downcase c)) d)))
+	     (set! skip (setprop skip (string-ref pat i) (- patlen i))))
 	   (subskip skip pat patlen str strlen char-ci=?)))))
 
 (define (subskip skip pat patlen str strlen char=)
+  (define getprop (alist-inquirer char=?))
   (do ((k patlen (if (< k strlen)
-		     (+ k (vector-ref skip (char->integer (string-ref str k))))
+		     (+ k (or (getprop skip (string-ref str k)) (+ patlen 1)))
 		     (+ strlen 1))))
       ((or (> k strlen)
 	   (do ((i 0 (+ i 1))