andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mes: Basic support for string-index. 

* module/srfi/srfi-13.mes (string-index): New function.
* tests/srfi-13.test ("string-index"): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2017-05-06 23:00:27 +02:00
parent 529ab8caa1
commit c84f95beee
2 changed files with 17 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
module/srfi/srfi-13.mes
View File

@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; 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)))))))

6
tests/srfi-13.test
View File

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; 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)