[plt-scheme] Questions about modules in embedded system

>> I'd like to split a routine out of embed.ss that takes the same
>> mod-list, literal-file-list, and literal-sexpr arguments as
>> make-embedding-executable, but writes the resulting expressions to the
>> current output port. make-embedding-executable could call this
>> function, and it could be used directly. Would you take such a patch?
>
> Yes.

Here is a patch against collects/compiler in 208. I have tested that I 
can save a bytecode image of my application and its dependencies to a 
file, and that loading it later leads to a working application, and 
that module name resolution finds the modules in the bundle and doesn't 
hit the filesystem. I also tried embedding (the scheme part of) my 
application with mzc --exe, and it seemed to work, so I don't think I 
broke anything.

I can do additional testing if you like. If embed-unit.ss has changed 
in 299, let me know and I will make a 299 patch.

diff -Naur compiler/doc.txt compiler-patched/doc.txt
--- compiler/doc.txt	Tue May 11 14:41:07 2004
+++ compiler-patched/doc.txt	Fri Oct  8 01:47:14 2004
@@ -356,6 +356,18 @@
  copy of MzScheme or MrEd, thus creating a _stand-alone_ Scheme
  executable.

+Embedding is done by walking the module dependency graph to find all
+modules needed by some initial set of top-level modules, compiling them
+if needed, and combining them into a _module bundle_. The bundle also
+contains an adjusted module name resolver so that modules can be named 
in
+the usual way and they will be retrieved from the bundle instead of the
+filesystem.
+
+It is also possible to generate a module bundle that resides in a file
+instead of being embedded in an executable. Such a bundle can be
+`load'ed directly by a running program, provided that the
+`read-accept-compiled' parameter is true.
+
  The _embedr-unit.ss_ library provides a signed unit, _compiler:embed at _
  that imports nothing and exports the functions below. The
  _embedr-sig.ss_ library provides the signature, _compiler:embed^_.
