From ea9d2313359282ad0975958cc58dc17530400204 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Thu, 14 Nov 2019 09:54:22 +0100
Subject: [PATCH] core: Remove make_module_type, module_printer,
 module_variable, module_ref.

* src/module.c (make_module_type, module_printer, module_variable,
module_ref): Remove.
* include/mes/builtins.h: Remove declarations.
* src/builtins.c (mes_builtins): Remove registrations.
* src/eval-apply.c (assert_defined): Remove.
(set_env_x, eval_apply): Use lookup_variable and variable_ref.
* src/core.c (error): Likewise.
* mes/module/mes/boot-01.scm (defined?): Likewise.
* mes/module/mes/boot-02.scm (defined?): Likewise.
* mes/module/mes/boot-03.scm (defined?): Likewise.
* mes/module/mes/boot-0.scm (defined?): Likewise.
* scaffold/boot/53-closure-display.scm (guile): Likewise.
* scaffold/boot/60-let-syntax-expanded.scm (defined?): Likewise.
* src/mes.c (main): Use hash_table_printer for debugging.
---
 include/mes/builtins.h                   |  4 --
 include/mes/mes.h                        |  2 +-
 mes/module/mes/boot-0.scm                |  2 +-
 mes/module/mes/boot-00.scm               |  2 +-
 mes/module/mes/boot-01.scm               |  2 +-
 mes/module/mes/boot-02.scm               |  2 +-
 mes/module/mes/boot-03.scm               |  2 +-
 scaffold/boot/53-closure-display.scm     |  2 +-
 scaffold/boot/60-let-syntax-expanded.scm |  2 +-
 src/builtins.c                           |  4 --
 src/core.c                               |  6 +-
 src/eval-apply.c                         | 40 +++++-------
 src/gc.c                                 |  1 -
 src/mes.c                                |  5 +-
 src/module.c                             | 82 +-----------------------
 src/test/gc.c                            |  2 -
 src/variable.c                           |  3 +-
 17 files changed, 35 insertions(+), 128 deletions(-)

diff --git a/include/mes/builtins.h b/include/mes/builtins.h
index 96a61efe..503af128 100644
--- a/include/mes/builtins.h
+++ b/include/mes/builtins.h
@@ -101,10 +101,6 @@ struct scm *lognot (struct scm *x);
 struct scm *logxor (struct scm *x);
 struct scm *ash (struct scm *n, struct scm *count);
 /* src/module.c */
-struct scm *make_module_type ();
-struct scm *module_printer (struct scm *module);
-struct scm *module_variable (struct scm *module, struct scm *name);
-struct scm *module_ref (struct scm *module, struct scm *name);
 struct scm *module_define_x (struct scm *module, struct scm *name, struct scm *value);
 /* src/posix.c */
 struct scm *abort_ ();
diff --git a/include/mes/mes.h b/include/mes/mes.h
index f13e6bcf..8bf5b3df 100644
--- a/include/mes/mes.h
+++ b/include/mes/mes.h
@@ -70,7 +70,7 @@ struct scm *R1;
 struct scm *R2;
 /* continuation */
 struct scm *R3;
-/* current-module */
+/* initial module */
 struct scm *M0;
 /* macro */
 struct scm *g_macros;
