artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: Add string-fold, string-fold-right.

Browse source 
* module/srfi/srfi-13.mes (string-fold, string-fold-right): New
  function.
* tests/srfi-13.test ("string-fold"): Test it.
  ("string-fold-right"): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-07 13:37:07 +02:00
parent c4b0879bc9
commit 4958921abc
2 changed files with 27 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
module/srfi/srfi-13.mes
View file

@ -96,3 +96,21 @@
(define substring/shared substring)
(define string-null? (compose null? string->list))
(define (string-fold cons' nil' s . rest)
(let* ((start (and (pair? rest) (car rest)))
(end (and start (pair? (cdr rest)) (cadr rest))))
(if start (error "string-fold: not supported: start=" start))
(if end (error "string-fold: not supported: end=" end))
(let loop ((lst (string->list s)) (prev nil'))
(if (null? lst) prev
(loop (cdr lst) (cons' (car lst) prev))))))
(define (string-fold-right cons' nil' s . rest)
(let* ((start (and (pair? rest) (car rest)))
(end (and start (pair? (cdr rest)) (cadr rest))))
(if start (error "string-fold-right: not supported: start=" start))
(if end (error "string-fold-right: not supported: end=" end))
(let loop ((lst (reverse (string->list s))) (prev nil'))
(if (null? lst) prev
(loop (cdr lst) (cons' (car lst) prev))))))

10
tests/srfi-13.test
View file

@ -9,7 +9,7 @@ exit $?
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
@ -48,4 +48,12 @@ exit $?
3
(string-index "foo:bar" #\:))
(pass-if-equal "string-fold"
"oof"
(list->string (string-fold cons '() "foo")))
(pass-if-equal "string-fold-right"
"f-o-o-:"
(list->string (string-fold-right (lambda (e p) (cons e (cons #\- p))) '(#\:) "foo")))
(result 'report)