From 51cd4885fc3ccbab43203fc3037d58164d09c73a Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 11 Dec 2016 21:26:27 +0100 Subject: [PATCH] =?UTF-8?q?Add=20string-copy,=20string=3D,=20string=3D=3F,?= =?UTF-8?q?=20char<=3F,=20char>=3F,=20char<=3D=3F,=20char>=3D=3F.?= * module/srfi/srfi-13.mes: New file. * module/mes/scm.mes (char?, char<=?, char>=?): New function. * module/srfi/srfi-13.mes: New file. * tests/srfi-13.test: New file. * string.c (string_to_symbol): Handle "". --- GNUmakefile | 1 + module/mes/scm.mes | 5 ++++ module/srfi/srfi-13.mes | 54 +++++++++++++++++++++++++++++++++++++++++ string.c | 2 +- tests/srfi-13.test | 46 +++++++++++++++++++++++++++++++++++ 5 files changed, 107 insertions(+), 1 deletion(-) create mode 100644 module/srfi/srfi-13.mes create mode 100755 tests/srfi-13.test diff --git a/GNUmakefile b/GNUmakefile index 6c2a681a..7a77588c 100644 --- 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 a9898c8a..18018347 100644 --- 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 (charinteger 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 index 00000000..18a7f650 --- /dev/null +++ b/module/srfi/srfi-13.mes @@ -0,0 +1,54 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; 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 . + +;;; 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 36c27816..b62a4a94 100644 --- 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 index 00000000..0dabe268 --- /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 +;;; +;;; 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 . + +(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)