diff --git a/mes/module/mes/boot-0.scm b/mes/module/mes/boot-0.scm
index 767a1f28..c2532864 100644
--- a/mes/module/mes/boot-0.scm
+++ b/mes/module/mes/boot-0.scm
@@ -30,7 +30,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (module-variable (current-module) x))
+  (lookup-variable (current-module) x #f))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
diff --git a/mes/module/mes/boot-00.scm b/mes/module/mes/boot-00.scm
index 9c85ccb5..1e84fee9 100644
--- a/mes/module/mes/boot-00.scm
+++ b/mes/module/mes/boot-00.scm
@@ -20,7 +20,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (module-variable (current-module) x))
+  (lookup-variable (current-module) x #f))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
diff --git a/mes/module/mes/boot-01.scm b/mes/module/mes/boot-01.scm
index c42bc814..577d00af 100644
--- a/mes/module/mes/boot-01.scm
+++ b/mes/module/mes/boot-01.scm
@@ -20,7 +20,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (module-variable (current-module) x))
+  (lookup-variable (current-module) x #f))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
diff --git a/mes/module/mes/boot-02.scm b/mes/module/mes/boot-02.scm
index 4f09daea..c6beec8f 100644
--- a/mes/module/mes/boot-02.scm
+++ b/mes/module/mes/boot-02.scm
@@ -30,7 +30,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (module-variable (current-module) x))
+  (lookup-variable (current-module) x #f))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
diff --git a/mes/module/mes/boot-03.scm b/mes/module/mes/boot-03.scm
index c4e8b61c..14346201 100644
--- a/mes/module/mes/boot-03.scm
+++ b/mes/module/mes/boot-03.scm
@@ -30,7 +30,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (module-variable (current-module) x))
+  (lookup-variable (current-module) x #f))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
diff --git a/scaffold/boot/53-closure-display.scm b/scaffold/boot/53-closure-display.scm
index 4c31a221..3dc1f7e8 100644
--- a/scaffold/boot/53-closure-display.scm
+++ b/scaffold/boot/53-closure-display.scm
@@ -28,7 +28,7 @@
     (if (null? lst) (list)
         (cons (f (car lst)) (map f (cdr lst)))))
   (define (closure x)
-    (map car (cdr (core:cdr (core:car (core:cdr (cdr (module-variable (current-module) 'x))))))))))
+    (map car (cdr (core:cdr (core:car (core:cdr (cdr (lookup-variable (current-module) 'x #f))))))))))
 
 (define (x t) #t)
 (define (xx x1 x2)
diff --git a/scaffold/boot/60-let-syntax-expanded.scm b/scaffold/boot/60-let-syntax-expanded.scm
index a298a83f..84e40289 100644
--- a/scaffold/boot/60-let-syntax-expanded.scm
+++ b/scaffold/boot/60-let-syntax-expanded.scm
@@ -20,7 +20,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (module-variable (current-module) x))
+  (lookup-variable (current-module) x #f))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
diff --git a/src/builtins.c b/src/builtins.c
index fcf7cdb7..680c7f17 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -211,10 +211,6 @@ mes_builtins (struct scm *a)            /*:((internal)) */
   a = init_builtin (builtin_type, "logxor", -1, &logxor, a);
   a = init_builtin (builtin_type, "ash", 2, &ash, a);
   /* src/module.c */
-  a = init_builtin (builtin_type, "make-module-type", 0, &make_module_type, a);
-  a = init_builtin (builtin_type, "module-printer", 1, &module_printer, a);
-  a = init_builtin (builtin_type, "module-variable", 2, &module_variable, a);
-  a = init_builtin (builtin_type, "module-ref", 2, &module_ref, a);
   a = init_builtin (builtin_type, "module-define!", 3, &module_define_x, a);
   /* src/posix.c */
   a = init_builtin (builtin_type, "abort", 0, &abort_, a);
diff --git a/src/core.c b/src/core.c
index 15585e45..6f2a4267 100644
--- a/src/core.c
+++ b/src/core.c
@@ -149,9 +149,9 @@ struct scm *
 error (struct scm *key, struct scm *x)
 {
 #if !__MESC_MES__ && !__M2_PLANET__
-  struct scm *throw = module_ref (R0, cell_symbol_throw);
-  if (throw != cell_undefined)
-    return apply (throw, cons (key, cons (x, cell_nil)), R0);
+  struct scm *throw = lookup_variable (R0, cell_symbol_throw, cell_f);
+  if (throw != cell_f)
+    return apply (throw->cdr, cons (key, cons (x, cell_nil)), R0);
 #endif
   display_error_ (key);
   eputs (": ");
diff --git a/src/eval-apply.c b/src/eval-apply.c
index 597bde43..03e5529c 100644
--- a/src/eval-apply.c
+++ b/src/eval-apply.c
@@ -23,14 +23,6 @@
 
 #include <string.h>
 
-struct scm *
-assert_defined (struct scm *x, struct scm *e)   /*:((internal)) */
-{
-  if (e == cell_undefined)
-    return error (cell_symbol_unbound_variable, x);
-  return e;
-}
-
 struct scm *
 check_formals (struct scm *f, struct scm *formals, struct scm *args)    /*:((internal)) */
 {
@@ -127,7 +119,11 @@ set_env_x (struct scm *x, struct scm *e, struct scm *a)
   if (x->type == TVARIABLE)
     p = x->variable;
   else
-    p = assert_defined (x, module_variable (a, x));
+    {
+      p = lookup_variable (a, x, cell_f);
+      if (p == cell_f || p-> cdr == cell_undefined)
+        error (cell_symbol_unbound_variable, x);
+    }
   if (p->type != TPAIR)
     error (cell_symbol_not_a_pair, cons (p, x));
   return set_cdr_x (p, e);
@@ -269,7 +265,7 @@ expand_variable_ (struct scm *x, struct scm *formals, int top_p)        /*:((int
                    && a != cell_symbol_primitive_load
                    && formal_p (x->car, formals) == 0)
             {
-              v = module_variable (R0, a);
+              v = lookup_variable (R0, a, cell_f);
               if (v != cell_f)
                 x->car = make_variable (v);
             }
@@ -508,6 +504,7 @@ apply:
         }
       if (c == cell_symbol_current_module)
         {
+          /* FIXME: TODO */
           R1 = R0;
           goto vm_return;
         }
@@ -623,11 +620,7 @@ eval:
                           macro_set_x (name, cell_f);
                       }
                     else
-                      {
-                        entry = module_variable (R0, name);
-                        if (entry == cell_f)
-                          module_define_x (M0, name, cell_f);
-                      }
+                      entry = lookup_variable (R0, name, cell_t);
                   }
                 R2 = R1;
                 aa = R1->cdr->car;
@@ -661,7 +654,7 @@ eval:
                   }
                 else if (global_p != 0)
                   {
-                    entry = module_variable (R0, name);
+                    entry = lookup_variable (R0, name, cell_f);
                     set_cdr_x (entry, R1);
                   }
                 else
@@ -670,7 +663,7 @@ eval:
                     aa = cons (entry, cell_nil);
                     set_cdr_x (aa, cdr (R0));
                     set_cdr_x (R0, aa);
-                    cl = module_variable (R0, cell_closure);
+                    cl = lookup_variable (R0, cell_closure, cell_f);
                     set_cdr_x (cl, aa);
                   }
                 R1 = cell_unspecified;
@@ -697,13 +690,12 @@ eval:
         goto vm_return;
       if (R1 == cell_symbol_call_with_current_continuation)
         goto vm_return;
-      R1 = assert_defined (R1, module_ref (R0, R1));
+      R1 = lookup_ref (R0, R1);
       goto vm_return;
     }
   else if (t == TVARIABLE)
     {
-      x = R1->variable;
-      R1 = x->cdr;
+      R1 = variable_ref (R1);
       goto vm_return;
     }
   else if (t == TBROKEN_HEART)
@@ -771,13 +763,13 @@ macro_expand:
           macro = macro_get_handle (cell_symbol_portable_macro_expand);
           if (macro != cell_f)
             {
-              expanders = module_ref (R0, cell_symbol_sc_expander_alist);
-              if (expanders != cell_undefined)
+              expanders = lookup_ref (R0, cell_symbol_sc_expander_alist);
+              if (expanders != cell_f)
                 {
                   macro = assq (R1->car, expanders);
                   if (macro != cell_f)
                     {
-                      sc_expand = module_ref (R0, cell_symbol_macro_expand);
+                      sc_expand = lookup_ref (R0, cell_symbol_macro_expand);
                       R2 = R1;
                       if (sc_expand != cell_undefined && sc_expand != cell_f)
                         {
@@ -884,7 +876,7 @@ begin_expand:
               push_cc (input, R2, R0, cell_vm_return);
               x = read_input_file_env (R0);
               if (g_debug > 5)
-                module_printer (M0);
+                hash_table_printer (R0);
               gc_pop_frame ();
               input = R1;
               R1 = x;
diff --git a/src/gc.c b/src/gc.c
index 4f733b4c..b886445c 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -731,7 +731,6 @@ gc_dump_state ()
   gc_dump_register ("R1", R1);
   gc_dump_register ("R2", R2);
   gc_dump_register ("R3", R3);
-  gc_dump_register ("M0", M0);
   gc_dump_register ("g_symbols", g_symbols);
   gc_dump_register ("g_symbol_max", g_symbol_max);
   gc_dump_register ("g_macros", g_macros);
diff --git a/src/mes.c b/src/mes.c
index ae4f4ac1..d3c678bd 100644
--- a/src/mes.c
+++ b/src/mes.c
@@ -189,10 +189,11 @@ main (int argc, char **argv, char **envp)
   a = mes_builtins (a);
   a = init_time (a);
   M0 = make_initial_module (a);
+  R0 = cell_nil;
   g_macros = make_hash_table_ (0);
 
   if (g_debug > 5)
-    module_printer (M0);
+    hash_table_printer (M0);
 
   struct scm *program = read_boot ();
   R0 = acons (cell_symbol_program, program, R0);
@@ -216,7 +217,7 @@ main (int argc, char **argv, char **envp)
   if (g_debug != 0)
     {
       if (g_debug > 5)
-        module_printer (M0);
+        hash_table_printer (M0);
 
       if (g_debug < 3)
         gc_stats_ ("\ngc run");
diff --git a/src/module.c b/src/module.c
index 7a86022f..ac328369 100644
--- a/src/module.c
+++ b/src/module.c
@@ -21,96 +21,20 @@
 #include "mes/lib.h"
 #include "mes/mes.h"
 
-struct scm *
-make_module_type ()             /*:(internal)) */
-{
-  struct 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 (fields, cell_nil);
-  fields = cons (cell_symbol_module, fields);
-  return make_struct (cell_symbol_record_type, fields, cell_unspecified);
-}
-
 struct scm *
 make_initial_module (struct scm *a)     /*:((internal)) */
 {
-  struct scm *module_type = make_module_type ();
-  a = acons (cell_symbol_module, module_type, a);
-
-  struct scm *hash_table_type = scm_hash_table_type;
-  a = acons (cell_symbol_hashq_table, hash_table_type, a);
-
-  struct scm *name = cons (cstring_to_symbol ("boot"), cell_nil);
-  struct scm *globals = make_hash_table_ (0);
-  struct scm *locals = cell_nil;
-
-  struct scm *values = cell_nil;
-  values = cons (globals, values);
-  values = cons (locals, values);
-  values = cons (name, values);
-  values = cons (cell_symbol_module, values);
-  struct scm *module = make_struct (module_type, values, cstring_to_symbol ("module-printer"));
-  R0 = cell_nil;
-  R0 = cons (a->cdr->car, R0);
-  R0 = cons (a->car, R0);
-  M0 = module;
+  struct scm *module = make_hash_table_ (100);
   while (a->type == TPAIR)
     {
-      module_define_x (module, a->car->car, a->car->cdr);
+      hashq_set_x (module, a->car->car, a->car->cdr);
       a = a->cdr;
     }
-
   return module;
 }
 
-struct scm *
-module_printer (struct scm *module)
-{
-  fdputs ("#<", __stdout);
-  display_ (struct_ref_ (module, 2));
-  fdputc (' ', __stdout);
-  fdputs ("name: ", __stdout);
-  display_ (struct_ref_ (module, 3));
-  fdputc (' ', __stdout);
-  fdputs ("locals: ", __stdout);
-  display_ (struct_ref_ (module, 4));
-  fdputc (' ', __stdout);
-  struct scm *table = struct_ref_ (module, 5);
-  fdputs ("globals:\n  ", __stdout);
-  display_ (table);
-  fdputc ('>', __stdout);
-}
-
-struct scm *
-module_variable (struct scm *module, struct scm *name)
-{
-  /*struct scm *locals = struct_ref_ (module, 3);*/
-  struct scm *locals = module;
-  struct scm *x = assq (name, locals);
-  if (x == cell_f)
-    {
-      module = M0;
-      struct scm *globals = struct_ref_ (module, 5);
-      x = hashq_get_handle_ (globals, name, cell_f);
-    }
-  return x;
-}
-
-struct scm *
-module_ref (struct scm *module, struct scm *name)
-{
-  struct scm *x = module_variable (module, name);
-  if (x == cell_f)
-    return cell_undefined;
-  return x->cdr;
-}
-
 struct scm *
 module_define_x (struct scm *module, struct scm *name, struct scm *value)
 {
-  module = M0;
-  struct scm *globals = struct_ref_ (module, 5);
-  return hashq_set_x (globals, name, value);
+  return hashq_set_x (M0, name, value);
 }
diff --git a/src/test/gc.c b/src/test/gc.c
index 8d3c70cf..e04343cf 100644
--- a/src/test/gc.c
+++ b/src/test/gc.c
@@ -43,7 +43,6 @@ test_setup ()
   g_ports = cell_zero;
   g_macros = cell_zero;
   g_stack = STACK_SIZE;
-  M0 = cell_zero;
 
   memset (g_arena + sizeof (struct scm), 0, ARENA_SIZE * sizeof (struct scm));
   cell_zero->type = TCHAR;
@@ -185,7 +184,6 @@ main (int argc, char **argv, char **envp)
   g_ports = cell_zero;
   g_macros = cell_zero;
   g_stack = STACK_SIZE;
-  M0 = cell_zero;
 
   test_empty ();
   test_number ();
diff --git a/src/variable.c b/src/variable.c
index e3755e77..86d2d769 100644
--- a/src/variable.c
+++ b/src/variable.c
@@ -25,7 +25,8 @@ struct scm *
 variable_ref (struct scm *var)
 {
   assert_variable (1, var);
-  struct scm *value = var->variable;
+  struct scm *ref = var->variable;
+  struct scm *value = ref->cdr;
   if (value == cell_undefined)
     error (cell_symbol_unbound_variable, var);
   return value;