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

(require 'char-set:member?)

;+doc
; procedure: substring:find-chars-r->l
; arguments: string start end chars if-found if-not-found state
; signature: forall a
;         => string x char-set x int x int x (int x (a -> a) x a) x (a -> a)
;         -> a
; pre:       (<= start end (string-length string))
;
; Searches STRING from right to left between START (inclusive) and END
; (exclusive) looking for characters that are in CHARS.  If a
; character is found, IF-FOUND is called with the position at which
; the character was found, a continuation which if called will find
; the next position of the character and the STATE of the system.
;-doc

(define substring:find-chars-r->l
  (lambda (s ss se cs if-found if-not-found st)
    (if (= ss se)
	(if-not-found st)
	(let loop ((p (- se 1)) (ns st))
	  (cond
	   ((< p ss) (if-not-found ns))
	   ((char-set:member? cs (string-ref s p))
	    (if-found p (lambda (s) (loop (- p 1) s)) ns))
	   (else (loop (- p 1) ns)))))))

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

;+doc
; procedure: string:find-chars-r->l
; arguments: string chars if-found if-not-found state
; signature: forall a
;         => string x char-set x (int x (a -> a) x a) x (a -> a) x a -> a
;
; Searches STRING from right to left looking for charcters that are in
; CHARS.  If CHAR is found, IF-FOUND is called with the position at
; which the character was found, a continuation which if called will
; find the next position of the character and the STATE of the system.
;-doc

(define string:find-chars-r->l
  (lambda (s cs yes no st)
    (substring:find-chars-r->l s 0 (string-length s) cs yes no st)))

; eof
