core: Add module indirection for variable lookup.

* src/module.c (module_ref, module_variable): New function.
* src/mes.c: Thoughout: Use them.
(assq_ref_env): Remove.
* mes/module/mes/boot-0.scm.in (defined?): Use module-variable.
* mes/module/mes/boot-00.scm (defined?): Likewise.
* mes/module/mes/boot-01.scm (defined?): Likewise.
* mes/module/mes/boot-02.scm (defined?): Likewise.
* scaffold/boot/53-closure-display.scm: Likewise.

mes/module/mes/boot-0.scm.in

@@ -30,7 +30,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))

mes/module/mes/boot-00.scm

@@ -20,7 +20,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))

mes/module/mes/boot-01.scm

@@ -20,7 +20,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))

mes/module/mes/boot-02.scm

@@ -30,7 +30,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))

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 (assq 'x (current-module)))))))))))
+    (map car (cdr (core:cdr (core:car (core:cdr (cdr (module-variable (current-module) 'x))))))))))
 
 (define (x t) #t)
 (define (xx x1 x2)

scaffold/boot/60-let-syntax-expanded.scm

@@ -20,7 +20,7 @@
 (define mes %version)
 
 (define (defined? x)
-  (assq x (current-module)))
+  (module-variable (current-module) x))
 
 (define (cond-expand-expander clauses)
   (if (defined? (car (car clauses)))
@@ -139,14 +139,6 @@
       (if (eq? x (car lst)) lst
           (memq x (cdr lst)))))
 
-;; (cond-expand
-;;  (guile
-;;   (define closure identity)
-;;   (define body identity)
-;;   (define append2 append)
-;;   (define (core:apply f a m) (f a))
-;;   )
-;;  (mes
   (define <cell:symbol> 11)
   (define (symbol? x)
     (eq? (core:type x) <cell:symbol>))
@@ -163,12 +155,6 @@
   (define (vector? x)
     (eq? (core:type x) <cell:vector>))
 
-  ;; (define (body x)
-  ;; (core:cdr (core:cdr (core:cdr (cdr (assq 'x (current-module)))))))
-  ;; (define (closure x)
-  ;;   (map car (cdr (core:cdr (core:car (core:cdr (cdr (assq 'x (current-module)))))))))
-  ;; ))
-
 (define (cons* . rest)
   (if (null? (cdr rest)) (car rest)
       (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
@@ -183,9 +169,7 @@
           (append2 (car rest) (apply append (cdr rest))))))
 
 (define-macro (quasiquote x)
-  ;;(core:display-error "quasiquote:") (core:write-error x) (core:display-error "\n")
   (define (loop x)
-    ;;(core:display-error "loop:") (core:write-error x) (core:display-error "\n")
     (if (vector? x) (list 'list->vector (loop (vector->list x)))
         (if (not (pair? x)) (cons 'quote (cons x '()))
             (if (eq? (car x) 'quasiquote) (loop (loop (cadr x)))

scaffold/boot/60-let-syntax.scm

@@ -52,14 +52,6 @@
       (if (eq? x (car lst)) lst
           (memq x (cdr lst)))))
 
-;; (cond-expand
-;;  (guile
-;;   (define closure identity)
-;;   (define body identity)
-;;   (define append2 append)
-;;   (define (core:apply f a m) (f a))
-;;   )
-;;  (mes
   (define (symbol? x)
     (eq? (core:type x) <cell:symbol>))
 
@@ -73,12 +65,6 @@
   (define (vector? x)
     (eq? (core:type x) <cell:vector>))
 
-  ;; (define (body x)
-  ;; (core:cdr (core:cdr (core:cdr (cdr (assq 'x (current-module)))))))
-  ;; (define (closure x)
-  ;;   (map car (cdr (core:cdr (core:car (core:cdr (cdr (assq 'x (current-module)))))))))
-  ;; ))
-
 (define (cons* . rest)
   (if (null? (cdr rest)) (car rest)
       (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
@@ -93,9 +79,7 @@
           (append2 (car rest) (apply append (cdr rest))))))
 
 (define-macro (quasiquote x)
-  ;;(core:display-error "quasiquote:") (core:write-error x) (core:display-error "\n")
   (define (loop x)
-    ;;(core:display-error "loop:") (core:write-error x) (core:display-error "\n")
     (if (vector? x) (list 'list->vector (loop (vector->list x)))
         (if (not (pair? x)) (cons 'quote (cons x '()))
             (if (eq? (car x) 'quasiquote) (loop (loop (cadr x)))

src/mes.c

@@ -562,7 +562,7 @@ error (SCM key, SCM x)
 {
 #if !__MESC_MES__
   SCM throw;
-  if ((throw = assq_ref_env (cell_symbol_throw, r0)) != cell_undefined)
+  if ((throw = module_ref (r0, cell_symbol_throw)) != cell_undefined)
     return apply (throw, cons (key, cons (x, cell_nil)), r0);
 #endif
   display_error_ (key);
@@ -826,15 +826,6 @@ assq (SCM x, SCM a)
   return a != cell_nil ? CAR (a) : cell_f;
 }
 
-SCM
-assq_ref_env (SCM x, SCM a)
-{
-  x = assq (x, a);
-  if (x == cell_f)
-    return cell_undefined;
-  return CDR (x);
-}
-
 SCM
 set_car_x (SCM x, SCM e)
 {
@@ -860,7 +851,7 @@ set_env_x (SCM x, SCM e, SCM a)
   if (TYPE (x) == TVARIABLE)
     p = VARIABLE (x);
   else
-    p = assert_defined (x, assq (x, a));
+    p = assert_defined (x, module_variable (a, x));
   if (TYPE (p) != TPAIR)
     error (cell_symbol_not_a_pair, cons (p, x));
   return set_cdr_x (p, e);
@@ -1009,7 +1000,7 @@ expand_variable_ (SCM x, SCM formals, int top_p) ///((internal))
                    && CAR (x) != cell_symbol_if // HMM
                    && !formal_p (CAR (x), formals))
             {
-              SCM v = assq (CAR (x), r0);
+              SCM v = module_variable (r0, CAR (x));
               if (v != cell_f)
                 CAR (x) = make_variable_ (v);
             }
@@ -1275,7 +1266,7 @@ eval_apply ()
                     }
                   else
                     {
-                      entry = assq (name, r0);
+                      entry = module_variable (r0, name);
                       if (entry == cell_f)
                         {
                           entry = cons (name, cell_f);
@@ -1315,7 +1306,7 @@ eval_apply ()
                 }
               else if (global_p)
                 {
-                  entry = assq (name, r0);
+                  entry = module_variable (r0, name);
                   set_cdr_x (entry, r1);
                 }
               else
@@ -1324,7 +1315,7 @@ eval_apply ()
                   aa = cons (entry, cell_nil);
                   set_cdr_x (aa, cdr (r0));
                   set_cdr_x (r0, aa);
-                  cl = assq (cell_closure, r0);
+                  cl = module_variable (r0, cell_closure);
                   set_cdr_x (cl, aa);
                 }
               r1 = cell_unspecified;
@@ -1350,7 +1341,7 @@ eval_apply ()
           r1 = cell_begin;
           goto vm_return;
         }
-      r1 = assert_defined (r1, assq_ref_env (r1, r0));
+      r1 = assert_defined (r1, module_ref (r0, r1));
       goto vm_return;
     }
   else if (t == TVARIABLE)
@@ -1421,10 +1412,10 @@ eval_apply ()
         && TYPE (CAR (r1)) == TSYMBOL
         && CAR (r1) != cell_symbol_begin
         && ((macro = assq (cell_symbol_portable_macro_expand, g_macros)) != cell_f)
-        && ((expanders = assq_ref_env (cell_symbol_sc_expander_alist, r0)) != cell_undefined)
+        && ((expanders = module_ref (r0, cell_symbol_sc_expander_alist)) != cell_undefined)
         && ((macro = assq (CAR (r1), expanders)) != cell_f))
       {
-        sc_expand = assq_ref_env (cell_symbol_macro_expand, r0);
+        sc_expand = module_ref (r0, cell_symbol_macro_expand);
         r2 = r1;
         if (sc_expand != cell_undefined && sc_expand != cell_f)
           {

src/module.c

@@ -38,3 +38,20 @@ make_initial_module (SCM a)
   SCM module = make_struct (module_type_name, values, cell_unspecified);
   return module;
 }
+
+SCM
+module_ref (SCM module, SCM name)
+{
+  SCM x = module_variable (module, name);
+  if (x == cell_f)
+    return cell_undefined;
+  return CDR (x);
+}
+
+SCM
+module_variable (SCM module, SCM name)
+{
+  //SCM locals = struct_ref (module, 4);
+  SCM locals = module;
+  return assq (name, locals);
+}