60c004125b6860078648ffae78e5b576a50a382d
[mes.git] / src / module.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 SCM struct_ref_ (SCM x, long i);
22 SCM struct_set_x_ (SCM x, long i, SCM e);
23
24 SCM
25 make_initial_module (SCM a) ///((internal))
26 {
27   SCM fields = cell_nil;
28   fields = cons (cstring_to_symbol ("globals"), fields);
29   fields = cons (cstring_to_symbol ("locals"), fields);
30   fields = cons (cstring_to_symbol ("name"), fields);
31   fields = cons (cstring_to_symbol ("<module>"), fields);
32   SCM module_type = make_struct (cstring_to_symbol ("record-type"), fields, cell_unspecified);
33   SCM module_type_name = cstring_to_symbol ("<module>");
34   a = acons (module_type_name, module_type, a);
35   SCM values = cell_nil;
36   SCM name = cons (cstring_to_symbol ("boot"), cell_nil);
37   SCM globals = make_hash_table_ (0);
38   values = cons (globals, values);
39   SCM locals = cell_nil;
40   values = cons (locals, values);
41   values = cons (name, values);
42   SCM module = make_struct (module_type_name, values, cell_module_printer);
43   r0 = cell_nil;
44   r0 = cons (CAR (a), r0);
45
46   m0 = module;
47   while (TYPE (a) == TPAIR)
48     {
49       if (g_debug > 3)
50         {
51           eputs ("entry="); display_error_ (CAR (a)); eputs ("\n");
52         }
53       module_define_x (module, CAAR (a), CDAR (a));
54       a = CDR (a);
55     }
56
57   return module;
58 }
59
60 SCM
61 module_printer (SCM module)
62 {
63   eputs ("#<"); display_error_ (struct_ref_ (module, 0)); eputc (' ');
64   //eputs ("printer: "); display_error_ (struct_ref_ (module, 1)); eputc (' ');
65   eputs ("name: "); display_error_ (struct_ref_ (module, 2)); eputc (' ');
66   eputs ("locals: "); display_error_ (struct_ref_ (module, 3)); eputc (' ');
67   eputs ("globals:\n  ");
68   SCM v = struct_ref_ (m0, 4);
69   for (int i=0; i<LENGTH (v); i++)
70     {
71       SCM e = vector_ref_ (v, i);
72       if (e != cell_unspecified)
73         {
74           eputc ('[');
75           while (TYPE (e) == TPAIR)
76             {
77               display_error_ (CAAR (e));
78               e = CDR (e);
79               if (TYPE (e) == TPAIR)
80                 eputc (' ');
81             }
82           eputs ("]\n  ");
83         }
84     }
85   eputc ('>');
86 }
87
88 SCM
89 module_variable (SCM module, SCM name)
90 {
91   //SCM locals = struct_ref_ (module, 3);
92   SCM locals = module;
93   SCM x = assq (name, locals);
94   if (x == cell_f)
95     {
96       module = m0;
97       SCM globals = struct_ref_ (module, 4);
98       x = hashq_ref (globals, name, cell_f);
99     }
100   return x;
101 }
102
103 SCM
104 module_ref (SCM module, SCM name)
105 {
106   if (g_debug > 4)
107     {
108       eputs ("module_ref: "); display_error_ (name); eputs ("\n");
109     }
110   SCM x = module_variable (module, name);
111   if (x == cell_f)
112     return cell_undefined;
113   return CDR (x);
114 }
115
116 SCM
117 module_define_x (SCM module, SCM name, SCM value)
118 {
119   if (g_debug > 4)
120     {
121       eputs ("module_define_x: "); display_error_ (name); eputs ("\n");
122     }
123   module = m0;
124   SCM globals = struct_ref_ (module, 4);
125   return hashq_set_x (globals, name, value);
126 }