Move strings to string.c.
[mes.git] / string.c
1 /* -*-comment-start: "//";comment-end:""-*-
2  * Mes --- Maxwell Equations of Software
3  * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
4  *
5  * This file is part of Mes.
6  *
7  * Mes is free software; you can redistribute it and/or modify it
8  * under the terms of the GNU General Public License as published by
9  * the Free Software Foundation; either version 3 of the License, or (at
10  * your option) any later version.
11  *
12  * Mes is distributed in the hope that it will be useful, but
13  * WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
19  */
20
21 scm *
22 string (scm *x) ///((args . n))
23 {
24   char buf[STRING_MAX] = "";
25   char *p = buf;
26   while (x != &scm_nil)
27     {
28       scm *s = car (x);
29       assert (s->type == CHAR);
30       *p++ = s->value;
31       x = cdr (x);
32     }
33   return make_string (buf);
34 }
35
36 scm *
37 string_append (scm *x) ///((args . n))
38 {
39   char buf[STRING_MAX] = "";
40
41   while (x != &scm_nil)
42     {
43       scm *s = car (x);
44       assert (s->type == STRING);
45       strcat (buf, s->name);
46       x = cdr (x);
47     }
48   return make_string (buf);
49 }
50
51 scm *
52 list_to_string (scm *x)
53 {
54   char buf[STRING_MAX] = "";
55   char *p = buf;
56   while (x != &scm_nil)
57     {
58       scm *s = car (x);
59       assert (s->type == CHAR);
60       *p++ = s->value;
61       x = cdr (x);
62     }
63   *p = 0;
64   return make_string (buf);
65 }
66
67 scm *
68 string_length (scm *x)
69 {
70   assert (x->type == STRING);
71   return make_number (strlen (x->name));
72 }
73
74 scm *
75 string_ref (scm *x, scm *k)
76 {
77   assert (x->type == STRING);
78   assert (k->type == NUMBER);
79   return make_char (x->name[k->value]);
80 }
81
82 scm *
83 substring (scm *x) ///((args . n))
84 {
85   assert (x->type == PAIR);
86   assert (x->car->type == STRING);
87   char const *s = x->car->name;
88   assert (x->cdr->car->type == NUMBER);
89   int start = x->cdr->car->value;
90   int end = strlen (s);
91   if (x->cdr->cdr->type == PAIR) {
92     assert (x->cdr->cdr->car->type == NUMBER);
93     assert (x->cdr->cdr->car->value <= end);
94     end = x->cdr->cdr->car->value;
95   }
96   char buf[STRING_MAX];
97   strncpy (buf, s+start, end - start);
98   buf[end-start] = 0;
99   return make_string (buf);
100 }
101
102 scm *
103 number_to_string (scm *x)
104 {
105   assert (x->type == NUMBER);
106   char buf[STRING_MAX];
107   sprintf (buf,"%d", x->value);
108   return make_string (buf);
109 }
110
111 scm *
112 string_to_symbol (scm *x)
113 {
114   assert (x->type == STRING);
115   return make_symbol (x->name);
116 }
117
118 scm *
119 symbol_to_string (scm *x)
120 {
121   assert (x->type == SYMBOL);
122   return make_string (x->name);
123 }