Add string-copy, string=, string=?, char<?, char>?, char<=?, char>=?.

* module/srfi/srfi-13.mes: New file.
* module/mes/scm.mes (char<?, char>?, char<=?, char>=?): New function.
* module/srfi/srfi-13.mes: New file.
* tests/srfi-13.test: New file.
* string.c (string_to_symbol): Handle "".
This commit is contained in:
Jan Nieuwenhuizen 2016-12-11 21:26:27 +01:00
parent 8256f2638e
commit 51cd4885fc
5 changed files with 107 additions and 1 deletions

View file

@ -58,6 +58,7 @@ TESTS:=\
tests/scm.test\ tests/scm.test\
tests/cwv.test\ tests/cwv.test\
tests/srfi-1.test\ tests/srfi-1.test\
tests/srfi-13.test\
tests/srfi-14.test\ tests/srfi-14.test\
tests/optargs.test\ tests/optargs.test\
tests/fluids.test\ tests/fluids.test\

View file

@ -100,6 +100,11 @@
(if (null? lst) (* sign n) (if (null? lst) (* sign n)
(loop (cdr lst) (+ (* n 10) (- (char->integer (car lst)) (char->integer #\0))))))))) (loop (cdr lst) (+ (* n 10) (- (char->integer (car lst)) (char->integer #\0)))))))))
(define (char<? a b) (< (char->integer a) (char->integer b)))
(define (char>? a b) (> (char->integer a) (char->integer b)))
(define (char<=? a b) (<= (char->integer a) (char->integer b)))
(define (char>=? a b) (>= (char->integer a) (char->integer b)))
(define (vector . rest) (list->vector rest)) (define (vector . rest) (list->vector rest))
(define c:make-vector make-vector) (define c:make-vector make-vector)
(define (make-vector n . x) (define (make-vector n . x)

54
module/srfi/srfi-13.mes Normal file
View file

@ -0,0 +1,54 @@
;;; -*-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)))))))))))

View file

@ -101,7 +101,7 @@ SCM
string_to_symbol (SCM x) string_to_symbol (SCM x)
{ {
assert (TYPE (x) == STRING); assert (TYPE (x) == STRING);
return make_symbol (STRING (x)); return STRING (x) == cell_nil ? cell_nil : make_symbol (STRING (x));
} }
SCM SCM

46
tests/srfi-13.test Executable file
View file

@ -0,0 +1,46 @@
#! /bin/sh
# -*-scheme-*-
echo ' ()' | cat $(dirname $0)/../module/mes/base-0.mes $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@"
#paredit:||
exit $?
!#
;;; -*-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/>.
(mes-use-module (srfi srfi-13))
(mes-use-module (mes test))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-equal "string-split"
'("foo")
(string-split "foo" #\:))
(pass-if-equal "string-split 2"
'("foo" "")
(string-split "foo:" #\:))
(pass-if-equal "string-split 3"
'("foo" "bar" "baz")
(string-split "foo:bar:baz" #\:))
(result 'report)