Fix module scoping for datum->syntax with no identifier

* module/ice-9/psyntax.scm: With the new behavior of datum->syntax which
allows #f for the lexical context, we have the question of what module
to attach to these newly created syntax objects.  In that case we'll
mark down #f as the module, indicating that we know nothing.  We have to
extend a number of other cases to default to the expander's idea of the
current module, if a syntax object has no module scope.

Also, change datum->syntax to attach the empty wrap, not the top wrap.
Attaching the top wrap leads to multiply applying the top mark, as you
recurse into subexpressions.

diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 8efd082f19d481350f21cb7631911aeca5c98cfc..6c29cee3b7ebe8bb0ad9a26891898ce89c7604a1 100644 (file)
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -384,7 +384,7 @@
                  ((syntax? id)
                   (let ((id (syntax-expression id))
                         (w1 (syntax-wrap id))
-                        (mod (syntax-module id)))
+                        (mod (or (syntax-module id) mod)))
                     (let ((marks (join-marks (car w) (car w1))))
                       (call-with-values
                         (lambda () (search id (cdr w) marks mod))
@@ -466,12 +466,12 @@
                         (syntax-expression n)
                         (syntax-wrap n)
                         r
-                        (syntax-module n)
+                        (or (syntax-module n) mod)
                         resolve-syntax-parameters?)))
                    ((symbol? n)
-                    (resolve-global n (if (syntax? id) (syntax-module id) mod)))
+                    (resolve-global n (or (and (syntax? id) (syntax-module id)) mod)))
                    ((string? n)
-                    (resolve-lexical n (if (syntax? id) (syntax-module id) mod)))
+                    (resolve-lexical n (or (and (syntax? id) (syntax-module id)) mod)))
                    (else (error "unexpected id-var-name" id w n)))))))
      (transformer-environment
        (make-fluid
@@ -524,16 +524,16 @@
               (or (bound-id=? x (car list)) (bound-id-member? x (cdr list))))))
      (wrap (lambda (x w defmod) (source-wrap x w #f defmod)))
      (wrap-syntax
-       (lambda (x w)
+       (lambda (x w defmod)
          (make-syntax
            (syntax-expression x)
            w
-           (syntax-module x)
+           (or (syntax-module x) defmod)
            (syntax-source x))))
      (source-wrap
        (lambda (x w s defmod)
-         (cond ((and (null? (car w)) (null? (cdr w)) (not s)) x)
-               ((syntax? x) (wrap-syntax x (join-wraps w (syntax-wrap x))))
+         (cond ((and (null? (car w)) (null? (cdr w)) (not defmod) (not s)) x)
+               ((syntax? x) (wrap-syntax x (join-wraps w (syntax-wrap x)) defmod))
                ((null? x) x)
                (else (make-syntax x w defmod (or s (source-properties x)))))))
      (expand-sequence
@@ -557,7 +557,7 @@
                     (extend-ribcage!
                       ribcage
                       id
-                      (cons (syntax-module id) (wrap var '((top)) mod))))))
+                      (cons (or (syntax-module id) mod) (wrap var '((top)) mod))))))
               (macro-introduced-identifier?
                 (lambda (id) (not (equal? (car (syntax-wrap id)) '(top)))))
               (fresh-derived-name
@@ -871,7 +871,7 @@
                     (build-global-reference
                       (or (source-annotation (car e)) s)
                       (if (syntax? value) (syntax-expression value) value)
-                      (if (syntax? value) (syntax-module value) mod))
+                      (or (and (syntax? value) (syntax-module value)) mod))
                     e
                     r
                     w
@@ -966,11 +966,15 @@
                        (let ((w (syntax-wrap x)))
                          (let ((ms (car w)) (ss (cdr w)))
                            (if (and (pair? ms) (eq? (car ms) #f))
-                             (wrap-syntax x (cons (cdr ms) (if rib (cons rib (cdr ss)) (cdr ss))))
+                             (wrap-syntax
+                               x
+                               (cons (cdr ms) (if rib (cons rib (cdr ss)) (cdr ss)))
+                               mod)
                              (wrap-syntax
                                x
                                (cons (cons m ms)
-                                     (if rib (cons rib (cons 'shift ss)) (cons 'shift ss))))))))
+                                     (if rib (cons rib (cons 'shift ss)) (cons 'shift ss)))
+                               mod)))))
                       ((vector? x)
                        (let* ((n (vector-length x)) (v (decorate-source (make-vector n) s)))
                          (let loop ((i 0))
@@ -986,11 +990,11 @@
                          (source-wrap e w (cdr w) mod)
                          x))
                       (else (decorate-source x s))))))
-           (let* ((t-680b775fb37a463-d7b transformer-environment)
-                  (t-680b775fb37a463-d7c (lambda (k) (k e r w s rib mod))))
+           (let* ((t-680b775fb37a463-db3 transformer-environment)
+                  (t-680b775fb37a463-db4 (lambda (k) (k e r w s rib mod))))
              (with-fluid*
-               t-680b775fb37a463-d7b
-               t-680b775fb37a463-d7c
+               t-680b775fb37a463-db3
+               t-680b775fb37a463-db4
                (lambda ()
                  (rebuild-macro-output
                    (p (source-wrap e (anti-mark w) s mod))
@@ -1183,7 +1187,7 @@
                     (make-syntax
                       '#{ $sc-ellipsis }#
                       (syntax-wrap e)
-                      (syntax-module e)
+                      (or (syntax-module e) mod)
                       #f)
                     '(())
                     r
@@ -1557,11 +1561,9 @@
                                           s
                                           mod
                                           get-formals
-                                          (map (lambda (tmp-680b775fb37a463-fec
-                                                        tmp-680b775fb37a463-feb
-                                                        tmp-680b775fb37a463-fea)
-                                                 (cons tmp-680b775fb37a463-fea
-                                                       (cons tmp-680b775fb37a463-feb tmp-680b775fb37a463-fec)))
+                                          (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
+                                                 (cons tmp-680b775fb37a463
+                                                       (cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
                                                e2*
                                                e1*
                                                args*)))
@@ -1866,9 +1868,11 @@
               (apply (lambda (args e1 e2)
                        (build-it
                          '()
-                         (map (lambda (tmp-680b775fb37a463-1 tmp-680b775fb37a463 tmp-680b775fb37a463-68f)
-                                (cons tmp-680b775fb37a463-68f
-                                      (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)))
+                         (map (lambda (tmp-680b775fb37a463-6a4
+                                       tmp-680b775fb37a463-6a3
+                                       tmp-680b775fb37a463-6a2)
+                                (cons tmp-680b775fb37a463-6a2
+                                      (cons tmp-680b775fb37a463-6a3 tmp-680b775fb37a463-6a4)))
                               e2
                               e1
                               args)))
@@ -1880,11 +1884,11 @@
                   (apply (lambda (docstring args e1 e2)
                            (build-it
                              (list (cons 'documentation (syntax->datum docstring)))
-                             (map (lambda (tmp-680b775fb37a463-6a7
-                                           tmp-680b775fb37a463-6a6
-                                           tmp-680b775fb37a463-6a5)
-                                    (cons tmp-680b775fb37a463-6a5
-                                          (cons tmp-680b775fb37a463-6a6 tmp-680b775fb37a463-6a7)))
+                             (map (lambda (tmp-680b775fb37a463-6ba
+                                           tmp-680b775fb37a463-6b9
+                                           tmp-680b775fb37a463-6b8)
+                                    (cons tmp-680b775fb37a463-6b8
+                                          (cons tmp-680b775fb37a463-6b9 tmp-680b775fb37a463-6ba)))
                                   e2
                                   e1
                                   args)))
@@ -1907,9 +1911,11 @@
               (apply (lambda (args e1 e2)
                        (build-it
                          '()
-                         (map (lambda (tmp-680b775fb37a463-65b tmp-680b775fb37a463-65a tmp-680b775fb37a463)
-                                (cons tmp-680b775fb37a463
-                                      (cons tmp-680b775fb37a463-65a tmp-680b775fb37a463-65b)))
+                         (map (lambda (tmp-680b775fb37a463-66e
+                                       tmp-680b775fb37a463-66d
+                                       tmp-680b775fb37a463-66c)
+                                (cons tmp-680b775fb37a463-66c
+                                      (cons tmp-680b775fb37a463-66d tmp-680b775fb37a463-66e)))
                               e2
                               e1
                               args)))
@@ -1921,9 +1927,9 @@
                   (apply (lambda (docstring args e1 e2)
                            (build-it
                              (list (cons 'documentation (syntax->datum docstring)))
-                             (map (lambda (tmp-680b775fb37a463-1 tmp-680b775fb37a463 tmp-680b775fb37a463-66f)
-                                    (cons tmp-680b775fb37a463-66f
-                                          (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)))
+                             (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
+                                    (cons tmp-680b775fb37a463
+                                          (cons tmp-680b775fb37a463-1 tmp-680b775fb37a463-2)))
                                   e2
                                   e1
                                   args)))
@@ -2144,7 +2150,9 @@
             (if (and tmp-1
                      (apply (lambda (id)
                               (and (id? id)
-                                   (equal? (cdr (if (syntax? id) (syntax-module id) mod)) '(guile))))
+                                   (equal?
+                                     (cdr (or (and (syntax? id) (syntax-module id)) mod))
+                                     '(guile))))
                             tmp-1))
               (apply (lambda (id) (values (syntax->datum id) r '((top)) #f '(primitive)))
                      tmp-1)
@@ -2424,10 +2432,8 @@
       (lambda* (id datum #:key (source #f #:source))
         (make-syntax
           datum
-          (if id (syntax-wrap id) '((top)))
-          (if id
-            (syntax-module id)
-            (cons 'hygiene (module-name (current-module))))
+          (if id (syntax-wrap id) '(()))
+          (and id (syntax-module id))
           (cond ((not source) (source-properties datum))
                 ((and (list? source) (and-map pair? source)) source)
                 (else (syntax-source source))))))
@@ -2478,7 +2484,7 @@
              (if (not (nonsymbol-id? x))
                (syntax-violation 'syntax-module "invalid argument" x)))
            (let ((mod (syntax-module id)))
-             (and (not (equal? mod '(primitive))) (cdr mod)))))
+             (and mod (not (equal? mod '(primitive))) (cdr mod)))))
        (syntax-local-binding
          (lambda* (id
                    #:key
@@ -2501,7 +2507,7 @@
                        (syntax-expression id)
                        (strip-anti-mark (syntax-wrap id))
                        r
-                       (syntax-module id)
+                       (or (syntax-module id) mod)
                        resolve-syntax-parameters?))
                    (lambda (type value mod)
                      (let ((key type))
@@ -2517,7 +2523,7 @@
                              ((memv key '(ellipsis))
                               (values
                                 'ellipsis
-                                (wrap-syntax value (anti-mark (syntax-wrap value)))))
+                                (wrap-syntax value (anti-mark (syntax-wrap value)) mod)))
                              (else (values 'other #f)))))))))))
        (syntax-locally-bound-identifiers
          (lambda (id)
@@ -2547,7 +2553,7 @@
                     (syntax-expression e)
                     p
                     (join-wraps w (syntax-wrap e))
-                    (syntax-module e)))
+                    (or (syntax-module e) mod)))
                  (else #f))))
        (match-each+
          (lambda (e x-pat y-pat z-pat w r mod)
@@ -2645,7 +2651,7 @@
                          p
                          (join-wraps w (syntax-wrap e))
                          r
-                         (syntax-module e)))
+                         (or (syntax-module e) mod)))
                       (else (match* e p w r mod))))))
       (set! $sc-dispatch
         (lambda (e p)
@@ -2835,11 +2841,9 @@
                            #f
                            k
                            '()
-                           (map (lambda (tmp-680b775fb37a463-110c
-                                         tmp-680b775fb37a463-110b
-                                         tmp-680b775fb37a463-110a)
-                                  (list (cons tmp-680b775fb37a463-110a tmp-680b775fb37a463-110b)
-                                        tmp-680b775fb37a463-110c))
+                           (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
+                                  (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
+                                        tmp-680b775fb37a463-2))
                                 template
                                 pattern
                                 keyword)))
@@ -2855,9 +2859,9 @@
                                #f
                                k
                                (list docstring)
-                               (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
-                                      (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
-                                            tmp-680b775fb37a463-2))
+                               (map (lambda (tmp-680b775fb37a463-1 tmp-680b775fb37a463 tmp-680b775fb37a463-115f)
+                                      (list (cons tmp-680b775fb37a463-115f tmp-680b775fb37a463)
+                                            tmp-680b775fb37a463-1))
                                     template
                                     pattern
                                     keyword)))
@@ -2872,11 +2876,9 @@
                                    dots
                                    k
                                    '()
-                                   (map (lambda (tmp-680b775fb37a463-113e
-                                                 tmp-680b775fb37a463-113d
-                                                 tmp-680b775fb37a463-113c)
-                                          (list (cons tmp-680b775fb37a463-113c tmp-680b775fb37a463-113d)
-                                                tmp-680b775fb37a463-113e))
+                                   (map (lambda (tmp-680b775fb37a463-117a tmp-680b775fb37a463-1 tmp-680b775fb37a463)
+                                          (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
+                                                tmp-680b775fb37a463-117a))
                                         template
                                         pattern
                                         keyword)))
@@ -2892,11 +2894,9 @@
                                        dots
                                        k
                                        (list docstring)
-                                       (map (lambda (tmp-680b775fb37a463-115d
-                                                     tmp-680b775fb37a463-115c
-                                                     tmp-680b775fb37a463-115b)
-                                              (list (cons tmp-680b775fb37a463-115b tmp-680b775fb37a463-115c)
-                                                    tmp-680b775fb37a463-115d))
+                                       (map (lambda (tmp-680b775fb37a463-2 tmp-680b775fb37a463-1 tmp-680b775fb37a463)
+                                              (list (cons tmp-680b775fb37a463 tmp-680b775fb37a463-1)
+                                                    tmp-680b775fb37a463-2))
                                             template
                                             pattern
                                             keyword)))
@@ -3044,8 +3044,8 @@
                                                (apply (lambda (p)
                                                         (if (= lev 0)
                                                           (quasilist*
-                                                            (map (lambda (tmp-680b775fb37a463-120d)
-                                                                   (list "value" tmp-680b775fb37a463-120d))
+                                                            (map (lambda (tmp-680b775fb37a463)
+                                                                   (list "value" tmp-680b775fb37a463))
                                                                  p)
                                                             (quasi q lev))
                                                           (quasicons
@@ -3068,8 +3068,8 @@
                                                    (apply (lambda (p)
                                                             (if (= lev 0)
                                                               (quasiappend
-                                                                (map (lambda (tmp-680b775fb37a463)
-                                                                       (list "value" tmp-680b775fb37a463))
+                                                                (map (lambda (tmp-680b775fb37a463-124e)
+                                                                       (list "value" tmp-680b775fb37a463-124e))
                                                                      p)
                                                                 (quasi q lev))
                                                               (quasicons
@@ -3122,8 +3122,8 @@
                                       (apply (lambda (p)
                                                (if (= lev 0)
                                                  (quasiappend
-                                                   (map (lambda (tmp-680b775fb37a463-122d)
-                                                          (list "value" tmp-680b775fb37a463-122d))
+                                                   (map (lambda (tmp-680b775fb37a463)
+                                                          (list "value" tmp-680b775fb37a463))
                                                         p)
                                                    (vquasi q lev))
                                                  (quasicons
@@ -3213,7 +3213,8 @@
                                 (let ((tmp-1 ls))
                                   (let ((tmp ($sc-dispatch tmp-1 'each-any)))
                                     (if tmp
-                                      (apply (lambda (t-680b775fb37a463) (cons "vector" t-680b775fb37a463))
+                                      (apply (lambda (t-680b775fb37a463-12b2)
+                                               (cons "vector" t-680b775fb37a463-12b2))
                                              tmp)
                                       (syntax-violation
                                         #f
@@ -3223,7 +3224,8 @@
                        (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") each-any))))
                          (if tmp-1
                            (apply (lambda (y)
-                                    (k (map (lambda (tmp-680b775fb37a463) (list "quote" tmp-680b775fb37a463))
+                                    (k (map (lambda (tmp-680b775fb37a463-12be)
+                                              (list "quote" tmp-680b775fb37a463-12be))
                                             y)))
                                   tmp-1)
                            (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") . each-any))))
@@ -3234,8 +3236,8 @@
                                    (apply (lambda (y z) (f z (lambda (ls) (k (append y ls))))) tmp-1)
                                    (let ((else tmp))
                                      (let ((tmp x))
-                                       (let ((t-680b775fb37a463 tmp))
-                                         (list "list->vector" t-680b775fb37a463)))))))))))))))))
+                                       (let ((t-680b775fb37a463-12cd tmp))
+                                         (list "list->vector" t-680b775fb37a463-12cd)))))))))))))))))
          (emit (lambda (x)
                  (let ((tmp x))
                    (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") any))))
@@ -3248,9 +3250,9 @@
                                     (let ((tmp-1 (map emit x)))
                                       (let ((tmp ($sc-dispatch tmp-1 'each-any)))
                                         (if tmp
-                                          (apply (lambda (t-680b775fb37a463-12a0)
+                                          (apply (lambda (t-680b775fb37a463-12dc)
                                                    (cons (make-syntax 'list '((top)) '(hygiene guile))
-                                                         t-680b775fb37a463-12a0))
+                                                         t-680b775fb37a463-12dc))
                                                  tmp)
                                           (syntax-violation
                                             #f
@@ -3266,10 +3268,10 @@
                                             (let ((tmp-1 (list (emit (car x*)) (f (cdr x*)))))
                                               (let ((tmp ($sc-dispatch tmp-1 '(any any))))
                                                 (if tmp
-                                                  (apply (lambda (t-680b775fb37a463-12b4 t-680b775fb37a463-12b3)
+                                                  (apply (lambda (t-680b775fb37a463-12f0 t-680b775fb37a463-12ef)
                                                            (list (make-syntax 'cons '((top)) '(hygiene guile))
-                                                                 t-680b775fb37a463-12b4
-                                                                 t-680b775fb37a463-12b3))
+                                                                 t-680b775fb37a463-12f0
+                                                                 t-680b775fb37a463-12ef))
                                                          tmp)
                                                   (syntax-violation
                                                     #f
@@ -3282,9 +3284,9 @@
                                             (let ((tmp-1 (map emit x)))
                                               (let ((tmp ($sc-dispatch tmp-1 'each-any)))
                                                 (if tmp
-                                                  (apply (lambda (t-680b775fb37a463-12c0)
+                                                  (apply (lambda (t-680b775fb37a463-12fc)
                                                            (cons (make-syntax 'append '((top)) '(hygiene guile))
-                                                                 t-680b775fb37a463-12c0))
+                                                                 t-680b775fb37a463-12fc))
                                                          tmp)
                                                   (syntax-violation
                                                     #f
@@ -3297,9 +3299,9 @@
                                                 (let ((tmp-1 (map emit x)))
                                                   (let ((tmp ($sc-dispatch tmp-1 'each-any)))
                                                     (if tmp
-                                                      (apply (lambda (t-680b775fb37a463-12cc)
+                                                      (apply (lambda (t-680b775fb37a463)
                                                                (cons (make-syntax 'vector '((top)) '(hygiene guile))
-                                                                     t-680b775fb37a463-12cc))
+                                                                     t-680b775fb37a463))
                                                              tmp)
                                                       (syntax-violation
                                                         #f
@@ -3310,9 +3312,9 @@
                                          (if tmp-1
                                            (apply (lambda (x)
                                                     (let ((tmp (emit x)))
-                                                      (let ((t-680b775fb37a463-12d8 tmp))
+                                                      (let ((t-680b775fb37a463 tmp))
                                                         (list (make-syntax 'list->vector '((top)) '(hygiene guile))
-                                                              t-680b775fb37a463-12d8))))
+                                                              t-680b775fb37a463))))
                                                   tmp-1)
                                            (let ((tmp-1 ($sc-dispatch tmp '(#(atom "value") any))))
                                              (if tmp-1

diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index aa13215c29ccb1d41af82b8c4527f7360c953d04..58b3ac0b3e4a2231a77ac9840adc33bb9894ae08 100644 (file)
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -760,7 +760,7 @@
          ((syntax? id)
           (let ((id (syntax-expression id))
                 (w1 (syntax-wrap id))
-                (mod (syntax-module id)))
+                (mod (or (syntax-module id) mod)))
             (let ((marks (join-marks (wrap-marks w) (wrap-marks w1))))
               (call-with-values (lambda () (search id (wrap-subst w) marks mod))
                 (lambda (new-id marks)
@@ -902,15 +902,15 @@
             (resolve-identifier (syntax-expression n)
                                 (syntax-wrap n)
                                 r
-                                (syntax-module n)
+                                (or (syntax-module n) mod)
                                 resolve-syntax-parameters?))))
          ((symbol? n)
-          (resolve-global n (if (syntax? id)
-                                (syntax-module id)
+          (resolve-global n (or (and (syntax? id)
+                                     (syntax-module id))
                                 mod)))
          ((string? n)
-          (resolve-lexical n (if (syntax? id)
-                                 (syntax-module id)
+          (resolve-lexical n (or (and (syntax? id)
+                                      (syntax-module id))
                                  mod)))
          (else
           (error "unexpected id-var-name" id w n)))))
@@ -1012,18 +1012,21 @@
       (lambda (x w defmod)
         (source-wrap x w #f defmod)))
 
-    (define (wrap-syntax x w)
+    (define (wrap-syntax x w defmod)
       (make-syntax (syntax-expression x)
                    w
-                   (syntax-module x)
+                   (or (syntax-module x) defmod)
                    (syntax-source x)))
-    (define source-wrap
-      (lambda (x w s defmod)
-        (cond
-         ((and (null? (wrap-marks w)) (null? (wrap-subst w)) (not s)) x)
-         ((syntax? x) (wrap-syntax x (join-wraps w (syntax-wrap x))))
-         ((null? x) x)
-         (else (make-syntax x w defmod (or s (source-properties x)))))))
+    (define (source-wrap x w s defmod)
+      (cond
+       ((and (null? (wrap-marks w))
+             (null? (wrap-subst w))
+             (not defmod)
+             (not s))
+        x)
+       ((syntax? x) (wrap-syntax x (join-wraps w (syntax-wrap x)) defmod))
+       ((null? x) x)
+       (else (make-syntax x w defmod (or s (source-properties x))))))
 
     ;; expanding
 
@@ -1064,7 +1067,7 @@
               ;; the special case of names that are pairs.  See the
               ;; comments in id-var-name for more.
               (extend-ribcage! ribcage id
-                               (cons (syntax-module id)
+                               (cons (or (syntax-module id) mod)
                                      (wrap var top-wrap mod)))))
           (define (macro-introduced-identifier? id)
             (not (equal? (wrap-marks (syntax-wrap id)) '(top))))
@@ -1410,8 +1413,8 @@
                                     (if (syntax? value)
                                         (syntax-expression value)
                                         value)
-                                    (if (syntax? value)
-                                        (syntax-module value)
+                                    (or (and (syntax? value)
+                                             (syntax-module value))
                                         mod))
             e r w s mod))
           ((primitive-call)
@@ -1510,14 +1513,16 @@
                             (make-wrap (cdr ms)
                                        (if rib
                                            (cons rib (cdr ss))
-                                           (cdr ss))))
+                                           (cdr ss)))
+                            mod)
                            ;; output introduced by macro
                            (wrap-syntax
                             x
                             (make-wrap (cons m ms)
                                        (if rib
                                            (cons rib (cons 'shift ss))
-                                           (cons 'shift ss))))))))
+                                           (cons 'shift ss)))
+                            mod)))))
                 
                   ((vector? x)
                    (let* ((n (vector-length x))
@@ -1752,7 +1757,7 @@
                  (lambda () (resolve-identifier
                              (make-syntax '#{ $sc-ellipsis }#
                                           (syntax-wrap e)
-                                          (syntax-module e)
+                                          (or (syntax-module e) mod)
                                           #f)
                              empty-wrap r mod #f))
                (lambda (type value mod)
@@ -2477,8 +2482,8 @@
                      (syntax-case e (@@ primitive)
                        ((_ primitive id)
                         (and (id? #'id)
-                             (equal? (cdr (if (syntax? #'id)
-                                              (syntax-module #'id)
+                             (equal? (cdr (or (and (syntax? #'id)
+                                                   (syntax-module #'id))
                                               mod))
                                      '(guile)))
                         ;; Strip the wrap from the identifier and return top-wrap
@@ -2728,10 +2733,10 @@
             (make-syntax datum
                          (if id
                              (syntax-wrap id)
-                             top-wrap)
+                             empty-wrap)
                          (if id
                              (syntax-module id)
-                             (cons 'hygiene (module-name (current-module))))
+                             #f)
                          (cond
                           ((not source) (source-properties datum))
                           ((and (list? source) (and-map pair? source)) source)
@@ -2778,7 +2783,8 @@
       (define (%syntax-module id)
         (arg-check nonsymbol-id? id 'syntax-module)
         (let ((mod (syntax-module id)))
-          (and (not (equal? mod '(primitive)))
+          (and mod
+               (not (equal? mod '(primitive)))
                (cdr mod))))
 
       (define* (syntax-local-binding id #:key (resolve-syntax-parameters? #t))
@@ -2797,7 +2803,7 @@
                                 (syntax-expression id)
                                 (strip-anti-mark (syntax-wrap id))
                                 r
-                                (syntax-module id)
+                                (or (syntax-module id) mod)
                                 resolve-syntax-parameters?))
              (lambda (type value mod)
                (case type
@@ -2812,7 +2818,8 @@
                       (values 'global (cons value (cdr mod)))))
                  ((ellipsis)
                   (values 'ellipsis
-                          (wrap-syntax value (anti-mark (syntax-wrap value)))))
+                          (wrap-syntax value (anti-mark (syntax-wrap value))
+                                       mod)))
                  (else (values 'other #f))))))))
 
       (define (syntax-locally-bound-identifiers id)
@@ -2866,7 +2873,7 @@
             (match-each (syntax-expression e)
                         p
                         (join-wraps w (syntax-wrap e))
-                        (syntax-module e)))
+                        (or (syntax-module e) mod)))
            (else #f))))
 
       (define match-each+
@@ -2979,7 +2986,7 @@
              p
              (join-wraps w (syntax-wrap e))
              r
-             (syntax-module e)))
+             (or (syntax-module e) mod)))
            (else (match* e p w r mod)))))
 
       (set! $sc-dispatch