core: Add a C-only module lookup fast path.

* include/mes/constants.h (MODULE_OBARRAY): New constant.
(MODULE_USES): New constant.
(MODULE_BINDER): New constant.
* src/module.c (standard-eval-closure): New function.
(standard_interface_eval_closure): New function.
(module_make_local_var_x): New function.
(module_variable): New function.
(cuurent_module_variable): Use the new functions for lookup if the
current module's eval-closure is one of two special symbols.
* include/mes/mes.h: Declare new functions.
* include/mes/symbols.h (cell_symbol_standard_eval_closure): New
variable.
(cell_symbol_standard_interface_eval_closure): New variable.
(SYMBOL_MAX): Adjust accordingly.
* src/symbol.c (init_symbols_): Initialize the new symbols.
* mes/module/mes/guile-module.mes (standard-eval-closure)
(standard-interface-eval-closure): Return a designated symbol
instead of an actual closure.

include/mes/constants.h

@@ -73,6 +73,12 @@
 // CONSTANT FRAME_PROCEDURE 4
 #define FRAME_PROCEDURE 4
 
+// CONSTANT MODULE_OBARRAY 3
+#define MODULE_OBARRAY 3
+// CONSTANT MODULE_USES 4
+#define MODULE_USES 4
+// CONSTANT MODULE_BINDER 5
+#define MODULE_BINDER 5
 // CONSTANT MODULE_EVAL_CLOSURE 6
 #define MODULE_EVAL_CLOSURE 6
 

include/mes/mes.h

@@ -132,6 +132,10 @@ struct scm *cstring_to_list (char const *s);
 struct scm *cstring_to_symbol (char const *s);
 struct scm *cell_ref (struct scm *cell, long index);
 struct scm *current_module_variable (struct scm *name, struct scm *define_p);
+struct scm *standard_eval_closure (struct scm *name, struct scm *define_p);
+struct scm *standard_interface_eval_closure (struct scm *name, struct scm *define_p);
+struct scm *module_make_local_var_x (struct scm *module, struct scm *name);
+struct scm *module_variable (struct scm *module, struct scm *name);
 struct scm *fdisplay_ (struct scm *, int, int);
 struct scm *init_symbols ();
 struct scm *init_time (struct scm *a);

include/mes/symbols.h

@@ -111,6 +111,8 @@ extern struct scm *cell_symbol_arch;
 extern struct scm *cell_symbol_pmatch_car;
 extern struct scm *cell_symbol_pmatch_cdr;
 extern struct scm *cell_symbol_variable;
+extern struct scm *cell_symbol_standard_eval_closure;
+extern struct scm *cell_symbol_standard_interface_eval_closure;
 extern struct scm *cell_type_bytes;
 extern struct scm *cell_type_char;
 extern struct scm *cell_type_closure;
@@ -133,8 +135,8 @@ extern struct scm *cell_type_broken_heart;
 extern struct scm *cell_symbol_program;
 extern struct scm *cell_symbol_test;
 
-// CONSTANT SYMBOL_MAX 111
-#define SYMBOL_MAX 111
+// CONSTANT SYMBOL_MAX 113
+#define SYMBOL_MAX 113
 
 // CONSTANT CELL_UNSPECIFIED 7
 #define CELL_UNSPECIFIED 7

mes/module/mes/guile-module.mes

@@ -100,23 +100,28 @@
 ;;; that we need.
 ;;;
 
