diff --git a/module/srfi/srfi-13.mes b/module/srfi/srfi-13.mes index caf31a00..98b2d667 100644 --- a/module/srfi/srfi-13.mes +++ b/module/srfi/srfi-13.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan Nieuwenhuizen +;;; Copyright © 2016,2017 Jan Nieuwenhuizen ;;; ;;; This file is part of Mes. ;;; @@ -63,3 +63,14 @@ (let ((p (if (procedure? pred) pred (lambda (c) (not (eq? pred c)))))) (list->string (filter p (string->list s))))) + +(define (string-index s pred . rest) + (let* ((start (and (pair? rest) (car rest))) + (end (and start (pair? (cdr rest)) (cadr rest)))) + (if (not (char? pred)) (error "string-index: not supported: pred=" pred)) + (if start (error "string-index: not supported: start=" start)) + (if end (error "string-index: not supported: end=" end)) + (let loop ((lst (string->list s)) (i 0)) + (if (null? lst) #f + (if (eq? (car lst) pred) i + (loop (cdr lst) (1+ i))))))) diff --git a/tests/srfi-13.test b/tests/srfi-13.test index e3bae7b6..14972d7a 100755 --- a/tests/srfi-13.test +++ b/tests/srfi-13.test @@ -9,7 +9,7 @@ exit $? ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan Nieuwenhuizen +;;; Copyright © 2016,2017 Jan Nieuwenhuizen ;;; ;;; This file is part of Mes. ;;; @@ -44,4 +44,8 @@ exit $? '("foo" "bar" "baz") (string-split "foo:bar:baz" #\:)) +(pass-if-equal "string-index" + 3 + (string-index "foo:bar" #\:)) + (result 'report)