fix R6RS language to disallow redefinition of imported names in phase different from import

svn: r12176

collects/r6rs/main.ss

@@ -151,8 +151,9 @@ FIXME:
      (let ([a (local-expand
                #'thing
                'module
-               (kernel-form-identifier-list))])
-       (syntax-case a (begin)
+               (cons #'#%require 
+                     (kernel-form-identifier-list)))])
+       (syntax-case a (begin #%require)
          [(def . _)
           (ormap (lambda (id)
                    (free-identifier=? id #'def))
@@ -160,6 +161,10 @@ FIXME:
                        #'define-syntaxes
                        #'define-values-for-syntax))
           #`(begin #,a (library-body/defns . more))]
+         [(#%require . _)
+          ;; We allow `require' mixed with definitions, because it
+          ;; might reasonably be introduced by a macro.
+          #`(begin #,a (library-body/defns . more))]
          [(begin sub ...)
           #`(library-body/defns sub ... . more)]
          [else
@@ -257,7 +262,9 @@ FIXME:
             (for-each (map-id 0) ids)
             (for-each (map-id 1) for-syntax-ids))
           (for-each (lambda (l)
-                      (for-each (map-id (car l)) (cdr l)))
+                      (if (car l)
+                          (for-each (map-id (car l)) (cdr l))
+                          null))
                     (syntax-local-module-required-identifiers #f #t))
           (apply
            append

collects/rnrs/base-6.ss

@@ -489,13 +489,25 @@
     [(_ args . body)
      (syntax/loc stx (r5rs:lambda args (let () . body)))]))
 
+(define-for-syntax (check-label id orig-stx def)
+  (when (eq? 'module (syntax-local-context))
+    (when (identifier-binding id #f)
+      (raise-syntax-error
+       #f
+       "cannot define imported identifier"
+       orig-stx
+       id)))
+  def)
+
 (define-syntax (r6rs:define stx)
   (syntax-case stx ()
     [(_ id) 
      (identifier? #'id)
-     (syntax/loc stx (define id (void)))]
+     (check-label #'id stx (syntax/loc stx (define id (void))))]
     [(_ (name . args) . body)
-     (syntax/loc stx (r5rs:define (name . args) (let () . body)))]
+     (check-label #'name
+                  stx
+                  (syntax/loc stx (r5rs:define (name . args) (let () . body))))]
     [(_ . rest) #'(define . rest)]))
 
 ;; ----------------------------------------
@@ -507,8 +519,10 @@
   (syntax-case stx ()
     [(_ id expr)
      (identifier? #'id)
-     (syntax/loc stx
-       (define-syntax id (wrap-as-needed expr)))]))
+     (check-label #'id
+                  stx
+                  (syntax/loc stx
+                    (define-syntax id (wrap-as-needed expr))))]))
 
 (define-for-syntax (wrap r stx)
   (cond