-(define module-make-local-var! #f)
-(define module-variable #f)
+(define (standard-eval-closure m)
+  'standard-eval-closure)
+(define (standard-interface-eval-closure m)
+  'standard-interface-eval-closure)
 
-(define (standard-eval-closure module)
-  (let ((module-make-local-var! module-make-local-var!)
-        (module-variable module-variable))
-    (lambda (name define?)
-      (if define?
-          (module-make-local-var! module name)
-          (module-variable module name)))))
+;; (define module-make-local-var! #f)
+;; (define module-variable #f)
 
-(define (standard-interface-eval-closure module)
-  (let ((module-variable module-variable))
-    (lambda (name define?)
-      (if define?
-          #f
-          (module-variable module name)))))
+;; (define (standard-eval-closure module)
+;;   (let ((module-make-local-var! module-make-local-var!)
+;;         (module-variable module-variable))
+;;     (lambda (name define?)
+;;       (if define?
+;;           (module-make-local-var! module name)
+;;           (module-variable module name)))))
+
+;; (define (standard-interface-eval-closure module)
+;;   (let ((module-variable module-variable))
+;;     (lambda (name define?)
+;;       (if define?
+;;           #f
+;;           (module-variable module name)))))
 
 
 

src/module.c

@@ -78,6 +78,16 @@ current_module_variable (struct scm *name, struct scm *define_p)
      'eval-closure' procedure.  We take it on faith that whatever is in
      'M1' is a module. */
   struct scm *eval_closure = struct_ref_ (module, MODULE_EVAL_CLOSURE);
+
+  /* If the module's "eval-closure" is the standard one, we can save
+     time by performing the lookup without calling into Scheme code. */
+  if (eval_closure == cell_symbol_standard_eval_closure)
+    return standard_eval_closure (name, define_p);
+  else if (eval_closure == cell_symbol_standard_interface_eval_closure)
+    return standard_interface_eval_closure (name, define_p);
+
+  /* Otherwise, we assume it's a closure, and defer to it for the
+     lookup. */
   struct scm *args = cell_nil;
   args = cons (define_p, args);
   args = cons (name, args);
@@ -88,3 +98,55 @@ current_module_variable (struct scm *name, struct scm *define_p)
   gc_pop_frame ();
   return result;
 }
+
+struct scm *
+standard_eval_closure (struct scm *name, struct scm *define_p)
+{
+  if (define_p != cell_f)
+    return module_make_local_var_x (M1, name);
+  return module_variable (M1, name);
+}
+
+struct scm *
+standard_interface_eval_closure (struct scm *name, struct scm *define_p)
+{
+  if (define_p != cell_f)
+    return cell_f;
+  return module_variable (M1, name);
+}
+
+struct scm *
+module_make_local_var_x (struct scm *module, struct scm *name)
+{
+  struct scm *obarray = struct_ref_ (module, MODULE_OBARRAY);
+  struct scm *variable = make_variable (cell_undefined);
+  struct scm *handle = hashq_create_handle_x (obarray, name, variable);
+
+  /* TODO: Call 'module-modified' to invoke obervers, but only if there
+     are observers, since we are trying to avoid Scheme code. */
+
+  return handle->cdr;
+}
+
+struct scm *
+module_variable (struct scm *module, struct scm *name)
+{
+  struct scm *modules = cons (module, cell_nil);
+  struct scm *obarray;
+  struct scm *variable;
+  struct scm *uses;
+  while (modules->type == TPAIR)
+    {
+      module = modules->car;
+      obarray = struct_ref_ (module, MODULE_OBARRAY);
+      variable = hashq_ref_ (obarray, name, cell_f);
+      if (variable != cell_f)
+          return variable;
+
+      /* TODO: Call binders. */
+
+      uses = struct_ref_ (module, MODULE_USES);
+      modules = append2 (uses, modules->cdr);
+    }
+  return cell_f;
+}

src/symbol.c

@@ -146,6 +146,8 @@ init_symbols_ ()                  /*:((internal)) */
   cell_symbol_pmatch_car = init_symbol (g_symbol, TSYMBOL, "pmatch-car");
   cell_symbol_pmatch_cdr = init_symbol (g_symbol, TSYMBOL, "pmatch-cdr");
   cell_symbol_variable = init_symbol (g_symbol, TSYMBOL, "<variable>");
+  cell_symbol_standard_eval_closure = init_symbol (g_symbol, TSYMBOL, "standard-eval-closure");
+  cell_symbol_standard_interface_eval_closure = init_symbol (g_symbol, TSYMBOL, "standard-interface-eval-closure");
 
   cell_type_bytes = init_symbol (g_symbol, TSYMBOL, "<cell:bytes>");
   cell_type_char = init_symbol (g_symbol, TSYMBOL, "<cell:char>");