From 7e81aaeb655eba928a2b776e12e7c2bb9cdd5036 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 7 Apr 2009 20:36:08 +0000
Subject: [PATCH] scheme/package simplifications from Chongkai

svn: r14448

original commit: de1e2fac233b1c1916943bb946b77224455619d5
---
 collects/scheme/package.ss | 28 +++++++++++-----------------
 1 file changed, 11 insertions(+), 17 deletions(-)

diff --git a/collects/scheme/package.ss b/collects/scheme/package.ss
index 8f0d471..2140f22 100644
--- a/collects/scheme/package.ss
+++ b/collects/scheme/package.ss
@@ -222,7 +222,6 @@
                                                 [(_ stx) #'stx])))))])
              (let loop ([exprs init-exprs]
                         [rev-forms null]
-                        [defined null]
                         [def-ctxes (list def-ctx)])
                (cond
                 [(null? exprs)
@@ -296,7 +295,6 @@
                      [(begin . rest)
                       (loop (append (syntax->list #'rest) (cdr exprs))
                             rev-forms
-                            defined
                             def-ctxes)]
                      [(def (id ...) rhs)
                       (and (or (free-identifier=? #'def #'define-syntaxes)
@@ -319,7 +317,6 @@
                             (loop (cdr exprs)
                                   (cons #`(define-syntaxes #,ids rhs)
                                         rev-forms)
-                                  (cons ids defined)
                                   (if star? (cons def-ctx def-ctxes) def-ctxes)))))]
                      [(def (id ...) rhs)
                       (and (or (free-identifier=? #'def #'define-values)
@@ -337,7 +334,6 @@
                           (register-bindings! ids)
                           (loop (cdr exprs)
                                 (cons #`(define-values #,ids rhs) rev-forms)
-                                (cons ids defined)
                                 (if star? (cons def-ctx def-ctxes) def-ctxes))))]
                      [else
                       (loop (cdr exprs) 
@@ -346,7 +342,6 @@
                                       expr
                                       #`(define-values () (begin #,expr (values))))
                                   rev-forms)
-                            defined
                             def-ctxes)]))]))))))]))
 
 (define-syntax (define-package stx)
@@ -396,18 +391,17 @@
                                                      (syntax-local-introduce (cdr p))))
                                              ((package-exports v)))]
                          [(h ...) (map syntax-local-introduce ((package-hidden v)))])
-             #`(begin
-                 (#,define-syntaxes-id (intro ...)
-                   (let ([rev-map (lambda (x)
-                                    (reverse-mapping
-                                     'pack-id
-                                     x
-                                     (list (cons (quote-syntax a)
-                                                 (quote-syntax b))
-                                           ...)
-                                     (list (quote-syntax h) ...)))])
-                     (values (make-rename-transformer #'defined rev-map)
-                             ...))))))))]))
+             #`(#,define-syntaxes-id (intro ...)
+                 (let ([rev-map (lambda (x)
+                                  (reverse-mapping
+                                   'pack-id
+                                   x
+                                   (list (cons (quote-syntax a)
+                                               (quote-syntax b))
+                                         ...)
+                                   (list (quote-syntax h) ...)))])
+                   (values (make-rename-transformer #'defined rev-map)
+                           ...)))))))]))
 
 (define-syntax (open-package stx)
   (do-open stx #'define-syntaxes))