Re: module trickery

[Marius Vollmer]

Marius Vollmer <address@hidden> writes:

> If you can export your macros in this way, that would buy you time
> until we have a real fix.

Or you can try the attached patch.  That should fix the bug for real.

Index: ice-9/syncase.scm
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/ice-9/syncase.scm,v
retrieving revision 1.18.2.7
diff -u -r1.18.2.7 syncase.scm
--- ice-9/syncase.scm   12 Mar 2002 21:21:15 -0000      1.18.2.7
+++ ice-9/syncase.scm   4 Sep 2002 20:10:11 -0000
@@ -65,10 +65,20 @@
 
 
 
+(define expansion-eval-closure (make-fluid))
+
+(define (env->eval-closure env)
+  (or (and env
+          (car (last-pair env)))
+      (module-eval-closure the-root-module)))
+
 (define sc-macro
   (procedure->memoizing-macro
     (lambda (exp env)
-      (sc-expand exp))))
+      (with-fluids ((expansion-eval-closure (env->eval-closure env)))
+        (sc-expand exp)))))
+
+(fluid-set! expansion-eval-closure (env->eval-closure #f))
 
 ;;; Exported variables
 
@@ -135,13 +145,12 @@
                          '())))
 
 (define the-syncase-module (current-module))
+(define the-syncase-eval-closure (module-eval-closure the-syncase-module))
 
 (define (putprop symbol key binding)
-  (let* ((m (current-module))
-        (v (or (module-variable m symbol)
-               (module-make-local-var! m symbol))))
+  (let* ((v ((fluid-ref expansion-eval-closure) symbol #t)))
     (if (symbol-property symbol 'primitive-syntax)
-       (if (eq? (current-module) the-syncase-module)
+       (if (eq? (fluid-ref expansion-eval-closure) the-syncase-eval-closure)
            (set-object-property! (module-variable the-root-module symbol)
                                  key
                                  binding))
@@ -149,8 +158,7 @@
     (set-object-property! v key binding)))
 
 (define (getprop symbol key)
-  (let* ((m (current-module))
-        (v (module-variable m symbol)))
+  (let* ((v ((fluid-ref expansion-eval-closure) symbol #f)))
     (and v (or (object-property v key)
               (let ((root-v (module-local-variable the-root-module symbol)))
                 (and (equal? root-v v)


-- 
GPG: D5D4E405 - 2F9B BCCC 8527 692A 04E3  331E FAF8 226A D5D4 E405