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 "".

diff --git a/GNUmakefile b/GNUmakefile
index 6c2a681a5aff6b40729858ff5b0c685cb603f602..7a77588cbbe0cab2e29aeddea44c182e1a128020 100644 (file)
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -58,6 +58,7 @@ TESTS:=\
  tests/scm.test\
  tests/cwv.test\
  tests/srfi-1.test\
+ tests/srfi-13.test\
  tests/srfi-14.test\
  tests/optargs.test\
  tests/fluids.test\

diff --git a/module/mes/scm.mes b/module/mes/scm.mes
index a9898c8ad95300cb3190f58cbef025b2f777d374..1801834720b932921fb65c809cb9107530efc420 100644 (file)
--- a/module/mes/scm.mes
+++ b/module/mes/scm.mes
@@ -100,6 +100,11 @@
           (if (null? lst) (* sign n)
               (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 c:make-vector make-vector)
 (define (make-vector n . x)

diff --git a/module/srfi/srfi-13.mes b/module/srfi/srfi-13.mes
new file mode 100644 (file)
index 0000000..18a7f65
--- /dev/null
+++ b/module/srfi/srfi-13.mes
@@ -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)))))))))))

diff --git a/string.c b/string.c
index 36c27816381fd4d466ae6a78eade536cd9bf651b..b62a4a9476e7d99e1945b30007db5a12c06e13c4 100644 (file)
--- a/string.c
+++ b/string.c
@@ -101,7 +101,7 @@ SCM
 string_to_symbol (SCM x)
 {
   assert (TYPE (x) == STRING);
-  return make_symbol (STRING (x));
+  return STRING (x) == cell_nil ? cell_nil : make_symbol (STRING (x));
 }
 
 SCM

diff --git a/tests/srfi-13.test b/tests/srfi-13.test
new file mode 100755 (executable)
index 0000000..0dabe26
--- /dev/null
+++ b/tests/srfi-13.test
@@ -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)