88 lines
3.1 KiB
Scheme
88 lines
3.1 KiB
Scheme
;;; -*-scheme-*-
|
|
|
|
;;; Mes --- Maxwell Equations of Software
|
|
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
|
|
;;;
|
|
;;; This file is part of Mes.
|
|
;;;
|
|
;;; Mes is free software; you can redistribute it and/or modify it
|
|
;;; under the terms of the GNU General Public License as published by
|
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
;;; your option) any later version.
|
|
;;;
|
|
;;; Mes is distributed in the hope that it will be useful, but
|
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;; GNU General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;;; srfi-13.mes is the minimal srfi-13
|
|
|
|
;;; Code:
|
|
|
|
(mes-use-module (srfi srfi-1))
|
|
|
|
(define (string-copy s)
|
|
(list->string (string->list s)))
|
|
|
|
(define (string=? a b)
|
|
(eq? (string->symbol a)
|
|
(string->symbol b)))
|
|
|
|
(define (string= a b . rest)
|
|
(let* ((start1 (and (pair? rest) (car rest)))
|
|
(end1 (and start1 (pair? (cdr rest)) (cadr rest)))
|
|
(start2 (and end1 (pair? (cddr rest)) (caddr rest)))
|
|
(end2 (and start2 (pair? (cdddr rest)) (cadddr rest))))
|
|
(string=? (if start1 (if end1 (substring a start1 end1)
|
|
(substring a start1))
|
|
a)
|
|
(if start2 (if end2 (substring b start2 end2)
|
|
(substring b start2))
|
|
b))))
|
|
|
|
(define (string-split s c)
|
|
(let loop ((lst (string->list s)) (result '()))
|
|
(let ((rest (memq c lst)))
|
|
(if (not rest) (append result (list (list->string lst)))
|
|
(loop (cdr rest)
|
|
(append result
|
|
(list (list->string (list-head lst (- (length lst) (length rest)))))))))))
|
|
|
|
(define (string-take s n)
|
|
(list->string (list-head (string->list s) n)))
|
|
|
|
(define (string-drop s n)
|
|
(list->string (list-tail (string->list s) n)))
|
|
|
|
(define (string-delete pred s)
|
|
(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)))
|
|
(pred (if (char? pred) (lambda (c) (eq? c 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 (pred (car lst)) i
|
|
(loop (cdr lst) (1+ i)))))))
|
|
|
|
(define (string-rindex s pred . rest)
|
|
(let* ((start (and (pair? rest) (car rest)))
|
|
(end (and start (pair? (cdr rest)) (cadr rest)))
|
|
(pred (if (char? pred) (lambda (c) (eq? c pred)) pred)))
|
|
(if start (error "string-rindex: not supported: start=" start))
|
|
(if end (error "string-rindex: not supported: end=" end))
|
|
(let loop ((lst (reverse (string->list s))) (i (1- (string-length s))))
|
|
(if (null? lst) #f
|
|
(if (pred (car lst)) i
|
|
(loop (cdr lst) (1- i)))))))
|