From ca973ccae1e993037dcd9a3654ff4fefcc48b165 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 16 Aug 2006 23:10:13 +0000
Subject: [PATCH] propagate module-begin certificates on src2src optimization

svn: r4073
---
 collects/compiler/src2src.ss | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

diff --git a/collects/compiler/src2src.ss b/collects/compiler/src2src.ss
index e2eb0aa0ee..eb666f8d19 100644
--- a/collects/compiler/src2src.ss
+++ b/collects/compiler/src2src.ss
@@ -1388,7 +1388,7 @@
 
   (define module%
     (class exp% 
-      (init-field body et-body name init-req req-prov tables)
+      (init-field body et-body name init-req req-prov tables src-module-begin-stx)
       (super-instantiate ())
       (inherit-field src-stx)
       
@@ -1543,13 +1543,17 @@
 		      [(body ...) (map get-sexpr body)]
 		      [(et-body ...) (map get-sexpr et-body)]
 		      [(req-prov ...) (map get-sexpr req-prov)])
-	  (recertify
-	   (syntax/loc src-stx
-	     (module name init-req
-	       (#%plain-module-begin
-		req-prov ...
-		body ...
-		et-body ...))))))
+          (with-syntax ([body 
+                         (syntax-recertify #'(#%plain-module-begin
+                                              req-prov ...
+                                              body ...
+                                              et-body ...)
+                                           src-module-begin-stx
+                                           recert-insp
+                                           #f)])
+            (recertify
+             (syntax/loc src-stx
+               (module name init-req body))))))
       (define/override (body-sexpr)
 	(list (sexpr)))))
 
@@ -1808,7 +1812,10 @@
              (syntax name)
              (syntax init-require)
              req-prov
-             tables stx))]
+             tables 
+             (syntax-case stx ()
+               [(m n ir mb) #'mb])
+             stx))]
         
 	[(require . i) (make-object require/provide% stx)]
 	[(require-for-syntax . i) (make-object require/provide% stx)]
@@ -1833,7 +1840,7 @@
     (opt-lambda (e [for-mzc? #f])
       (let ([p (parse-top e null #f #f (create-tables))])
 	(send p set-mutability)
-	(send p reorganize)
+        (send p reorganize)
 	(send p set-known-values)
 	(let ([p (send p simplify (make-context 'all null))])
 	  (let ([v (get-sexpr (if for-mzc?