a0baa98196
* module/srfi/srfi-13.mes (string-take, string-drop): New functions.
61 lines
2 KiB
Scheme
61 lines
2 KiB
Scheme
;;; -*-scheme-*-
|
|
|
|
;;; Mes --- Maxwell Equations of Software
|
|
;;; Copyright © 2016 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)))
|