From f24b9140d6f74804d5599ec225717d38ca443813 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:26 -0800 Subject: Import Upstream version 2c0 --- strsrch.scm | 46 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 37 insertions(+), 9 deletions(-) (limited to 'strsrch.scm') diff --git a/strsrch.scm b/strsrch.scm index a08510e..b25c229 100644 --- a/strsrch.scm +++ b/strsrch.scm @@ -1,6 +1,6 @@ ;;; "MISCIO" Search for string from port. ; Written 1995, 1996 by Oleg Kiselyov (oleg@ponder.csci.unt.edu) -; Modified 1996 by A. Jaffer (jaffer@ai.mit.edu) +; Modified 1996, 1997 by A. Jaffer (jaffer@ai.mit.edu) ; ; This code is in the public domain. @@ -13,7 +13,27 @@ ((char=? a-char (string-ref str pos)) pos) (else (loop (+ 1 pos)))))) -(define (substring? pattern str) +(define (string-index-ci str a-char) + (let loop ((pos 0)) + (cond + ;; whole string has been searched, in vain + ((>= pos (string-length str)) #f) + ((char-ci=? a-char (string-ref str pos)) pos) + (else (loop (+ 1 pos)))))) + +(define (string-reverse-index str a-char) + (let loop ((pos (- (string-length str) 1))) + (cond ((< pos 0) #f) + ((char=? (string-ref str pos) a-char) pos) + (else (loop (- pos 1)))))) + +(define (string-reverse-index-ci str a-char) + (let loop ((pos (- (string-length str) 1))) + (cond ((< pos 0) #f) + ((char-ci=? (string-ref str pos) a-char) pos) + (else (loop (- pos 1)))))) + +(define (miscio:substring? pattern str char=?) (let* ((pat-len (string-length pattern)) (search-span (- (string-length str) pat-len)) (c1 (if (zero? pat-len) #f (string-ref pattern 0))) @@ -39,24 +59,32 @@ ;; mismatch after partial match (outer (+ 1 pos)))))))))))) +(define (substring? pattern str) (miscio:substring? pattern str char=?)) +(define (substring-ci? pattern str) (miscio:substring? pattern str char-ci=?)) + (define (find-string-from-port? str . max-no-char) (set! max-no-char (if (null? max-no-char) #f (car max-no-char))) (letrec ((no-chars-read 0) (my-peek-char ; Return a peeked char or #f - (lambda () (and (or (not max-no-char) (< no-chars-read max-no-char)) + (lambda () (and (or (not (number? max-no-char)) + (< no-chars-read max-no-char)) (let ((c (peek-char ))) - (if (eof-object? c) #f c))))) + (and (not (eof-object? c)) + (if (procedure? max-no-char) + (not (max-no-char c)) + (not (eqv? max-no-char c))) + c))))) (next-char (lambda () (read-char ) (set! no-chars-read (+ 1 no-chars-read)))) (match-1st-char ; of the string str (lambda () (let ((c (my-peek-char))) - (if (not c) #f - (begin (next-char) - (if (char=? c (string-ref str 0)) - (match-other-chars 1) - (match-1st-char))))))) + (and c + (begin (next-char) + (if (char=? c (string-ref str 0)) + (match-other-chars 1) + (match-1st-char))))))) ;; There has been a partial match, up to the point pos-to-match ;; (for example, str[0] has been found in the stream) ;; Now look to see if str[pos-to-match] for would be found, too -- cgit v1.2.3