26acf80462050d2c66a40b494176c9eaca0c0f96
[mes.git] / vector.c
1 /* -*-comment-start: "//";comment-end:""-*-
2  * Mes --- Maxwell Equations of Software
3  * Copyright © 2016,2017 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 make_vector (SCM n)
23 {
24   int k = VALUE (n);
25   VALUE (tmp_num) = TVECTOR;
26   SCM v = alloc (k);
27   SCM x = make_cell_ (tmp_num, k, v);
28 #if __GNUC__
29   for (int i=0; i<k; i++) g_cells[v+i] = g_cells[vector_entry (cell_unspecified)];
30 #else
31   for (int i=v; i<k+v; i++)
32     {
33       SCM t = vector_entry (cell_unspecified);
34       struct scm s = g_cells[t];
35       s = g_cells[t];
36       g_cells[i] = s;
37     }
38 #endif
39   return x;
40 }
41
42 SCM
43 vector_length (SCM x)
44 {
45   assert (TYPE (x) == TVECTOR);
46   return MAKE_NUMBER (LENGTH (x));
47 }
48
49 SCM
50 vector_ref (SCM x, SCM i)
51 {
52   assert (TYPE (x) == TVECTOR);
53   assert (VALUE (i) < LENGTH (x));
54   SCM e = VECTOR (x) + VALUE (i);
55   if (TYPE (e) == TREF) e = REF (e);
56   if (TYPE (e) == TCHAR) e = MAKE_CHAR (VALUE (e));
57   if (TYPE (e) == TNUMBER) e = MAKE_NUMBER (VALUE (e));
58   return e;
59 }
60
61 SCM
62 vector_entry (SCM x) {
63   if (TYPE (x) == TPAIR || TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL || TYPE (x) == TVECTOR) x = MAKE_REF (x);
64   return x;
65 }
66
67 SCM
68 vector_set_x (SCM x, SCM i, SCM e)
69 {
70   assert (TYPE (x) == TVECTOR);
71   assert (VALUE (i) < LENGTH (x));
72 #if __GNUC__
73   g_cells[VECTOR (x)+VALUE (i)] = g_cells[vector_entry (e)];
74 #else
75   SCM a = VECTOR (x)+VALUE (i);
76   SCM b = vector_entry (e);
77   g_cells[a] = g_cells[b];
78 #endif
79   return cell_unspecified;
80 }
81
82 SCM
83 list_to_vector (SCM x)
84 {
85   VALUE (tmp_num) = VALUE (length (x));
86   SCM v = make_vector (tmp_num);
87   SCM p = VECTOR (v);
88   while (x != cell_nil)
89     {
90 #if __GNUC__
91       g_cells[p++] = g_cells[vector_entry (car (x))];
92 #else
93       SCM b = vector_entry (car (x));
94       g_cells[p++] = g_cells[b];
95 #endif
96       x = cdr (x);
97     }
98   return v;
99 }
100
101 SCM
102 vector_to_list (SCM v)
103 {
104   SCM x = cell_nil;
105   for (int i = 0; i < LENGTH (v); i++) {
106     SCM e = VECTOR (v)+i;
107     if (TYPE (e) == TREF) e = REF (e);
108     x = append2 (x, cons (e, cell_nil));
109   }
110   return x;
111 }