build: Resurrect --with-cheating.
[mes.git] / src / struct.c
1 /* -*-comment-start: "//";comment-end:""-*-
2  * GNU Mes --- Maxwell Equations of Software
3  * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
4  *
5  * This file is part of GNU Mes.
6  *
7  * GNU 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  * GNU 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 GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
19  */
20
21 #include "mes/lib.h"
22 #include "mes/mes.h"
23
24 #include <assert.h>
25
26 SCM
27 make_struct (SCM type, SCM fields, SCM printer)
28 {
29   long size = 2 + length__ (fields);
30   SCM v = alloc (size);
31   SCM x = make_cell__ (TSTRUCT, size, v);
32   g_cells[v] = g_cells[vector_entry (type)];
33   g_cells[v + 1] = g_cells[vector_entry (printer)];
34   for (long i = 2; i < size; i++)
35     {
36       SCM e = cell_unspecified;
37       if (fields != cell_nil)
38         {
39           e = CAR (fields);
40           fields = CDR (fields);
41         }
42       g_cells[v + i] = g_cells[vector_entry (e)];
43     }
44   return x;
45 }
46
47 SCM
48 struct_length (SCM x)
49 {
50   assert (TYPE (x) == TSTRUCT);
51   return MAKE_NUMBER (LENGTH (x));
52 }
53
54 SCM
55 struct_ref_ (SCM x, long i)
56 {
57   assert (TYPE (x) == TSTRUCT);
58   assert (i < LENGTH (x));
59   SCM e = STRUCT (x) + i;
60   if (TYPE (e) == TREF)
61     e = REF (e);
62   if (TYPE (e) == TCHAR)
63     e = MAKE_CHAR (VALUE (e));
64   if (TYPE (e) == TNUMBER)
65     e = MAKE_NUMBER (VALUE (e));
66   return e;
67 }
68
69 SCM
70 struct_set_x_ (SCM x, long i, SCM e)
71 {
72   assert (TYPE (x) == TSTRUCT);
73   assert (i < LENGTH (x));
74   g_cells[STRUCT (x) + i] = g_cells[vector_entry (e)];
75   return cell_unspecified;
76 }
77
78 SCM
79 struct_ref (SCM x, SCM i)
80 {
81   return struct_ref_ (x, VALUE (i));
82 }
83
84 SCM
85 struct_set_x (SCM x, SCM i, SCM e)
86 {
87   return struct_set_x_ (x, VALUE (i), e);
88 }