diff --git a/GNUmakefile b/GNUmakefile index f8aa33dc..5f23d70b 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -27,6 +27,7 @@ mes.o: mes.c mes.environment.h mes.environment.i mes.symbols.i mes.o: define.c define.environment.h define.environment.i mes.o: math.c math.environment.h math.environment.i mes.o: quasiquote.c quasiquote.environment.h quasiquote.environment.i +mes.o: string.c string.environment.h string.environment.i mes.o: type.c type.environment.h type.environment.i clean: diff --git a/mes.c b/mes.c index cba0d05b..7c6d0ba9 100644 --- a/mes.c +++ b/mes.c @@ -66,6 +66,7 @@ scm temp_number = {NUMBER, .name="nul", .value=0}; #include "define.environment.h" #include "quasiquote.environment.h" #include "math.environment.h" +#include "string.environment.h" #include "mes.environment.h" scm *display_ (FILE* f, scm *x); @@ -194,11 +195,6 @@ quasisyntax (scm *x) return cons (&symbol_quasisyntax, x); } -#include "type.c" -#include "define.c" -#include "math.c" -#include "quasiquote.c" - //Library functions // Derived, non-primitives @@ -598,87 +594,6 @@ make_vector (scm *n) return p; } -scm * -string (scm *x) ///((args . n)) -{ - char buf[STRING_MAX] = ""; - char *p = buf; - while (x != &scm_nil) - { - scm *s = car (x); - assert (s->type == CHAR); - *p++ = s->value; - x = cdr (x); - } - return make_string (buf); -} - -scm * -string_append (scm *x) ///((args . n)) -{ - char buf[STRING_MAX] = ""; - - while (x != &scm_nil) - { - scm *s = car (x); - assert (s->type == STRING); - strcat (buf, s->name); - x = cdr (x); - } - return make_string (buf); -} - -scm * -list_to_string (scm *x) -{ - char buf[STRING_MAX] = ""; - char *p = buf; - while (x != &scm_nil) - { - scm *s = car (x); - assert (s->type == CHAR); - *p++ = s->value; - x = cdr (x); - } - *p = 0; - return make_string (buf); -} - -scm * -string_length (scm *x) -{ - assert (x->type == STRING); - return make_number (strlen (x->name)); -} - -scm * -string_ref (scm *x, scm *k) -{ - assert (x->type == STRING); - assert (k->type == NUMBER); - return make_char (x->name[k->value]); -} - -scm * -substring (scm *x) ///((args . n)) -{ - assert (x->type == PAIR); - assert (x->car->type == STRING); - char const *s = x->car->name; - assert (x->cdr->car->type == NUMBER); - int start = x->cdr->car->value; - int end = strlen (s); - if (x->cdr->cdr->type == PAIR) { - assert (x->cdr->cdr->car->type == NUMBER); - assert (x->cdr->cdr->car->value <= end); - end = x->cdr->cdr->car->value; - } - char buf[STRING_MAX]; - strncpy (buf, s+start, end - start); - buf[end-start] = 0; - return make_string (buf); -} - scm * length (scm *x) { @@ -828,15 +743,6 @@ char_to_integer (scm *x) return make_number (x->value); } -scm * -number_to_string (scm *x) -{ - assert (x->type == NUMBER); - char buf[STRING_MAX]; - sprintf (buf,"%d", x->value); - return make_string (buf); -} - scm * builtin_exit (scm *x) { @@ -844,20 +750,6 @@ builtin_exit (scm *x) exit (x->value); } -scm * -string_to_symbol (scm *x) -{ - assert (x->type == STRING); - return make_symbol (x->name); -} - -scm * -symbol_to_string (scm *x) -{ - assert (x->type == SYMBOL); - return make_string (x->name); -} - scm * vector_to_list (scm *v) { @@ -1184,6 +1076,7 @@ mes_environment () ///((internal)) a = cons (cons (&symbol_quote, &scm_quote), a); a = cons (cons (&symbol_syntax, &scm_syntax), a); +#include "string.environment.i" #include "math.environment.i" #include "mes.environment.i" #include "define.environment.i" @@ -1226,6 +1119,12 @@ read_file (scm *e, scm *a) #endif } +#include "type.c" +#include "define.c" +#include "math.c" +#include "quasiquote.c" +#include "string.c" + int main (int argc, char *argv[]) { diff --git a/string.c b/string.c new file mode 100644 index 00000000..d0f792a6 --- /dev/null +++ b/string.c @@ -0,0 +1,123 @@ +/* -*-comment-start: "//";comment-end:""-*- + * 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 . + */ + +scm * +string (scm *x) ///((args . n)) +{ + char buf[STRING_MAX] = ""; + char *p = buf; + while (x != &scm_nil) + { + scm *s = car (x); + assert (s->type == CHAR); + *p++ = s->value; + x = cdr (x); + } + return make_string (buf); +} + +scm * +string_append (scm *x) ///((args . n)) +{ + char buf[STRING_MAX] = ""; + + while (x != &scm_nil) + { + scm *s = car (x); + assert (s->type == STRING); + strcat (buf, s->name); + x = cdr (x); + } + return make_string (buf); +} + +scm * +list_to_string (scm *x) +{ + char buf[STRING_MAX] = ""; + char *p = buf; + while (x != &scm_nil) + { + scm *s = car (x); + assert (s->type == CHAR); + *p++ = s->value; + x = cdr (x); + } + *p = 0; + return make_string (buf); +} + +scm * +string_length (scm *x) +{ + assert (x->type == STRING); + return make_number (strlen (x->name)); +} + +scm * +string_ref (scm *x, scm *k) +{ + assert (x->type == STRING); + assert (k->type == NUMBER); + return make_char (x->name[k->value]); +} + +scm * +substring (scm *x) ///((args . n)) +{ + assert (x->type == PAIR); + assert (x->car->type == STRING); + char const *s = x->car->name; + assert (x->cdr->car->type == NUMBER); + int start = x->cdr->car->value; + int end = strlen (s); + if (x->cdr->cdr->type == PAIR) { + assert (x->cdr->cdr->car->type == NUMBER); + assert (x->cdr->cdr->car->value <= end); + end = x->cdr->cdr->car->value; + } + char buf[STRING_MAX]; + strncpy (buf, s+start, end - start); + buf[end-start] = 0; + return make_string (buf); +} + +scm * +number_to_string (scm *x) +{ + assert (x->type == NUMBER); + char buf[STRING_MAX]; + sprintf (buf,"%d", x->value); + return make_string (buf); +} + +scm * +string_to_symbol (scm *x) +{ + assert (x->type == STRING); + return make_symbol (x->name); +} + +scm * +symbol_to_string (scm *x) +{ + assert (x->type == SYMBOL); + return make_string (x->name); +}