diff options
Diffstat (limited to 'mew.scm')
-rw-r--r-- | mew.scm | 29 |
1 files changed, 28 insertions, 1 deletions
diff --git a/mew.scm b/mew.scm index 902f750..7756746 100644 --- a/mew.scm +++ b/mew.scm @@ -17,7 +17,7 @@ one-of op op* per prn proj puts range rep - sing? seq set set-at str slurp + sing? search seq set set-at str slurp tally-accumulator tbl time while uniq-accumulator unlist until @@ -800,6 +800,33 @@ (map list (cdr exn)))) (apply fail '(exn) exn args))) + ;; The QuickSearch algorithm, for generic sequences + ;; http://www-igm.univ-mlv.fr/~lecroq/string/node19.html#SECTION00190 + (define search + (case-lambda + ((needle haystack) (search needle haystack 0)) + ((needle haystack start) + (let* ((lh (len haystack)) + (ln (len needle)) + (t (into (tbl) (gmap (lambda (c i) + (cons c (- ln i))) + (gen needle) + (range 0))))) + (def (match? offset) + (let loop ((i (dec ln))) + (and (=? (at haystack (+ i offset)) (at needle i)) + (or (zero? i) + (loop (dec i)))))) + + (if (zero? ln) + start + (let loop ((i start)) + (if (<= i (- lh ln)) + (if (match? i) + i + (loop (+ i (get t (get haystack (+ i ln) #f) (inc ln))))) + #f))))))) + (let ((old-repl-prompt (repl-prompt))) (repl-prompt (lambda () (let ((old-prompt (old-repl-prompt))) |