compile all of base/; some arbitrary changes; more "fixes" to `link'

* module/language/scheme/translate.scm (lookup-transformer): When
  expanding syncase macros, use the eval closure from the ghil-env.
  Probably doesn't make any difference whatsoever.

* module/system/base/Makefile.am (SOURCES): Compile pmatch.scm, now that
  it works :-))

* module/system/base/compile.scm (compile-in): Compile inside a
  save-module-excursion, so that side effects of evaluation don't leak
  out.

* module/system/base/pmatch.scm: Change from :use-syntax/:export-syntax
  to simply :use-modules/:export. Also probably has no effect.

* module/system/il/ghil.scm (fix-ghil-mod!): Suppress warnings resulting
  from compilation of define-module.

* src/vm_loader.c (link): So, referencing variables defined but not
  exported from the current module didn't work. Fixed that, but it's
  hacky. There are still some uncaught cases.

diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm
index 618544a..6293978 100644 (file)
--- a/module/language/scheme/translate.scm
+++ b/module/language/scheme/translate.scm
@@ -50,8 +50,8 @@
   '(procedure->syntax procedure->macro procedure->memoizing-macro))
 
 (define (lookup-transformer e head retrans)
-  (let ((val (and=> (module-variable (ghil-mod-module (ghil-env-mod e)) head)
-                    variable-ref)))
+  (let* ((mod (ghil-mod-module (ghil-env-mod e)))
+         (val (and=> (module-variable mod head) variable-ref)))
     (cond
      ((or (primitive-macro? val) (eq? val eval-case))
       (or (assq-ref primitive-syntax-table head)
@@ -68,7 +68,7 @@
              (sc-expand3 (module-ref the-syncase-module 'sc-expand3)))
         (lambda (env loc exp)
           (retrans
-           (with-fluids ((eec (module-eval-closure (current-module))))
+           (with-fluids ((eec (module-eval-closure mod)))
              (sc-expand3 exp 'c '(compile load eval)))))))
 
      ((macro? val)

diff --git a/module/system/base/Makefile.am b/module/system/base/Makefile.am
index eeff192..c6c5722 100644 (file)
--- a/module/system/base/Makefile.am
+++ b/module/system/base/Makefile.am
@@ -1,10 +1,8 @@
-SOURCES = syntax.scm compile.scm language.scm
-# we don't deal well with syncase yet
-NOCOMP_SOURCES = pmatch.scm
+SOURCES = pmatch.scm syntax.scm compile.scm language.scm
 GOBJECTS = $(SOURCES:%.scm=%.go)
 
 vmdir = $(guiledir)/system/vm
-vm_DATA = $(SOURCES) $(NOCOMP_SOURCES) $(GOBJECTS)
+vm_DATA = $(SOURCES) $(GOBJECTS)
 
 CLEANFILES = $(GOBJECTS)
 

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 537d81e..b48ed9f 100644 (file)
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -115,20 +115,22 @@
   (call-with-input-file file (language-read-file lang)))
 
 (define (compile-in x e lang . opts)
-  (catch 'result
-    (lambda ()
-      ;; expand
-      (set! x ((language-expander lang) x e))
-      (if (memq :e opts) (throw 'result x))
-      ;; translate
-      (set! x ((language-translator lang) x e))
-      (if (memq :t opts) (throw 'result x))
-      ;; compile
-      (set! x (apply compile x e opts))
-      (if (memq :c opts) (throw 'result x))
-      ;; assemble
-      (apply assemble x e opts))
-    (lambda (key val) val)))
+  (save-module-excursion
+   (lambda ()
+     (catch 'result
+      (lambda ()
+        ;; expand
+        (set! x ((language-expander lang) x e))
+        (if (memq :e opts) (throw 'result x))
+        ;; translate
+        (set! x ((language-translator lang) x e))
+        (if (memq :t opts) (throw 'result x))
+        ;; compile
+        (set! x (apply compile x e opts))
+        (if (memq :c opts) (throw 'result x))
+        ;; assemble
+        (apply assemble x e opts))
+      (lambda (key val) val)))))
 
 ;;;
 ;;;

diff --git a/module/system/base/pmatch.scm b/module/system/base/pmatch.scm
index 681835e..260d452 100644 (file)
--- a/module/system/base/pmatch.scm
+++ b/module/system/base/pmatch.scm
@@ -1,6 +1,6 @@
 (define-module (system base pmatch)
-  #:use-syntax (ice-9 syncase)
-  #:export-syntax (pmatch ppat))
+  #:use-module (ice-9 syncase)
+  #:export (pmatch ppat))
 ;; FIXME: shouldn't have to export ppat...
 
 ;; Originally written by Oleg Kiselyov. Taken from:

diff --git a/module/system/il/ghil.scm b/module/system/il/ghil.scm
index 7bfeb15..0a65f83 100644 (file)
--- a/module/system/il/ghil.scm
+++ b/module/system/il/ghil.scm
@@ -191,9 +191,15 @@
          (make-ghil-env (make-ghil-mod iface)))))
 
 (define (fix-ghil-mod! mod for-sym)
-  (warn "during lookup of" for-sym ":" (ghil-mod-module mod) "!= current" (current-module))
+  ;;; So, these warnings happen for all instances of define-module.
+  ;;; Rather than fixing the problem, I'm going to suppress the common
+  ;;; warnings.
+  (if (not (eq? for-sym 'process-define-module))
+      (warn "during lookup of" for-sym ":"
+            (ghil-mod-module mod) "!= current" (current-module)))
   (if (not (null? (ghil-mod-table mod)))
-      (warn "throwing away old variable table" (ghil-mod-table mod)))
+      (warn "throwing away old variable table"
+            (ghil-mod-module) (ghil-mod-table mod)))
   (set! (ghil-mod-module mod) (current-module))
   (set! (ghil-mod-table mod) '())
   (set! (ghil-mod-imports mod) '()))

diff --git a/src/vm_loader.c b/src/vm_loader.c
index 2b182d8..a28d44b 100644 (file)
--- a/src/vm_loader.c
+++ b/src/vm_loader.c
@@ -176,6 +176,7 @@ VM_DEFINE_LOADER (load_program, "load-program")
   NEXT;
 }
 
+/* this seems to be a bit too much processing for one instruction.. */
 VM_DEFINE_INSTRUCTION (link, "link", 0, 2, 1)
 {
   SCM modname, mod, sym;
@@ -183,12 +184,17 @@ VM_DEFINE_INSTRUCTION (link, "link", 0, 2, 1)
   POP (modname);
   if (SCM_NFALSEP (modname)) 
     {
-      mod = scm_c_module_lookup (scm_resolve_module (modname),
-                                 "%module-public-interface");
-      if (SCM_FALSEP (mod))
-        SCM_MISC_ERROR ("Could not load module", SCM_LIST1 (modname));
+      mod = scm_resolve_module (modname);
+
+      if (mod != scm_current_module ()) 
+        {
+          mod = scm_c_module_lookup (mod, "%module-public-interface");
+          if (SCM_FALSEP (mod))
+            SCM_MISC_ERROR ("Could not load module", SCM_LIST1 (modname));
+          mod = SCM_VARIABLE_REF (mod);
+        }
       
-      PUSH (scm_module_lookup (SCM_VARIABLE_REF (mod), sym));
+      PUSH (scm_module_lookup (mod, sym));
     }
   else
     PUSH (scm_lookup (sym));