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:
parent
8256f2638e
commit
51cd4885fc
|
@ -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\
|
||||||
|
|
|
@ -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
54
module/srfi/srfi-13.mes
Normal 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)))))))))))
|
2
string.c
2
string.c
|
@ -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
46
tests/srfi-13.test
Executable 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)
|
Loading…
Reference in a new issue