test: Enable vector read test.
[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 0
29   //__GNUC__
30   for (int i=0; i<k; i++) g_cells[v+i] = g_cells[vector_entry (cell_unspecified)];
31 #else
32   for (int i=0; i<k; i++)
33     {
34       SCM y = v+i;
35       SCM z = vector_entry (cell_unspecified);
36       //g_cells[y] = g_cells[z];
37       SCM zz = TYPE (z);
38       TYPE (y) = zz;
39       zz = CAR (z);
40       CAR (y) = zz;
41       zz = CDR (z);
42       CDR (y) = zz;
43     }
44 #endif
45   return x;
46 }
47
48 SCM
49 vector_length (SCM x)
50 {
51   assert (TYPE (x) == TVECTOR);
52   return MAKE_NUMBER (LENGTH (x));
53 }
54
55 SCM
56 vector_ref (SCM x, SCM i)
57 {
58   assert (TYPE (x) == TVECTOR);
59   assert (VALUE (i) < LENGTH (x));
60   SCM e = VECTOR (x) + VALUE (i);
61   if (TYPE (e) == TREF) e = REF (e);
62   if (TYPE (e) == TCHAR) e = MAKE_CHAR (VALUE (e));
63   if (TYPE (e) == TNUMBER) e = MAKE_NUMBER (VALUE (e));
64   return e;
65 }
66
67 SCM
68 vector_entry (SCM x) {
69   if (TYPE (x) == TPAIR || TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL || TYPE (x) == TVECTOR) x = MAKE_REF (x);
70   return x;
71 }
72
73 SCM
74 vector_set_x (SCM x, SCM i, SCM e)
75 {
76   assert (TYPE (x) == TVECTOR);
77   assert (VALUE (i) < LENGTH (x));
78 #if 0
79   //__GNUC__
80   g_cells[VECTOR (x)+VALUE (i)] = g_cells[vector_entry (e)];
81 #else
82   SCM y = VECTOR (x)+VALUE (i);
83   SCM z = vector_entry (e);
84   //g_cells[y] = g_cells[z];
85   SCM zz = TYPE (z);
86   TYPE (y) = zz;
87   zz = CAR (z);
88   CAR (y) = zz;
89   zz = CDR (z);
90   CDR (y) = zz;
91 #endif
92   return cell_unspecified;
93 }
94
95 SCM
96 list_to_vector (SCM x)
97 {
98   VALUE (tmp_num) = VALUE (length (x));
99   SCM v = make_vector (tmp_num);
100   SCM p = VECTOR (v);
101   while (x != cell_nil)
102     {
103 #if 0
104       //__GNUC__
105       g_cells[p++] = g_cells[vector_entry (car (x))];
106 #else
107       SCM y = p;
108       SCM z = vector_entry (car (x));
109       //g_cells[p++] = g_cells[y];
110       SCM zz = TYPE (z);
111       TYPE (y) = zz;
112       zz = CAR (z);
113       CAR (y) = zz;
114       zz = CDR (z);
115       CDR (y) = zz;
116       p++;
117 #endif
118       x = cdr (x);
119     }
120   return v;
121 }
122
123 SCM
124 vector_to_list (SCM v)
125 {
126   SCM x = cell_nil;
127   for (int i = 0; i < LENGTH (v); i++) {
128     SCM e = VECTOR (v)+i;
129     if (TYPE (e) == TREF) e = REF (e);
130     x = append2 (x, cons (e, cell_nil));
131   }
132   return x;
133 }