diff --git a/GNUmakefile b/GNUmakefile index d54cb278..3b96a1f7 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -60,6 +60,7 @@ TESTS:=\ tests/scm.test\ tests/cwv.test\ tests/srfi-1.test\ + tests/srfi-14.test\ tests/optargs.test\ tests/fluids.test\ tests/catch.test\ diff --git a/module/srfi/srfi-14.mes b/module/srfi/srfi-14.mes new file mode 100644 index 00000000..6d383b6d --- /dev/null +++ b/module/srfi/srfi-14.mes @@ -0,0 +1,48 @@ +;;; -*-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: + +;;; Minimal implementation of srfi-14, for nyacc. + +;;; Code: + +;; FIXME: have structs +(define (char-set . x) + (cons '*char-set* x)) + +(define (char-set? x) + (and (pair? x) (eq? (car x) '*char-set*))) + +(define (char-set= a b) + (and (char-set? a) (char-set? b) + (equal? a b))) + +(define char-set:whitespace (char-set #\tab #\return #\vtab #\newline #\space)) + +(define (string->char-set x . base) + (apply char-set (append (string->list x) (if (null? base) '() (cdar base))))) + +(define (string->char-set! x base) + (set-cdr! (last-pair base) (string->list x)) + base) + +(define (char-set-contains? cs x) + (memq x cs)) diff --git a/tests/srfi-14.test b/tests/srfi-14.test new file mode 100755 index 00000000..b15c3e3d --- /dev/null +++ b/tests/srfi-14.test @@ -0,0 +1,48 @@ +#! /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 . + +(cond-expand (guile (use-modules (srfi srfi-14))) (mes)) +(mes-use-module (srfi srfi-14)) +(mes-use-module (mes test)) + +(pass-if "first dummy" #t) +(pass-if-not "second dummy" #f) + +(pass-if "char-set=" + (char-set= (char-set #\a #\b #\c) (char-set #\a #\b #\c))) + +(pass-if "char-set= 2" + (char-set= (char-set #\a #\b #\c) (string->char-set "abc"))) + +(pass-if "char-set-contains?" + (char-set-contains? char-set:whitespace #\space)) + +(pass-if "string->char-set!" + (char-set= (char-set #\a #\b #\c #\d) (string->char-set! "d" (string->char-set "abc")))) + +(result 'report) +