@@ -483,3 +495,14 @@
    `style' result is suitable for use with `get-directory', and the
    `extension' result may be a string indicating a required extension
    for the directory name (e.g., ".app" for Mac OS X).
+
+
+> (write-module-bundle verbose? mod-list literal-file-list 
literal-sexpr)
+  As `make-embedding-executable', but the module bundle is written to
+  the current output port instead of being embedded into an executable.
+  The output of this function can be `read' to load and instantiate
+  `mod-list' and its dependencies, adjust the module name resolver to
+  find the newly loaded modules, evaluate the forms included from
+  `literal-file-list', and finally evaluate `literal-sexpr'. The
+  `read-accept-compiled' parameter must be true for this to work.
+
diff -Naur compiler/embed-sig.ss compiler-patched/embed-sig.ss
--- compiler/embed-sig.ss	Wed Jul 24 15:29:05 2002
+++ compiler-patched/embed-sig.ss	Fri Oct  8 00:13:40 2004
@@ -5,5 +5,6 @@

    (define-signature compiler:embed^
      (make-embedding-executable
+     write-module-bundle
       embedding-executable-is-directory?
       embedding-executable-put-file-extension+style+filters)))
diff -Naur compiler/embed-unit.ss compiler-patched/embed-unit.ss
--- compiler/embed-unit.ss	Tue May 11 14:41:07 2004
+++ compiler-patched/embed-unit.ss	Fri Oct  8 01:47:31 2004
@@ -407,6 +407,65 @@
  			      ;; Let default handler try:
  			      (orig name rel-to stx))))))))))

+      ;; Just write a module bundle that can be loaded with 'load'; do 
not embed it
+      ;; into an executable. The bundle is written to the current 
output port. See doc.txt.
+      (define (write-module-bundle verbose? modules literal-files 
literal-expression)
+	(let* ([module-paths (map cadr modules)]
+	       [files (map
+		       (lambda (mp)
+			 (let ([f (resolve-module-path mp #f)])
+			   (unless f
+				   (error 'write-module-bundle "bad module path: ~e" mp))
+			   (normalize f)))
+		       module-paths)]
+	       [collapsed-mps (map
+			       (lambda (mp)
+				 (collapse-module-path mp "."))
+			       module-paths)]
+	       [prefix-mapping (map (lambda (f m)
+				      (cons f (let ([p (car m)])
+						(cond
+						 [(symbol? p) (symbol->string p)]
+						 [(eq? p #t) (generate-prefix)]
+						 [(not p) ""]
+						 [else (error
+							'write-module-bundle
+							"bad prefix: ~e"
+							p)]))))
+				    files modules)]
+	       ;; Each element is created with `make-mod'.
+	       ;; As we descend the module tree, we append to the front after
+	       ;; loasing imports, so the list in the right order.
+	       [codes (box null)])
+	
+	  (for-each (lambda (f mp) (get-code f mp codes prefix-mapping 
verbose?))
+		    files
+		    collapsed-mps)
+
+	  ;; Install a module name resolver that redirects
+	  ;; to the embedded modules
+	  (write (make-module-name-resolver (unbox codes)))
+	  (let ([l (unbox codes)])
+	    (for-each
+	     (lambda (nc)
+	       (when verbose?
+		     (fprintf (current-error-port) "Writing module from ~s~n" 
(mod-file nc)))
+	       (write `(current-module-name-prefix ',(string->symbol 
(mod-prefix nc))))
+	       (write (mod-code nc)))
+	     l))
+	  (write '(current-module-name-prefix #f))
+	  (newline)
+	  (for-each (lambda (f)
+		      (when verbose?
+			    (fprintf (current-error-port) "Copying from ~s~n" f))
+		      (call-with-input-file*
+		       f
+		       (lambda (i)
+			 (copy-port i (current-output-port)))))
+				 literal-files)
+	  (when literal-expression
+		(write literal-expression))))
+
        ;; The main function (see doc.txt).
        (define make-embedding-executable
  	(opt-lambda (dest mred? verbose?
@@ -425,36 +484,7 @@
  	  (unless (or long-cmdline?
  		      ((apply + (length cmdline) (map string-length cmdline)) . < . 
50))
  	    (error 'make-embedding-executable "command line too long"))
-	  (let* ([module-paths (map cadr modules)]
-		 [files (map
-			 (lambda (mp)
-			   (let ([f (resolve-module-path mp #f)])
-			     (unless f
-			       (error 'make-embedding-executable "bad module path: ~e" mp))
-			     (normalize f)))
-			 module-paths)]
-		 [collapsed-mps (map
-				 (lambda (mp)
-				   (collapse-module-path mp "."))
-				 module-paths)]
-		 [prefix-mapping (map (lambda (f m)
-					(cons f (let ([p (car m)])
-						  (cond
-						   [(symbol? p) (symbol->string p)]
-						   [(eq? p #t) (generate-prefix)]
-						   [(not p) ""]
-						   [else (error
-							  'make-embedding-executable
-							  "bad prefix: ~e"
-							  p)]))))
-				      files modules)]
-		 ;; Each element is created with `make-mod'.
-		 ;; As we descend the module tree, we append to the front after
-		 ;; loasing imports, so the list in the right order.
-		 [codes (box null)])
-	    (for-each (lambda (f mp) (get-code f mp codes prefix-mapping 
verbose?))
-		      files
-		      collapsed-mps)
+
  	    (let ([exe (find-exe mred? variant)])
  	      (when verbose?
  		(fprintf (current-error-port) "Copying to ~s~n" dest))
@@ -476,33 +506,10 @@
  					      (delete-file dest)))
  					(raise x))])
  		  (let ([start (data-fork-size dest-exe)])
-		    (call-with-output-file*
-		     dest-exe
-		     (lambda (o)
-		       ;; Install a module name resolver that redirects
-		       ;; to the embedded modules
-		       (write (make-module-name-resolver (unbox codes)) o)
-		       (let ([l (unbox codes)])
-			 (for-each
-			  (lambda (nc)
-			    (when verbose?
-			      (fprintf (current-error-port) "Writing module from ~s~n" 
(mod-file nc)))
-			    (write `(current-module-name-prefix ',(string->symbol 
(mod-prefix nc))) o)
-			    (write (mod-code nc) o))
-			  l))
-		       (write '(current-module-name-prefix #f) o)
-		       (newline o)
-		       (for-each (lambda (f)
-				   (when verbose?
-				     (fprintf (current-error-port) "Copying from ~s~n" f))
-				   (call-with-input-file*
-				    f
-				    (lambda (i)
-				      (copy-port i o))))
-				 literal-files)
-		       (when literal-expression
-			 (write literal-expression o)))
-		     'append)
+		    (with-output-to-file dest-exe
+		      (lambda ()
+			(write-module-bundle verbose? modules literal-files 
literal-expression))
+		      'append)
  		    (let ([end (data-fork-size dest-exe)])
  		      (when verbose?
  			(fprintf (current-error-port) "Setting command line~n"))
@@ -552,4 +559,4 @@
  				(let ([m (and (eq? 'windows (system-type))
  					      (assq 'ico aux))])
  				  (when m
-				    (install-icon dest-exe (cdr m)))))))))))))))))))
+				    (install-icon dest-exe (cdr m))))))))))))))))))