core: Remove string debugging.
[mes.git] / src / module.c
index 60c004125b6860078648ffae78e5b576a50a382d..773e1793eb4706e620fdcceb552d569dcb37ea8f 100644 (file)
 
 SCM struct_ref_ (SCM x, long i);
 SCM struct_set_x_ (SCM x, long i, SCM e);
+SCM cstring_to_symbol (char const *s);
 
 SCM
-make_initial_module (SCM a) ///((internal))
+make_module_type () ///(internal))
 {
+  SCM record_type = cell_symbol_record_type; // FIXME
   SCM fields = cell_nil;
   fields = cons (cstring_to_symbol ("globals"), fields);
   fields = cons (cstring_to_symbol ("locals"), fields);
   fields = cons (cstring_to_symbol ("name"), fields);
-  fields = cons (cstring_to_symbol ("<module>"), fields);
-  SCM module_type = make_struct (cstring_to_symbol ("record-type"), fields, cell_unspecified);
-  SCM module_type_name = cstring_to_symbol ("<module>");
-  a = acons (module_type_name, module_type, a);
-  SCM values = cell_nil;
+  fields = cons (fields, cell_nil);
+  fields = cons (cell_symbol_module, fields);
+  return make_struct (record_type, fields, cell_unspecified);
+}
+
+SCM
+make_initial_module (SCM a) ///((internal))
+{
+  SCM module_type = make_module_type ();
+  a = acons (cell_symbol_module, module_type, a);
+
+  SCM hashq_type = make_hashq_type ();
+  a = acons (cell_symbol_hashq_table, hashq_type, a);
+
   SCM name = cons (cstring_to_symbol ("boot"), cell_nil);
   SCM globals = make_hash_table_ (0);
-  values = cons (globals, values);
   SCM locals = cell_nil;
+
+  SCM values = cell_nil;
+  values = cons (globals, values);
   values = cons (locals, values);
   values = cons (name, values);
-  SCM module = make_struct (module_type_name, values, cell_module_printer);
+  values = cons (cell_symbol_module, values);
+  SCM module = make_struct (module_type, values, cell_module_printer);
   r0 = cell_nil;
+  r0 = cons (CADR (a), r0);
   r0 = cons (CAR (a), r0);
-
   m0 = module;
   while (TYPE (a) == TPAIR)
     {
-      if (g_debug > 3)
-        {
-          eputs ("entry="); display_error_ (CAR (a)); eputs ("\n");
-        }
       module_define_x (module, CAAR (a), CDAR (a));
       a = CDR (a);
     }
@@ -60,29 +70,14 @@ make_initial_module (SCM a) ///((internal))
 SCM
 module_printer (SCM module)
 {
-  eputs ("#<"); display_error_ (struct_ref_ (module, 0)); eputc (' ');
-  //eputs ("printer: "); display_error_ (struct_ref_ (module, 1)); eputc (' ');
-  eputs ("name: "); display_error_ (struct_ref_ (module, 2)); eputc (' ');
-  eputs ("locals: "); display_error_ (struct_ref_ (module, 3)); eputc (' ');
-  eputs ("globals:\n  ");
-  SCM v = struct_ref_ (m0, 4);
-  for (int i=0; i<LENGTH (v); i++)
-    {
-      SCM e = vector_ref_ (v, i);
-      if (e != cell_unspecified)
-        {
-          eputc ('[');
-          while (TYPE (e) == TPAIR)
-            {
-              display_error_ (CAAR (e));
-              e = CDR (e);
-              if (TYPE (e) == TPAIR)
-                eputc (' ');
-            }
-          eputs ("]\n  ");
-        }
-    }
-  eputc ('>');
+  //module = m0;
+  fdputs ("#<", g_stdout); display_ (struct_ref_ (module, 2)); fdputc (' ', g_stdout);
+  fdputs ("name: ", g_stdout); display_ (struct_ref_ (module, 3)); fdputc (' ', g_stdout);
+  fdputs ("locals: ", g_stdout); display_ (struct_ref_ (module, 4)); fdputc (' ', g_stdout);
+  SCM table = struct_ref_ (module, 5);
+  fdputs ("globals:\n  ", g_stdout);
+  display_ (table);
+  fdputc ('>', g_stdout);
 }
 
 SCM
@@ -94,8 +89,8 @@ module_variable (SCM module, SCM name)
   if (x == cell_f)
     {
       module = m0;
-      SCM globals = struct_ref_ (module, 4);
-      x = hashq_ref (globals, name, cell_f);
+      SCM globals = struct_ref_ (module, 5);
+      x = hashq_get_handle (globals, name, cell_f);
     }
   return x;
 }
@@ -103,10 +98,6 @@ module_variable (SCM module, SCM name)
 SCM
 module_ref (SCM module, SCM name)
 {
-  if (g_debug > 4)
-    {
-      eputs ("module_ref: "); display_error_ (name); eputs ("\n");
-    }
   SCM x = module_variable (module, name);
   if (x == cell_f)
     return cell_undefined;
@@ -116,11 +107,7 @@ module_ref (SCM module, SCM name)
 SCM
 module_define_x (SCM module, SCM name, SCM value)
 {
-  if (g_debug > 4)
-    {
-      eputs ("module_define_x: "); display_error_ (name); eputs ("\n");
-    }
   module = m0;
-  SCM globals = struct_ref_ (module, 4);
+  SCM globals = struct_ref_ (module, 5);
   return hashq_set_x (globals, name, value);
 }