core: Cleanup cells.
[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) ///((arity . n))
23 {
24   return make_string (x);
25 }
26
27 SCM
28 string_append (SCM x) ///((arity . n))
29 {
30   SCM p = cell_nil;
31   while (x != cell_nil)
32     {
33       SCM s = car (x);
34       assert (TYPE (s) == STRING);
35       p = append2 (p, STRING (s));
36       x = cdr (x);
37     }
38   return make_string (p);
39 }
40
41 SCM
42 list_to_string (SCM x)
43 {
44   return make_string (x);
45 }
46
47 SCM
48 string_length (SCM x)
49 {
50   assert (TYPE (x) == STRING);
51   return make_number (VALUE (length (STRING (x))));
52 }
53
54 SCM
55 string_ref (SCM x, SCM k)
56 {
57   assert (TYPE (x) == STRING);
58   assert (TYPE (k) == NUMBER);
59   VALUE (tmp_num) = VALUE (k);
60   return make_char (VALUE (list_ref (STRING (x), tmp_num)));
61 }
62
63 SCM
64 substring (SCM x) ///((arity . n))
65 {
66   assert (TYPE (x) == PAIR);
67   assert (TYPE (car (x)) == STRING);
68   SCM s = STRING (car (x));
69   assert (TYPE (cadr (x)) == NUMBER);
70   int start = VALUE (cadr (x));
71   int end = VALUE (length (s));
72   if (TYPE (cddr (x)) == PAIR) {
73     assert (TYPE (caddr (x)) == NUMBER);
74     assert (VALUE (caddr (x)) <= end);
75     end = VALUE (caddr (x));
76   }
77   int n = end - start;
78   while (start--) s = cdr (s);
79   SCM p = cell_nil;
80   while (n-- && s != cell_nil) {
81     p = append2 (p, cons (make_char (VALUE (car (s))), cell_nil));
82     s = cdr (s);
83   }
84   return make_string (p);
85 }
86
87 SCM
88 number_to_string (SCM x)
89 {
90   assert (TYPE (x) == NUMBER);
91   int n = VALUE (x);
92   SCM p = n < 0 ? cons (make_char ('-'), cell_nil) : cell_nil;
93   do {
94     p = cons (make_char (n % 10 + '0'), p);
95     n = n / 10;
96   } while (n);
97   return make_string (p);
98 }
99
100 SCM
101 string_to_symbol (SCM x)
102 {
103   assert (TYPE (x) == STRING);
104   return make_symbol (STRING (x));
105 }
106
107 SCM
108 symbol_to_string (SCM x)
109 {
110   assert (TYPE (x) == SYMBOL);
111   return make_string (STRING (x));
112 }