From c18ed2be4c3d103d72bcb4a4926d65bd2d1dae14 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 16 Nov 2019 08:03:37 +0100
Subject: [PATCH] WIP: current-module

---
 mes/module/mes/boot-module.scm | 17 ++++++++++++-----
 src/variable.c                 | 31 ++++++++++++++++++++++++-------
 2 files changed, 36 insertions(+), 12 deletions(-)

diff --git a/mes/module/mes/boot-module.scm b/mes/module/mes/boot-module.scm
index f8a64f14..c0ae542d 100644
--- a/mes/module/mes/boot-module.scm
+++ b/mes/module/mes/boot-module.scm
@@ -147,16 +147,23 @@
 
 ;;;;;;;;;;; ************************************************************
 
-(define *current-module* #f)
-(define (guile:current-module)
-  *current-module*
-  )
+(define guile:current-module (make-fluid #f))
 
+(define lookup-global #f)
+(define (global-lookup-function name define?)
+  ;; (if define? (module-make-local-var! (guile:current-module) name)
+  ;;     (module-variable (guile:current-module) name))
+  '("boe")
+  )
 (define (set-current-module m)
   (display "set-current-module: name=")
   (display (module-name m))
   (display "\n")
-  (set! *current-module* m))
+  (let ((o (guile:current-module)))
+    (guile:current-module m)
+    ;; (unless o
+    ;;   (set! lookup-global global-lookup-function))
+    o))
 
 (define (make-hook . n)
   '())
diff --git a/src/variable.c b/src/variable.c
index 1dad09c0..1f74248c 100644
--- a/src/variable.c
+++ b/src/variable.c
@@ -67,16 +67,33 @@ lookup_variable (struct scm *name, struct scm *define_p)
 
   if (handle == cell_f)
     {
-      handle = hashq_get_handle_ (M0, name, cell_f);
-      if (handle == cell_f && define_p == cell_t)
+      struct scm *lookup = hashq_get_handle_ (M0, cstring_to_symbol ("lookup-global"), cell_f);
+      if (lookup != cell_f && lookup->cdr != cell_f)
         {
-          if (g_debug > 0)
+          eputs ("lookup? ");
+          display_error_ (lookup);
+          eputs (" ...  \n");
+          handle = apply (lookup->cdr, cons (name, cons (define_p, cell_nil)), R0);
+          eputs ("lookup: ");
+          display_error_ (name);
+          eputs (" => ");
+          write_error_ (handle);
+          if (handle != cell_f)
+            handle = cons (name, name->variable);
+        }
+      else
+        {
+          handle = hashq_get_handle_ (M0, name, cell_f);
+          if (handle == cell_f && define_p == cell_t)
             {
-              eputs ("lookup + define: ");
-              write_error_ (name);
-              eputs ("\n");
+              if (g_debug > 0)
+                {
+                  eputs ("lookup + define: ");
+                  write_error_ (name);
+                  eputs ("\n");
+                }
+              handle = hashq_set_handle_x (M0, name, cell_f);
             }
-          handle = hashq_set_handle_x (M0, name, cell_f);
         }
     }