diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm index 618544a45..62939782c 100644 --- 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 eeff1927b..c6c5722cc 100644 --- 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 537d81ed1..b48ed9fb2 100644 --- 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 681835ef8..260d452dd 100644 --- 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 7bfeb1580..0a65f833f 100644 --- 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 2b182d819..a28d44b25 100644 --- 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));