From 3ce6d037e4e0786132abe6ade969f5d06cb6cc21 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Sat, 19 Apr 2008 17:55:30 -0400
Subject: [PATCH] Fixed a bug in module imports where some marks were missing
 in action. (Note from Kent, extracted from chez scheme release notes,
 follows)

This always worked:

(let ()
  (define-syntax from
    (syntax-rules ()
      [(_ m v) (let () (import m) v)]))
  (module a (x) (define x 'x-of-a))
  (from a x))

Didn't work before this change:

(let ()
  (define-syntax x-from-a
    (syntax-rules ()
      [(_) (let () (import a) x)]))
  (module a (x) (define x 'x-of-a))
  (x-from-a))
---
 scheme/last-revision       |  2 +-
 scheme/psyntax.expander.ss | 34 +++++++++++++++++++++++++++++++---
 2 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/scheme/last-revision b/scheme/last-revision
index 31d5cbb..d370470 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1450
+1451
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index 9b8d548..a4886e4 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -2804,6 +2804,26 @@
              (stx-error e "module exports must be identifiers"))
            (values name (list->vector export*) b*))))))
 
+  (define-record module-interface (first-mark exp-id-vec exp-lab-vec))
+
+  (define (module-interface-exp-id* iface id)
+    (define (diff-marks ls x) 
+      (when (null? ls) (error 'diff-marks "BUG: should not happen"))
+      (let ([a (car ls)])
+        (if (eq? a x)
+            '()
+            (cons a (diff-marks (cdr ls) x)))))
+    (let ([diff
+           (diff-marks (stx-mark* id) (module-interface-first-mark iface))]
+          [id-vec (module-interface-exp-id-vec iface)])
+      (if (null? diff)
+          id-vec
+          (vector-map
+            (lambda (x)
+              (make-stx (stx-expr x) (append diff (stx-mark* x)) '() '()))
+            id-vec))))
+
+
   (define chi-internal-module
     (lambda (e r mr lex* rhs* mod** kwd*)
       (let-values (((name exp-id* e*) (parse-module e)))
@@ -2824,7 +2844,14 @@
                 (if (not name) ;;; explicit export
                     (values lex* rhs* exp-id* exp-lab* r mr mod** kwd*)
                     (let ((lab (gen-label 'module))
-                          (iface (cons exp-id* exp-lab*)))
+                          (iface 
+                           (make-module-interface 
+                             (car (stx-mark* name))
+                             (vector-map 
+                               (lambda (x) 
+                                 (make-stx (stx-expr x) (stx-mark* x) '() '()))
+                               exp-id*)
+                             exp-lab*)))
                       (values lex* rhs*
                               (vector name) ;;; FIXME: module cannot
                               (vector lab)  ;;;  export itself yet
@@ -2927,8 +2954,9 @@
                            (case type
                              (($module)
                               (let ((iface value))
-                                (let ((id* (car iface)) (lab* (cdr iface)))
-                                  (values id* lab*))))
+                                (values 
+                                  (module-interface-exp-id* iface id)
+                                  (module-interface-exp-lab-vec iface))))
                              (else (stx-error e "invalid import")))))))
                     (define (library-import e) 
                       (syntax-match e ()